R shiny favourites in long selectInput lists - r

How do I deal with long lists of options? In the example below, I have a subset of the options as favourites, but want to be able to select all options including the non-favourites. How do I get the input$selected to return what I selected last based on both the radiogroupbutton() and the selectInput()?
EDIT: I would like to keep the look, which has radiobuttons AND a drop down list. Therefore, I assume both will need different inputID's which then could be combined (somehow) in the server site (as Joris suggested). I am not sure how to combine them on the server site, and how to identify what was selected last.
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId="selected",
choices = sort(favourites),
individual = TRUE,
selected = NULL,
width="20%"),
selectInput(inputId="selected", label = "Other options",
choices = ALL.options,
selected = NULL),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
)
server <- function(input, output) {
output$choice <- renderPrint(
input$selected
)
}
shinyApp(ui, server)

Perhaps it suffices to use a single selectInput or selectizeInput that lists the Favourites and Other options in separate option groups (see e.g. Shiny: Option groups for selectize input):
library(shiny)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
selectizeInput(inputId = "selected", label = "All options", choices = list(
Favourites = favourites,
`Other options` = setdiff(ALL.options, favourites)
),
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
output$choice <- renderPrint({
validate(need(input$selected, "None selected"))
input$selected
})
}
shinyApp(ui, server)
NB: If you instead use two separate inputs (radioGroupButtons and selectInput) you could combine the selected choices server-side in a reactive object. For instance:
library(shiny)
library(shinyWidgets)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId = "radio",
choices = sort(favourites),
individual = TRUE,
selected = character(0),
width="20%"),
selectizeInput(inputId="select", label = "Other options",
choices = ALL.options,
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
## initialize reactive value
currentSelected <- reactiveVal(NULL)
## update based on radioGroupButtons
observeEvent(input$radio, {
currentSelected(input$radio)
})
## update based on selectInput
observeEvent(input$select, {
currentSelected(input$select)
})
output$choice <- renderPrint({
validate(need(currentSelected(), "None selected"))
currentSelected()
})
}
shinyApp(ui, server)
Created on 2019-06-17 by the reprex package (v0.3.0)

I am not sure if I understand fully what you are trying to achieve. I also notice that both the radioGroupButtons and the selectInput have the same inputId. If the idea is to print both the choices, you could change the inputId of the selectInput to say, select and just modify the renderPrint as:
output$choice <- renderPrint(
c(input$selected, input$select)
)
Is this what you are looking for?

Related

making selectizeInput function in Rshiny to print out all selected variables at once

I am new to Rshiny and practising how to use reactive values, reactive expressions and selectizeInput. I would like to have all brands printed at once after pressing the button without the sentence "The brands selected are as follows: " to be printed multiple times:
here is my code:
ui <- fluidPage(
titlePanel("This is a Test"),
sidebarLayout(
sidebarPanel(
selectizeInput('brand', label = 'Car brand',
multiple = T, choices = mtcars %>% rownames(),
selected = NULL, width = '100%',
options = list('plugins' = list('remove_button')))
),
mainPanel(
actionButton("show_brands", "Show brands"),
textOutput("brands")
)
)
)
server <- function(input, output, session) {
values <- reactiveValues(
brandname = NULL,
mpgdata = NULL
)
output$brands <- renderText({
allbrands <- values$brandname()
paste("The brands seleted are as follows: ", allbrands)
})
values$brandname <- eventReactive(input$show_brands, {
input$brand
})
}
shinyApp(ui, server)
and here is the output after selecting three of the brands:
We can wrap input$brand in another paste() call:
library(shiny)
ui <- fluidPage(titlePanel("This is a Test"),
sidebarLayout(
sidebarPanel(
selectizeInput(
'brand',
label = 'Car brand',
multiple = TRUE,
choices = rownames(mtcars),
selected = NULL,
width = '100%',
options = list('plugins' = list('remove_button'))
)
),
mainPanel(
actionButton("show_brands", "Show brands"),
textOutput("brands")
)
))
server <- function(input, output, session) {
output$brands <- renderText({
paste("The brands seleted are as follows: ", paste(input$brand, collapse = ", "))
}) |> bindEvent(input$show_brands)
}
shinyApp(ui, server)
PS: There is no need to use reactiveValues

How to have a user input text and create a list with shiny? R

