复选框输入 R shiny。 插入条件

Question

我有以下代码，并且创建了两个复选框输入。

1. 因此，我创建了一个pos变量，它将两个字符串中的一个作为第一个输入。 这行得通。

2. 现在，我想创建一个新变量pll根据我的数据集的两个变量（类型和员工）之一填充图形。 我使用以下代码，但这不起作用。 你有什么主意吗

library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)
library(shinythemes)
library(plotly)
library(ggthemes)
library(lubridate)



data <- data.frame(mitarbeiter = c("AA", "BB", "CC", "DD", "EE", "FF"), 
         art = c("hr", "GG", "TT", "RR", "OO", "OO"),
         creadate = as_date(c("2018-01-03", "2018-01-03", "2018-01-03", "2018-01-03", "2018-01-03", "2018-01-03")))

mitarbeiter1 <- sort(unique(data$mitarbeiter))
art1 <- sort(unique(data$art))

year_month <- function(dates) {
  paste(lubridate::year(dates),
        str_pad(lubridate::month(dates), width = 2, pad = 0),
        sep="-")
}

year_week <- function(dates) {
  paste(lubridate::year(dates),
        str_pad(lubridate::week(dates), width = 2, pad = 0),
        sep="-")
}

year_day <- function(dates) {
  paste(lubridate::year(dates),
        str_pad(lubridate::month(dates), width = 2, pad = 0),
        str_pad(lubridate::day(dates), width = 2, pad = 0),
        sep="-")
}


ui <- fluidPage(
  fluidRow(
    column(4,
           pickerInput("mitarbeiterName", "Name des Mitarbeiters", mitarbeiter1, 
                       options = list(`actions-box` = TRUE), multiple = TRUE),
           pickerInput("artName", "Art", art1, 
                       options = list(`actions-box` = TRUE), multiple = TRUE),
           pickerInput("period", "Zeitraum", c("day", "week", "month", "year"), 
                       options = list(`actions-box` = TRUE)),
           dateRangeInput("date", "Datum auswahlen", start  = "2020-01-01"),
           checkboxInput("kumulativ", "Kumulativ"),
           checkboxInput("tf", "TF"),
           downloadButton("download", "Download")
    ),
    column(8,
           plotlyOutput("policyPlot")
    )
  )
)

server <- function(input, output, session) {
  
  #create a reactive object with a NULL starting value
  listofrows <- reactiveValues(data = NULL)
  
  #observe the changes in inputs and update the reactive object 
  observeEvent(c(input$mitarbeiterName, input$artName, input$date, input$period), {
    req(input$mitarbeiterName)
    req(input$artName)
    req(input$period)
    req(input$date)

    listofrows$data <- subset(data, mitarbeiter %in% input$mitarbeiterName &
                                art %in% input$artName & 
                                creadate >= input$date[1] & creadate <= input$date[2]) 
  }, ignoreInit = T, ignoreNULL = TRUE)
  
  output$policyPlot <- renderPlotly({
    req(listofrows$data)
    req(input$kumulativ)
    
    fn <- switch(
      input$period,
      day = year_day,
      week = year_week,
      month = year_month,
      year = year
    )
    
    pos <- if (input$kumulativ) "dodge" else "identity"
    pll <- if  (input$tf) type else employee

    ggplot(listofrows$data) +
      geom_bar(aes(x = fn(creadate), fill = pll), 
               stat = "count", 
               position = pos,
               show.legend = T) +
      ggtitle("Anzahl erstellte Policen (pro Mitarbeiter)") +
      xlab("Zeitraum") + ylab("Anzahl der Policen")
  })
  
  output$download <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".png", sep = "")
    },
    content = function(file) {
      ggsave(file, plot = output$policyPlot)
    })
}

shinyApp(ui, server)

您知道如何进行这项工作吗？ 谢谢

Answer 1

我注意到的错误：

• 没有反应性session_store的声明
• 缺少对库 plotly 的调用
• 使用aes_string时使用aes而不是 aes_string 变量名存储在变量中，因为这里pll是变量名的字符串

请记住在提出问题时提供可重复的示例，并使用最少的可用数据集。

library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)
library(shinythemes)
library(plotly)


data <- data.frame(employee = c("A", "B", "C", "A", "B", "C"),
                   type = c('1','2','3', '4', '2', '1'),
                   date = c("2020-01-01", "2020-01-02", "2020-01-01", "2020-01-02", "2020-01-02", "2020-01-02"))


ui <- fluidPage(
  fluidRow(
    column(4,
           checkboxInput("cumulative", "Cumulative"),  
           checkboxInput("tf", "TF")
    ),
    column(8,
           plotlyOutput("policyPlot")
    )
  )
)

server <- function(input, output, session) {  
  
  session_store <- reactiveValues()
  
  output$policyPlot <- renderPlotly({
    
    pos <- if (input$cumulative) "stack" else "dodge"
    pll <- if  (input$tf) 'type' else 'employee'

    # make a ggplot graph
    g <- ggplot(data) +
      geom_bar(aes_string('date', fill = pll), 
               stat = "count", 
               position = pos,
               show.legend = T)
    
    # convert the graph to plotly graph and put it in session store
    session_store$plt <- ggplotly(g)
    
    # render plotly graph
    session_store$plt
  })
}

shinyApp(ui, server)