Наблюдать за событием внутри цикла

Question

Я пытаюсь создать матрицу действий кнопок пользовательского интерфейса, которые увеличиваются в значении на единицу при нажатии (счетчик с различным значением для каждой кнопки через ObserveEvent). Я хотел бы получить доступ к этим значениям в R после закрытия моего блестящего приложения в виде матрицы для целей спортивного поиска. До сих пор я создавал отдельную переменную для каждой кнопки и копировал, вставлял одну и ту же функцию счетчика снова и снова. Но очевидно, что это приводит к уродливому коду и долгому ожиданию при запуске, даже если это работает. Я хотел бы сократить свой код, создав al oop в серверной части, возможно, выполнив матрицу этих значений «хранилища» и заставив l oop добавить единицу к значениям, когда кнопка соответствующего действия активирована в UI. Я включил свой код ниже, будьте добры, я не программист и у меня мало опыта! Спасибо.

a_OH1_z1_q1 <- 0

ui <- fluidPage(
  navbarPage(
    "Scouting",
    id = "navtab",
    tabPanel("Attack",
             navlistPanel(
               tabPanel('OH1',
                        mainPanel(
                          tags$b("______1____________2____________3_____________4______"),
                          br(),
                          actionButton("aOH1z1q1", a_OH1_z1_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z1q2", a_OH1_z1_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z1q3", a_OH1_z1_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z1q4", a_OH1_z1_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          br(),
                          actionButton("aOH1z2q1", a_OH1_z2_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z2q2", a_OH1_z2_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z2q3", a_OH1_z2_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z2q4", a_OH1_z2_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          br(),
                          actionButton("aOH1z3q1", a_OH1_z3_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z3q2", a_OH1_z3_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z3q3", a_OH1_z3_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z3q4", a_OH1_z3_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          br(),
                          actionButton("aOH1z4q1", a_OH1_z4_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z4q2", a_OH1_z4_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z4q3", a_OH1_z4_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z4q4", a_OH1_z4_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          br(),
                          actionButton("aOH1z5q1", a_OH1_z5_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z5q2", a_OH1_z5_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z5q3", a_OH1_z5_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z5q4", a_OH1_z5_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          br(),
                          actionButton("aOH1z6q1", a_OH1_z6_q1,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z6q2", a_OH1_z6_q2,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z6q3", a_OH1_z6_q3,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;"),
                          actionButton("aOH1z6q4", a_OH1_z6_q4,
                                       style = "width: 100px; height:100px; background-color:blue; color:white;")
                        )
               )
             )
    )
  )
)


server <- function(input, output, session) {
  observeEvent(
    input$aOH1z1q1,{
      a_OH1_z1_q1 <<- a_OH1_z1_q1 + 1
      updateActionButton(session,"aOH1z1q1",label = a_OH1_z1_q1)
    }
  )
}

shinyApp(ui,server)

Answer 1

Вы можете сделать это:

library(shiny)

loadBackup <- function(x){
  if(file.exists(x)){
    init <- readRDS(x)
  } else {
    init <- NULL
  }
  return(init)
}

ui <- fluidPage(
  navbarPage(
    "Scouting",
    id = "navtab",
    tabPanel("Attack",
             navlistPanel(
               tabPanel('OH1',
                        mainPanel(
                          tags$b("______1____________2____________3_____________4______"),
                          br(),
                          uiOutput(outputId = "CustomUI")
                        )
               )
             )
    )
  )
)


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

  rv <- reactiveValues(length = 4,
                       width = 4)
  initialize <- reactive({
   backup <- matrix(0, nrow = rv$length, ncol = rv$width)
   .backup <- loadBackup("backup.rds")
   if(!is.null(.backup)){
     dim <- dim(.backup)
     backup[1:dim[1],1:dim[2]] <- .backup
   }
   for(x in 1:rv$length){
     for(y in 1:rv$width){
       rv[[paste0("a_OH1_z",x,"_q",y)]] <- backup[x,y]
     }
   }
  })


  savebackup <- reactive({
  backup <- matrix(0, nrow = rv$length, ncol = rv$width)
    for(x in 1:rv$length){
      for(y in 1:rv$width){
        backup[x,y] <- rv[[paste0("a_OH1_z",x,"_q",y)]] + input[[paste0("aOH1z",x,"q",y)]]
      }
    }
    saveRDS(backup, file = "backup.rds")
  })
  session$onSessionEnded(function() {
    isolate(savebackup())
  })


  output$CustomUI <- renderUI({
    initialize()
    column(12,
           lapply(1:rv$length, function(x){
             fluidRow(
               br(),
               lapply(1:rv$width, function(y, x){
                 actionButton(paste0("aOH1z",x,"q",y), 
                              rv[[paste0("a_OH1_z",x,"_q",y)]],
                              style = "width: 100px; height:100px; background-color:blue; color:white;")
               }, x = x)
             )


           })
    )
  })

  observe(

    lapply(1:rv$length, function(x){
      lapply(1:rv$width, function(y, x){
        z <- rv[[paste0("a_OH1_z",x,"_q",y)]] + input[[paste0("aOH1z",x,"q",y)]]
        updateActionButton(session,paste0("aOH1z",x,"q",y),label = z)
      }, x = x)
    })
  )

}


shinyApp(ui, server)

LoadBackup проверит указанный файл c, если он найдет его, вернет его значение, если нет, вернет 0.

Файлы сохраняются по окончании сеанса с функцией обратного вызова session$onSessionEnded. Пользовательский интерфейс построен с использованием lapply, который я адаптировал из этого примера, приведенного RStudio.

Весь пользовательский интерфейс построен из заданных мною реактивных значений ширины и длины, поэтому пользователь может увеличить размер, так как они будут sh. Вы можете удалить это и сделать его входным, и он все равно будет работать так же.

Файлы RDS сохраняются локально на устройстве, поэтому это не будет воспроизводиться на shinyapps.io. Вам нужно будет найти решения для базы данных для этого.