Here is my app embedded in my site. I want to get rid of the scroll widget below my app, this is due to the width of the tabsetPanel.
I embed the app using this code:
<iframe width="800" height="480" frameborder="0" src="http://spark.rstudio.com/alstated/meanvar/"></iframe>
App Codes:
ui.R
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)
server.R
library(shiny)
# Define server logic required to generate and plot a random distribution
shinyServer(function(input, output) {
data <- reactive(rnorm(
n = input$size,
mean = input$mu,
sd = input$sd
))
output$histogram <- renderPlot({
hist(data(),
probability = TRUE,
xlab = "Data",
ylab = "Density",
main = "Histogram of Random Samples")
if(input$indiv_obs){
rug(data())
}
if(input$density){
dens <- density(data(), adjust = input$bw_adjust)
lines(dens, col = "blue")
}
})
output$datsummary <- renderPrint(summary(data()))
})
Any help is greatly appreciated!
I figure it now, I inspect the html code of the app on Shiny Homepage. And the tabsetPanel is adjusted using the <div> (Document Division) tag in html by setting the option class to either span1, span2, span3 and so on. The higher the suffix of the span the larger the width of the division. And I just add div() tag in my ui.R code:
div(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
), class = "span7")
Another way to adjust width (and height):
add
), style='width: 1000px; height: 1000px' # end of tabsetPanel
after tabsetPanel, no need for div() in this case
The examples above work in certain circumstances. I needed a more general solution. The following solution can be tailored to any situation. For example, your Shiny app could still be responsive.
My solution
First, create a div before the tabsetPanel and give it a class. Second, write a piece of jQuery/javascript to find the parent element of that div. Third, change the class of this parent element using javascript/jQuery. You can change the class into anything you like, for example, col-sm-12, col-sm-11, some other standard Bootstrap class or you can add and create your own class. Fourth, add the custom jQuery/javascript to your Shiny application (make sure that you save the .js-file in the www folder of your Shiny app).
Here is my example:
Javascript/jQuery (general.js):
$(function (){
$("div.delParentClass").parent().removeClass("col-sm-8").addClass("col-sm-12");
/* In addClass you can specify the class of the div that you want. In this example,
I make use of a standard Bootstrap class to change the width of the tabset: col-sm-12.
If you want the tabset to be smaller use: col-sm-11, col-sm-10, ... or add
and create your own class. */
});
Shiny UI
mainPanel(
tags$head(tags$script(src="general.js")),
div(class="delParentClass",
tabsetPanel(
tabPanel("Some panel", .....),
tabPanel("Some panel", .....),
tabPanel("Some panel", .....)
)
)
)
A different way to adjust the width of sidebarPanel and tabsetPanel was based on modifying the width property of the col-sm-4 and col-sm-8 CSS classes, respectively.
Using tag$head and tag$style it is possibile to add CSS directly to the Shiny UI.
See https://shiny.rstudio.com/articles/css.html for details.
This is not an elegant solution, but it works correctly.
Shiny UI
shinyUI(fluidPage(
tags$head(
tags$style(HTML("
.col-sm-4 { width: 25%;}
.col-sm-8 { width: 75%;}
"))
),
headerPanel(title = ""),
sidebarPanel(
sliderInput("size",
"Number of Observations",
min = 10,
max = 200,
value = 95),
sliderInput("mu",
"Mean",
min = -100,
max = 100,
value = 0),
sliderInput("sd",
"Standard Deviation",
min = 1,
max = 6,
value = 3),
checkboxInput(inputId = "indiv_obs",
label = "Show individual observations",
value = FALSE),
checkboxInput(inputId = "density",
label = "Show density estimate",
value = FALSE),
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth Adjustment",
min = 0.2,
max = 2,
value = 1,
step = 0.2))
),
mainPanel(
tabsetPanel(
tabPanel("Plot",
plotOutput(
outputId = "histogram",
height = "400px",
width = "400px")),
tabPanel("Summary",
verbatimTextOutput(outputId = "datsummary"))
))
)
)
Related
How do I make numericInput and selectInput next to each other instead of under each other? It is possible?
Executable code below:
library(shiny)
ui <- fluidPage(
column(4,
wellPanel(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h5("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = ""))),
hr(),
column(8,
tabsetPanel(tabPanel("table1", DTOutput('table1')))))
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
splitLayout can be used to split the space.
wellPanel(
splitLayout(
numericInput("weight1", label = h4("Weight 1"), min = 0, max = 1, value = NA, step = 0.1),
selectInput("maxmin", label = h4("Maximize or Minimize"),choices = list("Maximize " = 1, "Minimize" = 2),
selected = "")))
The above code will produce equally sized inputs, but there is an optional argument, cellWidths, that can be used to specify the widths if another ratio is preferred. For example, adding cellWidths = c("40%", "60%") will make weight1 take 40% of the available space and maxmin the rest 60%.
I'm trying to build Rshiny app, i have 3 tabs, but my problem is in the first one, I have 2 filters for this page "Country" and "Package" and i want to show in the top of main panel both filters but horizontally, i mean, Package should be in the right part of Country filter, How can i modify my current code to show both filters in one line?, Thanks !!
shinyAppui <- tagList(
useShinyjs(),
navbarPage(
title = "Alternative Risk Transfer - Parametric Weather Solutions",
id = "navbar",
tabPanel(title="Map",
value= "_map",
sidebarLayout(
sidebarPanel( width = NULL, height = NULL
# Filter for country
# pickerInput(inputId = "country_", label = strong(" Select Country"),
# choices = unique(Stations_static$Country), "Labels",
# options = list(`live-search` = TRUE)),
#
# # Filter for package
# uiOutput("data_filtered_country")
#
),
mainPanel(
pickerInput(inputId = "country_", label = strong(" Select Country"),
choices = unique(Stations_static$Country), "Labels",
options = list(`live-search` = TRUE), inline = TRUE),
uiOutput("data_filtered_country"),
leafletOutput("map_stations",width="150%",height="550px"),
DT::DTOutput("table_map",width="150%",height="550px")
)),
fluidRow(
style = "border-top: 1px solid; border-color: #A9A9A9; padding-top: 10px;padding-bottom: 10px;",
column(width = 8),
column(width = 2),
column(
width = 2,
style = "padding-left: 0px;",
actionButton(
inputId = "showTabRiskQuantification",
label = "Static data updated as of June 2020",
width = '100%'
)
)
)
), # ends tab panel
As #YBS said in the comment when you want to place objects in the same row you should use the fluidRow(column(),column(),...) structure. This will make your dashboard responsive as well. In this case it would look like this.
fluidRow(
column(
width = 3,
pickerInput(inputId = "country_", label = strong(" Select Country"),
choices = unique(Stations_static$Country), "Labels",
options = list(`live-search` = TRUE), inline = TRUE)
),
column(
width = 3,
uiOutput("data_filtered_country")
)
)
where you can play around with different values for width to get the spacing you want.
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", ......)
The reference guide for shiny shows that the CSS relative size options are available for the plotOutput function. While the absolute measurement sizes have been working, I have not been able to successfully replicate the relative size units for the plot height. Note: The % units as well as "auto" work for the plot width, just not for height.
The following code has been pulled from the shiny gallery, and only the plot height has been modified.
http://shiny.rstudio.com/gallery/faithful.html
server.R
shinyServer(function(input, output) {
output$main_plot <- renderPlot({
hist(faithful$eruptions,
probability = TRUE,
breaks = as.numeric(input$n_breaks),
xlab = "Duration (minutes)",
main = "Geyser eruption duration")
if (input$individual_obs) {
rug(faithful$eruptions)
}
if (input$density) {
dens <- density(faithful$eruptions,
adjust = input$bw_adjust)
lines(dens, col = "blue")
}
})
})
ui.R
shinyUI(bootstrapPage(
selectInput(inputId = "n_breaks",
label = "Number of bins in histogram (approximate):",
choices = c(10, 20, 35, 50),
selected = 20),
checkboxInput(inputId = "individual_obs",
label = strong("Show individual observations"),
value = FALSE),
checkboxInput(inputId = "density",
label = strong("Show density estimate"),
value = FALSE),
plotOutput(outputId = "main_plot", height = "50%"),
# Display this only if the density is shown
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
))
When the absolute units are used for plot height, the browser console will show this for the plot div (the img source has been truncated for readability):
<div id="main_plot" class="shiny-plot-output shiny-bound-output" style="width: 100% ; height: 400px">
<img src="data:image/png..." width="1920" height="400">
</div>
However, when the code above is used, the browser console shows the following for the plot div:
<div id="main_plot" class="shiny-plot-output shiny-bound-output" style="width: 100% ; height: 50%">
</div>
Nothing is populated in the main_plot div when a relative measure is used for the plot height. Is there another option that I am missing?
Versions:
R - 3.1.1 and Shiny - 0.10.1
As an aside, it would be nice to also have the remaining CSS relative measurements also implemented (specifically vh and vw) as per the w3 guide:
http://dev.w3.org/csswg/css-values/#relative-lengths
50% of what? The container you place the plot into needs to have a height to start with. Your container is responsive and adjusts to what you place in it. The following will work for example:
library(shiny)
runApp(list(
ui = bootstrapPage(
selectInput(inputId = "n_breaks",
label = "Number of bins in histogram (approximate):",
choices = c(10, 20, 35, 50),
selected = 20),
checkboxInput(inputId = "individual_obs",
label = strong("Show individual observations"),
value = FALSE),
checkboxInput(inputId = "density",
label = strong("Show density estimate"),
value = FALSE),
div(
plotOutput(outputId = "main_plot", height = "50%")
, style = "height: 300px; background-color: green;"),
# Display this only if the density is shown
conditionalPanel(condition = "input.density == true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth adjustment:",
min = 0.2, max = 2, value = 1, step = 0.2)
)
),
server = function(input, output) {
output$main_plot <- renderPlot({
hist(faithful$eruptions,
probability = TRUE,
breaks = as.numeric(input$n_breaks),
xlab = "Duration (minutes)",
main = "Geyser eruption duration")
if (input$individual_obs) {
rug(faithful$eruptions)
}
if (input$density) {
dens <- density(faithful$eruptions,
adjust = input$bw_adjust)
lines(dens, col = "blue")
}
})
}
))
So in this case we have placed the plot in a div with a defined height and as expected the plot takes up 50%
div(plotOutput(outputId = "main_plot", height = "50%")
, style = "height: 300px; background-color: green;")