I have the following app which allows for text to be entered and it is then saved as VALUE and printed on a panel.
Although it looks like I can only do this with one text input at a time - even if I click add (so I don't believe this button is working). On top of that I would like for the user to be able to add multiple inputs (like I have below).
And then my VALUE function should be list with multiple inputs.
code below
library(shiny)
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
# selectInput("options", "options", choices=c('abc','def')),
textInput("textbox", "Enter R Package Name", ""),
actionButton("add","Add")
),
mainPanel(
textOutput("caption")
)
)
server <- function(input, output, session) {
observe({
VALUE <- ''
if(input$add>0) {
isolate({
VALUE <- input$textbox
})
}
updateTextInput(session, inputId = "textbox", value = VALUE)
})
output$caption <- renderText({
input$textbox
})
}
shinyApp(ui = ui, server = server)
Have you considered using selectizeInput with it's create option?
library(shiny)
packagesDF <- as.data.frame(installed.packages())
ui <- fluidPage(
headerPanel("R Package App"),
sidebarPanel(
selectizeInput(
inputId = "selectedPackages",
label = "Enter R Package Name",
choices = packagesDF$Package,
selected = NULL,
multiple = TRUE,
width = "100%",
options = list(
'plugins' = list('remove_button'),
'create' = TRUE,
'persist' = TRUE
)
)
),
mainPanel(textOutput("caption"))
)
server <- function(input, output, session) {
output$caption <- renderText({
paste0(input$selectedPackages, collapse = ", ")
})
}
shinyApp(ui = ui, server = server)

Access input ID of reactive radioButtons in shiny app

