从箱形图和晶须图中去除晶须 - ggplot
Remove wiskers from box and wisker plot - ggplotly
我可以通过将 outlier.shape = NA,coef = 0
添加到 geom_boxplot()
函数中来制作没有 wiskers 或离群值的 ggplot 箱线图。当我将其传递给 ggplotly()
时,他们都 return。我做了研究,并能够使用下面的代码从查看器中删除异常值。我的问题是如何从 plotly 对象中删除线条?此外,我注意到悬停在 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)
如果您只为每个组画框和线会怎样?
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)
它提供了一个非常简单甚至平庸的解决方案。
我们的图表在没有修改的情况下看起来像这样。
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
参数。
我可以通过将 outlier.shape = NA,coef = 0
添加到 geom_boxplot()
函数中来制作没有 wiskers 或离群值的 ggplot 箱线图。当我将其传递给 ggplotly()
时,他们都 return。我做了研究,并能够使用下面的代码从查看器中删除异常值。我的问题是如何从 plotly 对象中删除线条?此外,我注意到悬停在 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)
如果您只为每个组画框和线会怎样?
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)
它提供了一个非常简单甚至平庸的解决方案。
我们的图表在没有修改的情况下看起来像这样。
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
参数。