lapply function using a numericInput parameter around an observeEvent in RShiny - r

I would like to create many multiple selectize inputs which are connected with each other. In other words : if an item is selected in one of the selectizeinputs i would like that it disappears from the other selectizeinputs' choices. In addition, i would like that the number of selectize inputs corresponds to the number selected in a numericinput.
The example below is working. The only question I have left is on the following line :
X = 1:100, ####### QUESTION HERE
Instead of 1:100, i would like to put something like 1:input$ui_number but I have the following error in R :
Error in .getReactiveEnvironment()$currentContext() : Operation not allowed without an active reactive context.
And if I put a "reactive" or an "observe" function around the lapply, the observeEvent does not work anymore. Any trick for me ?
Thank you for your help !
modalities <- LETTERS[1:10]
library(shiny)
app <- shinyApp(
ui = tabPanel("Change modalities",
numericInput("ui_number", label="Number of modalities",min = 1, max = 4, value=3),
uiOutput("renderui")
),
server = function(input, output, session) {
output$renderui <- renderUI({
output = tagList()
for(i in 1:input$ui_number){
output[[i]] = tagList()
output[[i]][[1]] = selectizeInput(paste0("ui_mod_choose",i), label=paste0("Modality ",i),choices=modalities, multiple = TRUE)
}
return(output)
})
lapply(
X = 1:100, ####### QUESTION HERE
FUN = function(j){
observeEvent({
input[[paste0("ui_mod_choose",j)]]
},
{
sapply(1:input$ui_number,function(i){
vecteur <- do.call(c,lapply((1:input$ui_number)[-i],function(i){input[[paste0("ui_mod_choose",i)]]}))
updateSelectizeInput(session,paste0("ui_mod_choose",i),choices= modalities[!modalities %in% vecteur],selected = input[[paste0("ui_mod_choose",i)]])
})
},
ignoreNULL = FALSE)
}
)
observeEvent({
input$ui_num
},
{
sapply(1:nput$ui_num,function(i){
updateSelectizeInput(session,paste0("ui_mod_choose",i),choice= modalities,selected=NULL)
})
}
)
}
)
runApp(app)

You could have a single observe() instead of multiple observeEvent():
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui"))
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
for (i in seq_len(input$ui_number)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = modalities, multiple = TRUE)
}
return(output)
})
# Remove selected modalities from other select lists
observe({
n <- isolate(input$ui_number)
for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
})
}
runApp(shinyApp(ui, server))

Related

How to render a list of dataframes as tables to show as output in Shiny

