Shiny reactive function behavior is not as expected - r

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"]
})
}

Related

Getting renderTable to show dates as quarters

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)}
)
}
)

Subsetting Dataframe within Shiny

If I import a dataset from Shiny using fileInput, how could I go about creating this in a reactive form where I can create subsets of the imported dataframe and eventually perform calculations on different rows of the subsetted dataframes? Can I store subsetted dataframes as reactiveValues() and then use them outside of a reactive scenario?
How would I go about accomplishing something like the code below, which would be in an ordinary R Script, where it works successfully?
df <- read.table(file.choose(), header=TRUE, sep=",")
attach(df)
df <- df[, c(1, 50:75)]
df[1] <- time
I know I can accomplish the following using fileInput, I'm just not sure how I can subset things like this within shiny and make them usable in scenarios like
renderPlot and others. Would reactive or reactiveValues be the best strategy to accomplish this?
Is this something you are looking for?
library(shiny)
ui <- fluidPage(
titlePanel("Uploading Files"),
sidebarLayout(sidebarPanel(
fileInput(
"file1",
"Choose CSV File",
multiple = F,
accept = c("text/csv", "text/comma-separated-values,text/plain", "text")
),
uiOutput("selectbox")
),
mainPanel(tableOutput("contents")))
)
server <- function(input, output) {
data <- reactive({
req(input$file1)
df <- read.csv(file = input$file1$datapath,
header = T,
sep = "\t")
})
output$selectbox <- renderUI({
colnam <- colnames(data())
selectInput("colsel",
"Columns Selected",
c("Please select" = "", colnam),
multiple = T)
})
output$contents <- renderTable({
data()[, c(req(input$colsel))]
})
}
shinyApp(ui, server)

How to execute a long R script as function in RShiny and display the solution in the ui?

