動態閃亮

Question

我ui.R函數添加UI元素，並收集它們的輸入的數據幀是如下所示。

library(shiny) 

shinyUI(pageWithSidebar(
    headerPanel("Add Features"), 
    sidebarPanel(width=4, 
    fluidRow( 
    column(6, selectInput("features", label = h3("Features"), 
    choices = list("Feature1","Feature2","Feature3"), selected = "Feature1")),  

    br(), 
    br(), 
    column(6, numericInput("n", label="",min = 0, max = 100, value = 50)), 
    br(), 
    column(2, actionButton("goButton", "Add!")) 
    #column(3, submitButton(text="Analyze")) 
)), 


mainPanel(
verbatimTextOutput("nText"), 
textOutput("text2") 
) 
)) 

我server.R功能如下：

library(shiny) 

shinyServer(function(input, output) { 
selFeatures <- data.frame() 
    valFeatures <- data.frame() 
    # builds a reactive expression that only invalidates 
    # when the value of input$goButton becomes out of date 
    # (i.e., when the button is pressed) 
    ntext <- eventReactive(input$goButton, { 

    selFeatures <- rbind(selFeatures,input$features) 
    valFeatures <- rbind(valFeatures,input$n) 
    paste("The variables are",input$features,input$n) 
    paste("The variables are",selFeatures,valFeatures) 
    }) 

    output$nText <- renderText({ 
    ntext() 
    }) 
    output$text2 <- renderText({ 
    paste("You have selected", input$features) 
    }) 
}) 

我想要做的就是要求用戶輸入一些變量。這裏Feature1,Feature2和Feature3。用戶必須輸入Feature1但Feature2和Feature3是可選的。因此，這裏用戶選擇一個功能，輸入其值numericInput並按下按鈕Add。當Add是選擇Feature1後按壓時，用戶可以選擇提交表單或添加使用添加按鈕特徵2和3。我最後想要用這三個變量來學習預測模型。我如何收集數據框中的所有估算信息來處理它。另外，如果可能的話已經被添加後從selectBox刪除Feature1。我想我的UI看起來像下面按添加按鈕

之前，它應該看起來像按下添加按鈕後，以下。

這裏的優點1不必在選擇框，只是一個以顯示它已被添加是好的方式。

Answer 1

我不明白爲什麼你想使用selectInputs那麼這裏設置變量值是如何從動態生成的內容訪問輸入一個普通的例子：

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('goButton',"Analyze")) 
       ) # END fluidRow 
), # END sidebarPanel 
    mainPanel(
    verbatimTextOutput("nText"), 
    textOutput("text2"), 
    tableOutput('tbl') 
) 
)) 

server <- shinyServer(function(input, output) { 
    features <- reactiveValues(renderd=c(1)) 

    ntext <- eventReactive(input$goButton, { 
    out <- lapply(features$renderd,function(i){ 
     fv <- paste0('numInp_',i) 
     vn <- paste0('Feature',i) 
     # Get input values by namw 
     sprintf('Variable: %s, Value: %5.3f',input[[vn]],input[[fv]]) 
    }) 
    do.call(paste,c(out,sep="\n")) 
    }) 

    df <- eventReactive(input$goButton, { 
    out <- lapply(features$renderd,function(i){ 
     fv <- paste0('numInp_',i) 
     vn <- paste0('Feature',i) 
     data.frame(Variable=input[[vn]], Value=input[[fv]]) 
    }) 
    do.call(rbind,out) 
    }) 

    output$nText <- renderText({ 
    ntext() 
    }) 
    output$text2 <- renderText({ 
    sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")) 
    }) 

    output$tbl <- renderTable({ 
    df() 
    }) 

    # Increment reactive values used to store how may rows we have rendered 
    observeEvent(input$add,{ 
    if (max(features$renderd) > 2) return(NULL) 
    features$renderd <- c(features$renderd, max(features$renderd)+1) 
    }) 

    # If reactive vector updated we render the UI again 
    observe({ 
    output$uiOutpt <- renderUI({ 
     # Create rows 
     rows <- lapply(features$renderd,function(i){ 
     fluidRow(
      column(6, selectInput(paste0('Feature',i), 
           label = "", 
           choices = list("Feature1","Feature2","Feature3"), 
           selected = paste0('Feature',i))), 
      column(6, numericInput(paste0('numInp_',i), label="",min = 0, max = 100, value = runif(1,max=100))) 
     ) 
     }) 
     do.call(shiny::tagList,rows) 

    }) 
    }) 
}) 

shinyApp(ui=ui,server=server) 

我只是存儲的ID動態生成內容的矢量，可以幫助我跟蹤生成的內容。要訪問這些值，我只需從存儲在矢量中的數字重新構造元素ID。

Answer 2

奧斯卡的答案是非常有用的，我要我面臨着類似的挑戰;對於無限的功能，我想出瞭如何啓用「刪除」按鈕並在按下「添加」按鈕時保留值。對於後人，這裏有我對奧斯卡的代碼修改：

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=unique(c(features$inlabels[i],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])), 
      column(4, selectizeInput(paste0('OutLabel',i), 
           label = "Output Name", selected=features$outlabels[i], 
           choices=unique(c(features$inlabels,features$outlabels)), 
           options = list(create = TRUE))) 
     ) 
     }) 
     do.call(shiny::tagList,rows) 
    }) 
    }) 
}) 

shinyApp(ui=ui,server=server)