I am working in a shiny app to compare multiple items according to an input defined by the user. The code works fine but I have an issue. I do not know what function I should apply in order to display the results of some computing as tables in the right side of the app. The code of the app is next:
library(shiny)
library(shinydashboard)
#Function
compute <- function(firstitem,seconditem)
{
Sum <- firstitem+seconditem
Difference <- firstitem+seconditem
Product <- firstitem*seconditem
Ratio <- firstitem/seconditem
Res <- data.frame(C1=Sum,C2=Difference,C3=Product,C4=Ratio)
return(Res)
}
#App
ui = shinyUI(fluidPage(
titlePanel("Compare"),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items to compare?",
min = 1, max = 5, value = 1),
uiOutput("period_cutpoints"),
uiOutput("period_cutpoints2"),
actionButton("submit", "Submit")
),
mainPanel(
textOutput("numitems"),
textOutput("cutpoints")
)
)
))
server = shinyServer(function(input, output, session) {
output$period_cutpoints<-renderUI({
req(input$numitems)
lapply(1:(input$numitems), function(i) {
numericInput(inputId=paste0("firstitem",i),
label=paste0("Enter the value of first item ", i, ":"),value = 0)
})
})
output$period_cutpoints2<-renderUI({
req(input$numitems)
lapply(1:(input$numitems), function(i) {
numericInput(inputId=paste0("seconditem",i),
label=paste0("Enter the value of second item ", i, ":"),value = 0)
})
})
seldates <- reactiveValues(x=NULL)
observeEvent(input$submit, {
seldates$x <- list()
lapply(1:(input$numitems), function(i) {
seldates$x[[i]] <- compute(firstitem = input[[paste0("firstitem", i)]],seconditem = input[[paste0("seconditem", i)]])
})
})
output$cutpoints <- renderText({as.character(seldates$x)})
})
shinyApp(ui = ui, server = server)
It is working but my issue is that I do not know how to set the content of seldates, which are dataframes, as tables that should appear one after another. This task is done with output$cutpoints but I can not get them as Tables:
Does anybody know how can I fix this issue? Many thanks!
Try this
library(shiny)
library(shinydashboard)
library(DT)
#Function
compute <- function(firstitem,seconditem)
{
Sum <- firstitem+seconditem
Difference <- firstitem+seconditem
Product <- firstitem*seconditem
Ratio <- firstitem/seconditem
Res <- data.frame(C1=Sum,C2=Difference,C3=Product,C4=Ratio)
return(Res)
}
#App
ui = shinyUI(fluidPage(
titlePanel("Compare"),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items to compare?",
min = 1, max = 5, value = 1),
uiOutput("period_cutpoints"),
uiOutput("period_cutpoints2"),
actionButton("submit", "Submit")
),
mainPanel(
textOutput("numitems"),
textOutput("cutpoints"),
uiOutput("t1")
)
)
))
server = shinyServer(function(input, output, session) {
output$period_cutpoints<-renderUI({
req(input$numitems)
lapply(1:(input$numitems), function(i) {
numericInput(inputId=paste0("firstitem",i),
label=paste0("Enter the value of first item ", i, ":"),value = i)
})
})
output$period_cutpoints2<-renderUI({
req(input$numitems)
lapply(1:(input$numitems), function(i) {
numericInput(inputId=paste0("seconditem",i),
label=paste0("Enter the value of second item ", i, ":"),value = i+i)
})
})
seldates <- reactiveValues(x=NULL)
observeEvent(input$submit, {
seldates$x <- list()
lapply(1:(input$numitems), function(i) {
seldates$x[[i]] <- compute(firstitem = input[[paste0("firstitem", i)]],seconditem = input[[paste0("seconditem", i)]])
})
})
output$cutpoints <- renderText({as.character(seldates$x)})
observeEvent(input$submit, {
lapply(1:(input$numitems), function(i) {
output[[paste0("table",i)]] <- renderDT(seldates$x[[i]])
})
output$t1 <- renderUI({
tagList(
lapply(1:(input$numitems), function(i) {
DTOutput(paste0("table",i))
})
)
})
})
})
shinyApp(ui = ui , server = server)

reset selectizeInputs each time I modify a numericInput in RShiny

