How to handle the "indentation hell" that Shiny's ui can become? - r

Is it just me?, or somebody else out there is bothered by how the ubiquitous use of ... in Shiny's api to build the ui can very quickly become an "indentation hell"? (paraphrasing Javascript's callback hell)
Consider this example. Let's say you decided to use shinydashboard to build a small app with a couple of columns? It would look something like this:
ui <- dashboardPage(
dashboardHeader(title = "Dashboard Title"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Widgets", tabName = "widgets")
)
),
dashboardBody(
tabItems(
tabItem(
tabName = "dashboard",
fluidRow(
column(
width = 3,
valueBoxOutput("valuebox1", width = NULL),
valueBoxOutput("valuebox2", width = NULL)
),
column(
width = 3,
valueBoxOutput("valuebox1", width = NULL),
valueBoxOutput("valuebox2", width = NULL)
)
)
)
)
)
)
Way too complex and uncomfortable to read (if and when you get the indentation right), isn't it?
Not to mention that you basically ran out of space to write the output function parameters, 'cause you will be dangerously close to the 80 characters margin.
How to make this example shwallower?, or how to handle this better?

You may want to experiment with the backpipe package.
It inverts the magrittr %>% pipe by piping from right to left, like this %<%.
One of its selling points is:
write clearer, more debuggable shinyUI code such that the order of code matches the HTML output.
div() %<% p("This is some text")
There are a few more examples on the Github Page that show more complex indentation applications.

Related

R Shiny - dropdownMenu code in server - styling goes bonkers

For the dropdownMenu in the header, I want to change the icon reactively, so I have to place the code into server. However the styling goes bonkers, is there a way to keep the original styling? I've tried manually copying styles and setting everything important but it still doesn't work.
In this example, there are two dropdownMenu blocks, one in the ui (looks good) and one in the server (looks bad). I want to make the bad one look the same as the good one.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
uiOutput("my_dropdown"),
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks good"
)
),
sidebar = dashboardSidebar(),
body = dashboardBody(),
rightsidebar = rightSidebar()
),
server = function(input, output) {
output$my_dropdown <- renderUI({
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks bad"
)
})
}
)
This is what it looks like
This is what it should look like

Data table will not work in shinydashboard

If shinydashboard was a person I would like to meet him in a dark alley with a baseball bat. I am simply trying show a data frame as a table in my shiny app so I looked online at a bunch websites and questions on stack exchange and this is what I got.
UI
library(shiny)
library(shinydashboard)
library(data.table)#For fread.
library(tidyverse)
library(htmlwidgets)
library(DT)#For the interactive table.
# Header -----------------------------------------------------------------------|
header<-dashboardHeader( title = "Marketing Dashboard"
)
# Sidebar ----------------------------------------------------------------------|
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabname ="overview", icon = icon("dashboard")),
menuItem("Weather", tabname ="weather", icon = icon("bolt"))
)
)
# Body -------------------------------------------------------------------------|
body<-dashboardBody(
tabItems(
tabItem(tabName = 'overview',
DT::dataTableOutput("overviewtable")
),
tabItem(tabName = 'weather',
fluidRow(
)
)
)
)
# UI ---------------------------------------------------------------------------|
ui = dashboardPage(
header,
sidebar,
body
)
shinyApp(ui,server)
Server
server <- function(input,output){
#Table for overview
output$overviewtable<- DT::renderDataTable({
DT::datatable(tib1)
})
}
I have tried using tableOutput and renderTable
I have tried to see if my tib1 was somehow the problem so I tried using the data set mpg. That didnt work. I tried placing DT::dataTableOutput("overviewtable") in a column(), in a fluidRow. I tried reinstalling the packages for DT and refreshing R but that didnt work. I looked at the gallery website from R here. I took that code and ran it and I was able to see their table they made but when I ran my code I cant see my table at all or other tables for that matter. I have a feeling it has something to do with shinydashboard because it seems that when I ran the code from the website above that was just using shiny it worked.
The problem is a typo in the tabName = argument:
sidebar<-dashboardSidebar(
sidebarMenu(
menuItem("Overview", tabName ="overview", icon = icon("dashboard")),
menuItem("Weather", tabName ="weather", icon = icon("bolt"))
)
)

daterangeinput without fluidpage in shiny dashboard

