seleccionar - IU procesada dinámicamente: cómo eliminar las antiguas variables reactivas en la segunda ejecución

seleccionar datos en r

Question

Hola héroes de desbordamiento de pila,

BREVE RESUMEN: la aplicación funciona muy bien, hasta que cambie el número ingresado en el campo de entrada. UI vuelve a renderizar bien, pero el lado del servidor falla en cosas que todavía están en la memoria, parece. Explicación detallada a continuación:

Tengo una aplicación dinámica que funciona muy bien, pero todavía estoy lidiando con algunos errores y un problema central.

El problema debe estar en algún lugar de la reactividad, pero estoy teniendo muchas dificultades para descubrir qué es lo que estoy haciendo mal. Ya he probado docenas de cosas, y ninguna de ellas funciona, o termino rompiendo la aplicación en otras áreas.

Aquí está el PROBLEMA PRINCIPAL:

La aplicación registra las acciones de clic del usuario como 1 o 0 en una lista de valores reactivos () llamada dynamicvalues_highlight_button_sf1 y los elementos se realizan dinámicamente dentro de una función de aplicación que hace que los observadores dinámicos sean los mismos que los botones dinámicos. Cuando ingresas un número, aparecen botones y todo funciona perfecto

HASTA que cambie el número en el campo de texto. -Los botones se actualizan y se representa una nueva cantidad, etc., PERO: el viejo dynamicvalues_highlight_button_sf1 y la lista dinámica todavía se están imprimiendo. No tengo ni idea de por qué los viejos resultados todavía están allí, así como los nuevos.

Entonces, en lugar de solo los nuevos resultados:

[1] "dl = 0, 0, 0, 0, 1" ## status of the current nr of elements (here its 5)
[1] "ob = 5"   ### nr of the last clicked button
[1] "-----------next click event prints the below this line-----------" 

la impresión que recibo es vieja y nueva:

[1] "dl = 0, 0, 0, 0, 1, 0" ## old results
[1] "ob = 5"
[1] "-----------next click event prints the below this line-----"
[1] "dl = 0, 0, 0, 0, 0, 0" ## new results
[1] "ob = 5"
[1] "-----------next click event prints the below this line-----"

He intentado cosas como rm(dynamicvalues_highlight_button_sf1) y rm(dynamiclist) pero solo pueden funcionar si los valores están ahí, y causar un bloqueo cuando la aplicación se inicia ya que no lo hacen.

