seleccionar - IU procesada dinámicamente: cómo eliminar las antiguas variables reactivas en la segunda ejecución
seleccionar datos en r (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_sf1condhbsglobalmente (no es necesario, pero las líneas se estaban volviendo demasiado largas para que yo pudiera ver lo que estaba pasando). - reemplazando
dhbscondhbs$elglobalmente. - deshacerse de todas las llamadas
reactiveValuesToList. - deshacerse de todos los intentos de obtener
rm(...)cosas fuera del entorno reactivo. - agregando una
dhbs$el <- NULLcomo la primera línea delobserveEvent(values$nrofelements, {node code. - agregó un campo de salida adicional para inspeccionar
dhbscon una instrucciónrenderTextVerbatum. Esta es una técnica de depuración útil cuando te acostumbras. - eliminado un montón de código redundante.
- eliminó todas las declaraciones
isolateque no estaban haciendo nada. - agregó un
clickcountpara 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:
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) { ......