代码之家  ›  专栏  ›  技术社区  ›  Mike

从盒子和wisker plot中移除wisker-ggplotly

  •  0
  • Mike  · 技术社区  · 3 年前

    我可以通过添加 outlier.shape = NA,coef = 0 进入 geom_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)
    
    0 回复  |  直到 3 年前
        1
  •  4
  •   Marek Fiołka    3 年前

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

    我们的图表看起来像这样,没有修改。

    df = diamonds[sample(1:nrow(diamonds), size = 1000),]
    
    p1 = df %>% group_by(cut) %>% 
      ggplot(aes(cut, price, fill = cut)) + 
      geom_boxplot()
    ggplotly(p1)
    

    enter image description here

    现在,同样的数据只需最少的修改。

    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)
    

    enter image description here

    注意四分位数可能与原始数据的四分位数略有不同。这是由于分位数的计算方法。您可以尝试 type 中的论点 quantile 作用

        2
  •  1
  •   DaveArmstrong    3 年前

    如果你只是为每组画一个方框和一条线呢?

    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)