从盒子和胡须图中删除胡须 - ggplot

Question

我可以通过将outlier.shape = NA,coef = 0 添加到geom_boxplot() 函数中来制作没有wiskers 或异常值的ggplot boxplot。当我将此传递给ggplotly() 时，它们都会返回。我进行了研究，并能够使用下面的代码从查看器中删除异常值。我的问题是如何从情节对象中删除线条？此外，我注意到在 plotly 中悬停时，0 的不透明度只是将其从视图中隐藏，但不会将其从悬停文本中删除。这也可以从悬停中隐藏吗？欢迎任何解决方案。

library(plotly) 
library(ggplot2)

p1 <- ggplot(mtcars,
      aes(
       x = factor(vs),
       y = mpg
       )
      )+
      geom_boxplot( outlier.shape = NA,coef = 0)
  
p2 <- ggplotly(p1)
#removes outlier 
p2$x$data[[1]]$marker$opacity = 0

请注意，即使定义您自己的统计摘要仍然会产生类似的输出：

q25medq75 <- function(x) {
  v <- c(quantile(x,.25),quantile(x,.25),median(x),
         quantile(x,.75),quantile(x,.75))
  names(v) <- c("ymin", "lower", "middle", "upper", "ymax")
  v
}

p1 <- ggplot(mtcars, aes(factor(am), mpg, fill=factor(am))) +
  stat_summary(fun.data=q25medq75, geom="boxplot", colour="black")

p2 <- ggplotly(p1)

Answer 1

它提供了一个非常简单甚至平庸的解决方案。

我们的图表在没有修改的情况下看起来像这样。

df = diamonds[sample(1:nrow(diamonds), size = 1000),]

p1 = df %>% group_by(cut) %>% 
  ggplot(aes(cut, price, fill = cut)) + 
  geom_boxplot()
ggplotly(p1)

现在只需少量修改即可获得相同的数据。

f1 = function(x){
  q = quantile(x, c(.25, .75)) 
  x = ifelse(x>q[2], max(x[x<=q[2]]), x)
  x = ifelse(x<q[1], min(x[x>=q[1]]), x)
  x
}

p1 = df %>% group_by(cut) %>% 
  mutate(price = f1(price)) %>% 
  ggplot(aes(cut, price, fill = cut)) + 
  geom_boxplot()
ggplotly(p1)

注意。四分位数可能与原始数据的四分位数略有不同。这是由于计算分位数的方法。您可以在quantile 函数中试验type 参数。

Answer 2

如果您只为每个组画出方框和线会怎样？

poly_data <- mtcars %>% 
  group_by(vs = vs) %>% 
  summarise(y = list(data.frame(y=c(quantile(mpg, c(.25,.25,.75,.75,.25))))), 
            x = list(data.frame(x=c(vs[1] + c(-.25, .25,.25, -.25,-.25))))) %>%
              unnest(c("x", "y")) 
line_data <-   mtcars %>% 
  group_by(vs = vs) %>% 
  summarise(y = median(mpg), 
            x = list(data.frame(x=c(vs[1] + c(-.25, .25))))) %>%
  unnest(c("x")) 



g <- ggplot() + 
  geom_polygon(data=poly_data, 
               aes(x=x, y=y, group=vs), 
               fill="transparent", 
               col="black") + 
  geom_line(data=line_data,
            aes(x=x, y=y, group=vs))

ggplotly(g)

---

编辑：如果x 是字符向量：

library(tidyverse)
library(plotly)
mtcars$vs <- as.character(mtcars$vs)

poly_data <- mtcars %>% 
  mutate(vs_num = as.numeric(as.factor(vs))) %>%   
  group_by(vs = vs) %>% 
  summarise(y = list(data.frame(y=c(quantile(mpg, c(.25,.25,.75,.75,.25))))), 
            x = list(data.frame(x=c(vs_num[1] + c(-.25, .25,.25, -.25,-.25))))) %>%
  unnest(c("x", "y")) 
line_data <-   mtcars %>% 
  mutate(vs_num = as.numeric(as.factor(vs))) %>%   
  group_by(vs = vs) %>% 
  summarise(y = median(mpg), 
            x = list(data.frame(x=c(vs_num[1] + c(-.25, .25))))) %>%
  unnest(c("x")) 



g <- ggplot() + 
  geom_polygon(data=poly_data, 
               aes(x=x, y=y, group=vs), 
               fill="transparent", 
               col="black") + 
  geom_line(data=line_data,
            aes(x=x, y=y, group=vs))

ggplotly(g)