Downloading the outputs of a reactive table in R shiny - r

I have an R shiny app that gets a .csv import from a user and searches the imported data across a built-in data frame, then gives the % match in the output. The UI is very simple, with a few different inputs (import .csv, a slider, and some radio buttons). What I want is to be able to take the reactive table output and print this to a .csv that the user can download to their machine. The server side of the app looks something like this:
server <- function(input, output){
rvals <- reactiveValues()
observeEvent(input$file_1,{
req(input$file_1)
rvals$csv <<- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
if(input$select == 1){
x <- function
}else if(input$select == 2){
x <- function
}else if(input$select == 3){x <- function}
#some more data processing and formatting here
return(x)
},digits = 4)
}
I would like to have the data table x be able to become a .csv that can be downloaded by clicking a download button. In the server, I added the following code, but when I try to download the data it just downloads a blank file and says "SERVER ERROR" in my downloads manager on my machine.
output$downloadData <- downloadHandler(
filename = "thename.csv",
content = function(file){
write.csv(x, file)
}
In the console I also get the error message:
Warning: Error in is.data.frame: object 'x' not found [No stack trace available]

The object you create inside the expression of renderTable is not available outside of it. Instead you could assign it to the reactive values you set up. Below is a working example (note that I have tried to replicate your code so the data will not be available until you click on "Upload CSV", which here just calls mtcars).
library(shiny)
ui = fluidPage(
sidebarPanel(
actionButton(inputId = "uploadCsv", label = "Upload CSV:", icon = icon("upload")),
selectInput(inputId = "preProc", label = "Pre-processing", choices = c("Mean"=1,"Sum"=2)),
downloadButton("downloadData", label = "Download table")
),
mainPanel(
h4("My table:"),
tableOutput("contents")
)
)
server <- function(input, output) {
rvals <- reactiveValues(
csv=NULL,
x=NULL
)
observeEvent(input$uploadCsv,{
rvals$csv <- mtcars # using example data since I don't have your .csv
# rvals$csv <- read.csv(input$file_1$datapath, header = TRUE)
#some data processing here
})
output$contents <- renderTable({
# Assuing the below are functions applied to your data
req(
input$preProc,
!is.null(rvals$csv)
)
if(input$preProc == 1){
rvals$x <- data.frame(t(colMeans(mtcars)))
}else {
rvals$x <- data.frame(t(colSums(mtcars)))
}
return(rvals$x)
},digits = 4)
output$downloadData <- downloadHandler(
filename = "myFile.csv",
content = function(file){
write.csv(rvals$x, file)
}
)
}
shinyApp(ui,server)

EventReactive already outputs a reactive value, you don't need to create an extra reactiveVal, see example below :
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Test"),
mainPanel(
actionButton("show", "Download"),
textOutput("result")
)
)
server <- function(input, output) {
csvfile <- eventReactive(req(input$show), ignoreNULL = T, {
"Content of file"
})
output$result <- reactive(
paste("result : ",csvfile()))
}
# Run the application
shinyApp(ui = ui, server = server)
I would also avoid to use <<-operator in a reactive expression.

Related

SHINY Summarise info based on sheet selected by user after uploading file

