如何根据数据设置 dateRangeInput？

Question

我正在尝试设置一个相对基本的闪亮应用程序，我有一个包含日期列 (DF$Date) 的数据框，我想：(1) 设置 dateRangeInput 以获得最小值和最大值DF$Date (2) tableOutput 应该只打印选择的日期范围。 这是我正在使用的代码：

UI.R

library(shiny)
library(shinydashboard)
library(plyr)
library(reshape2)

#library(data.table)

shinyUI(pageWithSidebar(
  headerPanel("CSV Viewer"),
  sidebarPanel(
    fileInput('file1', 'Choose CSV File',
              accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
    tags$hr(),

    checkboxGroupInput("inCheckboxGroup",
                       "Checkbox group input:",
                       choices = NULL
                       ),
    actionButton("oui","Affichage"),
    actionButton("non","Clear"),
    numericInput("act1", "afficher les dernieres lignes:",10),

    uiOutput("choose_columns"),
    uiOutput("date")

  ),

  mainPanel(
   uiOutput("dates"),
    tableOutput('contents'),

    verbatimTextOutput('mean')

  )
))

服务器.UI

shinyServer(function(input, output,session) {
  dsnames <- c()
  ######### essai date ###############

  ################### 
  output$dates <- renderUI({
  inFile <- input$file1

  if (is.null(inFile))
    return(NULL)
  dates <- as.Date(data_set()$Date,origin="2002-10-01", format = "%d %b %y")
  minval <- min(dates)
  maxval <- max(dates)
  dateRangeInput('expDateRange', label = "Choose experiment time-frame:",
                 start = minval, end = maxval, 
                 min = minval, max = maxval,
                 separator = " - ", format = "yyyy-mm-dd",
                 language = 'cz', weekstart = 1)


})##################################


  ####################################
  data_set <- reactive({
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    data_set<-data.frame(tail(read.csv(inFile$datapath, header = TRUE, sep = ";", dec = ","), n=input$act1))
    data_set
  })

  ###########ici observe contents []###################
  observe({if(input$oui)
    output$contents <- renderTable({
      inFile <- input$file1

      if (is.null(inFile))
        return(NULL) 
     format( data_set()[, input$inCheckboxGroup], nsmall=5)

    })
  })
  observe(if(input$non) output$contents<- renderTable(NULL))
  #############################################
  output$mean<-renderPrint({
    inFile <- input$file1

    if (is.null(inFile))
      return("choisissez le fichier et decocher la date")
    inFile <- input$file1

    data<- data_set()[, input$inCheckboxGroup]
    a<-colMeans(data[,which(sapply(data, class) != "Date")])
   moyenne<-round(a*100,5)
    data.frame(moyenne)
  })


    observe({
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    updateCheckboxGroupInput(session, "inCheckboxGroup",
                             label = "Check Box Group",
                             choices = cb_options,
                             selected = cb_options)

  })


  output$choose_dataset <- renderUI({
    selectInput("dataset", "Data set", as.list(data_sets))
  })

  # Check boxes

  output$choose_columns <- renderUI({
    # If missing input, return to avoid error later in function
    if(is.null(input$data_set))
      return()

    # Get the data set with the appropriate name

    colnames <- names(contents)

    # Create the checkboxes and select them all by default

     checkboxGroupInput("columns", "Choose columns", 
                        choices  = colnames,
                        selected = colnames)

  })


})

我正在使用的数据：

Date          VL         s         d     performance

28/12/2015  1082,71     3,67    0,0005  -0,0002
04/01/2016  1081,78     3,67    0,0005  0.0007
08/01/2016  1082,27     4,03    0,0031  0,0008
15/01/2016  1082,76     4,06    0,0013  0,0009
22/01/2016  1086,08     4,41    0,0042  0,0014
29/01/2016  1087,5      4,58    0,0016  0,0015
05/02/2016  1092,02     5,81    0,003   0,0016
12/02/2016  1093,8      6,6     0,006   0,0021
19/02/2016  1097,05      6      0,0016  0,0021
26/02/2016  1103,63     5,02    0,0019  0,0021
04/03/2016  1105,35     4,79    0,0024  0,0021
11/03/2016  1107,45     3,36    0,0074  0,0025
18/03/2016  1110,16     4,83    0,0112  0,0031

任何提示都可能有用，请让我卡住。谢谢。

Answer 1

由于时间限制，我无法如我所愿地详细说明我的答案。无论如何，我希望这个例子会有所帮助

---

# Create a dataframe with 30 days and 30 observations

# Convert Sys.time to Date class
days <- seq(as.Date(Sys.time()), by = "day", length.out = 30)

# convert days to characters
df <- data.frame(days = as.character(days), obs = seq_along(days))

library(shiny)


ui <- shinyUI(bootstrapPage(
  dateRangeInput("date", "Date", weekstart = 1, 
                 start = days[1], end = days[length(days)]),
  tableOutput("table")
)
)


# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {

  output$table <- renderTable({

    min <- as.character(input$date[1])
    max <- as.character(input$date[2])

    # convert characters temporary to the date for subsetting
    df[as.Date(df$days) >= min & as.Date(df$days) <= max, ]
  })

})

