An example:
UI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
radioButtons("orderdata", "Sort by :",
c("Name" = "name",
"MRDNo" = "mrdno"
))
),
mainPanel(
uiOutput("deatilscv")
)
)
))
Server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output) {
observeEvent(input$orderdata,
{
output$deatilscv <- renderUI({
if(input$orderdata=="name")
{
mid<-c("1","2")
name<-c("a","b")
datatable1 <- data.frame(mid,name)
fluidPage(shinyjs::useShinyjs(),
actionButton("button1", "CLICK") )
}
else if(input$orderdata=="mrdno")
{
mid<-c("3","4")
name<-c("c","d")
datatable2 <- data.frame(mid,name)
fluidPage(shinyjs::useShinyjs(),
actionButton("button1", "CLICK") )
}
})
})
observeEvent(
input$button1,{
a <- datatable1[1,2] #this shows an error object 'datatable1' not found
print(a)
})
observeEvent(
input$button2,{
a <- datatable2[1,2] #this shows an error object 'datatable2' not found
print(a)
})
})
There are two errors in the program as shown above.How can the datatables be accessed in the observe event?
Not sure what you are trying to accomplish. Maybe you can explain how your app should work. I change your code to show the datasets according to the selected radiobutton. You do not need to put the output inside the observeEvent.
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
radioButtons("orderdata", "Sort by :",
c("Name" = "name",
"MRDNo" = "mrdno" ))
),
mainPanel(
tableOutput("deatilscv")
)
)
))
server <- shinyServer(function(input, output) {
# observeEvent(input$orderdata, {
output$deatilscv <- renderTable({
if(input$orderdata=="name") {
mid <- c("1","2"); name <-c("a","b")
datatable <- data.frame(mid,name)
# fluidPage(shinyjs::useShinyjs(), actionButton("button1", "CLICK") )
} else if(input$orderdata=="mrdno") {
mid<-c("3","4"); name<-c("c","d")
datatable <- data.frame(mid,name)
# fluidPage(shinyjs::useShinyjs(), actionButton("button1", "CLICK") )
}
})
# })
# observeEvent( input$button1,{
#
# a <- datatable1[1,2] #this shows an error object 'datatable1' not found
# print(a)
# })
# observeEvent( input$button2,{
# a <- datatable2[1,2] #this shows an error object 'datatable2' not found
# print(a)
# })
})
shinyApp(ui, server)
I think you need to separate observeEvent function from renderTable function.
Then, save the observeEvent as a class object to be called later in the renderTable (output) function, something like this:
my_table <- observeEvent({
datatable <- data.frame(input$orderdata)
### to call your table later on
print(datatable)
})
#Put the render function outside the observe event
output$deatilscv <- renderTable({
rendered_table <- mytable( )
})
}
Related
I am trying to pass a value assigned in an observeEvent to another observeEvent in shiny. In addition to the codes below, I also attempted to use my_dynamic_table(), but unfortunately I couldn't achieve my goal.
My aim is to have "Something 1" on the screen if my_dynamic_table is not empty.
library(shiny)
library(DT)
my_dynamic_table = data.frame(NA)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
observeEvent (input$call ,{
my_dynamic_table <- mtcars
output$table_out <- DT::renderDataTable(
my_dynamic_table
) # renderDataTable : table_out
})
observeEvent (input$save,{
output$text <- renderText({
if(nrow(my_dynamic_table)>1) {
"Something 1"
}else {
"Something 2"
}
}) #renderText
}) #observeEvent
} #server
) #shinyApp
One option to achieve that would be to use a reactiveVal or reactiveValues:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call", "Call"),
actionButton("save", "Save"),
verbatimTextOutput("text"),
DT::dataTableOutput("table_out")
),
server = function(input, output, session) {
my_dynamic_table <- reactiveVal(data.frame())
observeEvent(input$call, {
my_dynamic_table(mtcars)
output$table_out <- DT::renderDataTable(
my_dynamic_table()
)
})
observeEvent(input$save, {
output$text <- renderText({
if (nrow(my_dynamic_table()) > 0) {
"Something 1"
} else {
"Something 2"
}
}) # renderText
}) # observeEvent
} # server
) # shinyApp
While I do think that using reactiveValues is a good solution to this problem, I'd say its never a good idea to use an output inside an observeEvent(). I would rearrange the code as below. In the observeEvent we observe the action buttons, and when clicked, update the reactiveValues. Those are again intermediates for your output.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
actionButton("call","Call"),
actionButton("save","Save"),
verbatimTextOutput('text'),
DT::dataTableOutput('table_out')
),
server = function(input, output, session) {
my <- reactiveValues(dynamic_table = data.frame(NA),
text = NA)
observeEvent(input$call, {
my$dynamic_table <- mtcars
})
observeEvent(input$save, {
if (nrow(my$dynamic_table) > 1) {
my$text <- "Something 1"
} else {
my$text <-"Something 2"
}
})
output$text <- renderText({
req(input$save)
my$text
})
output$table_out <- DT::renderDataTable({
req(input$call)
my$dynamic_table
})
} #server
) #shinyApp
Tell me in R Shiny, there are two action buttons. I want to update the data according to the button I press. But for some reason it only responds to the second button and not to the first button. What is the solution?
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
output$result <- renderText(data())
}
shinyApp(ui, server)
}
The second line of this piece of code overwrites the first one:
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
You can do:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
result <- reactiveVal()
observeEvent(input$action_1, { result(1) })
observeEvent(input$action_2, { result(2) })
output$result <- renderText(result())
}
shinyApp(ui, server)
}
If you have many buttons you can simply add a class to it and some simple JS to monitor the last click like so:
library(shiny)
monitorJS <- "$(document).on('click', '.monitor', function () {
Shiny.onInputChange('last_click',this.id);
});"
ui <- fluidPage(
tags$head(tags$script(monitorJS)),
sidebarLayout(
sidebarPanel(
uiOutput("buttons")
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output, session) {
output$buttons <- renderUI({
a <- list()
for(i in 1:200){
id <- paste0("action_",i)
name <- paste0("Get ",i)
a[[i]] <- actionButton(id, name, class = "monitor")
}
tagList(a)
})
data <- eventReactive(input$last_click,{
# Your click ligic here
value <- gsub("action_","",input$last_click)
value
})
output$result <- renderText({
data()
})
}
shinyApp(ui, server)
I need some help I want to show my reactive tabPanel in a popup with the shinyBS package.
Everything seems to work well except the creation of popup.
I am inspired by :
1) R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
2)Show dataTableOutput in modal in shiny app
My code :
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE)
),
mainPanel(
uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs = length(input$decision)
# create tabPanel with datatable in it
myTabs = lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
bsModal(
id = "modalExample",
"yb",
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
)
})
shinyApp(ui, server)
Thanks in advance for any help !
bsModal is an UI element, so you need to put it into you UI. Within this modal you want to show the tabPanels (rendered via uiOutput), so all you need to do is to place your bsModal into the UI, and within this bsModal you have your uiOutput. All what is left is to add an actionButton which shows the modal.
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your species",
choices = unique(iris$Species),
selected = unique(iris$Species), multiple = TRUE),
actionButton("show", "Show")
),
mainPanel(
bsModal("modalExample",
"myTitle",
"show",
uiOutput('mytabs')
)
)
)
))
server <- shinyServer(function(input, output, session) {
output$mytabs <- renderUI({
nTabs <- length(input$decision)
# create tabPanel with datatable in it
myTabs <- lapply(seq_len(nTabs), function(i) {
tabPanel(paste0("dataset_", input$decision[i]),
tableOutput(paste0("datatable_",i))
)
})
do.call(tabsetPanel, myTabs)
})
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
})
shinyApp(ui, server)
It's not clear to me what you want to do (maybe #thothal has the right answer). What about this app ?
library(shiny)
library(DT) # need datatables package
library(shinyBS)
ui <- shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
selectInput("decision", label = "Choose your specie",
choices = iris$Species,
selected = "mtcars", multiple = TRUE),
actionButton("trigger_modal", "View modal")
),
mainPanel(
uiOutput("modal")
# uiOutput('mytabs')
)
)
))
server <- shinyServer(function(input, output, session) {
# output$mytabs <- renderUI({
# nTabs = length(input$decision)
# # create tabPanel with datatable in it
# myTabs = lapply(seq_len(nTabs), function(i) {
# tabPanel(paste0("dataset_", input$decision[i]),
# tableOutput(paste0("datatable_",i))
# )
# })
#
# do.call(tabsetPanel, myTabs)
# })
# create datatables in popup ?
observe(
lapply(seq_len(length(input$decision)), function(i) {
output[[paste0("datatable_",i)]] <- renderTable({
as.data.frame(iris[iris$Species == input$decision[i], ])
})
})
)
output$modal <- renderUI({
bsModal(
id = "modalExample",
"yb",
trigger = "trigger_modal",
do.call(tagList, lapply(seq_along(input$decision), function(i){
tableOutput(paste0("datatable_",i))
}))
)
})
})
shinyApp(ui, server)
I'm trying to use lapply to create multiple tabs in a tabsetPanel in Shiny based on this example: http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html. Below is my app.R code. When I run it, it doesn't create 5 tabs, nor does it print the name of each tab. What am I doing wrong?
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
tabsetPanel(id='t',
lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})
)
)
)
server <- function(input, output) {
observe({
print(input$t)
})
lapply(1:5, function(j) {
output[[paste0('a',j)]] <- renderPrint({
input$t
})
})
}
shinyApp(ui, server)
It's a bit tricky, because tabsetPanel does not accept a list of tabset as an argument. You can use do.call to "unlist" arguments:
mainPanel(
do.call(tabsetPanel, c(id='t',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab', i),
textOutput(paste0('a',i))
)
})))
)
stack.app <- function(n = 5){
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(
verbatimTextOutput("show_selected")
),
mainPanel(
uiOutput('my_tabs')
)
)
server <- function(input, output, session) {
output$my_tabs <- renderUI({
### Had to hicjack this from shiny to get it to work...
shiny:::buildTabset(
id = "t",
lapply(1:n, function(i){
tabPanel(title = sprintf("tt_%s",i),
HTML(sprintf("This is tab %s content", i))
)
}), paste0("nav nav-","tabs")) %>% (function(x){
tags$div(class = "tabbable", x[[1]], x[[2]])
})
})
output$show_selected <- renderPrint({
sprintf("SELECTED TAB IS : %s", input$t)
})
}
shinyApp(ui, server)
}
Which results in:
This is the code:
button 1 is an actionbutton ,the observeevent is defined as follows
observeEvent(
input$button1,{
mid<-c("1","2")
name<-c("a","b")
datatable1<-data.frame(mid,name)
output$deatilscv <- renderUI({
div(id="div1",
fluidPage(shinyjs::useShinyjs(),
actionButton("button2", "CLICK") )) )}
observeEvent(
input$button2,{
a<-datatable1(1,1) #this shows an error datatable1 not found
print(a)
})
How to access datatable1 details inside observeevent of actionbutton button2
This is a working example:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
actionButton("button1", "button1")
),
mainPanel(
uiOutput("deatilscv")
)
)
))
server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output) {
datatable1 <- eventReactive(input$button1, {
mid<-c("1","2")
name<-c("a","b")
tmp <- data.frame(mid,name)
})
output$deatilscv <- renderUI({
if(!input$button1) return()
div(id="div1",
fluidPage(shinyjs::useShinyjs(),
actionButton("button2", "CLICK") ))
})
observeEvent(
input$button2,{
a <- datatable1()[1,1] #this shows an error datatable1 not found
print(a)
})
})
note that the print(a) in the observe event prints to the console.
Radio buttons version
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Example"),
sidebarLayout(
sidebarPanel(
radioButtons("rb1", "Select options", choices = c("Choice1", "Choice2"))
),
mainPanel(
uiOutput("deatilscv1"),
uiOutput("deatilscv2")
)
)
))
server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output) {
datatable1 <- eventReactive(input$rb1, {
if (input$rb1 == "Choice1") {
mid<-c("1","2")
name<-c("a","b")
tmp <- data.frame(mid,name)
} else {
mid<-c("3","4")
name<-c("c","d")
tmp <- data.frame(mid,name)
}
tmp
})
output$deatilscv1 <- renderUI({
if(input$rb1 != "Choice1") return()
div(id="div1",
fluidPage(shinyjs::useShinyjs(),
actionButton("button2", "CLICK1"),
renderDataTable(DT::datatable(datatable1()))))
})
output$deatilscv2 <- renderUI({
if(input$rb1 !="Choice2") return()
div(id="div1",
fluidPage(shinyjs::useShinyjs(),
actionButton("button3", "CLICK2"),
renderDataTable(DT::datatable(datatable1()))))
})
observeEvent(
input$button2,{
a <- datatable1()[1,1] #this shows an error datatable1 not found
print(a)
})
observeEvent(
input$button3,{
a <- datatable1()[1,1] #this shows an error datatable1 not found
print(a)
})
})