如何解决方面ggplot2 :: coord_cartesian

coord_cartesian不允许设置每面的坐标，并且使用其他范围限制往往会在特定的极端处生成一条直线。由于我们具有宽变的y范围，因此我们无法在所有方面都设置相同的极限；在绘图之前限制数据对geom_line / geom_path（https://stackoverflow.com/a/27319786/3358272）并不友好，因为要花费更多的精力来插值数据以到达边缘然后插入{{1 } s以便分界。（最终，仅获得所需结果的方法就是精确地执行此操作，这对于其他数据可能会有点麻烦。）

在https://gist.github.com/burchill/d780d3e8663ad15bcbda7869394a348a中，建议一种解决方法，其始于

NA

和test_data %>% ggplot(aes(x=Nsubjects,y = Odds,color=EffectSize)) + facet_wrap(DataType ~ ExpType,labeller = label_both,scales="free") + geom_line(size=2) + geom_ribbon(aes(ymax=Upper,ymin=Lower,fill=EffectSize,color=NULL),alpha=0.2)的早期版本中，要点定义了ggplot2，并且能够控制每面的坐标。右侧的两个小平面应缩小到yy轴（1-6），以使爆炸的置信区间脱离屏幕，并使小平面主要集中在数据的“正常范围”上。（请注意：coord_panel_ranges并不是我的，而是从要旨中提取的。虽然我的需求有些相似，但我认为最好不在要旨的数据和代码范围内。）

不幸的是，对于我来说，test_data失败了。最初的错误与ggplot2-3.3.0的最近丢失有关，我尝试通过burchill的这种代码修改（使用其他ggplot2::scale_range内部函数）来减轻这种错误：

ggplot2:::

但这仍然失败

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords",ggplot2::CoordCartesian,num_of_panels = 1,panel_counter = 1,panel_ranges = NULL,setup_layout = function(self,layout,params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    layout
  },setup_panel_params =  function(self,scale_x,scale_y,params = list()) {
    if (!is.null(self$panel_ranges) & length(self$panel_ranges) != self$num_of_panels)
      stop("Number of panel ranges does not equal the number supplied")
    
    train_cartesian <- function(scale,limits,name,given_range = NULL) {
      if (is.null(given_range)) {
        expansion <- ggplot2:::default_expansion(scale,expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale,expansion,coord_limits = self$limits[[name]])
      } else {
        range <- given_range
      }
      
      out <- scale$break_info(range)
      out$arrange <- scale$axis_order()
      names(out) <- paste(name,names(out),sep = ".")
      out
    }
    
    cur_panel_ranges <- self$panel_ranges[[self$panel_counter]]
    if (self$panel_counter < self$num_of_panels)
      self$panel_counter <- self$panel_counter + 1
    else
      self$panel_counter <- 1
    
    c(train_cartesian(scale_x,self$limits$x,"x",cur_panel_ranges$x),train_cartesian(scale_y,self$limits$y,"y",cur_panel_ranges$y))
  }
)

coord_panel_ranges <- function(panel_ranges,expand = TRUE,default = FALSE,clip = "on") {
  ggplot2::ggproto(NULL,UniquePanelCoords,panel_ranges = panel_ranges,expand = expand,default = default,clip = clip)
}

