Я разрешаю пользователю загружать набор данных в мое приложение R Shiny, а затем я позволяю ему указать временную переменную этого набора данных, а также то, используется ли он ежемесячно или ежеквартально.Данные, загруженные пользователем, называются model_data на сервере.Затем я хочу создать в столбце model_data новый столбец с именем time_var_use, который будет временной переменной, выбранной пользователем, но преобразованной в формат yearmon (для месячных данных) или yearqtr (для квартальных данных).
Я борюсь с созданием этой новой переменной time_var_use и с обновлением одного из моих входных данных input$time_threshold на основе уникальных значений time_var_use.
Код для этого блестящего приложения ниже:
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
1.Дизайн пользовательского интерфейса
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.")
)
)
)
)
)
)
2.Дизайн сервера
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)
})
}
3.Create ShinyApp
shinyApp(ui, server)
Часть кода, которая не работает, - observeEvent() в конце серверной среды.Я пытаюсь создать time_var_use столбец внутри observeEvent и затем обновить значения input$time_threshold с ним.
Я не знал, как прикрепить пример файла CSV сюда, который я загружаю в приложение (модель_данных сверху), поэтому я просто копирую данные из этого примера файла CSV ниже:
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
Основываясь на столбце time, я хочу создать в приложении столбец time_var_use, а затем использовать его значения для другого ввода.