R ggplotly中的第二个x轴具有不可见的第二条轨迹

我试图在ggplotly绘图上添加第二个x轴，不是为了容纳第二个轨迹，而是为了更好的可视化

我已经计算出我确实需要为它添加一个跟踪，但问题是如何添加。我发现添加简单透明轨迹的示例不适用于在y轴上具有因子的绘图

请认为，出于我的目的，我需要使用ggplotly并需要第二个轴。我将要提供的示例非常简单，真实的应用程序有其他由ggplotly满足的需求（与直线plotly或ggplot2相反）。想象一下，如果有100种不同的虹膜物种被人们滚动浏览，那么顶部的轴首先提供了一个很好的指南。使用ggplot2，下面是我希望使用ggplotly实现的示例：

library(tidyverse)
library(plotly)

dat <- iris %>% 
  group_by(Species) %>% 
  summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
            count = n()) 


labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)

p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), y = meanSL)) +
  geom_point() + 
  geom_hline(yintercept = 6, lty = 2) +
  coord_flip() +
  ggtitle("Means of sepal length by species") +
  
  theme_classic()+
  
  theme(axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.line.y = element_blank(),
        plot.title = element_text(size = 10, hjust = 0.5))

p + scale_y_continuous(breaks = breaks, labels = labels, limits = limits, sec.axis = dup_axis(labels = labels_dup)) +
  geom_text(aes(y = 4,label = paste0("n=",count)), size = 3)
  
  

库（tidyverse）
图书馆（绘本）
dat%
组别(种类)%>%
总结（平均值SL=平均值（萼片长度，na.rm=真），
计数=n（）
标签_dup=c（“低”、“中”、“高”）
标签=c（“低”、“中”\n\n此行右侧的\n符号为“低”、“高”）
断裂=c（5,6,7）
极限=c（4,8）
p我通过添加以下内容来实现：

add_标记（data=NULL，inherit=TRUE，xaxis=“x2”）

我还将第二个轴的
tickfont
大小设置为
11
，以匹配原始轴的字体大小

虽然它正在工作，但有时更改缩放（特别是单击“自动缩放”时）会弄乱x轴的比例，使它们不再同步。最好的选择可能是限制图标栏中的可用选项

以下是您编辑的代码，将其放入正在运行的闪亮应用程序中：

library(tidyverse)
library(plotly)
library(shiny)

dat <- iris %>% 
  group_by(Species) %>% 
  summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
            count = n()) 


labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)

p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), y = meanSL)) +
  geom_point() + 
  geom_hline(yintercept = 6, lty = 2) +
  coord_flip() +
  ggtitle("Means of sepal length by species") +
  
  theme_classic() +
  
  theme(axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.line.y = element_blank(),
        plot.title = element_text(size = 10, hjust = 0.5))

p + scale_y_continuous(breaks = breaks, labels = labels, limits = limits, sec.axis = dup_axis(labels = labels_dup)) +
  geom_text(aes(y = 4,label = paste0("n=",count)), size = 3)


ax <- list(
  side = "bottom",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels)


ax2 <- list(
  overlaying = "x",
  side = "top",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup,
  tickfont = list(size = 11)) # I added this line


shinyApp(
  ui = fluidPage(
      plotlyOutput("plot")
  ),
  
  server = function(input, output) {
    
    output$plot <- renderPlotly({
      
      ggplotly(p) %>% 
        add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>% # new line
        layout(
          xaxis = ax,
          xaxis2 = ax2)
    })
  }
)