I'm learning shiny and working with a numericInput connected to many selectizeInputs.
if the numeric input equals to 1 or 2, I would like to create respectively 1 and 2 selectizeInputs and select the "i"th modality of a vector called "modalities" for each selectizeInput EDIT : and that choices = modalities[i] only (and not modalities)
if the numeric input equals to 3 or 4, I would like to create respectively 3 and 4 selectizeInputs which are connected with each other (with choices = modalities). In other words : if an item is selected in one of the selectizeinputs i would like that it disappears from the other selectizeinputs' choices.
In addition (and this is what I have trouble with) I would like to "reset" all the selected SelectizeInputs each time I modify the numericInput. I tried with the observeEvent below and I tried to use an isolate(input$ui_number) but I did not find any solution to my question because i don't understand how to do it... !
Thank you for your help !
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui")
)
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
for (i in seq_len(input$ui_number)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = modalities, multiple = TRUE)
}
return(output)
})
# if input$ui_number is modified to 3 or 4 : set selected to NULL ##### NOT WORKING
observeEvent({input$ui_number},
{
n <- input$ui_number
if(n%in%c(3,4)){
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),selected=NULL)
}
}
}
)
observe({
n <- input$ui_number
if(n%in%c(1,2)){ #if n=1 or 2 => Select the "i"th modality for each selectizeInput
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = modalities[i],
selected = modalities[i]
)
}
} else{ # if n=3 or 4 => Remove selected modalities from other select lists
for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
}
})
}
runApp(shinyApp(ui, server))
This issue corresponds to the following of this one :
lapply function using a numericInput parameter around an observeEvent in RShiny
EDIT2 : new try thanks to #Aurèle 's tip.
The only problem which remains is the 1:100 in lapply which can take time to load (did not find a solution to add a reactive content such as 1:input&ui_number around a conditional panel)
library(shiny)
modalities <- LETTERS[1:10]
make_conditional_selectizeInputs <- function() {
do.call(
div,
lapply(1:100, function(i)
conditionalPanel(
condition = sprintf("%d <= input.ui_number", i),
selectizeInput(sprintf("ui_mod_choose%d", i),
label = sprintf("Modality %d", i),
choices = character(0), multiple = TRUE, selected = NULL)
)
)
)
}
ui <- tabPanel(
"Change modalities",
uiOutput("rendernumeric"),
#numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L),
make_conditional_selectizeInputs()
)
server <- function(input, output, session) {
max <- 4
output$rendernumeric <- renderUI({
numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L)
})
n <- reactive({
n <- input$ui_number
if (is.null(n) || is.na(n) || !n >= 0) 0 else n
})
# Reset all
observeEvent(
eventExpr = n(),
handlerExpr = for (i in seq_len(max))
updateSelectizeInput(
session, sprintf("ui_mod_choose%d", i),
choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities,
selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
)
)
all_selected <- reactive({
unlist(lapply(seq_len(max), function(i)
input[[sprintf("ui_mod_choose%d", i)]]))
})
# Update available modalities
observeEvent(
eventExpr = all_selected(),
handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
x <- input[[sprintf("ui_mod_choose%d", i)]]
other_selected <- setdiff(all_selected(), x)
updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
choices = setdiff(modalities, other_selected),
selected = x)
}
)
}
runApp(shinyApp(ui, server))
Basically, you just need one more line: selected = if (n %in% 1:2) modalities[i] else NULL whenever you regenerate your selectizeInputs.
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui"))
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
n <- input$ui_number
n <- if (is.null(n) || is.na(n) || ! n >= 0) 0 else n
for (i in seq_len(n)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = if (n %in% 1:2) modalities[i] else modalities,
multiple = TRUE,
# Add this
selected = if (n %in% 1:2) modalities[i] else NULL)
}
output
})
# Remove selected modalities from other select lists
observe({
n <- isolate(input$ui_number)
if (!n %in% 1:2) for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
})
}
runApp(shinyApp(ui, server))
(This is different enough to be a separate answer).
In https://shiny.rstudio.com/articles/dynamic-ui.html, four different approaches to a dynamic UI in Shiny are suggested, ordered by difficulty:
The conditionalPanel function, which is used in ui.R and wraps a set of UI elements that need to be dynamically shown/hidden.
The renderUI function, which is used in server.R in conjunction with the uiOutput function in ui.R, lets you generate calls to UI functions and make the results appear in a predetermined place in the UI.
The insertUI and removeUI functions, which are used in server.R and allow you to add and remove arbitrary chunks of UI code (all independent from one another), as many times as you want, whenever you want, wherever you want.
Use JavaScript to modify the webpage
Your attempts use the second approach, this answer uses the first one (though it should be doable with any of them):
library(shiny)
modalities <- LETTERS[1:10]
max <- 4L
First, a helper function to build the UI. The number of selectizeInputs is no longer dynamic but fixed to max, and they're alternatively shown/hidden based on input$ui_number:
make_conditional_selectizeInputs <- function(max) {
do.call(
div,
lapply(seq_len(max), function(i)
conditionalPanel(
condition = sprintf("%d <= input.ui_number", i),
selectizeInput(sprintf("ui_mod_choose%d", i),
label = sprintf("Modality %d", i),
choices = character(0), multiple = TRUE, selected = NULL)
)
)
)
}
ui <- tabPanel(
"Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1L, max = max, value = 1L),
make_conditional_selectizeInputs(max)
)
The server function has two reactive expressions that help modularize code but are not essential to its logic (n() and all_expected()).
There is no longer a renderUI() (the selectizeInputs are already generated once and for all).
There is an observeEvent() that takes a dependency on input$ui_number and resets all selections and choices when it changes.
The last observeEvent() takes a dependency on all input$ui_mod_choose[i] and updates all the choices whenever there is a new selection.
server <- function(input, output, session) {
n <- reactive({
n <- input$ui_number
if (is.null(n) || is.na(n) || !n >= 0) 0 else n
})
# Reset all
observeEvent(
eventExpr = n(),
handlerExpr = for (i in seq_len(max))
updateSelectizeInput(
session, sprintf("ui_mod_choose%d", i),
choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities,
selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
)
)
all_selected <- reactive({
unlist(lapply(seq_len(max), function(i)
input[[sprintf("ui_mod_choose%d", i)]]))
})
# Update available modalities
observeEvent(
eventExpr = all_selected(),
handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
x <- input[[sprintf("ui_mod_choose%d", i)]]
other_selected <- setdiff(all_selected(), x)
updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
choices = setdiff(modalities, other_selected),
selected = x)
}
)
}
Essentially it differs from the second approach (with renderUI) in that it removes part of the dependency between input$ui_number and the input$ui_mod_choose[i], at least when they're generated (but there's a residual dependency when they're reset because of updateSelectizeInput. I'm not completely clear why I could make it work with this approach and not with renderUI though).
runApp(shinyApp(ui, server))
This is a screenshot of the reactlog, though it doesn't show the whole picture, because of the necessary impurity of updateSelectizeInput() that mixes the UI and server logics, and creates circular dependencies that can be tricky to reason about:

