I am using Shiny as an interface for viewing tables stored locally in a series of .RData files however I am unable to get the table to render.
My server code is like this:
output$table1 <- renderTable({
load(paste0(input$one,"/",input$two,".RData"))
myData})
On the ui side I am simply displaying the table in the main panel.
This other SO question suggests that the issue is that the environment that the data is loaded into goes away so the data isn't there to display. They suggest creating a global file and loading the .RData file in there, but I don't believe I will be able to load the data dynamically that way. Any guidance on how to use .RData files effectively within shiny would be appreciated.
Regards
I think you just need to move the load statement outside of the renderTable function. So you should have
load(paste0(input$one,"/",input$two,".RData"))
output$table1 <- renderTable({myData})
If you look at the help file for renderTable, the first argument is
expr: An expression that returns an R object that can be used with
xtable.
load does not return this.
I got around this by "tricking" R Shiny. I make a BOGUS textOutput, and in renderText, call a external function that, based in the input selected, sets the already globally loaded environments to a single environment called "e". Note, you MUST manually load all RDatas into environments in global.R first, with this approach. Assuming your data isn't that large, or that you don't have a million RDatas, this seems like a reasonable hack.
By essentially creating a loadEnvFn() like the below that returns a string input passed as input$datasetNumber, you can avoid the scoping issues that occur when you put code in a reactive({}) context. I tried to do a TON of things, but they all required reactive contexts. This way, I could change the objects loaded in e, without having to wrap a reactive({}) scope around my shiny server code.
#Global Environment Pre-loaded before Shiny Server
e = new.env()
dataset1 = new.env()
load("dataset1.RData", env=dataset1)
dataset2 = new.env()
load("dataset2.RData", env=dataset2)
dataset3 = new.env()
load("dataset3.RData", env=dataset3)
ui = fluidPage(
# Application title
titlePanel(title="View Datasets"),
sidebarLayout(
# Sidebar panel
sidebarPanel(width=3, radioButtons(inputId = "datasetNumber", label = "From which dataset do you want to display sample data?", choices = list("Dataset1", "Dataset2", "Dataset3"), selected = "Dataset2")
),
# Main panel
mainPanel(width = 9,
textOutput("dataset"), # Bogus textOutput
textOutput("numInEnv")
)
)
)
loadEnvFn = function(input) {
if (input$datasetNumber=="Dataset1") {
.GlobalEnv$e = dataset1
} else if (input$datasetNumber=="Dataset2") {
.GlobalEnv$e = dataset2
} else {
.GlobalEnv$e = dataset3
}
# Bogus return string unrelated to real purpose of function loadEnvFn
return(input$datasetNumber)
}
server = function(input, output, session) {
output$dataset = renderText(sprintf("Dataset chosen was %s", loadEnvFn(input))) # Bogus output
output$numInEnv = renderText(sprintf("# objects in environment 'e': %d", length(ls(e))))
}
shinyApp(ui, server)
Related
I am getting crazy with this small reproducible Shiny app:
Basically 3 steps:
I have an input$text which the user can chose
The user triggers an R file create_text.R transforming this text, creating a my_text string. (IRL it is basically a download and data preparation step)
The user triggers the render of an R Markdown where my_text value is printed
My base code looks like:
app.R
library(shiny)
ui <- fluidPage(
selectInput(inputId = "text",
label = "Choose a text",
choices = c("Hello World!", "Good-bye World!")),
actionButton("create_text", "Prepare text"),
downloadButton("report", "Render markdown"))
)
server <- function(input, output) {
observeEvent(input$create_text, {
text_intermediate <- input$text
source('create_text.R')
})
output$report <- downloadHandler(
filename = "report_test.html",
content = function(file) {
rmarkdown::render(input = "report_test.Rmd",
output_file = file)
})
}
shinyApp(ui, server)
create_text.R
my_text <- paste("transfomation //", text_intermediate)
report_test.Rmd
---
title: "My title"
output: html_document
---
```{r}
my_text
```
My problem is the intermediate step (2.), probably because I am confused between environments.
If I run source('create_text.R', local = FALSE), it fails because the R file is run from an empty environment, then does not recognize text_intermediate.
# Warning: Error in paste: object 'text_intermediate' not found
On the opposite way, if I run source('create_text.R', local = TRUE), the created my_text string is not "saved" for the next of the shiny app, then the Rmd cannot be rendered since my_text is not found.
# Warning: Error in eval: object 'my_text' not found
What I have tried:
Two ugly solutions would be:
do not use an intermediate R file and have the whole code inside the app but it will make it very unreadable
or even more ugly, only use hard assigning <-- in the R file, like my_text <<- paste("transfomation //", text_intermediate)
Playing with the env argument of the render() function dit not help neither.
Lastly, starting from scratch I would have used reactive values everywhere, but both my R and Rmd files are very big and "finished", and it would be difficult to adapt the code.
Any help ?
OK, at the end I bypassed the problem with this unelegant solution:
I added a block of code after running the external R script, which stocks all created objects into the global environment. This way, those objects are callable later on in the server function. This allows to go without eventReactive(). Not very pleasant but works.
For this, I use assign within a lapply. In my example, it would be equivalent to write: my_text <<- my_text. The lapply allows to do it for all objects.
observeEvent(input$create_text, {
text_intermediate <- input$text
source('create_text.R')
lapply(X = (ls()), FUN = function(object) {assign(object, get(object), envir = globalenv())})
})
At the moment I am attempting the following: import a file in Rshiny, give it a number (interactive), and then move on to the next file. This part works fine. However, I would also like to store the data of every iteration, and then show it on the user interface.
However, it is not working. So I guess something is not right with the reactivity, but I am not sure how to fix it.
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
Here an empty reactive data.frame
outputdata<-reactive(data.frame("file"="file","score"="score"))
filename<-eventReactive(input$new,{
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
return(filename)
})
scores<-eventReactive(input$new,{
return(input$score)
})
Then I would like to append the previous values of the outputdata, with the new values. But it is not working
outputdata<-eventReactive(input$new,{
rbind(outputdata(),filename(),scores())
})
output$savdat<-renderTable(outputdata())
}
shinyApp(ui, server)
Any advice would be welcome
It appears you want the reactivity to occur each time you click on the 'Next file' button. I rewrote your code to respond just once, using 'ObserveEvent', each time the 'Next file' button is clicked. The 2nd challenge is permitting values to persist upon each reactive event. While there are multiple ways to handle this, I chose an expedient technique, the '<<-' assignment statement, to permit the variable 'output data' to persist (this is generally not a good programming technique). Because the variable 'outputdata' exists in all environments, you'll need to wipe your environment each time you want to run this program.
Here's my rewrite using the same ui you created:
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
setupData <- function(filename,score) {
data <- data.frame(filename,score,stringsAsFactors = FALSE)
return(data)
}
observeEvent (input$new, {
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
if (!exists(c('outputdata'))) {
score <- input$score
outputdata <<- data.frame (filename,score,stringsAsFactors = FALSE)
}
else {
outputdata <<- rbind(outputdata,setupData(filename,input$score))
}
# Show the table
output$savdat<-renderTable(outputdata)
})
}
shinyApp(ui, server)
I am building an interactive Shiny app using Neo4j graph data by using RNeo4j package to connect Neo4j with R.
The app contains a table showing properties of graph data pulled from Neo4j, users can view and change table content (properties of graph data).
The changes can be written back to Neo4j as an update of graph data properties. This function can be completed using updateProp & getOrCreateNode functiona in RNeo4j package.
However, I have a reactive error.
Below is my code:
library(RNeo4j)
library(dplyr)
library(shiny)
library(shinydashboard)
library(visNetwork)
library(tidyr)
library(sqldf)
library(igraph)
library(plotly)
library(stringi)
library(stringr)
graph = startGraph("http://localhost:7474/db/data/", username = "xxx", password = "xxx")
summary(graph)
# build dashboard
# UI items list
header <- dashboardHeader(
title = "Neo4j"
)
sidebar <- dashboardSidebar(
sidebarMenu (
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard1",
box(textOutput("aa")),
box(title = "CATEGORY", DT::dataTableOutput("category")),
box(uiOutput("category_status"))
)
)
)
# UI
ui <- dashboardPage(header, sidebar, body)
# Server
server <- function(input, output, session) {
# Query graph data and properties from Neo4j and store them in table format in R
query = "
MATCH (c:Category)
RETURN c.id AS Category, c.Price AS Price, c.status AS Category_Status
"
info = cypher(graph, query) # R Table to store Neo4j data
# Build Shiny output tables
output$i1 <- renderTable(info)
output$category = DT::renderDataTable(info, selection = 'single')
# This is to build the function of change the status of category with 3 options
output$category_status = renderUI({
x = info[input$category_rows_selected, ]
if (length(x)){
selectInput("category_status", "",
c( "Sold", "On Sale","Out of Stock"),
selected = x$Category_Status)
}
})
# Table to examine if the status change was made successfully
output$aa<-renderText(input$category_status)
# Write back the changes made in Shiny to Neo4j using "updateProp" & "getOrCreateNode" function in RNeo4j
if(info$Category_Status[input$category_rows_selected] != input$category_status) {
category_num = as.numeric(substring(info$Category[input$category_rows_selected], 16))
updateProp(getOrCreateNode(graph, "Category", Category = paste("CC_CCAA_AAC.0C-", category_num, sep="")),
status = input$status)
}
}
# Shiny dashboard
shiny::shinyApp(ui, server)
Below is the error message:
Listening on http://127.0.0.1:4401
Warning: 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.)
55: stop
54: .getReactiveEnvironment()$currentContext
53: .subset2(x, "impl")$get
52: $.reactivevalues
50: server [#44]
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.)
By trail and error, the Shiny app can work properly if I remove the code of written the changes back to Neo4j, which is the last part of the code. However, this is the core function of this project.
Also, this written-back function worked properly by standing alone outside of Shiny. So the problem is the interaction between 2 parts.
I am wondering if I can add observeEvent in Shiny to solve this problem.
Thanks in advance.
As you said the last part of your code caused the problem. The reason behind is that you use reactives in this code chunk. That is you use input$category_rows_selected, input$category_status and input$status which do not have a fixed value but depend on your interaction with the app.
Depending on what you want to do you have basically 2 options:
Include the code chunk in isolate. In this case, however, your code will never be updated when you change the respective inputs.
Include the code chunk in observe. In this case whenever either of the inputs (as listed above) change its value, this code will be executed. If you want your code chunk to run only if some of the inputs change you can isolate the inputs you do not want to take a dependency on.
For instance this code will be executed whenever input$category_rows_selected or input$category_status change but not if input$status change because it is wrapped in isolate:
observe({
if(info$Category_Status[input$category_rows_selected] != input$category_status) {
category_num = as.numeric(substring(info$Category[input$category_rows_selected], 16))
updateProp(getOrCreateNode(graph, "Category",
Category = paste("CC_CCAA_AAC.0C-", category_num, sep="")),
status = isolate(input$status))
}
})
I am setting up a shiny application that asks for a dataset, asks for information about said data set, and then runs a series of analytic models on said data set, taking into account information about the dataset (for example, the names of variables to adjust for in a regression). The app starts with a simple UI with a data upload input. Once the user has uploaded their data, I would like the UI to dynamically add a new section that asks the user to select a subset of variables from the column labels of their dataset.
I am working with RStudio Server via a Linux AWS machine.
My app is generated as an add-on to another R package that serves as a wrapper for most of the statistical functions I require. Since the app is quite large, the UI is composed of some standard text and a series of functions that call tabItems for the UI.
In the example below, the UI has a standard data upload user input. In addition to this I have attempted to use shiny::renderUI on the server side to take the user-provided dataset, read the columns, and return the set of columns via shiny::varSelectInput(). Unfortunately, my app does not provide this new input after uploading the data.
ui_data_1 <- function(){
y<-tabItem(tabName = "load_dat",
shiny::tabsetPanel(type = "tabs",
# Data upload ---- -
h2("Data"),
p("Please upload your data file"),
shiny::fileInput(
inputId = "data_file", label = "Upload patient data file (.csv Only)",
accept = c(".csv")
),
h2("Treatment"),
p("Instructions for treatment"),
shiny::uiOutput("variables"))
)
)
return(y)
}
server_data_1 <- function(){
y <- shiny::renderUI({
inFile <- input$data_file
# Load data
if (is.null(inFile)) {
df <- shiny::reactive({NULL})
} else {
df <- shiny::reactive({read.csv(inFile$datapath, header = input$header)})
}
varnames <- colnames(df())
shiny::varSelectInput(
inputId = "treat",
label = "Treatment Variable",
data = c(varnames)
)
})
return(y)
}
#UI.R
body <- shinydashboard::dashboardBody(
ui_data_1()
)
ui <- shinydashboard::dashboardPage(header, sidebar, body, skin = "black")
#Server.R
server <- function(input, output) {
output$variables <- server_data_1()
}
shiny::shinyApp(ui, server)
The app loads properly, as does the data upload menu. When I upload the data, I receive a notification indicating that the upload was successful. The label associated with inputId = "treat" is visible the entire time. However, the variable selection menu does not populate after uploading the data as expected. Perhaps I've done something wrong. Thanks in advance for any advice.
I am trying to make Shiny App which allows users to save inputs and later load them.
Easiest way to approach this, is to make Save button, which saves inputs. Here is basic app to demonstrate:
server.R
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500)
),
mainPanel(tableOutput("values"),
actionButton('save_inputs', 'Save inputs')
)
))
server <- function(input, output, session) {
sliderValues <- reactive({
value = input$integer
})
output$values <- renderTable({
sliderValues()
})
observeEvent(input$save_inputs,{
saveRDS( input$integer , file = 'integer.RDS')
})
}
shinyApp(ui = ui, server = server)
However, I would like to make saving automatic, e.g. I want inputs to be saved at end of session. onSessionEnded() should be answer to this, but it can't reach input values and save them.
session$onSessionEnded( function() {
saveRDS( input$integer, file = 'integer.RDS')
})
Which returns error: Warning:
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.)
Is there any way to solve it?
Using isolate seems to solve the problem.
session$onSessionEnded(function() {
isolate(saveRDS( input$integer, file = 'integer.RDS'))
})
Using another observe event function and watching the value of isClosed() we can
make this work
observeEvent(session$isClosed()==T,{
saveRDS( input$integer, file = 'integer.RDS')
})
observeEvent() as well as reactive() are both considered "reactive" environments which means they are watching for changing values throughout the session and not just on startup. If you put a function that needs to be reactive outside of a reactive environment shiny will do you the favor of sending you that error, to inform you the function would never be called unless we wrap it in a reactive function.
Also +1 for the well composed question.