Envolverlos dentro de if(exists("dynamicvalues_highlight_button_sf1")) { } no funciona porque existe parece no funcionar en las listas de if(exists("dynamicvalues_highlight_button_sf1")) { } reactivos. (También he intentado evaluate(need(...the variable..., "text")) y if(!is.null(...the variable...)){...} pero no todo También intenté ponerlos en diferentes lugares del servidor pero no tuve éxito. Estoy perdido y mi conocimiento de R brillante todavía es muy limitado para esta complejidad, parece.

• SEGUNDO Parte del problema

si ingreso primero es decir 5, haga clic en algo, y luego vuelva a crear botones para un número mayor que 5, es decir 6: BUTTON nr 6 funciona (se pone azul, etc.), pero los botones 1: 5 NO funcionan.

Sospecho que los dos problemas están relacionados entre sí.

La interfaz de usuario y el servidor se publican a continuación. Diviértete intentándolo antes de sumergirte en el problema si quieres.

NOTAS: - publicó el "ejemplo mínimo" pero es una aplicación bastante compleja para tener toda la funcionalidad aquí. - la aplicación real escupirá la entrada NR desde un gran paso de modelado en lugar del campo de entrada en esta demostración - anoté lo más posible para mayor claridad - dejé un poco de código de mi último intento de resolver el problema en el server.r en las líneas 18-25.

¡Gracias por cualquier ayuda que pueda ofrecer!

UI.r

library(shiny)
library(shinydashboard)
library(shinyBS)


ui <- dashboardPage(
  dashboardHeader(title = "My Test App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs", menuItem("testpage", tabName = "testpage", icon = icon("book"))
    )
  ),

  dashboardBody(
    tags$head(tags$style(HTML(''.skin-blue .content-wrapper, .right-side {background-color: #ffffff; }, ''))),


        tabItems(

  ### test page ###_________
      tabItem(tabName = "testpage",  

              h5("Enter desired nr of elements here"),
              textInput(inputId ="NrOfClusters", label = NULL , placeholder = "NULL"),

              fluidRow(
                column(2,
                       uiOutput("buttons_highlight_sf1")),

                column(1,
                    uiOutput("button_hightlight_all_sf1"),
                    uiOutput("multi_highlight"),
                    br(),
                    actionButton(inputId = "statuscheck", label = "status", style = "background-color: white")
                ))))))

SERVER.R

shinyServer = function(input, output, session) {

  ################# start functionality HOME TAB #############################  

  ### create 2 reactive environment lists
  values <- reactiveValues()
  dynamicvalues_highlight_button_sf1 <- reactiveValues()

  ### set initial state of two buttons 
  values$HL_multi_switch_sf1 <- FALSE
  values$HL_all_switch_sf1 <- FALSE 

  ### if the user types in a value, then convert it to a reactive value of this nr
  observeEvent (input$NrOfClusters, {
    isolate(values$nrofelements <- paste0(input$NrOfClusters))

    ##TRY THERE TO REMOVE THE dynamiclist and all the reactive elements in dynamic_highlight_button_sf1
    if (exists("dynamiclist")) { 

      rm(dynamiclist)
      rm(dynamicvalues_highlight_button_sf1)
      dynamicvalues_highlight_button_sf1 <- reactiveValues() } 

    isolate( dynamiclist <- as.character(unlist(reactiveValuesToList(dynamicvalues_highlight_button_sf1), use.names = FALSE)))
    isolate( print(paste0("dl length = ", length(dynamiclist))))
    })


#### RENDER DYNAMIC UI and DYNAMIC OBSERVERS
  observeEvent(values$nrofelements, {
   print(values$nrofelements == 1 | values$nrofelements >1)

    ### create a nr of buttons equal to the entered value
    if (values$nrofelements == 1 | values$nrofelements >1) { 

      output$buttons_highlight_sf1 <- renderUI({

        lapply(1:values$nrofelements, function(ab) {
          if (!is.null(dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ab)]])) { 
            if(dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ab)]] == 0 ) {
              div(br(), actionButton(inputId = paste0("highlight_button_sf1", ab), label = icon("lightbulb-o"),style = "color: grey;
                          background-color: white;
                                   height: 35px;
                                   width: 35px;
                                   text-align:center;
                                   text-highlight_buttonent: 0,5px;
                                   border-radius: 6px;
                                   display:block;
                                   margin: auto;
                                   border-width: 2px")) } 
              else { div(br(), actionButton(inputId = paste0("highlight_button_sf1", ab), label = icon("lightbulb-o"),style = "color: black;
                                  background-color: white;
                                  border-color: blue;
                                  height: 35px;
                                  width: 35px;
                                  text-align:center;
                                  text-highlight_buttonent: 0,5px;
                                  border-radius: 6px;
                                  display:block;
                                  margin: auto;
                                  border-width: 2px"))  }  }
              else { div(br(), actionButton(inputId = paste0("highlight_button_sf1", ab), label = icon("lightbulb-o"),style = "color: grey;
                                  background-color: white; 
                                  height: 35px; 
                                  width: 35px;
                                  text-align:center;
                                  text-highlight_buttonent: 0,5px;
                                  border-radius: 6px;
                                  display:block;
                                  margin: auto;
                                  border-width: 2px")) } 
            })
      })

      ### create a button to highlight all
      output$button_hightlight_all_sf1 <- renderUI({ 
        if(values$HL_all_switch_sf1 == TRUE) { 
        div( br(), actionButton(inputId = "hightlight_all_button_sf1", label = "All", style = "color: blue; background-color:white"), br())}
        else { div( br(), actionButton(inputId = "hightlight_all_button_sf1", label ="All", style = "color: grey; background-color:white"), br())}
      })

     ### create a button to enable highlight multiple or sinle boxes
       output$multi_highlight <-  renderUI({
        if(values$HL_multi_switch_sf1 == TRUE) { 
          div( br(), actionButton(inputId = "multi_highlight", label ="multi", style = "color: blue; background-color:white"), br())}
         else { div( br(), actionButton(inputId = "multi_highlight", label ="single", style = "color: green; background-color:white"), br())}
         })


    ### loop apply function over all dynamically created buttons
    isolate(lapply(1:values$nrofelements,  function(ob) {
      observeEvent(input[[paste0("highlight_button_sf1", ob)]], {

    ### complex observer structure to check what to do depending on the ALL and MULTI status
    ### FALSE all FALSE multi 
    if (values$HL_all_switch_sf1 == FALSE) {
            if (values$HL_multi_switch_sf1 == FALSE) { 
                for (each in 1:values$nrofelements) { 
                  if ( ob != each) { dynamicvalues_highlight_button_sf1[[paste0("highlight_button", each)]] <- 0}
                  else if (ob == each) { 
                        if (is.null(dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]])) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 1}
                        else if (dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] == 1) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 0}
                        else if (dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] == 0) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 1}
                  }}}
      ### FALSE all TRUE multi
            if (values$HL_multi_switch_sf1 == TRUE){
                        if (is.null(dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]])) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 1}
                        else if (dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] == 1) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 0}
                        else if (dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] == 0) {dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 1}
            }}

    ### TRUE all TRUE multi
    if(values$HL_all_switch_sf1 == TRUE) { 
            if (values$HL_multi_switch_sf1 == TRUE) {
              dynamicvalues_highlight_button_sf1[[paste0("highlight_button", ob)]] <- 0
              isolate(values$HL_all_switch_sf1 <- FALSE)}
    ### TRUE all FALSE multi
    else if (values$HL_multi_switch_sf1 == FALSE) { for (each in 1:values$nrofelements) 
        {if (ob != each) { dynamicvalues_highlight_button_sf1[[paste0("highlight_button", each)]] <- 0}
        }
             isolate(values$HL_all_switch_sf1 <- FALSE)
    }}


      dynamiclist <- as.character(unlist(reactiveValuesToList(dynamicvalues_highlight_button_sf1), use.names = FALSE))
      print(paste0("dl = ", toString(dynamiclist)))

        print(paste("ob =", ob ))

        lastclicked_button_nr <- ob

        colorpalette <- vector(mode="character", length=values$nrofelements)
        colorpalette <- replace(colorpalette, colorpalette == "", "GREY")
        colorpalette[values$button_nr_clicked]="RED"
        print( "-----------next click event prints the below this line--------------------------------------------------------------")
      })
      }))
      }
      })


