Question

我下面有一些数据，我想创建几年和几个月的滑块。我有一个年份和月份的专栏。另外，我是闪亮的新手，所以这对我来说是相当新的。这是我尝试过的：

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)

问题在于，当我移动滑块时，只有年份可以响应，而月份却没有变化。我在做什么错了？

Answer 1

您不能给两个滑块相同的id。另外，您应该在10之前的几个月中添加前导0。为此，我使用了sprintf。

如果我对您的理解正确，那么您希望您的月份过滤器影响所有年份。如果您不希望将renderDataTable中的脚本更改为：

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])),]

工作示例

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)

无响应的滑块

1 个答案: