Unresponsive slider | 易学教程

问题

I have some data below and I would like to create sliders for years and months. I have a column with both the year and month. Also, I am new to shiny so this is quite new to me. Here’s what I tried:

stack_qn <- structure(list(Date = c("2012-01", "2012-02", "2012-03", "2012-04", 
"2012-05", "2012-06", "2012-07", "2012-08", "2012-09", "2012-10", 
"2012-11", "2012-12", "2013-01", "2013-02", "2013-03", "2013-04", 
"2013-05", "2013-06", "2013-07", "2013-08", "2013-09", "2013-10", 
"2013-11", "2013-12", "2014-01", "2014-02", "2014-03", "2014-04", 
"2014-05", "2014-06", "2014-07", "2014-08", "2014-09", "2014-10", 
"2014-11", "2014-12", "2015-01", "2015-02", "2015-03", "2015-04", 
"2015-05", "2015-06", "2015-07", "2015-08", "2015-09", "2015-10", 
"2015-11", "2015-12", "2016-01", "2016-02", "2016-03", "2016-04", 
"2016-05", "2016-06", "2016-07", "2016-08", "2016-09", "2016-10", 
"2016-11", "2016-12", "2017-01", "2017-02", "2017-03", "2017-04", 
"2017-05", "2017-06", "2017-07", "2017-08", "2017-09", "2017-10", 
"2017-11", "2017-12"), B1 = c(125321974.63, 100231854.71, 388896041.92, 
190934450.65, 370701439.73, 270937291.19, 445647533.17, 286589619.6, 
390812514.59, 132726027.2, 189174990.8, 221587942.16, 183697165, 
160243660, 259351959, 288779972, 182312633, 178447575.39, 492044831, 
368031328, 677703325, 606829743, 389812559, 269243649, 188087050, 
218826099, 175163254, 355028760, 275705763, 293392216, 257952043, 
292130900, 457891219.26, 440345562.84, 383374430, 367544110, 
294646428.3, 350952972, 442595955, 312195436, 279342075, 633343091, 
451257868, 695746740, 674081332, 512643519, 347660743, 427185462, 
447023815, 308143373, 346575478, 403853718, 288662321, 363973548, 
531566733, 176373682, 136480503, 104530230, 137824430, 61257829, 
196606956, 130958505, 198574118, 138035136.27, 83628347, 143166961, 
79492942, 58885958, 202109934, 433994669, 247630743, 392612864
)), row.names = c(NA, -72L), groups = structure(list(Date = structure(c(15340, 
15371, 15400, 15431, 15461, 15492, 15522, 15553, 15584, 15614, 
15645, 15675, 15706, 15737, 15765, 15796, 15826, 15857, 15887, 
15918, 15949, 15979, 16010, 16040, 16071, 16102, 16130, 16161, 
16191, 16222, 16252, 16283, 16314, 16344, 16375, 16405, 16436, 
16467, 16495, 16526, 16556, 16587, 16617, 16648, 16679, 16709, 
16740, 16770, 16801, 16832, 16861, 16892, 16922, 16953, 16983, 
17014, 17045, 17075, 17106, 17136, 17167, 17198, 17226, 17257, 
17287, 17318, 17348, 17379, 17410, 17440, 17471, 17501), class = "Date"), 
    .rows = list(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
        12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 
        23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 
        34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 
        45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 
        56L, 57L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 
        67L, 68L, 69L, 70L, 71L, 72L)), row.names = c(NA, -72L
), class = c("tbl_df", "tbl", "data.frame"), .drop = FALSE), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"))

#App
library(shiny)
library(shinydashboard)
library(dplyr)
library(scales)
library(DT)


#Declaring the UI
ui <- fluidPage(
    titlePanel("Slider Test"),
    fluidRow(
        column(4,
               sliderInput("range", "Select Years",
                           min = 2012, max = 2017,
                           value = c(min,max) )),
        column(4,
               sliderInput("range", "Select Months",
                           min = 1, max = 12,
                           value = c(min,max) ))

    ),

    # Create a new row for the table.
    fluidRow(
        DT::dataTableOutput("table")
    )
)

#Declaring the Server
server <- function(input, output) {
    output$table <- DT::renderDataTable(DT::datatable({
        stack_qn[stack_qn$Date >= input$range[1] & stack_qn$Date <= input$range[2],]
    }))
    output$table <- DT::renderDataTable(DT::datatable({
        stack_qn[stack_qn$Date >= input$range[1] & stack_qn$Date <= input$range[2],]
    }))

}
shinyApp(ui, server)

The issue is that only the years are responsive but the months don’t change when I move the slider. What am I doing wrong?

回答1:

You cannot give both sliders the same id. In addition, you should add a leading 0 to your months before 10. I used sprintf for that.

If I understand you correctly you want to your month filter to affect all the years. If you don't want that you should change the script in your renderDataTable to:

stack_qn[stack_qn$Date >= paste0(input$yearrange[1], '-', sprintf("%02d",  input$monthrange[1])) & stack_qn$Date <= paste0(input$yearrange[2], '-', sprintf("%02d",  input$monthrange[2])),]

Working example

library(shiny)
library(shinydashboard)
library(dplyr)
library(scales)
library(DT)


#Declaring the UI
ui <- fluidPage(
  titlePanel("Slider Test"),
  fluidRow(
    column(4,
           sliderInput("yearrange", "Select Years",
                       min = 2012, max = 2017,
                       value = c(min,max) )),
    column(4,
           sliderInput("monthrange", "Select Months",
                       min = 1, max = 12,
                       value = c(min,max) ))

  ),

  # Create a new row for the table.
  fluidRow(
    DT::dataTableOutput("table")
  )
)

#Declaring the Server
server <- function(input, output) {
  output$table <- DT::renderDataTable(DT::datatable({
    year_table = stack_qn[stack_qn$Date >= input$yearrange[1] & stack_qn$Date <= input$yearrange[2]+1,]
    year_table[unlist(str_split(year_table$Date, '-'))[c(F,T)] >= sprintf("%02d",  input$monthrange[1]) & unlist(str_split(year_table$Date, '-'))[c(F,T)] <= sprintf("%02d",  input$monthrange[2]),]
  }))
}

shinyApp(ui, server)

来源：https://stackoverflow.com/questions/56988083/unresponsive-slider

标签

Shiny