Is it possible to get some R object used in Shiny?
For example, in the following code, I want to get text string inputted by users.
However, the .Last.value dose not the desired text string.
ref
How to store the returned value from a Shiny module in reactiveValues?
Ex code
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
myreturn <- reactiveValues()
observe({ myreturn$txt <- input$txt })
return(myreturn)
}
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
observe({
myvals$txt <- mytxt$txt
print(myvals$txt)
})
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
.Last.value
Yes, you can push variables to the global environment (your usual workspace) from a Shiny app running in your console:
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(NULL)
)
)
server <- function(input, output) {
observe({
my_global_env <- globalenv()
my_global_env$x <- input$bins
})
}
shinyApp(ui = ui, server = server)
Related
I have a modularized R Shiny app in which a sliderInput() is created within renderUI() so that the value can be passed to further processing (here, a renderPrint()). First, I tested the construct in a simple app composed of a global.R, a ui.R and a server.R, where it works as expected (i.e. on slider modification, the correct slider input is printed):
global.R
library(shiny)
ui.R
shinyUI(fluidPage(
fluidRow(column(3,
uiOutput("ui")),
column(3,
verbatimTextOutput("dynamic_value")))))
server.R
shinyServer(function(input, output, session) {
output$ui <- renderUI({
sliderInput("dynamic", "The slider:",
min = 1,
max = 20,
value = 10)
})
output$dynamic_value <- renderPrint({
str(input$dynamic)
})
})
Then, I transferred this construct to a modularized app, in which--to my surprise--the value passed from the slider to the text output is NULL instead of the actual value from the slider input:
global.R
library(shiny)
# load module
source("test_module.R")
test_ui.R
test_module_ui(id = "test")
ui.R
shinyUI(fluidPage(navbarPage(title = "Dynamic sliderInput",
tabPanel("Panel",
source("test_ui.R",
local = TRUE)$value))))
server.R
shinyServer(function(input, output, session) {
callModule(test_module, "test")
})
test_module.R
test_module_ui <- function(id) {
ns <- NS(id) # namespace
fluidRow(
column(3,
uiOutput(ns("ui"))),
column(3,
verbatimTextOutput(ns("dynamic_value")))
)
}
test_module <- function(input, output, session) {
output$ui <- renderUI({
sliderInput("dynamic", "The slider:",
min = 1,
max = 20,
value = 10)
})
output$dynamic_value <- renderPrint({
str(input$dynamic)
})
}
Does someone know what is misspecified here? Any hints are highly appreciated--thank you! :)
As stated in this question, you have to use session$ns() in the renderUI():
test_module_server <- function(input, output, session) {
output$ui <- renderUI({
sliderInput(session$ns("dynamic"), "The slider:",
min = 1,
max = 20,
value = 10)
})
My shinyapp is build using modules, the radioBox component inputId = modelling_type is created in the server, using a renderUI function and stored under outputId = modelling_type_ui
As I'm using modules, I have name spaced my IDs in the mod_ui, and then in order to (attempt!) to use the same name space function in the mod_server I have called it via ns <- parentsession$ns. This doesn't throw an error. But I would now expect to access the value of the RadioBox via input$modelling_type
This isn't working! So I must be calling the value incorrectly.
Here is the code:
library(shiny)
library(shinyalert)
library(shinydashboard)
library(shinyjs)
library(tidyverse)
# modules ------------------------------------------
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id, parentsession){
moduleServer(id,
function(input, output, server){
ns <- parentsession$ns
output$modelling_type_ui = renderUI({
print(input$modelling_type) # this should not be null
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS",
"Bayesian"),
selected = "OLS")
})
output$capture = renderText({ paste0("modelling type selected:", input$modelling_type) })
})
}
# call app ---------------------------------------
# run app
ui <- function(){ mod_ui("mt") }
server <- function(input, output, session){ mod_server("mt", session) }
shinyApp(ui = ui, server = server)
Any help appreciated. Usually I would just call radioButtons in the UI, and use updateradioButtons function in the server, but I'm dealing with a legacy app which uses the below method repeatedly.
To expand on my comment above, here is a MWE that I believe does what you want.
I'm not sure why you're using uiOutput and renderUI. I assume it's needed in your actual use case, but it's not needed here. Also, there's no need to muck about with parentsession and the like.
One reason why your debug print prints NULL is that you haven't defined the radio group at the time you try to print its value.
library(shiny)
library(tidyverse)
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id) {
moduleServer(
id,
function(input, output, session){
ns <- session$ns
output$modelling_type_ui = renderUI({
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS","Bayesian"),
selected = "OLS"
)
})
output$capture <- renderText({
paste0("modelling type selected: ", input$modelling_type)
})
rv <- reactive({
input$modelling_type
})
return(rv)
}
)
}
ui <- function() {
fluidPage(
mod_ui("mt"),
textOutput("returnValue")
)
}
server <- function(input, output, session) {
modValue <- mod_server("mt")
output$returnValue <- renderText({
paste0("The value returned by the module is ", modValue())
})
}
shinyApp(ui = ui, server = server)
I'm making an app with modules in which the user can create as many UI as he wants. Each UI contain one table and I would like to give the possibility to the user to see the code for each of this table separately, not in a unique chunk. Therefore, I included the part of the code with expandChain in my module (module_server).
However, expandChain won't detect the reactive stuff I'm calling because the name of this stuff changes since it is created in a module. Take a look at the app below:
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(count$value))
callModule(module_server, count$value)
})
}
shinyApp(ui, server)
When I try to show the code for the table generated, I have the error:
Warning: Error in : <text>:2:2: unexpected input
1: `1_data` <- mtcars
2: 1_
^
133: <Anonymous>
Since the module renames data() by adding a number, data() is not recognized by expandChain. I tried with:
expandChain(paste0(id, "_data()"))
without success (since expandChain does not support character).
Does anybody know how to do it?
Also asked on RStudio Community
Here's the solution given on RStudio Community (see the link for some additional details):
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
}
shinyApp(ui, server)
I'm trying to write a shiny app where I produce a list and add and delete some elements.
I have a module to add somethind to my list.
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- list()
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})
}
Then I call it twice and connect the 2 different inputs. Now I want to choose the elements to delete but this doesn't work.
source('/cloud/project/Queue/find_input.R')
library(shiny)
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- eventReactive(input$combine, {
return(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended <<- appended()[-input$delete]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Maybe anybody can tell me what's wrong so far?
Thanks in advance!
Below is an app which seems to work but I'm not sure to understand what your app is intended to do.
In general, prefer reactive values (reactiveVal) instaed of using the non-local assignment <<-.
The code appended <<- appended()[-input$delete] is not correct. It does not replace the output of appended() by its originalvalue minus the input$delete index.
library(shiny)
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- reactiveVal(list())
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue(append(queue(), queue_append))
})
queue_ret <- eventReactive(input$press, {
list(queue=queue(), add=input$press)
})
}
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- reactiveVal(list())
observeEvent(input$combine, {
appended(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended(appended()[-as.integer(input$delete)])
})
}
# Run the application
shinyApp(ui = ui, server = server)
The example app below has two shiny modules. The first module displays a table with randomly generated values as well as an action button, which, when clicked, generates new values. The second module displays the data set generated in the first one.
How do I make the second table change with the first one?
Thank you.
app.R
library(shiny)
source("modules.R")
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1$values)
}
shinyApp(ui, server)
modules.R
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table1_module <- function(input, output, session) {
table <- reactiveValues()
observeEvent(input$submit, {
table$values <- replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table$values
})
return(table)
}
# Module for table 2
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table2_module <- function(input, output, session, table_data){
output$table <- renderTable({
table_data
})
}
The second module seems to be missing in the question but the logic seems to be straight forward. The issue here is that you are passing the value of the reactive expression to the second module when you use,
callModule(table2_module, "table2", table_data = table1$values)
instead, you want to pass the reactive value, which tells R to invalidate the outputs when the reactive values changes,
callModule(table2_module, "table2", table_data = table1)
here is the complete app,
library(shiny)
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table1_module <- function(input, output, session) {
table <- reactiveValues()
observeEvent(input$submit, {
table$values <- replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table$values
})
return(table)
}
table2_module <- function(input, output, session,table_data) {
output$table <- renderTable({
table_data
})
}
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1$values)
}
shinyApp(ui, server)
As a caveat, if you are wanting to display a dataframe, using reactive values seems to be overkill. When we want to return a reactive expression, intead of initializing a reactive variable and setting it in an observer we can simply use reactive() or eventReactive(), this is what they are there for! So let's use it. Reactive values have their space, and in my experience are used relatively sparingly.
library(shiny)
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table1_module <- function(input, output, session) {
table = eventReactive(input$submit, {
replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table()
})
return(table)
}
table2_module <- function(input, output, session,table_data) {
output$table <- renderTable({
table_data()
})
}
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1)
}
shinyApp(ui, server)