How to access secondary inputs with variable names in R Shiny? - r

I'm trying to have the user enter a numeric input, then generate a number of input boxes equal to that first numeric input. I would then like to find the sum of the responses to these secondary numeric inputs. However, I am having trouble accessing these variables in a comprehensive way, since their names are created used numeric variables. Right now when I run it I get this error:
Warning: Error in get: object 'inp21' not found
Thanks
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
numericInput("inp1",
"Enter num:",1)
),
mainPanel(
uiOutput("more_inp"),
textOutput("num_inps")
)
)
)
server <- function(input, output) {
counter <- reactiveValues(countervalue = 0)
counter2 <- reactiveValues(counter2value = 0)
output$more_inp <- renderUI({
#Generates number of numeric inputs equal to original numeric input
mylist <- lapply(1:input$inp1, function(i) {
inp_identifier <- paste("inp2", i, sep="")
inp_name<- paste("Input2",i,sep=" ")
list(
numericInput(inp_identifier,inp_name, 5)
)
})
do.call(tagList, unlist(mylist, recursive = FALSE))
})
#Display number of secondary inputs
#Count number of secondary inputs
observeEvent(input$inp1, {
counter$countervalue <- counter$countervalue + 1
})
#Find sum of secondary inputs
output$num_inps<-renderText(input$inp1)
observeEvent(input$inp1,{
for (i in 1:counter$countervalue) {
counter2$counter2value <- counter2$counter2value + get(paste("inp2", i, sep=""))
print(counter2$counter2value)
}
})
}
Run the application
shinyApp(ui = ui, server = server)

Additionaly to r2evans suggestion simply "filter" out the case when an input field cannot be found. It seems that this observeEvent is called before the other input fields can be created. As a consequence, you receive an empty vector (numeric(0)) when you try to access one of them.
observeEvent(input$inp1,{
for (i in 1:counter$countervalue) {
if (isTruthy(input[[paste0("inp2", i)]])) {
counter2$counter2value <- counter2$counter2value + input[[paste0("inp2", i)]]
print(counter2$counter2value)
}
}
})

You aren't checking for the presence before adding. The observeEvent block is firing aggressively, so even though counter$countervalue is 1, there are not additional input fields present, so input[[paste("inp2", i, sep="")]] returns NULL. Anything plus null is numeric(0).
How to find this
observeEvent(input$inp1,{
browser()
for (i in 1:counter$countervalue) {
counter2$counter2value <- counter2$counter2value + get(paste("inp2", i, sep=""))
print(counter2$counter2value)
}
})
Run your app. When it hits the debugger and shows you Browse[2]>, then
counter$countervalue
# [1] 1
counter2$counter2value
# [1] 0
i <- 1L
get(paste("inp2", i, sep=""))
# Error in get(paste("inp2", i, sep = "")) : object 'inp21' not found
input[[ paste("inp2", i, sep="") ]]
# NULL
names(input)
# [1] "inp1"
A quick check could be to look for that paste(.) name in names(input).
Tangent
for (i in 1:n) works fine as long as you are 100% certain that n here will always be 1 or greater. If there is the remote possibility that it will be <1, then the results will be rather unintuitive.
That is, if n is 0, then I would expect the for loop to do nothing. As a vector example,
for (nm in c('a','b')) ... # executes twice GOOD
for (nm in c()) ... # does not execute GOOD
for (i in 1:2) ... # executes twice GOOD
for (i in 1:0) ... # executes twice BAD
The reason is that 1:0 resolves to a reverse sequence, so seq(1, 0) and therefore c(1L, 0L).
A safer alternative if you expect a possible zero is seq_len:
seq_len(2)
# [1] 1 2
seq_len(0)
# integer(0)
(seq(1, length.out=n) is equivalent.)
An even safer alternative if you cannot guarantee "positive only", then
seq_len(max(0, n))
(since seq_len(-1) is an error).
Suggested solution
observeEvent(input$inp1,{
for (i in seq_len(counter$countervalue)) { # or max(0, ...)
nm <- paste("inp2", i, sep="")
if (nm %in% names(input)) {
counter2$counter2value <- counter2$counter2value + input[[nm]]
print(counter2$counter2value)
}
}
})

Related

Error in :: NA/NaN argument in Shiny R: Comparing Strings

