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:
Related
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 currently trying to set up a UI that is creating valueBoxes dynamically.
I' picked up the code shown here which does exactly what I want, but using plots.
Actually the following works, but the boxes aren't rendered as expected:
library(shiny)
library(shinydashboard)
ui <- pageWithSidebar(
headerPanel("Dynamic number of valueBoxes"),
sidebarPanel(
selectInput(inputId = "choosevar",
label = "Choose Cut Variable:",
choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
),
mainPanel(
# This is the dynamic UI for the plots
uiOutput("plots")
)
)
server <- function(input, output) {
#dynamically create the right number of htmlOutput
# renderUI
output$plots <- renderUI({
plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
plotname <- paste0("plot", i)
# valueBoxOutput(plotname)
htmlOutput(plotname)
})
tagList(plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderUI({
valueBox(
input$choosevar,
my_i,
icon = icon("credit-card")
)
})
})
}
}
# Run the application
shinyApp(ui = ui, server = server)
Thanks for any hints!
You are mixing shinydashboard elements with normal shiny-uis. You have to create a dashboard-ui, as the valueboxes are for dashboards.
The following should work:
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "Dynamic number of valueBoxes"),
dashboardSidebar(
selectInput(inputId = "choosevar",
label = "Choose Cut Variable:",
choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
),
dashboardBody(
uiOutput("plots")
)
)
server <- function(input, output) {
#dynamically create the right number of htmlOutput
# renderUI
output$plots <- renderUI({
plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
plotname <- paste0("plot", i)
valueBoxOutput(plotname)
# htmlOutput(plotname)
})
tagList(plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
local({
my_i <- i
plotname <- paste0("plot", my_i)
output[[plotname]] <- renderUI({
valueBox(
input$choosevar,
my_i,
icon = icon("credit-card")
)
})
})
}
}
# Run the application
shinyApp(ui = ui, server = server)
I have a shiny app that a user can check whether they want the data table displayed in the main panel. Depending on the numericinput, if they select 1, only 1 datatable be displayed or if they select 2 it will display 2 datatables I am not so sure how to code this in shiny R since I am new to this. Thank you for looking into this.
Here is my code
library("shiny")
df1 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df1<-rbind(df1,setNames(as.list(c(10,20,30,40)), names(df2)))
df2 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df2<-rbind(df2,setNames(as.list(c(100,200,300,400)), names(df2)))
df3 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df3<-rbind(df3,setNames(as.list(c(1000,2000,3000,4000)), names(df2)))
ui <-fluidPage(
sidebarPanel(
checkboxInput("add_data", "Add Data Table(s)"),
conditionalPanel(condition="input.add_data === true",
numericInput("numofdata",
label="Number of Data Table(s):",
min = 1,
max = 3,
value = 1,
step = 1),
uiOutput("num_of_data"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
),
mainPanel(
titlePanel("Output Data Table"),
DT::dataTableOutput("datatable.view", width = "95%")
) # end of main panel
)
server <- function(input, output, session) {
output$num_of_data <- renderUI({
lapply(1:input$numofdata, function(i) {
print(trend_list())
})
})
output$see_ranges <- renderPrint({
print(trend_list())
})
data.filter <- reactive({
df(i)
})
output$datatable.view <- DT::renderDataTable(
{
input$submit
if (input$submit==0) return()
isolate({
for(i in 1:input$numoftrends) {
datatable(data.filter(i),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=FALSE,
autoWidth=TRUE,
rownames=FALSE,
scroller=TRUE,
scrollX=TRUE,
pagelength=1,
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns =
list(leftColumns=2,heightMatch='none')
)
)
}
})
})
}
shinyApp(ui = ui, server = server)
You should look at this article:
http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html
You will seen then that one has to create multiple renderDataTable instead of muliple datatable within one renderDataTable().
Also in your code you call df like a function df() but it is only defined as a variable.
See a generic running example below.
EDIT: Changed dynamic part of UI.
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10, 3)
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
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( )
})
}