I am letting the user to upload the dataset into my R Shiny app and then I let him to specify the time variable of this dataset and whether it's in monthly or quarterly frequency. The data uploaded by the user are called model_data within the server. Then I want to create a new column in model_data named time_var_use which will be the time variable selected by the user, but converted to yearmon (for monthly data) or to yearqtr (for quarterly data) format.
I am struggling with the creation of this new variable time_var_use and with updating one of my inputs input$time_threshold based on the unique values of time_var_use.
The code for this Shiny app is below:
library(shiny)
library(shinydashboard)
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggrepel)
library(scales)
library(lubridate)
library(knitr)
library(foreign)
library(DT)
library(caret)
library(car)
library(data.table)
library(digest)
library(jsonlite)
library(httr)
library(reshape2)
library(zoo)
library(sqldf)
library(boot)
library(openxlsx)
library(readxl)
options(shiny.maxRequestSize = 30000*1024^2)
options(scipen = 999)
### Define app
ui <- dashboardPage(
dashboardHeader(title = "My app"),
dashboardSidebar(
sidebarMenu(
menuItem("Upload Data", tabName = "data_upload", icon = icon("folder-
open"))
)
),
dashboardBody(
tags$head(tags$style(HTML('.main-header .logo {
font-family: "Bliss Pro Light", Times, "Times New Roman", serif;
font-weight: bold;
font-size: 30px;
}
'))),
tabItems(
tabItem(tabName = "data_upload",
fluidRow(
box(title = "Modelling data", status = "primary",
fileInput(inputId = "main_data", label = "Upload the data for modelling", accept = c('.csv', 'text/comma-separated-values,text/plain', 'text/csv', 'csv')),
checkboxInput(inputId = "header", label = "The data has headers", value = TRUE),
radioButtons(inputId = "sep", label = "Delimiter:", choices = c("Comma" = ",","Semicolon" = ";","Tab" = "\t"), selected = ";")
)
),
fluidRow(
box(title = "Divide modelling data into estimation & validation sample", status = "primary", width = 12,
selectizeInput(inputId = "time_var", label = "Select the time variable", choices = "", multiple = FALSE),
#frequency of the data
tags$b("Choose the frequency of your data"),
radioButtons(inputId = "frequency", label = "", choices = c("Monthly", "Quarterly"), selected = "Quarterly"),
#time format based on frequency - choices
tags$b("Select the time series variable format"),
conditionalPanel(condition = "input.frequency == 'Monthly'",
radioButtons(inputId = "format_monthly", label = "",
choices = c("month Year, e.g. Jan 2014 or January 2014" = "format_1", "month/day/Year, e.g. 2/26/2019" = "format_2"),
selected = "format_1")
),
conditionalPanel(condition = "input.frequency == 'Quarterly'",
radioButtons(inputId = "format_quarterly", label = "",
choices = c("Year quarter, e.g. 2014q3 or 2014Q3" = "format_3", "month/day/Year, e.g. 2/26/2019" = "format_4"),
selected = "format_3")
),
selectizeInput(inputId = "time_threshold", label = "Select time threshold for estimation and validation", choices = "", multiple = FALSE),
h6("Data before this threshold will be used for estimation, data after this threshold will be used for validation.")
)
)
)
)
)
)
server <- function(input, output, session) {
model_data <- reactive({
infile <- input$main_data
if (is.null(infile))
return(NULL)
read.csv(infile$datapath, header = input$header, sep = input$sep, stringsAsFactors = FALSE)
})
# update time_var choices
observe({
vchoices <- names(model_data())
updateSelectizeInput(session = session, inputId = "time_var", choices = vchoices)
})
observeEvent(input$frequency, {
if (input$frequency == "Monthly") {
if (input$format_monthly == "format_1") {
model_data()[, "time_var_use"] <- as.yearmon(model_data()[, input$time_var])
}
else if (input$format_monthly == "format_2") {
model_data()[, "time_var_use"] <- as.yearmon(as.Date(model_data()[, input$time_var], "%m/%d/%Y"))
}
}
if (input$frequency == "Quarterly") {
if (input$format_quarterly == "format_3") {
model_data()[, "time_var_use"] <- as.yearqtr(model_data()[, input$time_var])
}
else if (input$format_quarterly == "format_4") {
model_data()[, "time_var_use"] <- as.yearqtr(as.Date(model_data()[, input$time_var], "%m/%d/%Y"))
}
}
updateSelectizeInput(session, inputId = "time_threshold",
choices = as.character(unique(model_data()[, "time_var_use"])),
server = TRUE)
})
}
shinyApp(ui, server)
The part of the code that does not work is observeEvent() at the end of the server environment. I am trying to create time_var_use column inside observeEvent and then update the values of input$time_threshold with it.
I didn't know how to attach an example CSV file here that I am uploading to the app (model_data from above), so I am just copying data from this example CSV file below:
time var1 var2 var3
2015q1 8 1 0.6355182
2015q1 12 0 0.5498784
2015q1 23 1 0.9130934
2015q1 152 1 0.8938210
2015q2 563 1 0.2335470
2015q3 8 0 0.5802677
2015q4 2 0 0.8514926
2016q1 1 1 0.4712101
2016q1 14 0 0.9747804
2016q2 13 1 0.8571699
2016q2 14 1 0.8738486
2016q3 53 0 0.8467971
2016q4 75 0 0.3191140
2016q4 15 0 0.9608926
Based on the time column, my aim is to create time_var_use column within the app and then use its values for another input.
No comments:
Post a Comment