So I am writing an app that lets the user input some basic operations involving a matrix. At one part, they are asked to "return" the entire matrix, as they would in base R, for which they can either "call" the matrix with rows and columns [1:5,1:5] or simply put in the matrix's name (my.matrix, for instance). I am not able to get the second part working, however, as the app will crash and return the following error: Error in :: NA/NaN argument. I included the segment of code for this particular part in the server:
observeEvent( input$go6, {
sixthinput<- as.numeric(str_extract_all(input$six, "[0-9]+")[[1]])
string6 <- str_extract(input$six, "my.matrix")
sixth.list <- my.matrix[sixthinput[1]:sixthinput[2],sixthinput[3]:sixthinput[4]]
isolate({
buttonValue$go1 = FALSE
buttonValue$go2 = FALSE
buttonValue$go3 = FALSE
buttonValue$go4 = FALSE
buttonValue$go5 = FALSE
buttonValue$go6 = TRUE
buttonValue$go7 = FALSE
})
comparestring <- "my.matrix"
if (isTRUE(identical(sixth.list, my.matrix)) & buttonValue$go6) {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
sixth.list
)
output$display2 <- renderText({
print("Correct!")
})
} else if(isTRUE(identical(string6, comparestring)) & buttonValue$go6) {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
my.matrix
)
output$display2 <- renderText({
print("Correct!")
})
} else {
output$display <- renderText({
paste(c("The matrix you extracted contains:"))
})
output$displayMat <- renderTable(
sixth.list
)
output$display2 <- renderText({
print("Incorrect")
})
}
})
I am sure it has something to do with the variable "string6," "comparestring," and/or the part where I compare them in the if loop, but I am not sure where/how exactly it is going wrong, other than something is NA. Any clarification is appreciated.
The problem is in these lines:
sixthinput<- as.numeric(str_extract_all(input$six, "[0-9]+")[[1]])
string6 <- str_extract(input$six, "my.matrix")
sixth.list <- my.matrix[sixthinput[1]:sixthinput[2],sixthinput[3]:sixthinput[4]]
When the user inputs my.matrix with no subset operator ([), the value of sixthinput will be numeric(0) because there are no matching numbers. The value of sixthinput[1] will be NA, and you can’t then subset my.matrix by NA. The easiest way to avoid the error would be to check that length(sixthinput) == 4, and if not then avoid subsetting my.matrix.

Multiple filters by lower and upper bound in R Shiny

All of this code is adapted from Shiny - dynamic data filters using insertUI.
I am currently using R Shiny code that is supposed to allow for the creation of multiple filters (as many as the Shiny server will allow).
Each filter includes a selection of the variable to filter by, the upper bound, lower bound, and whether the values will be filtered by taking only the values between the upper and lower bound (i.e., lwr < x < upr), or the opposite (i.e., x < lwr ∪ x > upr). I have compiled the relevant code into code that is specifically relevant to this question.
The source code (for the simplified code) is below:
library(shiny)
library(ggplot2)
# Column names of file.
logColumns <- names(read.csv("file.csv"))
ui <- fluidPage(
titlePanel("Testing Filters"),
sidebarLayout(
sidebarPanel(
# Data type to display as Y value in graph.
selectInput("display", label = "Data Type", choice = logColumns),
# Button to activate addFilter actions.
fluidRow(
column(6, actionButton('addFilter', "Add Filter")),
offset=6
),
tags$hr(),
# Area to generate new filters.
tags$div(id='filters'),
width = 4
),
mainPanel(
# Displays plot.
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
# File to use.
usefile <- reactive({
# Placeholder code, does basic file reading for now.
# Basic (unedited) file format is time (in milliseconds) in first column
# followed by other columns with different types of data, e.g., voltage.
usefile <- read.csv("file.csv", header=TRUE)
usefile$time <- usefile$time / 1000
usefile
})
# Column names of above file.
logNames <- reactive({
names(usefile())
})
# Turns aggregFilterObserver into a reactive list.
makeReactiveBinding("aggregFilterObserver")
aggregFilterObserver <- list()
observeEvent(input$addFilter, {
# Generates unique IDs for each filter.
add <- input$addFilter
filterId <- paste0('filter', add)
colFilter <- paste0('colFilter', add)
lwrBoundNum <- paste0('lowerBound', add)
uprBoundNum <- paste0('upperBound', add)
removeFilter <- paste0('removeFilter', add)
exclusivity <- paste0('exclusivity', add)
# Dictates which items are in each generated filter,
# and where each new UI element is generated.
insertUI(
selector = '#filters',
ui = tags$div(id = filterId,
actionButton(removeFilter, label = "Remove filter", style = "float: right;"),
selectInput(colFilter, label = paste("Filter", add), choices = logNames()),
numericInput(lwrBoundNum, label = "Lower Bound", value=0, width = 4000),
numericInput(uprBoundNum, label = "Upper Bound", value=0, width = 4000),
checkboxInput(exclusivity, label = "Within Boundaries?", value=TRUE)
)
)
# Generates a filter and updates min/max values.
observeEvent(input[[colFilter]], {
# Selects a data type to filter by.
filteredCol <- usefile()[[input[[colFilter]]]]
# Updates min and max values for lower and upper bounds.
updateNumericInput(session, lwrBoundNum, min=min(filteredCol), max=max(filteredCol))
updateNumericInput(session, uprBoundNum, min=min(filteredCol), max=max(filteredCol))
# Stores data type to filter with in col, and nulls rows.
aggregFilterObserver[[filterId]]$col <<- input[[colFilter]]
aggregFilterObserver[[filterId]]$rows <<- NULL
})
# Creates boolean vector by which to filter data.
observeEvent(c(input[[lwrBoundNum]], input[[uprBoundNum]], input[[colFilter]], input[[exclusivity]]), {
# Takes only data between lower and upper bound (inclusive), or
if (input[[exclusivity]]){
rows <- usefile()[[input[[colFilter]]]] >= input[[lwrBoundNum]]
rows <- "&"(rows, usefile()[[input[[colFilter]]]] <= input[[uprBoundNum]])
}
# Takes only data NOT between lower and upper bounds (inclusive).
else{
rows <- usefile()[[input[[colFilter]]]] < input[[lwrBoundNum]]
rows <- "|"(rows, usefile()[[input[[colFilter]]]] > input[[uprBoundNum]])
}
aggregFilterObserver[[filterId]]$rows <<- rows
})
# Removes filter.
observeEvent(input[[removeFilter]], {
# Deletes UI object...
removeUI(selector = paste0('#', filterId))
# and nulls the respective vectors in aggregFilterObserver.
aggregFilterObserver[[filterId]] <<- NULL
})
})
# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
lapply(aggregFilterObserver, function(filter){
toAdjust <- "&"(toAdjust, filter$rows)
})
subset(usefile(), toAdjust)
})
# Creates plot based on filtered data and selected data type
output$distPlot <- renderPlot({
xData <- adjusted()$time
yData <- adjusted()[[input$display]]
curData <- data.frame(xData, yData)
plot <- ggplot(data=curData, aes(x=xData, y=yData)) + geom_point() + labs(x = "Time (seconds)", y = input$display)
plot
})
}
# Run the application
shinyApp(ui = ui, server = server)
My problem is that subsetting via the boolean vectors does not work - i.e., filters simply have no effect whatsoever.
Also, I'm not too sure about the wording and variable names for how the upper and lower bounds should be applied (i.e., the "Within Boundaries?" button and exclusivity variable). If a better (while still concise) wording could be used, I'd appreciate some help with that as well.
Any input is appreciated.
EDIT: After fixing my code with the current answer, I have realized that the code that [the fixed] adjusted() had is not exactly what I wanted, and that I have misunderstood what lapply actually does. I had been trying to compile multiple logical vectors into one, and this was achieved by doing the following:
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
for (filter in aggregFilterObserver){
toAdjust <- "&"(toAdjust, filter$rows)
}
if (length(toAdjust) == 0){
usefile()
} else {
subset(usefile(), toAdjust)
}
})
Thanks for the help given!
The problem comes from the fact that you never store the result of the filtering. When you define adjusted, the result of lapply is never stored.
# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
toAdjust <- rep(TRUE,nrow(usefile()))
tmp <- lapply(aggregFilterObserver, function(filter){
toAdjust <- "&"(toAdjust, filter$rows)
})
if (length(tmp$filter1) == 0) {
return(usefile())
} else {
subset(usefile(), tmp$filter1)
}
})
The condition length(tmp$filter1) == 0 is here to prevent the filtering of all rows when no filter is present.

