R: Shiny, how to use renderTable to replace reactiveTable? - r

I am trying to load multiple text files (each has a string of characters) into Shiny and I found a very nice tutorial to begin with:
https://gist.github.com/jcheng5/4050398
The code is shown below:
ui.R
shinyUI(pageWithSidebar(
headerPanel("File input test"),
sidebarPanel(
fileInput("files", "File data", multiple=TRUE)
),
mainPanel(
tableOutput("filetable")
)
))
server.R
shinyServer(function(input, output) {
output$filetable <- reactiveTable(function() {
if (is.null(input$files)) {
# User has not uploaded a file yet
return(NULL)
}
input$files
})
})
The issue I have is that the result got a warning: reactiveTable is deprecated. Please use renderTable instead. Besides that, the code does work well.
However, after I replaced reactiveTable with renderTable, I got an error message: Error: no applicable method for 'xtable' applied to an object of class "function"
Any idea how to replace reactiveTable with renderTable correctly? Thanks a lot!

Related

How to check to see if a function is an object in the R workspace and if not, run a source file to invoke it?

In the below example code, the function testFunction() is defined in the separate source file functionsLibrary.R saved on the desktop. This example code works as intended.
How would I modify the code to first test if testFunction() is an object in the R workspace, and source it (running the line source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")) only if the function is not in the workspace?
In the full code this is intended for, the function takes a very long time to run (reading a large data file into memory) and I only want it sourced if it is not currently a workspace object.
Example code:
library(shiny)
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
Source file contents (filename functionsLibrary.R):
testFunction <- function(a) {
b <- data.frame(Value=seq(1:a),Square_Value = seq(1:a)^2)
return(b)
}
An easy way to go about this would be to use exist(). This should work for your problem.
library(shiny)
if (!exists("testFunction")) {
source("C:/Users/laran/OneDrive/Desktop/functionsLibrary.R")
}
ui <- fluidPage(
br(),
numericInput('selectValue','Select number of values to square:',value=1,step=1,min=1),
br(),
tableOutput('table')
)
server <- function(input,output,session)({
output$table <- renderTable(testFunction(input$selectValue))
})
shinyApp(ui, server)
We could extend the if clause to check if testFunction is really a function in case it exists and if not source the file.
if (!exists("testFunction") || (exists("testFunction") && !is.function(testFunction)))

Why R's error handling functions not working in shinyApp?

To reproduce :
library(shiny)
library(DT)
testdf<-c("car1",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))
testdf<-rbind(testdf,c("car2",sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
testdf<-data.frame(testdf)
shinyApp(
ui = fluidPage(
tabPanel("tab1",dataTableOutput("datatable")),
actionButton("CheckFile", "Refresh data")
),
server = function(input, output, session) {
X = testdf
output$datatable = renderDataTable(
{X},selection = list(mode = 'single',target = 'cell')
)
observeEvent(input$CheckFile, {
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
#same with evaluate function
#evaluate(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1)))
removeModal()
showModal(modalDialog(
title="Refresh done",
footer=NULL,
easyClose=T
))
})
}
)
My app is rendering a table. I want to give the user the possibility to update this dataset with an actionButton(). It then calls an other R file that update this dataset with source(). However, this script may contain some errors and stops before the end. So I chose to handle errors with tryCatch() and eval(). The problem is that these two functions inside my shiny app avoid the update of the dataset.
I made this reproducible example to illustrate the problem.
When I'm only running this line the dataset is updated:
tryCatch(eval(testdf[nrow(testdf)+1,]<-c(sample(row.names(mtcars),1),sample(1:1000,1),sample(1:10,1),sample(1:10,1),sample(1:10,1))))
But in the app, it is not the case.
Any idea?
Thanks in advance.

Show R documentation of a function in Shiny app

I'm building a shiny app and I need one of the tabpanels to show the R Documentation of one of the functions of the package RecordLinkage, so the user can choose his argument options.
I have tried
library(shiny)
library(RecordLinkage)
ui <- fluidPage(
tabPanel("Literature of functions",
selectInput(
"literatureChoice",
"Choose a function : ",
choices = c("compare.dedup",
"compare.linkage")
),
textOutput("literatureOutput")
),
)
server <- function(input, output) {
output$literatureOutput <- renderText({
?compare.linkage
})
}
But it doesn't show any documentation. I'm aware that ?compare.linkage shows in help panel in RStudio instead of the console.
R help documentations are stored in Rd objects. We need a way to fetch this object and render them in Shiny.
We fetch the Rd object with the help of Rd_fun() found in the gbRd package.
We then parse the file into html with Rd2HTML. The file is saved in the temp directory and read back into R.
The example is for the reactive() function found in the shiny package, replace it with whichever function required.
library(shiny)
library(gbRd)
library(tools)
ui <- fluidPage(
tabPanel("Literature of functions",
selectInput(
"literatureChoice",
"Choose a function : ",
choices = c("compare.dedup",
"compare.linkage")
),
htmlOutput("literatureOutput")
)
)
server <- function(input, output) {
output$literatureOutput <- renderText({
temp = Rd2HTML(Rd_fun("reactive"),out = tempfile("docs"))
content = read_file(temp)
file.remove(temp)
content
})
}
shinyApp(ui,server)

R Shiny Modules - Can't coerce type 'closure' to vector of type character

New to the Shiny modules environment, and I am trying to work through the setup of a basic scaffold for separating out the tabbed components of the UI and other's from the ui.r and server.r
Currently I have the following 4 files:
ui.r
navbarPage(id = "main", windowTitle = "Dashboard Title", position =
"fixed-top", header = "Header Text?", title = "Application Logo <To Do>",
navbarMenu("Company Dashboards", icon = icon("dashboard"),
tabPanel(title = "Sales", value = "SalesModule", icon = icon("bar-chart-o"), salesModuleUI("SalesModule")))
server.r
shinyServer(function(input, output, session){
### Modules
callModule(module = salesModule, id = "SalesModule")
})
global.r
#######
# Libraries
#######
library(shiny)
library(shinydashboard)
library(dplyr)
library(highcharter)
library(DT)
#######
# Source Files
#######
source("modules/salesModule.r")
salesModule.r
salesModuleUI <- function(id){
ns <- NS(id)
}
######
# salesDashboard Server
######
salesModule <- function(input,output,session){
ns <- session$ns
}
if I remove the "value = salesModule" and the salesModuleUI call from the ui.r, the application loads fine. As soon as I add those in to populate the tab panel using the salesModuleUI (either UI should be empty right now) I get the error:
Warning: Error in as.character: cannot coerce type 'closure' to vector of type 'character'
I tried reviewing the: r shiny error Error in as.vector(x, "character") : cannot coerce type 'closure' to vector of type 'character'
but this issue appears to be with the reactive call in the code and I have not added reactivity to this yet. I also reviewed: https://github.com/FrissAnalytics/shinyJsTutorials
And his code, this is where the structure for this setup is pulled from.
The coercion issue seems to be fairly common and the fixes revolve around the data type being passed and expectation. However, from I can troubleshoot, the code should be expecting a character vector and I am passing a character vector.
Thoughts on where I am going wrong?
The problem is that the UI part of your module returns the namespace function (invisibly). Therefore, shiny tries to embed the function (type: closure) into your UI code (type: character**) which causes the mentioned error message.
Error in as.character: cannot coerce type 'closure' to vector of type 'character'
If you change the definition of your module ui to
salesModuleUI <- function(id) {
ns <- NS(id)
return(NULL)
}
the error is gone since NULL can be embedded in shiny UI definitions. Here is a minimal app that uses the above UI.
shinyApp(
ui = fluidPage(
salesModuleUI("moduleId")
),
server = function(input, output, session) {}
)
** Actually, shiny UIs have their own class called shiny.tag which can be of type list or character depending on the usecase. However, when shiny converts R objects into shiny.tag objects, it relies on the as.character generic.

How do I print an input from the R shiny UI to the console?

Situation: I want to print an input variable from the R shiny UI to the console. Here is my code:
library(shiny)
ui=fluidPage(
selectInput('selecter', "Choose ONE Item", choices = c("small","big"))
)
server=function(input,output,session){
print("You have chosen:")
print(input$selecter)
}
shinyApp(ui, server)
Unfortunately I get this error message:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Question: What do I need to change my code to, in order to make it work?
You should use an observeEvent which will execute every time the input changes:
library("shiny")
ui <- fluidPage(
selectInput('selecter', "Choose ONE Item", choices = c("small","big")),
verbatimTextOutput("value")
)
server <- function(input, output, session){
observeEvent(input$selecter, {
print(paste0("You have chosen: ", input$selecter))
})
}
shinyApp(ui, server)

Resources