Question

我正在尝试编写一个Shiny-App并接近解决方案，我想达成。但是，有一些问题，我无法解决......

if(!require(shiny)){
  install.packages("shiny")
  require(shiny)
}

if(!require(tidyverse)){
install.packages("tidyverse")
require(tidyverse)
}

if(!require(readxl)){
  install.packages("readxl")
  require(readxl)
}

if(!require(lubridate)){
  install.packages("lubridate")
  require(lubridate)
}

prodpromonat <- tibble(prodmonat = c("2008-01-01", "2008-02-01", "2008-03-01", "2008-04-01", "2008-05-01", "2008-06-01", "2008-07-01", "2008-08-01"),
                   n = c("3216", "3268", "2398", "2987", "4003", "3103", "3064", "2786"))

prodpromonat$prodmonat <- as.Date(prodpromonat$prodmonat)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput(
        "zeitraum",
        "Produktionszeitraum",
        min = min(prodpromonat$prodmonat),
        max = max(prodpromonat$prodmonat),
        value = c(max(prodpromonat$prodmonat)-90, max(prodpromonat$prodmonat))
  ),

    fluidRow(
      radioButtons(
        "farbschema",
        "Farbschema",
        choices = c("Einfarbig", "Zweifarbig"),
        selected = "Einfarbig"
      )
    ),

    fluidRow(
      uiOutput("farbwahl")
    )
    ),

  mainPanel(
    tabsetPanel(
      tabPanel(
        title = "Produktionsmenge" ,
        plotOutput(
          outputId = "produktionsmenge"
        )
      )
  )
  )
))

server <- function(input, output, session){

  farbeninput <- reactive({
    switch(input$farbschema,
       "Zweifarbig" = c(input$farbe1, input$farbe2),
       "Einfarbig" = c(input$farbe1, input$farbe1)
    )
  })

  filter_produktionsmenge <- reactive({
    min <- filter(prodpromonat, prodmonat >= floor_date(input$zeitraum[1], "month"))
    max <- filter(prodpromonat, prodmonat <= floor_date(input$zeitraum[2], "month"))
    semi_join(min, max, by = "prodmonat")
  })

  output$farbwahl <- renderUI({
    switch(input$farbschema,
       "Zweifarbig" = tagList(textInput("farbe1", "Farbe 1", value = "#808080"), textInput("farbe2", "Farbe 2", value = "#1E90FF")),
       "Einfarbig" = textInput("farbe1", "Farbe", value = "#808080")
       )
  })

  output$produktionsmenge <- renderPlot({
    ggplot(filter_produktionsmenge(), aes(factor(prodmonat), n)) +
      geom_bar(stat="identity", aes(fill = factor(as.numeric(month(prodmonat) %% 2 == 0)))) + 
      scale_fill_manual(values=rep(farbeninput())) +
      xlab("Produktionsmonat") +
      ylab("Anzahl produzierter Karosserien") + 
      theme(legend.position = "none") 
  })

}

shinyApp(ui, server)

问题＃1：在sliderInput中我提供所选时间跨度内的每一天，而我只想提供现有月份，最好不提供当天的任何提示。我试图打印“％Y-％m”的每个解决方案都会产生错误，所以我坚持了这些日子......

问题＃2：在使用uiOutput之前是否有可能定义颜色矢量？现在它几乎按照我的计划工作，但在渲染的UI完成渲染并显示在侧边栏之前显示错误。我的猜测是，在renderUI完成之前，向量不存在，因为错误显示“手动缩放中的值不足.2需要但只提供0”。所以我想初始化它。同样适用于第一次更改为双色模式。

您对如何解决这些问题有任何想法吗？非常感谢！

干杯！

修改

之前找到问题的解决方案。但是，问题＃1和＃2仍然存在。

*编辑：从代码中删除了一个括号

Answer 1

问题＃1：

将timeFormat = "%Y-%m"添加到sliderInput（已由waskuf回答）

问题＃2：

问题源于一些依赖性问题：

renderPlot取决于farbeninput和filter_produktionsmenge。每次在以下情况下都会渲染图：
- farbeninput更改，
- 修改了滑块，因此通过filter_produktionsmenge重新计算数据。

如果您向每个块添加print语句，您可以看到renderPlot被调用两次，因为farbeninput更改了两次。

[1] "renderUI"
[1] "renderPlot"
[1] "farbeninput"
[1] "renderPlot"
[1] "farbeninput"
[1] "filter_produkt"

为什么会这样？

farbeninput取决于input$farbschema，input$farbe1和input$farbe2。这意味着如果其中任何输入发生变化，将重新计算farbeninput。

更改input$farbschema farbeninput时会再次呈现两次：

因为input$farbschema已更改。
在用户界面中呈现textInput时。

这是导致显示警告的原因！

解决方案

您需要制作farbeninput，以便仅在textInput呈现后进行计算。您可以使用req实现此目的。

例如：如果input$farbschema的值为"Zweifarbig"，并且未呈现input$farbe1或input$farbe2，则会返回NULL值。如果两者都被渲染，则正常返回c(input$farbe1, input$farbe2)。

farbeninput <- reactive({
  switch(input$farbschema,
         "Zweifarbig" = {
           req(input$farbe1)
           req(input$farbe2)
           c(input$farbe1, input$farbe2)
         },
         "Einfarbig" = {
           req(input$farbe1)
           c(input$farbe1, input$farbe1)
         }
  )
})

将req(farbeninput())添加到renderPlot以避免在farbeninput为NULL时进行呈现：

output$produktionsmenge <- renderPlot({
  req(farbeninput())
  ggplot(filter_produktionsmenge(), aes(factor(prodmonat), n)) +
    geom_bar(stat="identity", aes(fill = factor(as.numeric(month(prodmonat) %% 2 == 0)))) + 
    scale_fill_manual(values=rep(farbeninput())) +
    xlab("Produktionsmonat") +
    ylab("Anzahl produzierter Karosserien") + 
    theme(legend.position = "none") 
})

Answer 2

对于问题＃1，您只需将timeFormat参数添加到sliderInput，就像这样

sliderInput(
    "zeitraum",
    "Produktionszeitraum",
    min = min(prodpromonat$prodmonat),
    max = max(prodpromonat$prodmonat),
    timeFormat = "%Y-%m",
    value = c(max(prodpromonat$prodmonat)-90, max(prodpromonat$prodmonat))
  ),

sliderInput和predefine矢量

2 个答案:

问题＃1：

问题＃2：

为什么会这样？

解决方案