No subsetting of data.frame in shiny app when inputs are empty, how to do this without many if statements?

I am subsetting a dataframe in a shiny app based on various inputs the user can specify. If an input field is empty, no subsetting should be done. I can achieve this inside a reactive statement with
data_subset <- reactive({
if (!is.null(input$input_a)) {data <- subset(data, a %in% input$input_a}
# lots of similar if statements for inputs b, c, d ...
data
})
where I have lots of these if statements checking if an input is NULL. But with more than 10 or 20 such statements one below the other, the code looks kind of messy and lengthy.
Is there a better way to do this? Maybe req can help here?
You should be able to tweak this code to suit your needs. input is a list containing the different elements you are using to subset. You can extract those that you need in your reactive function and then use higher order function Reduce to come up with a logical vector to index your data.
# Setup example
input <- list(input_vs = NULL, input_am = 1, input_gear = 4) # Inputs coming from ui
data <- mtcars # Data
# In the reactive expression
inpt <- reactiveValuesToList(input)
indx <- inpt[grepl("input", names(inpt))] # Extract the inputs you want
names(indx) <- gsub("input_", "", names(indx)) # Remove the prefix to get the associated variable names
indx <- Filter(Negate(is.null), indx) # Remove the null ones
# Find indices
indx <- lapply(seq_along(indx), function(i) data[, names(indx)[i]] %in% indx[[i]])
indx <- Reduce(`&`, indx)
# Subset data
data[indx, ]
I've just come up with a solution using a simple for loop. I defined a helper function to check if an input is empty and subset only if an input is not empty.
library(shiny)
data <- iris
# return TRUE if shiny input is empty, e.g. NULL, "", FALSE
is_input_empty <- function(ui_input) {
if (is.null(ui_input)) return(TRUE)
if (length(ui_input) != 1) return(FALSE)
if (ui_input == "") return(TRUE)
if (ui_input == FALSE) return(TRUE)
return(FALSE)
}
ui <- fluidPage(
selectizeInput("Species", "Species", choices = levels(data$Species),
multiple = TRUE, selected = c("versicolor", "setosa")),
plotOutput("plot_iris")
)
server <- function(input, output) {
data_subset <- reactive({
input_vars <- "Species"
# iterate over the inputs, if not NULL subset the data
for (i in input_vars){
if (!is_input_empty(input[[i]])) {data <- data[data[, i] %in% input[[i]], ]}
}
data
})
output$plot_iris <- renderPlot(plot(data_subset()$Sepal.Length,
data_subset()$Sepal.Width))
}
shinyApp(ui, server)

Dynamic UI & Accessing Data (Shiny)

I've a problem with my shiny code which is somewhat related with the two questions I linked below.
So i've made a dynamic UI :
output$hmgroupsmean <-renderUI({
numGroups <- as.integer(input$HMgroups)
lapply(1:numGroups, function(i) {
numericInput(paste0("group_", i),
label= paste("Mean", i),
min=0,
max=1000,
value= 10)
})
})
that display N numericInput depending on how many groups the user has chosen.
Then I just want to retrieve all the mean and there begin the problem :
I tried what is explained here but it doesnt work :
output$PowerAnalysisANOVA <- renderPlot({
allmean = c()
lapply(1:numGroups, function(i){
allmean[i] <- input[[paste0("group_", i)]]
})
qplot(allname)
})
it returns :
Error : argument "env" is missing, with no default
then i tried something a tad more exotic :
output$PowerAnalysisANOVA <- renderPlot({
allname = c()
allmean = c()
lapply(1:numGroups, function(i){
allname[i] <- paste0("input$group_" ,i)
allmean[i] <- get(allname[i])
})
qplot(allmean)
})
But it doesn't work : Error :object 'input$group_1' not found
Edit after AndriyTkach's comment :
output$PowerAnalysisANOVA <- renderPlot({
allname = c()
allmean = c()
lapply(1:numGroups, function(i){
allname[i] <- eval(parse (text = paste0("input$group_" ,i)))
allmean[i] <- get(allname[i])
})
qplot(allmean)
})
It returns a new Error : invalid first argument
AndriyTkach proposed that :
for (i in 1:numGroups)
eval (parse (text = paste0("allmean[", i, "] <- input$group_" ,i)))
Which work a lot better : no Error message but it only work for 2 and 3 groups , the fourth and up is not taken into account
Create dynamic number of input elements with R/Shiny
accessing inputs created in renderUI in Shiny
After some discussion with AndriyTkach : I have a working program :
output$PowerAnalysisANOVA <- renderPlot({
allmean = c()
for (i in 1:values$numGroups)
eval (parse (text = paste0("allmean[", i, "] <- input$group_" ,i)))
qplot(allmean)
})
And I had forgotten to make a reactive variable :
values <- reactiveValues()
output$hmgroupsmean <-renderUI({
values$numGroups <- as.integer(input$HMgroups)
apply(1:values$numGroups, function(i) {
numericInput(paste0("group_", i),
label= paste("Condition", i),
min=0,
max=1000,
value= 10)
})
})

for Loop - Replacement has length zero

I have a little problem with a loop. Here is the code of the loop:
for (i in 1:length(input$count))
{
id<-paste("text",i)
titles[i]<-input$id
}
This returns the following error
Error in titles[i] <- input$id : replacement has length zero
ui.R
library(shiny)
ui <- fluidPage(
numericInput("count", "Number of textboxes", 3),
hr(),
uiOutput("textboxes")
)
server.R
server <- function(input, output, session) {
output$textboxes <- renderUI({
if (input$count == 0)
return(NULL)
lapply(1:input$count, function(i) {
id <- paste0("text", i)
print(id) // its prints the text1, text2,text3
numericInput(id, NULL, value = abc)
print(input$text1) //it should print value abc , but it is not, why??
})
})
}
This error indicates that your input id is either NULL or a length 0 vector: make sure the indices are correct.
Additionally, in R it is usually best to avoid for loops as they tend to be pretty slow: see Why are loops slow in R?. There's almost always a way to avoid using a for loop and using a vectorised function instead, although the example as it stands doesn't provide enough detail to actually suggest a function.

Resources