I have a fairly involved app. When I call a particular eventReactive function, let's call it function A, within a reactive expression, I get an error that function A cannot be found.
I'm unable to reproduce the exact app because it is proprietary, but I did create a dummy app that simulates the setup I have. I realize that there must be some difference between the dummy app and what I actually have, but I can't figure it out. The function in question is there, so I fundamentally don't understand why it's not being found.
library(shiny)
ui <- fluidPage(
sliderInput(inputId = "num",
label = "Choose a number",
value = 25, min = 1, max = 100),
actionButton(inputId = "action",
label = "Update"),
plotOutput("hist"),
verbatimTextOutput("stats")
)
server <- function(input, output) {
data <- eventReactive(input$action, {
input$num*2
})
data2 <- reactive({
data()*2
})
output$stats <- renderPrint({
data2()
})
}
shinyApp(ui = ui, server = server)
Related
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 am new to asynchronous programming in R with the Future Package so needed some help. I am trying to build a simple application with rshiny which supports asynchronous programming. So my code as a histogram plot, a slider, a simple text print and read.csv function to read a large CSV file. So my plan is before my read.csv function runs in the background using the future package in R, I would like to have control over my other application.
But my code waits for the CSV file to read. Any help will be appreciated. The code sample is below.
library(promises)
library(future)
library(shinydashboard)
library(shiny)
library(tidyverse)
plan(multiprocess)
#UI parts
ui <- dashboardBody(fluidRow(box(tableOutput("input1")),
box(textOutput("input2"))),
fluidRow(box(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 5,
value = 2
)
),
box(plotOutput(outputId = "distPlot"))),
fluidRow(box(
sliderInput(
"slider2",
label = h3("Slider Range"),
min = 0,
max = 100,
value = c(40, 60)
)
),
box(verbatimTextOutput("range"))))
#server part
server <- function(input, output, session) {
output$input1 <- renderTable({
promise <- future((read.csv("data/sample_large.csv")))
promise %...>% head() %...>% print()
})
output$input2 <- renderText({
print("hello")
})
output$distPlot <- renderPlot({
dist <- rnorm(input$bins)
hist(dist)
})
output$range <- renderPrint({
input$slider2
})
}
shinyApp(ui = dashboardPage(dashboardHeader(),
dashboardSidebar(),
ui),
server = server)
The behaviour you're experiencing where the rest of the UI is not loading until the promise is evaluated is expected behaviour. It is explained in the promises package as part of what they call the 'shiny flush cycle' and is described in more detail here and here.
Only after all of the outputs have completed executing are they sent back to Shiny to update the UI. You may expect/prefer outputs to be rendered as soon as they are ready but unfortunately that's not how Shiny operates.
As noted in the second link you can 'trick' shiny into thinking all outputs are executed and then use a reactive value to trigger the final update once the promise has evaluated:
#server part
server <- function(input, output, session) {
data <- reactiveVal()
# Return NULL from this operation so Shiny 'thinks' the output is evaluated
observe({
data(NULL)
future({read.csv("data/sample_large.csv")}) %...>%
data() #Assign to data
NULL
})
# When data() is updated as a side effect of our promise the table will be updated
output$input1 <- renderTable({
req(data()) %>%
head(5) %>%
print()
})
# in the mean time all outputs will be judged to be complete so can be rendered
output$input2 <- renderText({
print("hello")
})
output$distPlot <- renderPlot({
dist <- rnorm(input$bins)
hist(dist)
})
output$range <- renderPrint({
input$slider2
})
}
shinyApp(ui = dashboardPage(dashboardHeader(),
dashboardSidebar(),
ui),
server = server)
I'm trying to add a "save inputs" feature to my Shiny app where the saved inputs would be saved in a DT data table. If a user clicks an Add button, the inputs would be appended to a data table. A user then can delete a row from this data table by selecting a row and clicking the Delete button. I also need to have this table's values be saved as a global variable so it stays persistent across all sessions.
The example code is shown below. When I close the session, the table (this_table) is correctly updated, however, those changes don't appear realtime during the app. I've tried putting both of these input buttons in an eventReactive function, but this did not work when one of the buttons was selected more than once.
Any ideas?
Global table:
this_table = data.frame(bins = c(30, 50), cb = c(T, F))
Shiny app code:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("cb", "T/F"),
actionButton("add_btn", "Add"),
actionButton("delete_btn", "Delete")
),
mainPanel(
DTOutput("shiny_table")
)
)
)
server <- function(input, output) {
observeEvent(input$add_btn, {
t = rbind(data.frame(bins = input$bins,
cb = input$cb), this_table)
this_table <<- t
})
observeEvent(input$delete_btn, {
t = this_table
print(nrow(t))
if (!is.null(input$shiny_table_rows_selected)) {
t <- t[-as.numeric(input$shiny_table_rows_selected),]
}
this_table <<- t
})
output$shiny_table <- renderDT({
datatable(this_table, selection = 'single', options = list(dom = 't'))
})
}
shinyApp(ui = ui, server = server)
You can use reactiveVal to add server side variables that are observable and mutable at the same time. The syntax for those variables is to initialize them as
rV <- reactiveValue("init_value")
and update them with
rV("new_value")
Those variables can be accessed inside reactive contexts (basically like inputs) with
rV()
The syntax is quite unusual for R and might take time to get used to, but it is definitely the recommended way to solve issues like these. You might also want to take a look at reactiveValues for a similar functionality but with a semantic closer to the R class list.
Here is how this technique can be applied to your question
library(shiny)
library(DT)
this_table = data.frame(bins = c(30, 50), cb = c(T, F))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("cb", "T/F"),
actionButton("add_btn", "Add"),
actionButton("delete_btn", "Delete")
),
mainPanel(
DTOutput("shiny_table")
)
)
)
server <- function(input, output) {
this_table <- reactiveVal(this_table)
observeEvent(input$add_btn, {
t = rbind(data.frame(bins = input$bins,
cb = input$cb), this_table())
this_table(t)
})
observeEvent(input$delete_btn, {
t = this_table()
print(nrow(t))
if (!is.null(input$shiny_table_rows_selected)) {
t <- t[-as.numeric(input$shiny_table_rows_selected),]
}
this_table(t)
})
output$shiny_table <- renderDT({
datatable(this_table(), selection = 'single', options = list(dom = 't'))
})
}
shinyApp(ui = ui, server = server)
Finally, I would like to add that # Vishesh Shrivastavs recommendation to use the rhandsontable package is also a viable approach, although you will definitely loose some flexibility in doing so.
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)
I have output of data.tree package as follows in the console :
print(acme, "cost", "p")
#Out of Data.tree print JPEG
I want to render the same output structure in the shiny UI.
I have tried paste(console.output(print(acme, "cost", "p")),collapse = ""), but the output structure is not same.
ui <- fluidPage(
sliderInput(inputId = "slider",
label = "My number",
min = 300,
max = 19000,
value = 5000),
htmlOutput("mytext")
)
server <- function(input, output) {
output$mytext <- renderText({
paste(capture.output(print(acme, "cost", "p")),collapse = "<br/>")
})
}
shinyApp(ui = ui, server = server)
Please suggest me any render functions , that will print the output exactly like the above in the Shiny UI.
TL:DR; Replace renderText() with renderPrint() in server and htmlOutput() with verbatimTextOutput() in ui.
The issue is with how renderText() works. It concatenates all the text input with cat() which will fail when using against the data.tree object, which is a list. You should use renderPrint() to capture the output of your print statement. No capture.output() required. The renderPrint() will not work with various output methods, the safest one to use is verbatimTextOutput(). I base that recommendation from experimentation, not actual documentation research. htmlOutput might work but I an not sure.
Updated code:
ui <- fluidPage(
sliderInput(inputId = "slider",
label = "My number",
min = 300,
max = 19000,
value = 5000),
verbatimTextOutput("mytext")
)
server <- function(input, output) {
output$mytext <- renderPrint({
print(acme, "cost", "p"))
})
}
shinyApp(ui = ui, server = server)