shiny R app menuitem inside conditional panel deformed - html

I have this shiny app with 4 menuItem. One is named "Login" and tabA, tabB, and tabC are under a conditionalPanel and only appear when a login is successfully done.
Can someone give a hint on why the UI has changed? Because all 4 tabs should look exactly as the first one.
ui.R code:
menuItem('Login', tabName = 'Login', icon = icon('fa fa-address-book')),
conditionalPanel(" 'TRUE' === 'TRUE' ",
menuItem("tabA", tabName = "tabA", icon = icon("fa fa-book")),
menuItem("tabB", tabName = "tabB", icon = icon("fa fa-line-chart")),
menuItem("tabC", icon = icon("fa fa-database")))
Thank you in advance

One option should be to wrap with sidebarMenu
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "Shiny"
),
dashboardSidebar(
sidebarMenu(id="menu",
menuItem('Login', tabName = 'Login', icon = icon('user-o')),
conditionalPanel(" 'TRUE' === 'TRUE' ",
sidebarMenu(menuItem("tabA", tabName = "tabA", icon = icon("quora")),
menuItem("tabB", tabName = "tabB", icon = icon("superpowers")),
menuItem("tabC", tabName = "tabC", icon = icon("podcast"))))
)
),
dashboardBody(
tabItems(
tabItem("Login",h1("login")),
tabItem("tabA",h1("a")),
tabItem("tabB",h1("b")),
tabItem("tabC", h1("c"))
)
)
)
server <- function(input, output) {
observe(print(input$menu))
}
shinyApp(ui,server)
giving output

Related

How to change the default "angle-left icon" on the sidebar menu in R Shiny to an "angle-right icon"?

I would like to change the default arrow direction (as in the attached pic), so it will point to the right.
this is the current code:
sidebarMenu(
menuItem("Market data", tabName = "market data", icon = icon("users"), startExpanded = TRUE,
menuSubItem("Performance", tabName = "history", icon = icon("calendar-day")),
menuSubItem("SMP", tabName = "SMP", icon = icon("dollar-sign"))
),
menuItem("Consumer 1", tabName = "consumer1", icon = icon("user"), startExpanded = FALSE,
menuSubItem("Consumption", tabName = "consumption", icon = icon("history")),
menuSubItem("Profile", tabName = "profile", icon = icon("poll-h")),
menuSubItem("Forecast engine", tabName = "forecast", icon = icon("brain"))
)
Thanks in advance
General
In general, to change the defaults in shinydashboard you need to find the correct CSS tags for these elements and then add your own custom CSS file to overwrite the default.
If you plan on making a lot of these changes, the shinydashboard framework might not be right for you.
Specific solution to your question
With some poking around in the browser, you'll see that the tag for these arrows are .fa-angle-left:before. The symbol showed is defined with the following CSS:
.fa-angle-left:before{content:"\f104"}
To change it to a right arrow we need to change \f104 to \f105:
As noted in the documentation, you can add your own CSS-file as such:
Add the file www/custom.css to the same folder as your Shiny dashboard is located.
Add the following code to it:
.fa-angle-left:before{content:"\f105"}
If you want the arrow to still point down after you click it you also need to add
.sidebar-menu li.active>a>.fa-angle-left, .sidebar-menu li.active>a>.pull-right-container>.fa-angle-left {
transform: rotate(90deg);
}
When this is done, you need to add the following code to your sidebarMenu:
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
)
Working example
app.R
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
dashboardSidebar(
sidebarMenu(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
),
menuItem(
"Market data",
tabName = "market data",
icon = icon("users"),
menuSubItem("SMP", tabName = "SMP", icon = icon("dollar-sign"))
)
)
)
),
dashboardBody()
)
server <- function(input, output) {}
shinyApp(ui, server)
www/custom.css
.fa-angle-left:before{content:"\f105"}
.sidebar-menu li.active>a>.fa-angle-left, .sidebar-menu li.active>a>.pull-right-container>.fa-angle-left {
transform: rotate(90deg);
}

How to isolate conditional panels from other conditional panels?

