Plotly 和 ggplot with facet_grid in R: How to get yaxis labels to use ticktext value instead of range value?
Plotly and ggplot with facet_grid in R: How to to get yaxis labels to use ticktext value instead of range value?
我想将 ggplot2 facets 与 plotly 一起使用,但 运行 遇到了显示 yaxis 范围值而不是 ticktext 的 y 轴标签的问题。我可以在 plotly 对象中更改某些内容(使用 plotly_build)以使其正确呈现。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。我在 plotly 中发现了一些与 facets 相关的其他问题,但大多数问题似乎将用户重定向为使用 plotly 子图而不是 ggplot。在我的例子中,facet 数据并没有消失,只是 yaxis 坏了。
参考问题:
请参阅下面的示例代码和显示方面问题的 mtcars 数据集。如果您查看 ggplot 对象,标签是正确的。
如果我减少子图的数量,例如将 mtcars 数据集减少到只有几个模型,问题似乎就得到了解决。为什么子图的数量会影响 yaxis 刻度标签?看起来损坏的 facets/groups 只有 1 个项目(除非它是第一个 yaxis),具有超过 1 个项目的方面(至少在这个例子中)正在正确绘制 yaxis。我可以在 plotly 对象中更改某些内容(使用 plotly_build)以使其正确呈现。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。
library(plotly)
library(ggplot2)
library(data.table)
library(datasets)
#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#Optional toggle: pick a few models and issue seems to go away
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)
#check ggplot in Plots
ggplot.test
#broken ggplotly object in Viewer
ggplotly(ggplot.test)
ggplot 图:
plotly 中的同一图已损坏 yaxis 标签:
这看起来像是从 ggplot
到 Plotly
转换的一些奇怪的人工制品。
无论如何,您需要做的就是向 ticktext
添加一个空字符串并将 tickvals
扩展 1。
for (i in 2:22) {
tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
}
第一个 yaxis 布局与其余布局相同,但不需要修复,因为它已经正确显示。
修复整个情节需要更多调整。我试图尽可能通用,但转换可能会破坏每个情节的不同之处。
library(plotly)
library(ggplot2)
library(data.table)
library(datasets)
#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#Optional toggle: pick a few models and issue seems to go away
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)
p <- ggplotly(ggplot.test)
len <- length(unique(dt$model))
total <- 1
for (i in 2:len) {
total <- total + length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']])
}
spacer <- 0.01 #space between the horizontal plots
total_length = total + len * spacer
end <- 1
start <- 1
for (i in c('', seq(2, len))) {
tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
#fix the y-axis
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
end <- start - spacer
start <- start - (tick_l - 1) / total_length
v <- c(start, end)
#fix the size
p[['x']][['layout']][[paste('yaxis', i, sep='')]]$domain <- v
}
#fix the first entry which has a different name than the rest
p[['x']][['layout']][['annotations']][[3]][['y']] <- (p[['x']][['layout']][['yaxis']]$domain[2] + p[['x']][['layout']][['yaxis']]$domain[1]) /2
p[['x']][['layout']][['shapes']][[2]][['y0']] <- p[['x']][['layout']][['yaxis']]$domain[1]
p[['x']][['layout']][['shapes']][[2]][['y1']] <- p[['x']][['layout']][['yaxis']]$domain[2]
#fix the annotations
for (i in 3:len + 1) {
#fix the y position
p[['x']][['layout']][['annotations']][[i]][['y']] <- (p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[1] + p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[2]) /2
#trim the text
p[['x']][['layout']][['annotations']][[i]][['text']] <- substr(p[['x']][['layout']][['annotations']][[i]][['text']], 1, length(p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]][['ticktext']]) * 3 - 3)
}
#fix the rectangle shapes in the background
for (i in seq(0,(len - 2) * 2, 2)) {
p[['x']][['layout']][['shapes']][[i+4]][['y0']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[1]
p[['x']][['layout']][['shapes']][[i+4]][['y1']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[2]
}
p
我对 ggplot 到 plotly conversion 有类似的问题,但想出了一个不同的解决方案。仍然不完美,但通过一些调整我相信你可以取得很好的结果:
#Using your original dt dataframe
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#define plot xaxis limits (+/- 10%)
limits <- dt %>%
summarise(max = ceiling(max(mpg*1.1)),
min = floor(min(mpg*0.9)))
#define height of subplots by finding the number of cars in each "facet"
plot_height<- dt %>%
group_by(model) %>%
count() %>%
ungroup() %>%
mutate(height_pct = n/sum(n))
#define a list of ggplots and feed it in the subplot function with the calculated limits
dt %>%
split(.$model) %>%
map(function(x) {
ggplot(data=x,aes(mpg,car.id)) + geom_point()+
facet_grid(model~.) + xlim(c(limits$min,limits$max))
}) %>%
subplot(margin = 0.005, shareX = T,heights = plot_height$height_pct,nrows = nrow(plot_height))
我想将 ggplot2 facets 与 plotly 一起使用,但 运行 遇到了显示 yaxis 范围值而不是 ticktext 的 y 轴标签的问题。我可以在 plotly 对象中更改某些内容(使用 plotly_build)以使其正确呈现。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。我在 plotly 中发现了一些与 facets 相关的其他问题,但大多数问题似乎将用户重定向为使用 plotly 子图而不是 ggplot。在我的例子中,facet 数据并没有消失,只是 yaxis 坏了。
参考问题:
请参阅下面的示例代码和显示方面问题的 mtcars 数据集。如果您查看 ggplot 对象,标签是正确的。
如果我减少子图的数量,例如将 mtcars 数据集减少到只有几个模型,问题似乎就得到了解决。为什么子图的数量会影响 yaxis 刻度标签?看起来损坏的 facets/groups 只有 1 个项目(除非它是第一个 yaxis),具有超过 1 个项目的方面(至少在这个例子中)正在正确绘制 yaxis。我可以在 plotly 对象中更改某些内容(使用 plotly_build)以使其正确呈现。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。
library(plotly)
library(ggplot2)
library(data.table)
library(datasets)
#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#Optional toggle: pick a few models and issue seems to go away
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)
#check ggplot in Plots
ggplot.test
#broken ggplotly object in Viewer
ggplotly(ggplot.test)
ggplot 图:
plotly 中的同一图已损坏 yaxis 标签:
这看起来像是从 ggplot
到 Plotly
转换的一些奇怪的人工制品。
无论如何,您需要做的就是向 ticktext
添加一个空字符串并将 tickvals
扩展 1。
for (i in 2:22) {
tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
}
第一个 yaxis 布局与其余布局相同,但不需要修复,因为它已经正确显示。
修复整个情节需要更多调整。我试图尽可能通用,但转换可能会破坏每个情节的不同之处。
library(plotly)
library(ggplot2)
library(data.table)
library(datasets)
#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#Optional toggle: pick a few models and issue seems to go away
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)
p <- ggplotly(ggplot.test)
len <- length(unique(dt$model))
total <- 1
for (i in 2:len) {
total <- total + length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']])
}
spacer <- 0.01 #space between the horizontal plots
total_length = total + len * spacer
end <- 1
start <- 1
for (i in c('', seq(2, len))) {
tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
#fix the y-axis
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
end <- start - spacer
start <- start - (tick_l - 1) / total_length
v <- c(start, end)
#fix the size
p[['x']][['layout']][[paste('yaxis', i, sep='')]]$domain <- v
}
#fix the first entry which has a different name than the rest
p[['x']][['layout']][['annotations']][[3]][['y']] <- (p[['x']][['layout']][['yaxis']]$domain[2] + p[['x']][['layout']][['yaxis']]$domain[1]) /2
p[['x']][['layout']][['shapes']][[2]][['y0']] <- p[['x']][['layout']][['yaxis']]$domain[1]
p[['x']][['layout']][['shapes']][[2]][['y1']] <- p[['x']][['layout']][['yaxis']]$domain[2]
#fix the annotations
for (i in 3:len + 1) {
#fix the y position
p[['x']][['layout']][['annotations']][[i]][['y']] <- (p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[1] + p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[2]) /2
#trim the text
p[['x']][['layout']][['annotations']][[i]][['text']] <- substr(p[['x']][['layout']][['annotations']][[i]][['text']], 1, length(p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]][['ticktext']]) * 3 - 3)
}
#fix the rectangle shapes in the background
for (i in seq(0,(len - 2) * 2, 2)) {
p[['x']][['layout']][['shapes']][[i+4]][['y0']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[1]
p[['x']][['layout']][['shapes']][[i+4]][['y1']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[2]
}
p
我对 ggplot 到 plotly conversion 有类似的问题,但想出了一个不同的解决方案。仍然不完美,但通过一些调整我相信你可以取得很好的结果:
#Using your original dt dataframe
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]
#define plot xaxis limits (+/- 10%)
limits <- dt %>%
summarise(max = ceiling(max(mpg*1.1)),
min = floor(min(mpg*0.9)))
#define height of subplots by finding the number of cars in each "facet"
plot_height<- dt %>%
group_by(model) %>%
count() %>%
ungroup() %>%
mutate(height_pct = n/sum(n))
#define a list of ggplots and feed it in the subplot function with the calculated limits
dt %>%
split(.$model) %>%
map(function(x) {
ggplot(data=x,aes(mpg,car.id)) + geom_point()+
facet_grid(model~.) + xlim(c(limits$min,limits$max))
}) %>%
subplot(margin = 0.005, shareX = T,heights = plot_height$height_pct,nrows = nrow(plot_height))