我正在尝试设置一个相对基本的闪亮应用，我有一个数据框，其中包含一列日期(DF$Date)，我想：（1）设置dateRangeInput以获得最低限度最大DF$Date（2）tableOutput应仅打印dateRange选择。
这是我正在使用的代码：
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)
})
})
我正在使用的数据：
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
任何提示都有用，请我卡住。谢谢。
答案 0 :(得分：2)
由于时间限制，我无法按照自己的意愿详细说明我的答案。无论如何，我希望这个例子有用
# 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)