Interactively change the selectInput choices - r

Originally I create this shiny interface that takes in a parameter "company id" and "date", but here we have a problem: most people dont know the companies we work with by their id, only their name, i.e. (McDonalds, Radioshack).
So I want to ideally create a search function like this
My current idea is to pass in a table including a list of all our partner companies and their ids to global.R. Then pass in the textInput as the search variables and perform the search on server side. However, I get lost on how to pass searchResults back into the UI on a selectInput panel?
My current code:
ui.R
library(shiny)
shinyUI(pageWithSidebar(
sidebarPanel(
textInput("nameSearch", "Or, Search for company name", 'McDonald'),
selectInput("partnerName", "Select your choice", list( "searchResults" ),
br(),
submitButton("Update View"),
br(),
),
server.R
shinyServer(function(input, output) {
#subTable
searchResult<- reactive({
subset(partners, grepl(input$nameSearch, partners$name))
})
output$searchResults <- renderTable({
searchResult[,1]
})
global.R
partners<- read.csv("partnersList.csv", fill=TRUE)
partnersList is just in this format
name id
------------------
McDonalds 1
Wendy's 2
Bestbuy 3

You need to make the UI reactive. I haven't tested this (miss data for it too) but should work I think. In server.R add:
output$selectUI <- renderUI({
selectInput("partnerName", "Select your choice", searchResult()[,1] ),
})
And in ui.R replace the selectInput with:
htmlOutput("selectUI")

In Shiny version 0.8 (where I have tested it), in server.R add the following:
shinyServer(function(input, output, session) {
observe({
# This will change the value of input$partnerName to searchResult()[,1]
updateTextInput(session, "partnerName",
label = "Select your choice",
value = searchResult()[,1])
})
})
Now the function within shinyServer has additional argument session.
You can skip the label if you don't need to change it.
You don't need to change anything in ui.R.

Reply from Rstudio's JC:
Sure, just use a textInput for the search string, and use
renderUI/uiOutput to make a dynamic selectInput. Then the rest of
your code can depend on the selectInput's value. (Make sure to check
for NULL or whatever when reading the selectInput value, because it
will start out with no value.)

If I understand the question correcly, all you need to do is display to the user company names and have company ids passed to the server.
I suppose this feature was not available back in the days (and you had to work around as suggested above) but nowadays the argument choices in selectInput function accepts named lists exactly for this need. Hopefully example below clarifies the situation.
library(shiny)
library(tidyverse)
companies <- tribble(
~name, ~id,
"McDonalds", 1,
"Wendy's", 2,
"Bestbuy", 3
)
ui <- fluidPage(
uiOutput("select_company_ui"),
textOutput("value")
)
server <- function(input, output) {
output$select_company_ui <- renderUI({
selectInput("select_company", "Select company", choices = deframe(companies))
})
output$value <- renderText(paste0("Value of the company filter is ", input$select_company))
}
# Run the application
shinyApp(ui = ui, server = server)
Here you can see the resulting app:
Side note: I use function deframe from package tibble to turn a tibble into a named list just for convenience, you could do without it by writing
choices = c("McDonalds" = 1, "Wendy's" = 2, "Bestbuy" = 3)

Related

how to use conditionalpanel() in shiny r

I am trying to create a shiny app where it allows you to select an input of what operation calculate. if the user chooses "Addition" it will show the two numeric input boxes (so they can input two numbers), if the user chooses "square" it will show only one numeric input box to square.
With this, I use conditionalPanel and if the condition is satisfied, it fetches through uiOutput() the numericInputs that I want. and same thing for square.
Now when I run this app, the conditional panels do not appear. Where did I go wrong? Thanks for checking out my question.
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),#sidebar panel
)#fluidpage
server <- function(input, output) {
output$basicmath <- renderText( ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation"))))),
output$var2 <- renderUI({
helpText("this will show to input two numerics to be added")
}) ,
output$var1 <- renderUI({
helpText("this will show to input one numeric to square")
})
)}
shinyApp(ui = ui, server = server)
The key issue you were having is that you put the uiOutputs inside the calculation output that you anticipated. It is better to separate them, since the calculation output won't run until it has the necessary prerequisite values (your input values). In addition, because you hadn't specified an output location for basicmath, the app didn't know where to put anything inside that call to renderText(). Below is working code that gets the right UI elements to appear.
One other thing you were missing in your renderUI was the use of tagList(). This helps ensure that all of your elements are packaged together, not just the last one.
Note that the math part does not work, but it looks like that was just a placeholder. When you do start to use it, be sure to use unique ids for each input. You have several instances of input$a and input$b, which probably isn't a workable approach.
library(shiny)
library(shinythemes)
ui <- fluidPage( theme = shinytheme("slate"),
titlePanel("Basic Calculator"),
sidebarPanel(
selectInput("ops","Select what Operation use",choices = c("ADDITION","SQUARE")),
helpText("Please input the appropriate number depending on the operations"),
conditionalPanel("input.ops=='ADDITION'", uiOutput("var2")),
conditionalPanel("input.ops=='SQUARE'", uiOutput("var1"))
),
mainPanel(
textOutput("basicmath")
)
)#fluidpage
server <- function(input, output) {
output$var2 <- renderUI({
tagList(
helpText("this will show to input two numerics to be added"),
splitLayout(
numericInput("var2a", label = "Input one number", value = NULL),
numericInput("var2b", label = "Input another number", value = NULL)
)
)
})
output$var1 <- renderUI({
tagList(
helpText("this will show to input one numeric to square"),
numericInput("var1a", label = "Input a number", value = NULL)
)
})
output$basicmath <- renderText( {ifelse(input$ops=="ADDITION",input$a+input$b,
ifelse(input$ops=="SUBTRACTION",input$a-input$b,
ifelse(input$ops=="SQUARE",input$a*input$a,
ifelse(input$ops=="SQUARE ROOT",sqrt(input$a),
ifelse(input$ops=="MULTIPLICATION",input$a*input$b,"not a valid operation")))))
})
}
shinyApp(ui = ui, server = server)

Use functions or loops to create shiny UI elements

I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.
I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.

use pre assigned variable inside R shiny function as a parameter

I am creating a survey using R shiny and have the following function at the beginning of my Shiny App:
install.packages("devtools")
spotifydata<-spotifycharts::chart_top200_weekly()
s<-spotifydata$artist
h<-head(s,20)
I want to know if there is anywhere to display the output of variable "h"??
I had the idea of using "selectInput" in the following manner to display each result in a drop down menu fashion.
selectInput("artists","pick 3 artists out of the top 10",
c("h[1]","h[2]","h[3]","h[4]","h[5]","h[6]",
"h[7]","h[8]","h[9]","h[10]"),multiple = TRUE)
I know this produces an error But I want to know if there is a way to emulate this
In the selectInput the variables should be written without quotes like this:
selectInput("artists","pick 3 artists out of the top 10",
c(h[1],h[2],h[3],h[4],h[5],h[6],
h[7],h[8],h[9],h[10]),multiple = TRUE)
Following is an app showing the working of the same:
library(shiny)
spotifydata<-spotifycharts::chart_top200_weekly()
s<-spotifydata$artist
h<-head(s,20)
ui <- fluidPage(
selectInput("artists","pick 3 artists out of the top 10",
c(h[1],h[2],h[3],h[4],h[5],h[6],
h[7],h[8],h[9],h[10]),multiple = TRUE)
)
server <- function(input, output)
{}
shinyApp(ui, server)
The output is as follows:
Please note that with this approach the variable h is shared between different user sessions.
If you don't want the variable h to be shared between different user sessions you can use the following approach, where we get h value within the server function and update the choices of select input using the function updateSelectInput
ui <- fluidPage(
selectInput("artists","pick 3 artists out of the top 10",
choices = c(), multiple = TRUE)
)
server <- function(input, output, session)
{
observe({
spotifydata<-spotifycharts::chart_top200_weekly()
s<-spotifydata$artist
h<-head(s,20)
updateSelectInput(session, inputId = "artists", choices = c(h[1],h[2],h[3],h[4],h[5],h[6],
h[7],h[8],h[9],h[10]))
})
}
shinyApp(ui, server)

Saving state of Shiny app to be restored later

I have a shiny application with many tabs and many widgets on each tab. It is a data-driven application so the data is tied to every tab.
I can save the application using image.save() and create a .RData file for later use.
The issue I am having how can I get the state restored for the widgets?
If the user has checked boxes, selected radio buttons and specified base line values in list boxes can I set those within a load() step?
I have found libraries such as shinyURL and shinystore but is there a direct way to set the environment back to when the write.image was done?
I am not sure where to even start so I can't post code.
edit: this is a cross-post from the Shiny Google Group where other solutions have been suggested
This is a bit hacky, but it works. It uses an "internal" function (session$sendInputMessage) which is not meant to be called explicitly, so there is no guarantee this will always work.
You want to save all the values of the input object. I'm getting all the widgets using reactiveValuesToList(input) (note that this will also save the state of buttons, which doesn't entirely make sense). An alternative approach would be to enumerate exactly which widgets to save, but that solution would be less generic and you'd have to update it every time you add/remove an input. In the code below I simply save the values to a list called values, you can save that to file however you'd like (RDS/text file/whatever). Then the load button looks at that list and updates every input based on the value in the list.
There is a similar idea in this thread
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "text", ""),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
}
)
Now with bookmarking is possible to save the state of your shinyapp. You have to put the bookmarkButton on your app and also the enableBookmarking.
The above example may not work if shiny UI involves date. Here is a minor change for date handling.
library(shiny)
shinyApp(
ui = fluidPage(
dateInput("date", "date", "2012-01-01"),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
temp=as.character(as.Date(values$date, origin = "1970-01-01"))
updateDateInput(session, inputId="date", label ="date", value = temp)
}
})
}
)

R Shiny - how to force submit button to affect not all inputs

I am facing a problem with submitButton usage in my Shiny application (which I use as some time-consuming rendering is done with the data supplied by the app-user). I also use some radioButtons with conditionalPanel to define the variables group of which user may choose the parameters. Please see the attached image to get the idea (user is selecting a list type, and - based on his list choice - a particular list appears (conditionalPanel is working) from which the user is selecting a parameter), or run a reprodicible example supplied below.
Of course, only the parameter is a value that is using in rendering an output, and I would like to force a submitButton to pass only the parameter in an automatic way. The problem is that submitButton affects also the radioButtons element, which unables the use to choose the desired value (as the values list are not switching).
QUESTION: Is there any way to define which UI elements are to be stop-from-automatic-update by submitButton so as to solve my problem? Thank you for any help!
UI:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Problem with submit button"),
sidebarPanel(
radioButtons("selectionway", "Choose list type", c(number='number', letter='letter')),
conditionalPanel(
condition = "input.selectionway == 'number'",
selectInput("numberlist", "Choose NUMBER:", choices = c("11111", "22222", "33333"))
),
conditionalPanel(
condition = "input.selectionway == 'letter'",
selectInput("letterlist", "Choose LETTER:", choices = c("A", "B", "C"))
),
submitButton("submitButton")
),
mainPanel(
verbatimTextOutput("list"),
verbatimTextOutput("value")
)
))
SERVER:
library(shiny)
shinyServer(function(input, output) {
selected.value <- reactive({
if(input$selectionway=="letter"){
return(input$letterlist)
} else {
return(input$numberlist)
}
})
output$list <- renderText({
input$selectionway
})
output$value <- renderText({
selected.value()
})
})

Resources