Wie setze ich einen dateRangeInput basierend auf Daten?

Question

Ich versuche, eine relativ einfache glänzende App einzurichten, ich habe einen Datenrahmen mit einer Spalte von Daten (DF$Date) und ich möchte: (1) die dateRangeInput einrichten, um das Minimum und das Maximum von DF$Date (2) zu erhalten tableOutput sollte nur das DateRange ausgewählt werden. Hier ist der Code, den ich mit:

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') 

) 
)) 

SERVER.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) 

    }) 


}) 

die Daten Ich verwende:

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 

Jeder Hinweis kann nützlich sein, bitte ich bin fest. Vielen Dank.

Answer 1

Aufgrund der zeitlichen Einschränkungen kann ich meine Antwort nicht so erarbeiten, wie ich es mir gewünscht habe. Wie dem auch sei, ich hoffe, dass dieses Beispiel hilfreich sein

---

# 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) 

---

UPDATE

ich einige Änderungen vorgenommen:

1) Die Variable Date nun auf das Datum dazu gezwungen wird Klasse innerhalb data_set

data_set <- reactive({ ... }) 

2) Dann innerhalb output$dates Sie brauchen nur dates <- data_set()$Date

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

3) Schließlich tableOutput reaktiv dateRangeInput zu machen und checkboxGroupInput Sie folgende subsetting innerhalb Beobachter zu tun haben:

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) 
     }) 
    } 
    }) 

---

Vollständiger Code:

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)