R Shiny：mainPanel 行为随输入而变化

Question

每张图片上方都有一个操作按钮。但它的工作方式不同，具体取决于 input$n 的奇偶校验（在侧边栏面板中的数字输入中）。如果 input$n 是奇数，单击按钮会更改标签，这正是我想要的。否则，它没有。

请分别查找附件服务器和ui:

require(png)
require(shiny)
require(shinyjs)

########## PRE-PROCESSING
Nsub <- 5
Nimg <- 10
nvar <- 112*92
N <- Nsub * Nimg

#stocker noms fichiers et images
init <- function(){
  listFiles <- list()
  listDataMat <- list()
  excluded <- list()
  
  for( sub in 1:Nsub ){
    listLabel <- c()
    DataMat <- matrix(nrow=Nimg,ncol=nvar)
    for( img in 1:Nimg ) {
      fname <-  paste("www/s",sub,"_",img,".png",sep="")
      listLabel <- c(listLabel,fname)
      d <- readPNG(fname)
      DataMat[img,] <- matrix(d,ncol=nvar)
    }
    listFiles[[sub]] <- listLabel
    listDataMat[[sub]] <- DataMat
    excluded[[sub]] <- rep(FALSE,10)
  }
  
  list(listFiles,listDataMat,excluded)
}

lists <- init()
listFiles <- lists[[1]]
listDataMat <- lists[[2]]
excluded <- lists[[3]] #noms fichier exclus de database // %in%
remove(lists)


############ HELPER FUNC
#afficher images d'une classe
dispImgs <- function(variable,ind){
  
  if(variable>=1){
    DataMat <- listDataMat[[variable]]
  }else{
    DataMat <- listDataMat[["0"]]
  }
  result <- list()
  outfile <- tempfile(fileext = ".png")
  
  sample <- matrix(DataMat[ind,], nrow = 112, ncol = 92)
  writePNG(sample, target = outfile)
  im <- list(src = outfile,
             contentType = "image/png",
             alt = "Normalement, on devrait voir une photo",
             width = 92, 
             height = 112
  )
  im
}


###########SERVER
server <- function(input,output,session){
  excluded <- reactiveValues(ls = excluded)
  
  # vals <- reactiveValues()
  # vals$n_sample <- 10
  # vals$n_rows <- *
  # vals$last_row <- n_sample%%5
  # 
  observeEvent(input$n,{
    n_sample <- ifelse(input$n==0,nrow(listDataMat[["0"]]),nrow(listDataMat[[input$n]]))
    n_rows <- round(n_sample/5)
    last_row <- n_sample%%5
    
    #creating event listener
    lapply(
      X = 1:n_sample,
      FUN = function(i){
        observeEvent(input[[paste0("out",i)]], {
          excluded$ls[[input$n]][i] <- !excluded$ls[[input$n]][i]
          updateActionButton(session, paste0("out",i),
                             label = ifelse(excluded$ls[[input$n]][i],"Inclure","Exclure"))
          print(excluded$ls[[input$n]])
        })
      }
    )
  })
  
  img_widget <- function(i) {
    if(input$n==0){
      column(2,
             renderImage({
               dispImgs(input$n,i)
             },outputArgs = c(height="200px")
             )
      )
      
    }else{
      column(2,
             actionButton(paste0("out",i), label = ifelse(excluded$ls[[input$n]][i],"Inclure","Exclure")),
             renderImage({
               dispImgs(input$n,i)
             }, 
             outputArgs = c(height="200px")
             )
      )
      
    }
    
  }
  
  output$mainPanel <- renderUI({
    mainPanel(
      h2(paste("Les 10 photos de l'individu", input$n)),
      # if(n_rows!=0){
      #   for(i in 1:n_rows){
      #     fluidRow(
      #       width=10,
      #       lapply(
      #         X = 1+5*(i-1):5*i,
      #         FUN = img_widget
      #       )
      #     )
      #   }
      # }
      # if(last_row!=0){
      #   fluidRow(
      #     width=10,
      #     lapply(
      #       X = 1+5*(n_rows-1):5*(n_rows-1)+last_row,
      #       FUN = img_widget
      #     )
      #   )
      # }
      fluidRow(
        width=10,
        lapply(
          X = 1:5,
          FUN = img_widget
        )
      ),
      fluidRow(
        width=10,
        lapply(
          X = 6:10,
          FUN = img_widget
        )
      )
    )
    
  })
  
}

require(png)
require(shiny)

######### HELPER FUNC


########## UI
ui <- fluidPage(
  
  # Titre
  headerPanel("Banque de photos pour reconnaissance faciale"),
  sidebarLayout(
    sidebarPanel(
      numericInput('n', "Numéro de l'individu à afficher", 1, min = 0, max = 40, step = 1)
    ),
  uiOutput("mainPanel")
  )
)

为了重现问题，您需要一个包含名为 's1_2.png' 的图片的文件夹 'www'，其中 1 是 class，2 是图片索引。每个 class (S[1-5]_[1-5].png) 只能定义 5 张图片。因此自然会出现一个小的显示问题。

编辑：忘了说图片需要灰度。

Answer 1

查看 print(excluded$ls[[input$n]]) 输出，似乎每次触发 input$n 时，它都会增加触发任何 [=14= 时将启动的 updateActionButton() 的数量].

因此，例如，触发 2 次 input$n 然后单击任何 input$outN 按钮将启动 updateActionButton 两次而不是一次。所以它首先排除但然后重新包含您的样本。当 input$n 被触发奇数次时，它最终以排除样本结束，所以这就是它似乎起作用的原因。

不确定为什么会这样，但肯定是因为有两个嵌套 observeEvent。可能已经观察到类似的行为（双关语）already.

如果您不嵌套这两个 observeEvent，它会按预期工作：

n_sample <- nrow(listDataMat[[1]])

observeEvent(input$n,{
n_sample <- ifelse(input$n==0,nrow(listDataMat[["0"]]),nrow(listDataMat[[input$n]])) 
n_rows <- round(n_sample/5)
last_row <- n_sample%%5
})

#creating event listener
lapply(
  X = 1:n_sample,
  FUN = function(i){
    observeEvent(input[[paste0("out",i)]], {
      excluded$ls[[input$n]][i] <- !excluded$ls[[input$n]][i]
      updateActionButton(session, paste0("out",i),
                         label = ifelse(excluded$ls[[input$n]][i],"Inclure","Exclure"))
      print(excluded$ls[[input$n]])
    })
  }
)

但是您需要在第一个 observeEvent 之外定义 n_sample 变量，以便 lapply 函数可以使用它。我通过“静态”定义它来简化，但您需要一些 reactiveValue 以便在触发第一个 observeEvent.

时更新它

R Shiny：mainPanel 行为随输入而变化

RShiny : mainPanel behavior changing with input

r

widget

shiny