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.
Related
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)
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)
I have created a large number of data tables using mapply, however, I need to access the data tables in a following step. R assigns random IDs to these tables if the user does not specify the IDs. Here is an example of what I would like to do:
library(shiny)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2), elementId = "DT_Test")
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
If I look at the html, the elementID did not change to what I wanted, in fact, R gives the warning:
Warning in origRenderFunc() :
Ignoring explicitly provided widget ID "DT_Test"; Shiny doesn't use them
Even after the call, still not sure what you are trying to do.
But if you have a list of datatables and you want to access them, it works rather well like this:
library(shiny)
library(purrr)
ui <- fluidPage(
h2("Last clicked:"),
verbatimTextOutput("last_clicked"),
h2("elementId values"),
verbatimTextOutput("elementId_values"),
actionButton("reset", "Reset clicked value"),
h2("Datatable:"),
DT::dataTableOutput("dt")
)
server <- function(input, output) {
# the last clicke value
output$last_clicked <- renderPrint({
str(last())
})
table <- DT::datatable(head(mtcars, 2), elementId = "DT_Test")
table2 <- DT::datatable(tail(mtcars, 1), elementId = "DT_Test2")
list_of_data_tables <- list(table, table2)
element_ids <- purrr::map(list_of_data_tables, "elementId")
output$elementId_values <- renderPrint({
element_ids
})
output$dt <- DT::renderDataTable({
list_of_data_tables[[which(element_ids == "DT_Test2")]]
})
observeEvent(input$dt_cell_clicked, {
validate(need(length(input$dt_cell_clicked) > 0, ''))
print("You clicked something!")
})
myProxy = DT::dataTableProxy('dt')
last = reactiveVal(NULL)
observe({
last(input$dt_cell_clicked)
})
observeEvent(input$reset, {
DT::selectRows(myProxy, NULL)
last(NULL)
output$dt <- DT::renderDataTable({
DT::datatable(head(mtcars, 2))
})
})
}
shinyApp(ui, server)
first I know there is a lot of threads covering my problem, I read them all, but I did not manage to do it. I got a list of 10 data.frame which I built through the following code :
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
I want the user to enter n, the number of tables he wants to see. And then display n random tables from the list_of_df. I want to display those tables inside tabs. Here is what I did, I grabbed some ideas here and there, but obviously it does not work and I do not know why.
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = "numput",label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[[index]]
})
size<-reactive({
length(random_tables())
})
for (i in 1:size()) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
}
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', 1: nTabs), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui, server)
So, if you see what I should do ...
Here is a working version:
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = 'numput',label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[index]
})
size<-reactive({
input$numput
})
observe({
lapply(seq_len(size()), function(i) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
})
})
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', seq_len(nTabs)), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui=ui,server=server)
A couple issues, you subset the list with double brackets, but it isn't working like you think it is, you need single brackets. Next when you select a single table random_table() is a data.frame so when you call length you get 2, the number of columns. So just use the input$numput for size() since they are the same anyways. Also, I put the dynamic output in an observe so that it can access the reactive size(). A small thing, but I used seq_len instead of 1:aNumber since it is more robust.
Hope this helps
I have a R Shiny app that contains checkboxGroupInput, and I'm trying to create a "select all" button, using updateCheckboxGroupInput function.
You can see the full code below, but basically I defined the cb groups like this:
checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list)
and then, on a button click, call the function:
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
I have an indication that the function ran, but what it does is actually UNselecting the checkboxes.
BTW, when I put the selected upon defining the cbGroupInput it did worked, but not on the function.
Thanks!
this is my server.R:
library(shiny)
source('usefulFunctions.R')
shinyServer(function(input, output, session) {
output$cascading <- renderUI({
provider_id <- input$provider
if (provider_id == "") return(NULL)
campaigns_list <<- t(getCampaigns(provider_id))
tagList(
checkboxGroupInput("campaigns","Choose campaign(s):",
choices = campaigns_list, selected = campaigns_list),
actionLink("selectall","Select All")
)
})
observe({
if(is.null(input$selectall)) return(NULL)
if (input$selectall > 0)
{
print(campaigns_list)
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
}
})
})
I also added the select and unselect options here by checking if the button or link are divisible by 2
#rm(list = ls())
library(shiny)
campaigns_list <- letters[1:10]
ui =fluidPage(
checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list),
actionLink("selectall","Select All")
)
server = function(input, output, session) {
observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall%%2 == 0)
{
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list)
}
else
{
updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
}
})
}
runApp(list(ui = ui, server = server))
If campaigns_list is a list, might be because you are specifying the list of all your choices instead of the value of the boxes that should be selected in the selected argument of your updateCheckboxGroupInput.
Try replacing selected=campaigns_list by selected=unlist(campaigns_list).
Here is an example with dummy names:
library(shiny)
server<-function(input, output,session) {
observe({
if(input$selectall == 0) return(NULL)
else if (input$selectall > 0)
{
variables<-list("Cylinders" = "cyl","Transmission" = "am","Gears" = "gear")
updateCheckboxGroupInput(session,"variable","Variable:",choices=variables,selected=unlist(variables))
}
})
}
ui <- shinyUI(fluidPage(
checkboxGroupInput("variable", "Variable:",list("Cylinders" = "cyl","Transmission" = "am","Gears" = "gear")),
actionButton("selectall", "Select All")
))
shinyApp(ui = ui, server = server)