My goal is that user uploads an Excel file. Then, the user selects which sheets wants to be summarised, after the selection has been updated. I have managed to update selectInput with the name of the sheets but I have not been able to find\understand how to summarise based on what the sheet selected by the user. Thanks for any help.
library(shiny)
library(shinythemes)
library(data.table)
library(ggplot2)
library(dplyr)
library(readxl)
not_sel <- "Not Selected"
# Define UI for application that draws a histogram
ui <- fluidPage('MAIN TITLE',
theme = shinytheme('flatly'),
tabsetPanel(
sidebarLayout(
sidebarPanel(
fileInput('files','Import File', accept = c('.csv','.xlsx'),
multiple = F),
actionButton('boton1', 'Load', icon = icon('table')),
br(),
selectInput("indices", "Select SHEET:", choices = c(not_sel))
),
mainPanel(
tabsetPanel(
tabPanel('Data',
tableOutput('tabla'),
tableOutput('cabeza')),
tabPanel('Stats',
# selectInput('var01', 'Variable to summarise', choices = c(not_sel)),
tableOutput('stats')),
)
)
)
)
)
##############
server <- function(input, output, session) {
options(shiny.maxRequestSize=10*1024^2)
df <- eventReactive(input$boton1, {
req(input$files)
if(is.null(input$files))return(NULL)
# else{
read_excel(input$files$datapath)
# }
})
# Sheets of file uploaded
sheets_name <- reactive({
if (!is.null(input$files)) {
return(excel_sheets(path = input$files$datapath))
} else {
return(NULL)
}
})
# Update inputSelector with sheet names
observeEvent(df(),{
choices <- c(sheets_name())
updateSelectInput(inputId = "indices", choices = choices)
})
# DATA Tab
## This will show the name of the file
output$tabla <- renderTable({
input$files$name
})
## This Shows the head() but it is only showing the first sheet
output$cabeza <- renderTable({
tabla <- as_tibble(bind_cols(Date = format(as.Date(df()$Date),"%Y-%m-%d"),
Close.Price = df()$Close))
head(tabla)
})
# HERE is where I do not know how to calculate based on selection
# Table for STATS
output$stats <- renderTable({
datos <- df()
Value <- c(round(mean(datos$Close,na.rm = T),2)
)
Statistic <- c("Mean")
data.table(Statistic, Value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want to assume that by knowing how to calculate mean based on the sheet selected, I. can replicate the code for the top rows (head()) shown in the Data Panel.
If I missed a similar question asked, I would appreciate any link and I will try the solution proposed first.
As I cannot share the file, this is how the file would look:
After working with this answer I made my app work. If there is a 'cleaner'/'better' answer, I will be happy to read.
Following the recommendation in the linked answer my server ended up like this:
ui <-fluidPage{
#My UI stayed the same with the exception of adding
uiOutput("dropdownUI") #Whererever I needed to appear
}
server <- function(input, output, session) {
...ANSWER FROM THE LINK...
## STATS Tab
output$stats <- renderTable({
Values <- c(round(mean(Dat()[,2],na.rm = T),2)
)
Statistics <- c("Mean")
data.table(Statistics, Values)
})
}

Reactives Evaluation in a Loop

I am trying to create a number of tabs based on some list and create similar fields in those tabs with their own identity. Can we create and use reactives like
eval(paste0("Updated_files_list_",Some_List[k], "()"))
I have used following code and one location but that will be different for different tabs it seems that reactives are created for the lists but I am unable to either assign values to it or call it -
Some_List <- list("AGG", "CMP1", "CMP2")
Some_Long_List <- list("Aggregated Things", "Component 1", "Component 2")
sidebar <- dashboardSidebar(
do.call(sidebarMenu, c(lapply(1:length(Some_List), function(i) {
menuItem(Some_Long_List[i], tabName = paste0(Some_List[i],"_tab"))
}))))
uibody <- dashboardBody(
do.call(tabItems, c(lapply(1:length(Some_List), function(i) {
tabItem(tabName = paste0(Some_List[i],"_tab"), h2(Some_Long_List[i]),
fluidPage(fluidRow(column(3,
dateInput(paste0("ME_DATE_output_",Some_List[i]),label=h2("Select a Date"), value="2020-05-29"))
,column(9,column(verbatimTextOutput(paste0("file_path_",Some_List[i])),width=12),hr(),
selectInput(paste0('select_file_',Some_List[i]),'Select a File to display', choices=NULL),hr(),
column(dataTableOutput(paste0('selected_table_',Some_List[i])),width=12)))))
}))))
ui = dashboardPage(dashboardHeader(title = "Results"), sidebar, uibody)
server = function(input, output, session) {
# Location for Source Inputs
Some_loc <- "K:/Outputs"
lapply (1:length(Some_List), function(k){
ME_DATE_GUI <- reactive({input[[paste0("ME_DATE_output_",Some_List[k])]]})
# Files Path
output[[paste0("file_path_",Some_List[k])]] <- renderPrint({ req(Some_loc) })
# Updated Files list
assign(paste0("Updated_files_list_",Some_List[k]), reactive({
lf_some <- list.files(Some_loc,full.names = TRUE)
names(lf_some) <- basename(lf_some)
lf_some
}))
# Fetch selection of file
observeEvent(eval(paste0("Updated_files_list_",Some_List[k], "()")), {
updateSelectInput(session, paste0("select_file_",Some_List[k]), choices=eval(paste0("Updated_files_list_", Some_List[k],"()")))
})
# Display Selected file
output[[paste0("selected_table_",Some_List[k])]] <- renderDataTable({
req(input[[paste0("select_file_", Some_List[k])]])
read.csv(input[[paste0("select_file_", Some_List[k])]], header=T)
})
})
}
shinyApp(ui, server)
In the selectInput field, I can see Update_files_list_AGG(), ("AGG", "CMP1" and "CMP2" in respective tabs) but not the list of files in the assigned location. The error I get is Error: cannot open the connection

Dataframe - R - Shiny

i have a question regarding Shiny and the usage of Data frames.
I think i understood that i need to create isolated or reactive environmentes to interact with, but if i try to work with the Dataframe i get an error message:
Error in pfData: konnte Funktion "pfData" nicht finden
i tried to manipulate the dataframe by this code:
server <- function(input, output) {
observeEvent(input$go,
{
pf_name <- reactive({input$pfID})
pf_date <- reactive({input$pfDate})
if (pf_name()!="please select a PF") {
pfData <- reactive(read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=","))
MDur <- pfData()[1,15]
pfData <- pfData()[3:nrow(pfData()),]
Total = sum(pfData()$Eco.Exp...Value.long)
}
})
}
If i manipulate my Dataframe in the console it works just fine:
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
can you help me?
Edit:
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
choices = list("please select a PF","GF25",
"FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
input$go
if (pf_name()!="please select a PF") {
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
MDur <- pfData[1,15]
pfData <- pfData[3:nrow(pfData),]
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
output$selected_var <- renderText({paste(MDur)})
}
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Thank you
Stefan
Without a working example, it's imposible to be sure what you're trying to do, but it sounds like you need a reactive rather than using observeEvent.
Try something like
pfDataReactive <- reactive({
input$go
pfData <- read.csv(file =paste(pf_name(),".csv",sep=""),sep=";",dec=",")
Total = sum(pfData$Eco.Exp...Value.long)
Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
pfData
})
And then use pfDataReactive() in your Shiny app's server function wherever you would refer to pfData in your console code.
The standalone reference to input$go ensures the reactive will update whenever input$go changes/is clicked/etc.
Update
There are still significant issues with your code. You've added an assignment to an output object as the last line of the reactive I gave you, so the reactive always returns NULL. That's not helpful and is one of the reasons why it "doesn't active at all"...
Second, you test for the existence of an reactive/function called pf_name when the relevant input object appears to be input$pfID. That's another reason why the reactive is never updated.
Note the change to the definition of input$pfID that I've made to improve the readability of the pfDataReactive object. (This change also probably means that you can do away with input$go entirely.)
As you say, I don't have access to your csv file, so I can't test your code completely. I've modified the body of the pfDataReactive to simply return the mtcars dataset as a string. I've also edited the code I've commented out to hopefully run correctly when you use it with the real csv file.
This code appears to give the behaviour you want,. Though, if I may make a subjective comment, I think the layout of your GUI is appaling. ;=)
library(shiny)
ui <- fluidPage(
fluidRow(
column(6, offset =3,
wellPanel(
"Choose Mandate and Date",
fluidRow(
column(4,selectInput("pfID",label = "",
# Modified to that "Pleaseselect a PF" returns NULL
choices = list("please select a PF"="","GF25", "FPM"),
selected = "please select a PF") ),
column(4, dateInput("pfDate",label="",value = Sys.Date()) ),
column(2, actionButton("go","Submit")),column(2,textOutput("selected_var"))
)
)
)
)
)
# Define server logic ----
server <- function(input, output) {
pfDataReactive <- reactive({
# Don't do anything until we have a PF csv file
req(input$pfID)
input$go
# Note the change to the creation of the file name
# pfData <- read.csv(file =paste(input$pfID,".csv",sep=""),sep=";",dec=",")
# pfData <- pfData[3:nrow(pfData),]
# Total = sum(pfData$Eco.Exp...Value.long)
# Assets = sum(as.numeric(gsub(",",".",gsub(".","",pfData$Value,fixed=TRUE),fixed=TRUE)))
# pfData$Exposure <- with(pfData, Eco.Exp...Value.long /Total)
# MDur <- pfData[1,15]
# If you want to print MDur in the selected_var output, MDur should be the retrun value from this reactive
# MDur
mtcars
})
output$selected_var <- renderText({
print("Yep!")
as.character(pfDataReactive())
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Next time, please, please, make more effort to provide a MWE. This post may help.
This is a good introduction to Shiny.

How to automatically navigate to another sidebar after data is uploaded in a sidebar within Shinydashboard?

Hello Shiny dashboard experts,
Following reprex works.
i.e. Once the file is uploaded in sidebar: mod1,
we can navigate to sidebar: mod2 and see the uploaded data displayed.
Below is the code:
1. Module to display with its UI
2. Module to read data with its UI
Server and UI for calling modules.
Can we automate this ?
i.e. Once the data is uploaded in sidebar: mod1,
sidebar: mod2 should be seen to the user with uploaded data.
library(shiny)
library(tidyverse)
# Module UI to read content
mod_readUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
fileInput(ns("file1"),
h3("Choose xlsx file"),
accept=c(".xlsx")),
actionButton(ns("ref"), "Refresh")
)
}
# Server modules of reading content
mod_read <- function(input, output, session){
# Uploaded data as reactive element
getData <- reactive({
req(input$file1) # Ensure file is uploaded
if(!is.null(input$file1)){
my_data <- readxl::read_excel(input$file1$datapath)
my_data
}
else{
my_data <- "nothing" %>% as.data.frame()
my_data
}
})
### In order to pass data as reactive elements to other module:
# Created list
reactive({
# browser()
list("excl" = getData())
})
}
# Module UI to display content
mod_displayUI <- function(id) {
ns <- shiny::NS(id)
shiny::tagList(
DT::dataTableOutput(ns("contents"))
)
}
# Server functions
mod_display <- function(input, output, session, file) {
output$contents <- DT::renderDataTable({
req(file())
DT::datatable(file()$excl,
options = list(pageLength = 7,scrollX = TRUE))
})
}
ui <-
shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(),
shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "menu1",
shinydashboard::menuItem('mod1',
tabName = 'mod1',
icon = shiny::icon('file')),
shinydashboard::menuItem('mod2',
tabName = 'mod2',
icon = shiny::icon('file'))
)),
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem("mod1",
mod_readUI("sidemod1")),
shinydashboard::tabItem("mod2",
mod_displayUI("bodymod2")
)
)))
server <- function(input, output) {
# storing mod_read in a variable
readFile1 <- shiny::callModule(mod_read, "sidemod1")
# passing the output of readFile into mod_display module
displayFile <- shiny::callModule(mod_display, "bodymod2", file = readFile1)
}
shinyApp(ui,server)
I suppose you can add an observe to see when the sidemod1-file1 input is not NULL or changes. When that happens, you can use updateTabItems. Note you need to have session as a server function argument as well.
server <- function(input, output, session) {
# storing mod_read in a variable
readFile1 <- shiny::callModule(mod_read, "sidemod1")
# passing the output of readFile into mod_display module
displayFile <- shiny::callModule(mod_display, "bodymod2", file = readFile1)
observe({
req(input$`sidemod1-file1`)
updateTabItems(session, "menu1", "mod2")
})
}

