observeEvent v insertUI generované ve smyčce

hlasů
0

Když jsem se vytvořit nové objekty s insertUI v reaktivním způsobem, všichni pozorovatelé, které jsem vytvořit práci naprosto v pořádku, jak můžete vidět v následujícím dummy kód:

library(shiny)

# Define the UI
ui <- fluidPage(
  actionButton(adder, Add),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues()

  rv$counter <- 0

  observeEvent(input$adder,{
    rv$counter <- rv$counter + 1

    add <- sprintf(%03d,rv$counter)

    filterId <- paste0('adder_', add)
    divId <- paste0('adder_div_', add)
    elementFilterId <- paste0('adder_object_', add)
    removeFilterId <- paste0('remover_', add)

    insertUI(
      selector = '#placeholder',
      ui = tags$div(
        id = divId,
        actionButton(removeFilterId, label = Remove filter, style = float: right;),
        textInput(elementFilterId, label = paste0(Introduce text #,rv$counter), value = )
      )
    )

    # Observer that removes a filter
    observeEvent(input[[removeFilterId]],{
      removeUI(selector = paste0(#, divId))
    })
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Nicméně, když jsem vytvořit stejné objekty pomocí smyčky for, tak pozorovatelé posledního vytvořeného objektu Zdá se, že fungují, jak můžete vidět na následujícím příkladu:

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton(adder, Add),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues()

  rv$counter <- 0
  rv$init <- T

  observeEvent(rv$init, {
    if(!rv$init) return(NULL)

    rv$init <- F

    for(i in 1:3) {
      rv$counter <- rv$counter + 1

      add <- sprintf(%03d,rv$counter)

      #prefix <- generateRandomString(1,20)
      filterId <- paste0('adder_', add)
      divId <- paste0('adder_div_', add)
      elementFilterId <- paste0('adder_object_', add)
      removeFilterId <- paste0('remover_', add)

      insertUI(
        selector = '#placeholder',
        ui = tags$div(
          id = divId,
          actionButton(removeFilterId, label = Remove filter, style = float: right;),
          textInput(elementFilterId, label = paste0(Introduce text #,rv$counter), value = )
        )
      )

      # Observer that removes a filter
      observeEvent(input[[removeFilterId]],{
        removeUI(selector = paste0(#, divId))
      })
    }
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Co dělám špatně?

Může to být v souvislosti s líné vyhodnocování?

Položena 20/10/2018 v 12:36
zdroj uživatelem
V jiných jazycích...                            


2 odpovědí

hlasů
1

Pro smyček v R všichni běží ve stejném rozsahu, což znamená, že proměnné jsou definovány ve smyčce budou sdílet všechny iterace. To je otázka, pokud vytvořit funkci v každé iteraci smyčky, který přistupuje k této proměnné, a předpokládám, že to bude jedinečné pro každou iteraci.

Zde je jednoduchý demo:

counter <- 0; funcs <- list()
for (i in 1:3) {
    counter <- counter + 1
    funcs[[i]] <- function() print(counter)
}
for (i in 1:3) {
    funcs[[i]]()  # prints 3 3 3
}

V tomto Shiny aplikaci se observeEventpsovod vstoupí do lokální proměnné add, a že nedojde k volání až po dobu cyklu je u konce, a addje ve své konečné hodnoty.

Existuje několik způsobů, jak získat kolem tohoto a vytvořit jedinečný prostor pro jednotlivé smyčky iterace. Můj oblíbený je použít applyfunkci nahradit pro smyčce. Pak každá applyiterace probíhá v jeho vlastní funkce, takže lokální proměnné jsou jedinečné každou položku.

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output) {
  rv <- reactiveValues(counter = 0)

  lapply(1:3, function(i) {
    isolate({
      rv$counter <- rv$counter + 1

      add <- sprintf("%03d",rv$counter)

      #prefix <- generateRandomString(1,20)
      filterId <- paste0('adder_', add)
      divId <- paste0('adder_div_', add)
      elementFilterId <- paste0('adder_object_', add)
      removeFilterId <- paste0('remover_', add)

      insertUI(
        selector = '#placeholder',
        ui = tags$div(
          id = divId,
          actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
          textInput(elementFilterId, label = paste0("Introduce text #",rv$counter), value = "")
        )
      )
    })

    # Observer that removes a filter
    observeEvent(input[[removeFilterId]],{
      removeUI(selector = paste0("#", divId))
    })
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Všimněte si, že jsem také odstranil vnější observeEventprotože funkce server běží na inicializaci relace tak jako tak.

Odpovězeno 20/10/2018 v 23:56
zdroj uživatelem

hlasů
0

Jsem našel řešení, ale myslím, že by mělo být provedeno v účinnějším způsobem.

Vypadá to, že tento problém se týká líné vyhodnocování, takže pouze poslední objekt vytvořený má observeEvent práci. Tak jsem se rozhodl vytvořit pro každou iteraci smyčky nové proměnné s použitím eval:

library(shiny)

# Define the UI
ui <- fluidPage(
  #actionButton("adder", "Add"),
  tags$div(id = 'placeholder')
)


# Define the server code
server <- function(input, output, session) {
  rv <- reactiveValues()

  rv$counter <- 0
  rv$init <- T

  observeEvent(rv$init, {
    if(!rv$init) return(NULL)

    for(i in 1:4) {
      rv$counter <- rv$counter + 1

      add <- sprintf("%03d",rv$counter)

      coding <- paste0(
        "divId",add," <- paste0('adder_div_', add);
        elementFilterId",add," <- paste0('adder_object_', add);
        removeFilterId",add," <- paste0('remover_', add);
        insertUI(
          selector = '#placeholder',
          ui = tags$div(
            id = divId",add,",
            actionButton(inputId=removeFilterId",add,", label = \"Remove filter\", style = \"float: right;\"),
            textInput(inputId=elementFilterId",add,", label = paste0(\"Introduce text #\",rv$counter), value = '')
          )
        );

        # Observer that removes a filter
        observeEvent(input[[removeFilterId",add,"]],{
          removeUI(selector = paste0(\"#\", divId",add,"))
        })
        "
      )

      eval(parse(text=coding))
    }

    rv$init <- F
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))

Jak je možno vidět, každý smyčka má nové proměnné, takže problém opožděného vyhodnocení je vyřešen.

Co bych chtěl nyní je, jestli se to dá udělat v účinnějším způsobem.

Odpovězeno 20/10/2018 v 15:02
zdroj uživatelem

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more