我对扩展test_data %>% ggplot(aes(x=Nsubjects,alpha=0.2) + coord_panel_ranges(panel_ranges = list( list(x=c(8,64),y=c(1,4)),# Panel 1 list(x=c(8,6)),# Panel 2 list(NULL),# Panel 3,an empty list falls back on the default values list(x=c(8,7)) # Panel 4 )) # Error in panel_params$x$break_positions_minor() : # attempt to apply non-function不太熟悉，我怀疑ggproto中缺少某些内容。原型的返回值如下所示：

ggplot2

我是否需要一个str(c(train_cartesian(scale_x,cur_panel_ranges$y))) # List of 14 # $ x.range : num [1:2] 8 64 # $ x.labels : chr [1:3] "20" "40" "60" # $ x.major : num [1:3] 0.214 0.571 0.929 # $ x.minor : num [1:6] 0.0357 0.2143 0.3929 0.5714 0.75 ... # $ x.major_source: num [1:3] 20 40 60 # $ x.minor_source: num [1:6] 10 20 30 40 50 60 # $ x.arrange : chr [1:2] "secondary" "primary" # $ y.range : num [1:2] 1 4 # $ y.labels : chr [1:4] "1" "2" "3" "4" # $ y.major : num [1:4] 0 0.333 0.667 1 # $ y.minor : num [1:7] 0 0.167 0.333 0.5 0.667 ... # $ y.major_source: num [1:4] 1 2 3 4 # $ y.minor_source: num [1:7] 1 1.5 2 2.5 3 3.5 4 # $ y.arrange : chr [1:2] "primary" "secondary"元素，它是一个至少包含一个x函数的列表，或者是否需要继承其他内容以确保存在break_positions_minor或使用合理的默认值？

数据：

panel_params$x$break_positions_minor

解决方法

我修改了函数train_cartesian以匹配view_scales_from_scale（定义为here）的输出格式，这似乎可行：

train_cartesian <- function(scale,limits,name,given_range = NULL) {
    if (is.null(given_range)) {
        expansion <- ggplot2:::default_expansion(scale,expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale,expansion,coord_limits = self$limits[[name]])
    } else {
        range <- given_range
    }
    
    out <- list(
        ggplot2:::view_scale_primary(scale,range),sec = ggplot2:::view_scale_secondary(scale,arrange = scale$axis_order(),range = range
    )
    names(out) <- c(name,paste0(name,".",names(out)[-1]))
    out
}

p <- test_data %>%
  ggplot(aes(x=Nsubjects,y = Odds,color=EffectSize)) +
  facet_wrap(DataType ~ ExpType,labeller = label_both,scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper,ymin=Lower,fill=EffectSize,color=NULL),alpha=0.2)

p + 
  coord_panel_ranges(panel_ranges = list(
    list(x=c(8,64),y=c(1,4)),# Panel 1
    list(x=c(8,6)),# Panel 2
    list(NULL),# Panel 3,an empty list falls back on the default values
    list(x=c(8,7))  # Panel 4
  ))

原始答案

我以前曾经欺骗过similar problem。

# alternate version of plot with data truncated to desired range for each facet
p.alt <- p %+% {test_data %>%
    mutate(facet = as.integer(interaction(DataType,ExpType,lex.order = TRUE))) %>%
    left_join(data.frame(facet = 1:4,ymin = c(1,1,-Inf,1),# change values here to enforce
                         ymax = c(4,6,Inf,7)),# different axis limits
              by = "facet") %>%
    mutate_at(vars(Odds,Upper,Lower),list(~ ifelse(. < ymin,ymin,.))) %>%
    mutate_at(vars(Odds,list(~ ifelse(. > ymax,ymax,.))) }

# copy alternate version's panel parameters to original plot & plot the result
p1 <- ggplot_build(p)
p1.alt <- ggplot_build(p.alt)
p1$layout$panel_params <- p1.alt$layout$panel_params
p2 <- ggplot_gtable(p1)
grid::grid.draw(p2)

非常感谢Z.Lin为我的问题提供的解决方案，该答案无疑帮助我克服了错误并学习了使用ggproto对象的更合适的方法。

此答案是作为更灵活的方法来发布的，该方法可以解决刻面图内每个面板限制的潜在问题。我第一批代码的主要问题是它依赖于构面的排序，在我的其他（私有）用例中，这并不总是已知的（嗯，不是受控）先验。因此，我希望明确确定每个面板的限制。

我已经更改了函数名称（和args）以表示两点：（1）这似乎是模仿/替换coord_cartesian，并且（2）我不知道它将转换为其他coord_*功能，无需进行调整。欢迎在我的gist上发表评论/补丁。

预先，Z.Lin的结果可以完美复制：

p <- test_data %>%
  ggplot(aes(x = Nsubjects,scales = "free") +
  geom_line(size = 2) +
  geom_ribbon(aes(ymax = Upper,ymin = Lower,fill = EffectSize,color = NULL),alpha = 0.2)

p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~DataType,~ExpType,~ymin,~ymax,"A","X",4,"Y","B",7
  )
)

然后消失了哪个面板是列表中的哪个自变量的歧义（由原始代码引入）。由于它使用data.frame与图的merge匹配（通常为layout），因此行的顺序无关紧要。

注意：

所引用的panel_limits字段为：xmin，xmax，ymin和ymax，无论需要哪个构面变量；
特定字段（或缺失字段）中的NA表示使用先前定义的限制；
当所有所有分面变量匹配时（在panel_limits和facet_*定义的布局之间），限制是在各个面板上设置的；这种一对一的映射是对该功能的持续假设；
当一些（但不是全部）变量匹配时，限制是在面板的一个子集上设置的（例如，在面板的一个轴上，取决于构面方法）；
当没有变量匹配并且panel_limits是一行时，则不加选择地为所有面板设置限制；和

panel_limits

在layout中不匹配的行进行刻面忽略。

错误：

panel_limits中布局中不存在的所有构面变量（即未在facet_*中指定）；或
panel_limits中的一行以上与特定面板匹配。

作为扩展，它也处理了构面变量的子集，因此，如果我们只想将所有构面限制为ExpType，则

# set the limits on panels based on one faceting variable only
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~ExpType,NA,5
  )
) + labs(title = "panel_limits,one variable")

# set the limits on all panels
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~ymin,no variables")

（最后一个例子似乎很愚蠢，但是如果以编程方式构建构面/图并且不能保证先验地存在单个构面，则假定一切都没有歧义，这将导致合理的默认行为。）

进一步的扩展可能允许构面变量中的NA匹配所有变量，例如

# does not work
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~DataType,6
  )
)

