R Shiny: initial rendering of eventReactive output - r

What I'm trying to achieve is to have an initial table to be rendered right as the app is executed. But then, update the table only on executing action.
Here's the example:
library(shiny)
library(data.table)
dt <- data.table(x = c("a", "b"), y = c(0,0))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(inputId = "inSelect",
label = "Select:",
choices = dt[,unique(x)]),
actionButton(inputId = "trigger",
label = "Trigger",
icon = icon("refresh"))
),
mainPanel(
tableOutput("outTable")
)
)
)
server <- function(input, output){
re <- eventReactive(input$trigger, {
dt[x == input$inSelect, y := y + 1]
})
output$outTable <- renderTable({
re()
})
}
shinyApp(ui, server)
So the issue is that under renderTable() I can put either dt to show initial table or re() to show each update after first press of the "Trigger" button.


Do
re <- eventReactive(input$trigger, {
dt[x == input$inSelect, y := y + 1]
}, ignoreNULL = FALSE)
From ?eventReactive:
Both observeEvent and eventReactive take an ignoreNULL parameter that
affects behavior when the eventExpr evaluates to NULL (or in the
special case of an actionButton, 0).

Related

How to count number of times the selectInput box is clicked?

The below MWE code uses observeEvent() functions and reactiveVal() to track and show the number of times the selectInput() box is clicked and the number of times the actionButton() is clicked.
The actionButton() tracking works fine. Note how in output$... in the code the selectInput() and actionButton() work differently, looks weird to me.
Anyhow, I'm having trouble having selectInput() track the same as actionButton(). When the App is first invoked, the user clicking the first option rendered ("Cyl") in the selectInput() box is not counted as a click, when I would like it to count as a click. And if the same choice is clicked in the selectInput() ("Trans" for example) more than once, the clicks > 1 aren't counted as clicks when I would each click to be counted. Basically, anytime the user clicks in the selectInput() box it needs to be included as a "click". Is there any way to do this?
In the full code this matters because the selectInput() in that box triggers a removeUI() and the list of choices is dynamic and sequentially renumbered with every click.
Code:
library(shiny)
ui = fluidPage(hr(),
selectInput("selInput",label=NULL,c("Cyl"="cyl","Trans"="am","Gears"="gear"),selected=NULL),
actionButton("addBtn","Add"), hr(),
textOutput("clickSelInput"),
textOutput("clickAddBtn"),
tableOutput("data")
)
server = function(input, output) {
x = reactiveVal(0)
y = reactiveVal(0)
output$data <- renderTable({mtcars[1:10, c("mpg", input$selInput), drop = FALSE]})
observeEvent(input$selInput,{x(x()+1)})
observeEvent(input$addBtn,{y(y()+1)})
output$clickSelInput <- renderText({paste('Select Input clicks =',x()-1)})
output$clickAddBtn <- renderText({paste('Add Button clicks =',y())})
}
shinyApp(ui, server)