库（tidyverse）
图书馆（绘本）
图书馆（闪亮）
dat%
组别(种类)%>%
总结（平均值SL=平均值（萼片长度，na.rm=真），
计数=n（）
标签_dup=c（“低”、“中”、“高”）
标签=c（“低”、“中”\n\n此行右侧的\n符号为“低”、“高”）
断裂=c（5,6,7）
极限=c（4,8）
p注意，我刚刚在我的原始应用程序中使用的示例中添加了一个文本geom，可以用于跟踪，但我不知道如何以绘图仪的方式添加它。谢谢。这给了我一个警告“未指定分散模式：将模式设置为标记读取有关此属性的更多信息->”，这与我在其他尝试中得到的警告类似。在这个最小的示例中，它发出警告，但有效。在我的实际绘图中（在shiny中），我得到警告“警告：'分散'对象没有这些属性：'标签'”，我认为这是相关的。第二个轴不显示。如果没有其他答案，我将对这个答案给予奖励，并警告它会产生警告。@racho：我们可以将
add_trace
更改为
add_markers
，以在没有警告的情况下获得相同的结果。如果您的问题仍然存在，我们需要一个复制上述错误的较小示例。我的猜测是，您原来的情节要复杂得多，因此您可以尝试在上面的示例中添加更复杂的内容，直到出现错误。谢谢，@TimTeaFan。如果您愿意的话，我提供了一个更复杂的示例。@racho：我看了一个更复杂的示例，虽然我可以重现警告消息，但仍然正确地呈现了显示两个x轴的绘图。我假设第二个x轴的问题与警告无关。在第二个轴消失之前，是否可以尝试向示例中添加更多原始代码？我的猜测是，
ggplot
或
plotly
调用中的某些规范覆盖了第二个x轴。
library(boot)
library(tidyverse)
library(plotly)

boot_sd <- function(x, fun=mean, R=1001) {
  fun <- match.fun(fun)
  bfoo <- function(data, idx) {
    fun(data[idx])
  }
  b <- boot(x, bfoo, R=R)
  sd(b$t)
}  

#Summarise the data for use with geom_pointrange and add some hover text for use with plotly:

dat <- iris %>% 
  mutate(flower_colour = c(rep(c("blue", "purple"), 25), rep(c("blue", "white"), 25), rep(c("white", "purple"), 25))) %>% 
  group_by(Species) %>% 
  summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
            countSL = n(),
            meSL = qt(0.975, countSL-1) * boot_sd(Sepal.Length, mean, 1001),
            lowerCI_SL = meanSL - meSL,
            upperCI_SL = meanSL + meSL,
            group = "Mean &\nConfidence Interval",
            colours_in_species = paste0(sort(unique(flower_colour)), collapse = ",")) %>% 
  as.data.frame() %>% 
  mutate(colours_in_species = paste0("colours: ", colours_in_species))
  
  
  
#Some plotting variables
purple <- "#8f11e7"
plot_title_colour <- "#35373b"
axis_text_colour <- "#3c4042"
legend_text_colour <- "#3c4042"
annotation_colour <- "#3c4042"

labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)

p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), text = colours_in_species)) +
  geom_text(aes(y = 4.2,label = paste0("n=",countSL)), color = annotation_colour, size = 3) +
 geom_pointrange(aes(y = meanSL, ymin=lowerCI_SL, ymax=upperCI_SL,color = group, fill = group), size = 1) +
  scale_fill_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
  scale_color_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
  
  geom_hline(yintercept = 5, colour = "dark grey", linetype = "dashed") +
  geom_hline(yintercept = 6, colour = purple, linetype = "dashed") +
  coord_flip() +
  
  ggtitle("Means of sepal length by species") +
  
  theme_classic()+
  
  theme(axis.text.y=element_text(size=10, colour = axis_text_colour),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.line.y = element_blank(),
        axis.ticks.y = element_blank(),
        plot.title = element_text(size = 12, hjust = 0, colour = plot_title_colour), 
        legend.justification=c("right", "top"),
        legend.box.just = "center",
        legend.position ="top",
        legend.title.align = "left",
        legend.text=element_text(size = 8, hjust = 0.5, colour = legend_text_colour),
        legend.title=element_blank())



ax <- list(
  side = "top",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup)

ay <- list(
  side = "right")


ax2 <- list(
  overlaying = "x",
  side = "bottom",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup,
  tickfont = list(size = 11))




ggplotly(p, tooltip = 'text') %>% 
  add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>% 
  layout(
    xaxis = ax,
    xaxis2 = ax2,
    yaxis = ay,
    legend = list(orientation = "v", itemclick = FALSE, x = 1.2, y = 1.04),
    margin = list(t = 120, l = 60)
  )

    

library(tidyverse)
library(plotly)
library(shiny)

dat <- iris %>% 
  group_by(Species) %>% 
  summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
            count = n()) 


labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)

p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), y = meanSL)) +
  geom_point() + 
  geom_hline(yintercept = 6, lty = 2) +
  coord_flip() +
  ggtitle("Means of sepal length by species") +
  
  theme_classic() +
  
  theme(axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.line.y = element_blank(),
        plot.title = element_text(size = 10, hjust = 0.5))