I am trying to create a shiny app which includes radioButtons which are reactive to some user input.
I was successful to implement the code from this related question:
Add n reactive radioButtons to shiny app depending on user input
However, in this question it is not described how to access this values.
Here is the example:
server.R
library(shiny)
shinyServer( function(input, output, session) {
output$variables <- renderUI({
numVar <- length(as.integer(input$in0))
lapply(input$in0, function(x) {
list(radioButtons(paste0("dynamic",x), x,
choices = c("Choice one" = "one",
"Choice two" = "two"), selected = "one"))
})
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar (
headerPanel("mtcars subset"),
sidebarPanel(
selectInput(inputId = 'in0', label = 'Choose variables',
choices = colnames(mtcars),
multiple = TRUE, selectize = TRUE),
uiOutput("variables")
),
mainPanel()
))
What I have tried so far:
numVar <- length(as.integer(input$in0))
for(i in 1:numVar){
in <- noquote(paste0("dynamic",input$in0[i]))
input$in
}
However, this does not work. Any suggestions?
I'm not sure exactly of your use case but to access the values you could edit your code as below:
numVar <- length(as.integer(input$in0))
for(i in 1:numVar){
value <- paste0("dynamic",input$in0[i])
input[[value]]
}
Basically you need to use input[[value]] as opposed to input$value in this case. It doesn't seem that R allows you to use in as a variable (probably because it's already used in other contexts). You don't need noquote() anymore.
Welcome to stackoverflow!
You were almost there. However, you'll have to make sure, that you are accessing the inputs in a reactive context.
Here is a working example:
library(shiny)
ui <- fluidPage(
pageWithSidebar (
headerPanel("mtcars subset"),
sidebarPanel(
selectInput(inputId = 'in0', label = 'Choose variables',
choices = colnames(mtcars),
multiple = TRUE, selectize = TRUE),
uiOutput("variables")
),
mainPanel(
textOutput("myChoicesDisplay")
)
)
)
server <- function(input, output, session) {
output$variables <- renderUI({
lapply(input$in0, function(x) {
list(radioButtons(paste0("dynamic", x), x,
choices = c("Choice one" = "one",
"Choice two" = "two"), selected = "one"))
})
})
myChoices <- reactive({
dynInputList <- list()
for(dynInputs in paste0("dynamic", input$in0)){
dynInputList[[dynInputs]] <- input[[dynInputs]]
}
return(dynInputList)
})
output$myChoicesDisplay <- renderText({
paste(input$in0, myChoices(), sep = ": ", collapse = ", ")
})
}
shinyApp(ui, server)

Unable to clear the displayed output in ShinyApp using actionButton

I'm building a shinyApp on mtcars data. I got 2 actionButtons (Go & Clear).
The Go button is for displaying the output on mainPanel whereas the Clear button is for clearing that output.
My Clear button isn't working due to some unforeseen reason. Can somebody please have a look at my codes. I shall be extremely grateful.
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
library(shinydashboard)
data_table<-mtcars
#ui
ui = fluidPage(
sidebarLayout(
sidebarPanel (
uiOutput("cyl_selector"),
uiOutput("disp_selector"),
actionButton(inputId = "go", label = "Go"),
actionButton(inputId = "reset", label = "Clear")),
mainPanel(
DT::dataTableOutput('mytable') )))
#server
server = function(input, output, session) {
output$cyl_selector <- renderUI({
selectInput(inputId = "cyl",
label = "cyl:", multiple = TRUE,
choices = c( unique(as.character(data_table$cyl))),
selected = c('4')) })
output$disp_selector <- renderUI({
available <- data_table[c(data_table$cyl %in% input$cyl ), "disp"]
selectInput(
inputId = "disp",
label = "disp:",
multiple = TRUE,
choices = c('All',as.character(unique(available))),
selected = 'All') })
thedata <- eventReactive(input$go,{
data_table<-data_table[data_table$cyl %in% input$cyl,]
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
data_table
})
# thedata <- eventReactive(input$reset,{
# data_table<-NULL
# })
output$mytable = DT::renderDataTable({
DT::datatable( filter = "top", rownames = FALSE, escape = FALSE,
options = list(pageLength = 50, autowidth=FALSE,
dom = 'Brtip' ),
{
thedata() # Call reactive thedata()
})
})}
shinyApp(ui = ui, server = server)
I didn't analyze your script completly, but i can see that it doesn't call the second button at all (Clear). You made an eventReactive() using input$go for the first button to make the plot, but you need to call input$reset too if you want to make it work.

Shiny App checkboxInput and conditionalPanel

I am new to ShinyApp.
I want to use a checkboxInput() with conditionalPanel, so when it's checked, the options for Type will show up (then users can select a Type from "BEER", "REFRESHMENT", "SPIRITS", "WINE"). If it's not checked, the options for Type will not show up.
Below are my code, but when the Type options didn't show no matter I check the box or not. I guess I should write something in the server function? I really don't know. Thank you for your help.
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
img(src = "BCLS.png",align = "right"),
sidebarLayout(
sidebarPanel(sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),
wellPanel(
checkboxInput("checkbox", "Filter by Type", FALSE),
conditionalPanel(
condition="checkbox==true",
selectInput("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "WINE")
)
),
uiOutput("countryOutput")
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("coolplot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("results"))
)
)
)
)
server <- function(input, output, session) {
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected = "CANADA")
})
filtered <- reactive({
if (is.null(input$countryInput)) {
return(NULL)
}
bcl %>%
filter(Price >= input$priceInput[1],
Price <= input$priceInput[2],
Type == input$typeInput,
Country == input$countryInput
)
})
output$coolplot <- renderPlot({
if (is.null(filtered())) {
return()
}
filtered() %>% ggvis(~Alcohol_Content, fill := "#fff8dc") %>%
layer_histograms(width = 1, center = 0)
})
output$results <- renderTable({
filtered()
})
}
I came across this question recently while researching a similar one.
It seems the simple answer to the checkboxInput condition is as below:
condition="input.checkbox==1",
OK, you can classify conditional inputs in two categories.
1) Inputs that depend on the ui.R (in your case the checkboxInput)
2) Inputs that depend on the server.R (not necessary in your example)
Solutions:
1) you can easily solve with a renderUI() function, see the example below.
If you really want 2), you would need a conditionalPanel and you would use a reactive function in the server.R, that you save in an output object and access it with small JS-snippet in the ui.R. For me it looks like 1) is enough for you, if I am mistaken, let me know then we adapt the answer to solve 2).
A hint:
As a default your "checkbox" input takes the boolean value: false. So you would not render the "typeInput" (until you click "checkbox"). So up to that point "typeInput" is null.
However, if you now make dependencies on "typeInput" shiny will be confused,
since "typeInput" is not rendered and therefore does not exist.
So before using "typeInput", you should check, whether it is available:
if(!is.null(input$typeInput)) otherwise shiny will complain that you actually do not have a "typeinput" in your app (again: at least until you click "checkbox").
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
img(src = "BCLS.png",align = "right"),
sidebarLayout(
sidebarPanel(sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),
wellPanel(
checkboxInput("checkbox", "Filter by Type", FALSE),
uiOutput("conditionalInput")
),
uiOutput("countryOutput")
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("coolplot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("results"))
)
)
)
)
server <- function(input, output, session) {
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected = "CANADA")
})
output$conditionalInput <- renderUI({
if(input$checkbox){
selectInput("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "WINE")
}
})
filtered <- reactive({
if (is.null(input$countryInput)) {
return(NULL)
}
bcl %>%
filter(Price >= input$priceInput[1],
Price <= input$priceInput[2],
Type == input$typeInput,
Country == input$countryInput
)
})
output$coolplot <- renderPlot({
if (is.null(filtered())) {
return()
}
filtered() %>% ggvis(~Alcohol_Content, fill := "#fff8dc") %>%
layer_histograms(width = 1, center = 0)
})
output$results <- renderTable({
filtered()
})
}
# run the app
shinyApp(ui = ui, server = server)

Resources