时间戳

首页 > 解决方案 > Shiny 应用程序中 plotly 和 ggplot2 的布局问题

r - Shiny 应用程序中 plotly 和 ggplot2 的布局问题

问题描述

我正在创建一个闪亮的应用程序来显示调查结果。我想在绘图中显示结果，其中问题文本作为 y 轴上的标签。（情节比下面的演示版本更复杂）。我想使用 plotly 以便鼠标悬停时出现数据标签。

问题是长 y 轴标签会导致绘图形状完全扭曲：所有内容都被推到右侧，在左侧留下大量空白区域。

我尝试手动添加换行符（使用<br>或 \n），但绘图仍被推到右侧。我还在 ggplotly 调用中指定了“宽度”；这使它更宽，但仍将其推向右侧。

是否可以在 plotly 或 ggplot2 内控制这些事情？

更新编辑：这是我发现的解决方案，以防它帮助其他人。它有两个部分：

layout()1）在调用后手动设置边距ggplotly()：https ://plot.ly/r/setting-graph-size/ （您也可以在plotlyOutput()调用内部的UI中调整整体绘图宽度。）

layout(autosize = TRUE, margin = list(l = 300, r = 0, b = 0, t = 0, pad = 4))

2）使用字符串包装函数来拆分标签，如 Rushabh 在他的回答中所建议的那样。我喜欢 tidyverse 版本：

scale_x_discrete(labels = function(x) str_wrap(x, width = 40))

这是一个演示，您可以在其中查看问题和解决方案：

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

ui <- fluidPage(

    titlePanel("Problems with Plotly"),

    sidebarLayout(
        sidebarPanel(
            radioButtons("view", "View", choices = c("Problem", "Solution")), 
            width = 3
        ),

        mainPanel(

            fluidRow(
                column(6, HTML("Other content fills up this column")), 
                column(6, plotlyOutput("plot", width = "600px"))
            )
        )
    )
)

server <- function(input, output) {

    output$plot <- renderPlotly({

        df <- tibble(
            Label = paste0(
                "Very long survey question that has to be spelled out completely ", 
                1:5
                ), 
            Value = sample(5:10, 5, replace = TRUE)
        )

        if (input$view == "Problem") {

            p <- ggplot(df, aes(Label, Value)) + 
                geom_col() + 
                coord_flip() + 
                labs(x = "")

            ggplotly(p) %>% 
                config(displayModeBar = FALSE)

        } else { # input$view == "Solution"

            p <- ggplot(df, aes(Label, Value)) + 
                geom_col() + 
                coord_flip() + 
                labs(x = "") +
                scale_x_discrete(labels = function(x) str_wrap(x, width = 40))

            ggplotly(p) %>% 
                config(displayModeBar = FALSE) %>% 
                layout(autosize = TRUE, margin = list(
                    l = 300, r = 0, b = 0, t = 0, pad = 4
                ))

        }
    })
}

shinyApp(ui = ui, server = server)

这是显示我的尝试无效的原始示例：

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

label <- "Very long survey question that has to be spelled out completely "
label_break <- "Very long survey question that<br>has to be spelled out completely "

ui <- fluidPage(

    titlePanel("Problems with Plotly"),

    sidebarLayout(
        sidebarPanel(
            radioButtons("tried", "Things I've tried", 
                         c("Adding line breaks" = "breaks", 
                           "Adding 'width' to ggplotly call" = "width", 
                           "Both", 
                           "Neither"), 
                         selected = "Neither")
        ),

        mainPanel(

            fluidRow(

                column(6, HTML("Some content goes on this side")), 

                column(6, plotlyOutput("plot"))

            )

        )
    )
)

server <- function(input, output) {

    output$plot <- renderPlotly({

        df <- tibble(
            Label = paste0(ifelse(input$tried %in% c("breaks", "Both"), 
                                  label_break, label), 1:5), 
            Value = sample(5:10, 5, replace = TRUE)
        )

        p <- ggplot(df, aes(Label, Value)) + 
            geom_col() + 
            coord_flip() +
            labs(x = "")

        if (input$tried %in% c("width", "Both")) {
            ggplotly(p, width = 1000)
        } else {
            ggplotly(p)
        }
    })
}

shinyApp(ui = ui, server = server)

标签： rggplot2shinyplotly

解决方案

试试下面的代码 -

library(shiny)
library(plotly)
library(tidyverse)
label <- "Very long survey question that has to be spelled out completely "


ui <- fluidPage(

  titlePanel("Problems with Plotly"),

  sidebarLayout(
    sidebarPanel(
      fluidRow(
      radioButtons("tried", "Things I've tried", 
                   c("Adding line breaks" = "breaks", 
                     "Adding 'width' to ggplotly call" = "width", 
                     "Both", 
                     "Neither"), 
                   selected = "Neither")
    ),

    mainPanel(

      fluidRow(
        column(2,HTML("Some content goes on this side"),plotlyOutput("plot"))



      )

    )
  )
)
)

server <- function(input, output) {

  output$plot <- renderPlotly({

    df <- tibble(
      Label = paste0(label, 1:5), 
      Value = sample(5:10, 5, replace = TRUE)
    )

    p <- ggplot(df, aes(Label, Value)) + 
      geom_col() + 
      coord_flip() +
      labs(x = "") +
      scale_x_discrete(labels = function(x) lapply(strwrap(x, width = 20, simplify = FALSE), paste, collapse="\n"))

      ggplotly(p,width = 1000)
  })
}

shinyApp(ui = ui, server = server)

注意：您可以使用以下代码块调整ggplot's刻度标签-

scale_x_discrete(labels = function(x) lapply(strwrap(x, width = 20, simplify = FALSE), paste, collapse="\n"))

推荐阅读