I am trying to build a GUI using gWidgets R library to download satellite imagery. The intention is to read the urls from a comma separated values file. The GUI looks ok but it does not do what I expect it to do. I am doing something wrong, any help is greatly appreciated.
Here is the sample data:
Online.Access.URLs <- c("http://e4ftl01.cr.usgs.gov//MODIS_Composites/MOLT/MOD09A1.005/2000.02.18/MOD09A1.A2000049.h09v06.005.2006268183648.hdf",
"http://e4ftl01.cr.usgs.gov//MODIS_Composites/MOLT/MOD09A1.005/2000.02.26/MOD09A1.A2000057.h09v06.005.2006270065224.hdf",
"http://e4ftl01.cr.usgs.gov//MODIS_Composites/MOLT/MOD09A1.005/2000.03.05/MOD09A1.A2000065.h09v06.005.2006269234536.hdf")
Producer.Granule.ID <- c("MOD09A1.A2000049.h09v06.005.2006268183648.hdf",
"MOD09A1.A2000057.h09v06.005.2006270065224.hdf",
"MOD09A1.A2000065.h09v06.005.2006269234536.hdf")
df <- data.frame(Producer.Granule.ID,Online.Access.URLs)
write.csv(df,"C:\\GUI_test\\h09v06v3.csv",row.names=FALSE)
And this is my try:
my.DownloadHDF <- function(){
library(gWidgets)
library(gWidgetstcltk)
library(RCurl)
options(guiToolkit = "tcltk")
win <- gwindow("Download HDF with R!", visible = FALSE)
csv.frame <- gframe("csv file ", container = win)
csv.label <- glabel("csv with HDF's names ", container = csv.frame)
csv.file.name <- gfilebrowse("Select csv file", type="open",cont=csv.frame,action="read.csv")
dir.frame <- gframe("Output Directory ", container = win)
dir.label <- glabel("Where to save HDF's? ", container = dir.frame)
dir.out <- gfilebrowse("Select folder ",type = "selectdir", cont=dir.frame)
dlw.frame <- gframe("Download ", container = win)
dlw.label <- glabel(" ", container = dlw.frame)
btnDwn <- gbutton("Start Download", container = dlw.frame,
handler = function(csv.file.name,dir.out){
df <- read.csv(csv.file.name, header=TRUE,sep=",")
hdf.urls <- df$Online.Access.URLs
hdf.urls <- as.character(hdf.urls)
hdf.names <- df$Producer.Granule.ID
hdf.names <- as.character(hdf.names)
for (i in 1:length(hdf.names)){
URL <- hdf.urls [i]
file <- hdf.names[i]
download.file(URL,paste(dir.out,file,sep=""),mode="wb")
cat(paste("Composite number ",i,"successfully downloaded!"),sep="\n")
cat("\n\n\n\n\n\n\n\n")
}})
visible(win) <- TRUE
}
my.DownloadHDF()
I am using R-3.2.2 with RStudio 0.98.1103.
Here is the script after the improvements. Now it does exactly what I expect it to do. I hope someone finds it useful:
# load functions ####
# download function
f.d <- function(hdf.urls,hdf.names,out.dir){
for(i in 1:length(hdf.urls)){
URL <- hdf.urls [i]
file <- hdf.names [i]
download.file(URL,paste(out.dir,"/",file,sep=""),mode="wb")
}}
# read csv function
f.csv <- function(x){
df1 <<- read.csv(x,header=TRUE,sep=",")
hdf.urls <<- df1$Online.Access.URLs
hdf.urls <<- as.character(hdf.urls)
hdf.names <<- df1$Producer.Granule.ID
hdf.names <<- as.character(hdf.names)
}
# load functions ####
# my.DownloadHDFv2 this one works fine ####
my.DownloadHDF <- function(){
options(guiToolkit = "tcltk")
win <- gwindow("Download HDF with R!", visible = FALSE)
csv.frame <- gframe("csv with HDFs names ", container = win)
a <- gfilebrowse("Upload csv file",cont=csv.frame,
handler=function(h,...){
f.csv(svalue(a))
})
path.frame <- gframe("Output Directory ", container = win)
brow <- gfilebrowse(text = "Select folder...", type = "selectdir",container=path.frame,
handler=function(h,...){
out.dir <<- svalue(brow)
})
b <- gbutton(text="Start Download",container = win,
handler = function(h,...){
f.d(hdf.urls,hdf.names,out.dir=out.dir)
})
visible(win)<-TRUE
}
my.DownloadHDF()
# my.DownloadHDFv2 this one works fine ####
Related
I'm trying to write a function to wrap up some data frames for export to Excel using the openxlsx package. It fails when running from a downloadHandler function in a Shiny app, but runs fine on the console in R.
Regular R script that runs fine:
library(openxlsx)
datDf1 <- data.frame(grr = c(1:10),
hrm = c(11:20),
boo = c(21:30))
datDf2 <- data.frame(will = c(31:40),
this = c(41:50),
work = c(51:60))
addSheetFun <- function(df, datName){
addWorksheet(wbExp, sheetName=datName)
writeData(wbExp, sheet=datName, df)
freezePane(wbExp, sheet=datName, firstRow=TRUE)
setColWidths(wbExp, sheet=datName, widths="auto", cols=1:ncol(df))
}
wbExp <- createWorkbook()
addSheetFun(datDf1, "SheetOne")
addSheetFun(datDf2, "SheetTwo")
Shiny application fails:
ui.r
shinyUI(
fluidPage(
downloadButton("xlExl", "Click to Export")
)
)
server.r
library(openxlsx)
library(shiny)
shinyServer(
function(
input, output, session
){
addSheetFun <- function(df, datName){
addWorksheet(wbExp, sheetName=datName)
writeData(wbExp, sheet=datName, df)
freezePane(wbExp, sheet=datName, firstRow=TRUE)
setColWidths(wbExp, sheet=datName, widths="auto", cols=1:ncol(df))
}
output$xlExl <- downloadHandler(
filename="Test.xlsx",
content=function(file){
datDf1 <- data.frame(grr = c(1:10),
hrm = c(11:20),
boo = c(21:30))
datDf2 <- data.frame(will = c(31:40),
this = c(41:50),
work = c(51:60))
wbExp <- createWorkbook()
addSheetFun(datDf1, "SheetOne")
addSheetFun(datDf2, "SheetTwo")
saveWorkbook(wbExp, file, overwrite=TRUE)
}
)
}
)
The error I get when running from Shiny is: "Warning: Error in %in%: object 'wbExp' not found
[No stack trace available]"
I played around with tacking this this to the top of addSheetFun:
if (exists("wbExp")) {
wbExp <- wbExp
}
else {
wbExp <- createWorkbook()
}
and then calling it like so:
wbExp <- addSheetFun(datDf1, "SheetOne")
wbExp <- addSheetFun(datDf2, "SheetTwo")
but that only manages to overwrite the first sheet with the second.
Thoughts?
The Error explains why it fails, it can't find your wbExp.
Probably the easiest way to overcome the error is by using <<- when you createWorkbook.
So wbExp <<- createWorkbook(). Then your shiny app should work.
This is like 'superassignment' and will assign the object in the parent environment (suggest reading http://adv-r.had.co.nz/Environments.html)
Alternatively, you can include addSheetFun inside the downloadHandler just before
wbExp <- createWorkbook().
So server.R
library(openxlsx)
library(shiny)
shinyServer(
function(
input, output, session
){
output$xlExl <- downloadHandler(
filename="Test.xlsx",
content=function(file){
datDf1 <- data.frame(grr = c(1:10),
hrm = c(11:20),
boo = c(21:30))
datDf2 <- data.frame(will = c(31:40),
this = c(41:50),
work = c(51:60))
addSheetFun <- function(df, datName){
addWorksheet(wbExp, sheetName=datName)
writeData(wbExp, sheet=datName, df)
freezePane(wbExp, sheet=datName, firstRow=TRUE)
setColWidths(wbExp, sheet=datName, widths="auto", cols=1:ncol(df))
}
wbExp <- createWorkbook()
addSheetFun(datDf1, "SheetOne")
addSheetFun(datDf2, "SheetTwo")
saveWorkbook(wbExp, file, overwrite=TRUE)
}
)
}
)
Below is my code. It might seem a bit long but actually it's a VERY simple app.
The user is supposed to upload a tiny data frame (x.csv if you are in the US or x_Europe.csv if you are in Europe). Then the user should click on the button to start calculations. And then at the end the user should be able to download the results of those calculations as a data frame.
My problem: after I upload the file, when I click on the 'do_it' action button - nothing happens. I can see it because nothing is being printed to my console. WHY? After all, my function 'main_calc' should be eventReactive to input$do_it? Why do all the calculations inside main_calc start happening ONLY after the user tries to download the results?
Important: It is important to me to keep the 'Data' function separately from main_calc.
Thank you very much!
First, generate one of these 2 files in your working directory:
# generate file 'x.csv' to read in later in the app:
write.csv(data.frame(a = 1:4, b = 2:5), "x.csv", row.names = F) # US file
write.csv2(data.frame(a = 1:4, b = 2:5), "x_Europe.csv", row.names = F)
This is the code for the shiny app:
library(shiny)
ui <- fluidPage(
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x.csv'!")),
br(),
actionButton("do_it", "Click Here First:"),
br(),
br(),
textInput("user_filename","Save your file as:", value = "My file x"),
downloadButton('file_down',"Save the output File:")
)
server <- function(input, output, session) {
#----------------------------------------------------------------------
# Function to read in either European (csv2) or American (csv) input:
#----------------------------------------------------------------------
ReadFile <- function(pathtofile, withheader = TRUE){
test <- readLines(pathtofile, n = 1)
if (length(strsplit(test, split = ";")[[1]]) > 1) {
print("Reading European CSV file")
outlist <- list(myinput = read.csv2(pathtofile, header = TRUE),
europe.file = 1)
} else {
print("Reading US CSV file")
outlist <- list(myinput = read.csv(pathtofile, header = TRUE),
europe.file = 0)
}
return(outlist)
}
#----------------------------------------------------------------------
# Data-related - getting the input file
#----------------------------------------------------------------------
Data <- reactive({
print("Starting reactive function 'Data'")
# Input file:
infile_x <- input$file_x
myx <- ReadFile(infile_x$datapath)$myinput
# European file?
europe <- ReadFile(infile_x$datapath)$europe.file
print("Finishing reactive function 'Data'")
return(list(data = myx, europe = europe))
})
#----------------------------------------------------------------------
# Main function that should read in the input and 'calculate' stuff
# after the users clicks on the button 'do_it' - takes about 20 sec
#----------------------------------------------------------------------
main_calc <- eventReactive(input$do_it, {
req(input$file_x)
# Reading in the input file:
x <- Data()$data
print("Done reading in the data inside main_calc")
# Running useless calculations - just to kill time:
myvector <- matrix(unlist(x), ncol = 1, nrow = 1000)
print("Starting calculations")
for (i in seq_len(10)) {
set.seed(12)
mymatr <- matrix(abs(rnorm(1000000)), nrow = 1000)
temp <- solve(mymatr) %*% myvector
}
print("Finished calculations")
# Creating a new file:
y <- temp
result = list(x = x, y = y)
print("End of eventReactive function main_calc.")
return(result)
}) # end of main_calc
#----------------------------------------------------------------------
# The user should be able to save the output of main_calc as a csv file
# using a string s/he specified for the file name:
#----------------------------------------------------------------------
output$file_down <- downloadHandler(
filename = function() {
paste0(input$user_filename, " ", Sys.Date(), ".csv")
},
content = function(file) {
print("Europe Flag is:")
print(Data()$europe)
if (Data()$europe == 1) {
x_out <- main_calc()$x
print("Dimensions of x in downloadHandler are:")
print(dim(x_out))
write.csv2(x_out,
file,
row.names = FALSE)
} else {
x_out <- main_calc()$x
print("Dimensions of x in downloadHandler are:")
print(dim(x_out))
write.csv(x_out,
file,
row.names = FALSE)
}
}
)
} # end of server code
shinyApp(ui, server)
Below is the solution - based on MrFlick's suggestions:
# generate file 'x.csv' to read in later in the app:
# write.csv(data.frame(a = 1:4, b = 2:5), "x.csv", row.names = F)
# write.csv2(data.frame(a = 1:4, b = 2:5), "x_Europe.csv", row.names = F)
library(shiny)
library(shinyjs)
ui <- fluidPage(
# User should upload file x here:
fileInput("file_x", label = h5("Upload file 'x.csv'!")),
br(),
actionButton("do_it", "Click Here First:"),
br(),
br(),
textInput("user_filename","Save your file as:", value = "My file x"),
downloadButton('file_down',"Save the output File:")
)
server <- function(input, output, session) {
#----------------------------------------------------------------------
# Function to read in either European (csv2) or American (csv) input:
#----------------------------------------------------------------------
ReadFile <- function(pathtofile, withheader = TRUE){
test <- readLines(pathtofile, n = 1)
if (length(strsplit(test, split = ";")[[1]]) > 1) {
print("Reading European CSV file")
outlist <- list(myinput = read.csv2(pathtofile, header = TRUE),
europe.file = 1)
} else {
print("Reading US CSV file")
outlist <- list(myinput = read.csv(pathtofile, header = TRUE),
europe.file = 0)
}
return(outlist)
}
#----------------------------------------------------------------------
# Data-related - getting the input file
#----------------------------------------------------------------------
Data <- reactive({
print("Starting reactive function Data")
# Input file:
infile_x <- input$file_x
myx <- ReadFile(infile_x$datapath)$myinput
# European file?
europe <- ReadFile(infile_x$datapath)$europe.file
print("Finishing reactive function 'Data'")
return(list(data = myx, europe = europe))
})
#----------------------------------------------------------------------
# Main function that should read in the input and 'calculate' stuff
# after the users clicks on the button 'do_it' - takes about 20 sec
#----------------------------------------------------------------------
# Creating reactive Values:
forout_reactive <- reactiveValues()
observeEvent(input$do_it, {
print("STARTING observeEvent")
req(input$file_x)
# Reading in the input file:
x <- Data()$data
print("Done reading in the data inside observeEvent")
# Running useless calculations - just to kill time:
myvector <- matrix(unlist(x), ncol = 1, nrow = 1000)
print("Starting calculations")
for (i in seq_len(10)) {
set.seed(12)
mymatr <- matrix(abs(rnorm(1000000)), nrow = 1000)
temp <- solve(mymatr) %*% myvector
} # takes about 22 sec on a laptop
print("Finished calculations")
# Creating a new file:
y <- temp
forout_reactive$x = x
forout_reactive$y = y
print("End of observeEvent")
}) # end of main_calc
#----------------------------------------------------------------------
# The user should be able to save the output of main_calc as a csv file
# using a string s/he specified for the file name:
#----------------------------------------------------------------------
output$file_down <- downloadHandler(
filename = function() {
paste0(input$user_filename, " ", Sys.Date(), ".csv")
},
content = function(file) {
print("Europe Flag is:")
print(Data()$europe)
if (Data()$europe == 1) {
y_out <- forout_reactive$y
print("Dimensions of y in downloadHandler are:")
print(dim(y_out))
write.csv2(y_out,
file,
row.names = FALSE)
} else {
y_out <- forout_reactive$y
print("Dimensions of y in downloadHandler are:")
print(dim(y_out))
write.csv(y_out,
file,
row.names = FALSE)
}
}
)
} # end of server code
shinyApp(ui, server)
Here is a simple app that may help elucidate how eventReactive() works:
library(shiny)
run_data <- function() {
paste0("Random number generated in eventReactive: ", runif(1))
}
ui <- basicPage(
actionButton("run1", "Invalidate eventReative()"),
actionButton("run2", "Trigger observeEvent()"),
verbatimTextOutput("data")
)
server <- function(input, output, session) {
# Initialize reactiveValues list
# to use inside observeEvent()
rv <- reactiveValues(data = NULL)
# This eventReactive() doesn't run when run1 button is
# clicked. Rather, it becomes invalidated. Only when
# data() (the reactive being returned) is actually
# called, does the expression inside actually run.
# If eventReactive is not invalidated by clicking run1
# then even if data() is called, it still won't run.
data <- eventReactive(input$run1, {
showNotification("eventReactive() triggered...")
run_data()
})
# Every time run2 button is clicked,
# this observeEvent is triggered and
# will run. If run1 is clicked before run2,
# thus invalidating the eventReactive
# that produces data(), then data() will
# contain the output of run_data() and
# rv$data will be assigned this value.
observeEvent(input$run2, {
showNotification("observeEvent() triggered")
rv$data <- data()
})
# Renders the text found in rv$data
output$data <- renderText({
rv$data
})
}
shinyApp(ui, server)
In this example, run1 invalidates the eventReactive(), and run2 triggers the observeEvent() expression. In order for the data (in this case just a random number) to print, run1 must be clicked prior to run2.
The key takeaway is that the input(s) (buttons) that eventReactive() listens to don't trigger eventReactive(). Instead, they invalidate eventReactive() such that when the output from eventReactive() is required, then the expression inside eventReactive() will run. If it is not invalidated or the output is not needed, it will not run.
I have an rshiny app and i'm trying to download a csv file from the app after it is edited. I followed the examples online, but the download button isn't working. I know the button is fine, its copied directly from the rshiny documentation. I assume the error is server side
server <-function(input,output){# Combine the selected variables into a new data frame
#output$value <- renderPrint({
# str(input$GimmeCSV[2,2])
output$table.preview <- renderTable({
inFile <- input$GimmeCSV
preview <- read.csv(inFile$datapath, header=TRUE, sep=",")
return(head(preview)) # undo Table can be modified
})
output$table.output <- renderTable({
inFile <- input$GimmeCSV
tbl <- read.csv(inFile$datapath, header=TRUE, sep=",")
#return(head(tbl)) # undo Table can be modified
################^ preview of csv table################
#look up how to extract the columns with no name present(something numerical)
#After that is figured out calculating the rest of those values will be a snap
#tbl <- read.csv(inFile$datapath, header=TRUE, sep=",")
#below is temporary file path only used for testing purposes, the above read.csv is the true pooba
#STANDARDS!!!
solar <- tbl$solar
temp <- tbl$temp
ws <- tbl$ws
#return(head(solar))
Ktemp <-temp + 273
ktemp <-temp + 273
#lol
if ((input$Shape) == shape_select[1]){
Len <- (input$diacone)
Height <- (input$hgtcone)
Width <- 0
} else {if((input$Shape) == shape_select[2]){
Len <- (input$diasphere)
Height <- 0
Width <- 0
}
else
Len <- (input$lenprism)
Height <- (input$hgtprism)
Width <- (input$widprism)
}
r <-Len/2
#return(r)
if (Len >=0.037){ # Absorptivity from Luke Miller
Abs <- 0.615
} else {if (Len <= 0.02225 ){Abs <-0.689
} else Abs <- 0.68 }
#works!
Emm <-0.97
#TOTALLY ARBITURARY SURFACE AREA VALUES BASED ON WHAT I KNOW!
ConeA <- (pi*r*r) + (sqrt((Height*Height)+(r*r))) # area of cone
SphereA <- (4*pi*(r*r)) #area of sphere
PrismA <- ((2*Len*Width) + (2*Height*Len) +( 2*Height*Width))
#return(PrismA)
#WORKS
#Deciding which surface area area to calculate
if ((input$Shape) == shape_select[1]){
SA <-ConeA
} else {if((input$Shape) == shape_select[2]){SA <- SphereA}
else SA <-PrismA}
#WOEKS!!!!!!!
#return(SA)
#Temporary placeholder values for PSA
PSA <- SA
SB <- 5.67E-08 # Stephan Boltzman constant
eskyclear <- 0.72 + (0.005*temp)
CC <- 0.5 #Cloud over 0 - 1
esky <- eskyclear + CC*(1 - eskyclear - (8/ktemp)) #IR emissivity from sky
Aradsky <- SA/2 #surface area projected to the sky
Aradground <- SA/2 # surface area projected to the ground
K3 <- esky^(1/4)
K2 <- 4 * SB * Emm * (esky)^(3/4)
K4 <- 4 * SB * Emm
K5 <- 0.6/(0.5*Len)
hc <- 0.6
com1 <- (Abs * solar) + (K2 * (Aradsky/PSA) * K3 * Ktemp^4) + (K4 * (Aradground/PSA) * Ktemp^4) + (K5 * PSA * Ktemp) + (hc*SA*Ktemp) + 2.48*0
com2 <- (4180 * 0) + ((Ktemp^3) * K2 * (Aradsky/PSA)) + (K4 * (Aradground/PSA) *(Ktemp^3)) + (hc*SA) + (K5*PSA)
#works!
Sol <- com1 / com2
modeltemp <- Sol - 273
max <- max(modeltemp)
min <- min(modeltemp)
mydata <- data.frame( Daily_Temp = temp, Solar_Radiation = solar, Body_Temperature = modeltemp, stringsAsFactors = FALSE)
return(mydata)
output$downloadData <- downloadHandler(
filename = function() { paste(input$inFile, '.csv', sep='') },
content = function(file) {
write.csv(mydata, file)
}
)
})
} #app goes here lol
shinyApp(ui, server)
}
Any sugestions are appreciated
I rearranged your code a bit and created 2 reactiveValues at the beginning of the server function.
In an observeEvent, you wait until the fileInput-Button (input$GimmeCSV) is clicked, it reads the csv then and assigns it to the reactive value inputFile. Then you can access this value directly in both renderTable outputs, as you would load the csv twice in your example. If the file is not too big, it shouldnt be a problem, but its not necessary.
The downloadHandler goes outside the renderTable function and takes the input argument (input$inFile), which is used to name the output file. For the content, the second reactiveValue is used, where the data was assigned in output$table.output.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("GimmeCSV", "Upload a CSV", multiple = F),
textInput("inFile", "Name for Output"),
downloadLink("downloadData", "Download")
),
mainPanel(
tableOutput("table.preview"),
tableOutput("table.output")
)
)
)
server <-function(input,output){
inputFile <- reactiveValues(file = NULL)
outputFile <- reactiveValues(file=NULL)
observeEvent(input$GimmeCSV, {
inFile <- input$GimmeCSV
data <- read.csv(inFile$datapath, header=TRUE, sep=";")
inputFile$file <- data
})
output$table.preview <- renderTable({
head(inputFile$file)
})
output$table.output <- renderTable({
tbl <- inputFile$file
outputFile$file <- tbl
tbl
})
output$downloadData <- downloadHandler(
filename = function() {
paste(input$inFile, '.csv', sep='')
},
content = function(file) {
write.csv(outputFile$file, file)
}
)
}
shinyApp(ui, server)
Hope it helps.
x <- gconfirm("Run Program?",title="gConfirm")
if (x){
w <- gwindow(title="List of Programs",visible=TRUE)
g = ggroup(horizontal = FALSE, cont=w)
glabel("Please select the Program", cont=g)
ptype <- c("A","B")
temp <- gcombobox(ptype , cont=g)
addHandlerChanged(temp , handler=function(...){})
gbutton("Run", cont=g,handler = function(...){
print(svalue(temp)
dispose(g)
runagain <- gconfirm("Run again?",title="gConfirm")
if(runagain){
## If user clicks okay, I want to start running again from the third line of the code, w <- gwindow......)**
}
}
Can anyone hint a work around that? Also how do I display the svalue(temp) in to similar UI box instead of printing it on the console. Any help is much appreciated.
SOmething like this might get you what you want:
library(gWidgets2)
programs = list("Program A"="a.R",
"Program B" = "b.R")
w <- gwindow("run programs")
g <- ggroup(cont=w, horizontal=FALSE)
fl <- gformlayout(cont=g)
cb <- gcombobox(names(programs), cont=fl, label="Select a program to run")
b <- gbutton("Run selected program", cont=fl, label="", handler=function(h,...) {
prog <- svalue(cb)
val <- gconfirm(sprintf("Run program %s?", prog), parent=w)
if (val) {
source(programs[[val]])
gmessage("All done", parent=w)
}
})
I am currently working on a project in which a user, inputs into the app a set of editrules for an uploaded data set. The user inputs the rule through a textbox input in the UI. I planned to create a text file which contains the editrules set by the user.
Now, my problem is creating a code which creates a list or a vector that contains these editrules since I cant think of a way to insert the user's input into the code. Here is what I have done:
textprepGen <- function(x,y,z){
for(i in 1:x){
z[[i]] <- paste(y[1], paste("input",
paste("input",i, sep = "_"), sep = "$"), sep = " ")
}
return(z)
}
The reason it does not work is because the paste function automatically sets the code into character so it does not read the input, input$input_1, input$input_2, ...
Any suggestions?
Here is the UI and the Server:
shinyUI(fluidPage(theme="bootstrap.css",
titlePanel("Edit Rules"),
sidebarPanel(
fileInput('file_upload', 'Upload CSV File',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
uiOutput("editrulePanel")
),
mainPanel(
h4("Data Summary")
)
)
)
shinyServer(function(input, output, session) {
# Text input list assignment in order for the data to show up in UI
textinpList <-vector("list", 20)
# Textfile preparation for the lines to be written on the textfile
textprepList <- vector(20)
# Function to generate text inputs
## A for loop is used to generate only the columns that are in the data file
textinpGeneration <- function(x,y,z){
for(i in 1:x){
z[[i]] <- list(textInput(paste("text", i, sep = "_"),
label = h5(y[i]),
value = ">= 0"
)
)
}
return(z)
}
textprepGen <- function(x,y,z){
for(i in 1:x){
z[[i]] <- paste(y[1], paste("input",
paste("input",i, sep = "_"), sep = "$"), sep = " ")
}
return(z)
}
# Dynamic UI
output$editrulePanel <- renderUI ({
# Assigns the input of the uploaded data to a variable
inFile <- input$file_upload
# If no file is uploaded, no table will be displayed in the main panel
if (is.null(inFile))
return(NULL)
# Read csv file uploaded
dataFile <- read.csv(inFile$datapath)
# Count the number of columns of the data file and assign to a variable
## This is used to know the number of options
## to show in the editrule panel
dataCol <- as.numeric(ncol(dataFile))
# Read the column names and assign to a variable
datacolName <- colnames(dataFile)
textprepGen(dataCol, datacolName, textprepList)
# Conditional panel for editrules show if a file has been uploaded
conditionalPanel(condition = "is.null(inFile) == FALSE",
h4("Please input edit rule"),
textinpGeneration(dataCol,datacolName,textinpList)
)
})
# Preparation for writing a textfile
editruleFile <- file("editrules.txt")
writeLines(c(textprepList), editruleFile)
close(editruleFile)
})
The result textfile I wanted to achieve:
# numerical rules
RECOV <= 0
PAID >= 0
CASE >= 0
INC >= 0
Only the logical symbols and the number is the user input.
Anyway, thank you so much Eugene Choe. Just got my code working. Also figured it out to write it in the textfile properly.
Here is the final code for the inputs:
for(i in 1:addruleNumber){
textprepList[i+1+dataCol] <- list(paste(
eval(parse(text = paste("input",
paste("lhand",i,sep="_"),
sep = "$"))),
eval(parse(text = paste("input",
paste("logexp",i,sep="_"),
sep = "$"))),
eval(parse(text = paste("input",
paste("rhand",i,sep="_"),
sep = "$"))),
sep = " "))
}
And here is how I fixed the textfile output:
textprepList[1] <- "# numerical rules"
for(i in 1:dataCol){
textprepList[i+1] <- list(paste(datacolName[i],
eval(parse(text = paste("input",
paste("text",i,sep="_"),
sep = "$"))), sep = " "))
}