Prevent selectInput from wrapping text
Taking inspiration from here and here you can add some custom css to the drowpdown
Here's a working example
library(shiny)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100),
selectizeInput(inputId = "si",
label = "select",
choices = c("the quick brown fox jumped over the lazy dog the quick brown fox jumped over the lazy dog"),
selected = NULL),
## Custom css
tags$head(
tags$style(HTML('
.selectize-input {
white-space: nowrap;
}
.selectize-dropdown {
width: 660px !important;
}'
)
)
)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
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)
Selectize dropdown width independent of input
The widths of each label are set dynamically through JS.
To overwrite that how about doing something like this:
.selectize-dropdown {
width: 600px !important;
}
Fiddle
Customize drop-down width in shiny selectInput
If i understand your right you need something like
library(shiny)
ui <- (fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("userInput","Select User", c(1,2,3),
selected=1),
selectInput("LongInput", "Long Strings", c("This is a long long string that is long.",
"This is a long long string that is longer."))
),
# allows for long texts to not be wrapped, and sets width of drop-down
tags$head(
tags$style(HTML('
.selectize-input {
white-space: nowrap;
}
#LongInput + div>.selectize-dropdown{
width: 660px !important;
}
#userInput + div>.selectize-dropdown{
width: 300px !important;
}
'
)
)
)
)
))
server <- function(input, output, session) {}
shinyApp(ui, server)
Its set 660px for LongInput and 300px for userInput
Update
you also can do it dunamic
for example you have df with input name and size
df1=data.frame(name=c("LongInput","userInput"),px=c(600,300))
So try
library(shiny)
ui <- (fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("userInput","Select User", c(1,2,3),
selected=1),
selectInput("LongInput", "Long Strings", c("This is a long long string that is long.",
"This is a long long string that is longer."))
),
uiOutput("din_css")
)
))
server <- function(input, output, session) {
df1=data.frame(name=c("LongInput","userInput"),px=c(600,300))
output$din_css=renderUI({
tags$head(
tags$style(HTML(paste0('
.selectize-input {
white-space: nowrap;
}',
paste(apply(df1,1,function(i){
paste0("#",i[["name"]],"+ div>.selectize-dropdown{
width: ",i[["px"]],"px !important;
}")
})
,collapse='/n') )
)
)
)
})
}
shinyApp(ui, server)
Is there a way to prevent a new line when a text + a select input exceed flex container's width?
Because it is two elements. Text is full width so there is no more actual space. If you want select next to text, it must be in one element or without display flex.
.entry {
display: flex;
flex-wrap: wrap;
align-items: center;
width: 100%;
margin-bottom: 10px;
font-family: "Noto Sans";
font-size: 16px;
letter-spacing: 0;
line-height: 28px;
}<div class="entry">
<div>This is a very long text that will definitely need 2 lines to be rendered. However, because of the select, it will take 3 lines even though it should take only 2
<select>
<option value="1">1</option>
</select>
</div>
</div>
<div class="entry">Short text, 1 line. Why?
<select>
<option value="1">1</option>
</select>
</div>How to text wrap choices from a pickerInput, If the length of the choices are long the choices often end up outside the screen
Here's two solutions, both use choicesOpt argument to prevent modifying the value server-side.
1. Truncate your string to fix width
I used stringr::str_trunc :
library("shiny")
library("shinyWidgets")
my_choices <- c(
"Choice 1 is small","Choice 2 is average sized",
"But choice 3 is very big and sometimes when the length of the qption is long it leaves the screen, so I need a UI fix to wrap the question to fit the width of the pickerInput. I want pickerInput because it has select all/deselect all button."
)
ui <- fluidPage(
pickerInput(
inputId = "id",
label = "Some name",
choices = my_choices,
selected = NULL,
multiple = TRUE,
options = list(
`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3"
),
choicesOpt = list(
content = stringr::str_trunc(my_choices, width = 75)
)
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$id)
}
shinyApp(ui = ui, server = server)
2. Insert break lines
I used stringr::str_wrap to breaks text paragraphs into lines, then stringr::str_replace_all to replace \n with <br> (HTML version of \n)
library("shiny")
library("shinyWidgets")
my_choices <- c(
"Choice 1 is small","Choice 2 is average sized",
"But choice 3 is very big and sometimes when the length of the qption is long it leaves the screen, so I need a UI fix to wrap the question to fit the width of the pickerInput. I want pickerInput because it has select all/deselect all button."
)
my_choices2 <- stringr::str_wrap(my_choices, width = 80)
my_choices2 <- stringr::str_replace_all(my_choices2, "\\n", "<br>")
ui <- fluidPage(
# tags$style(".text {width: 200px !important; word-break: break-all; word-wrap: break-word;}"),
pickerInput(
inputId = "id",
label = "Some name",
choices = my_choices,
selected = NULL,
multiple = TRUE,
options = list(
`actions-box` = TRUE, size = 10, `selected-text-format` = "count > 3"
),
choicesOpt = list(
content = my_choices2
)
),
verbatimTextOutput(outputId = "res")
)
server <- function(input, output, session) {
output$res <- renderPrint(input$id)
}
shinyApp(ui = ui, server = server)
HTML Dropdown (select) with Text Wrap and Border after every value (option)
select { width: 100px; overflow: hidden; white-space: pre; text-overflow: ellipsis; -webkit-appearance: none;}
option { border: solid 1px #DDDDDD;}<select name="d" class="myselect"> <option value="sdf" class="test1"> line text How to wrap the big line text </option> <option value="sdf2" class="test1"> line text How to wrap the big line text </option> <option value="sdf3" class="test1"> line text How to wrap the big line text </option> <option value="sdf4" class="test1"> line text How to wrap the big line text </option></select>R shiny passing reactive to selectInput choices
You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
EDIT. Another Solution using updateSelectInput
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))
EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.
library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
Related Topics
How to Filter Cases in a Data.Table by Multiple Conditions Defined in Another Data.Table
Optimization of a Function in R ( L-Bfgs-B Needs Finite Values of 'Fn')
How to Use Multiple Cores to Make Gganimate Faster
Return Rows Establishing a "Closest Value To" in R
How to Fuzzy Join Based on Multiple Columns and Conditions
Error with Pred$Fit Using Nls in Ggplot2
R: How to Count How Many Points Are in Each Cell of My Grid
Making Commandargs Comma Delimited or Parsing Spaces
Use Endpoints Function to Get Start Points Instead
Tidyr Separate Column Values into Character and Numeric Using Regex
Convert a Row of a Data Frame to a Simple Vector in R
R Aggregate Data.Frame with Date Column
Cannot Install R Tseries, Quadprog ,Xts Packages in Linux
Split Violin Plot with Ggplot2 with Quantiles
Combination of Expand.Grid and Mapply
Is Ifelse Ever Appropriate in a Non-Vectorized Situation and Vice-Versa