добавления/удаления полей в блестящей веб-приложение без изменения выбора

Question

У меня есть следующий пример веб-приложения:

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) 

Проблема заключается в том, что каждый раз, когда мы добавим новый fluidRow, нажав на Бутон «добавить» , выбранные значения в предыдущей жидкости Row обновляются. Я хотел бы изменить это. Если я выбрал, например, inputName = 'B', Conversion = 50, outputName = 'A', я бы хотел, чтобы они были постоянными, даже если бы я добавлял или удалял строки.

Я попытался это, но он не работает:

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) 

Я уверен, что это очень легко понять это, но я понятия не имею.

Благодарим за отзыв.

Answer 1

Я нашел ответ на свой вопрос. Я думаю, что это может быть полезным для кого-то, именно поэтому я отправляю follwing пример:

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) 

имеют хороший день.