这将要求merge理解NA的意思是“全部/任何”，而不是文字上的NA。目前，我不会扩展merge来处理该问题，因此，我不会使此函数复杂化以尝试执行此操作。如果有合理的merge替代品可以进行这种演算，请告诉我：-）

非常感谢对...

burchill（原始工作）和gist；和
Z.Lin，帮助将功能提高到ggplot2-3.3.0。

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords",ggplot2::CoordCartesian,num_of_panels = 1,panel_counter = 1,layout = NULL,setup_layout = function(self,layout,params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    self$layout <- layout # store for later
    layout
  },setup_panel_params =  function(self,scale_x,scale_y,params = list()) {
    train_cartesian <- function(scale,given_range = c(NA,NA)) {
      if (anyNA(given_range)) {
        expansion <- ggplot2:::default_expansion(scale,coord_limits = limits)
        isna <- is.na(given_range)
        given_range[isna] <- range[isna]
      }
      out <- list(
        ggplot2:::view_scale_primary(scale,given_range),range = given_range
      )
      names(out) <- c(name,names(out)[-1]))
      out
    }

    this_layout <- self$layout[ self$panel_counter,drop = FALSE ]
    self$panel_counter <- 
      if (self$panel_counter < self$num_of_panels) {
        self$panel_counter + 1
      } else 1

    # determine merge column names by removing all "standard" names
    layout_names <- setdiff(names(this_layout),c("PANEL","ROW","COL","SCALE_X","SCALE_Y"))
    limits_names <- setdiff(names(self$panel_limits),c("xmin","xmax","ymin","ymax"))

    limit_extras <- setdiff(limits_names,layout_names)
    if (length(limit_extras) > 0) {
      stop("facet names in 'panel_limits' not found in 'layout': ",paste(sQuote(limit_extras),collapse = ","))
    } else if (length(limits_names) == 0 && NROW(self$panel_limits) == 1) {
      # no panels in 'panel_limits'
      this_panel_limits <- cbind(this_layout,self$panel_limits)
    } else {
      this_panel_limits <- merge(this_layout,self$panel_limits,all.x = TRUE,by = limits_names)
    }

    if (isTRUE(NROW(this_panel_limits) > 1)) {
      stop("multiple matches for current panel in 'panel_limits'")
    }

    # add missing min/max columns,default to "no override" (NA)
    this_panel_limits[,setdiff(c("xmin","ymax"),names(this_panel_limits)) ] <- NA

    c(train_cartesian(scale_x,self$limits$x,"x",unlist(this_panel_limits[,"xmax"),drop = TRUE])),train_cartesian(scale_y,self$limits$y,"y",c("ymin",drop = TRUE])))
  }
)

coord_cartesian_panels <- function(panel_limits,expand = TRUE,default = FALSE,clip = "on") {
  ggplot2::ggproto(NULL,UniquePanelCoords,panel_limits = panel_limits,expand = expand,default = default,clip = clip)
}

在某些时候，我也有类似的问题。结果是稍微更冗长但也更灵活的选项，该选项可以基于每个方面自定义位置比例尺的许多方面。由于技术上的原因，它使用scales::oob_keep()的等价物作为标尺上的oob参数，因此就好像坐标确定了极限一样。

library(ggh4x) # devtools::install_github("teunbrand/ggh4x")
library(tidyverse)

p <- test_data %>%
  ggplot(aes(x=Nsubjects,alpha=0.2) +
  facetted_pos_scales(
    x = list(
      scale_x_continuous(limits = c(8,64)),scale_x_continuous(limits = c(64,8),trans = "reverse"),NULL,scale_x_continuous(limits = c(8,labels = scales::dollar_format())
    ),y = list(
      scale_y_continuous(limits = c(1,4),guide = "none"),scale_y_continuous(limits = c(1,6),breaks = 1:3),7),position = "right")
    )
  )

方面ggplot2 :: coord_cartesian

如何解决方面ggplot2 :: coord_cartesian

解决方法

原始答案

非常感谢对...

相关推荐