I want to make my server.R file to load the csv file of a binary matrix when it starts.
library(shiny)
server <- function(input, output) {
#this aint loading
df <- read.csv("starGraphAdjMatrix.csv",
header = TRUE,
sep = ",",
quote='"')
#output$loadedMat -> output$loadedMat
output$loadedMat <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
#falsy value if empty
req(input$file1)
# when reading semicolon separated files,
# having a comma separator causes `read.csv` to error
tryCatch(
{
df <- read.csv(input$file1$datapath,
header = TRUE,
sep = ",",
quote='"')
df$X <- NULL
},
error = function(e) {
# return a safeError if a parsing error occurs
stop(safeError(e))
}
)
return(df)
},
rownames = FALSE, colnames = FALSE)
}
Full code including ui.R and the starGraphAdjMatrix here:
https://github.com/andandandand/fixCSVLoad
Not sure if this is what you were after:
library(shiny)
server <- function(input, output) {
output$contents <- renderTable({
if (is.null(input$file1$datapath)) {
dpath <- "starGraphAdjMatrix.csv"
} else {
dpath <- input$file1$datapath
}
read.csv(dpath)
}, rownames = FALSE, colnames = FALSE)
}
Related
I am creating an app to allow user to upload two excel files and carry over the comments one to the other one, then to download the merged file. The downloadhandler is not working when I tried to run it on the published server, however it running properly locally in rstudio. Any thoughts/suggestions?
library(plyr)
library(dplyr)
library(tidyr)
library(readxl)
library(xlsx)
library(openxlsx)
ui <- fluidPage(
br(),
titlePanel("Excel File Merging Tool"),
br(),
br(),
sidebarLayout(
sidebarPanel(
fileInput("file1", label = h3("Upload New File"), multiple = FALSE, buttonLabel = "Browse", placeholder = "No file selected"),
fileInput("file2", label = h3("Upload Old File"), multiple = FALSE, buttonLabel = "Browse", placeholder = "No file selected"),
actionButton("actionMerge", label = "Merge Uploaded Files"),
hr(),
downloadButton('downloadData', 'Download Merged File')
),
mainPanel(
)
)
)
#Defined Funtions
read_excel_allsheets <- function(filename, tibble = FALSE) {
sheets <- readxl::excel_sheets(filename)
x <- lapply(sheets, function(X) readxl::read_excel(filename, sheet = X))
if(!tibble) x <- lapply(x, as.data.frame)
names(x) <- sheets
x
}
server <- function(input, output) {
getData <- eventReactive(input$actionMerge, {
inFile1 <- input$file1
if (is.null(inFile1)){
return(NULL)
} else {
mydata1= read_excel_allsheets(inFile1$datapath)}
inFile2 <- input$file2
if (is.null(inFile2)){
return(NULL)
} else {
mydata2= read_excel_allsheets(inFile2$datapath)}
wb <- createWorkbook()
#find tabs not in old file
newSheets <- (names(mydata1))[which(!(names(mydata1)) %in% (names(mydata2)))]
if (length(newSheets) > 0){
for (n in newSheets)
{
mydata6 <- bind_rows(mydata1[n])
addWorksheet(wb, sheetName = names(mydata1[n]))
writeData(wb, names(mydata1[n]), mydata6)
}}
for (i in names(mydata1)){
for (j in names(mydata2)){
if (i == j ){
if ((nrow(as.data.frame(mydata1[i]))) == 0 | (nrow(as.data.frame(mydata2[j]))) == 0 )
{
mydata6 <- bind_rows(mydata1[i])
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}
else {
if (ncol(bind_rows(mydata1[i])) == ncol(bind_rows(mydata2[j])) )
{
mydata6 <- bind_rows(mydata1[i])
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}
else {
# validate(
# column_mismatch(mydata1[i], mydata2[j])
# )
drop_in_key <- c("Earliest data creation time", "Latest data update time", "Timestamp of last save in clinical views", "Date time value from the source file name",
"Lowest Date of Rec, Pg, Inst or Subj", "Record Minimum Created Datetime Stamp", "Record Maximum Updated Datetime Stamp", "Accessible to Jreview Timestamp")
mydatax0 = bind_rows(mydata1[i])
mydatax = bind_rows(mydata1[i])[,!(names(bind_rows(mydata1[i])) %in% drop_in_key)]
mydatanew <- mydatax %>% unite(col="Key", 1:(ncol(mydatax)-1), sep=";", remove=FALSE)
mydatanew$Newflag <- "New"
mydatanew0 = mydatanew %>% select(Key, Newflag)
mydatanew1 = bind_cols(mydatanew0,mydatax0)
mydatay0 = bind_rows(mydata2[j])
mydatay = bind_rows(mydata2[j])[,!(names(bind_rows(mydata2[j])) %in% drop_in_key)]
mydataold <- mydatay %>% unite(col="Key", 1:(ncol(mydatay)-1), sep=";", remove=FALSE)
mydataold$Oldflag <- "Old"
mydataold0 <- mydataold %>% select(Oldflag, Key)
mydataold1 <- bind_cols(mydataold0,mydatay0)
mydataold2 = select(mydataold1, Key, Oldflag, (ncol(bind_rows(mydata1[i]))+3):((ncol(mydataold1))))
mydata3 <- merge(x=mydatanew0, y=mydataold2, by="Key", all=TRUE)
mydata4 <- subset(mydata3, Newflag == "New")
mydata5 <- merge(x=mydatanew1, y=mydata4, by="Key", all.y=TRUE)
drop <- c("Key", "Newflag.x", "Oldflag", "Newflag.y")
mydata6 = mydata5[,!(names(mydata5) %in% drop)]
addWorksheet(wb, sheetName = names(mydata1[i]))
writeData(wb, names(mydata1[i]), mydata6)
}}}
else
NULL
}
}
saveWorkbook(wb, file = "aaa.xlsx" , overwrite = TRUE)
})
output$downloadData <- downloadHandler(
filename = function() {
paste0(input$file2, ".xlsx")
},
content = function(file) {
file.copy("aaa.xlsx", file)
})
}
shinyApp(ui = ui, server = server)```
Here's a toy shiny app that provides a solution that is safe for concurrent users. All operations are done on either (a) temporary files that shiny controls, or (b) in the directory of one of these temp files, using tempfile to create the new filename. Both of those assure new-file uniqueness, so no filename collisions. (I believe shiny's method is temporary directories under a temp-directory, at least that's what I'm seeing in my dev env here. So ... seemingly robust.)
The some_magic_function function is mostly because I didn't want to generate an example with openxlsx and sample datas and such, mostly my laziness. For your code, remove all of the if (runif... within the tryCatch and replace with whatever you need, ensuring your code ends by returning the filename with the new data (or updated) data.
... but keep the tryCatch! It will ensure that the function always returns "something". If all code succeeds, then the function will return the filename with new/updated data. If something goes wrong, it returns a class "error" string that can be used to communicate to the user (or otherwise react/recover).
Last thing, though it's just icing on my cupcake here: I use the shinyjs package to disable the 'merge' and 'download' buttons until there is valid data. Frankly, once the two file-selection inputs have something set, the "merge" button will likely never be disabled. However, if there's ever a problem during the merge/update, then the download button will be disabled (until a merge/update happens without error).
library(shiny)
library(shinyjs)
# a naive function that just concatenates the files, first removing
# the header row from the second file
some_magic_function <- function(f1, f2) {
# put the output file in the same directory as 'f2'
d <- dirname(f2)
if (!length(d)) d <- "."
output_file <- tempfile(tmpdir = d, fileext = paste0(".", tools::file_ext(f2)))
tryCatch({
if (runif(1) < 0.2) {
# purely for StackOverflow demonstration
stop("Something went wrong")
} else {
# add your stuff here (and remove the runif if/else)
writeLines(c(readLines(f1), readLines(f2)[-1]), output_file)
output_file # you must return this filename
}
}, error = function(e) e)
# implicitly returning the output_file or an error (text with class 'error')
}
shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
titlePanel("Tool"),
sidebarLayout(
sidebarPanel(
fileInput("file1", label = "File #1", multiple = FALSE, placeholder = "No file selected"),
fileInput("file2", label = "File #2", multiple = FALSE, placeholder = "No file selected"),
actionButton("btn", label = "Merge uploaded files"),
hr(),
downloadButton("dnld", "Download merged file")
),
mainPanel(
tableOutput("tbl"),
hr(),
verbatimTextOutput("bigtext")
)
)
),
server = function(input, output, session) {
# start with neither button enabled
for (el in c("btn", "dnld")) shinyjs::disable(el)
# disable the 'merge' button until both files are set
observeEvent({
input$file1
input$file2
}, {
req(input$file1, input$file2)
shinyjs::toggleState("btn", isTRUE(file.exists(input$file1$datapath) && file.exists(input$file2$datapath)))
})
# this is the "workhorse" of the shiny app
newfilename <- eventReactive(input$btn, {
req(input$file1, input$file2)
some_magic_function(input$file1$datapath, input$file2$datapath)
})
# prevent the download handler from being used if the new file does not exist
observeEvent(newfilename(), {
cond <- !is.null(newfilename()) &&
!inherits(newfilename(), "error") &&
file.exists(newfilename())
shinyjs::toggleState("dnld", cond)
})
output$dnld <- downloadHandler(
filename = function() paste0("merged_", input$file2),
content = function(f) {
file.copy(newfilename(), f)
}
)
# some sample output, for fun
output$tbl <- renderTable({
req(newfilename(),
!inherits(newfilename(), "error"),
file.exists(newfilename()))
read.csv(newfilename(), nrows = 10, stringsAsFactors = FALSE)
})
output$bigtext <- renderText({
if (inherits(newfilename(), "error")) {
# if we get here then there was a problem
as.character(newfilename())
} else "(No problem)"
})
}
)
Notes:
shiny::req is supposed to ensure the data has something useful and "truthy" in it (see shiny::isTruthy). Normally it is good with detecting nulls, NA, empty variables, etc ... but it "passes" something that has class "error", perhaps counter-intuitive. That's why I had to be a little more explicit with conditions in some of the reactive blocks.
One impetus for having the merge/update functionality within an external not-shiny-requiring function (some_magic_function here) is that it facilitates testing of the merge functionality before adding the shiny scaffolding. It's difficult to test basic functionality when one is required to interact with a browser for every debugging step of basic functionality.
I just started to play around in shiny and made a simple app that reads a CSV file and replaces rows of one column with tokens. I would like the user to be able to download the tokenized data as a CSV file.
To do this I am using the downloadHandler() function. I have been looking in the documentation for this function, as well as similar questions in here but haven't been able to find a solution. I tried running the app externally as suggested in other similar questions.
app.R
# Only run examples in interactive R sessions
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
tags$hr(),
checkboxInput("header", "Header", TRUE),
textInput(inputId = 'variable', label = 'Name of variable to pseudonymize', placeholder = 'e.g., ID_PA'),
helpText("Case sensitive!"),
downloadButton('downloadData', 'Download')
),
mainPanel(
tableOutput("contents"),
br(), br(),
tableOutput('results')
)
)
)
server <- function(input, output) {
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
head(read.csv(inFile$datapath, header = input$header))
})
output$results <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
df <- read.csv(inFile$datapath)
# make sure to use utils::read_csv to read in data
# Function generates a lookup table that associates each unique identifier to an PSN. See lillemets
get_lookup_table <- function(data, id.var, key.length) {
if (any(duplicated(data[, id.var]))) warning('Duplicate id values in data. For longitudinal dataset, this is expected')
PSN <- c(1,1) # Allow the while loop to begin
while (any(duplicated(PSN))) { # Loop until all keys are unique
PSN <- replicate(length(unique(data[, id.var])),
paste(sample(c(LETTERS, 0:9), key.length, replace = T), collapse = ''))
}
lookup.table <- data.frame(id = unique(data[, id.var]), key = PSN)
return(lookup.table)
}
# Replace names with PSN
add_PSN <- function(data, id.var, lookup.table) {
data[, id.var] <- lookup.table[, 'key'][match(data[, id.var], lookup.table[, 'id'])]
return(data)
}
lookup_table <- get_lookup_table(df, input$variable, 10)
# Replace names with PSN
pseudo_df <- add_PSN(df, input$variable, lookup_table)
head(pseudo_df)
})
# Download file
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(pseudo_df, file)
}
)
}
shinyApp(ui, server)
}
When running the app and clicking download, I get the browser error 'File not found'.
In the R console I get the warning: Error in is.data.frame: object 'pseudo_df' not found
Comments on this issue would be much appreciated.
The download handler does not know that the pseudo_df data frame was created. You probably want to have one reactive that makes the data frame and then separate render and download handlers that call the reactive that creates the data frame. So for example
make_df <- reactive({}) # code that makes the data frame goes here
output$results <- renderTable({make_df()})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(make_df(), file) # notice the call to the reactive again
}
)
I want to initialize the download of a file in R Shiny when a button is pressed and do some checks before generating the file.
I've fooled arround with the downloadHandler (https://shiny.rstudio.com/gallery/file-download.html). But I want to catch the event of another button, do some things and checks with the data and when everything went well generate the file and initialize the download without having to press the download button from downloadHandler.
I've implemented most checks for now in the downloadHandler, but it now generates a failed download when some checks aren't fulfilled. I don't like the behavior.
output$downloadData <- downloadHandler(
filename = function() { paste("DATA_EXPORT-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
withProgress(message = 'Export data', value = 0, {
# Number of steps
n <- 3
incProgress(1/n, detail = "Pre checks and get data")
# checks if inputs for get_data are well defined
dataSet <- get_data(blabla)
incProgress(1/n, detail = "Post Proces and check")
incProgress(1/n, detail = "generate flatfile")
write.csv(dataSet, file, row.names = FALSE)
})
}
)
To elaborate my comment, a minimal example:
library(shiny)
library(shinyjs)
# function which checks the data; returns TRUE or FALSE
checkData <- function(dat){
TRUE
}
# function which transforms the data; returns NULL if check not TRUE
processData <- function(dat){
if(checkData(dat)){
# do something with dat
names(dat) <- toupper(names(dat)) # for our example
return(dat)
}else{
return(NULL)
}
}
ui <- fluidPage(
useShinyjs(),
conditionalPanel(
"false", # always hide the download button
downloadButton("downloadData")
),
actionButton("check", "Download")
)
server <- function(input, output, session){
dat <- mtcars
finalData <- reactiveVal() # to store the processed data
observeEvent(input$check, {
if(!is.null(df <- processData(dat))){
finalData(df)
runjs("$('#downloadData')[0].click();")
}else{
# something which throws an alert message "invalid data"
# (eg with shinyBS::createAlert or shinyWidgets::sendSweetAlert)
}
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(finalData(), file)
}
)
}
shinyApp(ui, server)
I´m new using R and I would like to call from a script to another using source() function and by the way,passing some parameters. This are my two R scripts:
Server.r
library(shiny)
shinyServer(function(input, output) {
#esta funcion guarda el csv cargado
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(NULL)
}
read.csv(infile$datapath, sep = ";")
})
filedata1 <- reactive({
infile1 <- input$datafile1
if (is.null(infile1)) {
return(NULL)
}
read.csv(infile1$datapath, sep = ";")
})
observeEvent(input$do, {
source("C:/.../app1.R", params=filedata, params=filedata1, local = TRUE)
})
app.r
...
csv1=read.csv("filedata", sep = ";")
csv2=read.csv("filedata1", sep = ";")
...
I don´t know how to send both .csv inserted (filedata, filedata1) from Server.r to app.r.
Thank you very much in advance
In my below example of a simple shiny app i recently created, im currently trying to include also the possibility of downloading a data frame that is created from the results. I mention here part of the server.R script in order to not make a huge post:
shinyServer(function(input, output) {
table_options<- list(lengthMenu = list(c(5,10,15,20),
c('5','10', '15', '20')), pageLength = 15, ordering=TRUE,
class = 'cell-border stripe',dom ='t',scrollX = TRUE,
fixedColumns = list(leftColumns = 2, rightColumns = 1))
inTable <- reactive({# upload a tsv file
inFile <- input$file1
if (is.null(inFile))
return(NULL)
read.table(inFile$datapath,header=input$header,
sep="\t",stringsAsFactors = FALSE)
}) #END REACTIVE
rv <- reactiveValues()
rv$data <- NULL # to further use it into the observeEvent below
observeEvent(input$goButton, {
df <- inTable()
# some data manipulation with df...
if(input$repo_option=="mimic"){
# some functions here that result to a data frame named final dat
rv$data <- final.dat
rv$data
}
else if(input$repo_option=="reverse"){
# similar procedure...
rv$data <- final.dat
rv$data
}
})
output$contents <- DT::renderDataTable({
expr=DT::datatable(rv$data, options=table_options,
extensions ='FixedColumns',selection="none")
})
output$downloadData <- downloadHandler(
filename = function() { paste("input$file1", ".csv", sep=",") },
content = function(file) {
write.csv(rv$data,file)
}
)
})
My main issue is that, although the output$contents works fine in the app, when i press the download button from the ui.R server (not posted here for simplicity), the download "pop-up" window appears, but the saving does not work. Thus, i suspect that is something wrong with the code in the downloadHandler function, but any ideas or help ?