R语言 使用两个闪亮输入在闪亮中过滤DT输出

qni6mghb  于 2023-04-27  发布在  其他
关注(0)|答案(1)|浏览(128)

下面是我的闪亮代码。我希望DT根据selectinputdaterange输入进行过滤。我已经尝试了solution,但它不起作用。
下面是Shiny应用程序代码

library(shiny)

DF = data.frame(ID = c ("1","2","3","4","5"),
                product = c("A","B","C","A","C"),
                sentiment = c("good","medium","bad","medium","bad"),
                online = c(1,0,1,1,0),
                ooh = c(0,1,0,1,1),
                Date= c("2020-08-11", "2020-09-16","2021-10-20", "2020-11-25", "2022-11-27"), 
                event = c(1,1,0,0,0))

Year <- c(2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010)
Auckland <- c(1760, 1549, 1388, 1967, 1326, 1765, 1814, 1693, 1502, 1751)
Wellington <- c(2176, 3154, 1138, 1196, 2132, 3176, 4181, 5169, 3150, 4175)
Lyttelton <- c(2176, 3154, 1138, 1196, 2132, 3176, 4181, 5169, 3150, 4175)
my_data <- as.data.frame(cbind(Year,Auckland,Wellington, Lyttelton))


# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Product Sentiment"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      selectInput("sentiment", label = "Select sentiment", choices = unique(DF$sentiment)), 
      dateRangeInput("daterange", h5("Date range"), 
                     start = ymd("2020-08-11"), 
                     end = ymd("2022-09-06"), 
                     min = min(DF$Date), 
                     max = max(DF$Date),
                     format = "yyyy-mm-dd"
      ) 
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      dataTableOutput("DT_Table")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  # output$DT_Table <- renderDT({ 
  #   DF[DF$sentiment==input$sentiment,]
  #   
  # })   
  
  output$DT_Table <- DT::renderDataTable(
    dt <- DF[DF$Date >= input$daterange[1] & DF$Date <= input$daterange[2],],
    dt[,c("sentiment",input$sentiment)],
    options = list(pageLength = 5, autoWidth = TRUE, dom='t')
  )
  
}

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

如何在shiny中的DT上应用上述过滤器?

kzmpq1sx

kzmpq1sx1#

更改服务器部件:
我们可以创建React式表达式来过滤输入值的数据。然后我们在renderDataTable中使用React式表达式:

library(shiny)
library(lubridate)
library(DT)

DF = data.frame(ID = c ("1","2","3","4","5"),
                product = c("A","B","C","A","C"),
                sentiment = c("good","medium","bad","medium","bad"),
                online = c(1,0,1,1,0),
                ooh = c(0,1,0,1,1),
                Date= c("2020-08-11", "2020-09-16","2021-10-20", "2020-11-25", "2022-11-27"), 
                event = c(1,1,0,0,0))

Year <- c(2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010)
Auckland <- c(1760, 1549, 1388, 1967, 1326, 1765, 1814, 1693, 1502, 1751)
Wellington <- c(2176, 3154, 1138, 1196, 2132, 3176, 4181, 5169, 3150, 4175)
Lyttelton <- c(2176, 3154, 1138, 1196, 2132, 3176, 4181, 5169, 3150, 4175)
my_data <- as.data.frame(cbind(Year,Auckland,Wellington, Lyttelton))


# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Product Sentiment"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      selectInput("sentiment", label = "Select sentiment", choices = unique(DF$sentiment)), 
      dateRangeInput("daterange", h5("Date range"), 
                     start = ymd("2020-08-11"), 
                     end = ymd("2022-09-06"), 
                     min = min(DF$Date), 
                     max = max(DF$Date),
                     format = "yyyy-mm-dd"
      ) 
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      dataTableOutput("DT_Table")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  filtered_data <- reactive({
    DF %>%
      filter(sentiment == input$sentiment |
               (Date >= input$daterange[1] & Date <= input$daterange[2]))
  })
  
  output$DT_Table <- DT::renderDataTable(
    filtered_data(),
    options = list(pageLength = 5, autoWidth = TRUE, dom='t')
  )
  
}

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

相关问题