R Shiny ggplot 条形图和折线图，具有动态变量选择和 y 轴为百分比

Posted 2023-02-18

【中文标题】R Shiny ggplot 条形图和折线图，具有动态变量选择和 y 轴为百分比

【英文标题】：R Shiny ggplot bar and line charts with dynamic variable selection and y axis to be percentages

【发布时间】：2017-04-25 23:57:36

【问题描述】：

我正在学习 Shiny，并在我正在创建的应用程序上寻求帮助。我正在创建一个应用程序，该应用程序将从用户那里获取动态输入，并且应该生成条形图和折线图。我设法创建了条形图，但生成的结果不正确。

我正在寻找的是在行中选择的变量应该是我的 x 轴和 y 轴应该是 百分比。比例为 100%。列变量应该是用于比较的变量，为此我使用position = "dodge"。我的数据很大，我创建了一个示例数据来描述这种情况。由于实际数据采用 data.table 格式，因此我将示例数据存储为 data.table。由于我不确定如何包含这些不是文件格式的数据，所以我先创建它，使其位于 R 环境中，然后运行应用程序 -

    Location <- sample(1:5,100,replace = T)
    Brand <- sample(1:3,100,replace = T)
    Year <- rep(c("Year 2014","Year 2015"),50)
    Q1 <- sample(1:5,100,replace = T)
    Q2 <- sample(1:5,100,replace = T)

    mydata <- as.data.table(cbind(Location,Brand,Year,Q1,Q2))

下面是我正在使用的 Shiny 代码 -

library("shiny")
library("ggplot2")
library("scales")
library("data.table")
library("plotly")

ui <- shinyUI(fluidPage(
  sidebarPanel(
    fluidRow(
      column(10,
             div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", ''))
      ),
      tags$br(),
      tags$br(),
      column(10,
             div(style = "font-size: 13px;", selectInput("columnvar", "Select Column Variable", ''))
      ))

  ),
  tabPanel("First Page"),
  mainPanel(tabsetPanel(id='charts',
                        tabPanel("charts",tags$b(tags$br("Graphical Output" )),tags$br(),plotlyOutput("plot1"))
  )
  )
))

server <- shinyServer(function(input, output,session)
  updateTabsetPanel(session = session
                    ,inputId = 'myTabs')


  observe(
    updateSelectInput(session, "rowvar", choices = (as.character(colnames(mydata))),selected = "mpg")
  )

  observe(
    updateSelectInput(session, "columnvar", choices = (as.character(colnames(mydata))),selected = "cyl")
  )

  output$plot1 <- renderPlotly(
    validate(need(input$rowvar,''),
             need(input$columnvar,''))
    ggplot(mydata, aes(x= get(input$rowvar))) + 
      geom_bar(aes(y = ..prop.., fill = get(input$columnvar)), position = "dodge", stat="count") +
      geom_text(aes( label = scales::percent(..prop..),
                     y= ..prop.. ), stat= "count", vjust = -.5) +
      labs(y = "Percent", fill=input$rowvar) +
      scale_y_continuous(labels=percent,limits = c(0,1))

  )

)

shinyApp(ui = ui, server = server)

如果你看到问题是-

所有条形均为 100%。比例计算不正确。不知道哪里出错了。

如果我尝试使用 group 参数，它会给我错误提示“未找到输入”变量。我尝试将群组设为group = get(input$columnvar)

我认为我需要为折线图重构我的数据。您能否帮助我如何动态重组 data.table 然后重新用于折线图。如何生成与折线图相同的条形图。

我正在使用 renderplotly，以便我使用 plotly 的功能来显示鼠标移动/缩放等的百分比。但是我可以在鼠标移动时看到 input$variable。我怎样才能摆脱它并拥有正确的名字。

已尝试详细说明情况。请提出一些解决方案。

谢谢！！

【问题讨论】：

我没有完整的答案，但对于 1。也许在您的 geom_bar 中使用 y = (..count..)/sum(..count..) 而不是 y = ..prop .. 和 4. 在 ggplot(mydata, aes(x= get(input$rowvar))) 中使用 ggplot(mydata, aes_string(x= input$rowvar));并在 geom_text() 中替换为 geom_text(aes( label = (..count..)/sum(..count..)*100, ..

@MLavoie，感谢您的建议，但是当我将 ..prop.. 替换为 (..count..)/sum(..count..) 时，我开始收到错误，因为找不到对象“计数”。不确定您是否也会遇到同样的错误

不，我没有收到此错误。这就是我使用 geom_bar(aes(y = (..count..)/sum(..count..), fill = get(input$columnvar)), position = "dodge", stat="count")

@MLavoie，它奏效了，我一直在尝试多种方法来解决这个问题，似乎已将代码更新为stat = "identity"，这导致了该错误。我把它改回stat = "count"，现在我没有收到错误，但是生成的图没有显示正确的百分比。我的意思是 2014 年所有条的添加应该是 100%，而 2015 年应该是 100%。目前不确定如何计算条形高度。我正在使用prop.table(table(mydata$Brand,mydata$Year),2) 生成的表格检查条形高度。你知道如何纠正这个问题吗？

100% 是所有柱的总和

【参考方案1】：

要正确分组变量以进行绘图，geom_bar 要求 x 值是数字，fill 值是因子，或者参数 group 用于明确指定分组变量。但是，plotly 在使用 group 时会引发错误。下面的方法将x 变量转换为integer，将fill 变量转换为factor，以便它们被正确分组。这保留了使用geom_bar 来计算百分比。

不过，首先，我想知道mydata 是否指定正确。鉴于数据是字符和整数的混合，cbind(Location, Brand, Year, Q1, Q2) 给出了一个字符矩阵，然后将其转换为一个data.table，其中所有变量都是字符模式。在下面的代码中，我将 mydata 直接定义为 data.table，但已将 Q1 转换为字符模式，以便 mydata 包含字符和数字的混合。

下面使用的方法是创建一个新的数据框plotdata，其中包含x 和fill 数据。如有必要，x 数据将转换为数字，首先将其设为因子变量，然后使用 unclass 获取因子整数代码。 fill 数据转换为因子。然后使用plotdata 生成ggplot 绘图，然后使用plotly 显示该绘图。该代码包括一些其他修改以改善图表的外观。

编辑

以下代码已更新，可在其栏下方显示行变量的名称。此外，仅当鼠标指针悬停在条形上方时，才会显示每个条形的百分比和计数。

 library("shiny")
  library("ggplot2")
  library("scales")
  library(plotly)
  library(data.table)

  Location <- sample(1:5,100,replace = T)
  Brand <- sample(1:3,100,replace = T)
  Year <- rep(c("Year 2014","Year 2015"),50)
  Q1 <- sample(1:5,100,replace = T)
  Q2 <- sample(1:5,100,replace = T)
  Q3 <- sample(seq(1,3,.5), 100, replace=T)
  mydata <- data.table(Location,Brand,Year,Q1,Q2, Q3)
#
# convert Q1 to character for demonstation purposes  
#
    mydata$Q1 <- as.character(mydata$Q1)

  ui <- shinyUI(fluidPage(
    sidebarPanel(
      fluidRow(
        column(10,
               div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", 
                                                           choices=colnames(mydata)))),
        tags$br(),
        tags$br(),
        column(10,
               div(style = "font-size: 13px;", selectInput("columnvar", label="Select Column Variable", 
                                                           choices=colnames(mydata))))
        )
    ),
    tabPanel("First Page"),
    mainPanel(tabsetPanel(id='charts',
                          tabPanel("charts",tags$b(tags$br("Graphical Output" )),tags$br(),plotlyOutput("plot1"))
    )
    )
  ))
  server <- shinyServer(function(input, output,session)
    updateTabsetPanel(session = session
                      ,inputId = 'myTabs')
    observe(
      updateSelectInput(session, "rowvar", choices = colnames(mydata), selected=colnames(mydata)[1])
    )
    observe(
      updateSelectInput(session, "columnvar", choices = colnames(mydata), selected=colnames(mydata)[2])
    )
    output$plot1 <- renderPlotly(
#
#   create data frame for plotting containing x variables as integer and fill variables as factors
#   
      if(is.numeric(get(input$rowvar)))  
        rowvar_brks <- sort(unique(get(input$rowvar)))
        rowvar_lbls <- as.character(rowvar_brks)
        plotdata <- data.frame(get(input$rowvar), factor(get(input$columnvar)) )
      
      else 
        rowvar_factors <- factor(get(input$rowvar))
        rowvar_brks <- 1:nlevels(rowvar_factors)
        rowvar_lbls <- levels(rowvar_factors)
        plotdata <- data.frame(unclass(rowvar_factors), factor(get(input$columnvar)) )
      
      colnames(plotdata) <- c(input$rowvar, input$columnvar)
      validate(need(input$rowvar,''),
               need(input$columnvar,''))
      col_width <- .85*mean(diff(rowvar_brks))
      sp <- ggplot(plotdata, aes_(x = as.name(input$rowvar), fill = as.name(input$columnvar))) +
        geom_bar( aes(y= ..prop..), stat="count", position=position_dodge(width=col_width)) +
        geom_text(aes( label = paste(scales::percent(..prop..),"<br>", "count:",..count..,"<br>"),  y= ..prop.. + .01),
                  stat= "count", position=position_dodge(width=col_width), size=3, alpha=0) +
        labs(x= input$rowvar, y = "Percent", fill=input$columnvar) +
        scale_y_continuous(labels=percent) +
        scale_x_continuous(breaks=rowvar_brks, labels=rowvar_lbls)
        ggplotly(sp, tooltip="none")
      )
  )

  shinyApp(ui = ui, server = server)

【讨论】：

感谢您的详细解释。这真的很有帮助。我设法复制了代码。然而，正如上面提到的数据是样本，我的实际数据有很多变量，其中大部分我已经转换为保留标签的因子，所以当我绘制图表时，我会在 Shiny 中自动显示标签。这段代码解决了百分比计算的问题，但我失去了标签。如何将所有因子变量的标签保留在 x 轴中。

如果一个变量有很多代码，百分比会变得混乱并破坏图表的外观。我不能在评论中粘贴图片，希望你明白我的意思。例如，我在 x 轴上有一个包含 20 个代码的变量，并且图表中的百分比杂乱无章。我们可以更新工具提示以显示计数+百分比并从条形顶部删除百分比吗？再次感谢 Walts，希望您能帮助我解决这些问题。

@WaltS，在这种情况下，我相信需要重组折线图的数据？您能否提供一些有关如何完成的示例。还有计数和百分比的工具提示似乎很有趣......

@Prasad。我认为编辑后的代码解决了您 cmets 中的项目。

@Walts，非常感谢！！这是在示例代码的环境中工作，但是当我尝试在我的实际应用程序中复制它时，找不到错误对象“（变量名）”......我觉得它无法引用数据.....不知道我哪里出错了。唯一的区别是，在我的实际应用程序中，我要求用户提供 csv 数据，然后我使用 actionbutton 重新格式化 observeEvent(..data Reformating..rendertable..renderplot..) 中的数据....我所有的表格输出和绘图都在这个 observeEvent 中.....这不是做范围界定的正确方法吗？