Unexpected behavior of req()

I experienced an unexpected behavior of my R shiny code and I'm asking myself if this is bug or if I don't understand how req() works.
I have an app where the user first uploads a *.txt file containing data with a location id, a date, and other data. Then the user has to choose two numerical values. The data is checked for NAs in the col date. If there are no NAs a text should appear telling the user everything is fine.
Below are two versions of my code. In output$txt <- renderText({ I use req() to test if all inputs are set and the file is loaded.
The differences between the two codes are the ordering of the last two arguments in req. Whereas in the first version, the green text appears already when both numeric inputs are set even the file is not uploaded, the second code behaves as expected; the user has to choose the numeric value and has to choose a file before the green bar with text appears.
Why makes the ordering of the arguments in req() a difference?
Code 1:
library(shiny)
library(lubridate)
# UI
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
fileInput("file1", label = h4("file upload")),
numericInput("in1", label = h4("first input"),value = 2.5, step=0.5),
numericInput("in2", label = h4("second input"),value = NULL, step=0.5)
)
),
column(8,
h4(textOutput("txt"), tags$style(type="text/css", "#txt {vertical-align:top;align:center;color:#000000;background-color: #4cdc4c;}")),
h2(""),
textOutput("fileinfo"),
tableOutput("tab_data")
)
)
)
# SERVER
server <- function(input, output) {
output$txt <- renderText({
req(input$in1, input$in2, fl_data(), input$file1)
"your data is ok and you have chosen input 1 and 2"
})
fl_data <- reactive({
validate(
need(input$file1 != "", "upload data and choose input 1 and 2...")
)
inFile <- input$file1
if (is.null(inFile)) {
return(NULL)
} else {
dd <- read.table(inFile$datapath, sep=";", stringsAsFactors=FALSE, header=TRUE)
dd[,2] <- ymd(dd[,2])
if (sum(is.na(dd[,2]))>0) dd <- NULL
}
})
output$tab_data <- renderTable({head(fl_data()[,1:4])})
output$fileinfo <- renderPrint({input$file1})
}
# Run the application
shinyApp(ui = ui, server = server)
Code 2:
library(shiny)
library(lubridate)
# UI
ui <- fluidPage(
fluidRow(
column(4,
wellPanel(
fileInput("file1", label = h4("file upload")),
numericInput("in1", label = h4("first input"),value = 2.5, step=0.5),
numericInput("in2", label = h4("second input"),value = NULL, step=0.5)
)
),
column(8,
h4(textOutput("txt"), tags$style(type="text/css", "#txt {vertical-align:top;align:center;color:#000000;background-color: #4cdc4c;}")),
h2(""),
textOutput("fileinfo"),
tableOutput("tab_data")
)
)
)
# SERVER
server <- function(input, output) {
output$txt <- renderText({
req(input$in1, input$in2, input$file1, fl_data())
"your data is ok and you have chosen input 1 and 2"
})
fl_data <- reactive({
validate(
need(input$file1 != "", "upload data and choose input 1 and 2...")
)
inFile <- input$file1
if (is.null(inFile)) {
return(NULL)
} else {
dd <- read.table(inFile$datapath, sep=";", stringsAsFactors=FALSE, header=TRUE)
dd[,2] <- ymd(dd[,2])
if (sum(is.na(dd[,2]))>0) dd <- NULL
}
})
output$tab_data <- renderTable({head(fl_data()[,1:4])})
output$fileinfo <- renderPrint({input$file1})
}
# Run the application
shinyApp(ui = ui, server = server)
req short-circuits, just like the && and || operators. As soon as it comes across an unavailable value (args evaluated left-to-right), it stops the reactive chain and doesn't care about any further args.
In the second example, input$file1 prevents fl_data() from ever executing if missing, so the validation in fl_data never occurs. But rather than order the req args like in the first example, I would just remove the check for input$file1 in output$txt, as it's already being checked in fl_data.

Resources