Consider this sample shiny application. You can type in a car name like "Valiant" and it will print out the MPG value from the mtcars built-in data set. I also wanted to allow the user to click on a car rather than type it. I did this by generating a list of links with car names and writing a bit of javascript to call Shiny.setInputValue when the link is clicked.
I noticed that when a link is clicked, the server state updates (ie the textOutput("MPG") value changes) but the text box doesn't update to show the current value. Is there a different way to get the value such that the textInput is updated AND the reactive textOutput is updated?
library(shiny)
script <- "$(document).on('click', '.name-opt a', function (evt) {
evt.preventDefault(); Shiny.setInputValue('name',this.dataset.name);
});"
ui <- fluidPage(
tags$head(tags$script(HTML(script))),
textInput("name", "Name:"),
textOutput("MPG"),
uiOutput("carlist")
)
server <- function(input, output, session) {
output$carlist <- renderUI({
tags$ul(
Map(function(v) tags$li(tags$a(v, href="#", "data-name"=v)), rownames(head(mtcars, 20))),
class="name-opt")
})
output$MPG <- renderText({
req(input$name)
paste(input$name, "mpg:", mtcars[input$name,]$mpg)
})
}
shinyApp(ui, server)
Tested with shiny_1.5.0
Serverside: You have to make a reactive value, here: myinput, and then call its value with myinput(). Then you need observer that fires the updateTextInput whenever myinput() changes
myinput = reactive({
paste(input$name)
})
observeEvent(myinput(),{
updateTextInput(session, "name", value = myinput())
})
The whole code:
library(shiny)
script <- "$(document).on('click', '.name-opt a', function (evt) {
evt.preventDefault(); Shiny.setInputValue('name',this.dataset.name);
});"
ui <- fluidPage(
tags$head(tags$script(HTML(script))),
textInput("name", "Name:"),
textOutput("MPG"),
uiOutput("carlist")
)
server <- function(input, output, session) {
output$carlist <- renderUI({
tags$ul(
Map(function(v) tags$li(tags$a(v, href="#", "data-name"=v)), rownames(head(mtcars, 20))),
class="name-opt")
})
output$MPG <- renderText({
req(input$name)
paste(input$name, "mpg:", mtcars[input$name,]$mpg)
})
myinput = reactive({
paste(input$name)
})
observeEvent(myinput(),{
updateTextInput(session, "name", value = myinput())
})
}
shinyApp(ui, server)
Related
In the below code for a Shiny app, I am expecting the print line to execute when the user clicks on a new row in the datatable. When I do this, the textOutput updates with the selected row via input$table_rows_selected as expected. But why does change <- reactive({ }) not take a dependency on changes to input$table_rows_selected and trigger the print message?
I see that it works with observe({}) but ultimately I want to use a value that reactive returns in different places (e.g here return and return2).
library(shiny)
library(DT)
ui <- fluidPage(
DT::DTOutput("table"),
textOutput("selected"),
textOutput("return"),
textOutput("return2")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
data.frame(a = 1:3, b = 4:6)
}, selection = 'single')
output$selected <- renderText({
input$table_rows_selected
})
change <- reactive({
input$table_rows_selected
print("it changed!")
"return"
})
output$return <- renderText({
isolate(change())
})
output$return2 <- renderText({
paste0(isolate(change()), "_2")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Your code has 2 problems:
a reactive is just a function, therefore its return value is the last value generated in the reactive -> you need to put input$table_rows_selected last
the isolate(change()) means that reactives don't have a dependency on input$table_rows_selected -> remove the isolate
library(shiny)
library(DT)
ui <- fluidPage(
DT::DTOutput("table"),
textOutput("selected"),
textOutput("return"),
textOutput("return2")
)
server <- function(input, output) {
output$table <- DT::renderDataTable({
data.frame(a = 1:3, b = 4:6)
}, selection = 'single')
output$selected <- renderText({
input$table_rows_selected
})
change <- reactive({
print("it changed!")
input$table_rows_selected
})
output$return <- renderText({
change()
})
output$return2 <- renderText({
paste0(change(), "_2")
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm making an app in which the user can create as many tables as he/she wants and display the code necessary to remake each individual table using shinymeta. I can generate the code for each of these tables but I have a problem when I want to create a complete modal that shows every code for each table.
To be clearer, here's a reproducible example:
library(shiny)
library(dplyr)
library(shinymeta)
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
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
return(data())
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
expandChain(x1_data)
})
))
})
}
shinyApp(ui, server)
When you click on "Launch", two buttons are generated and you can display a table ("Show table") and the code to remake this table ("Show code"). You can click on "Launch" indefinitely and the table will be named x1_data, x2_data, etc.
However, when I try to generate the code that unites every individual code (by clicking on "Show the full code"), x1_data is not found. Using x1_data() does not work either. I'm not a fan of asking two questions in one post but I will do this now:
How can I access the reactive elements created inside modules?
How can I "merge" every individual code in a big one?
Also asked on RStudio Community
Edit: following a comment, I add a second reactive expression in my example, so that I can't use return on both of them.
Ok, I came up with an answer that has the module return the expandChain() results rather than trying to render them again in the server:
library(shiny)
library(dplyr)
library(shinymeta)
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
}))
})
data2 <- metaReactive({
..(data()) %>%
select(mpg)
})
output$table <- renderTable({
data2()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data(), data2())
})
))
})
########################################
### create list of reactive objects ####
########################################
return(list(
expandChain(data(), data2())
)
)
}
ui <- fluidPage(
actionButton("launch", "Launch"),
actionButton("show_full_code", "Show the full code (at least 2 'launch' before)")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#show_full_code",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
#### "Merge" the single code modals in one big list object
my_data <- reactive({
req(count$value)
my_set <- 1:count$value
### lapply through the different name spaces so all are captured ###
final <- lapply(my_set, function(x){
temp <- callModule(module_server, paste0("x", x))
return(temp)
})
return(final)
})
#### "Merge" the single code modals in one big
observeEvent(input$show_full_code, {
showModal(modalDialog(
renderPrint({
temp <- sapply(unlist(my_data()), function(x){
print(x)
})
})
))
})
}
shinyApp(ui, server)
In the following example, duplicate input elements seem to be created, although output$app is re-rendered with every login/logout.
library(shiny)
user <- reactiveValues(logged_on = 0)
ui <- fluidPage(
uiOutput("app")
)
server <- function(input, output) {
observe({
if (user$logged_on == 1) {
output$app <- renderUI({
list(
uiOutput("container1"),
uiOutput("container2")
)
})
output$container1 <- renderUI({
actionButton("logout", "Logout")
})
output$container2 <- renderUI({
actionButton("clickme", "Click Me")
})
observeEvent(input$clickme, {
print("got clicked!")
})
observeEvent(input$logout, ignoreInit = TRUE, {
user$logged_on <- 0
})
} else {
output$app <- renderUI({
actionButton("login", "Login")
})
observeEvent(input$login, ignoreInit = TRUE, {
user$logged_on <- 1
})
}
})
}
shinyApp(ui, server)
Clicking Login followed by Click Me prompts got clicked! once. However, after repeating the process by Logout>Login>Click Me prompts the message twice, and so on.
Examining this problem using...
x <- reactiveValuesToList(input)
print(x)
...confirms that duplicates of the input elements are created. Why does this happen and how do i prevent it?
I think it's because you have observeEvents within your observe. This isn't necessary and I've edited your code and now the duplicates seem to have been removed. (Also the ignoreInits were unnecessary here.)
library(shiny)
user <- reactiveValues(logged_on = 0)
ui <- fluidPage(
uiOutput("app")
)
server <- function(input, output) {
observe({
if (user$logged_on == 1) {
output$app <- renderUI({
list(
uiOutput("container1"),
uiOutput("container2")
)
})
output$container1 <- renderUI({
actionButton("logout", "Logout")
})
output$container2 <- renderUI({
actionButton("clickme", "Click Me")
})
} else {
output$app <- renderUI({
actionButton("login", "Login")
})
}
})
observeEvent(input$clickme, {
print("got clicked!")
})
observeEvent(input$logout, {
user$logged_on <- 0
})
observeEvent(input$login, {
user$logged_on <- 1
})
}
shinyApp(ui, server)
So I've found that nesting observeEvent() within each other, registers new observers and that caused the problem. A better example than my previous one is:
library(shiny)
ui <- fluidPage(
actionButton("clicks", "Click"),
actionButton("more_clicks", "Print")
)
server <- function(input, output) {
observeEvent(input$clicks,{
observeEvent(input$more_clicks, {
print("Hello") # you can see these piling up in the console when switching buttons
})
})
}
shinyApp(ui, server)
My guess is that this should be avoided when possible, although observeEvent()'s can be nested if the child observer is destroyed after it has gotten triggered. This can be accomplished by the argument observeEvent(eventExpr, handlerExpr, once = TRUE).
I have 4 action buttons...but want same return value name. Since it is used in other elements. I initialize the reactive element as
myReactiveDF <- reactiveValues(data=NULL)
myReactiveDF <- eventReactive(input$action1, {
call functions
return(dataframe)
})
myReactiveDF <- eventReactive(input$action2, {
call functions
return(dataframe)
})
.....
However only the last button 4 works. The first three do not.
All the other elements use the same reactive element (dataframe) to get populated.
I tried observeEvent but it doesn't return values.
The following code should address your requirement as I understand them:
library(shiny)
ui <- fluidPage(
fluidRow(column(2, selectInput('action1', label = "Action1:", choices = c('a','b') )),
column(4, selectInput('action2', label = "Action2:", choices = c('A','B') ))),
fluidRow( verbatimTextOutput("outputs"))
)
server = function(input, output, session){
v <- reactiveValues(data = NULL)
observeEvent(input$action1, {
v$data <- input$action1
})
observeEvent(input$action2, {
v$data <- input$action2
})
output$outputs <- renderText({
if (is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
If what you need is different, please let me know so that I can amend the answer.
Is it possible to capture the label of an actionButton once it is clicked?
Imagine I have 3 buttons on my ui.R and depending on which one I click I want to perform a different action on the server.R.
One caveat is that the buttons are created dynamically on the server.R with dynamic labels (thus the necessity of capturing the label on click)
Thanks
Something like that ?
library(shiny)
server <- function(input, session, output) {
output$printLabel <- renderPrint({input$btnLabel})
}
ui <- fluidPage(
actionButton("btn1", "Label1",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
actionButton("btn2", "Label2",
onclick = "Shiny.setInputValue('btnLabel', this.innerText);"),
verbatimTextOutput("printLabel")
)
shinyApp(ui = ui, server = server)
1) What button was clicked last by the user?
To answer this you can user observeEvent function and by setting up a a variable using reactiveValues function. Make sure you update your libraries and work in the latest version of R (version 3.1.3) as shiny is dependant on this version. Working on windows you can follow example on how to update here
rm(list = ls())
library(shiny)
ui =fluidPage(
sidebarPanel(
textInput("sample1", "Name1", value = "A"),
textInput("sample2", "Name2", value = "B"),
textInput("sample3", "Name3", value = "C"),
div(style="display:inline-block",uiOutput("my_button1")),
div(style="display:inline-block",uiOutput("my_button2")),
div(style="display:inline-block",uiOutput("my_button3"))),
mainPanel(textOutput("text1"))
)
server = function(input, output, session){
output$my_button1 <- renderUI({actionButton("action1", label = input$sample1)})
output$my_button2 <- renderUI({actionButton("action2", label = input$sample2)})
output$my_button3 <- renderUI({actionButton("action3", label = input$sample3)})
my_clicks <- reactiveValues(data = NULL)
observeEvent(input$action1, {
my_clicks$data <- input$sample1
})
observeEvent(input$action2, {
my_clicks$data <- input$sample2
})
observeEvent(input$action3, {
my_clicks$data <- input$sample3
})
output$text1 <- renderText({
if (is.null(my_clicks$data)) return()
my_clicks$data
})
}
runApp(list(ui = ui, server = server))
2) Save the clicks for further manipulation is below
Here's small example based on the work of jdharrison from Shiny UI: Save the Changes in the Inputs and the shinyStorage package.
rm(list = ls())
#devtools::install_github("johndharrison/shinyStorage")
library(shinyStorage)
library(shiny)
my_clicks <- NULL
ui =fluidPage(
#
addSS(),
sidebarPanel(
textInput("sample_text", "test", value = "0"),
uiOutput("my_button")),
mainPanel(uiOutput("text1"))
)
server = function(input, output, session){
ss <- shinyStore(session = session)
output$my_button <- renderUI({
actionButton("action", label = input$sample_text)
})
observe({
if(!is.null(input$sample_text)){
if(input$sample_text != ""){
ss$set("myVar", input$sample_text)
}
}
})
output$text1 <- renderUI({
input$action
myVar <- ss$get("myVar")
if(is.null(myVar)){
textInput("text1", "You button Name")
}else{
textInput("text1", "You button Name", myVar)
}
})
}
runApp(list(ui = ui, server = server))