Shiny：動的フォーム/ ui：リスト内の最後のオブザーバがトリガしないremoveUI

Question

ユーザが（actionButtonを介して）いくつかの条件を追加し、それらの条件の値を選択できる動的フォームを構築しようとしています。彼が選択を終えると、彼は計算を開始するかもしれません。 すべての条件は「削除」ボタンで削除できます。

これは、関連する削除ボタンに反応しない最後に挿入されたコンポーネントを除いて、すべて正常に機能します。 最後のコンポーネントは、[条件の追加]ボタンがクリックされた場合にのみ削除されます。

これはバグですか、私の間違いを指摘できますか？

私はコンポーネントを構築するためにrenderUIでobserveEventを使用しています：server.R

で

observeEvent(input$go, { 

output$ui <- renderUI({ 

    rows <- lapply(names(components),buildComponent) 

    res = do.call(fluidRow, rows) 

}) 

makeObservers() 

}) 

makeObserversは、すべてのコンポーネントのためのobserveEvent閉鎖作成します。

makeObservers <- eventReactive(input$go, { 

IDs <- names(components) 

new_ind <- !(IDs %in% vals$y)  

res <- lapply(IDs[new_ind], function (x) { 

    observeEvent(input[[paste0("rmv", x)]], { 

    if(components[[x]] == "Main1") removeComponent(x) 
    }) 
}) 
} , 
ignoreNULL = F, ignoreInit = F) 

を見つけてください。実例

library(shiny) 
library(shinythemes) 

criterias <- c("Criteria 1", "Criteria 2", "Criteria 3", "Criteria 4") 
components <<- list() 
counter <<- 0 

buildComponent <- function(val) { 
    idselect = paste0("select", val) 
    idremove <- paste0("rmv", val) 
    div(
    selectInput(idselect, "criteria :", criterias, criterias[0]), 
    actionButton(idremove, paste0("X", val),icon = icon("remove"), size = "small") 
) 
} 

removeComponent <- function(x) { 
    print(paste0("Removing" ,x)) 
    xpath1 = paste0("div:has(> #select", x ,")") 
    xpath2 = paste0("div:has(> #rmv", x ,")") 
    removeUI(
    selector = xpath1, multiple = T#, immediate=T 
) 
    removeUI(
    selector = xpath2, multiple = T#, immediate=T 
) 
    components[[as.character(x)]] <<- NULL 
} 

ui <- shinyUI(fluidPage(
        sidebarPanel(
         actionButton("go", "Criteria", icon = icon("plus-circle"), 
            size = "small"), 
         uiOutput("ui") 
        ), 
        mainPanel(
         actionButton("activate", "show cpts"), 
         textOutput('show_components') 
        ) 
)) 

server <- shinyServer(function(input, output, session) { 
    # Keep track of which observer has been already created 
    vals <- reactiveValues(y = NULL) 

    makeObservers <- eventReactive(input$go, { 
    IDs <- names(components) 
    new_ind <- !(IDs %in% vals$y) 
    print("new_ind") 
    print(IDs[new_ind]) 
    # update reactive values 
    vals$y <- names(components) 
    res <- lapply(IDs[new_ind], function (x) { 
     observeEvent(input[[paste0("rmv", x)]], { 
    print(paste0("rmv", x)) 
    print(components[[x]]) 
    if(components[[x]] == "Main1") removeComponent(x) 
     }) 
    }) 
    } , ignoreNULL = F, ignoreInit = F) 

    observeEvent(input$go, { 
    output$ui <- renderUI({ 
     print(counter) 
     counter <<- counter + 1 
    components[[as.character(counter)]] <<- "Main1" 
    print("adding component : ") 
    print(paste0(names(components),collapse = ";")) 
    rows <- lapply(names(components),buildComponent) 
    res = do.call(fluidRow, rows) 
    }) 
    makeObservers() 
    }) 

    observeEvent(input$activate, { 
    output$show_components <- renderPrint({ 
     components 
    }) 
    }) 
}) 

shinyApp(ui, server) 

Mike Wiseの偉大な発言のおかげで、私は正確な問題を見つけることができました：（Mikeの答えを見てください）。ここではいくつかのコードは次のとおりです。

library(shiny) 
library(shinythemes) 

criterias <- c("Criteria 1", "Criteria 2", "Criteria 3", "Criteria 4") 
components <<- list() 
counter <<- 0 

buildComponent <- function(val) { 
    idselect = paste0("select", val) 
    idremove <- paste0("rmv", val) 
    div(
    selectInput(idselect, "criteria :", criterias, criterias[0]), 
    actionButton(idremove, paste0("X", val),icon = icon("remove"), size = "small") 
) 
} 

removeComponent <- function(x) { 
    print(paste0("Removing" ,x)) 
    xpath1 = paste0("div:has(> #select", x ,")") 
    xpath2 = paste0("div:has(> #rmv", x ,")") 
    removeUI(
    selector = xpath1, multiple = T#, immediate=T 
) 
    removeUI(
    selector = xpath2, multiple = T#, immediate=T 
) 
    components[[as.character(x)]] <<- NULL 
} 

