Can you use uiOutput in a shiny Dashboard? - r

I am trying to build a shiny Dashboard and I would like to use uiOutput.
In my ui.R file in the dashboardSidebar I have a menuitem that calls uiOutput:
library(shiny)
dashboardSidebar(
sidebarMenu(
menuItem("TCA", tabName = "dashboard", icon = icon("dashboard")),
menuItem(uiOUtput("Symbols")) ....
my server.r file looks like:
output$Symbols<-renderUI({
selectInput('Test', 'Test:', choices = c(1,2,3), selected = 1)
})
When I run the app:
## app.R ##
library(shinydashboard)
library(shiny)
shinyApp(ui, server)
I get an error:
Error in tag("span", list(...)) : could not find function "uiOUtput"
Do you know how to use shinyDashboard with uiOutput?


Once you correct the typo the following works for me. You should be able to use uiOuput.
library(shinydashboard)
runApp(
list(ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem(uiOutput("Symbols"))
)
),
dashboardBody()
)
, server = function(input, output) {
output$Symbols<-renderUI({
selectInput('Test', 'Test:', choices = c(1,2,3), selected = 1)
})
}
)
)

Related

Add an image in tabitem section in shiny app R

I am trying to insert an local image inside a tabitem in shiny app, but some challenges and load it on the page. Could someone help to solve this issue? My code attempt is:
CODE
if (interactive()) {
library(shiny)
library(shinydashboard)
ui <- dashboardPage(skin = "blue",
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem("Dogs", icon = icon("dog"), tabName = "Dogs"),
menuItem("Data", icon = icon("table"), tabName = "Data")
)),
dashboardBody(
mainPanel(
tabItems(
tabItem(tabName = "Dogs", class='active', role="figure",
tags$img(src="dogdogs.png")
)))),
tags$head(
tags$style(HTML(" .main-sidebar {background-color: blue;}"))
)
)
server <- function(input, output) { }
shinyApp(ui, server)
}
Thanks in advance

Shinydashboard, Server.R does not compile "source"-lines

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.

Shiny R checkboxGroupInput selected all

I have a checkboxGroupInput in my Shiny app with the following code :
checkboxGroupInput("sexe", "Sexe:",
c("Masculin" = "mas","Féminin" = "fem"))
My question is how to have them checked when first loaded?
knowing that I've tried selected= c but didn't work

use selected = c("mas","fem")
For example
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody( checkboxGroupInput("sexe","Sexe:",
choices = c("Masculin" = "mas", "Femenin" = "fem"),
selected = c("mas","fem")))
)
server <- function(input, output){
}
shinyApp(ui, server)

Using shiny modules and shinydashboard: shiny.tag error

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)
)
}

Dynamic selectInput in R shiny

I have 3 selectInput boxes and a pool of 4 options which can be selected by these 3 boxes. I want the options displayed by the selectInputs to change dynamically as other selectInputs are selected. However I want the "NONE" option to be available at all points of time for all the three boxes. The code I am using is
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
uiOutput('heirarchy1'),
uiOutput('heirarchy2'),
uiOutput('heirarchy3')
)
)
server <- function(input, output) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy_vector<-c("NONE","A","B","C")
output$heirarchy1<-renderUI({
selectInput("heir1","Heirarchy1",c("NONE",setdiff(heirarchy_vector,c(input$heir2,input$heir3))),selected="NONE")
})
output$heirarchy2<-renderUI({
selectInput("heir2","Heirarchy2",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir3))),selected="NONE")
})
output$heirarchy3<-renderUI({
selectInput("heir3","Heirarchy3",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir2))),selected="NONE")
})
}
shinyApp(ui, server)
Any help on this will be greatly appreciated
EDIT
I tried using updateSelectInput for this purpose. However the code doesn't seem to run
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectInput("heir1","Heirarchy1",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir2","Heirarchy2",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir3","Heirarchy3",c("NONE","A","B","C"),selected="NONE")
)
)
server <- function(input, output) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c("A","B","C")
observe({
hei1<-input$heir1
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectInput(session,"heir1",choices=choice1)
updateSelectInput(session,"heir2",choices=choice2)
updateSelectInput(session,"heir3",choices=choice3)
})
}
shinyApp(ui, server)

You're close! Two things, you need to assign the session variable when you start your server instance, also when you update the select inputs you need to set which choice was selected, other than that everything looks OK. Try this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
selectInput("heir1","Heirarchy1",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir2","Heirarchy2",c("NONE","A","B","C"),selected="NONE"),
selectInput("heir3","Heirarchy3",c("NONE","A","B","C"),selected="NONE")
)
)
server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
heirarchy<-c("A","B","C")
observe({
hei1<-input$heir1
hei2<-input$heir2
hei3<-input$heir3
choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))
updateSelectInput(session,"heir1",choices=choice1,selected=hei1)
updateSelectInput(session,"heir2",choices=choice2,selected=hei2)
updateSelectInput(session,"heir3",choices=choice3,selected=hei3)
})
}
shinyApp(ui, server)

Resources