R Shiny dashboard loading tabs only once - r

I started building my first shiny app but am now struggling with a strange behaviour. First, when I initially load the app, no tab is selected by default. Second, when clicking on any menu on the sidebar it shows the body only on the first time. When I go from "Overview" to "Pivot-Tabelle" and back, the body is blank. What am I missing? Below is the code I used.
library(shiny)
library(shinydashboard)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
mainPanel(
rpivotTableOutput("pivot")
)
)
),
##----TabItem:Test----
tabItem(tabName = "Test",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)

This seems to work. You need to have sidebarMenu for your menuItems. Also, you need to change tabName to farmer so it matches your menuItem. And I don't think you need mainPanel in there (you can use mainPanel with sidebarPanel as part of a sidebarLayout if you wanted that layout - see layout options). See if this works for you.
library(shiny)
library(shinydashboard)
library(rpivotTable)
df<-data.frame(a=c(1,2,3,4),
b=c("A","B","C","D"))
###################Beginn der App################
ui <- dashboardPage(
# Application title
dashboardHeader(),
##----DashboardSidebar----
dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName = "overview",selected=TRUE),
menuItem("Pivot-Tabelle", tabName = "pivot"),
menuItem("Test", tabName = "farmer")
)
),
##----DashboardBody----
dashboardBody(
tabItems(
##----TabItem: Overview----
tabItem(tabName="overview",
fluidRow(
valueBoxOutput("A"),
valueBoxOutput("B")
)
),
###----TabItem:Pivot----
tabItem(tabName = "pivot",
##Pivot
column(6,offset=4,titlePanel("Daten-Explorer")),
column(12,
#mainPanel(
rpivotTableOutput("pivot")
#)
)
),
##----TabItem:Test----
tabItem(tabName = "farmer",
h2("In Progress"))
)
)
)
server <- function(input, output) {
##----server:overview----
output$A<-renderValueBox({
valueBox(
paste0(25, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
output$B<-renderValueBox({
valueBox(
paste0(55, "%"), "Landwirte in der Datenbank", icon = icon("Person"),
color = "purple"
)
})
##----server:pivot----
output$pivot <- renderRpivotTable({
rpivotTable(data = df)
})
}
# Run the application
shinyApp(ui = ui, server = server)

Related

SelectInput under menuitem is not working

There is a wrong display in shiny dashboard for the below code. The title "Yet to do" is getting displayed as soon as i run the app. I need that when I click on Bivariate Analysis. What is the issue here. This happened when I introduced selectinput under menu item. Earlier it was working well
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis", tabName = "Univariate", icon =
icon("question"),selectInput("Factors",h5("Factors"),choices =
c("","A","B"))),
menuItem("Bivariate Analysis", tabName = "Bivariate", icon =
icon("question")))
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",fluidRow(box(plotOutput("Plot1"),width =
1000,height = 1000),
box(plotOutput("Plot2"),width =
1000,height = 1000))),
tabItem(tabName = "Bivariate",h1("Yet to do")))
))
server <- function(input, output) {
}
shinyApp(ui, server)
It is related having selectInput() as menuItem(). I tried some options like creating menuSubItem etc. but couldn't get it to work. This is probably some bug so you may have to look around for a fix. For now, I'd suggest moving the selectInput inside dashboardBody() -
ui <- dashboardPage(
dashboardHeader(title = "Data Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Univariate Analysis",
tabName = "Univariate", icon = icon("question")
# removing selectInput from here fixes the issue
# ,selectInput("Factors", h5("Factors"), choices = c("","A","B"))
),
# an option is to have selectInput by itself but probably not the layout you want
# selectInput("Factors", h5("Factors"), choices = c("","A","B")),
menuItem("Bivariate Analysis",
tabName = "Bivariate", icon = icon("question")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "Univariate",
fluidRow(
# add selectInput somewhere on Univariate page
selectInput("Factors", h5("Factors"), choices = c("","A","B")),
box(plotOutput("Plot1"), width = "50%", height = "50%"),
box(plotOutput("Plot2"), width = "50%", height = "50%")
)
),
tabItem(tabName = "Bivariate",
h1("Yet to do")
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)

shinydashboard: menuSubItem not rendering at start in case of several menuSubItems

I found that menuSubItem content is not rendering in case of several (more than one) tabItems.
Minimal example demonstrating this behavior is below.
The desired behavior is to show content of the tabItem marked as selected = TRUE on startup. Now, the content shows up only after switching between menuSubItems in the sidebar.
How can I make it work?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("body")
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
output$body <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
}
shinyApp(ui = ui, server = server)
Indeed, putting ui elements directly in UI solves it.
But the approach of putting everything inside ui is limited to situations that do not involve using reactive values. As I understand passing reactive value from server to ui is not possible in general (or limited to special cases). Please correct if I am wrong... Thanks
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
)
)
server <- function(input, output, session) {
output$menu <- renderMenu(
sidebarMenu(
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)
Renaming your output to something other than "body" helps - please see this.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "MINIMAL EXAMPLE"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
uiOutput("myBodyOutput")
)
)
server <- function(input, output, session) {
output$myBodyOutput <- renderUI({
tabItems(
tabItem(tabName = "tab1",
h4("MY TEXT 1")
),
tabItem(tabName = "tab2",
h4("MY TEXT 2")
))
})
output$menu <- renderMenu(
sidebarMenu(id = "sidebarID",
menuItem(text = "TABS", tabName = "TABS", startExpanded = T,
menuSubItem(text = "tab1", tabName="tab1",
icon = icon("cube"), selected = TRUE),
menuSubItem(text = "tab2", tabName="tab2",
icon = icon("cube"), selected = FALSE)
)
)
)
}
shinyApp(ui = ui, server = server)