ui <- shinyUI(fluidPage(
    sidebarPanel(
    actionButton("go", "Criteria", icon = icon("plus-circle"), 
      size = "small"), 
    uiOutput("ui") 
), 
    mainPanel(
    actionButton("activate", "show cpts"), 
    textOutput('show_components') 
) 
)) 

server <- shinyServer(function(input, output, session) { 
    # Keep track of which observer has been already created 
    vals <- reactiveValues(y = NULL) 

    makeObservers <- eventReactive(input$go, { 
    IDs <- names(components) 
    new_ind <- !(IDs %in% vals$y) 
    print("new_ind") 
    print(IDs[new_ind]) 
    # update reactive values 
    vals$y <- names(components) 
    res <- lapply(IDs[new_ind], function (x) { 
     observeEvent(input[[paste0("rmv", x)]], { 
    print(paste0("rmv", x)) 
    print(components[[x]]) 
    if(components[[x]] == "Main1") removeComponent(x) 
     }) 
    }) 
    } , ignoreNULL = F, ignoreInit = F) 

    observeEvent(input$go, { 
    counter <<- counter + 1 
    components[[as.character(counter)]] <<- "Main1" 
    output$ui <- renderUI({ 
     print(counter) 
     print("adding component : ") 
     print(paste0(names(components),collapse = ";")) 
     rows <- lapply(names(components),buildComponent) 
     res = do.call(fluidRow, rows) 
    }) 
    makeObservers() 
    }) 

    observeEvent(input$activate, { 
    output$show_components <- renderPrint({ 
     components 
    }) 
    }) 
}) 

shinyApp(ui, server) 

Answer 1

[OK]を、そこにコード内のいくつかの問題があって、私はそれを理解して、意図した通りに動作させるために、いくつかの小さいながらも重要な変更をしなければなりませんでした。しかし、それは本質的に同じコードです。

変更は：

• rv$prev_componentsにrv$yを変更しました。
• はあなたの名前に新たに追加を見つけること<<-
• 追加setdiffを不要にすでにreactiveValuesを使用していたとして見て、<<-を取り除くためにreactiveValuesにあなたのcomponentsとcounter変数を入れて（これがキーでした）。
• makeObervablesを単純な関数に変更しました（とにかくeventReactiveとして使用されていません）。
• おそらく、忘れられている他の小さなものがいくつかあります。

これはコードです：

library(shiny) 
library(shinythemes) 

criterias <- c("Criteria 1", "Criteria 2", "Criteria 3", "Criteria 4") 

vals <- reactiveValues(prev_components=list(),components=list(),counter=0) 

buildComponent <- function(val) { 
    idselect = paste0("select", val) 
    idremove <- paste0("rmv", val) 
    div(
    selectInput(idselect, "criteria :", criterias, criterias[0]), 
    actionButton(idremove, paste0("X", val),icon = icon("remove"), size = "small") 
) 
} 

removeComponent <- function(x) { 
    print(paste0("Removing" ,x)) 
    xpath1 = paste0("div:has(> #select", x ,")") 
    xpath2 = paste0("div:has(> #rmv", x ,")") 
    removeUI(
    selector = xpath1, multiple = T#, immediate=T 
) 
    removeUI(
    selector = xpath2, multiple = T#, immediate=T 
) 
    vals$components[[as.character(x)]] <<- NULL 
} 

ui <- shinyUI(fluidPage(
    sidebarPanel(
    actionButton("go", "Criteria", icon = icon("plus-circle"), 
       size = "small"), 
    uiOutput("uii") 
), 
    mainPanel(
    actionButton("activate", "show cpts"), 
    textOutput('show_components') 
) 
)) 


server <- shinyServer(function(input, output, session) { 

    makeObservers <- function() { 
    IDs <- names(vals$components) 
    new_ind <- setdiff(IDs,vals$prev_components) 

    vals$prev_components <- names(vals$components) 
    res <- lapply(new_ind, function (x) { 
     observeEvent(input[[paste0("rmv", x)]], { 
     print(paste0("rmv", x)) 
     print(vals$components[[x]]) 
     if(vals$components[[x]] == "Main1") removeComponent(x) 
     }) 
    }) 
    } 

    observeEvent(input$go, { 
    print(vals$counter) 
    vals$counter <- vals$counter + 1 
    vals$components[[as.character(vals$counter)]] <- "Main1" 

    output$uii <- renderUI({ 
     print("adding component : ") 
     print(paste0(names(vals$components),collapse = ";")) 
     rows <- lapply(names(vals$components),buildComponent) 
     res = do.call(fluidRow, rows) 
    }) 
    makeObservers() 
    }) 

    observeEvent(input$activate, { 
    output$show_components <- renderPrint({ 
     vals$components 
    }) 
    }) 
}) 

shinyApp(ui, server) 

とスクリーンショット：