I have an issue while creating a shiny web app using semantic.dashboard library.
Below is the code for my app.
library(semantic.dashboard)
# Define UI
header <- dashboardHeader(
)
sidebar <- dashboardSidebar(
side = "left",
sidebarMenu(
menuItem(tabName = "overview", text = "Overview", icon = icon("home")),
menuItem(tabName = "analysis", text = "Analysis", icon = icon("chart bar"))
)
)
body <- dashboardBody(
dateRangeInput("datepicker", NULL, start = Sys.Date()-30, end = Sys.Date()-1)
)
tabItems(
tabItem(
tabName = "overview",
fluidRow(
)
),
tabItem(
tabName = "analysis",
fluidRow(
)
)
)
ui <- dashboardPage(
header,
sidebar,
body,
title = "My Dashboard",
theme = "lumen"
)
# Define server logic
server <- function(input, output, session) {
session$onSessionEnded(stopApp)
}
# Run the application
shinyApp(ui = ui, server = server)
The result is in the screenshot below:
The main problem is that the dates inside the daterangeinput widget are just like simple text inside textbox.
I can't click on them to change the dates.
Using fluidPage() would resolve the problem, but the whole web page isn't filled totally by the app (and for this app, responsiveness isn't really useful).
Below is the screenshot of the app when I use fluidPage(), you can see that there's so much space between the sidebar and the border, and beetween the sidebar and the body.
app with fluidPage()
I'd like to know if it's possible to use daterangeinput without using fluidPage() or, if not possible, know how to remove the padding between the border and the sidebar when using fluidPage.
Thanks in advance for your help.
Above example doesn't work because it uses bootstrap framework styles - contrary to shiny.semantic or semantic.dashboard packages.
Please check my PR to shiny.semantic package. I've implemented there simple date input with usage of semantic-ui components. You can also use it to create simple date range (added quick example in PR).

Is there any way to send an array or list to sidebarMenu in RShiny

In RShiny is there any way to send an array or list of menuItems to sidebarMenu?
dashboardSidebar(width = 180,
sidebarMenu(
menuItem("server1", tabName = "server1", icon = icon("server")),
menuItem("server2", tabName = "server2", icon = icon("server")),
menuItem("server3", tabName = "server3", icon = icon("server"))
)
)
I actually have to add about 30 or menuItems to add and the names will change over time. This is also an issue with sending multiple fluidRows to a tabItem. Hopefully, the same solution can apply to both.
There is the possibility to use uiOutput, but personally, I am not a fan. However, there is not a single solution for all dynamic element additions, especially when not using uiOutput.
Here is a minimal solution that does what you said you wanted, but I guess this is only the first step for you (since I don't think you really just want to add menuItems). If you are looking for a more customized answer, please edit your original post with your actual problems.
You can add menuItems to the sidebar very easily, if you use JavaScript/jQuery. This is mainly because menuItems are not really "connected" to the Shiny-App but merely toggle buttons. It gets more difficult if you wanted to add complex reactive elements.
There is basically the trick that you give the target element (sidebar) an Id for easy selection and add the HTML that is generated by the shiny ui functions. The customMessageHandler gets both components and tells the browser to create the element.
More on customMessageHandlers can be found here.
Sample code below:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 180,
sidebarMenu(id = "nice",
menuItem("server1", tabName = "server1", icon = icon("server")),
menuItem("server2", tabName = "server2", icon = icon("server")),
menuItem("server3", tabName = "server3", icon = icon("server"))
)
),
dashboardBody(
actionButton("button", "Add MenuItem"),
tags$script("
Shiny.addCustomMessageHandler('addMenuItem', function(message){
$('#' + message[0]).append(message[1]);
})
")
)
)
server <- function(input, output, session){
addMenuItem <- function(item, sidebarId){
session$sendCustomMessage(type = "addMenuItem", message = list(sidebarId, as.character(item)))
}
observeEvent(input$button, {
newId <- as.numeric(input$button) + 3
newMenuItem <- menuItem(paste0("server", newId), tabName = paste0("server", newId), icon = icon("server"))
addMenuItem(newMenuItem, "nice")
})
}
shinyApp(ui, server)

Shinydashboard dashboardSidebar Width Setting

I'm using shiny (0.12.0) with shinydashboard (0.4.0) in R (RRO 8.0.3 CRAN-R 3.1.3) to create a UI, and I'm liking what I'm seeing. However, I would like to be able to control the width of the dashboardSidebar item, since I need to put some wide selector boxes in there.
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar(#stuffhere) #would like a width param setting
dashboardBody()
)
Is there a way to do it (some well-hidden width parameter, or embedded css) or do I have to go back to boring shiny and build it from the ground up instead?
The width of the sidebar is set by CSS on the .left-side class, so you could do:
dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar( tags$style(HTML("
.main-sidebar{
width: 300px;
}
")),selectInput("id","Select a survey",choices=c("Very very very very long text","text"))),
dashboardBody()
)
The old answer might still work, but there is also a width = ... option now. See:
https://rstudio.github.io/shinydashboard/appearance.html#sidebar-width. Here is the example code shown over there:
shinyApp(
ui = dashboardPage(
dashboardHeader(
title = "Title and sidebar 350 pixels wide",
titleWidth = 350
),
dashboardSidebar(
width = 350,
sidebarMenu(
menuItem("Menu Item")
)
),
dashboardBody()
),
server = function(input, output) { }
)

Resources