I am trying to run an R Script as a R Shiny App. From the ui, the user will upload a .csv file and input 4 numeric variables. These variables should be passed through the function and it will generate a final_table which should be displayed as output in the Shiny App. Currently, the variables are being passed through the function but not resulting in the final table. I am new with RShiny, appreciate your help in making this work.
my_function.R is the script file which contains the function my_function(). This in fact is a 500 line R script compressed into a function for ease of use.
my_function <- function(tbl_load, ts_freq, ts_start_yr, ts_start_month, seasonal_cat) {
..........
return(collect_ALL_final_fair)
}
ui.R
library(shiny)
fluidPage(
titlePanel("Elasticity Tool"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose datatable csv file', accept=c('.csv')),
numericInput("ts_freq", "Time series frequency:", 52, min = 1, max = 100),
numericInput("ts_start_yr", "Starting year:", 2013, min = 1990, max = 2030),
numericInput("ts_start_month", "Starting month:", 3, min = 1, max = 12),
numericInput("seasonal_cat", "Seasonal Category", 0, min = 0, max = 1),
br(),
actionButton("goButton", label = "Run tool"),
br()
),
mainPanel(
tabsetPanel(type = 'tabs',
tabPanel("Output", tableOutput('contents2'))
)
)
)
)
server.R
library(shiny)
library(datasets)
source("my_function.R")
#packages
library("glmnet")
library(Matrix)
library(dplyr)
library(forecast)
library(zoo)
library(stats)
library(car)
options(scipen = 999)
shinyServer(function(input, output) {
observeEvent(input$goButton, {
tbl_load <- input$file1
ts_freq <- input$ts_freq
ts_start_yr <- input$ts_start_yr
ts_start_month <- input$ts_start_month
seasonal_cat <- input$seasonal_cat
output$contents2 <- renderDataTable({
my_function(tbl_load, ts_freq, ts_start_yr, ts_start_month, seasonal_cat)
})
})
})
It seems like your output-render pairs are mismatched. If you want to use a regular table, you should have:
# ui
tableOutput('contents2')
# server
output$contents2 <- renderTable({})
If you want to use a datatable, you should have:
# ui
DT::dataTableOutput('contents2')
# server
output$contents2 <- DT::renderDataTable({})
If you want to do this, make sure you've installed the DT package.
If this turns out to not be the only problem, include the function definition in the server.R file (after you load the appropriate libraries). If this fixes it, it's because you weren't sourcing the file correctly (maybe your path isn't right or something like that). If it still doesn't work, the problem is in your function itself.
Also, why aren't you passing the inputs directly to my_function? You should also avoid using an observer in this case. Instead you can use this pattern:
my_table <- eventReactive(input$goButton, {
my_function(input$file1, input$ts_freq, input$ts_start_yr,
input$ts_start_month, input$seasonal_cat)
})
output$contents2 <- renderTable({
my_table()
})

Dynamic select input not working with loaded data

Using R shiny, I am developing a simple app that allows user to input data from a Rdata file. I want the app to load the data, show the names of numeric variables in a select input field, and after the user selected one of variables do some analysis. But I can not get it working. In the code provided I obtain two outputs: summary, which works fine, and the MEAN of the selected variable which I can not get work.
server.R
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
shinyServer(function(input, output) {
#### DATA LOAD
df <- reactive({
df <- input$datafile
if (is.null(df)) {
# User has not uploaded a file yet
return(NULL)
}
objectsLoaded <- load(input$datafile$name)
# the above returns a char vector with names of objects loaded
df <- eval(parse(text=objectsLoaded[1]))
# the above finds the first object and returns it
df<-data.table(df)
})
#### SELECTS
num <- reactive({
num <- sapply(df(),is.numeric)
num <- names(num)
})
output$var_num <- renderUI({
vector.num <- as.vector(num())
selectInput("var_num", "Select Variables :", as.list(vector.num), multiple = FALSE)
})
#### OUTPUTS
### SUMMARY
output$summary_num <-renderDataTable({
x<-t(sapply(df(), summary))
x<-as.data.frame(x)
x<-setDT(x, keep.rownames = TRUE)[]
colnames(x) <- c("Variable","Mínimo","1er Quartil", "Mediana", "Media", "3er Quartil","Máximo")
datatable(x)
})
### MEAN OF SELECTED VAR
output$test <-renderPrint ({
if(is.null(df()))
return()
dat<- df()
dat <- dat[,num(), drop = FALSE]
mean(dat[,input$var_num])
})
})
UI.R
dashboardPage(
dashboardHeader(title = "TITLE", titleWidth = 500),
dashboardSidebar(disable = TRUE), #---> fin SIDEBAR
dashboardBody(
fluidRow(
box(width=12, status = "primary",
tabsetPanel(
tabPanel("Test",
fileInput("datafile", label = h3("File input")),
uiOutput("var_num"),
br(),hr(),br(),
fluidRow(column(width=4, uiOutput("var_caracter"),textOutput("test"))),
br(),hr(),br(),
fluidRow(column(width=8, "Variables Numericas", dataTableOutput("summary_num")))
)
) # fin tabsetPanel
) # fin box
)# fin fluidRow
)# fin dashboardBody
)# fin dashboardPage
When I run the app everything goes fine (select input, summary, etc) except the calculation and printing of the MEAN of the selected variable. I guess for some reason the subsetted dataframe is empty, but I do not know why...
Any help will be great! Thanks in advance.
I get it working.
The solution was to define the dataset I used as.data.frame:
### MEAN OF SELECTED VAR
output$test <-renderPrint ({
if(is.null(df()))
return()
dat<- as.data.frame(df()) ## THIS IS THE CORRECTION
dat <- dat[,num(), drop = FALSE]
mean(dat[,input$var_num])
})
I do not really understand why... The reactive file df() was defined as data.table and dat shoul inherit that, but for some reason it was necesary an explicit definition as dataframe.

R Shiny request user to choose directory

I am new to R and R Shiny.
For the code i have at the moment i need to manually input the file name, i would like to generalize the case and let the user to pick working directory and corresponding file name.
1, user choose working directory
then shiny able to store all the file names under the selected working directory. similar to list.files()
2, then the box list files will list all file names under the selected wd
and user able to check which dataset should be shown
3, in the mainpanel
top 10 instances of the dataset with the header will be shown
What i have tried is
server.R
library(shiny)
setwd("C:/Users/HKGGAIT001/Google Drive/GA Project/Cargo/Cargo.Statistics/data/Hactl")
data1 <- read.csv(list.files()[1])
data2 <- read.csv(list.files()[2])
# Define server logic required to summarize and view the selected
# dataset
shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"data1" = data1,
"data2" = data2)
})
# Generate a summary of the dataset
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
# Show the first "n" observations
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
})
ui.R
library(shiny)
# Define UI for dataset viewer application
shinyUI(fluidPage(
# Application title
titlePanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the
# number of observations to view
sidebarLayout(
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("data1", "data2")),
numericInput("obs", "Number of observations to view:", 10)
),
# Show a summary of the dataset and an HTML table with the
# requested number of observations
mainPanel(
verbatimTextOutput("summary"),
tableOutput("view")
)
)
))
The situation is similar to This website while my case is request user to pick local working directory.
Thanks for your gentle help
First, create the .csv files to reproducibility:
write.csv(x = data.frame(V1 = 1:13, V2 = letters[1:13]),
file = "teste1.csv", row.names = FALSE)
write.csv(x = data.frame(V1 = 14:26, V2 = letters[14:26]),
file = "teste2.csv", row.names = FALSE)
write.csv(x = data.frame(V1 = rnorm(15), V2 = runif(15)),
file = "teste3.csv", row.names = FALSE)
Add a global.R script in your app might be useful. In this script you would be able to:
i. let the user select the working directory,
ii. read the .csv files in that folder,
iii. create a list of files that could be used by ui.R and server.R
# global.R
library(shiny)
wd <<- choose.dir()
setwd(wd)
csv <<- list.files(pattern = ".csv")
files <<- vector("list", length(csv))
for (i in seq_along(files)) {
files[[i]] <- read.csv(csv[i], stringsAsFactors = FALSE)
}
list_of_datasets <<- seq_along(files)
names(list_of_datasets) <- gsub(pattern = ".csv", replacement = "", x = csv)
Then you just have to make a few changes in the original scripts you provided us. In ui.R I would redefine the selectInput function so that displays the name of the files to the users. Also, you can't be sure that the selected folder would have 2 files.
selectInput("dataset", "Choose a dataset:",
choices = list_of_datasets)
In server.R you should i) remove the 2nd, 3rd and 4th lines (already handled by global.R) and ii) change datasetInput function:
datasetInput <- reactive({
files[[as.numeric(input$dataset)]]
})

Resources