In my shiny app for time series forecasting, I want to accept uploads of a single column csv file. This should be quarterly demand. Since the users may have different format for dates, I don't ask for dates in the csv, but ask for starting dates and create a sequence for the other dates. Downloading the uploaded data works perfect. But in displaying the table format, the dates are displayed as numbers. This is a known problem and I saw the discussions here: Shiny showing numbers instead of dates. My problem is that I want to display the date as Year quarter ("2002 Q3") and I don't know how to do it. My guess is that I need to add some format in the renderTable function and tried to search for that but could not find it. Please help.
(I also tried DT but DT was not able to display the tsibble table and it showed some text in red about a problem with year quarter)
I have created a sample dataset that can be uploaded on this app: https://drive.google.com/file/d/17OPRK0g1veCEvTZWOpQwm9lZ6sb20Ill/view?usp=sharing
UI:
library(shiny)
shinyUI(fluidPage(
titlePanel("Upload and Download"),
sidebarLayout(
sidebarPanel(
h5(helpText("Enter the starting point of your data below")),
selectInput("qrtr","Quarter",choices = c("Q1","Q2", "Q3","Q4")),
selectInput("yrr", "Year", choices = seq(from= 1990, to = 2020, by = 1)),
fileInput("datafile","Upload data file"),
h5(helpText("Data should be single column csv file with a header"))
),
mainPanel(
downloadButton("dldata","Download data"),
tableOutput("content")
)
)
))
Server:
library(shiny)
library(fpp3)
shinyServer(
function(input,output){
getdata <- reactive({
#dbz <- as.data.frame(c(1,2,3,4), colnames = "Demand")
infile <- input$datafile
if(is.null(input$datafile))
return(NULL)
dte <- paste(input$yrr,input$qrtr)
dte <- yearquarter(dte)
db <- read.csv(infile$datapath, header = TRUE, sep = ",")
db$Quarter <- seq(from = dte, by = 1, length = nrow(db))
db <- as_tsibble(db, index = Quarter)
return(db)
})
output$content <- renderTable(getdata())
output$dldata <- downloadHandler(
filename = "data.csv",
content = function(file){write.csv(getdata(),file, , row.names = FALSE)}
)
}
)
Related
I am developing a Shiny app to calculate statistical parameters of ground surface temperature time series in permafrost areas. Short example data can be found here.
Expanding on runExample("09_upload"), I built the upload wizard and would like to display the output as a table so that the user can peruse it before further processing. See code below.
However, I find that although the data is uploaded correctly, only the temperature values are displayed, and not the date/time index. I would like it to be visible as well, otherwise there is no point displaying the data as a table.
Can anyone help me understand what I might have done wrong, or how I can include the index in the datatable display?
Here is my code so far:
library("xts")
library("shiny")
# Define UI
ui <- fluidPage(
# App title
titlePanel("GST Parameters"),
sidebarLayout(
# Upload data
sidebarPanel(
# Widget title
h3("Import GST data", align = "center"),
fileInput("fname", "Choose data file"),
checkboxInput("header", "Header", value = FALSE),
radioButtons("separator", "Separator type:",
c("Tab" = "\t",
"Comma ," = ",",
"Semicolon ;" = ";")),
textInput("skip", "Number of initial rows to skip in data file:",
value = 0),
radioButtons("decimal", "Decimal marker:",
c("Dot ." = ".",
"Comma ," = ",")),
textInput("format", "POSIX date-time format:",
value = "%Y.%m.%d %H:%M:%S")
),
# Display data table
mainPanel(
dataTableOutput("contents")
)
)
)
server <- function(input, output) {
# Render data table from uploaded data
output$contents <- renderDataTable({
req(input$fname)
# Read in data as zoo object
read.delim.zoo(file = input$fname$datapath,
sep = input$separator,
skip = input$skip,
header = input$header,
dec = input$decimal,
index.column = 1,
drop = FALSE,
FUN = as.POSIXct,
tz = "",
format = input$format)
})
}
shinyApp(ui, server)
Thinking this issue might be specific to zoo objects, I also tried xts(read.delim.zoo(...)) and as.data.frame(read.delim.zoo(...)) but it still only displays the temperature values and not the index column.
I am new to Shiny, as I am using it for the first time to adapt my preexisting script for users with little R background. As such, any help is appreciated!
I built an app in R Shiny which uses time series data that excludes many dates. Within the app a user can select a new dataset, so the dates available will change. I'm using updateDateInput to update the dateInput selector. However, updateDateInput does not seem to allow the datesdisabled function?
Here is a reprex:
library(shiny)
# Sample 3 dates and disable the rest
my_dates <- sample(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"), 3)
date_choices <- seq.Date(from = min(my_dates), to = max(my_dates), by = 1)
dates_disabled <- date_choices[!(date_choices %in% my_dates)]
ui <- fluidPage(
dateInput("date", "Select Date",
min = min(date_choices),
max = max(date_choices),
value = max(date_choices),
datesdisabled = dates_disabled),
actionButton("click", "Click Me")
)
server <- function(input, output, session) {
observeEvent(input$click, {
my_dates <- sample(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"), 3)
date_choices <- seq.Date(from = min(my_dates), to = max(my_dates), by = 1)
dates_disabled <- date_choices[!(date_choices %in% my_dates)]
updateDateInput(
session,
"date",
min = min(date_choices),
max = max(date_choices),
value = max(date_choices),
datesdisabled = dates_disabled)
})
}
shinyApp(ui, server)
When the button is clicked and the updateDateInput runs, I get this error:
Warning: Error in updateDateInput: unused argument (datesdisabled =
dates_disabled)
I guess there is the option of changing the date to a character and using selectInput? But then I don't get the nice calendar!
You are right, the datesdisabled argument is not available in the update function. You can change the disabled dates by moving the UI declaration into the server and feed it to the client with renderUI().
The sample does not declare the date input in the UI but a uiOutput("date"). The server can dynamically create the dateInput using the datesdisabled argument. This way you can change the disabled dates.
The example will pick only 3 enabled dates after every button click.
# Reprex: The actual implementation of this uses data from a file:
# 1. Reads data file before ui and server are established
# 2. Does a bunch of calculations
# 3. Identifies dates that exist in data file
# 4. The data file is getting updated in the background from another application.
# 5. Allows user to click the button to update the data file. Reprex shows code
# that is used to update the date selector based on new data read. Dates are
# random in reprex, but would come from data file in actual code.
# Sample 3 dates and disable the rest - actual code reads data file here
# and parses out dates that exist in records
my_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day")
date_choices <- sample(my_dates, 31-3)
ui <- fluidPage(
uiOutput("date"), textOutput("disabled"),
actionButton("click", "Click Me")
)
server <- function(input, output, session) {
dates_disabled <- reactiveVal(NULL)
# Init 'dates_disabled()' once before Shiny flushes the reactive system with callback,
# using date_choices that exist in original data set
onFlush(fun = function () {dates_disabled(date_choices)}, once = TRUE)
# dateInput widget
output$date <- renderUI({
maxDate <- as.Date(max(setdiff(my_dates, dates_disabled())),
origin = "1970-01-01")
dateInput(input = "date",
label = "Select Date",
min = min(my_dates),
max = max(my_dates),
value = maxDate,
datesdisabled = dates_disabled())
})
# This output makes it easier to test if it works by showing the enabled dates
output$disabled <- renderPrint({
req(dates_disabled()) # only run this when 'dates_disabled' is initialized properly
Enabled <- as.Date(setdiff(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"),
dates_disabled()),
origin = '1970-01-01')
paste("Enabled:", paste(Enabled[order(Enabled)], collapse = ", "))
})
# Set new datesdisabled on button click
# Actual code would read updated data file and parse new dates
observeEvent(input$click, {
SelectedDates <- sample(my_dates, 31-3)
dates_disabled( SelectedDates )
})
}
shinyApp(ui, server)
I am trying to get my head around RShiny by building what I thought would be a pretty simple but useful app. What I would like the app to do is allow the user to input some data made up of dates, numeric, and characters. Then when the user presses a save/submit button this data is appended onto a pre-existing data frame made up of previous recordings and over write the .csv of these recordings. I would also like this data to be presented to the users in the form of a table in the UI which is updated as soon as the user presses the save/submit button.
I have managed to get the majority of the UI features working, however, I am having real difficulty 1) saving the data in the correct format and 2) updating the table displayed on the UI. My current method of saving the data involves creating an isolated list of the input values and rbinding this to the original data frame. However, the formats of the input values appear to all revert to factors which is especially problematic with the date as the output is meaningless as far as I am aware. In terms of updating the UI I have attempted to create a reactive object out of the data frame and use this object as the data displayed in renderDataTable but this approach seems to have no affect.
I have created a dummy minimal example below.
Thank you for all your help in advance.
require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- isolate(c(input$SessionDate, input$SessionValue, input$SessionPerson))
isolate(df <- rbind(as.matrix(df), unlist(newLine)))
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactive({
df
})
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I made some small tweaks.
You do not need isolate in the body of the observeEvent; it does not take a reactive dependency to values in its body.
I made ReactiveDf a reactiveVal instead of a reactive. This allows you to write its value from inside an observeEvent.
Instead of rowbinding a matrix and unlisting a list - the issue is that all the new values are parsed to the same class, while they are obviously not - it might be easier to rbind two data.frames, so create the newLine with newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)
So a working example would be as shown below. Hope this helps!
require(shiny)
require(tidyverse)
require(lubridate)
require(plotly)
#Would import the data in reality using read.csv() but to allow for an easily
#recreated example I made a dummy data frame
DateRecorded <- dmy(c("10/07/2018", "11/07/2018", "13/07/2018"))
Value <- c(1, 2, 3)
Person <- c("Bob", "Amy", "Charlotte")
df <- data.frame(DateRecorded, Value, Person)
ui <- fluidPage(
#UI Inputs
dateInput(inputId = "SessionDate", label = "Date Recorded", format = "dd-mm-yyyy"),
numericInput(inputId = "SessionValue", label = "Value Recorded", value = 0),
textInput(inputId = "SessionPerson", label = "Person Recording"),
actionButton(inputId = "Save", label = "Save"),
#UI Outputs
dataTableOutput("TheData"),
textOutput("TotRecorded")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
#When "Save" is pressed should append data to df and export
observeEvent(input$Save, {
newLine <- data.frame(DateRecorded = input$SessionDate, Value = input$SessionValue, Person = input$SessionPerson)
df <- rbind(df, newLine)
ReactiveDf(df) # set reactiveVal's value.
write.csv(df, "ExampleDataFrame.csv") #This export works but the date is saved incorrectly as "17729" not sure why
})
#Create a reactive dataset to allow for easy updating
ReactiveDf <- reactiveVal(df)
#Create the table of all the data
output$TheData <- renderDataTable({
ReactiveDf()
})
#Create the totals print outs
output$TotRecorded <- renderPrint({
data <- ReactiveDf()
cat(nrow(data))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to have my user upload two csv files. Only after this done do I want to send a data table to lm in renderTable, generate results and create a table from the output of a regression model. The basics of ui and server code are below. I use fileInput to read in the data. The server uses reactive construction to construct dataInput involving if (is.null) return(NULL) for each of the csv files. I thought this would essentially stop the renderTable code from doing anything until both csv files are uploaded. But in fact renderTable is still reacting. But I may be misunderstanding how to use reactive functions to pass a data table to another reactive function.
ui <- fluidPage(
titlePanel("Generate calibration parameters"),
# Sidebar with two csv imports
sidebarLayout(
sidebarPanel(
fileInput('master', 'Choose the master AQE CSV File',
accept = c('text/csv', 'text/comma-separated values,text/plain', '.csv')),
fileInput('slave', 'Choose the slave AQE CSV File',
accept = c('text/csv', 'text/comma-separated-values,text/plain','.csv'))
),
mainPanel(width = "100%",
fluidRow(align = "center",
column(
width = 6, div(tableOutput("coeffTableO3"), style = "font-size:80%")
))))))
server <- function(input, output) {
dataInput <- reactive({
masterInfo <- input$master
if (is.null(masterInfo))
return(NULL)
dt.master <- read_csv(masterInfo$datapath)
dt.master <- as.data.table(dt.master)
slaveInfo <- input$master
if (is.null(slaveInfo))
return(NULL)
dt.slave <- as.data.table(read_csv(slaveInfo$datapath)
timezone <- "America/Denver"
#aggregate to minutes; note that cut returns a factor 'timestamp' becomes 'cut'
varsToAgg.master <- c("no2", "o3")
dt.master.min <- dt.master[, lapply(.SD, mean), by = list(cut(dt.master$timestamp, breaks = "min")), .SDcols = varsToAgg.master]
varsToAgg.slave <- c("no2.slave", "o3.slave")
dt.slave.min <- dt.slave[, lapply(.SD, mean), by = list(cut(dt.slave$timestamp.slave, breaks = "min")), .SDcols = varsToAgg.slave]
# combine the two
combinedResults <- merge(dt.master.min, dt.slave.min, by = 'cut')
# convert cut back to posix and change name to time
combinedResults[, time := as.POSIXct(cut,format = "%Y-%m-%d %H:%M:%S", tz = timezone)]
combinedResults[,cut := NULL]
return(combinedResults)
})
output$coeffTableO3 <- renderTable({
# generate regression results
combinedResults <- dataInput()
print(str(combinedResults))
lmResultsO3 <- lm(o3.slave ~ o3, combinedResults)
coef(summary(lmResultsO3))["o3","Estimate"]
coef(summary(lmResultsO3))["(Intercept)","Estimate"]
})
}
I am currently building a shiny app and trying to get a set of dates to render as character strings to the end user, while still keeping their date format when invoked in the server side code.
There might be a simple solution here, but unsure how to get the dates to format in the selectInput dropdown. In my actual use case, using a date slider isn't ideal as the dates do not follow a common interval.
Reproducible example below:
# setup
require(lubridate)
test.dates <- as.Date(c('2014-06-01', '2014-07-01', '2014-08-01',
'2014-09-01', '2014-10-01', '2014-11-01',
'2014-12-01', '2015-01-01','2015-02-01',
'2015-03-01', '2015-04-01'))
test.names <- as.character(paste0(month(test.dates, label = T), ' ',
year(test.dates)))
test.df <- data.frame(date = test.dates)
row.names(test.df) <- test.names
# shiny
server <- function(input, output) {
output$table <- renderTable(test.df)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("test", label = "DATE FORMAT TEST:", choices =
test.df, selected = test.df[1,])
),
mainPanel(tableOutput('table'))
)
)
shinyApp(ui = ui, server = server)
I believe you will find it much easier to pass around character objects than date objects in Shiny. I would simply use the direct character values of your dates and whenever you need them to be date objects in your subsequent analysis explicitly convert to a date object. The following provides an example where both the dropdown and table have the character formatted dates.
require(lubridate)
myDates <- c('2014-06-01', '2014-07-01', '2014-08-01',
'2014-09-01', '2014-10-01', '2014-11-01',
'2014-12-01', '2015-01-01','2015-02-01',
'2015-03-01', '2015-04-01')
test.names <- as.character(paste0(lubridate::month(test.dates, label=TRUE), ' ',
year(test.dates)))
test.df <- data.frame(date = myDates)
row.names(test.df) <- test.names
# shiny
server <- function(input, output) {
output$table <- renderTable(test.df)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("test", label = "DATE FORMAT TEST:", choices =
myDates, selected = myDates[1])
),
mainPanel(tableOutput('table'))
)
)
shinyApp(ui = ui, server = server)