自动缩小以适应所有?

时间:2017-02-07 19:51:09

标签: r ggplot2

有没有办法告诉ggplot2缩小以适应情节的所有元素?例如,我想制作类似下图的内容

enter image description here

我可以通过硬编码coord_cartesian(xlim = c(-8, 8.5))来创建此图,但我想要一种自动确定这些值的方法,以便代码可以使用任何密度。

这是我现在的代码:

wrap_sentence <- function(string, width) {
  words <- unlist(strsplit(string, " "))
  fullsentence <- ""
  checklen <- ""
  for(i in 1:length(words)) {
    checklen <- paste(checklen, words[i])
    if(nchar(checklen)>(width+1)) {
      fullsentence <- paste0(fullsentence, "\n")
      checklen <- ""
    }
    fullsentence <- paste(fullsentence, words[i])
  }
  fullsentence <- sub("^\\s", "", fullsentence)
  fullsentence <- gsub("\n ", "\n", fullsentence)
  return(fullsentence)
}


library(ggplot2)
set.seed(02062017)
cutoff <- 0.75
t.text <- "There is a xx% chance that X improves achivement compared to Y"
c.text <- "There is a xx% chance that Y improves achivement compared to X"


df.plot <- data.frame(y = rnorm(n=100, mean = 0.5, sd = 2))

# Greater
ds <- density(df.plot$y, from = cutoff, to = max(df.plot$y))
ds_data <- data.frame(x = ds$x, y = ds$y)
prob_gt <- scales::percent(mean(df.plot[,"y"] > cutoff))

x_gt_end <- (max(df.plot[,"y"])+cutoff)/4
y_gt_end <- (density(df.plot[,"y"], from=x_gt_end, to=x_gt_end, n=1)$y)*2/3

x_gt_start <- (max(df.plot[,"y"])+cutoff)/2
y_start <-(density(df.plot[,"y"], from=x_gt_end, to=x_gt_end, n=1)$y + y_gt_end)/2

gt_y <- density(df.plot[,"y"], from=x_gt_start, to=x_gt_start, n=1)$y

gt_text <- gsub("xx%", prob_gt, t.text)

gt_text <- wrap_sentence(string = gt_text, width = 24)

# Less than

ds_less <- density(df.plot$y, from = min(df.plot$y), to = cutoff)
ds_data_less <- data.frame(x = ds_less$x, y = ds_less$y)
prob_lt <- scales::percent(1-mean(df.plot[,"y"] > cutoff))

x_lt_end <- (min(df.plot[,"y"])+cutoff)/4
y_lt_end <- (density(df.plot[,"y"], from=x_lt_end, to=x_lt_end, n=1)$y)*2/3

x_lt_start <- (min(df.plot[,"y"])+cutoff)/2
y_lt_start <-(density(df.plot[,"y"], from=x_lt_end, to=x_lt_end, n=1)$y + y_lt_end)/2

lt_text <- gsub("xx%", prob_lt, c.text)

lt_text <- wrap_sentence(string = lt_text, width = 24)

ggplot(df.plot, aes(y)) + geom_density() +
  geom_area(data = ds_data,
            aes(x = x, y = y),
            alpha = 0.5,
            fill = "darkblue") +
  geom_area(data = ds_data_less,
            aes(x = x, y = y),
            alpha = 0.5,
            fill = "darkred") +
  theme_bw() +
  geom_segment(aes(x = x_gt_start, y = y_start, xend = x_gt_end, yend = y_gt_end), 
               arrow = arrow(length=unit(0.30,"cm"), type = "closed"), 
               color="darkblue", alpha = 0.5, size=1) + 
  geom_label(aes(x = x_gt_start, y = y_start), label=gt_text, 
             vjust = "outward", hjust = "outward") + 
  geom_segment(aes(x = x_lt_start, y = y_lt_start, xend = x_lt_end, yend = y_lt_end), 
               arrow = arrow(length=unit(0.30,"cm"), type = "closed"), 
               color="darkred", alpha = 0.5, size=1) + 
  geom_label(aes(x = x_lt_start, y = y_lt_start), label=lt_text, 
             vjust = "outward", hjust = "outward") + 
  coord_cartesian(xlim = c(-8, 8.5))

请注意,如果我不包含硬编码的coord_cartesian ggplot,则会删除带有标签的框。

0 个答案:

没有答案