I'm using a conditional panel inside a well panel of my shiny app. Sadly the height of the well panel doesn't adjust to the conditional panel. My code looks like this:
library(shiny)
supp_distr_names <- c("Normal", "Uniform")
ui <- fluidPage(fluidRow(fluidRow(
wellPanel(
selectInput("distribution",
"Select distribution:",
choices = supp_distr_names),
conditionalPanel(
condition = "input.distribution == 'Normal'",
column(width = 6, numericInput("normal_mean", "Mean:", value = 0)),
column(width = 6, numericInput("normal_var", "Variance:", value = 0))
),
conditionalPanel(condition = "input.distribution == 'Uniform'",)
)
)))
server <- function(input, output, session) {
}
shinyApp(ui, server)
Is there a way to make the height of wellPanel adjust?
This seems to be caused by your strange fluidRow(fluidRow(. This works fine like this:
ui <- fluidPage(
wellPanel(
selectInput("distribution",
"Select distribution:",
choices = supp_distr_names),
conditionalPanel(
condition = "input.distribution == 'Normal'",
fluidRow(
column(width = 6, numericInput("normal_mean", "Mean:", value = 0)),
column(width = 6, numericInput("normal_var", "Variance:", value = 0))
)
),
conditionalPanel(condition = "input.distribution == 'Uniform'",)
)
)
You can add style = "padding: 80px;" to the wellPanel
library(shiny)
supp_distr_names <- c("Normal", "Uniform")
ui <- fluidPage(fluidRow(fluidRow(
wellPanel(
selectInput("distribution",
"Select distribution:",
choices = supp_distr_names),
conditionalPanel(
condition = "input.distribution == 'Normal'",
column(width = 6, numericInput("normal_mean", "Mean:", value = 0)),
column(width = 6, numericInput("normal_var", "Variance:", value = 0))
),
conditionalPanel(condition = "input.distribution == 'Uniform'",),
style = "padding: 80px;"
)
)))
server <- function(input, output, session) {
}
shinyApp(ui, server)
Related
I'm working on a shiny app that requires a lot of interaction with plots. Its quite complex, therefore I'll provide minimal examples that try to abstract the problem and reduce the code you have to copy and paste to a minimum.
One problem that I faced regarding computational efficiency when the plot changes has been solved here.
With this solution however I'm running into a different problem. Before incorporating the solution the app looked like this.
library(shiny)
ui <- fluidPage(
wellPanel(
fluidRow(
column(
width = 12,
fluidRow(
sliderInput(inputId = "slider_input", label = "Reactive values (Number of red points):", min = 1, max = 100, value = 10),
plotOutput(outputId = "plotx")
),
fluidRow(
selectInput(
inputId = "color_input",
label = "Choose color:",
choices = c("red", "blue", "green")
),
sliderInput(
inputId = "size_input",
min = 1,
max = 5,
step = 0.25,
value = 1.5,
label = "Choose size:"
)
)
)
)
)
)
slow_server <- function(input, output, session){
base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
output$plotx <- renderPlot({
# slow non reactive layer
plot(x = base_data()$x, y = base_data()$y)
# reactive layer
points(
x = sample(x = -4:4, size = input$slider_input, replace = T),
y = sample(x = -4:4, size = input$slider_input, replace = T),
col = input$color_input,
cex = input$size_input,
pch = 19
)
})
}
shinyApp(ui = ui, server = slow_server)
It differs from the example given in the solved question in so far as that it now features a well panel and some additional inputs below the plot. I had not mentioned this before because I thought it was not important to the problem.
Incorporating the solution the app now looks like this:
library(shiny)
library(ggplot2)
ui <- fluidPage(
wellPanel(
fluidRow(
column(
width = 12,
fluidRow(
sliderInput(inputId = "slider_input", label = "Reactive values (Number of red points):", min = 1, max = 100, value = 10),
div(
class = "large-plot",
plotOutput(outputId = "plot_bg"),
plotOutput(outputId = "plotx")
),
tags$style(
"
.large-plot {
position: relative;
}
#plot_bg {
position: absolute;
}
#plotx {
position: absolute;
}
"
)
),
fluidRow(
selectInput(
inputId = "color_input",
label = "Choose color:",
choices = c("red", "blue", "green")
),
sliderInput(
inputId = "size_input",
min = 1,
max = 5,
step = 0.25,
value = 1.5,
label = "Choose size:"
)
)
)
)
)
)
quick_server <- function(input, output, session){
base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
output$plot_bg <- renderPlot({
ggplot(base_data()) +
geom_point(aes(x,y)) +
scale_x_continuous(breaks = -4:4) +
scale_y_continuous(breaks = -4:4) +
xlim(-5, 5) +
ylim(-5, 5)
})
output$plotx <- renderPlot({
data.frame(
x = sample(x = -4:4, size = input$slider_input, replace = T),
y = sample(x = -4:4, size = input$slider_input, replace = T)
) %>%
ggplot() +
geom_point(mapping = aes(x,y), color = input$color_input, size = input$size_input) +
scale_x_continuous(breaks = -4:4) +
scale_y_continuous(breaks = -4:4) +
theme(
panel.background = element_rect(fill = "transparent"),
plot.background = element_rect(fill = "transparent", color = NA),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.background = element_rect(fill = "transparent"),
legend.box.background = element_rect(fill = "transparent")
)+
xlim(-5, 5) +
ylim(-5, 5)
}, bg="transparent")
}
shinyApp(ui = ui, server = quick_server)
The plot has become way quicker. But now the plot inputs are placed on top of it. I assume it is due to the relative positioning in the new CSS class 'large-plot'. I have been fiddling around with shiny::tags$style() and shiny::verticalLayout() but my knowledge of CSS only allows my to understand CSS code not reakky to change it and I'm not making any progress.
How can I keep the relative positioning of the two overlapping plots (like in example 2) and place the additional inputs in the row below the plot (as in example 1)?
Any help is appreciated. If you need more information about the app please tell me and I'll provide it!
Thanks in advance!!
so just add some height to the large-plot class. I didn't know you wanted to add content below. So the absolute position of plots will make container large-plot have no height.
Fix is very easy. Since the plotOutput is fixed height of 400px, you can just add the same height to the container:
.large-plot {
position: relative;
height: 400px;
}
I am trying to vertically align an input and its label in a horizontal form. I'm not sure if it's possible to vertically align inline divs of different heights though.
The code below gives me the following:
I would like the labels to sit inline with the inputs.
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- fluidPage(
column(width = 8,
tabBox(width = 12,
tabPanel(
'Items',
fluidRow(
style = 'margin:2px',
wellPanel(
tags$form(class = 'form-horizontal',
tags$b('Filter items'),
tags$div(
class = 'form-group',
tags$label(class = "col-sm-3 control-label", `for` = 'type', "By type:"),
column(
width = 9,
pickerInput(
inputId = 'type', label = '',
choices = character(0),
multiple = T
))),
tags$div(
class = 'form-group',
tags$label(class = "col-sm-3 control-label", `for` = 'name', "By name:"),
column(
width = 9,
searchInput(
inputId = 'name', label = '',
placeholder = "Search by name",
btnSearch = icon("search"),
btnReset = icon("remove")
))
)
)
)
)
)
)
) #/column 8
)
server <- function(input, output, session) {}
shinyApp(ui, server)
What I have tried besides column(width = 3, ...):
flex: tags$div(class = 'form-group', style = 'display:flex;
align-items:center;', ...)
position: tags$div(class = 'form-group', style = 'display:table; position:absolute;', tags$label(class = "col-sm-3 control-label", style = 'display;table-cell; vertical-align:middle;', ...), ...).
I'm not well-versed in HTML so it's taking a lot of guesswork. What would be the best way to achieve the desired result? Any help would be greatly appreciated.
maybe just arrange the tab panel with multiple fluid rows and
inside these arrange the things you like with columns.
#
#
library(shinydashboard)
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tabBox(
tabPanel(title = "Items",
wellPanel(
fluidRow(column(width = 12,"Filter Items")),
br(),
fluidRow(
column(width = 3,"By Type: "),
column(width = 9,
pickerInput(inputId = "choices.type",
choices = character(0),
multiple = TRUE))
),
fluidRow(
column(width = 3,"By Name: "),
column(width = 9,
searchInput(inputId = "seach.name",
placeholder = "Search",
btnSearch = icon("search"),
btnReset = icon("remove")))
)
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have an example, where dateRangeInput and actionButton are added dynamically.
I need elements to be positioned side by side and not in the block.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
useShinyjs(), #Set up shinyjs
tabsetPanel(
tabPanel("Settings",
br(),
fluidRow(
column(width = 8,
box(
title = "Set parameters", id = "RO_05_param_box", width = NULL, solidHeader = TRUE, status ="primary", collapsible = TRUE,
fluidRow(
box(radioButtons("RO_05_param_radio", h6("Company"), choices = list("A" = 1,
"B" = 2), selected = 1), br(),
dateRangeInput("date_range_view", h6("Timeline"), start = "2019-06-30", end = "2020-06-30"), br(),
selectInput("RO_05_param_select", h6("Distribute over time"), choices = list("Stepped line" = 2, "Linear funcion" = 1))
),
box(id= "step_box", dateRangeInput("RO05_date1", h6("Start and end date"), start = "2019-06-30", end = "2020-06-30"),
tags$div(id = 'placeholder_dateRangeInput'),
actionButton("add_lag", "Add dates")
)
)
)
)
)
)
)
)
)
server <- function(input, output) {
observeEvent(input$RO_05_param_select, {
if(input$RO_05_param_select == 2){
show(id = "step_box")
} else {
hide(id = "step_box")
}
})
observeEvent(input$add_lag, {
add <- input$add_lag + 1
addID <- paste0("NO", add)
daterangeID <- paste0('RO05_date', add)
removeID <- paste0('remove_lag', add)
insertUI(
selector = '#placeholder_dateRangeInput',
ui = tags$span(id = addID,
tags$span(dateRangeInput(daterangeID, h6("Near lag and far lag"), start = "2019-06-30", end = "2020-06-30")),
tags$span(actionButton(removeID, label= '', icon("minus")))
)
)
observeEvent(input[[removeID]], {
removeUI(selector = paste0('#', addID))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I tried adding this css:
#placeholder_dateRangeInput {
display: inline-block;
}
But all it does it only shrinks dateRangeInput widget.
However, #placeholder_dateRangeInput wraps all added elements, so I think that css should be wrapped around addID.
Here is a way that you can use to make your elements side by side. In css, you tell the element that your want on the left to be
float:left;
and the element that you want on the right to be
float:right;
This should make them side by side.
Here is an example of this being used:
https://www.geeksforgeeks.org/how-to-float-three-div-side-by-side-using-css/
I am trying to align the image I calling from the web to be in the center on my shiny app. I am using the html tag here because the image file is not saved in my computer, but I am calling it from the web. fifa_data[fifa_data$Name==input$player_name,]$Photo in my server.R file looks something like this: "https://cdn.sofifa.org/players/4/19/200104.png"
Here is an snapshot of what it looks like now, and the red square is where I want the image to be displayed:
Here is a snippet of my ui.R
ui2<- dashboardPage(
dashboardHeader(title="BIG Player Hunter"),
dashboardSidebar(
fluidRow(
uiOutput(outputId = "image")),
fluidRow(
uiOutput(outputId = "image2")),
fluidRow(
uiOutput(outputId = "image3")),
# uiOutput(outputId = "image2"),
# uiOutput(outputId = "image3")),
selectizeInput('player_name',"Player Name:",
choices=fifa_data$Name,
selected=NULL,
multiple=TRUE),
sliderInput("player_count",
"Number of players:",
min=1,
max=50,
value=5),
sliderInput("proximity",
"How close:",
min=0.01,
max=0.99,
value=0.05),
sliderInput("valuerange", "Price Range", min = 0, max = max(fifa_data$ValueNumeric_pounds),
value = c(25, 75)),
actionButton("search", "Search"),
sidebarMenu(
menuItem("Shoot 소개", tabName = "shoot_info", icon= icon("heart", lib= "glyphicon")),
menuItem("점수순위 및 분석", tabName = "leaderboard", icon= icon("bar-chart-o")),
menuItem("참가신청서", tabName = "signup", icon=icon("pencil", lib= "glyphicon"),
badgeLabel = "관리자", badgeColor = "red")
),
uiOutput("checkbox")
),
dashboardBody(
tabItem(tabName = "shoot_info",
fluidRow(
dataTableOutput("table1"),
chartJSRadarOutput("radarchart1")
)
)
)
)
Here is a sinner of my server.R
output$image<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$Photo)
})
output$image2<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$Flag)
})
output$image3<- renderUI({
tags$img(src= fifa_data[fifa_data$Name==input$player_name,]$`Club Logo`)
})
Try the below code for your requirement
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
body <- dashboardBody()
sidebar <- dashboardSidebar(uiOutput("images"),
sliderInput("player_count",
"Number of players:",
min = 1,
max = 50,
value = 5),
sliderInput("proximity",
"How close:",
min = 0.01,
max = 0.99,
value = 0.05),
actionButton("search", "Search")
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$images <- renderUI({
tags$div(img(src = "image1.png", width = 70, height = 90), img(src = "image2.png", width = 70, height = 90), img(src = "image3.png", width = 70, height = 90))
})
}
shinyApp(ui, server)
The screenshot of output
I am trying to make the following layout in shiny:
This is what I achieved so far by the help of this answer :
My ui.R:
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
# fluidRow(
# title = "My title",
# column(6,plotOutput('plot1', height="200px"))
# #plotOutput('plot1'),
# #plotOutput('plot2'),
# #plotOutput('plot3')
# ),
fluidRow(
column(6,div(style = "height:200px;background-color: gray;", "Topleft")),
column(6,div(style = "height:400px;background-color: gray;", "right"))),
fluidRow(
column(6,div(style = "height:100px;background-color: gray;", "Bottomleft"))
),
hr(),
fluidRow(
column(7,
h4("Control Panel"),
fileInput('file', 'Select an CSV file to read',
accept=c('text/csv','text/comma-separated- values,text/plain','.csv')),
br(),
sliderInput('sampleSize', 'Sample Size',
min=1, max=100, value=min(1, 100),
step=500, round=0),
br(),
actionButton("readButton", "Read Data!")
)
)
))
My server.R:
function(input, output) {
}
I don't know how to plug int he plotOutput into the boxes?
How can I control the sizes of the box to look like the layout given above?
Don't make things too complicated, just work with rows, columns and the height attribute of plots:
library(shiny)
ui <- shinyUI(fluidPage(fluidRow(
column(
width = 3,
plotOutput('plot1', height = 200),
plotOutput('plot2', height = 200)
),
column(width = 8, plotOutput('plot3', height = 400))
),
hr(),
wellPanel(fluidRow(
column(
width = 11,
align = "center",
h3("Control Panel"),
column(width = 3, fileInput('file','Select an CSV file to read', accept = c('text/csv', 'text/comma-separated-values,text/plain', '.csv'))),
column(width = 3, offset = 1, sliderInput('sampleSize','Sample Size', min = 1, max = 100, value = min(1, 100), step = 500,round = 0)),
column(width = 1, offset = 1, actionButton("readButton", "Read Data!"))
)
))))
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$mpg, mtcars$cyl)
})
output$plot2 <- renderPlot({
plot(mtcars$mpg, mtcars$carb)
})
output$plot3 <- renderPlot({
plot(mtcars$mpg, mtcars$disp)
})
}
shinyApp(ui, server)