Periodically switch tab in shinydashboard

In a shinydashboard with several tabs like here
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sample Shiny"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab1"),
menuItem("Tab 2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(
"tab1",
fluidRow(
box(title = "Foo")
)
),
tabItem(
"tab2",
fluidRow(
box(title = "Bar")
)
)
)
)
)
server <- function(input, output) { }
shinyApp(ui = ui, server = server)
is it possible to let the application switch the active tab periodically? I want to have the dashboard on my screen with switching the active tab every x minutes.
I already checked the Shiny docs for a solution but haven't found an appropriate function. But maybe I simply overlooked such a feature. If Shiny does not offer a suitable feature, is it possible to include some custom JavaScript that does the job?
Here's a way to do it, using invalidateLater and updateTabItems:
app.R:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sample Shiny"),
dashboardSidebar(
sidebarMenu(
id = 'tabs',
menuItem("Tab 1", tabName = "tab1"),
menuItem("Tab 2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(
"tab1",
fluidRow(
box(title = "Foo")
)
),
tabItem(
"tab2",
fluidRow(
box(title = "Bar")
)
)
)
)
)
tabnames = c('tab1', 'tab2')
server <- function(input, output, session) {
#keep track of active tab
active <- reactiveValues(tab = 1)
observe({
#Change every 5 secs, you can set this to whatever you want
invalidateLater(5000,session)
#update tab
isolate(active$tab <- active$tab%%length(tabnames) + 1)
updateTabItems(session,'tabs',tabnames[active$tab])
})
}
shinyApp(ui = ui, server = server)

Embed weather iframe into Shiny Dashboard

I am trying to embed the weather forecast from forecast.io in a Shiny dashboard. I originally had trouble with the ampersand but saw a post that provided an example of how to format HTML code with special characters. However, when I run the app I see a simple "Not Found", even though I know that the link works and is being formatted correctly. I'm not sure what I'm missing.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
column(12,
mainPanel(htmlOutput("frame")
)
)
)
)
)
)
)
server <- shinyServer(function(input, output) {
output$frame <- renderUI({
tags$iframe(id = 'app', src = url("https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston"), width = '100%')
})
})
shinyApp(ui,server)
Screen capture of error in Shiny Dashboard
Update with inserted dashboard
I transfered url from server to ui:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard",
tabName = "dashboard",
icon = icon("dashboard")
)
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
fluidRow(
tags$iframe(
seamless = "seamless",
src = "https://forecast.io/embed/#lat=42.3583&lon=-71.0603&name=Downtown Boston",
height = 800, width = 1400
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)

How to add the same inputs into two tabItems in shinydashboard?

I am using shinydashboard to create the interface of my shiny App. However I want one input which appear in the two tabMenu. In the example below, I want to textInput i_test appears in menu menu1 and menu2.
How should I implement it? Thanks for any suggestions.
library(shiny)
library(shinydashboard)
# Side bar boardy
sidebar <- dashboardSidebar(
sidebarMenu(
id = 'menu_tabs'
, menuItem('menu1', tabName = 'menu1')
, menuItem('menu2', tabName = 'menu2')
, menuItem('menu3', tabName = 'menu3')
)
)
# Body board
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'menu1',
textInput('i_test', 'Test')
),
tabItem(
tabName = 'menu2'
)
)
)
# Shiny UI
ui <- dashboardPage(
title = 'test',
dashboardHeader(),
sidebar,
body
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
It seems that shiny always renders two distinct elements, even if you try to build the same element a second time.
Thats why i could only come up with a solution that only makes it look like the two text iputs are the same.
Check the Code:
library(shiny)
library(shinydashboard)
# Side bar boardy
sidebar <- dashboardSidebar(
sidebarMenu(
id = 'menu_tabs'
, menuItem('menu1', tabName = 'menu1')
, menuItem('menu2', tabName = 'menu2')
, menuItem('menu3', tabName = 'menu3')
)
)
# Body board
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'menu1',
textInput('i_test_1', 'Test')
),
tabItem(
tabName = 'menu2',
textInput('i_test_2', 'Test')
),
tabItem(
tabName = 'menu3'
)
)
)
# Shiny UI
ui <- dashboardPage(
title = 'test',
dashboardHeader(),
sidebar,
body
)
server <- function(input, output, session) {
observe({
text1 <- input$i_test_1
updateTextInput(session, 'i_test_2', value = text1)
})
observe({
text2 <- input$i_test_2
updateTextInput(session, 'i_test_1', value = text2)
})
}
shinyApp(ui, server)

Resources