Following is the toned down version of my original problem. Here I am
trying to run an 'observeEvent' function into another 'observeEvent'
function. The code should perform the following steps sequentially:
On click of 'Print' button, Print the input number
On click of 'Add' button, Add +5 with the printed number
The code is working for first time only. From second time it is
showing the added number along with the printed without any click on
'Add' button.
Please help.
library(shiny)
ui <- fluidPage(
fluidRow(
sliderInput("n", min = 0, max = 100, value = 50, label = "Choose a number"),
actionButton("Print","Print the number"),
verbatimTextOutput("num1"),
actionButton("Add","Add +5 to the printed number"),
verbatimTextOutput("num2")
)
)
server <- function(input, output){
all <- reactiveValues(
n = 50,
a = 55
)
observeEvent(input$Print,{
all$n <- input$n
output$num1 <- renderPrint(all$n)
observeEvent(input$Add,{
all$d <- input$n + 5
output$num2 <- renderPrint(all$d)
})
})
}
shinyApp(ui = ui, server = server)
If you separate them, you can make the second observeEvent to get triggered from whatever happens inside the first one.
library(shiny)
ui <- fluidPage(
fluidRow(
sliderInput("n", min = 0, max = 100, value = 50, label = "Choose a number"),
actionButton("Print","Print the number"),
verbatimTextOutput("num1"),
actionButton("Add","Add +5 to the printed number"),
verbatimTextOutput("num2")
)
)
server <- function(input, output){
all <- reactiveValues(
n = 50,
a = 55
)
observeEvent(input$Print, {
all$n <- input$n
output$num1 <- renderPrint(all$n)
})
observeEvent(all$n, {
all$d <- input$n + 5
output$num2 <- renderPrint(all$d)
})
}
shinyApp(ui = ui, server = server)
Related
Here's the minimal reproducible example:
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have created live examples for demonstration.
With the second part of the program commented out.
The complete program. [Shinyapps.io] is supressing the error details, so attached is a screenshot of a local run.
The error is object of type 'closure' is not subsettable. While many questions (and answers) regarding this error exist, I am yet to find any explaining the behaviour demonstrated above.
Why does this happen?
The normal (script-equivalent) works as expected.
datExpr <- as.data.frame(iris)
n = 50
datExpr0 <- datExpr[1:n, ]
datExpr0
keepSamples = 10
datExpr <- datExpr0[keepSamples,]
datExpr
Is there a way to achieve what the normal script does in the shiny app?
The issue is that you have both a dataframe and a reactive in your app called datExpr. Simply rename one of both (I decided for the reactive).
EDIT There is of course nothing special about that in shiny.
A simple example to illustrate the issue:
datExpr <- iris
datExpr <- function() {}
datExpr[1:2]
#> Error in datExpr[1:2]: object of type 'closure' is not subsettable
And you see that we get the famous object of type 'closure' is not subsettable error too. The general issue or lesson is that in R you can't have two different objects with the same name at the same time.
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr1 <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr1()
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:3648
I have an app with two numericinput. Both presented values between 0 and 1. What I wanted to do is the following: As the sum of the two weights must equal 1, so when I select the first weight, for example, 0.2, the second will be 0.8. Got the idea?
Executable code below
library(shiny)
ui <- fluidPage(
numericInput("weight1", label = h4("Weight 1"),
min = 0, max = 1, value = 0.5),
numericInput("weight2", label = h4("Weight 2"),
min = 0, max = 1, value = 0.5),
helpText("The sum of weights should be equal to 1"),
hr(),
fluidRow(column(3, verbatimTextOutput("value1"))),
fluidRow(column(3, verbatimTextOutput("value2")))
)
server <- function(input, output,session) {
output$value1 <- renderPrint({ input$weight1 })
output$value2 <- renderPrint({ input$weight2 })
}
shinyApp(ui = ui, server = server)
You can do it by using observeEvent and updateNumericInput.
Here's what the code will look like:
server <- function(input, output,session) {
observeEvent(input$weight1, {
updateNumericInput(session, 'weight2',
value = 1 - input$weight1)
})
output$value1 <- renderPrint({ input$weight1 })
output$value2 <- renderPrint({ input$weight2 })
}
Note: You don't need updateNumericInput if you are dealing with only two numbers and every time you need the sum to be equal to 1.
I am trying to set a default (or fallback) value for numericInput() in my shiny app to prevent NAs.
I am aware that the NA can be dealt with later in the server.r, but was wondering if there is a more elegant way of replacing the value within the input whenever a user deletes it in the ui.
The best way is to use the validate package with need() (see this SO thread), but here is something simpler and closer to what you are asking for:
library(shiny)
ui <- fluidPage(
numericInput("obs", "Observations:", 10, min = 1, max = 100),
verbatimTextOutput("value")
)
server <- function(input, session, output) {
dafault_val <- 0
observe({
if (!is.numeric(input$obs)) {
updateNumericInput(session, "obs", value = dafault_val)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
I'd recommend using library(shinyvalidate), which is RStudios "official" way to solve this:
library(shiny)
library(shinyvalidate)
ui <- fluidPage(
numericInput(
inputId = "myNumber",
label = "My number",
value = 0,
min = 0,
max = 10
),
textOutput("myText")
)
server <- function(input, output, session) {
iv <- InputValidator$new()
iv$add_rule("myNumber", sv_required(message = "Number must be provided"))
iv$add_rule("myNumber", sv_gte(0))
iv$add_rule("myNumber", sv_lte(10))
iv$enable()
output$myText <- renderText({
req(iv$is_valid())
input$myNumber
})
}
shinyApp(ui, server)
I want to make a shiny app that can make successive calculations based on user input. Something like this:
a <- input$inputa
b <- a+2
c <- b-3
d <- c*4
e <- d/5
So the user would choose input a, and the shiny app would do the rest and show values a, b, c, d, e.
I managed to do it if the app always makes the entire calculations based on a. But if I try to create value b and call it, it breaks.
The following code works and shows the final result as it should, but I'm sure it can be improved upon, removing repetitions:
# UI
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
output$output1 <- renderText({ input$inputa })
output$output2 <- renderText({ input$inputa+2 })
output$output3 <- renderText({ ( input$inputa+2)-3 })
output$output4 <- renderText({ (( input$inputa+2)-3)*4 })
output$output5 <- renderText({ ((( input$inputa+2)-3)*4)/5 })
}
shinyApp(ui, server)
The last bit, (((input$inputa+2)-3)*4)/5, looks terrible and is terrible. Can I make a shiny app that creates a value in one equation and uses that value in the next equation?
Thanks!
You can store the data in a reactive expression.
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
rv <- reactive({
tibble::tibble(a = input$inputa, b = a + 2, c = b-3, d = c*4, e = d/5)
})
output$output1 <- renderText({rv()$a})
output$output2 <- renderText({rv()$b})
output$output3 <- renderText({rv()$c})
output$output4 <- renderText({rv()$d})
output$output5 <- renderText({rv()$e})
}
shinyApp(ui, server)
I have been trying to reconstruct the following simplistic Shiny app using modules since I believe that will be the best way to organize this code inside a much larger application where I will use these kinds of linked-slider-numeric inputs in many places.
However, I cannot figure out how to achieve the same kind of functionality from within a module.
Here's an example app that works exactly as intended, but not using modules:
library(shiny)
# Let's build a linked Slider and Numeric Input
server <- function(input, output) {
values <- reactiveValues(numval=1)
observe({
values$numval <- input$slider
})
observe({
values$numval <- input$number
})
output$slide <- renderUI({
sliderInput(
inputId = 'slider'
,label = 'SN'
,min = 0
,max = 10
,value = values$numval
)})
output$num <- renderUI({
numericInput(
inputId = 'number'
,label = 'SN'
,value = values$numval
,min = 0
,max = 10
)
})
}
ui <- fluidPage(
uiOutput('slide'),
uiOutput('num')
)
shinyApp(ui, server)
Here's my attempt. (Note that "mortalityRate" and associated strings are just an example of the variable name(s) I'll be using later). I have tried several variations on this attempt, but inevitably I get errors, usually indicating I'm doing something that can only be done inside a reactive context:
numericSliderUI <- function(id, label = "Enter value", min = 1, max = 40, value) {
ns <- NS(id)
tagList(
sliderInput(inputId = paste0(ns(id), "Slider"), label = label, min = min, max = max, value = value),
numericInput(inputId = paste0(ns(id), "Numeric"), label = label, min = min, max = max, value = value)
)
}
numericSlider <-
function(input,
output,
session,
value,
mortalityRateSlider,
mortalityRateNumeric
) {
values <- reactiveValues(mortalityRate = value())
observe({
values[['mortalityRate']] <- mortalityRateSlider()
})
observe({
values[['mortalityRate']] <- mortalityRateNumeric()
})
return( reactive( values[['mortalityRate']] ) )
}
library(shiny)
# source("modules.R") # I keep the modules in a separate file, but they're just pasted above for convenience here on StackOverflow.
ui <- fluidPage(
uiOutput('mortalityRate')
)
server <- function(input, output) {
values <- reactiveValues(mortalityRate = 1)
mortalityRateValue <- callModule(
numericSlider,
id = 'mortalityRate',
value = values[['mortalityRate']],
mortalityRateSlider = reactive( input$mortalityRateSlider ),
mortalityRateNumeric = reactive( input$mortalityRateNumeric )
)
values[['mortalityRate']] <- reactive( mortalityRateValue() )
output$mortalityRate <- renderUI(numericSliderUI('mortalityRate', value = values[['mortalityRate']]))
}
shinyApp(ui = ui, server = server)
I know that I must be doing something wrong with the reactiveValues and the way I'm using the observe statements inside the module, but this is my best attempt at using the module structure, so any help figuring out what I'm doing wrong would be very helpful.
Here is working code. There are a variety of changes, so I'll direct you to this Github page that also sets up a structure for using renderUI with modules. In general, I think the problems in your code involved trying to define reactive values inside the callModule function, and in passing the values of the sliders and numeric box back and forth.
Other features of using modules are that in your actual UI call, you need to call the UI module, where in turn you can call uiOutput. Inside renderUI is where you can set up the inputs. Additionally, inside modules you don't need the session namespaces, but you do need to wrap those ids in session$ns() to ensure they work across modules.
UI and Server Modules:
numericSliderUI <- function(id) {
ns <- NS(id)
uiOutput(ns('mortalityRate'))
}
numericSlider <- function(input, output, session) {
values <- reactiveValues(mortalityRate = 1)
observe({
values[['mortalityRate']] <- input$Slider
})
observe({
values[['mortalityRate']] <- input$Numeric
})
output$mortalityRate <- renderUI(
tagList(
sliderInput(inputId = session$ns("Slider"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']]),
numericInput(inputId = session$ns("Numeric"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']])
)
)
return(list(value = reactive({values[['mortalityRate']]})))
}
UI and Server functions:
ui <- fluidPage(
numericSliderUI('mortalityRate')
)
server <- function(input, output, session) {
mortalityRateValue <- callModule(numericSlider, 'mortalityRate')
}
shinyApp(ui = ui, server = server)