I'm having trouble with the formats of conditional panels affecting other conditional panels. Below is reproducible code, and at the bottom are images better explaining the issue. In the fuller App this code derives from, the problem is more obvious and makes it look sloppy (in the fuller App, there are multiple screens the user clicks through as the user scrolls to the right along the shaded bar (Well Panel) at the top just underneath the tab label, and the misalignment gets more pronounced as the user scrolls to the right).
The problem is: as the user scrolls right through the Glide Controls / Well Panels to make selections, the Well Panels (at the top with radio buttons) begin to misalign with the table and/or plots that appear beneath. The misalignment gets more pronounced as the user scrolls right. This misalignment isn't as apparent in this reproducible example, but is more pronounced in the fuller App this derives from where there are multiple "screens" or Well Panels at the top for the user to scroll through and where there are data tables and/or plots presented underneath in the main panel.
For sake of simplicity all server code is eliminated in this example (no plots, no tables), as the issue still presents without the server code.
If I comment-out other conditional panels (marked "###" in the reproducible code) the misalignment goes away. So how can I make the conditional panels independent of one another, as a way of eliminating this misalignment? I'm open to any other suggestions for eliminating this misalignment.
The basic structure of the App is the user makes "big choices" along the sidebar panel, and makes more "refined choices" only the top bar underneath the tab label using Glide Controls/Well Panels etc. for a carousel affect.
Reproducible code:
library(shiny)
library(shinyglide)
library(shinyjs)
library(shinyWidgets)
ui <-
fluidPage(
useShinyjs(),
tags$style(".glide-controls { position: absolute; top: 8px; right: 14px; width: 160px; }"),
titlePanel("Hello"),
sidebarLayout(
sidebarPanel(selectInput("selectData", h5(strong("Select data to view:")),choices = list("Stratification","DnL balances"),selected = "Stratification")),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
div(style = "margin-top:10px"),
conditionalPanel(condition = "input.selectData == 'Stratification'",
fluidRow(
column(12,
glide(
custom_controls = div(class = "glide-controls", glideControls()),
screen(
wellPanel(
radioButtons(
inputId = 'groupStrats',
label = NULL,
choiceNames = c('Calendar period','MOB'),
choiceValues = c('Period','MOB'),
selected = 'Period',
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
),
screen(
wellPanel(
radioButtons(
inputId = 'stratsView',
label = NULL,
choices = list("Table view" = 1,"Plot view" = 2),
selected = 1,
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
)
)
)
),
### Deleting next line resolves the well panel issue ###
conditionalPanel(condition = "input.stratsView == 2",fluidRow(column(12, plotOutput("stratPlot"))))
),
### Deleting the following conditional panel also resolves the well panel issue ###
conditionalPanel(condition = "input.selectData == 'DnL balances'",
fluidRow(
column(12,
glide(
custom_controls = div(class = "glide-controls", glideControls()),
screen(
wellPanel(
radioButtons(
inputId = 'groupBal',
label = NULL,
choiceNames = c('Calendar period','MOB'),
choiceValues = c('Period','MOB'),
selected = 'Period',
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
)
)
)
)
), # closes conditional panel
### Deleting the following conditional panel (or either checkbox... or selectize...) also resolves the well panel issue ###
conditionalPanel(condition = "input.selectData == 'Level 1 data'",
panel(
checkboxGroupInput(
inputId = "vars",
label = "Filter by (default view is all data):",
choices = c("Period", "MOB"),
selected = c("Period", "MOB"),
inline = TRUE),
selectizeGroupUI(
id = "my-filters",
params = list(Period = list(inputId = "Period", title = "Period:"),
MOB = list(inputId = "MOB", title = "MOB:"))
), # closes above selectize...
status = "primary"
)
) # closes conditional panel
), id = "tabselected"
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
Actually this is the same issue as here.
The conditionalPanels are visible for a very short time when first invoking the app.
This causes a vertical scrollbar to appear and leads to the misalignment.
Use style = "display: none;" to render the conditionalPanels hidden on startup (where needed) and please leave a thumbs up or other feedback here.
library(shiny)
library(shinyjs)
library(shinyglide)
library(shinyWidgets)
ui <-
fluidPage(
useShinyjs(),
tags$style(".glide-controls { position: absolute; top: 8px; right: 14px; width: 160px; }"),
titlePanel("Hello"),
sidebarLayout(
sidebarPanel(selectInput("selectData", h5(strong("Select data to view:")),choices = list("Stratification","DnL balances"),selected = "Stratification")),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
div(style = "margin-top:10px"),
conditionalPanel(condition = "input.selectData == 'Stratification'",
fluidRow(
column(12,
glide(
custom_controls = div(class = "glide-controls", glideControls()),
screen(
wellPanel(
radioButtons(
inputId = 'groupStrats',
label = NULL,
choiceNames = c('Calendar period','MOB'),
choiceValues = c('Period','MOB'),
selected = 'Period',
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
),
screen(
wellPanel(
radioButtons(
inputId = 'stratsView',
label = NULL,
choices = list("Table view" = 1,"Plot view" = 2),
selected = 1,
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
)
)
)
),
### Deleting next line resolves the well panel issue ###
conditionalPanel(condition = "input.stratsView == 2", style = "display: none;", fluidRow(column(12, plotOutput("stratPlot"))))
),
### Deleting the following conditional panel also resolves the well panel issue ###
conditionalPanel(condition = "input.selectData == 'DnL balances'", style = "display: none;",
fluidRow(
column(12,
glide(
custom_controls = div(class = "glide-controls", glideControls()),
screen(
wellPanel(
radioButtons(
inputId = 'groupBal',
label = NULL,
choiceNames = c('Calendar period','MOB'),
choiceValues = c('Period','MOB'),
selected = 'Period',
inline = TRUE),
style = "padding-top: 12px; padding-bottom: 0px;")
)
)
)
)
), # closes conditional panel
### Deleting the following conditional panel (or either checkbox... or selectize...) also resolves the well panel issue ###
conditionalPanel(condition = "input.selectData == 'Level 1 data'", style = "display: none;",
panel(
checkboxGroupInput(
inputId = "vars",
label = "Filter by (default view is all data):",
choices = c("Period", "MOB"),
selected = c("Period", "MOB"),
inline = TRUE),
selectizeGroupUI(
id = "my-filters",
params = list(Period = list(inputId = "Period", title = "Period:"),
MOB = list(inputId = "MOB", title = "MOB:"))
), # closes above selectize...
status = "primary"
)
) # closes conditional panel
), id = "tabselected"
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)

How to position searchbox to the top of the page in Shiny?

How can I position the search bar to the top of the page here in Rshiny. I would prefer to do a solution using HTML within shiny.
Here is what it currently looks like. I also tried to position it left and that wasn't quite what I was looking for. I was looking to have the table take up the entire main page and have the filter up at the top.
Below is a reproducible example using R:
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Tabsets"),
sidebarLayout(position = "right",
sidebarPanel(
textInput('search', "Search"),
tags$div(class="header", checked=NA,
tags$p("Ready to take the Shiny tutorial? If so"),
tags$a(href="shiny.rstudio.com/tutorial", "Click Here!")
)
),
mainPanel(
tabsetPanel(id = "tabsetPanelID",
type = "tabs",
tabPanel("Tab1", DTOutput('DT1')),
tabPanel("Tab2", DTOutput('DT2')),
tabPanel("Tab3", DTOutput('DT3'))
)
)
)
)
server <- function(input, output, session) {
output$DT1 = renderDT(iris)
DTProxy1 <- dataTableProxy("DT1")
output$DT2 = renderDT(iris)
DTProxy2 <- dataTableProxy("DT2")
output$DT3 = renderDT(iris)
DTProxy3 <- dataTableProxy("DT3")
observeEvent(c(input$search, input$tabsetPanelID), {
updateSearch(DTProxy1, keywords = list(global = input$search, columns = NULL))
updateSearch(DTProxy2, keywords = list(global = input$search, columns = NULL))
updateSearch(DTProxy3, keywords = list(global = input$search, columns = NULL))
})
}
shinyApp(ui, server)

shiny dashboard: jump to specific element in app by clicking infoBox

In my shiny app I want to add an option to let users jump to a specific element in the app (a table, a plot, just anything with an id), on current or different tab, by clicking on infoBox (or any other object I want).
My solution was to surround infoBox with div and add thehref=#id_of_element attribute. Unfortunately this solution works only for tabs with an extra "data-toggle" = "tab" attribute (it also does not change the opened tab to active), but that's not what I want.
My question is: how can I add the mentioned option and why this solution isn't working? Here is a small example what I want to do:
UI
library(shiny)
library(shinydashboard)
shinyUI(
dashboardPage(
skin = "blue",
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(id = "sidebarmenu",
menuItem("Tab1", icon = icon("line-chart"),
menuSubItem("SubTab1", tabName = "sub1", icon = icon("bar-chart")),
menuSubItem("SubTab2", tabName = "sub2", icon = icon("database"))),
menuItem("Tab2", tabName = "tab2", icon = icon("users"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "sub1",
tags$div(href="#s2t2",
infoBox(value = "Go to table 2 in SubTab2 (not working)",title = "Click me")),
tags$div(href="#shiny-tab-tab2", "data-toggle" = "tab",
infoBox(value = "Go to Tab2 (this works)",title = "Click me"))
),
tabItem(tabName = "sub2",
tableOutput("s2t1"),
tableOutput("s2t2")
),
tabItem(tabName = "tab2",
tableOutput("t2t1"),
tableOutput("t2t2")
)
)
)
)
)
SERVER:
shinyServer(function(input, output,session) {
output$s2t1<- renderTable(mtcars)
output$s2t2<- renderTable(mtcars)
output$t2t1<- renderTable(mtcars)
output$t2t2<- renderTable(mtcars)
} )
I found my answer:
$(document).ready(function() {
$("#div1").click(function() {
$(".sidebar-menu a[href=\'#shiny-tab-tab2\']").tab("show");
setTimeout(function(){
var top = $("#t2t2").position().top;
$(window).scrollTop( top );
}, 300);
});
});
where div1 is div around infoBox

Create Dropdown menu in Shiny - R using tags

I know using following code I can create normal dropdown menu in shiny,
selectInput("Input1", "Choose you Input:", choices = c('a1'='1','b2'='2'))
which will create following dropdown
But I am using conditionalPanel and for which I am populating kind of inline dropdownmenus something like this
I am using following code to generate these menus.
conditionalPanel(condition="input.conditionedPanels==3",
div(style="display:inline-block",
tags$label('Menu1', `for` = 'Sample'),
tags$select(id = 'Sample', class="input-small")),
div(style="display:inline-block",
tags$label('Menu2', `for` = 'Sample1'),
tags$select(id = 'Sample1', class="input-small")))
My problem is I am not able to add items to these dropdown menu. I tried values or options, but that did't change anything.
I hope I have provided enough information, let me know if more information is required.
You can supply a list of tags to tagList. The tags you need are option tags with value attributes You can construct these using mapply
library(shiny)
runApp(list(
ui = bootstrapPage(
numericInput('n', 'Enter 3 for condition', 3, 0, 10),
conditionalPanel(condition="input.n==3",
div(style="display:inline-block",
tags$label('Menu1', `for` = 'Sample'),
tags$select(id = 'Sample', class="input-small",
tagList(mapply(tags$option, value = 1:10,
paste0(letters[1:10], 1:10),
SIMPLIFY=FALSE)))
),
div(style="display:inline-block",
tags$label('Menu2', `for` = 'Sample1'),
tags$select(id = 'Sample1', class="input-small",
tagList(mapply(tags$option, value = 1:2,
paste0(letters[1:2], 1:2),
SIMPLIFY=FALSE)))
)
)
, textOutput("cond")
),
server = function(input, output) {
output$cond <- renderText({
if(input$n == 3){
paste0("Sample value selected =", input$Sample, " Sample1 value selected =",input$Sample1)
}
})
}
))
Of course you can just use selectInput inside the div for example:
library(shiny)
runApp(list(
ui = bootstrapPage(
numericInput('n', 'Enter 3 for condition', 3, 0, 10),
conditionalPanel(condition="input.n==3",
div(style="display:inline-block",
selectInput("Sample", "Choose you Input:", choices = c('a1'='1','b2'='2'))
),
div(style="display:inline-block",
tags$label('Menu2', `for` = 'Sample1'),
tags$select(id = 'Sample1', class="input-small",
tagList(mapply(tags$option, value = 1:2,
paste0(letters[1:2], 1:2),
SIMPLIFY=FALSE)))
)
)
, textOutput("cond")
),
server = function(input, output) {
output$cond <- renderText({
if(input$n == 3){
paste0("Sample value selected =", input$Sample, " Sample1 value selected =",input$Sample1)
}
})
}
))