Shiny splitLayout and selectInput issue
Here is a potential fix. It appears that the parent div of the dropdown menu has an overflow: auto style, which blocks the dropdown menu. Changing to visible fixes it.
library(shiny)
server <- function(input, session, output) {
output$select_1 <- renderUI({
selectInput("select_input","select", choices = LETTERS)
})
}
ui <- fluidPage(
splitLayout(
uiOutput("select_1"),
tags$head(tags$style(HTML("
.shiny-split-layout > div {
overflow: visible;
}
")))
)
)
shinyApp(ui = ui, server = server)
SelectInput choices are hidden behind downloadButton in Shiny App
I changed the splitLayout approach and used a fluidRow() with two columns instead.
library(shiny)
ui <- navbarPage(
title = 'StackOverFlow App',
tabPanel(
title = "First Panel",
sidebarLayout(
sidebarPanel = sidebarPanel(
tags$h4("Archive Filter", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center"),
radioButtons(
inputId = "archive.choice",
label = "Select Tasks to Display",
choices = c("Completed" = "archive.completed", "Scheduled" = "archive.scheduled")
),
tags$h4("Create Archive Report", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center"),
fluidRow(
column(
width = 6,
selectInput(
inputId = "report.month", label = "Select Month",
choices = as.list(month.name)
)
),
column(
width = 6,
selectInput(
inputId = "report.year", label = "Select Year",
choices = (2020:format(Sys.Date(), "%Y")))
)
),
downloadButton('downloadData', 'Download Report', style='z-index:1;')
),
mainPanel = mainPanel()
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
To get the job down using splitLayout it would be necesary to change the css z-index property of the selectImput.
Shiny: How to prevent selectInput from being reset by selecting a second selectInput
You can set selected in updateSelectInput to input$food_1 and input$food_2 respectively.
updateSelectInput(
session,
inputId = "food_1",
choices = food_table %>% filter(Food_category == input$cat_1) %>% pull(Food),
selected = input$food_1
)
Complete app code -
library(shiny)
library(dplyr)
categories <- sort(unique(food_table$Food_category))
foods <- sort(unique(food_table$Food))
unit <- sort(unique(food_table$Serving_Unit))
# Create Shiny app
# Define UI
ui <- fluidPage(headerPanel(strong("Carbohydrate Calculator")),
fluidRow(
column(
width = 3,
selectInput(
inputId = 'cat_1',
label = 'Food Category',
choices = c("None", categories)
)),
column(
width = 3,
selectInput(
inputId = 'food_1',
label = 'Food Item',
choices = foods
)),
column(
width = 3,
numericInput(
inputId = "actual_serving_1",
label = "How much?",
value = "",
min = 0,
max = 100
))
),
fluidRow(
column(
width = 3,
selectInput(
inputId = 'cat_2',
label = 'Food Category',
choices = c("None", categories)
)),
column(
width = 3,
selectInput(
inputId = 'food_2',
label = 'Food Item',
choices = foods
)),
column(
width = 3,
numericInput(
inputId = "actual_serving_2",
label = "How much?",
value = "",
min = 0,
max = 100
))
),
column(8,
tableOutput("my_table"),
span(textOutput("my_message"), style="color:red")
) # Column close
) # fluidPage close
# Define server logic required to draw a histogram
server <- function(input, output, session) {
food_table_1 <- reactive({
food_table %>%
filter(Food_category == input$cat_1) %>%
filter(Food == input$food_1) %>%
mutate(Actual_amount = input$actual_serving_1)
})
food_table_2 <- reactive({
food_table %>%
filter(Food_category == input$cat_2) %>%
filter(Food == input$food_2) %>%
mutate(Actual_amount = input$actual_serving_2)
})
# Combine selections into a single table
combined_tables <- reactive({
do.call("rbind", list(food_table_1(),
food_table_2()
)
) %>%
mutate(Total_Carbs_grams = Carbs_per_Serving * Actual_amount / Serving_Size) %>%
select(Food_category, Food, Serving_Size, Serving_Unit, Actual_amount, Carbs_per_Serving, Total_Carbs_grams, everything())
})
# Render Output table
output$my_table <- renderTable({
combined_tables()
})
# Create observe function which updates the second selectInput when the first selectInput is changed
observe({
updateSelectInput(
session,
inputId = "food_1",
choices = food_table %>% filter(Food_category == input$cat_1) %>% pull(Food),
selected = input$food_1
)
updateSelectInput(
session,
inputId = "food_2",
choices = food_table %>% filter(Food_category == input$cat_2) %>% pull(Food),
selected = input$food_2
)
}) # Observe close
} # Server close
# Run the application
shinyApp(ui = ui, server = server)
Problems with selectInput in Shiny
This is an example on how to do:
library(shiny)
ui<-fluidPage(
titlePanel(title = "Prueba"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Cargar archivo',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),selectInput('xcol', 'Variable X', columns())),
mainPanel(h3("Muestra del archivo cargado:"),
tableOutput('contents'),
verbatimTextOutput("summary")
)
)
)
server <- function(input, output, session){
columns <- reactive({
df <- read.table(input$file1$datapath)
names(df)
})
observe({
if(!is.null(input$file1))
updateSelectInput(session, "xcol", choices=columns())})
}
shinyApp(ui, server)
splitLayout in shinydashboard::box
If you place the selectInput inside a div and set the width to 100%, that should give you what you're looking for.
footer = splitLayout(
tags$div(
selectInput("y", NULL, paste(strrep("x", 10), 1:10), width="100%")
),
actionButton("ok", icon("trash")),
cellWidths = c("85%", "15%"),
cellArgs = list(style = "vertical-align: top")
),
How to prevent the overlapping of two input labels in splitLayout, Shiny, R?
I assume using fluidRow() with column() is an option for you.
Then you could use:
fluidRow(
column(width = 4,
selectInput(...)
),
column(width = 4,
selectInput(...)
)
)
Note 1:
You can control the width of an input by the width parameter of column().
Note 2:
Sidenote: If you want to use the full width of 12, you also have to set the mainPanel() to 12, see e.g. here:
https://stackoverflow.com/a/44214927/3502164
Full app - reproducible example:
library(shiny)
# Define UI
ui <- fluidPage(
mainPanel(
selectInput(inputId = "A", label = "This is a long lebel with lots of words", choices = letters[1:5], selected = "a"),
selectInput(inputId = "B", label = "This is a long lebel with lots of words", choices = letters[1:5], selected = "a"),
fluidRow(
column(width = 4,
selectInput(inputId = "C", label = "This is a long lebel with lots of words", choices = letters[1:5], selected = "a")
),
column(width = 4,
selectInput(inputId = "D", label = "This is a long lebel with lots of words", choices = letters[1:5], selected = "a")
)
),
# Expand the menu in splitLayout
# From: https://stackoverflow.com/a/40098855/7669809
tags$head(tags$style(HTML("
.shiny-split-layout > div {
display: inline-block;
}
")))
)
)
# Server logic
server <- function(input, output, session){
}
# Complete app with UI and server components
shinyApp(ui, server)
Issue selecting multiple inputs using selectInput
You just need req(), in a couple of places. Try this
server <- function(input, output, session){
observeEvent(input$data1, {
if (input$data1 != "All") {
updateSelectInput(session, "data2", "Select County", choices = c("All", unique(df$County[df$State %in% input$data1])))
} else {
updateSelectInput(session, "data2", "Select County", choices = c("All", unique(df$County)))
}
}, priority = 2)
observeEvent(c(input$data1, input$data2), {
req(input$data2)
if (input$data2 != "All") {
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City[df$County %in% input$data2])))
} else {
if (input$data1 != "All") {
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City[df$State %in% input$data1])))
} else {
updateSelectInput(session, "data3", "Select City", choices = c("All", unique(df$City)))
}
}
}, priority = 1)
filtered_data <- reactive({
temp_data <- df
req(input$data2,input$data3)
if (input$data1 != "All") {
temp_data <- temp_data[temp_data$State %in% input$data1, ]
}
if (input$data2 != "All") {
temp_data <- temp_data[temp_data$County %in% input$data2, ]
}
if (input$data3 != "All") {
temp_data <- temp_data[temp_data$City %in% input$data3, ]
}
temp_data
})
output$table <- renderDT(
filtered_data()
)
}
Related Topics
Combine Rows and Sum Their Values
Print a Data Frame with Columns Aligned (As Displayed in R)
Arrow() in Ggplot2 No Longer Supported
Fitting a Lognormal Distribution to Truncated Data in R
Na Matches Na, But Is Not Equal to Na. Why
How to Let R Use All the Cores of the Computer
Enriching a Ggplot2 Plot with Multiple Geom_Segment in a Loop
Assign Names to Vector Entries Without Assigning the Vector a Variable Name
R Looping Through in Survey Package
How to Turn the Filename into a Variable When Reading Multiple CSVS into R
How to Use R Package "Formattable" in Shiny Dashboard
R - Download Filtered Datatable