#### OBSERVE DYNAMIC UI

observeEvent(input$multi_highlight, { 
  if (values$HL_multi_switch_sf1 == TRUE) { values$HL_multi_switch_sf1 <- FALSE }
  else if (values$HL_multi_switch_sf1 == FALSE) { values$HL_multi_switch_sf1 <- TRUE }
})



observeEvent(input$hightlight_all_button_sf1,{
  if (values$HL_all_switch_sf1 == TRUE) { values$HL_all_switch_sf1 <- FALSE }
  else if (values$HL_all_switch_sf1 == FALSE) {values$HL_all_switch_sf1 <- TRUE}


  if (values$HL_all_switch_sf1 == TRUE) { for (any in 1:values$nrofelements) { dynamicvalues_highlight_button_sf1[[paste0("highlight_button", any)]] <- 1}}
  else if (values$HL_all_switch_sf1 == FALSE) { for (any in 1:values$nrofelements) { dynamicvalues_highlight_button_sf1[[paste0("highlight_button", any)]] <- 0}}

  colorpalette <- NULL
  colorpalette <- vector(mode="character", length=values$nrofelements)
  colorpalette <- replace(colorpalette, colorpalette == "", "RED")

})

### button to print the status of Multi and All on console to check what they are
observeEvent(input$statuscheck, { 
  print(paste("ALL switch: ", values$HL_all_switch_sf1)) 
  print(paste("MULTI switch: ", values$HL_multi_switch_sf1)) 
  })
}

error adicional 1: si cambia el número de entrada a cero, obtenemos un error

error adicional 2: si empiezo por ingresar "0" , va bien y no obtenemos botones, si ingreso cualquier número superior a 0 obtenemos tantos botones, pero si lo cambio a 0, obtengo 2 botones:

A pesar de que el renderUI dinámico en la línea 36 del servidor está envuelto dentro de una condición:

