Question

我是Shiny的新手，对我的图形和表格的响应性有疑问。

我的merged数据集由两个变量（长度和大小）组成，每个变量具有两个不同的类别：Length可以是Large或Small或和{ {1}}可以是Size或Long。还有两个不同的单位：short和Volume中的单位。我想用一个图形创建一个应用，其中Count或Length会显示在Size或Volume中。

当我仅使用部分Count数据集（即下面的merged或data1数据集来简化此任务时，一切正常，因为我只有一个{{1} }（选择data2）。

以下是有效的伪代码，其中仅使用selectInput()：

Category

当尝试使用data1数据集而不是data1 <- data.frame(variable = rep("Size", 24), category = rep(c("Large","Small"), each = 12), unit = rep(c("Volume", "Count"), each = 6), date = rep(c("Jan 2000", "Feb 2000", "Mar 2000", "Apr 2000", "May 2000", "Jun 2000"), times = 2), quantity = c(0.9,2,3.1,3.7,4.7,5.9,106.6,207.3,329,450.6,513.3,610,6.5,9.2,10,10.8,10.7,13.6,802.6,765.3,996,1076.6,1151.3,1196)) data1$date <- as.yearmon(paste(data1$date),"%b %Y") data2 <- data.frame(variable = rep("Length", 24), category = rep(c("Long","Short"), each = 12), unit = rep(c("Volume", "Count"), each = 6), date = rep(c("Jan 2000", "Feb 2000", "Mar 2000", "Apr 2000", "May 2000", "Jun 2000"), times = 2), quantity = c(1.8,6.8,4.3,1.6,8.4,11.8,362.4,290.2,148,811,1026.6,2074,9.1,4.1,18,21.6,36.3,19,361.1,1377.5,1992,3660.4,1611.8,538.2)) data1$date <- as.yearmon(paste(data1$date),"%b %Y") merged <- rbind(data1, data2) # Define UI for application that draws time-series ui <- fluidPage( # Application title titlePanel("Dummy shiny"), # Create filters fluidRow( column(4, selectInput("unit", label = h4("Display the dummy data in:"), unique(as.character(data1$unit))) ), column(4, sliderInput("date", label = h4("Select time range:"), 2000, 2000.5, value = c(2000, 2000.5), step = 0.1) ) ), # Create a new row for the graph or the table (one in each tab) tabsetPanel( tabPanel("Graphical view", plotOutput("distPlot")), tabPanel("Data", dataTableOutput("distTable"))) ) # Define server logic required to draw the wanted time-series server <- function(input, output) { dataInput <- reactive({ data1[data1$unit==input$unit,] }) output$distPlot <- renderPlot({ ggplot(dataInput(), aes(x = date, y = quantity, fill = category)) + geom_area(position = "stack") + xlab("") + ylab("") + scale_x_continuous(limits = input$date, expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) }) output$distTable <- renderDataTable({ dataInput() }, extensions = "Buttons", options = list( scrollY = "300px", pageLength = 10, scrollX = TRUE, dom = "Bftsp", buttons = c("copy", "csv", "excel")) ) } # Run the application shinyApp(ui = ui, server = server)数据集时，我需要添加另一个merged（以选择data1），但是当运行代码。

在上面的代码中，我只是在selectInput()中添加了该位：

Variable

，将fluidRow()位替换为：

column(4,
           selectInput("var", label = h4("Choose variable to display:"), 
                       unique(as.character(merged$variable)))
    )

它说“缺少需要TRUE / FALSE的值”。您是否知道为什么以及如何解决这个问题？

我还有另外两个问题，这些问题不那么令人讨厌：

有没有办法确保表格也响应时间范围？
是否可以将日期保留为“％b％Y”而不是表格中的分数？

非常感谢您的帮助。

Answer 1

好吧，经过一个不眠之夜，我实际上找到了一个解决方案，这主要归功于@deanattali的出色教程，网址为https://deanattali.com/blog/building-shiny-apps-tutorial/。

问题与我以前对数据进行子集的方式有关。这是完整的工作代码：

library(shiny)
library(DT)
library(zoo)
library(ggplot2)
library(dplyr)
data1 <- data.frame(variable = rep("Size", 24), category = rep(c("Large","Small"), each = 12), unit = rep(c("Volume", "Count"), each = 6), date = rep(c("Jan 2000", "Feb 2000", "Mar 2000", "Apr 2000", "May 2000", "Jun 2000"), times = 2), quantity = c(0.9,2,3.1,3.7,4.7,5.9,106.6,207.3,329,450.6,513.3,610,6.5,9.2,10,10.8,10.7,13.6,802.6,765.3,996,1076.6,1151.3,1196))
data2 <- data.frame(variable = rep("Length", 24), category = rep(c("Long","Short"), each = 12), unit = rep(c("Volume", "Count"), each = 6), date = rep(c("Jan 2000", "Feb 2000", "Mar 2000", "Apr 2000", "May 2000", "Jun 2000"), times = 2), quantity = c(1.8,6.8,4.3,1.6,8.4,11.8,362.4,290.2,148,811,1026.6,2074,9.1,4.1,18,21.6,36.3,19,361.1,1377.5,1992,3660.4,1611.8,538.2))
merged <- rbind(data1, data2)
merged$date <- as.yearmon(paste(merged$date),"%b %Y")

# Define UI for application that draws time-series
ui <- fluidPage(

  # Application title
  titlePanel("Dummy shiny"),

  # Create filters 
  fluidRow(
    column(4,
           selectInput("variableInput", label = h4("Display the dummy data in:"), 
                       unique(merged$variable))),
    column(4,
           selectInput("unitInput", label = h4("Display the dummy data in:"), 
                       unique(merged$unit))),
    column(4,
           sliderInput("dateInput", label = h4("Select time range:"),
                       2000, 2000.5, value = c(2000, 2000.5), step = 0.1)
    )
  ),
  # Create a new row for the graph or the table (one in each tab)
  tabsetPanel(
    tabPanel("Graphical view", plotOutput("distPlot")),
    tabPanel("Data", dataTableOutput("distTable")))
)

# Define server logic required to draw the wanted time-series
server <- function(input, output) {
  filtered <- reactive({
    merged %>%
      filter(variable == input$variableInput,
             unit == input$unitInput,
             date >= input$dateInput[1],
             date <= input$dateInput[2]
    )%>%
    select(-c(1,3))
})
  })
  output$distPlot <- renderPlot({
    ggplot(filtered(), aes(x = date, y = quantity, fill = category)) +
      geom_area(position = "stack") +
      xlab("") + ylab("") +
      scale_x_continuous(limits = input$date, expand = c(0, 0)) +
      scale_y_continuous(expand = c(0, 0))
  })
  output$distTable <- renderDataTable({
    filtered()
  },
  extensions = "Buttons",
  options = list(
    scrollY = "300px", pageLength = 10, scrollX = TRUE, dom = "Bftsp",
    buttons = c("copy", "csv", "excel"))
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

将图形和表格链接到多个输入的问题

1 个答案: