1 ) How can we position a selectInput next to an other one? I tried :
# style.css
.general {
display: inline-block;
margin-left: auto;
margin-right: auto;
height: auto;
width : auto ;
white-space: nowrap ;}
# ui.R
...
tags$div(class = "general", selectInput(...), selectInput(...))
...
but it doesn't work.
2) How can we position the label of a selectInput next to the selectInput itself ? I found this topic Positioning Shiny widgets beside their headers
but this is designed for all the selectInput of the app. I did not managed to use the code provided in tags$style(...) for only one selectInput of my app, not all of them. How can we do that ?
Thanks.
Just try using one fluid row and several columns. Since the total fluid row width = 12 you may put up to 12 columns one after another without any additional css. For example:
fluidRow(
column(6, selectInput("S1", label = "S1")),
column(6, selectInput("S2", label = "S2"))
)
I answer myself for question 1), with a simple example :
# style.css
.divleft {
float : left;
width : 50%;
}
.clearl {
clear: left;
}
# ui.R
library(shiny)
shinyUI(fluidPage(
tagList(
tags$head(
tags$link(rel="stylesheet", type="text/css",href="style.css")
)
),
sidebarLayout(
sidebarPanel(
selectInput("s1", "Select 1", 1:10),
tags$div(
tags$div(class = "divleft", selectInput("s2", label = "Select 2", 1:5, width = validateCssUnit("70%"))),
tags$div(class = "divleft", selectInput("s3", label = "Select 3", 1:5, width = validateCssUnit("70%")))
),
tags$div(class = "clearl",
selectInput("s4", "Select 4", 1:5)
)
, width = 3),
mainPanel(
h3("Example")
)
)
)
)
# server.R
shinyServer(function(input, output, session) { })
Related
Is there a R function to adjust the title " Factors under the dataset " and "Numbers under the dataset". Below is the code I have tried. So I need the title at the middle of the grey coloured bar
library(shiny)
ui <- fluidPage(
tabsetPanel(tabPanel(
"Factor_Univariate_Analysis",sidebarLayout(
sidebarPanel(
column(h6(selectInput("se1","Factors under the dataset",choices =
c("","Add","sub"))),width = 11,height= 20,offset = 0),width = 1000),
mainPanel(h5(plotOutput("Plot1",width = 1000,height = 1500)))
)
),
tabPanel(
"Numeric_Univariate_Analysis",sidebarLayout(
sidebarPanel(
column(h6(selectInput("se2","Numbers under the dataset",choices =
c("","mean","median","standard_deviation","Data Distribution"))),width
= 11,height= 20,offset = 0),width = 1000),
mainPanel(h5(plotOutput("Plot2",width = 1500,height = 500)))
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Here is some code which I think is close to what you want to do, I'll just explain a few things first:
I have five years experience as a web developer, so I enjoy using CSS, and I would recommend using it where ever possible. What I beleive you were trying to do is give the label a background, this can be done with CSS. In this case I have put it in the style and html tags. label {} applies styles to all labels. You might want to agust the background color.
I have removed the side panel layouts.
Hopefully you find this helpful.
library(shiny)
ui <- fluidPage(
tags$style(HTML("
label {
width: 100%;
background: lightgrey;
padding: 5px;
border-radius: 5px;
}
")),
tabsetPanel(
tabPanel(
"Factor_Univariate_Analysis",
div(
column(width = 12,
h6(
selectInput(
"se1",
label = "Factors under the dataset",
choices = c("","Add","sub"),
width = "100%"
)
)
),
div(plotOutput("Plot1",width = 1000,height = 1500))
)
),
tabPanel(
"Numeric_Univariate_Analysis",
column(width = 12,
h6(
selectInput(
"se2",
"Numbers under the dataset",
choices = c("","mean","median","standard_deviation","Data Distribution"),
width = "100%"
)
)
),
div(plotOutput("Plot2",width = 1500,height = 500))
)
)
)
server <- function(input, output, session) {
observe({
print(input$se1)
updateSelectInput(session, input$se1, label = "Factors under the dataset replaced")
})
}
# https://shiny.rstudio.com/reference/shiny/latest/updateSelectInput.html
shinyApp(ui, server)
I have a shiny app (using navbarPage) with many tabs and would like to add a sidebarMenu that can be seen no matter which tab is selected. The input values in the sidebar have an impact on the content of all tabs.
Additionally, it should be possible to hide the sidebarMenu as it is in a shinydashboard.
I see two possible ways:
(A) Using shinydashboard and somehow adding a top navigation bar or
(B) using navbarPage and somehow adding a sidebar menu that can be hidden.
(A) Using shinydashboard, the closest to what I want is this (simplified MWE):
library("shiny")
library("shinydashboard")
cases <- list(A=seq(50,500, length.out=10), B=seq(1000,10000, length.out=10))
ui <- dashboardPage(
dashboardHeader(title = "dash w/ navbarMenu"),
dashboardSidebar(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE), numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1)),
dashboardBody(
tabsetPanel(
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1", plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
))
)
)
)
server <- function(input, output) {
output$plot11 <- renderPlot({
hist(rnorm(cases[[input$case]][input$num]))
})
}
shinyApp(ui, server)
which is ugly because the navigation bar menu are tabsets which are not part of the menu. What I want is:
Based on this post, I guess it's not possible to include "Perspective 1" and "Perspective 2" tabs in the top menu at all, thus using shinydashboard seems not feasible.
(B) Using navbarPage, I tried using navlistPanel() but I didn't succeed to
(1) make it behave like a sidebarMenu, i.e. be overall visible on the left side of the page and
(2) add hide functionality. Here is my try:
library("shiny")
cases <- list(A=seq(50,500, length.out=10),
B=seq(1000,10000, length.out=10))
ui <- navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
)),
navlistPanel(widths = c(2, 2), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)
)
server <- function(input, output) {
output$plot11 <- renderPlot({
hist(rnorm(cases[[input$case]][input$num]))
})
}
shinyApp(ui, server)
Again, what I want is:
I know, there is flexDashboard. It does not solve the problem for three reasons:
(1) I think it is not possible to hide the sidebar menu, as it is a column and not a real sidebar menu,
(2) it is not reactive which I require in my app,
(3) I think dataTables don't work, which I also need.
Besides, I'd prefer to not have to change the code to Rmarkdown syntax.
Preferably, I'd use a navbarPage and add a sidebarMenu, because my app is already built using navbarPage.
You could use sidebarLayout and do something like this:
ui <- fluidPage(sidebarLayout(
sidebarPanel(navlistPanel(
widths = c(12, 12), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)),
mainPanel(navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
)))
)
))
You get something like this:
Another option would be using fluidRow function. Something like this:
ui <- fluidPage(
fluidRow(
column(3, navlistPanel(
widths = c(12, 12), "SidebarMenu",
tabPanel(selectizeInput('case', 'Pick a case', selected="A", choices = c("A", "B"), multiple = FALSE)),
tabPanel(numericInput('num', 'Number', min = 1, max = 10, value = 1, step = 1))
)),
column(9, navbarPage(title = "nav w/ sidebarMenu",
tabPanel(h4("Perspective 1"),
tabsetPanel(
tabPanel("Subtab 1.1",
plotOutput("plot11")),
tabPanel("Subtab 1.2")
)),
tabPanel(h4("Perspective 2"),
tabsetPanel(
tabPanel("Subtab 2.1"),
tabPanel("Subtab 2.2")
))))
)
)
To get this:
Hope it helps!
This is now possible using bootstraplib
Github Request to implement this:
https://github.com/rstudio/bootstraplib/issues/76
min reprex:
# package load ------------------------------------------------------------
library(shiny)
library(bootstraplib)
# boot dash layout funs ---------------------------------------------------
boot_side_layout <- function(...) {
div(class = "d-flex wrapper", ...)
}
boot_sidebar <- function(...) {
div(
class = "bg-light border-right sidebar-wrapper",
div(class = "list-group list-group-flush", ...)
)
}
boot_main <- function(...) {
div(
class = "page-content-wrapper",
div(class = "container-fluid", ...)
)
}
# title -------------------------------------------------------------------
html_title <-
'<span class="logo">
<div style="display:inline-block;">
<img src="https://jeroen.github.io/images/Rlogo.png" height="35"/>
<b>my company name</b> a subtitle of application or dashboard
</div>
</span>'
# css ---------------------------------------------------------------------
css_def <- "
body {
overflow-x: hidden;
}
.container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
padding-left: 0px;
}
.sidebar-wrapper {
min-height: 100vh;
margin-left: -15rem;
padding-left: 15px;
padding-right: 15px;
-webkit-transition: margin .25s ease-out;
-moz-transition: margin .25s ease-out;
-o-transition: margin .25s ease-out;
transition: margin .25s ease-out;
}
.sidebar-wrapper .list-group {
width: 15rem;
}
.page-content-wrapper {
min-width: 100vw;
padding: 20px;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: 0;
}
.sidebar-wrapper, .page-content-wrapper {
padding-top: 20px;
}
.navbar{
margin-bottom: 0px;
}
#media (max-width: 768px) {
.sidebar-wrapper {
padding-right: 0px;
padding-left: 0px;
}
}
#media (min-width: 768px) {
.sidebar-wrapper {
margin-left: 0;
}
.page-content-wrapper {
min-width: 0;
width: 100%;
}
.wrapper.toggled .sidebar-wrapper {
margin-left: -15rem;
}
}
"
# app ---------------------------------------------------------------------
ui <- tagList(
tags$head(tags$style(HTML(css_def))),
bootstrap(),
navbarPage(
collapsible = TRUE,
title = HTML(html_title),
tabPanel(
"Tab 1",
boot_side_layout(
boot_sidebar(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
boot_main(
fluidRow(column(6, h1("Plot 1")), column(6, h1("Plot 2"))),
fluidRow(
column(6, plotOutput(outputId = "distPlot")),
column(6, plotOutput(outputId = "distPlot2"))
)
)
)
),
tabPanel(
"Tab 2",
boot_side_layout(
boot_sidebar(h1("sidebar input")),
boot_main(h1("main output"))
)
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x,
breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
output$distPlot2 <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x,
breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
}
shinyApp(ui, server)
I've got a shiny application like this:
server.R:
library(shiny)
function(input, output) { NULL }
and ui.R:
library(shiny)
pageWithSidebar(
headerPanel("side-by-side"),
fluidRow(
column(2),
column(4,
wellPanel(
selectInput(inputId = "options", label = "some text",
choices = list(a = 0, b = 1)))
)
),
fluidRow(
h3("bla bla")
)
)
And I would like to have the label of selectInput next to it, not above. Do you know how to do it?
I've found this: Positioning Shiny widgets beside their headers
but it doesn't work for me.
There's multiple ways of doing this, here's one:
library(shiny)
server <- shinyServer(function(input, output) { NULL })
ui <- shinyUI(
pageWithSidebar(
headerPanel("side-by-side"),
sidebarPanel(
fluidRow(
tags$head(
tags$style(type="text/css", "label.control-label, .selectize-control.single{ display: table-cell; text-align: center; vertical-align: middle; } .form-group { display: table-row;}")
),
column(2),
column(4,
selectInput(inputId = "options", label = "some text",
choices = list(a = 0, b = 1))
)
)),
mainPanel(
fluidRow(
h3("bla bla")
))
)
)
shinyApp(ui=ui,server=server)
If you don't want to mess with shinys default CSS you can just leave the label empty and create a label next to it instead of forcing the existing label to the side.
This is a simplification of my Shiny UI. My issue is that the pull-down menu from the SelectizeInput is hidden. It is a bit of a pain having to scroll down. Also, it just does not look very nice. I have tried playing with the z-index to bring it up front but have not had any success.
This is my code:
library(shiny)
runApp(list(
ui = fluidPage(
tabsetPanel(id = "tabs",
tabPanel("Search",
fluidRow(
column(12,
inputPanel(
selectizeInput("s1", h4("Select State:"),
choices = state.name),
tags$head(tags$style(".selectize-control.single { width: 400px; z-index: 1; }")),
dateInput("day", h4("Input Date:"), value = Sys.Date())
)
)
)
)
)),
server = function(input,output,session)
{
})
)
Basically, I want the SelectizeInput menu to display on top like the DateInput calendar.
Thanks for the help!
Carlos
You can use the options from the selectize.js library https://github.com/brianreavis/selectize.js/blob/master/docs/usage.md . dropdownParentmaybe what you are looking for:
library(shiny)
runApp(list(
ui = fluidPage(
tabsetPanel(id = "tabs",
tabPanel("Search",
fluidRow(
column(12,
inputPanel(
selectizeInput("s1", h4("Select State:")
, options = list(dropdownParent = 'body')
, choices = state.name),
tags$head(tags$style(".selectize-control.single { width: 400px; z-index: 1; }")),
dateInput("day", h4("Input Date:"), value = Sys.Date())
)
)
)
)
)),
server = function(input,output,session)
{
})
)
Alternatively you can look at CSS and something like the overflow attribute. See Dropdowns not extending in shiny tabPanel . So in this case use
tags$head(tags$style(".tab-content {overflow: visible;}")),
I know there are a few posts about this issue, but I'm not getting why my code is not working. I have an app in Shiny that I'd like to have contain a conditional sidebar panel, that shows different controls based on which panel in the main panel is currently selected by the user. I thought the code below would work, but the app only displays conditional panel 1 (as defined below). Can anyone give me any advice? Thanks.
my ui.R:
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Spatially Balanced Sampling Tool"),
sidebarPanel(
tags$head(
tags$style(type="text/css", "select { max-width: 175px; }"),
tags$style(type="text/css", "textarea { max-width: 100px; }"),
tags$style(type="text/css", ".jslider { max-width: 120px; }"),
tags$style(type='text/css', ".well { max-width: 200px; }"),
tags$style(type='text/css', ".span4 { max-width: 200px; }")
),
conditionalPanel(condition="input.conditionedPanels == 1",
fileInput('file1', 'Choose .ZIP Shapefile:', multiple=TRUE,
accept=c('binary'))
),
conditionalPanel(condition="input.conditionedPanels == 2",
numericInput("pts", "# of sampling points per stratum:", 50),
numericInput("oversamppts", "# to OVER sample (optional):", 5),
submitButton("Generate Points"),
helpText("WORK DAMMIT")
)),
mainPanel(
tabsetPanel(
tabPanel("Instructions",
includeHTML("instructions.html"),
div(id="linkToMap", tags$a("Click here to see a map of your input data and create points")),
div(id="linkToPoints", tags$a("Click here to see table of created points")),
value=1
),
tabPanel("plot", helpText("Map of input polygons"),
plotOutput("plot"),
p(paste("polygons by strata")),
value=2
),
tabPanel("View Points", helpText("suggested sampling points"),
tableOutput("pointdata"),
HTML("<script>$('#linkToMap').click(function() {
tabs = $('.tabbable .nav.nav-tabs li')
tabs.each(function() {
$(this).removeClass('active')
})
$(tabs[1]).addClass('active')
tabsContents = $('.tabbable .tab-content .tab-pane')
tabsContents.each(function() {
$(this).removeClass('active')
})
$(tabsContents[1]).addClass('active')
$('#plot').trigger('change').trigger('shown')
})</script>
"),
HTML("<script>$('#linkToPoints').click(function() {
tabs = $('.tabbable .nav.nav-tabs li')
tabs.each(function() {
$(this).removeClass('active')
})
$(tabs[2]).addClass('active')
tabsContents = $('.tabbable .tab-content .tab-pane')
tabsContents.each(function() {
$(this).removeClass('active')
})
$(tabsContents[2]).addClass('active')
$('#pointdata').trigger('change').trigger('shown')
})</script>
"),
value=2
),
id = "conditionedPanels"))))
It looks like the conditionalPanel statement is looking for the name of the tabPanel.
# This will not work
condition="input.conditionedPanels == 1" #wrong
When I switched the condition in your conditionalPanel statement to test for the name of the tab, as opposed to the value, it worked.
I scooped out everything extraneous and got your UI.R to work conditionally as intended. You can use this as a starting point and go from here.
UI.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Spatially Balanced Sampling Tool"),
sidebarPanel(
conditionalPanel(condition="input.conditionedPanels == 'Tab1'",
helpText("TAB 1")
),
conditionalPanel(condition="input.conditionedPanels == 'Tab2'",
helpText("TAB 2 SELECTED")
)
),
mainPanel(
tabsetPanel(
tabPanel("Tab1",
p(paste("Tab 1 text")
)
),
tabPanel("Tab2", helpText("Map of input polygons"),
p(paste("polygons by strata")
)
),
id = "conditionedPanels"
)
)
))