In the following example, the R object fit is created in shiny::renderPrint but not in renderPlot. Thus plot done for print() but not plot().
In actual phase, fit is an fitted model object generated by rstan:sampling() and it takes very long time, so I won't execute it twice in both renderPrint and renderPlot. Is there any idea ? I am very beginner of Shiny.
library(shiny)
ui <- fluidPage(
mainPanel(
shiny::sliderInput("aaa",
"aaa:",
min = 1, max = 11111, value = 5),
shiny::plotOutput("plot"),
shiny::verbatimTextOutput("print") )
)
server <- function(input, output) {
output$print <- shiny::renderPrint({
fit <- input$aaa*100 # First creation of object,
# and we use it in the renderPlot.
# So, we have to create it twice even if it is exactly same??
# If possible, I won't create it
# In the renderPlot, twice.
print(fit)
})
output$plot <- shiny::renderPlot({
# The fit is again created
# If time to create fit is very long, then total time is very heavy.
# If possible, I do not want to make fit again.
fit <- input$aaa*100 #<- Redundant code or I want to remove it.
plot(1:fit)
})
}
shinyApp(ui = ui, server = server)
Edit
To avoid a duplicate code of making object, I use the following, then it goes well. Thank you #bretauv.
library(shiny)
ui <- fluidPage(
mainPanel(
shiny::sliderInput("aaa",
"aaa:",
min = 1, max = 11111, value = 5),
shiny::plotOutput("plot"),
shiny::verbatimTextOutput("print") )
)
server <- function(input, output) {
########## Avoid duplicate process ###################
test <- reactive({input$aaa*100})
#####################################################################
output$print <- shiny::renderPrint({
# fit <- input$aaa*100 # No longer required
print(test())
})
output$plot <- shiny::renderPlot({
# fit <- input$aaa*100 # No longer required
plot(1:test())
})
}
shinyApp(ui = ui, server = server)
if you want not to repeat fit, try to put the fit expression in a reactive function such as : test <- reactive({input$aaa*100}) and then call it in output functions with test()
Related
I'm working on an R shiny app structured like this:
library(shiny)
library(DT)
# global function
make_data = function(input){
data.frame(x = input$x, `x_times_2` = input$x*2)
}
ui <- fluidPage(
sliderInput("x", label = "Set x:", min = 1, value = 7, max = 10),
# Recalculates continuously, bad!
dataTableOutput("dtab"),
# Recalculates when inputs change, good!
# tableOutput("tab")
)
server <- function(input, output, session) {
reactive_data = reactive({
print("Recalculating Data")
make_data(reactiveValuesToList(input))
})
output$tab = renderTable({
reactive_data()
})
output$dtab = renderDataTable({
reactive_data()
})
}
shinyApp(ui, server)
My problem is that dataTableOutput("dtab") forces continuous recalculation of reactive_data whereas tableOutput("tab") (correctly) only recalculates when inputs change. Can someone help me understand why this happens?
I need to be able to pass inputs into a global function that makes a data frame which I then need to display. I want to use dataTableOutput() for the customization that DT offers but need it to only recalculate when any input is changed.
In this situation, you could use eventReactive() instead of reactive. Try this
reactive_data = eventReactive(input$x, {
print("Recalculating Data")
make_data(reactiveValuesToList(input))
})
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)
As I understand, eventReactive (or any reactive function) should not recalculate stuff whose related input did not change, but this is what's happening in my case. I'm pretty sure I'm doing something wrong but I just don't know what. In essence, I have two eventReactive functions, one involves a very time-consuming calculation, and the other mainly just plotting (should be quite quick). However, even when I change some inputs for plotting, the first eventReactive function is executed too (even though it's not needed).
Here is a shortened version of my code:
server <- function(input, output) {
res_tabl <-
eventReactive(c(input$recalc, input$recalc2), # this is a time-consuming calculation
ignoreNULL = FALSE, {
prep_sim(
gg_start = input$gg_start,
gg_end = input$gg_end
)
})
threeplots <-
eventReactive(c(input$recalc, input$recalc2), # this is for plotting
ignoreNULL = FALSE, {
prep_plot(
results_to_plot = res_tabl(),
yval_opt = input$yval_opt
)
})
output$esdc_plot_comb <- renderPlot({
threeplots()[[1]]
})
output$esdc_plot_tot <- renderPlotly({
threeplots()[[2]]
})
output$esdc_plot_comb2 <- renderPlot({
threeplots()[[1]]
})
output$esdc_plot_tot2 <- renderPlotly({
threeplots()[[2]]
})
output$esdc_table <- renderDataTable({
res_tabl()
})
}
What should I do so that when I press a single Action button and I only changed input$yval_opt, only the second eventReactive content would run? (Nothing should run until I click the button.)
Less importantly – and perhaps this should be a separate question – as you can see I render each of the two returned plots twice. Is there perhaps a more efficient way to do this?
(The full code is available here.)
This was tricky.
To avoid automatic calculation at App start-up, you should set ignoreNULL = T
This works on a single condition, but not on multiple conditions using c(recalc1,recalc2)
Solution is :
eventReactive(req(isTruthy(input$recalc1) | isTruthy(input$recalc2)), ignoreNULL = T,...
Added a reactiveVal() to keep track of last calculation update
I think following Minimal Reproducible example responds to your needs :
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Test"),
# Sidebar with a slider inpust
sidebarLayout(
sidebarPanel(
sliderInput("vizslider",
"viz percentage:",
min = 1,
max = 100,
value = 30),
sliderInput("calcslider",
"Calculation duration (s):",
min = 1,
max = 10,
value = 2),
actionButton("recalc1", "Calc 1"),
actionButton("recalc2", "Calc 2"),
),
# Show result
mainPanel(
textOutput("result")
)
)
)
# Define server logic
server <- function(input, output) {
lastcalc <- reactiveVal(0)
run <- reactive({})
calcresult <- eventReactive(req(isTruthy(input$recalc1) | isTruthy(input$recalc2)), ignoreNULL = T, {
if (lastcalc()==input$calcslider) {return("last calculation")} else {lastcalc(input$calcslider)}
cat("Start calc for ",input$calcslider, "seconds\n")
Sys.sleep(input$calcslider)
cat("End calc \n")
paste("calculation done in",input$calcslider,"seconds")
})
output$result <- eventReactive(c(input$recalc1,input$recalc2), ignoreNULL = T, {
req(calcresult())
paste("filter",input$vizslider,"% of a ",calcresult())
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to create numeric boxes for all column names in a data set. I have written below code but this displays a blank page. Not sure what the error is. Any suggestions?
library(shiny)
library(readr)
shinyApp(
ui <- fluidPage(
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- read.csv("Data/170210_Flat_File.csv")
output$TestColumns <- renderUI({
for(i in names(data_set)){
numericInput(i, i,30)
}}
)})
First off, when you ask questions you should ALWAYS post a minimal reproducible example. That is basically something that we can run to replicate the issue you are having so that it is much easier for us to help you. This way we don't have to go about using different data, trying to figure out exactly what your error is. See this link for a good intro: How to make a great R reproducible example?
Next to your question - since you didn't explicitly post an error you were seeing or explicitly state what your issue was I'm going to go ahead and assume that your issue is that you don't see any UI's popping up when you run your Shiny App (this is what I got when I tried running your code with different sample data).
The reason you aren't seeing anything is because you aren't returning any objects from your for loop. If you really wanted to do a for loop you would have to loop through, store everything in a list, then return that list. Note that I had to use R's built in data because you didn't provide any. Something like this would work:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
L<-vector("list",length(names(data_set)))
for(i in names(data_set)){
L[[i]]<-numericInput(i, i,30)
}
return(L)
})})
This should give you your desired result. However, the above is unnecessarily complicated. I suggest you use an lapply instead. Something like this is much better in my opinion:
shinyApp(
ui <- fluidPage(
#numericInput("test","test",30),
uiOutput("TestColumns")
),
server <- function(input, output) {
data_set <- mtcars
output$TestColumns <- renderUI({
lapply(names(data_set),function(x){numericInput(x,x,30)})
})})
ui <- bootstrapPage(
fluidRow(
column(4,offset = 2,
tags$h4("numeric inputs"),
uiOutput('mtcars_numerics') # These will be all the numeric inputs for mtcars
),
column(6,
tags$h4("current input values"),
verbatimTextOutput('show_vals') # This will show the current value and id of the inputs
)
)
)
server <- function(input, output, session){
# creates the output UI elements in the loop
output$mtcars_numerics <- renderUI({
tagList(lapply(colnames(mtcars), function(i){ # must use `tagList` `
column(3,
numericInput(
inputId = sprintf("mt_col_%s",i), # Set the id to the column name
label = toupper(i), # Label is upper case of the col name
min = min(mtcars[[i]]), # min value is the minimum of the column
max = max(mtcars[[i]]), # max is the max of the column
value = mtcars[[i]][[1]] # first value set to the first row of the column
))
})
)
})
# So we can see the values and ids in the ui for testing
output$show_vals <- renderPrint({
all_inputs <- names(session$input)
input_vals <- plyr::ldply(all_inputs, function(i){
data.frame(input_name = i, input_value = input[[i]],stringsAsFactors = FALSE)
})
input_vals
})
}
shinyApp(ui, server)
Results in:
I am writing an shiny app in which contains an stochastic function generates four objects - one plot and three tables. However, I want to render each object in different tabs without being executing the function four times since this stochastic function will generates four different versions. I have been researched online and find a lot people recommend "reactive()" but I still don't quite understand how to apply it to my problem. How can I use those four objects on rendering with only one execution on the function?
My "server.R" structure basically looks like the below:
shinyServer(function(input, output) {
stochastic_function() {
...
plot1 <- ...
table1 <- ...
table2 <- ...
table3 <- ...
result <- list(plot, table1, table2, table3)
return(result)
}
output$plot <- renderPlot({
})
output$table1 <- renderTable({
})
output$table2 <- renderTable({
})
output$table3 <- renderTable({
})
...
So, I have tried something like below for the stochastic function:
model <- eventReactive(input$goButton, {
reactive(WG_Model(cdata = cdata(), # load data from outside env
sdata = sdata(), # load data from outside env
N = input$n,
end_date = input$end_date,
cpx_goal = input$cpx,
N_new = input$n2,
end_date_new = input$end_date2,
spend_range = input$s_range,
spend_incr = input$s_incr
)
)
})
The idea is to add an "GoButton" to initiate the function and then save all outputs in a reactive fun(). So I can render each output with:
output$plot <- renderPlot({
model$gplot
})
output$table <- renderTable({
model$table
})
# Render UI section
output$tb <- renderUI({
tabsetPanel(tabPanel("About Model", plotOutput("plot")),
tabPanel("About Model", tableOutput("table")))
})
However, I only got "Error: object of type 'closure' is not subsettable" in the UI output. Which part did I miss?
If your model() is a list and contains data for all tables and a plot, it should work as in my example.
In this app, after pressing a button, a random number and data for a table and a plot are generated. Then the number, data for table and a plot are returned as a list and rendered with appropriate render* functions.
This app illustrates that the model function won't be re-run after accessing it with model() in other reactive functions.
However, there is an odd thing...the plot is not always rendered. You sometimes have to click the button few times to get the plot. The table is working always.
library(shiny)
ui <- shinyUI(fluidPage(
br(),
actionButton("numb", "generate a random numbers"),
br(),
br(),
verbatimTextOutput("text"),
plotOutput("plot"),
tableOutput("table")
))
server <- shinyServer(function(input, output) {
model <- eventReactive(input$numb, {
# draw a random number and print it
random <- sample(1:100, 1)
print(paste0("The number is: ", random))
# generate data for a table and plot
data <- rnorm(10, mean = 100)
table <- matrix(data, ncol = 2)
# create a plot
Plot <- plot(1:length(data), data, pch = 16, xlab ="", ylab = "")
# return all object as a list
list(random = random, Plot = Plot, table = table)
})
output$text <- renderText({
# print the random number after accessing "model" with brackets.
# It doesn't re-run the function.
youget <- paste0("After using model()$random you get: ", model()$random,
". Compare it with a value in the console")
print(youget)
youget
})
output$plot <- renderPlot({
# render saved plot
model()$Plot
})
output$table <- renderTable({
model()$table
})
})
shinyApp(ui = ui, server = server)