p + scale_y_continuous(breaks = breaks, labels = labels, limits = limits, sec.axis = dup_axis(labels = labels_dup)) +
  geom_text(aes(y = 4,label = paste0("n=",count)), size = 3)


ax <- list(
  side = "bottom",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels)


ax2 <- list(
  overlaying = "x",
  side = "top",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup,
  tickfont = list(size = 11)) # I added this line


shinyApp(
  ui = fluidPage(
      plotlyOutput("plot")
  ),
  
  server = function(input, output) {
    
    output$plot <- renderPlotly({
      
      ggplotly(p) %>% 
        add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>% # new line
        layout(
          xaxis = ax,
          xaxis2 = ax2)
    })
  }
)

library(boot)
library(tidyverse)
library(plotly)
library(shiny)

boot_sd <- function(x, fun=mean, R=1001) {
  fun <- match.fun(fun)
  bfoo <- function(data, idx) {
    fun(data[idx])
  }
  b <- boot(x, bfoo, R=R)
  sd(b$t)
}  

#Summarise the data for use with geom_pointrange and add some hover text for use with plotly:

dat <- iris %>% 
  mutate(flower_colour = c(rep(c("blue", "purple"), 25), rep(c("blue", "white"), 25), rep(c("white", "purple"), 25))) %>% 
  group_by(Species) %>% 
  summarise(meanSL = mean(Sepal.Length, na.rm = TRUE),
            countSL = n(),
            meSL = qt(0.975, countSL-1) * boot_sd(Sepal.Length, mean, 1001),
            lowerCI_SL = meanSL - meSL,
            upperCI_SL = meanSL + meSL,
            group = "Mean &\nConfidence Interval",
            colours_in_species = paste0(sort(unique(flower_colour)), collapse = ",")) %>% 
  as.data.frame() %>% 
  mutate(colours_in_species = paste0("colours: ", colours_in_species))



#Some plotting variables
purple <- "#8f11e7"
plot_title_colour <- "#35373b"
axis_text_colour <- "#3c4042"
legend_text_colour <- "#3c4042"
annotation_colour <- "#3c4042"

labels_dup = c("low", "medium", "high")
labels = c("low", "medium\n\nmeans to the right\nof this line are\nso cool", "high")
breaks = c(5,6,7)
limits = c(4,8)

p <- ggplot(dat, aes(x = reorder(as.character(Species),meanSL), text = colours_in_species)) +
  geom_text(aes(y = 4.2,label = paste0("n=",countSL)), color = annotation_colour, size = 3) +
  geom_pointrange(aes(y = meanSL, ymin=lowerCI_SL, ymax=upperCI_SL,color = group, fill = group), size = 1) +
  scale_fill_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
  scale_color_manual(values = "#f4a01f", name = "Mean &\nConfidence Interval") +
  
  geom_hline(yintercept = 5, colour = "dark grey", linetype = "dashed") +
  geom_hline(yintercept = 6, colour = purple, linetype = "dashed") +
  coord_flip() +
  
  ggtitle("Means of sepal length by species") +
  
  theme_classic()+
  
  theme(axis.text.y=element_text(size=10, colour = axis_text_colour),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.line.y = element_blank(),
        axis.ticks.y = element_blank(),
        plot.title = element_text(size = 12, hjust = 0, colour = plot_title_colour), 
        legend.justification=c("right", "top"),
        legend.box.just = "center",
        legend.position ="top",
        legend.title.align = "left",
        legend.text=element_text(size = 8, hjust = 0.5, colour = legend_text_colour),
        legend.title=element_blank())



ax <- list(
  side = "top",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup)

ay <- list(
  side = "right")


ax2 <- list(
  overlaying = "x",
  side = "bottom",
  showticklabels = TRUE,
  range = limits,
  tickmode = "array", 
  tickvals = breaks,
  ticktext = labels_dup,
  tickfont = list(size = 11))



shinyApp(
  ui = fluidPage(
    plotlyOutput("plot")
  ),
  
  server = function(input, output) {
    
    output$plot <- renderPlotly({
      
      ggplotly(p, tooltip = 'text') %>% 
        add_markers(data = NULL, inherit = TRUE, xaxis = "x2") %>% 
        layout(
          xaxis = ax,
          xaxis2 = ax2,
          yaxis = ay,
          legend = list(orientation = "v", itemclick = FALSE, x = 1.2, y = 1.04),
          margin = list(t = 120, l = 60)
        )
      
    })
  }
)