I have a shiny App where I am displaying the same output multiple times. I have two inputs and they need to both control the same output. In my example below the outputs are copies of each other and it has to stay that way. Currently only the first input does anything. I need them to control the same output and react to changes in each other.
ui <- function(request) {
fluidPage(
textInput("txt1", "Enter text1"),
textInput("txt1", "Enter text2"),
checkboxInput("caps", "Capitalize"),
verbatimTextOutput("out1"),
verbatimTextOutput("out2"),
)
}
server <- function(input, output, session) {
output$out2<- output$out1 <- renderText({
if (input$caps)
toupper(input$txt1)
else
input$txt1
})
}
shinyApp(ui, server, enableBookmarking = "url")
You need to give your inputs unique IDs, but in your code both IDs are txt1. If you change this, you can use the normal reactivity:
library(shiny)
ui <- function(request) {
fluidPage(
textInput("txt1", "Enter text1"),
textInput("txt2", "Enter text2"),
checkboxInput("caps", "Capitalize"),
verbatimTextOutput("out1"),
verbatimTextOutput("out2"),
)
}
server <- function(input, output, session) {
output$out2<- output$out1 <- renderText({
if (input$caps)
paste(toupper(input$txt1), toupper(input$txt2))
else
paste(input$txt1, input$txt2)
})
}
shinyApp(ui, server, enableBookmarking = "url")
I have had a similar situation where I needed multiple identical inputs (albeit I only needed one output) that always have the same value.
The solution for me was to create a reactive element that holds the value for the inputs and syncs the value with the inputs.
Ie this code always makes input 1 and 2 have the same values
library(shiny)
ui <- fluidPage(
selectInput("id1", "Input 1", choices = c("A", "B")),
selectInput("id2", "Input 2", choices = c("A", "B")),
)
server <- function(input, output, session) {
# the reactive value always holds the value from the inputs
input_filter <- reactiveVal("A")
# sync from the reactive value to the inputs
observeEvent(input_filter(), {
print("input_filter() has changed")
updateSelectInput(session, "id1", selected = input_filter())
updateSelectInput(session, "id2", selected = input_filter())
})
# sync from the inputs to the reactive value
observeEvent(input$id1, {
print("Update id1")
input_filter(input$id1)
})
observeEvent(input$id2, {
print("Update id2")
input_filter(input$id2)
})
}
shinyApp(ui, server)
Related
I have a modularized application with two "ui" functions (ui and readTzUi) and two "server" functions. For the application I want to read the timezone from a users browser with readTzUi (input#client_time_zone_international) and pass it on to readTzServer.
I have worked out a reproducable example of the app.
As you can see the but_out and out variable can be accessed through the readTzServer, but input$client_time_zone_international results in a NULL value.
Although input$client_time_zone_international is not available in readTzServer, it is available in server (The values of timezone are printed in the console for both readTzServer and server)
A few things that I have tried so far are:
pass input$client_time_zone_international from server to readTzServer with Callmodule
create a global variable of input$client_time_zone_international
capture input$client_time_zone_international in a variable from the readTzUi with Shiny.setInputValue()
All these options did not result in passing the input$client_time_zone_international value to readTzServer.
I hope someone can help me with this problem.
library(shiny)
readTzUi <- function(id, label = "readTz"){
ns <- NS(id)
fluidPage(
tags$script('
$(function() {
$("input#client_time_zone_international").val(Intl.DateTimeFormat().resolvedOptions().timeZone)
});
'),
textInput("client_time_zone_international", "Time zone international", value = ""),
tags$br(),
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("but_out")),
verbatimTextOutput(ns("out"))
)
}
readTzServer <- function(id){
moduleServer(
id,
function(input, output, session){
# This is where I need the timezone value
observe(print(input$client_time_zone_international))
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$but_out <- renderText({
count()
})
count
observe({
output$out <- renderText({
"Hello"
})
})
}
)
}
ui <- fluidPage(
readTzUi("readtz1", "Counter#2")
)
server <- function(input, output, session) {
readTzServer("readtz1")
observe(
print(input$client_time_zone_international)
)
}
shinyApp(ui, server)
This is example how to get a timezone:
library(shiny)
ui <- basicPage(
tags$script("$(document).on('shiny:sessioninitialized', function(event) {
var n = Intl.DateTimeFormat().resolvedOptions().timeZone;
Shiny.onInputChange('client_time', n);});")
)
server <- function(input, output, session) {
observe({
req(input$client_time)
print(input$client_time)
})
}
shinyApp (ui = ui, server = server)
Is there any way to apply a req command to multiple output objects in a shiny app without having to repeat the req statement each time? In the example below, you will see that the req statement is repeated in both the part1 and part2 outputs.
library(shiny)
ui <- fluidPage(
textInput("commentText", "Input Text"),
textOutput(outputId = "part1"),
textOutput(outputId = "part2")
)
server <- function(input, output, session) {
output$part1 <- renderText({
req(input$commentText)
"Hello"
})
output$part2 <- renderText({
req(input$commentText)
"World!"
})
}
shinyApp(ui, server)
If possible, I would only like to have to input the req statement once (the actual use case has 6 different objects tied to the req so I'd like to avoid repetition if possible). I tried the following approach using an observer, but this fails when you type in and then delete text (when the text is deleted, 'HelloWorld!' still appears).
server <- function(input, output, session) {
observeEvent(input$commentText, {
req(input$commentText)
output$part1 <- renderText({
"Hello"
})
output$part2 <- renderText({
"World!"
})
})
}
It is not recommended to nest a render function inside an observer. Instead, you could use a renderUI and handle both texts.
req allows more than one argument. You can check several inputs in one statement.
req(..., cancelOutput = FALSE)
... Values to check for truthiness.
Attempted solution:
library(shiny)
ui <- fluidPage(
textInput("commentText", "Input Text"),
textInput("commentText2", "Input More Text"),
uiOutput(outputId = "part1and2")
)
server <- function(input, output, session) {
output$part1and2 <- renderUI({
req(input$commentText, input$commentText2)
tagList(
wellPanel("Hello"),
wellPanel("World!")
)
})
}
shinyApp(ui, server)
I have a code that allows to dynamically add modules in a Shiny app. This module is composed of a selectInput and can be added by clicking on the "Add filter" Button.
What I try to do is to put text at the right of each selectInput widget which value update when the user click on the perform Button and is equal to the selection on the selectInput
I don't know how to do. Many tries were unsuccessfull...
The code is the following :
library(shiny)
moduleFilterUI <- function(id) {
ns <- NS(id)
uiOutput(ns("SymbolicFilter"))
}
moduleSymbolicFilter <- function(input, output, session) {
output$SymbolicFilter <- renderUI({
fluidRow(
column(width = 4, selectInput(session$ns("cname"), "Column name", choices = c(1:5)))
)
})
}
ui <- fluidPage(
fluidRow(
actionButton("addSymbolicFilterModule", "Add filter"),
actionButton("Filter", "Perform"),
uiOutput("symbolicFilters"))
)
)
server <- function(input, output, session) {
symbolicFilterModules <- list()
makeReactiveBinding("symbolicFilterModules")
observeEvent(input$addSymbolicFilterModule, {
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", input$addSymbolicFilterModule)
symbolicFilterModules <<- c(symbolicFilterModules, list(moduleSymbolicFilterUI(duplicateSymbolicFilterid)))
callModule(moduleSymbolicFilter, duplicateSymbolicFilterid)
shinyjs::disable("addSymbolicFilterModule")
iLast <- length(symbolicFilterModules)
for (i in 1:(iLast-1)){
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", i)
updateSelectInput(session, paste0(duplicateSymbolicFilterid,"-cname"),
selected=input[[paste0(duplicateSymbolicFilterid,"-cname")]])
}
})
observeEvent(input$Filter,{
shinyjs::enable("addSymbolicFilterModule")
iLast <- length(symbolicFilterModules)
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", iLast)
cname <- input[[paste0(duplicateSymbolicFilterid,"-cname")]]
for (i in 1:(iLast)){
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", i)
updateSelectInput(session, paste0(duplicateSymbolicFilterid,"-cname"),
selected=input[[paste0(duplicateSymbolicFilterid,"-cname")]])
}
})
output$symbolicFilters <- renderUI({
symbolicFilterModules
})
}
shinyApp(ui = ui, server = server)
maybe you had already solved the problem, but...
you named the module moduleFilterUI, but you call moduleSymbolicFilterUI...
I am quite new to R shiny and so have not been able to figure out the solution from similar questions posted on this site. I am trying to read and use the input that a user provides to R shiny to generate an output.
I am trying to create a simple GUI where a user selects the name of a person (from a drop-down menu) and then enters his/her weight. If the height is above a certain threshold the output recommendation is "Gain Weight", else it is "Loose Weight".
Everything seems to be working fine, except for the following error from the Server.R file:
Error in `$.shinyoutput`(output, value_weight) :
Reading objects from shinyoutput object not allowed
How can I read and use the variable 'value_weight' in an if-then-else condition?
Main.R
library(shiny)
runApp()
Server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
output$value_weight <- renderPrint({ input$num })
if(output$value_weight > 150)
{
output$value_recommendation <- "Loose Weight"
}
else{
output$value_recommendation <- "Gain Weight"
}
}
UI.R
names_list <- list("Adam", "Jenna","Peter")
fluidPage(
selectInput("select", label = h3("Select Name"), choices = names_list, selected = 1),
hr(),
fluidRow(column(3, verbatimTextOutput("value_name"))),
numericInput("num", label = h3("Enter Weight"), value = 0),
hr(),
fluidRow(column(3, verbatimTextOutput("value_weight"))),
hr(),
fluidRow(column(3, verbatimTextOutput("value_recommendation")))
)
The problem in your code is the line
if(output$value_weight > 150)
Generally speaking, outputs are write-only objects in the server, while inputs are readonly. If you replace output$value_weight with input$num, everything should work fine. You also need to use a render-function for outputs: in this case renderPrint or renderText (see the documentation for the difference between those two render functions).
## server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
output$value_weight <- renderPrint({ input$num })
output$value_recommendation <- renderPrint({
if(input$num > 150)
"Loose Weight"
else
"Gain weight"
})
}
Another way to do this is using a call to the function reactive
## server.R
function(input, output) {
# You can access the value of the widget with input$select, e.g.
output$value_name <- renderPrint({ input$select })
value_weight <- reactive({ input$num })
output$value_weight <- renderPrint({ value_weight() })
output$value_recommendation <- renderPrint({
if(value_weight() > 150)
"Loose Weight"
else
"Gain weight"
})
}
Using 'renderText' solved the issue!
Server.R
function(input, output)
{
output$value_market <- renderPrint({ input$select })
output$value_demand <- renderPrint({ input$num })
output$value_recommendation <- renderText({
if(input$num > 150)
{
print("Loose Weight")
}
else{
print("Gain Weight")
}
})
}
I am having trouble with nested selectizeInputs, i.e. a group of select inputs where the selection in the first determines the choices in the second, which control the choices in the third, and so on.
Let's say I have an select1 that lets you choose a dataset, and select2 which lets you pick a variable in the dataset. Obviously the choices in select2 depend on the selection in select1. I find that if a user selects a variable from select2, and then changes select1, it doesn't immediately wipe out the value from select2, but instead it goes through a reactive sequence with the new value in select1, and the old value from select2, which is suddenly referencing a variable in a different dataset, which is a problem.
Example:
library(shiny)
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
htmlOutput("out")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
output$out <- renderUI({
req(input$d,input$v)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
}
runApp(list(ui = ui, server = server))
On launch, select mpg, and displays max value.
Now, after selecting mpg, if you switch to iris, you will get a barely noticeable error, then it corrects itself. This is a toy example, so the error is insignificant, but there could easily be cases where the error is much more dire (as is the case with the app I am currently developing).
Is there a way to handle nested selectizeInputs such that changes in an upstream selectizeInput won't evaluate with old values of down stream selectizeInputs when changed?
Thanks
edit: This issue turns out to have to do more with modules than anything else I believe:
library(shiny)
library(DT)
testModUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("out"))
}
testMod <- function(input, output, session, data) {
output$out <- DT::renderDataTable({
data()
},caption="IN MODULE")
}
ui =fluidPage(
selectizeInput('d',choices=c('mtcars','iris'),
label="Datasets"),
uiOutput("vars"),
testModUI("test"),
DT::dataTableOutput("test2")
)
server = function(input, output, session) {
output$vars <- renderUI({
req(input$d)
selectizeInput("v",choices=names(get(input$d)), label="Variables",
options=list(onInitialize=I('function() {this.setValue("");}')))
})
observe({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
callModule(testMod,"test",reactive(data.frame(v1=max(get(input$d)[[input$v]]))))
})
output$test2 <- DT::renderDataTable({
req(input$d,input$v)#,get(input$d)[[input$v]])
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
data.frame(v1=max(get(input$d)[[input$v]]))
},caption="OUTSIDE MODULE")
}
runApp(list(ui = ui, server = server))
Hello you can put condition to check if your code is going to run, here you just need that input$v to be a valid variable from input$d, so do :
output$out <- renderUI({
req(input$d,input$v)
if (input$v %in% names(get(input$d))) {
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
}
})
# or
output$out <- renderUI({
req(input$d,input$v)
validate(
need(input$v %in% names(get(input$d)), 'Wait.')
)
HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})
EDIT with module, you can define your module with an expression to validate like this :
testMod <- function(input, output, session, data, validExpr) {
output$out <- DT::renderDataTable({
validate(need(validExpr(), FALSE))
data()
},caption="IN MODULE")
}
And call the module in the server with the expression in a function :
observe({
req(input$d,input$v)
callModule(
module = testMod,
id = "test",
data = reactive({ data.frame(v1=max(get(input$d)[[input$v]])) }),
validExpr = function() input$v %in% names(get(input$d))
)
})