Thursday, June 27, 2019

Create new column based on existing columns in R Shiny

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

plot explanation - Why did Peaches&#39; mom hang on the tree? - Movies &amp; TV

In the middle of the movie Ice Age: Continental Drift Peaches' mom asked Peaches to go to sleep. Then, she hung on the tree. This parti...