I have a side bar as follows
sidebarPanel(
wellPanel(
list(tags$head(tags$style("body {background-color: #E0F2F7; }"))),
helpText("Choose a stock ticker to examine, For example
^HSI - Hang Seng,
^N225 - Nikkei 225 and
^FTSE - FTSE 100.
Information will be collected from",tags$a(href="https://uk.finance.yahoo.com/lookup", "yahoo finance"),"."),
textInput("symb", "Symbol", "^FTSE"),
bsAlert(inputId = "alert_anchor"),
dateRangeInput("dates",
"Date range",
start = "2015-01-01",
end = as.character(Sys.Date())),
textOutput("DateRange"),
div(style="display:inline-block",submitButton("Analysis")),
div(style="display:inline-block",downloadButton('downloadData', 'Download Data')),width=6
))
Which gives the following (side bar is on the left)
However I wanted it so that the sidebar follows the page as the user scrolls up and down instead of there being a blank blue space on the left as shown.
Is this possible to do on R Shiny? If so, how can it be done?
You can add a style argument to sidebarPanel, which sets the element position to fixed. Below is the Shiny default minimal example with minor modifications to illustrate the behavior.
library(shiny)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
style = "position:fixed; width:33%;", # Add this line to your code!
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
lapply(1:10, function(i) {
plotOutput(outputId = paste("distPlot", i, sep = "_"))
})
)
)
)
server <- function(input, output) {
lapply(1:10, function(i) {
output[[paste("distPlot", i, sep = "_")]] <- renderPlot({
set.seed(i)
x <- rnorm(n = 1000)
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 = ui, server = server)
Related
I am trying to create a dynamic UI that has variable number of user inputs based on a user input and charts that uses that second level of user input.
A working example below:
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
numericInput(inputId = "Chartcount",
label = "Enter number of charts",
value = 5,
min = 2,
max = 8),
uiOutput("distui")
)
server <- function(input, output) {
c_count = reactive({input$Chartcount})
output$distui <- renderUI({
lapply(seq(1:c_count()), function(x){
chartId = (paste("Chart",x, sep = "="))
sinput <- sliderInput(inputId = paste(x,"_bins"),
"Number of bins:",
min = 1,
max = 50,
value = 30)
selectedbins = input[[paste(x,"_bins")]] # input$inputId does not work here as expression after $ can not be evaluated
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = 25 ) #I want to use selectedbins here for length.out
distplot <- renderPlot(hist(x, breaks = bins, col = 'darkgray', border = 'white'))
list(chartId, sinput,selectedbins, distplot)
})
})
}
shinyApp(ui = ui, server = server)
I think there are at least a couple of problems with this.
Selected number of bins resets as soon as they are selected
I get an error when I try to use selectedbins in the chart for
length.out
bins <- seq(min(x), max(x), length.out = selectedbins ) # This throws an error Error: argument 'length.out' must be of length 1
The selected number of bins is resetting because it is inside of the same reactive expression, you should put it in a different reactive expression, otherwise the full expression is going to be executed every time you change the input and it is going to recreate all the inputs and plots.
The second problem is caused because you are trying to use the selectedbins input value before the slider is created, therefore the value is NULL (length 0), you can only get the value after the slider is created.
Below is your code modified to create the plots in a separated reactive expression as a nested expression, maybe not the best solution but it is in the same style that your program. Also, reusing the x variable is confusing, so I changed the first one by k.
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
numericInput(inputId = "Chartcount",
label = "Enter number of charts",
value = 5,
min = 2,
max = 8),
uiOutput("distui")
)
server <- function(input, output) {
output$distui <- renderUI({
lapply(seq(1:input$Chartcount), function(k){
chartId = (paste("Chart", k, sep = "="))
sinput <- sliderInput(inputId = paste(k, "bins_"),
"Number of bins:",
min = 1,
max = 50,
value = 30)
x <- faithful[, 2]
distplot <- tagList(
renderUI({
selectedbins = input[[paste(k, "bins_")]]
bins <- seq(min(x), max(x), length.out = selectedbins )
tagList(
selectedbins,
renderPlot(hist(x, breaks = bins, col = 'darkgray', border = 'white'))
)
})
)
list(chartId, sinput, distplot)
})
})
}
shinyApp(ui = ui, server = server)
Friends could help me make my conditionalPanel functional. I made a conditionalPanel however I don't know how to adjust it on the server. When I press the option "No" I would like it to show the sliderInput ("Slider2"). The executable code is below. Thank you!
library(shiny)
ui <- shiny::navbarPage(
title = div(tags$img(src="", align="right", height='50px')),
sidebarLayout(
sidebarPanel(
sliderInput("Slider1",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
sidebarLayout(
sidebarPanel(
radioButtons("filter1","", choices = list("Yes" = 1,"No " = 2),selected = 1),
conditionalPanel(
"input.filter1 == 'No'",
sliderInput("Slider2",
"Number of bins:",
min = 1,
max = 20,
value = 30)),
),
mainPanel(
plotOutput("distPlot1")
))))
server <- function(input, output) {
output$distPlot1 <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$Slider1 + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
When you do
radioButtons("filter1", "", choices = list("Yes" = 1,"No " = 2)
the values of the radio buttons are "1" and "2", while "Yes" and "No" are the labels of the radio buttons. So you condition should be "input.filter1 == '2'".
Your condition must be "input.filter1 == 2" and not "input.filter1 == 'No'".
"No" is the name of the element, while 2 is the value (that is evaluated).
It will work with this modification.
Friends, is it possible to change the color tone of a shinytheme used? In my case I am using "united" which uses orange and gray. However I would like to make a slightly darker orange, is it possible to make this change? If so, can you please help me? The executable code is below.
library(shinyBS)
library(shiny)
library(shinyjs)
ui <- fluidPage(
navbarPage(theme = shinytheme("united"), collapsible = TRUE,
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
title= "Select Proprierties",
radioButtons("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 20,
value = 30),
## need to include at least one bs element, adapt
bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
"right", options = list(container = "body"))
),
mainPanel(
plotOutput("distPlot")
)
)
))
## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
"$('#filter1').find('.radio > label').attr('id', function(i) {",
"return 'filter1_row_' + i})")
server <- function(input, output, session) {
## once the UI is loaded, call JS function and attach popover to it
session$onFlushed(function() {
runjs(add_id_js)
addPopover(session, "filter1_row_0", "My Popover", "Content")
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you very much friends!!
I know that it is a quite old question, but since there is no answer and I had the same problem, I wanted to add the solution that I found.
When I was trying to do the same for ShinyDashboard, I found this post. However, taking a look of what the fresh package can do, I found the way to solve your problem using navBarPage.
You just have to add this to your code:
# This is to create your own theme. Depending on your needs, you can remove or keep some options.
mytheme <- create_theme(
theme = "default",
bs_vars_navbar(
default_bg = "#75b8d1",
default_color = "#FFFFFF",
default_link_color = "#FFFFFF",
default_link_active_color = "#75b8d1",
default_link_active_bg = "#FFFFFF",
default_link_hover_color = "firebrick"
),
output_file = NULL
)
navbarPage(
title = "Custom navbar",
header = tagList(
use_theme(mytheme) # <-- use your theme
),
tabPanel("Tab 1"),
tabPanel("Tab 2")
)
Just a note that when I load your code I get this warnings:
Warning messages: 1: In sliderInput(): value should be less than or
equal to max (value = 30, max = 20). 2: Navigation containers
expect a collection of bslib::nav()/shiny::tabPanel()s and/or
bslib::nav_menu()/shiny::navbarMenu()s. Consider using header or
footer if you wish to place content above (or below) every panel's
contents.
So, in order to try the code that I added you, I fixed them.
library(shinyBS)
library(shiny)
library(shinyjs)
library(fresh)
# This is to modify the header background color. It uses fresh package.
mytheme <- create_theme(
adminlte_color(
light_blue = "#9d6708"
)
)
mytheme <- create_theme(
theme = "default",
bs_vars_navbar(
default_bg = "#9d6708",
),
output_file = NULL
)
ui <- fluidPage(
navbarPage(
title = "Old Faithful Geyser Data",
collapsible = TRUE,
header = tagList(
use_theme(mytheme) # <-- use your theme
),
tabPanel(
title = "Tab 1",
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
title= "Select Proprierties",
radioButtons("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 30,
value = 20),
## need to include at least one bs element, adapt
bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
"right", options = list(container = "body"))
),
mainPanel(
plotOutput("distPlot")
)
)
))
)
## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
"$('#filter1').find('.radio > label').attr('id', function(i) {",
"return 'filter1_row_' + i})")
server <- function(input, output, session) {
## once the UI is loaded, call JS function and attach popover to it
session$onFlushed(function() {
runjs(add_id_js)
addPopover(session, "filter1_row_0", "My Popover", "Content")
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
I don't know what type of orange you wanted, but I changed to this tone #9d6708 just to show you the difference.
Here you have more info if you want to check about the fresh package and using NavbarPage.
Friends I have two questions and I would like your help: First, I would like to separate my two filters and the sliderInput on the panel. They are all together. I would like to leave them separated by some horizontal line or by a specific tag that makes this separation. The second is that I am using popify to describe the filters used. In this case, I am used radioButtons. However, I would like to do it separately for the filter options. For example, for filter 1, I would like to insert popify for the "All properties" and "exclude properties" options as well. So, separate three popify for the same filter, is this possible ?? The executable code is below.
library(shinyBS)
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
popify(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
title= "Select Proprierties",
content = paste0("Filter 1 refers to.....")),
popify(
radioButtons("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
title= "Select farms",
content = paste0("Filter 2 refers to.....")),
popify(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 20,
value = 30),
title = "Number of bins",
content = paste0("Number of bins refers to.....")),
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you very much!!
Here is a way. It uses JavaScript to assign an id to each radio button. Then addPopover can be used.
js <- "
$(document).ready(function(){
$('#dist input[type=radio]~span').each(function(i, $el){
$(this).attr('id', 'dist' + i);
});
});
"
library(shiny)
library(shinyBS)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
plotOutput("distPlot"),
popify(span(), title = "") # an empty shinyBS component, in order to use addPopover
)
server <- function(input, output, session) {
output$distPlot <- renderPlot({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
hist(dist(500))
})
addPopover(
session,
id = "dist0",
title = "Normal distribution",
content = "It is also called the Gaussian distribution",
placement = "right"
)
addPopover(
session,
id = "dist1",
title = "Uniform distribution",
content = "All outcomes are equally probable",
placement = "right"
)
addPopover(
session,
id = "dist2",
title = "Log-normal distribution",
content = "The exponential of the normal distribution",
placement = "right"
)
addPopover(
session,
id = "dist3",
title = "Exponential distribution",
content = "It is memoryless",
placement = "right"
)
}
shinyApp(ui, server)
You have to change the JS code according to the inputId of your radio buttons group, and to set the prefix of the generated ids to the one you want:
js <- "
$(document).ready(function(){
$('#YOUR_inputId_GOES_HERE input[type=radio]~span').each(function(i, $el){
$(this).attr('id', 'THE_PREFIX_YOU_WANT' + i);
});
});
"
This generated the ids THE_PREFIX_YOU_WANT0, THE_PREFIX_YOU_WANT1, etc. To be used in addPopover:
addPopover(session, id = "THE_PREFIX_YOU_WANT0", ......)
I have two numericInput boxes, allowing for the input of the min and max (range) of a numeric variable. I have tried using splitLayout, which works but the boxes are misaligned when I include a label for the boxes.
The code is below
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
#fluidRow(
splitLayout(
variable <- faithful$waiting,
numericInput(paste("Min"),
#round = TRUE,
label = h5(c("test")),
min = round(min(variable, na.rm=TRUE)),
max = round(max(variable, na.rm=TRUE))-1,
value = round(min(variable, na.rm=TRUE))
), ## end slider input
numericInput(paste("Min"),
#round = TRUE,
label = h5(""),
min = round(min(variable, na.rm=TRUE))+1,
max = round(max(variable, na.rm=TRUE)),
value = round(max(variable, na.rm=TRUE))
)
)
)
))
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run the code, you will see that the boxes are misaligned.
How can I fix this?
The issue is that you have a label for one box, which pushes it down, with no equivalent label for the other box. To push the second box down, you need to include something that will read as label without showing anything. I used an HTML break:
numericInput(paste("Min"),
#round = TRUE,
label = h5(HTML("<br/>")),
min = round(min(variable, na.rm=TRUE))+1,
max = round(max(variable, na.rm=TRUE)),
value = round(max(variable, na.rm=TRUE))