时间戳

首页 > 解决方案 > RShiny : mainPanel 行为随输入而变化

r - RShiny : mainPanel 行为随输入而变化

问题描述

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

请分别找到附加的服务器和用户界面：

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 是类，2 是图片索引。每个类只能定义 5 张图片 (S[1-5]_[1-5].png)。因此，自然会出现轻微的显示问题。

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

标签： rshinywidget

解决方案

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

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

不知道为什么会发生这种情况，但这肯定是因为有两个嵌套的observeEvent. 可能已经观察到了类似的行为（双关语）。

如果你不嵌套这两个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]])
    })
  }
)

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

推荐阅读