Adding "multiple = TRUE" to the selectInput() in this case resolves the question. Also allow the removal of the weird -1 from the out$selInput..x()-1)}) in the OP. This also works fine for the larger App this is intended for. See revised OP code with changes from OP commented (further down is the "larger App" where this functionality matters):
library(shiny)
ui = fluidPage(hr(),
selectInput("selInput",
label=NULL,
c("Cyl"="cyl","Trans"="am","Gears"="gear"),
selected=NULL,
multiple=TRUE # added this
),
actionButton("addBtn","Add"), hr(),
textOutput("clickSelInput"),
textOutput("clickAddBtn"),
tableOutput("data")
)
server = function(input, output) {
x = reactiveVal(0)
y = reactiveVal(0)
output$data <- renderTable({mtcars[1:10, c("mpg", input$selInput), drop = FALSE]})
observeEvent(input$selInput,{x(x()+1)})
observeEvent(input$addBtn,{y(y()+1)})
output$clickSelInput <- renderText({paste('Select Input clicks =',x())}) # removed the -1 from x()
output$clickAddBtn <- renderText({paste('Add Button clicks =',y())})
}
shinyApp(ui, server)
And here's the "larger App" where this functionality matters:
library(dplyr)
library(rhandsontable)
library(shiny)
rowNames1 <- c("A", "B", "C", "Sum")
DF1 <- data.frame(row.names = rowNames1, "Col 1" = c(1, 1, 0, 2), check.names = FALSE)
ui <- fluidPage(br(),
rHandsontableOutput('hottable1'),br(),
actionButton("addCol1", "Add column 1"),br(),
h5(strong("Select column to delete:")),
uiOutput("delCol1"), hr(),
textOutput("clickSelInput"),
textOutput("clickAddBtn"),
)
server <- function(input, output) {
x = reactiveVal(0)
y = reactiveVal(0)
uiTbl1 <- reactiveVal(DF1)
observeEvent(input$hottable1, {uiTbl1(hot_to_r(input$hottable1))})
output$hottable1 <- renderRHandsontable({
rhandsontable(uiTbl1(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
observeEvent(input$addCol1, {
newCol <- data.frame(c(1,1,0,2))
names(newCol) <- paste("Col", ncol(hot_to_r(input$hottable1)) + 1)
uiTbl1(cbind(uiTbl1(), newCol))
})
observeEvent(input$delCol1, {
tmp <- uiTbl1()
delCol <- input$delCol1
tmp <- tmp[ , !(names(tmp) %in% delCol), drop = FALSE]
newNames <- sprintf("Col %d",seq(1:ncol(tmp)))
names(tmp) <- newNames
uiTbl1(tmp)
})
output$delCol1 <-
renderUI(
selectInput(
"delCol1",
label = NULL,
choices = colnames(hot_to_r(input$hottable1)),
selected = "",
multiple = TRUE)
)
observeEvent(input$delCol1,{x(x()+1)})
observeEvent(input$addCol1,{y(y()+1)})
output$clickSelInput <- renderText({paste('Select Input clicks =',x())})
output$clickAddBtn <- renderText({paste('Add Button clicks =',y())})
}
shinyApp(ui,server)

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]

I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much

It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")

Shiny, reuss reactive input pickerInput

I am trying to create my first shiny app but I am facing a difficulty: in the reproducible example below I am creating a reactive pickerInput (i.e. only show brands proposing a cylindre equal to the input visitors select).
I then want that based on the combination input_cyl and picker_cny (remember that picker_cny depends on input_cyl) to display a table which shows the relevant data for the observation matching the combination input_cyl and picker_cny.
Thank you for your help!
df <- mtcars
df$brand <- rownames(mtcars)
df$brand <- gsub("([A-Za-z]+).*", "\\1", df$brand)
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_cyl", label = "Cyl",
choices = c("6", "4", "8")),
pickerInput(
inputId = "picker_cny",
label = "Select Company",
choices = paste0(unique(df$brand)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Show Text
mainPanel(
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_cyl, {
df_mod <- df[df$cyl == paste0(input$input_cyl), ]
# Method 1
disabled_choices <- !df$cyl %in% df_mod$cyl
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(df$brand)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
output$table <- renderTable(df)
}
}
# Run the application
shinyApp(ui = ui, server = server)

You need a reactive that will handle the change in the input and subset the dataframe before giving it to the output table. For that, you just need to add this block to your server:
data <- reactive({
if (length(input$picker_cny) > 0)
df[df$brand %in% input$picker_cny,]
else
df
})
and update the output$table like this:
output$table <- renderTable(data())
Note: feel free to remove the if else in the reactive to get that:
data <- reactive({
df[df$brand %in% input$picker_cny,]
})
The only difference in that case is: would you show all or nothing when no input has been entered yet. That's a matter of taste.

Updating checkbox value in Shiny

I am trying to make a Shiny app that does the following:
1) Upload a file like this:
X Y
1 3
2 1
3 6
4 4
2) Press a Run button to add 2 to the file values by default, or multiplying by 2 if a box is checked,
3) Making a scatter plot out of the generated values.
My problems are (i) I need to check/uncheck the box and then press again the Run button to display the corresponding plot, and (ii) the checkbox comes back to on every time.
How could I update the plot when I check/uncheck the box without pressing the Run button?
I tried to place the observe() and updateCheckboxInput() function outside the eventReactive() block, but it does simply not work.
My code:
library(shiny)
library(ggplot2)
ui <- fluidPage(
fileInput(
inputId = "input_file",
label = "Choose an input file"
),
actionButton(
inputId = "run_button",
label = "Run"
),
checkboxInput(
inputId = "operation_button",
label = "multiply instead of summing",
value = FALSE
),
plotOutput(
outputId = "my_plot"
)
)
server <- function(input, output, session) {
my_data <- eventReactive(
input$run_button,
{
inFile <- input$input_file
if(is.null(inFile)){
return(NULL)
}
my_in <- read.table(inFile$datapath, header = T, sep = "\t")
my_function <- function(input, operation){
if(operation == "sum"){
input <- input + 2
}else if(operation == "multiply"){
input <- input * 2
}
return(input)
}
button_switch <- ifelse(input$operation_button == FALSE, "sum", "multiply")
observe(
{
updateCheckboxInput(session, "operation_button", "multiply instead of summing", value = button_switch)
}
)
my_in <- my_function(my_in, button_switch)
}
)
output$my_plot <- renderPlot(
{
my_df <- my_data()
ggplot(my_df, aes(x=X, y=Y)) +
geom_point()
}
)
}
shinyApp(ui = ui, server = server)

You could make the eventReactive() dependent on multiple inputs:
my_data <- eventReactive(c(input$run_button, input$operation_button),...)

Showing and hiding inputs based on checkboxGroupInput

My shiny app begins with a checkboxGroupInput which contains the names of three companies: A, B and C. It also has 3 hidden numeric inputs, each corresponding to a company. Potential investors may select the name of the company they wish to invest in and specifiy the amount they are willing to invest. When the name of a company is checked, the corresponding numeric input shows up. Also, when the company name is unchecked, the numeric input disappears.
The checkboxGroupInput is called company. The 3 numericInput fields are respectively called amountA, amountB and amountC and are all generated inside a uiOutput. They are hidden with the hidden function of shinyjs.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observeEvent(eventExpr = input$company, handlerExpr = {
if(length(input$company) == 0){
for(i in num_ids){
shinyjs::hide(id = i)
}
} else {
for(i in input$company){
shinyjs::toggle(id = paste0("amount", i), condition = input$company)
}
}
})
}
shinyApp(ui = ui, server = server)
The problem with my app is that the intended dynamics between the checkboxGroupInput and the numericInput fields are not working as intended. For instance, once a numericInput is shown, it cannot be hidden anymore by unchecking the boxes. How can I handle this?
The code pasted above is fully functional. Thank you very much.

I fixed your code by explicitly show/hide the numericInput when the corresponding check box is selected/unselected. Also I change the observeEvent with observe to make sure that the observer reacts when none of the check boxes are selected.
library(shiny)
library(shinyjs)
library(magrittr)
ui <- fluidPage(
useShinyjs(),
checkboxGroupInput(inputId = "company", label = "Select a company", choices = LETTERS[1:3]),
uiOutput(outputId = "amounts")
)
server <- function(input, output){
company_names <- LETTERS[1:3]
num_ids <- paste0("amount", LETTERS[1:3])
output$amounts <- renderUI({
num_inputs <- lapply(1:3, function(i){
numericInput(inputId = num_ids[i], label = paste0("Investment in ", company_names[i]), value = 0, min = 0, max = 5000)
}) %>% tagList
shinyjs::hidden(num_inputs)
})
observe({
for(i in company_names){
if (i %in% input$company) {
shinyjs::show(id = paste0("amount", i))
} else {
shinyjs::hide(id = paste0("amount", i))
}
}
})
}
shinyApp(ui = ui, server = server)

Resources