I want create output spaces in UI part of Shiny conditionally. If the variable in server changed, the output spaces should be defined in UI.
library(shiny)
ui <- fluidPage(
mainPanel("main panel", textOutput("ts_txt_main"))
)
server <- function(input, output) {
observe({
for (i in 1:10) {
output[[paste0("ts_txt",i)]<- renderText({ "Some_text" })
}
})
}
shinyApp(ui = ui, server = server)
I need textOutput("ts_txt_main") to be changed or extended to textOutput("ts_txt1"), textOutput("ts_txt2"), textOutput("ts_txt3"), textOutput("ts_txt4"), textOutput("ts_txt5"), textOutput("ts_txt6"), textOutput("ts_txt7"), textOutput("ts_txt8"), textOutput("ts_txt9"), textOutput("ts_txt10")
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 want to selectInput from reactive data frame column as code below but it is not showed anything:
library(shiny)
library(data.table)
ui <- fluidPage(
selectInput('region','Select region',choice=tableOutput('region'),selected=NULL)
)
server <- function(input, output, session){
data<- reactive(fread('murders.csv')) # this file contain 'region' column
output$region <- renderTable(data()$region)
}
shinyApp(ui = ui, server = server)
But when I read data outside server function (not reactive) the selectinput is working normal:
library(shiny)
library(data.table)
ui <- fluidPage(
selectInput('region','Select region',choice=data$region,selected=NULL)
)
data<- fread('murders.csv') # this file contain 'region' column
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
I think it is better to read file in reactive mode in server function, could you show me how to select input from data column in reactive mode ?
Unless you are planning on changing the murder csv file, there is no need for it to be reactive, and it can be a global value. If you are keen on it not being a global you can transform the ui in a function and load the data inside.
Version 1
library(shiny)
library(data.table)
ui <- function(request){
data <- fread("murders.csv")
fluidPage(
selectInput('region','Select region',choice=data$region,selected=NULL)
)
}
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
If you really want, by some reason, to load it inside the server what you are looking for is updateSelectInput. See version below
Version 2
library(shiny)
library(data.table)
ui <- fluidPage(
selectInput('region','Select region',choices=NULL, selected=NULL)
)
server <- function(input, output, session){
data <- fread("murders.csv")
updateSelectInput(session, "region", choices=data$region)
}
shinyApp(ui = ui, server = server)
And as I said there is no need for it to be reactive, but if you really want it to be reactive, you have to access the reactive inside a reactiveEnvironment, in this case observeEvent seems the most adequate:
Version 3
library(shiny)
library(data.table)
ui <- fluidPage(
selectInput('region','Select region',choices=NULL, selected=NULL)
)
server <- function(input, output, session){
data <- reactive(fread("murders.csv"))
observeEvent(data(),updateSelectInput(session, "region", choices=data()$region))
}
shinyApp(ui = ui, server = server)
I am using renderUI to optionally present a Table or Plot based on user selection of the visualization option. I am also using Shiny modules to present the same thing on multiple tabs. While I have gotten Shiny modules to work wonderfully in another app, I am struggling to get it to work with renderUI.
Here is a minimal piece of code that I came up with that shows the problem where nothing gets displayed on either tabs:
myUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('myFinalText'))
)
}
ui <- fluidPage(
tabBox(id = 'myBox', width = 12,
tabPanel('Tab1',
fluidRow(
myUI('tab1')
)),
tabPanel('Tab2',
fluidRow(
myUI('tab2')
))
)
)
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput('myText')
})
}
server <- function(input, output, session) {
callModule(myTextFunc, 'tab1', session = session, 'Hello Tab1')
callModule(myTextFunc, 'tab2', session = session, 'Hello Tab2')
}
shinyApp(ui = ui, server = server)
Any thoughts on what else I should be doing to make this work?
Replacing the Shiny module UI function and server functions as follows makes it work fine.
myUI <- function(id) {
ns <- NS(id)
fluidRow(
textOutput(ns('myFinalText'))
)
}
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderText({
text
})
}
You can get the namespace from the session object. Change myTextFunc in the initial app like this:
myTextFunc <- function(input, output, session, text) {
ns <- session$ns
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput(ns('myText'))
})
}
You shouldn't call output$ function from another output$ function - it's against Shiny design patterns.
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput(ns('myText'))
})
If you want to know, why it is very bad practice, watch Joe Cheng tutorial about 'Effective reactive programming' from this site: https://www.rstudio.com/resources/webinars/shiny-developer-conference/.
You should use rather reactiveValues or reactive expressions instead. What exactly you should use is dependent from what do you want to achieve, so it's hard to say without detailed example, but according to Joe Cheng everything can be accomplished without nesting outputs or observers.
Sorry for answering my own question...but for others looking for a similar solution, this may be of help.
Here is how I solved for the need to inherit Shiny module namespace on the server side to dynamically render UI. IF there is a better way to solve, please comment or post.
tab1NS <- NS('tab1')
tab2NS <- NS('tab2')
myUI <- function(ns) {
tagList(
fluidRow(
radioButtons(ns('type'), 'Select Visual:',
choices = c('Table' = 'table',
'Plot' = 'plot'))
),
fluidRow(
uiOutput(ns('myCars'))
)
)
}
ui <- fluidPage(
tabBox(id = 'myBox', width = 12,
tabPanel('Tab1',
fluidRow(
myUI(tab1NS)
)),
tabPanel('Tab2',
fluidRow(
myUI(tab2NS)
))
)
)
myTextFunc <- function(input, output, session, cars, ns) {
getMyCars <- reactive({
if (input$type == 'table') {
output$table <- renderDataTable({datatable(cars)})
dataTableOutput(ns('table'))
} else{
output$plot <- renderPlot({
plot(cars$wt, cars$mpg)
})
plotOutput(ns('plot'))
}
})
output$myCars <- renderUI({
getMyCars()
})
}
server <- function(input, output, session) {
callModule(myTextFunc, 'tab1', session = session,
mtcars[mtcars$am == 1, ], tab1NS)
callModule(myTextFunc, 'tab2', session = session,
mtcars[mtcars$am == 0, ], tab2NS)
}
shinyApp(ui = ui, server = server)
Replacing your functions with this renderUI equivalent also works:
myUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('myFinalText'))
)
}
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderUI({
text
})
}
Although this obviously does not capture the complexity of what you are really doing. There's something not right about using output$... and textOutput within the renderUI like that. I don't think that is necessary - you don't actually have to use the textOutput function to include text in your output.
EDIT: It occurs to me that the problem has to do with namespaces and modules. When you do output$myText <- renderText(text), the result ends up in the namespace of tab1 or tab2. For example, try changing your textOutput to
textOutput('tab1-myText')
and watch what happens. I think this is why having output$.. variables in your renderUI is problematic. You can access inputs via callModule and that should take care of any namespace issues.
Here is my code in R Shiny using modules.
I created a module named MyModule and want to generate two UI elements: selectInput and textInput. This code is just an example - in my real application second element require the result from the first element, so I want to generate them separately.
I don't understand why the second uiOutput doesn't generate the UI element it indended to:
library(shiny)
# Define UI
ui <- shinyUI(fluidPage(MyModuleUI("one")))
# Define server logic
server <- shinyServer(function(input, output, session) {callModule(MyModule, 'one')})
#Here is my UI Module
MyModuleUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('ChooseNumber')),
uiOutput(ns('EnterText'))
)
}
#Here is my server Module
MyModule <- function(input, output, session) {
output$ChooseNumber <- renderUI({
# In my bigger program I need this UI to be generated with some database values,
# thats why it is in the Server part of the Module
ns <- session$ns
selectInput(ns("TheNumber"), label = 'Select a number', c(1,2,3))
})
# Same here
output$EnterText <- renderUI({
ns <- session$ns
textInput(ns('TheText'),label = 'Enter a text:',value = 'ABC')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you!