shinyApp(ui = ui, server = server)

---

更新

我做了一些改动：

1) 变量 Date 现在被强制转换为 data_set 中的日期类

data_set <- reactive({ ... })

2) 那么在output$dates 内你只需要dates <- data_set()$Date

output$dates <- renderUI({ ... })

3) 最后，要使 tableOutput 对 dateRangeInput 和 checkboxGroupInput 产生反应，您必须在观察者中进行以下子集化：

observe({
    if(input$oui) { 
      output$contents <- renderTable({
        inFile <- input$file1

        if (is.null(inFile))
          return(NULL) 

        # Changes
        min <- as.character(input$expDateRange[1])
        max <- as.character(input$expDateRange[2])
        df <- data_set()

        df <- df[as.Date(df$Date) >= min & as.Date(df$Date) <= max,input$inCheckboxGroup]
        format(df, nsmall=5)
      })
    }
  })

---

完整代码：

library(shiny)
library(shinydashboard)
library(plyr)
library(reshape2)


server <- shinyServer(function(input, output,session) {
  dsnames <- c()
  ######### essai date ###############

  ################### 
  output$dates <- renderUI({
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    # data_set()$Date is now a date 
    dates <- data_set()$Date
    minval <- min(dates)
    maxval <- max(dates)
    dateRangeInput('expDateRange', label = "Choose experiment time-frame:",
                   start = minval, end = maxval, 
                   min = minval, max = maxval,
                   separator = " - ", format = "yyyy-mm-dd",
                   language = 'cz', weekstart = 1)


  })##################################


  ####################################
  data_set <- reactive({
    inFile <- input$file1

    if (is.null(inFile))
      return(NULL)

    data_set<-data.frame(tail(read.csv(inFile$datapath, header = TRUE, sep = ";", dec = ","), n=input$act1))
    # coerce variable Date to the date class
    data_set$Date <- as.Date(data_set$Date,origin="2002-10-01", format = "%d/%m/%y")
    data_set
  })

  ###########ici observe contents []###################

  observe({
    if(input$oui) { 
      output$contents <- renderTable({
        inFile <- input$file1

        if (is.null(inFile))
          return(NULL) 

        # Changes
        min <- as.character(input$expDateRange[1])
        max <- as.character(input$expDateRange[2])
        df <- data_set()

        df <- df[as.Date(df$Date) >= min & as.Date(df$Date) <= max,input$inCheckboxGroup]
        format(df, nsmall=5)
      })
    }
  })

  observe({
    if(input$non) output$contents<- renderTable(NULL)
    })

  #############################################
  output$mean<-renderPrint({
    inFile <- input$file1

    if (is.null(inFile))
      return("choisissez le fichier et decocher la date")
    inFile <- input$file1

    data<- data_set()[, input$inCheckboxGroup]
    a<-colMeans(data[,which(sapply(data, class) != "Date")])
    moyenne<-round(a*100,5)
    data.frame(moyenne)
  })


  observe({
    dsnames <- names(data_set())
    cb_options <- list()
    cb_options[ dsnames] <- dsnames
    updateCheckboxGroupInput(session, "inCheckboxGroup",
                             label = "Check Box Group",
                             choices = cb_options,
                             selected = cb_options)

  })


  output$choose_dataset <- renderUI({
    selectInput("dataset", "Data set", as.list(data_sets))
  })

  # Check boxes

  output$choose_columns <- renderUI({
    # If missing input, return to avoid error later in function
    if(is.null(input$data_set))
      return()

    # Get the data set with the appropriate name

    colnames <- names(contents)

    # Create the checkboxes and select them all by default

    checkboxGroupInput("columns", "Choose columns", 
                       choices  = colnames,
                       selected = colnames)

  })


})
ui <- shinyUI(pageWithSidebar(
  headerPanel("CSV Viewer"),
  sidebarPanel(
    fileInput('file1', 'Choose CSV File',
              accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv')),
    tags$hr(),

    checkboxGroupInput("inCheckboxGroup",
                       "Checkbox group input:",
                       choices = NULL
    ),
    actionButton("oui","Affichage"),
    actionButton("non","Clear"),
    numericInput("act1", "afficher les dernieres lignes:",10),

    uiOutput("choose_columns"),
    uiOutput("date")

  ),

  mainPanel(
    uiOutput("dates"),
    tableOutput('contents'),

    verbatimTextOutput('mean')

  )
))
shinyApp(ui, server)