How can I concise the code being generated in first panel? - r

library(shiny)
library(shinydashboard)
ui <- dashboardPage( skin="blue",title = "asdfasf",
dashboardHeader(title = "Fund Analysis Status Tool",titleWidth=255, .list=NULL),
dashboardSidebar( width = 255, sidebarMenu(menuItem("Analysis", icon = icon("th"),menuSubItem("ME-1", tabName = "Analysis-ME-1"),
menuSubItem("Current", tabName = "Analysis-Current")),menuItem("Post-Analysis1",icon = icon("th"),menuSubItem("ME-1", tabName = "Post_Analysis-ME-1"),menuSubItem("Current", tabName = "Post_Analysis-Current")))), # it gives heading in the left panel
dashboardBody(
tabItems(tabItem(tabName = "Analysis-ME-1",fluidRow(box(dataTableOutput('table')),box(title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)))),
tabItem(tabName = "Analysis-Current",h2("To be discussed1")),
# Second tab content
tabItem(tabName = "Post_Analysis-ME-1", h2("To be discussed1")),
tabItem(tabName = "Post_Analysis-Current",h2("To be discussed2")))))
server <- function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)

This is largely a matter of opinion on how you go about this. I've reorganized your code to how I might approach it below.
In the few applications I've built, my choice of strategy has varied by how large the application is. In smaller applications, I'll source in functions or define them in global.R and then use those functions throughout the application. More recently, I've started just writing each application as a stand alone package.
Either way, the general process is to break your application into small steps, write each of those steps into a function with a descriptive name (brevity isn't necessarily a virtue here), and then call the functions to generate your application.
library(shiny)
library(shinydashboard)
#* Put these in your global.R file, perhaps.
dashboard_header <- function(){
dashboardHeader(
title = "Fund Analysis Status Tool",
titleWidth=255,
.list=NULL
)
}
dashboard_sidebar <- function(){
dashboardSidebar(
width = 255,
sidebarMenu(
menuItem("Analysis", icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Analysis-Current"
)
),
menuItem(
"Post-Analysis1",
icon = icon("th"),
menuSubItem(
"ME-1",
tabName = "Post_Analysis-ME-1"
),
menuSubItem(
"Current",
tabName = "Post_Analysis-Current"
)
)
)
)
}
tab_items <- function(){
tabItems(
# First tab content
tabItem(
tabName = "Analysis-ME-1",
fluidRow(
box( dataTableOutput('table') )
),
box(
title = "Controls",
sliderInput(
"slider",
"Number of observations:",
1,
100,
50
)
)
),
tabItem(
tabName = "Analysis-Current",
h2("To be discussed1")
),
# Second tab content
tabItem(
tabName = "Post_Analysis-ME-1",
h2("To be discussed1")
),
tabItem(
tabName = "Post_Analysis-Current",
h2("To be discussed2")
)
)
}
#***************************
#***************************
#* And now the ui and server
ui <-
dashboardPage(
skin="blue",
title = "asdfasf",
dashboard_header(),
dashboard_sidebar(),# it gives heading in the left panel
dashboardBody(
tab_items()
)
)
server <- shinyServer(function(input, output) {
histdata <- rnorm(500)
output$table <- renderDataTable(iris)
output$plot1 <- renderPlot({ data <- histdata[seq_len(input$slider)]
hist(data) })
})
shinyApp(ui, server)

Related

R fails render on Shiny DashBoard after editing tabitems

library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")
),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
The above example, the output renders when the tabs dashboard and widgets are clicked seperately. In the dashboard tab, i have my slider input in the body.
Now when I change my slider to have it at the sidebar:
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable"),
),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
set.seed(122)
histdata <- rnorm(500)
output$myPlot = renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Problem here:
1) The text placeholder cloud, initially only rendered when the tab menuItem2 is clicked, now gets rendered together with the histogram which was supposed to render only when i clicked menuItem1
2) clicking on menuItem2 does not do anything. I would like to have tab2 when clicked, show a scatterplot as seen in this below block of code.
i.e., i would like to "integrate the below 3rd block of code" into the 2nd, the above so when i run the second block of code, when i click tab1, the input for the slider appears and renders the histogram. when i click tab2, the scatterplot will be rendered
library(shiny)
library(tidyverse)
library(leaflet)
library(shinydashboard)
library(RColorBrewer)
library(viridis)
library(shinyWidgets)
ui = dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
id = "sidebarmenu",
menuItem("menuItem1",
tabName = "tab1")
,
menuItem("menuItem2", tabName = "tab2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "tab1",
tableOutput("myTable")),
tabItem(tabName = "tab2",
h2("Placeholder Cloud"),
plotOutput("myPlot"))
)
)
)
server <- function(input, output, session) {
tableData = reactiveVal(data.frame(x = 1:10, y = LETTERS[1:10]))
plotData = reactiveVal()
observeEvent(input$sidebarmenu, {
if(input$sidebarmenu == "tab2"){
#Code for tab 2
req(is.null(plotData()))
print("Tab 2 code is run")
plotData(runif(100))
}
})
output$myTable = renderTable({
tableData()
})
output$myPlot = renderPlot({
plot(plotData())
})
}
shinyApp(ui, server)
Any help is appreciated.I am new to Shiny.
for your 2nd part you said "clicking on menuItem2 does not do anything."... but you don't have any action for menuItem2 see
menuItem("menuItem2", tabName = "tab2")

