I'm trying to build dynamic textInput with R shiny. The user should write in a text field then push an add button to fill another field. However, each time I push the button all the fields become empty, It's like if I must define how many fields I want in advance. Any help will be very appreciated.
Thank you
Here is my code:
library(shiny)
shiny::runApp(list(
ui = pageWithSidebar(
headerPanel("test"),
sidebarPanel(
helpText("Alternatives list"),
verbatimTextOutput("summary")
),
mainPanel(
actionButton("obs","add"),
htmlOutput("selectInputs")
)
)
,
server = function(input,output){
observe({
if (input$obs == 0)
return()
isolate({
output$selectInputs <- renderUI({
if(!is.null(input$obs))
print("w")
w <- ""
for(i in 1:input$obs) {
w <- paste(w,textInput(paste("a",i,sep=""),paste("a",i,sep="")))
}
HTML(w)
})
output$summary <- renderPrint({
print("your Alternative are:")
for(i in 1:input$obs) {
print(
input[[sprintf("a%d",i)]]
)
}
})
outputOptions(output, 'selectInputs', suspendWhenHidden=FALSE)
})
})
}))
Your problem is that you regenerate all the buttons (so the input$aX) each time you click on the button. And they are generated without value by default, that's why when you read them they are all nulls.
For example you can see your mistake if you supress the loop in your output$selectInputs code : (But now it only allow you to set each aX only 1 time.)
output$selectInputs <- renderUI({
if(!is.null(input$obs))
print("w")
w <- ""
w <- paste(w, textInput(paste("a", input$obs, sep = ""), paste("a", input$obs, sep = "")))
HTML(w)
})
Keeping your code (then keeping the regeneration of all the buttons), you should add to the value argument of each textInput his "own value" (in reality, the value of the old input with the same id) value = input[[sprintf("a%d",i)]] :
output$selectInputs <- renderUI({
w <- ""
for(i in 1:input$obs) {
w <- paste(w, textInput(paste("a", i, sep = ""), paste("a", i, sep = ""), value = input[[sprintf("a%d",i)]]))
}
HTML(w)
})
Related
Consider the following shiny app. There are three basic inputs, that the user can change: A, M, and S. The "content" C (in the verbatimTextOuput on the right) depends directly on A and S.
S can be changed in two ways: by the user, or by changing M/A. If the user changes S, then the dependency on M is irrelevant. M is also not used if it is empty.
The situation is depicted in the diagram below.
The problem is when M is not blank and A is changed:
C gets updated based on the old S and new A
S gets updated based on M and the new A
C gets updated based on the new S and new A.
Thus, C gets updated twice, the first time with an invalid value.
What I want to happen is for S to update, based on the new A, then C to update based on the new S and new A.
To see the problem, run the app, then:
Put something in the M box
Change A
Observe that the C is changed twice.
How can I block the first update?
Thanks!
Shiny app code:
library(shiny)
library(digest)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("M", "M:", ""),
textInput("S", "S:", "testS"),
selectInput("A", "A:", c("A1","A2"))
),
mainPanel(
verbatimTextOutput("C")
)
)
)
server <- function(input, output, session) {
# Count calculations of C
count = 0
# Make reactive so we can modify the value
# in the input box (inpt$S is an input and output,
# essentially)
S <- reactive({
input$S
})
# Create "content" from A and S
C <- reactive({
count <<- count + 1
Sys.sleep(0.5)
message("Count ", count)
paste(
"Count: ", count, "\n", digest::sha1( c(input$A, S()) )
)
})
# When M changes, we need to change S based on A and M
# OR set S to a default value
observeEvent(input$M, {
# If user gets rid of M, reset S to default
if(input$M == ""){
S = "testS"
}else{
S = digest::sha1(c(input$M,input$A))
}
# Update the input to new S
updateTextInput(
session,
"S",
value = S
)
})
# When A changes, we need to change S based on A and M
# OR if M is blank, do nothing (S doesn't depend on M if M is blank)
observeEvent(input$A, {
# If there's no M, don't use it
if(input$M == "") return()
# Update the input to new S
updateTextInput(
session,
"S",
value = digest::sha1(c(input$M,input$A))
)
})
# "Content"
output$C <- renderText({
C()
})
}
shinyApp(ui = ui, server = server)
This should work (if I've understood the logic of your function). It has a bunch of extra messages so you can see what is updated by when and in what order.
(I also changed the superassignment of count because those just bug me, but I get the it's a little awkward with the isolate, so feel free to put it back ;)
library(shiny)
library(digest)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("M", "M:", ""),
textInput("S", "S:", "testS"),
selectInput("A", "A:", c("A1","A2"))
),
mainPanel(
verbatimTextOutput("C")
)
)
)
server <- function(input, output, session) {
# Count calculations of C
count = reactiveVal(0)
S = reactiveVal("testS")
observeEvent(input$S, { message("S updated externally")
S(input$S)
})
# When M changes, we need to change S based on A and M
# OR set S to a default value
observeEvent(input$M, { message("M updated")
# If user gets rid of M, reset S to default
if (input$M == ""){
S("testS")
} else {
S(digest::sha1(c(input$M, input$A)))
}
# Update the input to new S
updateTextInput(inputId = "S", value = S())
message("S updated by M")
})
# When A changes, we need to change S based on A and M
# OR if M is blank, do nothing (S doesn't depend on M if M is blank)
observeEvent(input$A, { message("A updated")
# If there's no M, don't use it
req(input$M)
# Update the input to new S
S(digest::sha1(c(input$M, input$A)))
updateTextInput(inputId = "S", value = S())
message("S updated by A")
})
# "Content"
output$C <- renderText({
n = isolate(count()) + 1
count(n)
#Sys.sleep(0.5)
message("Count ", n)
paste("Count: ", n, "\n", digest::sha1( c(input$A, S())))
})
}
shinyApp(ui = ui, server = server)
The S() reactiveVal updates when the user changes input$S externally or internally by input$M or input$A. The comments show which of those changes the value and output$C only changes when input$A or the S() change.
I think the issue here is that you are using observers when you should use reactives. In general you only want to use observers for side effects (saving a file, pushing a button) not when you want a value in the app. Here I think it's better to use renderUI to generate the UI element reactively rather than updating it with the observer.
library(shiny)
library(digest)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("M", "M:", ""),
uiOutput("S_UI"),
selectInput("A", "A:", c("A1","A2"))
),
mainPanel(
verbatimTextOutput("C")
)
)
)
server <- function(input, output, session) {
# Count calculations of C
count = 0
# Create "content" from A and S
C <- reactive({
count <<- count + 1
Sys.sleep(0.5)
message("Count ", count)
paste(
"Count: ", count, "\n", digest::sha1( c(input$A, input$S ))
)
})
output$S_UI <- renderUI({
if (input$M == "") {
val <- "testS"
} else {
val <- "S"
}
return(textInput("S", "S:", val))
})
# "Content"
output$C <- renderText({
C()
})
}
shinyApp(ui = ui, server = server)
Here I asked an similar question and got a working answer. But the solution does not work if 'actionButton' of sub segment is replace by 'selectInput'. On each selection of selectInput creates two outputs. Please help.. Thanks....
library(shiny)
ui <- fluidPage(
verbatimTextOutput("txt",placeholder = T), #"It is Created for Testing"
actionButton("addSeg", "Add a Segment"),
uiOutput("myUI")
)
server <- function(input, output, session) {
alld <- reactiveValues()
alld$ui <- list()
# Action to add new Segment
observeEvent(input$addSeg,{
new_id <- length(alld$ui) + 1
sub_name <- paste0("addSub_", new_id)
alld$ui[[new_id]] <- list(selectInput(sub_name,"Add a variable", choices = c("V1","V2"), selected = NULL))
observeEvent(input[[sub_name]], {
new_text_id <- length(alld$ui[[new_id]]) + 1
alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
}, ignoreInit = TRUE)
})
output$myUI <- renderUI({alld$ui})
output$txt <- renderText({class(alld$ui)})
}
shinyApp(ui, server)
This behaviour occurs because the custom UI element is re-rendered every time a new element is added to the list. Once you click "V2" and the new text element is added, the selectInput itself re-renders and resets to V1, which is noticed by the observer you've created.
The following might be a solution for you:
observeEvent(input$addSeg,{
new_id <- length(alld$ui) + 1
sub_name <- paste0("addSub_", new_id)
alld$ui[[new_id]] <- list(
selectInput(sub_name,
"Add a variable",
choices = c("", "V1","V2"),
selected = "")
)
observeEvent(input[[sub_name]], {
if (input[[sub_name]] == "") return()
new_text_id <- length(alld$ui[[new_id]]) + 1
alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
}, ignoreInit = TRUE)
})
What I've done here is add an empty option to your selectInputs, and a condition to the corresponding observer that it shouldn't do anything if the input is empty. This way, I'm harnessing the "resetting" behaviour to be useful instead of annoying.
In this minimal example I want to have an option to select choices more than once i.e. to produce input value as e.g. A,B,B,B,A,A,C
Option hideSelected = FALSE makes selected options still visible, but not selectable again.
According to https://github.com/rstudio/shiny/issues/518 there is such an option in selectize but I can't find such an option even here: https://github.com/selectize/selectize.js/blob/master/docs/usage.md
server <- function(input, output, session) {
output$multipleSelect <- renderUI({
selectizeInput("selectMany",
label = "I want to select each multiple times",
choices = LETTERS[1:3],
multiple = TRUE,
options = list(hideSelected = FALSE))
})
}
ui <- function() {
fluidPage(
uiOutput("multipleSelect")
)
}
shinyApp(ui, server)
Since Shiny hasn't implemented this yet and if you'd like to stick to selectInput, a workaround would be using a selectInput but clears the selection everytime the user makes a choice. Then you can put another DT output to show the currently selected elements and let the user delete elements from there. I'm using verbertimTextOutput just for demo purpose.
library(shiny)
ui <- fluidPage(
selectInput(
"selectMany",
label = "Many",
choices = LETTERS[1:3],
multiple = TRUE
),
verbatimTextOutput("debug")
)
server <- function(input, output, session) {
elements <- reactiveVal(c())
observeEvent(input$selectMany, {
req(input$selectMany)
elements(c(elements(), input$selectMany[[1]]))
})
observeEvent(elements(), {
req(elements())
updateSelectInput(session, "selectMany",
selected = character(0),
choices = LETTERS[1:3]
)
})
output$debug <- renderPrint({
print(elements())
})
}
shinyApp(ui, server)
I've come up with some good idea of adding invisible space to choices list. I've also trick selectize by adding " " option at the beggining, which solves problem of lack of reactivity when removing last element.
Here is sth that pretty much does the job - excellent when adding items.
There are still two unresolvable problems:
dropdown list is closed each time (won't be fixable as input needs to be updated)
when removing item there is blink of too many options on dropdown list
code:
library(shiny)
library(dplyr)
server <- function(input, output, session) {
# set the default choices and set previous selection to initial selectInput vector
globalList <- reactiveValues(ManyChoices = LETTERS[1:3], SelectedPrev = c())
output$multipleSelect <- renderUI({
selectizeInput("selectMany",
label = "I want to select each multiple times",
choices = c(" ", globalList$ManyChoices),
selected = " ",
multiple = TRUE,
options = list(closeAfterSelect = TRUE, openOnFocus = TRUE))
})
observeEvent(input$selectMany, {
# if sth was added
if(length(input$selectMany) > length(globalList$SelectedPrev)) {
#find out what was modified
vDiff <- setdiff(input$selectMany, globalList$SelectedPrev) %>% setdiff(., " ")
# used when removing " " and selecting sth to double the selection
if(length(vDiff) == 0) vDiff <- input$selectMany[length(input$selectMany)]
req(input$selectMany != " ") # if only " " is selected then there is no need to update
# get the position of selected element
vIndex <- which(globalList$ManyChoices == vDiff)
vLength <- length(globalList$ManyChoices)
# create new choices in the correct order
globalList$ManyChoices <- c(globalList$ManyChoices[1:vIndex],
paste0(vDiff, " "),
if(vIndex < vLength) {globalList$ManyChoices[(vIndex + 1):vLength]})
} else {
# remove the version with additional space when value was removed
vDiff <- setdiff(globalList$SelectedPrev, input$selectMany)
globalList$ManyChoices <- setdiff(globalList$ManyChoices, paste0(vDiff, " "))
}
# update previous selection
globalList$SelectedPrev <- input$selectMany
# update input with same selection but modified choices
updateSelectizeInput(session = session,
inputId = "selectMany",
selected = c(" ", input$selectMany),
choices = c(" ", globalList$ManyChoices))
})
}
ui <- function() {
fluidPage(
uiOutput("multipleSelect")
)
}
shinyApp(ui, server)
Goal: I'm working on a bioinformatics project. I'm currently trying to implement R code that dynamically creates tabPanels (they are essentially carbon copies except for the data output).
Implementation: After doing some research I implemented this solution. It works in a way (the panels that I'm "carbon copying" are created), but the data that I need cannot be displayed.
Problem: I'm sure that the way I'm displaying my data is fine. The problem is that I can't use the same output function to display the data as seen here. So let me get to the code...
ui.R
library(shiny)
library(shinythemes)
library(dict)
library(DT)
...# Irrelevant functions removed #...
geneinfo <- read.table(file = "~/App/final_gene_info.csv",
header = TRUE,
sep = ",",
na.strings = "N/A",
as.is = c(1,2,3,4,5,6,7))
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Home",
#shinythemes::themeSelector(),
fluidPage(
includeHTML("home.html")
)),
tabPanel("Gene Info",
h2('Detailed Gene Information'),
DT::dataTableOutput('table')),
tabPanel("File Viewer",
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "gene", label = "Choose a Gene", choice = genes, multiple = TRUE),
selectInput(inputId = "organism", label = "Choose an Organism", choice = orgs),
selectInput(inputId = "attribute", label = "Choose an Other", choice = attributes),
width = 2),
mainPanel(
uiOutput('change_tabs'),
width = 10))),
tabPanel("Alignment")
)
I'm using uiOutput to generate tabs dynamically on the server side....
server.R
server <- function (input, output, session) {
# Generate proper files from user input
fetch_files <- function(){
python <- p('LIB', 'shinylookup.py', python=TRUE)
system(sprintf('%s %s %s', python, toString(genie), input$organism), wait = TRUE)
print('Done with Python file generation.')
# Fetch a temporary file for data output
fetch_temp <- function(){
if(input$attribute != 'Features'){
if(input$attribute != 'Annotations'){
chosen <- toString(attribute_dict[[input$attribute]])
}
else{
chosen <- toString(input$sel)
extension <<- '.anno'
}
}
else{
chosen <- toString(input$sel)
extension <<- '.feat'
}
count = 0
oneline = ''
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, extension, sep = '')
# Writes a temporary file to display output to the UI
target <- p('_DATA', f)
d <- dict_fetch(target)
temp_file <- tempfile("temp_file", p('_DATA', ''), fileext = '.txt')
write('', file=temp_file)
vectorofchar <- strsplit(toString(d[[chosen]]), '')[[1]]
for (item in vectorofchar){
count = count + 1
oneline = paste(oneline, item, sep = '')
# Only 60 characters per line (Find a better solution)
if (count == 60){
write(toString(oneline), file=temp_file, append=TRUE)
oneline = ''
count = 0
}
}
write(toString(oneline), file=temp_file, append=TRUE)
return(temp_file)
}
# Get the tabs based on the number of genes selected in the UI
fetch_tabs <- function(Tabs, OId, s = NULL){
count = 0
# Add a select input or nothing at all based on user input
if(is.null(s)==FALSE){
selection <- select(s)
x <- selectInput(inputId = 'sel', label = "Choose an Annotation:", choices = selection$keys())
}
else
x <- ''
for(gene in input$gene){
if(count==0){myTabs = character()}
count = count + 1
genie <<- gene
fetch_files()
file_tab <- lapply(sprintf('File for %s', gene), tabPanel
fluidRow(
titlePanel(sprintf("File for %s:", gene)),
column(5,
pre(textOutput(outputId = "file")),offset = 0))
)
addTabs <- c(file_tab, lapply(sprintf('%s for %s',paste('Specific', Tabs), gene), tabPanel,
fluidRow(
x,
titlePanel(sprintf("Attribute for %s:", gene)),
column(5,
pre(textOutput(outputId = OId), offset = 0)))
))
# Append additional tabs every iteration
myTabs <- c(myTabs, addTabs)
}
return(myTabs)
}
# Select the proper file and return a dictionary for selectInput
select <- function(ext, fil=FALSE){
f <- paste(toString(genie), toString(input$organism), sep = '_')
f <- paste(f, ext, sep = '')
f <- p('_DATA', f)
if(fil==FALSE){
return(dict_fetch(f))
}
else if(fil==TRUE){
return(toString(f))
}
}
# Output gene info table
output$table <- DT::renderDataTable(
geneinfo,
filter = 'top',
escape = FALSE,
options = list(autoWidth = TRUE,
options = list(pageLength = 10),
columnDefs = list(list(width = '600px', targets = c(6))))
)
observe({
x <- geneinfo[input$table_rows_all, 2]
if (is.null(x))
x <- genes
updateSelectizeInput(session, 'gene', choices = x)
})
# Output for the File tab
output$file <- renderText({
extension <<- '.gbk'
f <- select(extension, f=TRUE)
includeText(f)
})
# Output for attributes with ony one property
output$attributes <- renderText({
extension <<- '.kv'
f <- fetch_temp()
includeText(f)
})
# Output for attributes with multiple properties (features, annotations)
output$sub <- renderText({
f <- fetch_temp()
includeText(f)
})
# Input that creates tabs and selectors for more input
output$change_tabs <- renderUI({
# Fetch all the appropriate files for output
Tabs = input$attribute
if(input$attribute == 'Annotations'){
extension <<- '.anno'
OId = 'sub'
s <- extension
}
else if(input$attribute == 'Features'){
extension <<- '.feat'
OId = 'sub'
s <- extension
}
else{
OId = 'attributes'
s <- NULL
}
myTabs <- fetch_tabs(Tabs, OId, s = s)
do.call(tabsetPanel, myTabs)
})
}
)
Explanation: Now I'm aware that there's a lot to look at here.. But my problem exists within output$change_tabs (it's the last function), which calls fetch_tabs(). Fetch tabs uses the input$gene (a list of genes via selectizeInput(multiple=TRUE)) to dynamically create a set of 2 tabs per gene selected by the user.
What's Happening: So if the user selects 2 genes then 4 tabs are created. With 5 genes 10 tabs are created... And so on and so forth... Each tab is EXACTLY THE SAME, except for the data.
Roadblocks: BUT... for each tab I'm trying to use the same output Id (since they are EXACTLY THE SAME) for the data that I want to display (textOutput(outputId = "file")). As explained above in the second link, this simply does not work because HTML.
Questions: I've tried researching several solutions, but I would rather not have to implement this solution. I don't want to have to rewrite so much code. Is there any way I can add a reactive or observer function that can wrap or fix my output$file function? Or is there a way for me to add information to my tabs after the do.call(tabsetPanel, myTabs)? Am I thinking about this the right way?
I'm aware that my code isn't commented very well so I apologize in advance. Please feel free to critique my coding style in the comments, even if you don't have a solution. Please and thank you!
I've come up with a very VERY crude answer that will work for now...
Here is the answer from #BigDataScientist
My Issue with BigDataScientist's Answer:
I can't dynamically pass data to the outputs. The output functions are not interpreted until they are needed... So if I wanted to pass the for loop iterator that you created (iter) into the dynamically created outputs, then I wouldn't be able to do that. It can only take static data
My Solution:
I end up taking advantage of sys.calls() solution I found here in order to get the name of the function as a string. The name of the function has the info I need (in this case a number).
library(shiny)
library(shinythemes)
myTabs <<- list()
conv <- function(v1) {
deparse(substitute(v1))
}
ui <- navbarPage(inverse = TRUE, "GENE PROJECT",
theme = shinytheme("cerulean"),
tabPanel("Gene Info",
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 5,
value = 3)
),
# Show a plot of the generated distribution
mainPanel(
uiOutput('changeTab')
)
)
)
)
server <- function(input, output) {
observe({
b <<- input$bins
myTabs <<- list()
# Dynamically Create output functions
# Dynamically Create formatted tabs
# Dynamically Render the tabs with renderUI
for(iter in 1:b){
x <<- iter
output[[sprintf("tab%s", iter)]] <- renderText({
temp <- deparse(sys.calls()[[sys.nframe()-3]])
x <- gsub('\\D','',temp)
x <- as.numeric(x)
f <- sprintf('file%s.txt', x)
includeText(f)
})
addTabs <<- lapply(sprintf('Tab %s', iter), tabPanel,
fluidRow(
titlePanel(sprintf("Tabble %s:", iter)),
column(5,
pre(textOutput(outputId = sprintf('%s%s','tab', iter))))))
myTabs <<- c(myTabs, addTabs)
}
myTabs <<- c(myTabs, selected = sprintf('Tab %s', x))
output$changeTab <- renderUI({
do.call(tabsetPanel, myTabs)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I think your being a victim of this behavior. Try:
for (el in whatever) {
local({
thisEl <- el
...
})
}
like Joe suggests in the first reply to the Github issue I linked to. This is only necessary if you're using a for loop. lapply already takes el as an argument, so you get this "dynamic evaluation" benefit (for lack of a better name) for free.
For readability, I'm going to quote most of Joe's answer here:
You're the second person at useR that I talked to that was bitten by this behavior in R. It's because all the iterations of the for loop share the same reference to el. So when any of the created reactive expressions execute, they're using whatever the final value of el was.
You can fix this either by 1) using lapply instead of a for loop; since each iteration executes as its own function call, it gets its own reference to el; or 2) using a for loop but introducing a local({...}) inside of there, and creating a local variable in there whose value is assigned to el outside of the reactive.
I have successfully updated UI dynamically through renderUI(). I have a long list of inputs to choose from. The check boxes are used to dynamically add numeric inputs. So, to implement this, I used lapply. However, I have used values of selected check boxes in checkboxgroup itself to populate IDs of the dynamically added numerical input instead of using paste(input, i) in lapply.
ui code snippet :
checkboxGroupInput(inputId = "checkboxgrp", label = "Select types",
choices = list("ELECTAPP","NB W $","PUR","MANUAL LTR","REDEMPTION","NB W TRANSFER","NB WOUT $","OUTPUT")),
...
fluidRow(column(12, verbatimTextOutput("value")))
...
uiOutput("numerics")
server code snippet :
renderUI({
numInputs <- length(input$checkboxgrp)
if(numInputs==0){
wellPanel("No transaction selected")
}
else{
lapply(1:numInputs, function(i){
x[i]=input$checkboxgrp[i]
list(numericInput(input$checkboxgrp[i], min = 0, label = input$checkboxgrp[i],
value= input[[x[i]]] ))
})
}
})
output$value <- renderPrint({
numInputs <- length(input$checkboxgrp)
lapply(1:numInputs, function(i){
print(input[[x[i]]]) ## ERROR
})
})
I have used input[[x[i]]] as to instantiate value to be retained after adding or removing a numeric input. But, I want to extract values from input$x[i] or input[[x[i]]] into a vector for further use which I'm unable to do.
*ERROR:Must use single string to index into reactivevalues
Any help is appreciated.
EDIT
using 3 different ways of extracting values from input generate 3 different errors:
Using print(input$x[i]) # ERROR
NULL
NULL
NULL
NULL
[[1]]
NULL
[[2]]
NULL
[[3]]
NULL
[[4]]
NULL
Using print(input[[x[i]]]) # ERROR
Must use single string to index into reactivevalues
Using print('$'(input, x[i])) # ERROR
invalid subscript type 'language'
If I understand you correctly, you want to access values of dynamically generated widgets and then just print them out.
In my example below, which should be easy to generalise, the choices are the levels of the variable Setosa from the iris dataset.
The IDs of the generated widgets are always given by the selected values in checkboxGroupInput. So, input$checkboxgrp says to shiny for which level of setosa there should be generated a widget. At the same time input$checkboxgrp gives IDs of generated widgets. That's why you don't need to store the IDs of "active" widgets in other variable x (which is probably a reactive value).
To print the values out you can do the following:
output$value <- renderPrint({
activeWidgets <- input$checkboxgrp
for (i in activeWidgets) {
print(paste0(i, " = ", input[[i]]))
}
})
This line print(input[[x[i]]]) ## ERROR yields an error because x[i] (whatever it is) is not a vector with a single value but with multiple values.
Full example:
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkboxgrp", "levels", levels(iris$Species))
),
mainPanel(
fluidRow(
column(6, uiOutput("dynamic")),
column(6, verbatimTextOutput("value"))
)
)
)
)
server <- function(input, output) {
output$dynamic <- renderUI({
numInputs <- length(input$checkboxgrp)
if(numInputs==0){
wellPanel("No transaction selected")
}
else{
lapply(1:numInputs, function(i){
x[i]=input$checkboxgrp[i]
list(numericInput(input$checkboxgrp[i], min = 0, label = input$checkboxgrp[i],
value= input[[x[i]]] ))
})
}
})
output$value <- renderPrint({
activeWidgets <- input$checkboxgrp
for (i in activeWidgets) {
print(paste0(i, " = ", input[[i]]))
}
})
}
shinyApp(ui = ui, server = server)
Edit:
You could tweak the lapply part a little bit (mind <<- operator :) )
else{
activeWidgets <- input$checkboxgrp
val <- 0
lapply(activeWidgets, function(i){
val <<- val + 1
list(numericInput(i, min = 0, label = i,
value = val ))
})
}
Edit 2 In response to a comment:
server <- function(input, output) {
output$dynamic <- renderUI({
numInputs <- length(input$checkboxgrp)
if(numInputs==0){
wellPanel("No transaction selected")
}
else{
activeWidgets <- input$checkboxgrp
val <- 0
lapply(activeWidgets, function(i){
val <<- val + 1
list(numericInput(i, min = 0, label = i,
value = val ))
})
}
})
allChoices <- reactive({
# Require that all input$checkboxgrp and
# the last generated numericInput are available.
# (If the last generated numericInput is available (is not NULL),
# then all previous are available too)
# "eval(parse(text = paste0("input$", input$checkboxgrp))))" yields
# a value of the last generated numericInput.
# In this way we avoid multiple re-evaulation of allChoices()
# and errors
req(input$checkboxgrp, eval(parse(text = paste0("input$", input$checkboxgrp))))
activeWidgets <- input$checkboxgrp
res <- numeric(length(activeWidgets))
names(res) <- activeWidgets
for (i in activeWidgets) {
res[i] <- input[[i]]
}
res
})
output$value <- renderPrint({
print(allChoices())
})
}