add/remove fields in shiny web app without changing choice - r

Question

I have the following web application example:
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Add Features"),
sidebarPanel(width=4,
fluidRow(column(12,
h3('Features'),
uiOutput('uiOutpt')
)), # END fluidRow
fluidRow(
column(4,div()),
column(4,actionButton("add", "Add!")),
column(4,actionButton("remove", "Remove!")),
column(4,actionButton('goButton',"Analyze"))
) # END fluidRow
), # END sidebarPanel
mainPanel(
textOutput("text2"),
tableOutput('tbl')
)
))
server <- shinyServer(function(input, output) {
features <- reactiveValues(renderd=c(1),
conv=c(50),
inlabels=c('A'),
outlabels=c('B'))
df <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
data.frame(Variable=input[[vn]], Value=input[[fv]] )
})
do.call(rbind,out)
})
output$nText <- renderText({
ntext()
})
output$text2 <- renderText({
paste(sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")))
})
output$tbl <- renderTable({
df()
})
# Increment reactive values array used to store how may rows we have rendered
observeEvent(input$add,{
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
vo <- paste0('OutLabel',i)
data.frame(inlabels=input[[vn]],outlabels=input[[vo]], conv=input[[fv]] )
})
df<-do.call(rbind,out)
print(df)
features$inlabels <- c(as.character(df$inlabels),' ')
features$outlabels <- c(as.character(df$outlabels),' ')
print(c(features$inlabels,features$outlabels))
features$renderd <- c(features$renderd, length(features$renderd)+1)
print(features$renderd)
print(names(features))
features$conv<-c(df$conv,51-length(features$renderd))
})
observeEvent(input$remove,{
features$renderd <- features$renderd[-length(features$renderd)]
})
# If reactive vector updated we render the UI again
observe({
output$uiOutpt <- renderUI({
# Create rows
rows <- lapply(features$renderd,function(i){
fluidRow(
# duplicate choices make selectize poop the bed, use unique():
column(4, selectizeInput(paste0('InLabel',i),
label = 'Input Name',selected=features$inlabels[i-1],
choices=unique(c(features$inlabels[i-1],features$outlabels[!features$outlabels %in% features$inlabels])),
options = list(create = TRUE))),
column(4, sliderInput(paste0('numInp_',i), label="Conversion",min = 0, max = 100, value = features$conv[i-1])),
column(4, selectizeInput(paste0('OutLabel',i),
label = "Output Name", selected=features$outlabels[i-1],
choices=unique(c(features$inlabels,features$outlabels)),
options = list(create = TRUE)))
)
})
do.call(shiny::tagList,rows)
})
})
})
shinyApp(ui=ui,server=server)
The problem is that each time, when we add a new fluidRow by clicking on the buton "add", the chosen values in the previous fluidRow are refreshed. I would like to change that. If I chose for instance, inputName='B', Conversion=50, outputName='A', I would like them to be constant even thought I have add or delete rows.
I have tried this but it didn't work:
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Add Features"),
sidebarPanel(width=4,
fluidRow(column(12,
h3('Features'),
uiOutput('uiOutpt')
)), # END fluidRow
fluidRow(
column(4,div()),
column(4,actionButton("add", "Add!")),
column(4,actionButton("remove", "Remove!")),
column(4,actionButton('goButton',"Analyze"))
) # END fluidRow
), # END sidebarPanel
mainPanel(
textOutput("text2"),
tableOutput('tbl')
)
))
server <- shinyServer(function(input, output) {
features <- reactiveValues(renderd=c(1),
conv=c(50),
inlabels=c('A'),
outlabels=c('B'))
df <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
data.frame(Variable=input[[vn]], Value=input[[fv]] )
})
do.call(rbind,out)
})
output$nText <- renderText({
ntext()
})
output$text2 <- renderText({
paste(sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")))
})
output$tbl <- renderTable({
df()
})
# Increment reactive values array used to store how may rows we have rendered
observeEvent(input$add,{
out <- lapply(features$renderd,function(i){
fv <- paste0('numInp_',i)
vn <- paste0('InLabel',i)
vo <- paste0('OutLabel',i)
data.frame(inlabels=input[[vn]],outlabels=input[[vo]], conv=input[[fv]] )
})
df<-do.call(rbind,out)
print(df)
features$inlabels <- c(as.character(df$inlabels),' ')
features$outlabels <- c(as.character(df$outlabels),' ')
print(c(features$inlabels,features$outlabels))
features$renderd <- c(features$renderd, length(features$renderd)+1)
print(features$renderd)
print(names(features))
features$conv<-c(df$conv,51-length(features$renderd))
})
observeEvent(input$remove,{
features$renderd <- features$renderd[-length(features$renderd)]
})
# If reactive vector updated we render the UI again
observe({
output$uiOutpt <- renderUI({
# Create rows
rows <- lapply(features$renderd,function(i){
fluidRow(
# duplicate choices make selectize poop the bed, use unique():
column(4, selectizeInput(paste0('InLabel',i),
label = 'Input Name',selected=features$inlabels[i],
choices=c('A','B','C'),
options = list(create = TRUE))),
column(4, sliderInput(paste0('numInp_',i), label="Conversion",min = 0, max = 100, value = features$conv[i])),
column(4, selectizeInput(paste0('OutLabel',i),
label = "Output Name", selected=features$outlabels[i],
choices=c('A','B','C'),
options = list(create = TRUE)))
)
})
do.call(shiny::tagList,rows)
})
})
})
shinyApp(ui=ui,server=server)
I am sure that it's very easy to figure it out but I have no idea.
Thank you for your response.

Answer 1

I have found the answer of my question. I think that it could be useful for someone that's why I post the follwing example:
library(shiny)
ui <- shinyUI(
fluidPage(
actionButton("addFilter", "Add filter", icon=icon("plus", class=NULL, lib="font-awesome")),
uiOutput("filterPage1")
)
)
server <- function(input, output){
i <- 0
observeEvent(input$addFilter, {
i <<- i + 1
output[[paste("filterPage",i,sep="")]] = renderUI({
list(
fluidPage(
fluidRow(
column(6, selectInput(paste("filteringFactor",i,sep=""), "Choose factor to filter by:",
choices=c("factor A", "factor B", "factor C"), selected="factor B",
width="100%")),
column(6, actionButton(paste("removeFactor",i,sep=""), "",
icon=icon("times", class = NULL, lib = "font-awesome"),
onclick = paste0("Shiny.onInputChange('remove', ", i, ")")))
)
),
uiOutput(paste("filterPage",i + 1,sep=""))
)
})
})
observeEvent(input$remove, {
i <- input$remove
output[[paste("filterPage",i,sep="")]] <- renderUI({uiOutput(paste("filterPage",i + 1,sep=""))})
})
}
shinyApp(ui, server)
Have a nice day.