if (values$nrofelements == 1 | values$nrofelements >1) { ...... 

Answer 1

De acuerdo, tu problema es complicado por el que las personas se han enamorado antes, si miras la documentación de los reactiveValues (aquí reactiveValues ​​docs ) dice que

"Tenga en cuenta que los valores tomados del objeto reactiveValues ​​son reactivos, pero el objeto reactiveValues ​​en sí no es".

Por lo tanto, no debería usar dynamicvalues_highlight_button_sf1 como es, debería usar elementos con nombre. Lo hice funcionar haciendo lo siguiente:

• reemplazando dynamicvalues_highlight_button_sf1 con dhbs globalmente (no es necesario, pero las líneas se estaban volviendo demasiado largas para que yo pudiera ver lo que estaba pasando).
• reemplazando dhbs con dhbs$el globalmente.
• deshacerse de todas las llamadas reactiveValuesToList .
• deshacerse de todos los intentos de obtener rm(...) cosas fuera del entorno reactivo.
• agregando una dhbs$el <- NULL como la primera línea del observeEvent(values$nrofelements, { node code.
• agregó un campo de salida adicional para inspeccionar dhbs con una instrucción renderTextVerbatum . Esta es una técnica de depuración útil cuando te acostumbras.
• eliminado un montón de código redundante.
• eliminó todas las declaraciones isolate que no estaban haciendo nada.
• agregó un clickcount para manejar mejor la reactividad.

Parece que funciona ahora, aunque todavía podría haber algunos otros problemas para solucionar como resultado de esos cambios. También creo que muchos de esos aislamientos son probablemente innecesarios y solo el resultado de tus actividades de depuración.

El código:

library(shiny)
library(shinydashboard)
library(shinyBS)


ui <- dashboardPage(
  dashboardHeader(title = "My Test App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs", menuItem("testpage", tabName = "testpage", icon = icon("book"))
    )
  ),

  dashboardBody(
    tags$head(tags$style(HTML(''.skin-blue .content-wrapper, .right-side {background-color: #ffffff; }, ''))),


    tabItems(

      ### test page ###_________
      tabItem(tabName = "testpage",  

              h5("Enter desired nr of elements here"),
              textInput(inputId ="NrOfClusters", label = NULL , placeholder = "NULL"),
              verbatimTextOutput("values"),
              verbatimTextOutput("clickcount"),

              fluidRow(
                column(2,
                       uiOutput("buttons_highlight_sf1")),

                column(1,
                       uiOutput("button_hightlight_all_sf1"),
                       uiOutput("multi_highlight"),
                       br(),
                       actionButton(inputId = "statuscheck", label = "status", style = "background-color: white")
                ))))))

off_style <- 
"color: grey;
background-color: white;
height: 35px;
width: 35px;
text-align:center;
text-highlight_buttonent: 0,5px;
border-radius: 6px;
display:block;
margin: auto;
border-width: 2px"

on_style <- 
"color: grey;
background-color: white;
border-color: blue;
height: 35px;
width: 35px;
text-align:center;
text-highlight_buttonent: 0,5px;
border-radius: 6px;
display:block;
margin: auto;
border-width: 2px"


shinyServer = function(input, output, session) {

  ################# start functionality HOME TAB #############################  

  ### create 2 reactive environment lists
  values <- reactiveValues(clickcount=0)
  dhbs <- reactiveValues(el=NULL)

  ### set initial state of two buttons 
  values$HL_multi_switch_sf1 <- FALSE
  values$HL_all_switch_sf1 <- FALSE 

  ### if the user types in a value, then convert it to a reactive value of this nr
  observeEvent (input$NrOfClusters, {
    values$nrofelements <- input$NrOfClusters
    dynamiclist <- as.character(unlist(dhbs$el), use.names = FALSE)
    print(paste0("dl length = ", length(dynamiclist)))
  })

  hibutname <- function(idx){
    sprintf("highlight_button_sf1-%s-%d",values$nrofelements,idx)
  }
  atbutname <- function(idx){
    sprintf("activate_button_sf1-%s-%d",values$nrofelements,idx)
  }
  fliphib <- function(idx){
    hib <- hibutname(idx)
    dhbs$el[hib] <- abs(1-dhbs$el[hib])
  }

  sethib <- function(idx,v){
    hib <- hibutname(idx)
    dhbs$el[hib] <- v
  }


  #### RENDER DYNAMIC UI and DYNAMIC OBSERVERS
  observeEvent(values$nrofelements, {
    req(input$NrOfClusters)
    nel <- values$nrofelements
    dhbs$el <- rep(0,nel) 
    names(dhbs$el) <- sapply(1:nel,hibutname)
    print(names(dhbs$el))

    output$buttons_highlight_sf1 <- renderUI({
      values$clickcount
      print("clickcount")
      print(values$clickcount)
      lapply(1:values$nrofelements, function(ab) {
          if(dhbs$el[[hibutname(ab)]] == 0 ) {
            print("gray")
            div(br(), actionButton(inputId = hibutname(ab), label = icon("lightbulb-o"),style = off_style)) 
          } else { 
            print("black")
            div(br(), actionButton(inputId = hibutname(ab), label = icon("lightbulb-o"),style = on_style))  
          }  
      })
    })

    ### create a button to highlight all
    output$button_hightlight_all_sf1 <- renderUI({ 
      if(values$HL_all_switch_sf1 == TRUE) { 
        div( br(), actionButton(inputId = "hightlight_all_button_sf1", label = "All", style = "color: blue; background-color:white"), br())
      } else { 
        div( br(), actionButton(inputId = "hightlight_all_button_sf1", label ="All", style = "color: grey; background-color:white"), br())
      }
    })

    ### create a button to enable highlight multiple or single boxes
    output$multi_highlight <-  renderUI({
      if(values$HL_multi_switch_sf1 == TRUE) { 
        div( br(), actionButton(inputId = "multi_highlight", label ="multi", style = "color: blue; background-color:white"), br())
      }  else { 
        div( br(), actionButton(inputId = "multi_highlight", label ="single", style = "color: green; background-color:white"), br())
      }
    })


    lapply(1:values$nrofelements,  function(ob) {
      butname <- hibutname(ob)
      observeEvent(input[[butname]], {
        hibut <- hibutname(ob)
        print(hibut)
        values$clickcount <- values$clickcount+1
        print("clicked")
        print(values$clickcount)

        ### complex observer structure to check what to do depending on the ALL and MULTI status
        ### FALSE all FALSE multi 
        if (values$HL_all_switch_sf1 == FALSE) {
          if (values$HL_multi_switch_sf1 == FALSE) { 
            for (each in 1:values$nrofelements) { 
              if ( ob != each) { 
                sethib(each,0) 
              } else { 
                fliphib(each) 
              }
            }
          }
          ### FALSE all TRUE multi
          if (values$HL_multi_switch_sf1 == TRUE){
            fliphib(ob)
          }
        }

        ### TRUE all TRUE multi
        if(values$HL_all_switch_sf1 == TRUE) { 
          if (values$HL_multi_switch_sf1 == TRUE) {
            sethib(ob,0)
            values$HL_all_switch_sf1 <- FALSE
          }
          ### TRUE all FALSE multi
          else if (values$HL_multi_switch_sf1 == FALSE) { 
            for (each in 1:values$nrofelements) {
              if (ob != each) { sethib(each,0) }
            }
            values$HL_all_switch_sf1 <- FALSE
          }
        }


        dynamiclist <- as.character(unlist(dhbs$el), use.names = FALSE)
        print(paste0("dl = ", toString(dynamiclist)))

        print(paste("ob =", ob ))

        lastclicked_button_nr <- ob

        colorpalette <- vector(mode="character", length=values$nrofelements)
        colorpalette <- replace(colorpalette, colorpalette == "", "GREY")
        colorpalette[values$button_nr_clicked]="RED"
        print( "-----------next click event prints the below this line--------------------------------------------------------------")
      })
    })
  })


  #### OBSERVE DYNAMIC UI

  observeEvent(input$multi_highlight, {   values$HL_multi_switch_sf1 <- !values$HL_multi_switch_sf1 })




  observeEvent(input$hightlight_all_button_sf1,{
    values$HL_all_switch_sf1 <- !values$HL_all_switch_sf1;

    for (any in 1:values$nrofelements) { dhbs$el[[hibutname(any)]] <- as.integer(values$HL_all_switch_sf1) }

    colorpalette <- NULL
    colorpalette <- vector(mode="character", length=values$nrofelements)
    colorpalette <- replace(colorpalette, colorpalette == "", "RED")

  })

  ### button to print the status of Multi and All on console to check what they are
  observeEvent(input$statuscheck, { 
    print(paste("ALL switch: ", values$HL_all_switch_sf1)) 
    print(paste("MULTI switch: ", values$HL_multi_switch_sf1)) 
  })

  output$values <- renderPrint(as.character(unlist(dhbs$el), use.names = FALSE))
  output$clickcount <- renderPrint(values$clickcount)
}
options(shiny.reactlog = TRUE)
shinyApp(ui,shinyServer)

Captura de pantalla: