The program I'm writing takes a spreadsheet of grades and then creates tables, plots, and summaries of the data it receives. However, I want multiple users to be able to use this. This means the weight of each type of grade (Homework, Tests, Quizzes, etc) will be different for each user.
What I'm trying to do is create a checkboxGroupInput that generates a list of the different types of grades (read from 'Type' column in the spreadsheet), then when each checkbox is checked a numericInput will pop up allowing the user to select a weight. Here is an example picture.
Example Pic
(Sorry, I don't have enough reputation to post an image right now)
However, I don't know how to render the numericInput to a True/False value of each checkbox. I know how to render a table to show columns based on group input, like in this example, but I don't know how to initiate an unknown number of numericInputs since each one will be its own variable. Is this possible? I can't think of another way to achieve what I want.
Here is the code (snippet) of what I have so far.
ui <- fluidPage(
dashboardBody(
tabBox(
id = 'tabset1',
width = '100%',
tabPanel('Enter weights',
splitLayout(uiOutput('type'), uiOutput('weight'))),
tabPanel('Grades Graph', plotOutput('individualGraph')),
tabPanel('Grades Table', dataTableOutput('summaryDT')),
tabPanel('Summary by Unit', plotOutput('summaryBarGraph'), br(), dataTableOutput('summaryUnitDT')),
tabPanel('Class Averages', plotOutput('classAverageGraph'), br(), dataTableOutput('classAverageTable'))
)
)
server <- function(input, output, session) {
output$type <- renderUI({
df <- data.frame(grades())
choices <- unique(pull(df, Type))
checkboxGroupInput(inputId = 'typeVar',
label = 'Select Type',
choices = choices,
selected = choices)
})
output$weight <- renderUI({
numericInput(inputId = 'weightVar',
label = 'Select Weight %', value = 50,
width = 50)
})
}
Any help/guidance would be appreciated! If I'm wrong in thinking this is the best way to achieve what I want please let me know. I'm open to more suggestions.
First of all, does the checkboxGroupInput() make sense here? This seems like the radio buttons UI element match what you're trying to do better (because radio buttons imply to the user that only one can be checked at a time). Second, instead of having many numericInputs created dynamically, could you try to use one numeric input and use updateNumericInput() to change it whenever the radio button changes? Then in your handling of the number change your conditional statement would just need to look at the number AND what radio button is checked.
I'm envisioning something like this:
observeEvent(input$RadioButton, {
updateNumericInput(session, "NumericInputName", value=theVariable)
}
where theVariable is the value previously entered for that category (test, quiz, etc), or 0 if nothing has ever been entered for that category.
Related
I'm new to Shiny - a lot I don't fully understand yet. I'm working on a Shiny app to display some data. I want to allow for optional filtering of the data before being plotted. In order to construct my criteria, the UI will supply some selectInputs. My plan is that these are initially disabled. I could add, to the UI, buttons to activate each selectInput independently. But I wanted to try and use a checkboxGroupInput for this task. To begin developing this, I tried working on just one of the checkboxGroupInput values enabling/disabling just one of the selectInputs. It works perfectly except for one specific case. If I select the targeted checkboxGroupInput, the targeted selectInput gets enabled. But if I deselect that targeted checkboxGroupInput, the targeted selectInput does not get disabled. However, this behavior only occurs if no other checkboxGroupInput selection is currently selected. If any, or multiple, other checkboxGroupInputs are selected, the target will enable and disable in exactly the way I want and expect based on my (limited) understanding of the code.
Below is (hopefully) a clear and simple piece of code to demonstrate this behavior. I have a checkboxGroupInput with four items, and 4 selectInputs. Checking the third checkboxGroupInput item is supposed to enable the third selectInput. Unchecking (deselecting) the third checkboxGroupInput item is supposed to disable the third selectInput. Again, it behaves in precisely this way - if at least one other checkboxGroupInput is selected. The third selectInput will always be enabled by selecting the third checkboxGroupInput, but deselecting the third checkboxGroupInput item will not disable the third selectInput unless at least one other item is currently selected in the checkboxGroupInput.
I added output of the currently selected checkboxGroupInput contents to try and understand what was happening.
Last thing before the code -- I also first constructed the checkboxGroupInput using choices instead of choiceNames and choiceValues; didn't seem to matter. Also, my first try with the conditional test in the 'if' block was to use is.element instead of %in%; again, no difference in behavior.
library(shiny)
library(shinyjs)
# Let's make lists for the drop boxes
list_1 <- list("a", "b", "c")
list_2 <- list("d", "e", "f")
list_3 <- list("g", "h", "i")
list_4 <- list("j", "k", "l")
# Define UI for application
ui <- fluidPage(
useShinyjs(), # Set up shinyjs
# Application title
titlePanel("What's wrong with this??"),
# Sidebar
sidebarLayout(
sidebarPanel(
checkboxGroupInput("enabled", "Search Filters to Enable:",
choiceNames = list("List_1", "List_2", "List_3", "List_4"),
choiceValues = list("List_1_chosen", "List_2_chosen", "List_3_chosen", "List_4_chosen")),
# Input: Select from the following lists - default behavior is they are all disabled to start
disabled(selectInput("List_1_choice", "Choose from List 1:",
choices = list_1)),
disabled(selectInput("List_2_choice", "Choose from List 2:",
choices = list_2)),
disabled(selectInput("List_3_choice", "Choose from List 3:",
choices = list_3)),
disabled(selectInput("List_4_choice", "Choose from List 4:",
choices = list_4)),
verbatimTextOutput("text_choice")),
# Show a plot
mainPanel(
# empty
)
)
)
# Define server logic
server <- function(input, output) {
# This output is so I can see what's selected in the checkboxGroupInput
output$text_choice <- renderPrint({
return(paste0(input$enabled))})
observeEvent(input$enabled, {
# Here's the problem (I think) -- this 'if' block is not working the way I expect
if("List_3_chosen" %in% input$enabled){
enable("List_3_choice")
}else{
disable("List_3_choice")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have lot's of workarounds to complete this project, but I would very much like to understand what I'm doing wrong here.
Help! And thanks for your time and attention.
When nothing is selected, checkboxGroupInput returns NULL. You need to explicitly tell the observeEvent to not ignore it:
observeEvent(input$enabled, {
# Here's the problem (I think) -- this 'if' block is not working the way I expect
if("List_3_chosen" %in% input$enabled){
enable("List_3_choice")
}else{
disable("List_3_choice")
}
}, ignoreNULL = FALSE)
I'm looking to make some picker inputs in Shiny for each of the 50 states, but I'd like to separate them into three different groups such that no group has the same state. I was just wondering if there was a way to ensure that the three picker inputs didn't both select the same state or if there was perhaps a better way of doing this in R that I was not aware of. Thank you!
It takes a bit of work to set up, but you can accomplish that by updating the
available choices for other inputs when one changes. If you only have two or
three inputs that should be linked like this, it may be tempting to just
write out the observers and be done with it. But really, this is a
generalizable pattern, so I think it makes sense to use a helper function
instead. That way, you can link however many inputs you need, and also re-use
the logic in different apps.
All that the helper function needs to know is the IDs of the participating
inputs, and the set of shared choices. It’s not strictly necessary here, but
also making the choices reactive lets them dynamically change.
selectPool <- function(inputIds, choices = reactive(NULL)) {
stopifnot(is.reactive(choices))
session <- getDefaultReactiveDomain()
input <- session$input
# Keep track of all selected values in the pool
alreadySelected <- reactive({
Reduce(union, lapply(inputIds, \(id) input[[id]]))
})
# ... and based on that, what's left to select from.
remainingChoices <- reactive({
setdiff(choices(), alreadySelected())
})
# When an input changes, update remaining choices for others
lapply(inputIds, \(id) {
observe({
lapply(setdiff(inputIds, id), \(otherId) {
otherSelected <- input[[otherId]]
updateSelectInput(
session = session,
inputId = otherId,
# Anything already selected must remain a choice
choices = c(remainingChoices(), otherSelected),
selected = otherSelected
)
})
}) |> bindEvent(input[[id]], ignoreNULL = FALSE)
})
}
Once we’ve taken the time to do that, it’s very straightforward to use in an app:
library(shiny)
ui <- fluidPage(
titlePanel("Star Wars Alliance Builder"),
selectInput("alliance1", "Alliance 1", NULL, multiple = TRUE),
selectInput("alliance2", "Alliance 2", NULL, multiple = TRUE),
selectInput("alliance3", "Alliance 3", NULL, multiple = TRUE),
)
server <- function(input, output, session) {
selectPool(
inputIds = c("alliance1", "alliance2", "alliance3"),
choices = reactive(unique(dplyr::starwars$species))
)
}
shinyApp(ui, server)
By "picker inputs" I assume you mean selectInput/selectizeInput.
There are multiple ways you could do this. One way would be to use updateSelectInput() to update the reminding inputs after the first/second has been selected. The possible states to choose from would then be all states except the one(s) already selected. This would make it impossible to choose the same state in multiple inputs from the UI.
However, this might be a bit involved for your need. In that case I suggest that you:
either replace your three inputs with one selectInput(..., multiple = TRUE), and use validate() to check that the user has selected exactly three states
or simply just use validate() to throw an error to the user if they have selected the same state more than once in any of the three inputs.
I am stuck in a small problem related to shiny/R.
I am reading in a text file and displaying selective column names returned by grep search into the shiny application on the fly. For this, I am using the dynamicUI.
After the file is read in, the following function runs in server.R. It checks for specific colnames and displays this on the UI using uiOutput. Whatever column names are selected by the user, they are sent to another function for data processing and the plot it returned on the mainPanel.
server.R
output$Bait <- renderUI({
data <- input.data();
if(is.null(data)) return()
colnames <- names(data)
colnames = colnames[grep("*LFQ*",colnames,ignore.case=TRUE)]
# Creating the checkboxes using the above colnames
checkboxGroupInput("bait", "Choose Bait LFQ columns",
choices = colnames,
selected = colnames)
})
ui.R
shinyUI(
sidebarPanel(
uiOutput("Bait"),
),
mainPanel(
plotOutput(outputId = 'plot'),
)
)
Everything is fine, what I am trying to create is an action button for the checkboxes. Some files are big and have a longer list of column names >60, so whenever a checkbox is clicked, the whole function runs for processing and displays a plot. This gets unnecessary when the user has to deselect/select more than 10 columns.
An easy fix is, I kept selected=NULL but what I want is to add an actionButton after the checkboxGroupInput, so that user can select as many as checkBoxes but the function only runs when the GO button is pressed via the actionButton. If add a actionButton control after the checkbocGroupInput, it doesnt' works.
Can someone guide me in this regard. After working on this for sometime, now I am bit lost.
Thanks
Did you look into ?isolate? Lets say i want function initialFunction() only be evaluated if input$actionButtonis clicked.
observe({
input$actionButton # everything that triggers initialFunction() should come before isolate()
isolate({
# everything that should not trigger initialFunction() should come inside isolate()
initialFunction()
})
})
I'm trying to create an app where the user is initially presented with a sidebar selectInput containing a list of choices: A, B, C and D – populated by file-system contents.
Depending on which choice the user selects, I want to populate the rest of the sidebar with choice-specific contents. For example, if the user chooses "A", then the sidebar will contain an additional selectInput and dateRangeInput.
To keep the code clean, I've kept all "A"-specific code in handle_A.R, etc. This means that eventually when I decide to add a new choice "E", I just need to put all the code in handle_E.R.
ui.R
pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
selectizeInput("choice", "Choice:", c()),
uiOutput("sidebar")
),
mainPanel(uiOutput("main"))
)
server.R (relevant bits)
output$sidebar <- renderUI({
sidebarRenderer[[input$choice]](input, output, session)
})
I have code in server.R that sources all the handle_*.R scripts – each registering their callbacks.
So far, so good. I can select various choices and the relevant callbacks are called. However, I don't know how to implement the callbacks such that I can update the sidebar widgets as the user interacts with the sidebar. I want to essentially do the following (which will not work, because the function needs to return something to renderUI):
handle_A.R
sidebarRenderer[["A"]] <<- function(input, output, session) {
selectInput("day", "Day:", c("Mon", "Wed", "Fri"))
dates <- getDateList(input$day)
dateRangeInput("date", "Date:", start=dates[0], end=dates[length(dates)])
if (hasPublicHoliday(dates))
checkboxInput("ignoreHolidays", "Ignore public holidays")
}
So what I want is to automatically update dateRangeInput to the calculated start and end dates for the corresponding Mon/Wed/Fri. Furthermore, if any of the dates contain a public holiday, I want to display an extra checkbox to let the user ignore public holidays.
If anybody can help me out, I'd greatly appreciate it!
Turns out all I needed was to put the logic in observe and call updateCheckBoxInput.
I would like to show content of my shiny app depending on the number of selected items of a multiselect input. So far I couldn't figure out what the condition should look like to make this work.
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("select and conditional panel"),
sidebarPanel(
selectInput(inputId = "someSelect", multiple=TRUE, label = "Genes:", choices = colnames(someDataFrame), selected = c("ESR1", "CD44")),
),
mainPanel(
conditionalPanel(
condition="length(input.someSelect.selected) > 2",
tabsetPanel(
...
)
)
)
))
It is probably a matter of taste, but I don't like the conditionalPanel construct, because it enters a javascript logic into an R code. Instead I prefer the uiOutput (and the respective renderUI), that can generate dynamic UI. while the conditionalPanel can handle only rather simple conditions, the dynamic UI approach can create conditional appearance that are based on more complex logic and can take advantage of the power of R.
it is, however, slightly slower to respond to changes.
if you use this approach your ui.r should look something like:
mainPanel(uiOutput("myConditionalPanel"))
and your server.r would look something like:
output$myConditionalPanel = renderUI({
if(length(input$someSelect)>2) {
## some ui definitions here. for example
tabsetPanel(
...
)
} else {
## some alternative definitions here...
}
})
You can't use a R function into the condition of the conditional panel. I think your condition should be : input.someSelect.length > 2
Hopefully this helps someone else having the same issue I had...
Using the above answers I was having issues when trying to make a conditionalPanel only appear when 2 or more items were selected in a selectInput. The uiOutput/renderUi method was buggy and with the condition input.someSelect.length > 1 the conditionalPanel appeared even when nothing was selected in the selectInput.
With the conditionPanel, I needed to include a condition to check whether the selectInput was defined:
"input.someSelect != undefined && input.someSelect.length > 1"