I want to update the Pickerinput with change in another PickerInput.How can I do it in server side in Shiny?
You could use observeEvent function at the server side to monitor the status of pickerInput #1 then use updatePickerInput function to update pickerInput #2.
Please see the code below, which takes the first letter in pickerInput #1 and chooses the content of pickerInput #2 accordingly:
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
tags$h2("Update pickerInput"),
fluidRow(
column(
width = 5, offset = 1,
pickerInput(
inputId = "p1",
label = "Starting Letters",
choices = LETTERS
)
),
column(
width = 5,
pickerInput(
inputId = "p2",
label = "Names of Cars",
choices = ""
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$p1, {
updatePickerInput(session = session, inputId = "p2",
choices = grep(paste0("^",input$p1), rownames(mtcars), value = TRUE))
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
}
Output:
Related
I am trying to change the color of the slide when updating its values. I have tried different ways without success. The following code does not run, but replicates what I am trying to do:
if (interactive()) {
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
br(),
sliderTextInput(
inputId = "mySlider",
label = "Pick a month :",
choices = month.abb,
selected = "Jan"
),
verbatimTextOutput(outputId = "res"),
radioButtons(
inputId = "up",
label = "Update choices:",
choices = c("Abbreviations", "Full names")
)
)
server <- function(input, output, session) {
output$res <- renderPrint(str(input$mySlider))
observeEvent(input$up, {
choices <- switch(
input$up,
"Abbreviations" = month.abb,
"Full names" = month.name
)
updateSliderTextInput(
session = session,
inputId = "mySlider",
choices = choices,
color = "red" # This is the line I need to add
)
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
}
Maybe has someone the answer to this?
I was able to give this some more thought and figured out a way to update the slider color based on an input. shinyWidgets::setSliderColor essentially just injects CSS to overwrite all the classes associated with the sliderInputs. So it needs to be included in the UI instead of the server. (Took a min to realize that).
I set up a blank uiOutput which is then updated by observing input$up with the new or default color.
Demo
ui <- fluidPage(
br(),
mainPanel(class = "temp",
uiOutput('s_color'), # uiOuput
sliderTextInput(
inputId = "mySlider",
label = "Pick a month :",
choices = month.abb,
selected = "Jan"
),
verbatimTextOutput(outputId = "res"),
radioButtons(
inputId = "up",
label = "Update choices:",
choices = c("Abbreviations", "Full names")
)
)
)
server <- function(input, output, session) {
output$res <- renderPrint(str(input$mySlider))
# output$s_color = renderUI({})
observeEvent(input$up, {
choices <- switch(
input$up,
"Abbreviations" = month.abb,
"Full names" = month.name
)
updateSliderTextInput(
session = session,
inputId = "mySlider",
choices = choices
)
output$s_color = renderUI({ # add color
if (input$up == "Full names") {
setSliderColor(c("Red"), c(1))
} else {
setSliderColor(c("#428bca"), c(1))
}
})
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
BACKGROUND:
I have a large list of stock symbols, 27,000 rows, that I would like to be choices in a selectizeInput() on a shinyApp. Since the list is large I am using server = T in updateSelectizeInput().
AIM:
I would like the options list to not load/render until a user starts typing a string into selectizeInput(), so that I can return all symbols that start with that letter, to reduce loading all 27,000 rows in the input. I would like input$ticker to be what is observed and then what triggers the filtering code logic. How can i achieve this without using a specific button?
Shown below is
intended output, but with a button to produce the behavior instead of the user being in the text box. This is along the lines of what I would like, but does not automatically start searchign when I type in the box and has bad code smell to me.
current logic, using input$ticker in an observer to trigger selection of df and populate updateSelectize() with new choices, but is failing and the app is evaluating too soon?\
trying to load choices once, using upload button only doesn't work
REPREX:
1.
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
choice <- reactive(
tickers[startsWith(tickers$symbol, input$ticker), ]
)
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choice(),
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize, glitches and `input$ticker` observer causes loop gltich?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# updateSelectizeInput(
# session = session,
# label = "Ticker:",
# inputId ="ticker",
# choices = tickers,
# server = TRUE
# )
observeEvent(input$ticker, {
choices <- tickers[startsWith(tickers$symbol, input$ticker), ]
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = choices,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
# REPREX for selectize
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- {
renderUI(
shiny::fluidRow(
bs4Dash::box(
title = shiny::selectizeInput(
inputId = "ticker",
label = "Ticker:",
choices = NULL,
selected = "AAPL",
options = list(
placeholder = "e.g AAPL",
create = TRUE,
maxOptions = 50L
)
),
actionButton(
inputId = "update",
label = "UPDATE NOW"
),
id = "tickerBox",
closable = F,
maximizable = F,
width = 12,
height = "250px",
solidHeader = FALSE,
collapsible = F
)
)
)
}
server <- function(input, output, session){
# One call to try and load ticker df
observeEvent(input$update, {
updateSelectizeInput(
session = session,
label = "Ticker:",
inputId ="ticker",
choices = ticker,
server = TRUE
)
})
}
shiny::shinyApp(ui = ui, server = server)
SEE SIMILAR POSTS:
SO POST 1, SO POST 2, SO POST 3
What do you think about something like this?
library(shiny)
tickers <- rep(rownames(mtcars), 850)
ui <- fluidPage(
tags$head(
tags$script(
HTML(
'document.addEventListener("keydown", function(e) {
Shiny.setInputValue("key_pressed", e.key);
})'
)
)
),
fluidRow(
column(2, selectizeInput("select", "Select", choices = "")),
column(1, actionButton("btn", "Search"))
)
)
server <- function(input, output, session) {
observeEvent(input$btn, {
req(input$key_pressed)
updateSelectizeInput(session, "select", choices = tickers[startsWith(tickers, input$key_pressed)], server = TRUE)
})
}
shinyApp(ui, server)
Basically I think it is not possible to just use the words which are putted to the selectInput and we need separate input. I think that selectInput is truthy (isTruthy()) only after some option was chosen (and it can't be "" of course), so we can't use anything which is putted as a word to the selectInput box before some option is actually chosen. I'm not sure, but if I'm right, it is necessary to have separate input for what you want.
However, if we could assume that:
User will use only one letter to get the options to choose
Then we can use "keydown" event (keydown). Now the user doesn't need to put anything to the selectInput box, she/he can just use a key in the keyboards, like C (letter size does matter here, because we are using startsWith()) and then push "Search" button (but of course this letter can still be put to the selectInput box to mimic what you tried to achieve). We could even imagine solution without the button, but I'm afraid in most use-cases it will be not recommended, I mean if user can interact with the app using keyboard not only to choose the options, but also for other purposes, then we would recompute new options everytime user uses key in the keyboard for - well - nothing.
Turns out that selectizeInput doesn't accept a df and must be an atomic vector. When I used tickers[[1]], the issue seemed to be solved, and the list would no longer flash.
I have a selectizeInput (with parameter multiple = FALSE) in a shiny app. I´m not able to change the multiple-parameter afterwards by using the server-side updateSelectizeInput() and setting the option there.
Here is an example:
library(shiny)
ui <- fluidPage(
selectizeInput(
inputId = "name",
label = "Select Name:",
choices = NULL
)
)
server <- function(input, output, session) {
updateSelectizeInput(
inputId = "name",
choices = c("Markus", "Lisa", "Peter"),
options = list(maxItems = 10),
server = TRUE # set consciously, I have a big list to handle
)
}
shinyApp(ui, server)
If I don´t set the server parameter to TRUE, everything works just fine. Is this a bug or do I miss something?
To select multiple items, you can set multiple=TRUE in the selectizeInput as shown below.
library(shiny)
ui <- fluidPage(
selectizeInput(
inputId = "name",
label = "Select Name:",
choices = NULL, multiple=T
)
)
server <- function(input, output, session) {
updateSelectizeInput(
inputId = "name",
choices = c("Markus", "Lisa", "Peter"),
options = list(maxItems = 10),
server = TRUE # set consciously, I have a big list to handle
)
}
shinyApp(ui, server)
How to Displayed values in filter with ascending Order.
Want to displayed filter of week in dataTableOutput with value in ascending order.
Here is the code of ui.R
fluidPage(
titlePanel("Delivery Assurance Matrix"),
fluidRow(
column(4,
selectInput("week_count",
"Week",
c("All",
sort(unique(as.character(data$Week))))
))),
DT::dataTableOutput("table")
)
Here is the code of server.R
function(input, output) {
output$table <- DT::renderDataTable(DT::datatable({
data<-data
if (input$week_count != "All") {
data <- data[data$Week >= input$week_count,]
}
data
}))
}
But in UI Values not in ordering
You can also you shinyWidgets package which has Select All Option
library(shiny)
library(shinyWidgets)
data <- c(11,1,2,3,10,21)
ui <- fluidPage(
titlePanel("Delivery Assurance Matrix"),
fluidRow(
column(4,
pickerInput(
inputId = "week_count",
label = "Week",
choices = sort(data),
multiple = TRUE,
options = list(
`actions-box` = TRUE,
`deselect-all-text` = "None...",
`select-all-text` = "Select All",
`none-selected-text` = "None Selected"
)
)
)),
DT::dataTableOutput("table")
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Its solved by this changes.
fluidRow(
column(4,
selectInput("week_count",
"Week",
c("All",
order(sort(unique(as.character(data$Week)))))
))
I'm trying to place a selectInput box beside an actionButton in a shiny app, using fluidRow & column arguments. However the button gets placed at the top of its column.
Using text-align:center in the div places the button centre-top in the column view. I'd like the actionButton to be at the same height as the selectBox on its left.
I'm just beginning to get into some CSS because of Shiny but am at a loss here.
Thanks in advance :)
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, selectInput("Input1", label = h3("Select Input 1"), choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
You can do that by adding another fluidRow, and setting the label =NULL
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, h3("Select Input 1") )),
fluidRow(column(6, selectInput("Input1", label = NULL, choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)