如何在 R 中以 plotly 调整刻面宽度？

Question

我目前正在使用 plotly 创建热图。以下是示例数据集：

library(tidyverse)
library(plotly)
library(hrbrthemes)
set.seed(9999)
df <- data.frame(group.int = rep(c(rep("Prevention", 3), "Diagnosis", rep("Intervention", 2)), 6),
                int = rep(c("Prevention 1", "Prevention 2", "Prevention 3", "Diagnosis 1", "Intervention 1", "Intervention 2"), 6),
                group.outcome = c(rep("Efficacy", 12), rep("Safety", 18), rep("Cost-effectiveness", 6)),
                outcome = c(rep("Efficacy 1", 6), rep("Efficacy 2", 6), rep("Safety 1", 6), rep("Safety 2", 6), rep("Safety 3", 6), rep("Cost-effectiveness 1", 6)),
                n = sample(50:250, 36, rep = TRUE)
            )
df$group.int <- factor(df$group.int, levels = c("Prevention", "Diagnosis", "Intervention"))
df$group.outcome <- factor(df$group.outcome, levels = c("Efficacy", "Safety", "Cost-effectiveness"))

我想根据变量 outcome 针对 int 制作一个热图，每个热图单元格的填充为 n。这是所需的情节：

我尝试使用创建的 ggplot 中的 ggplotly：

plotly.df <- ggplot(df, 
                aes(x = int, y = outcome, fill= n)) + 
                geom_tile() +
                scale_fill_gradient(low="white", high="darkred") +
                scale_y_discrete(position = "right") +
                facet_grid(group.outcome ~ group.int,
                    scales = "free", space = "free", switch = "x") +
                theme_bw() +
                theme(axis.ticks = element_blank(),
                    legend.position = "left",
                    strip.placement = "outside", 
                    strip.background = element_blank())
ggplotly(plotly.df)

然而，ggplotly似乎忽略了facet_grid中的space = "free"，所以单元格的大小不成比例：[=23=]

有没有办法用 ggplotly 调整刻面宽度？

非常感谢您

Answer 1

您不必重新发明轮子。回到第一个 ggplotly 对象。领域是用来管理每个方面的空间的东西（或者在 plotly-subplot 中）。您可以通过将 ggplotly 图分配给对象并调用 plotly_json.

来检索此信息

但是，我以前曾解决过布局快捷方式。您可以像这样检索和修改域：

p = ggplotly(plotly.df)

p$x$layout$xaxis$domain <- c(0, 1/2) # 6 blocks, 3 in this group 1/6 * 3
p$x$layout$xaxis2$domain <- c(1/2, 2/3) # start at previous position, 1 in this group
p$x$layout$xaxis3$domain <- c(2/3, 1) # remaining space

p$x$layout$yaxis3$domain <- c(0, 1/6) # 1 block in bottom chunks
p$x$layout$yaxis2$domain <- c(1/6, 2/3) # 3 in mid group
p$x$layout$yaxis$domain <- c(2/3, 1) # remaining space
p

这让我走了这么远：

您的底部标签仍然对齐，但顶部标签没有对齐。此外，左下角的标签被切断了。

为了修复顶部标签，我使用 plotly_json 找出它们所在的位置，然后使用 guess-and-check 方法。为了调整标签，我修改了边距。

# prevention
p$x$layout$annotations[[3]]$x <- 1/4

# diagnosis
p$x$layout$annotations[[4]]$x <- 7/12

p %>% layout(margin = list(t = 40, r = 50, b = 80, l = 130))

根据评论更新

考虑将以下内容替换为 p = ggplotly(plotly.df) 之后的所有内容（因此您不会使用任何相关内容，但您会看到上面的代码仍然存在。）

切面

#------------- position and spacing facets -------------
p$x$layout$xaxis$domain <- c(0, 1/2)    # 6 blocks, 3 in this group 1/6 * 3
p$x$layout$xaxis2$domain <- c(1/2, 2/3) # 1 in this group
p$x$layout$xaxis3$domain <- c(2/3, 1)   # remaining space

p$x$layout$yaxis3$domain <- c(0, 1/6)   # 1 block in bottom chunks
p$x$layout$yaxis2$domain <- c(1/6, 2/3) # 3 in mid group
p$x$layout$yaxis$domain <- c(2/3, 1)    # remaining space

标签

#------------- position and spacing labels -------------
# prevention
p$x$layout$annotations[[3]]$x <- 1/4

# diagnosis
p$x$layout$annotations[[4]]$x <- 7/12

# bottom group labels: prevention, diagnosis, intervention/ adjust down
lapply(3:5, function(i){
  p$x$layout$annotations[[i]]$y <<- -0.1575
})

# efficacy, safety and cost effectiveness/ shift right
lapply(6:8, function(i){
  p$x$layout$annotations[[i]]$x <<- 1.25
  p$x$layout$annotations[[i]]$yanchor <<- "top"
})

# int
p$x$layout$annotations[[1]]$y <- -0.07

# outcome
p$x$layout$annotations[[2]]$x <- 1.475
p$x$layout$annotations[[2]]$textangle <- 90 # 180 degree flip

传说

#------------- position and spacing legend -------------
# capture the font sizes of the other annotations
tf <- p$x$layout$xaxis$tickfont

# change the font of the group labels
lapply(3:8, function(i){
  p$x$layout$annotations[[i]]$font <<- tf
})

# update the ticks to represent the values of n, not the scale 
getCol <- data.frame(p$x$data[[10]]$marker$colorscale) # capture the scale
getCol$n <- seq(from = 50, to = 208, along.with = 1:300) %>% round(digits = 0)
summary(getCol)
(getVals <- filter(getCol, n %in% seq(50, 200, by = 50)))
#          X1      X2   n
# 1 0.0000000 #FFFFFF  50
# 2 0.3143813 #E5B4A8 100
# 3 0.3177258 #E5B3A7 100
# 4 0.6321070 #C16B57 150
# 5 0.6354515 #C06A56 150
# 6 0.9464883 #941B0E 200
# 7 0.9498328 #931A0E 200 

# the legend
p$x$data[[10]]$marker$colorbar <- list(x = -.2, tickfont = tf,
                                       tickmode = "array",
                                       ticktext = seq(50, 200, by = 50),
                                   # from getVals output
                                       tickvals = c(0, .318, .636, .95),
                                       outlinewidth = 0,
                                       thickness = 20)

最后...

# legend and yaxis labels; the final plot
p %>% layout(margin = list(t = 10, r = 170, b = 120, l = 10),
             yaxis = list(side = "right", anchor = "free", position = 1),
             yaxis2 = list(side = "right", anchor = "free", position = 1),
             yaxis3 = list(side = "right", anchor = "free", position = 1))

如何在 R 中以 plotly 调整刻面宽度？

How can I adjust facet width in plotly in R?

r

ggplot2

plotly

ggplotly

r-plotly

根据评论更新