many selectize inputs in RShiny connected with each other

I'm quite a beginner in R Shiny and I would like to create many multiple selectize inputs which are connected with each other. In other words : if an item is selected in one of the selectizeinputs i would like that it disappears from the other selectizeinputs' choices.
Below is an example of what i want (does not work)
modalities <- LETTERS[1:10]
library(shiny)
app <- shinyApp(
ui = tabPanel("Change modalities",
selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices=NULL, multiple = TRUE),
selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
),
server = function(input, output, session) {
observe({
updateSelectizeInput(session,"ui_mod_choose1",choices= modalities)
updateSelectizeInput(session,"ui_mod_choose2",choices= modalities)
updateSelectizeInput(session,"ui_mod_choose3",choices= modalities)
})
}
)
runApp(app)
EDIT : Here is a solution based on Bertil Nestorius' answer
modalities <- LETTERS[1:10]
library(shiny)
app <- shinyApp(
ui = tabPanel("Change modalities",
numericInput("ui_number", label="Number of modalities",min = 1, max = 4, value=3),
uiOutput("renderui")
),
server = function(input, output, session) {
output$renderui <- renderUI({
output = tagList()
for(i in 1:input$ui_number){
output[[i]] = tagList()
output[[i]][[1]] = selectizeInput(paste0("ui_mod_choose",i), label=paste0("Modality ",i),choices=modalities, multiple = TRUE)
}
return(output)
})
lapply(
X = 1:100, ####### QUESTION HERE
FUN = function(j){
observeEvent({
input[[paste0("ui_mod_choose",j)]]
},
{
sapply(1:input$ui_number,function(i){
vecteur <- do.call(c,lapply((1:input$ui_number)[-i],function(i){input[[paste0("ui_mod_choose",i)]]}))
updateSelectizeInput(session,paste0("ui_mod_choose",i),choices= modalities[!modalities %in% vecteur],selected = input[[paste0("ui_mod_choose",i)]])
})
},
ignoreNULL = FALSE)
}
)
observeEvent({
input$ui_num
},
{
sapply(1:nput$ui_num,function(i){
updateSelectizeInput(session,paste0("ui_mod_choose",i),choice= modalities,selected=NULL)
})
}
)
}
)
runApp(app)
The only problem I have left is on the following line :
X = 1:100, ####### QUESTION HERE
See this issue for more information : lapply function using a numericInput parameter around an observeEvent in RShiny
To have them all interconnected I would do something like this
modalities <- LETTERS[1:10]
library(shiny)
app <- shinyApp(
ui = tabPanel("Change modalities",
selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices=NULL, multiple = TRUE),
selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
),
server = function(input, output, session) {
observe({
updateSelectizeInput(session,"ui_mod_choose1",choices= modalities)
updateSelectizeInput(session,"ui_mod_choose2",choices= modalities)
updateSelectizeInput(session,"ui_mod_choose3",choices= modalities)
})
observeEvent({
input$ui_mod_choose2
input$ui_mod_choose3
},
{
updateSelectizeInput(session,"ui_mod_choose1",choices= modalities[!modalities %in% c(input$ui_mod_choose2,input$ui_mod_choose3)],selected = input$ui_mod_choose1)
},
ignoreNULL = FALSE)
observeEvent({
input$ui_mod_choose1
input$ui_mod_choose3
},
{
updateSelectizeInput(session,"ui_mod_choose2",choices= modalities[!modalities %in% c(input$ui_mod_choose1,input$ui_mod_choose3)],selected = input$ui_mod_choose2)
},
ignoreNULL = FALSE)
observeEvent({
input$ui_mod_choose2
input$ui_mod_choose1
},
{
updateSelectizeInput(session,"ui_mod_choose3",choices= modalities[!modalities %in% c(input$ui_mod_choose2,input$ui_mod_choose1)],selected = input$ui_mod_choose3)
},
ignoreNULL = FALSE)
}
)
runApp(app)
Something like this?
rm(list = ls())
library(shiny)
modalities <- LETTERS[1:10]
app <- shinyApp(
ui = tabPanel("Change modalities",
selectizeInput("ui_mod_choose1", label=paste0("Modality 1"),choices= modalities, multiple = TRUE),
selectizeInput("ui_mod_choose2", label=paste0("Modality 2"),choices=NULL, multiple = TRUE),
selectizeInput("ui_mod_choose3", label=paste0("Modality 3"),choices=NULL, multiple = TRUE)
),
server = function(input, output, session) {
observe({
updateSelectizeInput(session,"ui_mod_choose2",choices = modalities[!modalities%in% input$ui_mod_choose1])
})
observe({
updateSelectizeInput(session,"ui_mod_choose3",choices = modalities[!modalities %in% c(input$ui_mod_choose1,input$ui_mod_choose2)])
})
}
)
runApp(app)

