Related
I built a shiny dashboard, which takes an input file (as reactive) and creates some plots based on that file. As I did not want to rewrite all the code for barplots, histograms etc again and again, I created different functions for plotting bars, histograms etc.
As an input these functions take processed data. Usually that means that I take my raw data (stored in an reactive variable), manipulate some values and create some kind of cross tabulated dataframe, which is passed to the plotting function.
Everything works fine, except that the plots are not updated, if I change my input data. The reason for that seems to be that I first process my reactive data and then pass it to my function. Apparently one has to use the reactive variable in direct context with/inside the plot function to make the plot reactive too.
Before I start re-writing my dashboard (an option that I really don't like), I wanted to ask if somebody knew an easy workaround to pass processed reactive variables to functions and still re-evaluate these functions, if the reactive value changes?
As my code works, there is no need for a minimal example, but to make it easier to understand my problem, here is some kind of pseudo code
# read selected xlsx file
dat <- shiny::reactive({
readxl::read_xlsx(path=input$selected_file$datapath)
})
# function to plot data
plot_bar <- function(dat,
.x,
.y){
# plot data
plot(data=dat,x=.x,y=.y)
}
# call plot_bar
plot_bar(dat=dat() %>%
dplyr::count(age),
.x=age,
.y=n)
As Ronak Shah mentioned I might have been a bit too lazy not sharing a reproducible example. Sorry for that. I was hoping that plain text would do the trick as it's hard to keep it minimal with dashboards :D
Anyways, here is some reproducible code. I hope this helps to clearify the problem.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("blupp"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(inputId="sel_tibble",
label="select tibble",
choices=c("test1","test2"))
),
# Show a plot of the generated distribution
mainPanel(
column(width=4,
plotOutput(outputId="barplot1")),
column(width=4,
plotOutput(outputId="barplot2")),
column(width=4,
plotOutput(outputId="barplot3"))
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# some data
dat_list <- list(test1=dplyr::tibble(X=1:10,
Y=10:1,
GRP1=sample(LETTERS[1:2],
size=10,
replace=T),
GRP2=sample(LETTERS[5:6],
size=10,
replace=T)),
test2=dplyr::tibble(X=101:1000,
Y=1000:101,
GRP1=sample(LETTERS[1:2],
size=900,
replace=T),
GRP2=sample(LETTERS[5:6],
size=900,
replace=T)))
# Reactive: change between datasets (should affect plots)
dat <- reactive({
input$sel_tibble
res <- dat_list[[input$sel_tibble]]
return(res)
})
# Functions
# passing processed reactive (plot won't change)
plot_bar1 <- function(dat,
.x,
.y,
id){
# NSE
.x <- rlang::enquo(.x)
.y <- rlang::enquo(.y)
# Plot Date
output[[id]] <- renderPlot({
dat %>%
ggplot2::ggplot(ggplot2::aes(x=!!.x,y=!!.y)) +
ggplot2::geom_col()
})
}
# passing reactive and processing inside function (plot changes)
plot_bar2 <- function(dat,
.x,
id){
# NSE
.x <- rlang::enquo(.x)
# Plot Date
output[[id]] <- renderPlot({
dat() %>%
dplyr::count(!!.x) %>%
ggplot2::ggplot(ggplot2::aes(x=!!.x,y=n)) +
ggplot2::geom_col()
})
}
# Output
plot_bar1(dat=dat() %>%
dplyr::count(GRP1),
.x=GRP1,
.y=n,
id="barplot1")
plot_bar1(dat=dat() %>%
dplyr::count(GRP2),
.x=GRP2,
.y=n,
id="barplot2")
plot_bar2(dat=dat,
.x=GRP1,
id="barplot3")
}
# Run the application
shinyApp(ui = ui, server = server)
I'm not sure your way of program in shiny is wrong, but for me is odd having functions creating output values directly, and specially having functions defined in the server block. Also try to use different names for the data structures you're working with and the reactive functions you create.
I modified your code with my own practices and it works as you expected.
My advise, keep the outputs defined by name nor dynamically named, your functions best declared outside server function, and if you need to add objects dynamically use removeUI and insertUI on your server code.
Working code
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("blupp"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(inputId="sel_tibble",
label="select tibble",
choices=c("test1","test2"))
),
# Show a plot of the generated distribution
mainPanel(
column(width=4,
plotOutput(outputId="barplot1")),
column(width=4,
plotOutput(outputId="barplot2")),
column(width=4,
plotOutput(outputId="barplot3"))
)
)
)
dat_list <- list(test1=dplyr::tibble(X=1:10,
Y=10:1,
GRP1=sample(LETTERS[1:2],
size=10,
replace=T),
GRP2=sample(LETTERS[5:6],
size=10,
replace=T)),
test2=dplyr::tibble(X=101:1000,
Y=1000:101,
GRP1=sample(LETTERS[1:2],
size=900,
replace=T),
GRP2=sample(LETTERS[5:6],
size=900,
replace=T)))
# Define server logic required to draw a histogram
plot_bar1 <- function(dat,
.x,
.y,
id){
# NSE
.x <- rlang::enquo(.x)
.y <- rlang::enquo(.y)
# Plot Date
return(
dat %>%
ggplot2::ggplot(ggplot2::aes(x=!!.x,y=!!.y)) +
ggplot2::geom_col()
)
}
plot_bar2 <- function(dat,
.x,
id){
# NSE
.x <- rlang::enquo(.x)
# Plot Date
return(
dat %>%
dplyr::count(!!.x) %>%
ggplot2::ggplot(ggplot2::aes(x=!!.x,y=n)) +
ggplot2::geom_col()
)
}
server <- function(input, output) {
# some data
# Reactive: change between datasets (should affect plots)
dat <- reactive({
#input$sel_tibble
res <- dat_list[[input$sel_tibble]]
print("data updated")
return(res)
})
# Functions
# passing processed reactive (plot won't change)
output$barplot1 <- renderPlot({
plot_bar1(dat=dat() %>%
dplyr::count(GRP1),
.x=GRP1,
.y=n,
id="barplot1") })
output$barplot2 <- renderPlot({
plot_bar1(dat=dat() %>%
dplyr::count(GRP2),
.x=GRP2,
.y=n,
id="barplot2")
})
output$barplot3 <- renderPlot({
plot_bar2(dat=dat(),
.x=GRP1,
id="barplot3")
})
# passing reactive and processing inside function (plot changes)
}
# Output
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to creat a shiny app which takes strings within a column of a data frame that are pieces of R code, and evaluate those against data frames which have been generated in the app. Below is a working reprex of the code outside of the shiny app:
## create df with eval expressions
code_df <- data.frame(desired_outcome = c("this should be true",
"this should be false",
"this will be true or false"),
code_string = c('nrow(random_df) > 0',
'nrow(random_df) == 0',
'nrow(random_df) >= 100'),
stringsAsFactors = F)
# generate a dataframe with 1-150 rows
random_df <- data.frame(rand_binary = sample(0:1,sample(1:150, 1),rep=TRUE))
## helper function for sapply
eval_parse <- function(x){
eval(parse(text = x))
}
## evaluate code strings
tf_vector <- sapply(code_df$code_string, eval_parse)
## add data to original df
code_df$nrow <- nrow(random_df)
code_df$tf <- tf_vector
code_df
If you run the code above, it will generate a 'random_df' with between 1-150 rows, then evaluate the code strings from code_df. This code works as intended.
The problem arises when I try to implement this in shiny (code below), the implementation returns "Error: object 'random_df' not found" when the action button is clicked.
One other wrinkle: If you run the non-shiny reprex code first, and do not clean the environment before you run the shiny app, the app will return the table, but it evaluates the code strings based on the non-shiny "random_df", not the newly randomly generated one from the shiny app. You can see this based on the fact that the 'nrow' column will change in value, while the 'tf' will not change.
server.R
library(shiny)
code_df <- data.frame(desired_outcome = c("this should be true", "this should be false", "this will be true or false"),
code_string = c('nrow(random_df) > 0', 'nrow(random_df) == 0', 'nrow(random_df) >= 100'),
stringsAsFactors = F)
## helper function for sapply
eval_parse <- function(x){
eval(parse(text = x))
}
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
new_code_df <- eventReactive(input$newDF,{
# create data.frame
random_df <- data.frame(rand_binary = sample(0:1,sample(1:150, 1),rep=TRUE))
##
tf_vector <- sapply(code_df$code_string, eval_parse)
code_df$nrow <- nrow(random_df)
code_df$tf <- tf_vector
code_df
})
output$randomdf <- renderTable({new_code_df()})
})
ui.R
#
# This is the user-interface definition of a Shiny web application. You can
# run the application by clicking 'Run App' above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Eval Code from Data Frame"),
sidebarLayout(
sidebarPanel(
actionButton("newDF","Generate New Dataframe")
),
mainPanel(
tableOutput('randomdf')
)
)
))
Functions in R (and therefore shiny) are lexically scoped. This mean that functions can only see the variables defined in the environment where they themselves are defined. You are defining eval_parse in the global environment but random_df is defined in the shiny server function. This the former cannot see the latter because random_df is not in the gloabl enviroment like it was in your non-shiny example.
If you want to make all the server variables available to your expression, you can specify an environment to eval(). First change the helper so you can pass an environment
eval_parse <- function(x, env=parent.frame()){
eval(parse(text = x), envir=env)
}
and then change your server code to pass along the function environment
tf_vector <- sapply(code_df$code_string, eval_parse, env=environment())
I am new to Shiny. I was trying to subset a data frame and the data frame, but encountered an error message:
"Can't access reactive value 'xx' outside of reactive consumer."
Could anybody tell me why?
The design idea is to (1) let the users to select the subgroup that they'd like to look into, which I tried to accomplish using the reactiveValues() command but failed, and then (2), an delayed action, which is within that subgroup, sort the data based on a key variable. Below are the codes, and I appreciate your help:
library(shiny)
library(tidyverse)
data(iris)
ui <- fluidPage(
navbarPage(
title = "Test",
tabsetPanel(
tabPanel(
"Tab 3, subset and then sort",
sidebarLayout(
sidebarPanel(
selectInput("xx", "species:", choices = unique(iris$Species), selected = "setosa"),
actionButton("click", "sort")
),
mainPanel(
tableOutput("table3")
)
)
)
)
)
)
server <- function(input, output) {
rv <- reactiveValues(
#### This line caused a problem whenever I added %>% dplyr::filter ####
df3 = iris %>% dplyr::filter(Species == !!input$xx)
)
observeEvent(input$click, {
rv$df3 <- rv$df3[order(rv$df3$Sepal.Length), ]
})
output$table3 <- renderTable({
rv$df3
})
}
# Run the application
app <- shinyApp(ui = ui, server = server)
runApp(app)
reactiveValues should be used like a list of values that are updated/evaluated within reactive/observe blocks. It's being used incorrectly here, I think you should be using reactive or eventReactive.
Double-bang !! is relevant for NSE (non-standard evaluation) within rlang (and much of the tidyverse), but that's not what you're doing here. In your case, input$xx is character, in which case you can simply compare to it directly, ala Species == input$xx.
Sometimes, depending on the startup of an app, the reactive is triggered before the input has a valid value, instead it'll be NULL. This causes an error and glitches in the shiny interface, and can be avoided by the use if req.
Unfortunately, you can't resort a reactive data block outside of it.
Here's one alternative:
server <- function(input, output) {
rv_unsorted <- reactive({
req(input$xx)
dplyr::filter(iris, Species == input$xx)
})
rv_sorted <- reactive({
req(input$click)
dplyr::arrange(isolate(rv_unsorted()), Sepal.Length)
})
output$table3 <- renderTable({
rv_sorted()
})
}
Another method, which is less efficient (more greedy, less lazy),
server <- function(input, output) {
rv <- reactiveVal(iris)
observeEvent(input$xx, {
rv( dplyr::filter(iris, Species == input$xx) )
})
observeEvent(input$click, {
rv( dplyr::arrange(rv(), Sepal.Length) )
})
output$table3 <- renderTable({
rv()
})
}
This may seem more straight-forward logically, but it will do more work than will technically be necessary. (observe blocks are greedy, firing as quickly as possible, even if their work is not used/noticed. reactive blocks are lazy in that they will never fire unless something uses/needs them.)
Edit: I corrected the previous behavior, which was:
Load iris, have all species present, store in rv().
Immediately filter, showing just setosa, store in rv().
Display in the table.
Change selector to a new species.
Filter the contents of rv() so that only the new species are in the frame. Unfortunately, since the contents of rv() were just setosa, this next filtering removed all rows.
The means that the current observe-sequence (as greedy and inefficient as it may be) must start with a fresh frame at some point, so I changed the input$xx observe block to always start from iris.
I've got the same module called 2 time within my application. In one of the call I've a "static" data.frame while in the second call I would like to pass a reactive value.
Is it possible to pass reactive and static value to the same shiny module?
If this is not possible should be better to develop 2 version of the same module or convert to reactive also the other data frame?
#--- Reactive Values ----
reactive_selected_account <- reactive({ input$budget_slider })
reactive_monthly_total <- reactive({
monthly_total %>%
filter( account==reactive_selected_account() ) %>%
group_by(dt) %>%
select(-account) %>%
function_do_monthly_total()
})
#--- Components Calls ----
callModule(component_srv, "istance1", data=monthly_total)
callModule(component_srv, "istance1", data=reactive_monthly_total() )
You can write the module in a way where a reactive value is expected
component_srv <- function(input, output, session, reactive_parameter) {
observeEvent(reactive_parameter(), {
# ...
}
# ...
}
Then you can choose to pass a static value by just wrapping reactive() around it.
static_object <- iris
callModule(component_srv, "instance",
reactive_parameter = reactive(static_object))
reactive_object = reactive({
get_data(input$dataset)
})
callModule(component_srv, "instance2",
reactive_parameter = reactive_object)
Note that you need to use reactive_object rather than reactive_object() in callModule() to make this work.
I'm trying to use quote/substitute as a method to apply a condition in shiny. I'm not very familiar with either quote/substitute or shiny - so it is definitely possible that I'm not going about this problem in the right way.
I've created a simple example below that I illustrates the problem I get.
#Create test dataframe
test<-data.frame(x=c(0:10), y=c(rep(1,5),rep(2,6)), z=c("A","A","A","B","B","B","C","C","C","C","C"))
#example of what I would like to do outside shiny app
test[test$x > 5,]
#or using quote and eval
test[eval(quote(test$x > 5)),]
All of the above code works. But now lets say I want to apply it within a shiny app (and allow the user to choose the condition):
#create simple shiny app
require(shiny)
# Server
server <- function(input, output) {
# subset of nodes
df <- reactive({
#eliminate certain observations
x <- test[eval(input$condition),]
})
output$table <- renderTable({
df <- df()
})
}
# UI
ui <- fluidPage(
radioButtons("conditon", "Condition", choices = c("cond_1" = substitute(test$x > 5), "cond_2" = substitute(test$x<5))),
tableOutput("table")
)
# Create app
shinyApp(ui = ui, server = server)
But this gives the error "All sub-lists in "choices" must be names"). I'm not sure how to interpret this, and so am stuck. I looked at the answers in Shiny - All sub-lists in "choices" must be named? but did not find them helpful.
Would appreciate a way to solve this, or suggestions of a better approach (though note that I can't create the subsets ahead of time, as for my more complex actual example this creates issues).
A quick fix could be to wrap with deparse and then use eval(parse. It is not entirely clear why the input needs to be expressions. If this is just for subsetting, there are easier ways to accomplish the same
library(shiny)
-ui
ui <- fluidPage(
radioButtons("conditon", "Condition",
choices = list(cond_1 = deparse(substitute(test$x > 5)),
cond_2 = deparse(substitute(test$x<5))),
selected = deparse(substitute(test$x > 5)) ),
tableOutput("table")
)
-server
server <- function(input, output) {
# subset of nodes
df <- reactive({
#eliminate certain observations
test[eval(parse(text=input$conditon)),, drop = FALSE]
})
output$table <- renderTable({
df()
})
}
-Create app
shinyApp(ui = ui, server = server)
-output