How to connect Shiny plot click to website

Is there a way to have a new tab open in browser with the link given after clicking on a plot? Below is my code, right now I have a couple of links to click that work in the Widgets section and I have some output once I click the plot in the main Dashboard section.
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "CN Basic dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th")),
menuItem("About", icon = icon("info-circle"), tabName = "about")
)
),
## Body content
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250,click="plot_click")),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
),
verbatimTextOutput("plot_clickinfo")
),
# Second tab content
tabItem(tabName = "widgets",
h2("Link1"),
tags$a(href="www.rstudio.com", "Click here!"),
h2("Link2"),
tags$a(HTML('Visit W3Schools!'))
),
tabItem(tabName = "about",
#includeHTML("www/about.html")
h2("Here is information about stuff that's important")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
output$plot_clickinfo <- renderPrint({
cat("Click:\n")
str(input$plot_click)
})
}
shinyApp(ui, server)
Ultimately I just want to click on the plot and that brings me to a website.
This should do:
observeEvent(input$plot_click,{
browseURL("https://www.google.com")
})

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)

Shiny - Input Argument Not Accessible

I'm trying to take input from a slider in shiny and use it in the server section by calling a function on it to obtain information for graphing. However, the input from the slider is not recognized serverside, and throws an error.
Evaluation error: argument "hour" is missing, with no default.
The inputID matches the argument so I don't understand why it wouldn't be able to access it.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
MR <- get_data(strtoi(input$hour))
output$series <- renderPlot({
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)
In a shiny application calls to input parameters must be in a reactive context.
Then we must move the functional assignment into the renderPlot function.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
output$series <- renderPlot({
MR <- get_data(strtoi(input$hour))
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)

Shiny Dashboard: Render multiple menu items and output dynamic content to each

I need to render various menu sub-items based on some reactive data values. For each sub-item, I also need to associate linked output. I tried to link with tabName, but not sure what went wrong.
Below is an example. The desired output will be one box for each menu item/sub-item.
## This code snippet doesn't do what I need ----
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItemOutput("dynamic_menu"),
menuItem("Menu2", tabName = "menu2")
)
),
dashboardBody(
tabItems(
uiOutput("menu1_content"),
tabItem(tabName = "menu2", box("I am menu2"))
)
),
title = "Example"
),
server = function(input, output) {
output$dynamic_menu <- renderMenu({
submenu_list <- lapply(letters[1:5], function(x) {
menuSubItem(x, tabName = paste0("menu1-", x))
})
menuItem(
text = "Menu1",
startExpanded = TRUE,
do.call(tagList, submenu_list)
)
})
output$menu1_content <- renderUI({
content_list <- lapply(letters[1:5], function(x) {
tabItem(
tabName = paste0("menu1-", x),
box(x)
)
})
do.call(tagList, content_list)
})
}
)
## This code snippet does what I need ----
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem(
"Menu1", startExpanded = TRUE,
menuSubItem("a", tabName = "menu1-a"),
menuSubItem("b", tabName = "menu1-b"),
menuSubItem("c", tabName = "menu1-c"),
menuSubItem("d", tabName = "menu1-d"),
menuSubItem("e", tabName = "menu1-e")
),
menuItem("Menu2", tabName = "menu2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "menu1-a", box("a")),
tabItem(tabName = "menu1-b", box("b")),
tabItem(tabName = "menu1-c", box("c")),
tabItem(tabName = "menu1-d", box("d")),
tabItem(tabName = "menu1-e", box("e")),
tabItem(tabName = "menu2", box("I am menu2"))
),
title = "Example"
)
),
server = function(input, output) {}
)
Answering my own question, but feel free to jump in if you have something more elegant.
I think my initial understanding of shiny dashboard is wrong, causing the app structure to be invalid.
The trick here is to add id to the sidebarMenu, so that page focus could be tracked and parsed later. Then each of the render function will listen on the input and render associated content.
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "sidebar_menu",
menuItemOutput("dynamic_menu"),
menuItem("Menu2", tabName = "menu2")
)
),
dashboardBody(
uiOutput("menu1_content"),
uiOutput("menu2_content")
),
title = "Example"
),
server = function(input, output, session) {
output$dynamic_menu <- renderMenu({
menu_list <- lapply(letters[1:5], function(x) {
menuSubItem(x, tabName = paste0("menu1-", x))
})
menuItem(
text = "Menu1",
startExpanded = TRUE,
do.call(tagList, menu_list)
)
})
output$menu1_content <- renderUI({
sidebar_menu <- tstrsplit(input$sidebar_menu, "-")
if (sidebar_menu[[1]] == "menu1") box(sidebar_menu[[2]])
})
output$menu2_content <- renderUI({
sidebar_menu <- tstrsplit(input$sidebar_menu, "-")
if (sidebar_menu[[1]] == "menu2") box("I am menu2")
})
}
)

Resources