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)
}
)
}
)
Related
I am new to shiny, and trying to make a folder monitor based on #jdharrison 's reply at
Use reactivePoll to accumulate data for output
The f1, or check function, seems like a validator. Once it gives whatever results, it triggers the f2, the true action-taker. Then, we render the output.
As the toy sample runs, the f1 does creates files, but not producing the result of listing all the files, as expected.
by the way, the code is running on ubuntu, and the files are saved in a sub-directory called temp
Where did I go wrong?
Would like to invite your advice.
runApp(
list(
ui =
mainPanel(
tableOutput("DT")
),
server =
function(input, output, session) {
# f1 as a tempfile creater. Once it is called. it creates a txt
f1 <- function() system(paste0("touch ", tempfile(tmpdir = "./temp", fileext = "txt")))
# f2 list all the files
f2 <- function(){
list.files("temp", full.names = T)
}
data <- reactivePoll(5000, session, f1, f2)
output$DT <- renderTable(data())
}
)
)
Thanks to suggection from #TonioLiebrand. The f1, check function, is exactly what it is, a checking function.
After I change the return of f1, it works.
I will keep the post here maybe it might help someone someday.
runApp(
list(
ui =
mainPanel(
DTOutput("DT")
),
server =
function(input, output, session) {
f1 <- function() {
system(paste0("touch ", tempfile(tmpdir = "./temp", fileext = "txt")))
file.info(list.files("temp", full.names = T))["mtime"]
}
f2 <- function(){
list.files("temp", full.names = T) %>% as.matrix()
}
data <- reactivePoll(5000, session, f1, f2)
output$DT <- renderDT({datatable(data())})
}
)
)
I want to use Shiny within RMarkdown for users to upload data (xlsx file).
Then I want to pass all the worksheets as R data frames (w/o reactivity) to run rest of the RMarkdown file.
I mainly want to convert them into data frames so I can use reticulate to run Python code as well.
I've tried this, and it doesn't seem to quite work:
library(dplyr)
library(miniUI)
library(shiny)
library(XLConnect)
launch_shiny <- function() {
ui <- miniPage(
gadgetTitleBar("Input Data"),
miniContentPanel(
fileInput(inputId = "my.file", label = NULL, multiple = FALSE)
)
)
server <- function(input, output, session) {
wb <- reactive({
new.file <- input$my.file
loadWorkbook(
filename = new.file$datapath,
create = FALSE,
password = NULL
)
})
observeEvent(input$done, {
stopApp(c(wb()))
})
}
runGadget(ui, server)
}
test <- launch_shiny()
df1 <- readWorksheet(object = test, sheet = "sheet1")
df2 <- readWorksheet(object = test, sheet = "sheet2")
It throws this error:
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘readWorksheet’ for signature ‘"list", "character"’
I can return one sheet at a time using stopApp(readWorksheet(object = wb(), sheet = "sheet1")), but I can't seem to return an entire workbook or multiple data frames at the same time.
I don't really want to read in xlsx, save each sheet as csv in working directory, then read those files in again.
Would anyone have a good suggestion on how to get around this?
The documentation of fileInput() states in the details:
datapath
The path to a temp file that contains the data that was
uploaded. This file may be deleted if the user performs another upload
operation.
Meaning that the datapath given in the input variable is a temporary file that is no longer accessible after you close the App, which is what the function readWorksheet will try to do.
So you'll have to read the sheets in the server and return the dataframes somehow.
I did that by defining a second reactive value which is basically a list of dataframes returned by applying lapply on all the sheets in wb, in this case test will be this list of data frames.
There might be other ways (more efficient, or suits your purpose better) to do this, but here it is:
library(dplyr)
library(miniUI)
library(shiny)
library(XLConnect)
launch_shiny <- function() {
ui <- miniPage(
gadgetTitleBar("Input Data"),
miniContentPanel(
fileInput(inputId = "my.file", label = NULL,
multiple = FALSE)
)
)
server <- function(input, output, session) {
wb <- reactive({
new.file <- input$my.file
loadWorkbook(
filename = new.file$datapath,
create = FALSE,
password = NULL
)
})
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
df_lst <- reactive({
# read all sheets into a list
lapply(getSheets(wb()),
function(sheet){
readWorksheet(object = wb(),
sheet = sheet)
})
})
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
observeEvent(input$done, {
# get the list of dfs from the app
stopApp(c(df_lst()))
})
}
runGadget(ui, server)
}
test <- launch_shiny()
I have a function that generates "n" dataframes and saves it in a location as csv files and the function returns the file name of the saved CSVs.
I wish to take those csv files, read it using read.csv() and then display it on the UI using renderUI and renderDataTable()
While the code below has no syntax errors, but nothing is getting displayed on the screen.
Please suggest an appropriate method by which the tables generated in one part of the server.R can be used in output and display those data tables on the UI.
The code for the function is below :
Function
GenerateData <- function(){
#********************************************************************
# some sample data (originally, my data comes from an external souce)
#--------------------------------------------------------------------
a <- 1:10
b<- 21:30
c<-41:50
sampleDat1 <- data.frame(a,b,c)
sampleDat2<- data.frame(c,a,b,a)
NumOfDataFrames <- 2
#--------------------------------------------------------------------
FilePath <- "D:/FolDerName/"
FullPath<-WriteStatement <- NULL
for(i in 1:NumOfDataFrames){
FullPath[i]<-paste0(FilePath,"sampleDat",i,".csv")
WriteStatement[i]<-paste0("write.csv(sampleDat",i,",file = '",FullPath[i],"')")
eval(parse(text=WriteStatement[i]))
}
return(FullPath)
}
The UI.r
library(shiny)
shinyUI(
fluidPage(
# Application title
navbarPage("Sample Data Display",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
titlePanel("Sample"),
numericInput("sample1",label = "Some Label",value = 20),
numericInput("sample2",label = "Some Other Label",value = 20)
),
mainPanel(
uiOutput("result")
)
)
)
)
)
)
The server.R
library(shiny)
GenerateData <- function(){
#********************************************************************
# already mentioned above, please copy the contents to server.R
#--------------------------------------------------------------------
}
shinyServer(function(input, output,session) {
dataSrc <- reactive({
paths <- GenerateData()
return(paths)
})
output$result <- renderUI({
dataTab1<-NULL
MyFilePath <- dataSrc()
for (i in 1:length(MyFilePath)){
dataTab1 <- read.csv(MyFilePath[i])
# print(dataTab1)
renderDataTable(dataTab1)
dataTab1<-NULL
}
})
}
)
You can try
1) use list of df
GenerateData <- function(){
#********************************************************************
# some sample data (originally, my data comes from an external souce)
#--------------------------------------------------------------------
a <- 1:10
b<- 21:30
c<-41:50
sampleDat1 <- data.frame(a,b,c)
sampleDat2<- data.frame(c,a,b,a)
NumOfDataFrames <- 2
ls_df=list(sampleDat1,sampleDat2)
names(ls_df)=c("sampleDat1","sampleDat2")
#--------------------------------------------------------------------
FilePath <- "C:\\12324\\files\\"
FullPath=character()
for(i in 1:length(ls_df)){
FullPath[i]<-paste0(FilePath,names(ls_df)[i],".csv")
write.csv(x=ls_df[[i]],file = FullPath[[i]])
}
return(FullPath)
}
2) Server.R( create dinamic ui and render DT in two step)
shinyServer(function(input, output,session) {
dataSrc <- reactive({
paths <- GenerateData()
return(paths)
})
output$result <- renderUI({
MyFilePath <- dataSrc()
lapply(1:length(MyFilePath),function(i)dataTableOutput(paste0('tbl',i)))
})
observe({
MyFilePath <- dataSrc()
lapply(1:length(MyFilePath),function(i) output[[paste0("tbl",i)]]<-renderDataTable(read.csv(MyFilePath[i])))
})
}
)
I'm trying to access an object(a<-get(obj1,envir=parent.environment())) residing in the calling environment from the called environment myf and I can't get it working. Error I'm getting is Object obj1 not found. I tried parent.frame()also. Any ideas?
library(shiny)
shinyApp(
ui = textOutput("test1"),
server = function(input, output) {
myf <- function(x) {
a <- get(obj1, envir = parent.environment())
return(paste0(x,a))
}
output$test1 <- renderText({
obj1 <- "testing"
a <- lapply(c("a","b","c"), myf)
return(paste(unlist(a), collapse = ","))
})
}
)
NOTE : I do NOT want to create obj1 using obj1<<- as it creates in Global Environment and is available for all sessions
The correct solution is that you have three problems: First of all, you need to quote "obj1" like this
get("obj1", envir = ...)
Secondly, parent.environment() is not a function. It doesn't exist.
Thirdly, you need to understand environment and calling frames a little bit to know how this works (it has nothing to do with Shiny). What you want to use is parent.frame(2) (being inside an lapply adds a layer)
So to modify your original code, this is the solution:
library(shiny)
shinyApp(
ui = textOutput("test1"),
server = function(input, output) {
myf <- function(x) {
a <- get("obj1", envir = parent.frame(2))
return(paste0(x,a))
}
output$test1 <- renderText({
obj1 <- "testing"
a <- lapply(c("a","b","c"), myf)
return(paste(unlist(a), collapse = ","))
})
}
)
I'm not sure why it doesn't work, but there' a simple workaround: explicitly pass obj1 to myf:
library(shiny)
shinyApp(
ui = textOutput("test1"),
server = function(input, output) {
## myf now takes two arguments, x and a:
myf <- function(x, a) {
return(paste0(x, a))
}
output$test1 <- renderText({
obj1 <- "testing"
## Now you can just pass obj1 as a second argument to myf
## without worrying about scoping:
a <- lapply(c("a","b","c"), myf, obj1)
return(paste(unlist(a), collapse = ","))
})
}
)
I have saved the .Rdata file, which contains 3 R objects:
1. Vector
2. Character String
3. rpart.object (I figured out that this object in .RData only creating issue, as if I remove this object from .RData file, Shiny app works fine.)
Whenever I load the .RData file and refresh the application Rshiny gives error below:
Error in .rs.getShinyFunction(params$name, params$where) :
attempt to apply non-function
In order to avoid above issue, I tries following options:
Load the .RData in Global environment.
load(infile$datapath,.GlobalEnv)
Load the .RData in New Environment.
LoadToEnvironment <- function(RData, env = new.env()) { load(RData, env)
return(env) }
e <- LoadToEnvironment("D:\Demo NBA\AddOnPropensity.R")
val_modtyp <- e$val_modtyp
val_model <- e$val_model
val_b <- e$val_b
Load data Using attach()
Code:
require(shinydashboard)||install.packages("shinydashboard"); library(shinydashboard)
require(shiny)||install.packages("shiny"); library(shiny)
require(shinyjs)||install.packages("shinyjs"); library(shinyjs)
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = "shinyjs.refresh = function() { location.reload(); }"),
fluidPage(id="Q1",useShinyjs(),
dashboardPage(dashboardHeader(title="Test",titleWidth=400),
dashboardSidebar(),
dashboardBody (
tabItem("PMData",
fileInput('filepm', 'Choose Data to Upload',accept = c(".R")),
uiOutput('ui.PM2'),
actionButton("savepm","Save"),
uiOutput("ui.PM3")
)
)
)
))
server <- function(session,input,output){
hide("savepm")
dfPM <<- data.frame(Category=character(),
PredictiveModel=character(),
OfferIdentifier=character(),
stringsAsFactors=FALSE)
LoadToEnvironment <<- function(RData, env = new.env())
{
load(RData, env)
return(env) }
val_choices <- reactive({
if (is.null(input$filepm)){
return()
}
infile <- input$filepm
e <- LoadToEnvironment(infile$datapath)
e$val_b
})
observeEvent(input$filepm,{
useShinyjs()
if (is.null(input$filepm)){
return()
}
output$ui.PM2 <- renderUI ({
selectInput("offered",label= "Offered Test",choices = val_choices(),
selected = NULL)
})
show("ui.PM2")
show("savepm")
})
val_pmfile <- reactive({
if (is.null(input$filepm)){
return()
}
infile <- input$filepm
infile$datapath
})
TempPredmodDF <- reactive({
if(is.null(input$offered))
{
return()
}else{
data.frame(Category="Test",
PredictiveModel=val_pmfile(),
OfferIdentifier=input$offered,
stringsAsFactors=FALSE)}
})
observeEvent(input$savepm,
{
useShinyjs()
tempPMdf <- TempPredmodDF()
if(nrow(dfPM[dfPM$Category==tempPMdf$Category,]) == 0)
{
dfPM <<- rbind(dfPM,tempPMdf)
}else
{
getidx <- as.numeric(which( dfPM[,1] == tempPMdf$Category ))
dfPM[getidx,2] <<- tempPMdf$PredictiveModel
dfPM[getidx,3] <<- tempPMdf$OfferIdentifier
}
output$ui.PM3 <- renderTable({
dfPM},include.rownames=FALSE)
hide("ui.PM2")
hide("savepm")
show("ui.PM3")
})
}
app <- shinyApp(ui,server)
runApp(app,port = 7000,launch.browser = getOption("shiny.launch.browser", interactive()))