The app below contains a module that renders a vertical tab panel in the UI. I call this module twice in the app.
The first instance of the module renders correctly:
However, the second instance does not (the content of the tabs is no longer visible):
If you check out the inspector, you can see that for the first instance, the HTML dependencies are appended to the tabset:
However, these dependencies are missing for the second instance:
I'm guessing this is due to the use of singleton() in the source code for verticalTabsetPanel? I don't know how to get around this. I tried adding the dependencies in the \www folder in my app directory and then manually prepending them to the head of my app but that doesn't seem to work either, any insight as to why would be greatly appreciated.
Here is the code:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
modui <- function(id) {
ns <- NS(id)
tagList(
verticalTabsetPanel(
id = ns('tabs'),
verticalTabPanel(ns('item1'), ns('item1 content')),
verticalTabPanel(ns('item2'), ns('item2 content'))
)
)
}
modserver = function(input, output, session) {
}
# HEADER ------------------------------------------------------------------
header <- dashboardHeader()
# SIDEBAR -----------------------------------------------------------------
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = 'tab_1'),
menuItem("Tab 2", tabName = 'tab_2'))
)
# BODY --------------------------------------------------------------------
body <- dashboardBody(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "vertical-tab-panel.css"),
tags$script(src='vertical-tab-panel.js'),
tags$script(src='vertical-tab-panel-bindings.js')
),
tabItems(
tabItem(tabName = 'tab_1', modui('t1')),
tabItem(tabName = 'tab_2', modui('t2')) )
)
# UI ----------------------------------------------------------------------
ui = dashboardPage(header, sidebar, body)
shinyApp(
ui = ui,
server = function(input, output, session) {
callModule(modserver, 't1')
callModule(modserver, 't2')
}
)
Related
I am working on a Shiny-app and since it is a rather large project, I am splitting it up in several files.
I have these app.R, ui.R and server.R:
app.R
library(shiny)
library(shinydashboard)
shinyApp(ui, server)
ui.R
library(shiny)
library(shinydashboard)
library(shinyWidgets)
header <- dashboardHeader(disable = TRUE)
sidebar <- dashboardSidebar(
sidebarMenu(id = "tabs",
sidebarMenuOutput("menu"))
)
MainBox <- fluidRow(
titlePanel("PromView"),
tabItems(
tabItem(tabName = "tab1", QuickPlot()),
tabItem(tabName = "tab2", p("Doorloop Content"))
)
)
body <- dashboardBody(MainBox)
ui <- dashboardPage(title = "PromView", skin = "blue",
header,
sidebar,
body
)
server.R
library(plotly)
source("~/Werk/BigData/Process Mining/R/PM_Globals.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/QuickFacts.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/LoadData.R", local = TRUE)
source("~/Werk/BigData/Process Mining/PromView/PromView/Filters.R", local = TRUE)
server <- function(input, output, session) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Quick facts", tabName = "tab1"),
menuItem("Doorloop", tabName = "tab2")
)
})
isolate({updateTabItems(session, "tabs", "tab1")})
}
When I start the app (in Rstudio), the app complains that it can' t find the QuickPlot()-function. The environment-pane in Rstudio is empty.
When I manually execute the "source"-lines in server.R, the environment-pane shows that all data are loaded and that functions are defined. The app then starts normally.
How can I force shiny to use the " source"-lines?
Ben
You can put the "source"-lines in the ui.R file, shiny loads ui file before server file and therefore, your app will complain that there is no QuickPlot function.
In my current application I am using a navlistPanel similar to the one below and I was wondering whether it would be possible to add a selectInput UI element to the navlist?
I have tried this in my ui.R but it doesn't work:
fluidPage(
titlePanel("Application Title"),
navlistPanel(
"Header",
tabPanel("First"),
tabPanel("Second"),
tabPanel("Third")
# selectInput(inputId, label, choices, selected = NULL) <- I've tried this but it doesn't work
)
)
Any solutions/workarounds are welcome.
I was wondering whether using sidebarLayout + sidebarPanel would work where the sidebarPanel imitates the behaviour of a navlistPanel but wasn't able to implement it.
A clean solution will be difficult, but how about something like this:
library(shiny)
shinyApp(
ui <- fluidPage(
titlePanel("Application Title"),
navlistPanel("Header", id = "navOut",
tabPanel("First", "First"),
tabPanel(selectInput("navSel", "Selection:", c("b", "c")), textOutput("txt"))
)
),
server <- shinyServer(function(input, output){
output$txt <- renderText(input$navSel)
})
)
If you are okay with using shinydashboard, it is fairly simple.
library(shiny)
library(shinydashboard)
rm(list=ls)
######/ UI Side/######
header <- dashboardHeader(title = "Test")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("First Tab",tabName = "FTab", icon = icon("globe")),
menuItem("Second Tab",tabName = "STab", icon = icon("star"))
),
selectInput("navSel", "Selection:", c("b","c"))
)
body <- dashboardBody()
ui <- dashboardPage(header, sidebar, body)
######/ SERVER Side/######
server <- function(input, output, session) {
}
shinyApp(ui, server)
In my shiny app I have lots of valueBoxes, each representing a tabItem in the sidebar of the shinydashboard. When clicking on the valueBox the page should move to the correct tab.
Instead of copypasting the code lots of times I wrote a reusable module which renders the valueBox and changes the class of the valueBox into an actionButton. In the server part I have included an observeEvent which calls updateTabItems when the valueBox is clicked. But when clicked nothing happens. It seems that the module cannot manipulate the dashboard sidebar.
library(shiny)
library(shinydashboard)
value_box_output <- function(.id) {
ns <- NS(.id)
valueBoxOutput(ns("overview.box"))
}
value_box <- function(input, output, session, .value, .subtitle, .tab.name) {
ns <- session$ns
output$overview.box <- renderValueBox({
box1 <- valueBox(
.value,
.subtitle,
href = "#",
width = NULL
)
box1$children[[1]]$attribs$class <- "action-button"
box1$children[[1]]$attribs$id <- ns("button")
box1
})
observeEvent(input$button, {
print("clicked")
updateTabItems(session, inputId = "tabs", selected = .tab.name)
})
}
ui <- dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Overview", tabName = "Overview"),
menuItem("Tab 1", tabName = "Tab_1")
)
),
dashboardBody(
tabItems(
tabItem("Overview", value_box_output("tab")),
tabItem("Tab_1")
)
)
)
server <- function(input, output, session) {
callModule(value_box,
"tab",
.value = 33,
.subtitle = "Tab 1",
.tab.name = "Tab_1")
}
shinyApp(ui, server)
You can find the answer in this post: Accessing parent namespace inside a shiny module
Basically, in updateTabItems() inside a moulde, you need to call the parent's session, not the session of the modul.
Thus, add a variable for your session to callModule() and call it in updateTabItems().
I'm trying to create and use shiny modules inside a shinydashboard app but I keep getting this error:
Error in FUN(X[[i]], ...) : Expected an object with class 'shiny.tag'.
Here is the app as condensed as possible:
ui.r
library(shiny)
library(shinydashboard)
source("modules.r")
ui <- dashboardPage(
dashboardHeader(
title = "Shiny modules and shinydashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("PointA")
)
),
dashboardBody(
tabItems(
fooUI("myid")
)
)
)
server.r
server <- function(input, output) {
callModule(foo, "myid")
}
modules.r
fooUI <- function(id) {
ns <- NS(id)
tagList(
tabItem(
tabName = "PointA",
textOutput(ns("text"))
)
)
}
foo <- function(input, output, session){
output$text <- renderText(
rnorm(1)
)
}
What am I doing wrong? I got other kinds of modules to work in a "normal" shiny app, however, whenever I try to use a module within shinydashboard it fails.
I am using the newest version of R, shiny and shinydashboard. This is not the issue here.
Problem with shinydashboard and tagList
As described here
You need simple use
ui <- dashboardPage(
dashboardHeader(
title = "Shiny modules and shinydashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("PointA",tabName = "PointA")
)
),
dashboardBody(
tags$div( fooUI("myid"), class = "tab-content" )
)
)
Update
You also need tabName in menuItem
menuItem("PointA_",tabName = "PointA")
Explanation
As you can see
tabItems
function (...)
{
lapply(list(...), tagAssert, class = "tab-pane")
div(class = "tab-content", ...)
}
<environment: namespace:shinydashboard>
use list to ... and cant work if you already have list as arg.
So other variant it create new tabItems function like
tabItems1=function (...)
{
lapply(..., tagAssert, class = "tab-pane")
div(class = "tab-content", ...)
}
environment(tabItems1)=environment(tabItems)
And then you can use tabItems1 with tagList
Following #Batanichek's answer which pointed me to the source of the problem (thanks for that) I simply removed the tagList() command in my fooUI definition. This conveniently solves the problem!
Two things:
Seems tabName is necessary in the menuItem function
Move tabItem from the module to ui (tabItem can hold you module)
UI
ui <- dashboardPage(
dashboardHeader(
title = "Shiny modules and shinydashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("PointA", tabName = "PointA")
)
),
dashboardBody(
tabItems(
tabItem("PointA",
fooUI("myid")
)
)
)
)
Module
fooUI <- function(id) {
ns <- NS(id)
tagList(
tabName = "PointA",
textOutput(ns("text"))
)
}
foo <- function(input, output, session){
output$text <- renderText(
rnorm(1)
)
}
I have initial loading of data from the DB in the server.R which takes a few seconds. Until this is done, the page displayed is distorted (wrong data in selection box, and weird placing of the boxes, see below).
I want to display a different page (or at least different content in my first-displayed tab) until the data is completely loaded.
I thought about doing some kind of conditionalPanel using a condition based on a dedicated global variable (initial_loading_done), but wherever I tried placing the conditionalPanel it didn't work.
This is the structure of my UI.R:
shinyUI(
dashboardPage(
dashboardHeader(title = "Title"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1",icon = icon("dashboard")),
menuItem("Tab2", tabName = "Tab2", icon = icon("bar-chart-o"))
)
),
dashboardBody(
includeCSS("custom_css.css"),
tabItems(
tabItem(tabName = "Tab1",
fluidRow(<content>),
mainPanel(
fluidRow(<content>)
)
),
tabItem(tabName = "Tab2",
fluidRow(<content>),
mainPanel(
dataTableOutput('my_data_table')
)
)
)
)
)
)
Here's a very simple example using shinyjs package
The idea is to create the loading "page" and the content "page" under different IDs, have the content page initially hidden, and use show() and hide() after the app is ready
library(shiny)
library(shinyjs)
load_data <- function() {
Sys.sleep(2)
hide("loading_page")
show("main_content")
}
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
)
)
server <- function(input, output, session) {
load_data()
}
shinyApp(ui = ui, server = server)
In server I like to use reactiveValues() to store a setupComplete condition. Then, when the data is loaded my setupComplete is set to TRUE.
In the ui we can then assess this setupComplete condition in a conditionalPanel, and only display the content (in my example the three box() widgets).
Here's a working example
## app.R ##
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton(inputId = "btn_data", label = "Download"),
conditionalPanel(condition = "output.setupComplete",
box( title = "box1" ),
box( title = "box2" ),
box( title = "boc3" )
),
conditionalPanel(condition = "!output.setupComplete",
box( title = "loading"))
)
)
server <- function(input, output) {
rv <- reactiveValues()
rv$setupComplete <- FALSE
## simulate data load
observe({
if(input$btn_data){
df <- data.frame(id = seq(1,200),
val = rnorm(200, 0, 1))
## Simulate the data load
Sys.sleep(5)
## set my condition to TRUE
rv$setupComplete <- TRUE
}
## the conditional panel reads this output
output$setupComplete <- reactive({
return(rv$setupComplete)
})
outputOptions(output, 'setupComplete', suspendWhenHidden=FALSE)
})
}
shinyApp(ui, server)
The code
hidden(
div(
id = "main_content",
"Data loaded, content goes here"
)
doesn't work with tabsetPanel. But if you move the id to the div level it works beautifully. Thanks to shinyjs author Dean Attali for this tip. https://stackoverflow.com/users/4432127/keshete
hidden(
div(id = "mainTabsetPanel",
tabsetPanel(
....