R Shiny : dynamic number of tables within a tab

first I know there is a lot of threads covering my problem, I read them all, but I did not manage to do it. I got a list of 10 data.frame which I built through the following code :
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
I want the user to enter n, the number of tables he wants to see. And then display n random tables from the list_of_df. I want to display those tables inside tabs. Here is what I did, I grabbed some ideas here and there, but obviously it does not work and I do not know why.
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = "numput",label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[[index]]
})
size<-reactive({
length(random_tables())
})
for (i in 1:size()) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
}
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', 1: nTabs), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui, server)
So, if you see what I should do ...
Here is a working version:
library(shiny)
# ui function
ui = pageWithSidebar(
headerPanel('Dynamic Tabs'),
sidebarPanel(
numericInput(inputId = 'numput',label = "number of tables",value = 1,min = 1,max = 5)
),
mainPanel(
uiOutput('mytabs')
)
)
# server function
server = function(input, output, session){
list_of_df=list()
for (i in seq(1,10)){
number_row=sample(seq(5,10),size = 1)
num=seq(1,number_row)
val=sample(x = letters,size = number_row,replace = TRUE )
df=data.frame(num=num,
val=val)
rownames(df)=NULL
list_of_df[[i]]=df
}
random_tables<- reactive({
index=sample(seq(1,10),size = input$numput,replace=FALSE)
list_of_df[index]
})
size<-reactive({
input$numput
})
observe({
lapply(seq_len(size()), function(i) {
local({
my_i <- i
tablename <- paste("table_", my_i, sep="")
output[[tablename]] <- renderTable({
random_tables()[[i]]
})
})
})
})
output$mytabs = renderUI({
nTabs = size()
myTabs = lapply(paste0('table_', seq_len(nTabs)), function(x){
tabPanel(x, tableOutput(x))
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui=ui,server=server)
A couple issues, you subset the list with double brackets, but it isn't working like you think it is, you need single brackets. Next when you select a single table random_table() is a data.frame so when you call length you get 2, the number of columns. So just use the input$numput for size() since they are the same anyways. Also, I put the dynamic output in an observe so that it can access the reactive size(). A small thing, but I used seq_len instead of 1:aNumber since it is more robust.
Hope this helps

Shiny R renderPrint in loop usinf RenderUI only update the output

I am trying to dynamically render multiple text output from multiple text input. I tried to use this very helpfull example and this one too.
This conversation is also helpfull.
But when I try to adapt this examples on the following script, I have a problem of output update. Apparently, only the last element was read and updated. It's probably a reactivity problem but it seems to be difficult to associate reactive{()} and renderUI{()}functions.
rm(list = ls())
library(shiny)
creatDataElem <- function(ne, input) {
x1 <- lapply(1:ne, function(i) {
textInput(paste0("elemName", i),
label = h4(strong("Name of dataset element")),
value = "")
})
return(x1)
}
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3)
,
conditionalPanel(
condition = "input.elemNb == 1",
creatDataElem(1)
),
conditionalPanel(
condition = "input.elemNb == 2",
creatDataElem(2)
),
conditionalPanel(
condition = "input.elemNb == 3",
creatDataElem(3)
)
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
max_elem <- 3
# Name
output$nameElem <-renderUI({
nameElem_output_list <- lapply(1:input$elemNb, function(i) {
elemName <- paste0("elemName", i)
tags$div(class = "group-output",
verbatimTextOutput(elemName)
)
})
do.call(tagList, nameElem_output_list)
})
for (i in 1:max_elem) {
local({
force(i)
my_i <- i
elemName <- paste0("elemName", my_i)
output[[elemName]] <- renderPrint(input[[elemName]])
})
}
}
runApp(list(ui = ui, server = server))
The idea with a reactive({}) function is to add an independant object (a function in this case) like:
nameElem <- reactive({
if (input$goElem == 0) {
return()
} else {
isolate({
if (is.null(input$elemName)) {
return()
} else if (test(input$elemName)) {
return("TEST RESULT")
} else {
return(input$elemName)
}
})
}
})
and to use renderUI on this object (with an ActionButton).
So, if someone knows why the output does not return the good object...
I think one of your problems is that your creatDataElem function is such that when it is called with argument ne=3, the first and second textInput elements are created again (and their value "lost").
Anyway, I think one solution would be to create those textInput elements as an "uiOutput".
You'll find a possible solution below which (I think) does what you want.
Lise
rm(list = ls())
library(shiny)
ui = (fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("elemNb",
"Number of elements", value = 1, min = 1,
max = 3),
uiOutput("myUI")
),
mainPanel(
uiOutput("nameElem")
)
)
)
)
server = function(input, output, session) {
output$myUI=renderUI({
w=""
for (i in 1:input$elemNb){
w=paste0(w,
textInput(paste0("elemName",i),label='Name of dataset element'))
}
HTML(w)
})
output$nameElem <-renderUI({
elems=c("<div>")
for(i in 1:input$elemNb){
elems=paste(elems,"</div><div>",input[[paste0("elemName",i)]])
}
elems=paste0(elems,"</div>")
HTML(elems)
})
}
runApp(list(ui = ui, server = server))
Found a solution:
library(readr)
library(dplyr)
library(shiny)
df <- data.frame(symbol = 1:10)
uiOutput("myUI")
createUI <- function(dfID, symbol) {
div(class="flex-box",paste0(symbol, " - 10"))
}
output$myUI <- renderUI({
w <- lapply(seq_len(nrow(df)), function(i) {
createUI(i, df[i,"symbol"])
})
do.call(fluidPage,w)
})

Resources