Different behavior when defining ui component in server compared to ui Rshiny-CodePudding

I am working on a Shiny App. The problem is that defining my main Panel, having two fuildRows, in the server will have an unwanted behavior which is a big empty space separating the two fluidRows.

Please find here the code leading to picture 2 server.R:

require(shiny)
#require()

########## PRE-PROCESSING
Nsub <- 40
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){
  
  DataMat <- listDataMat[[variable]]
  nsamples <- nrow(DataMat)
  
  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"
  )
  im
}


###########SERVER
server <- function(input,output){
  
  output$phrase <- renderText({
    paste("Les 10 photos de l'individu", input$n)
  })
  
  lapply(
    X = 1:10,
    FUN = function(i){
      observeEvent(input[[paste0("out",i)]], {
        #excluded[[input$n]] = !excluded[[input$n]]
      })
    }
  )
  
  #image display
  lapply(
    X = 1:10,
    FUN = function(i){
      output[[paste0("photo",i)]] = renderImage({dispImgs(input$n,i)})
    }
  )
}

ui.R :

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

######### HELPER FUNC
create_rows <- function(i) {
  column(2,
         checkboxGroupInput(paste0("out",i),
                            label = h3(""),
                            choices = list("exclu" = 0)
         ),
         imageOutput(paste0('photo', i), 
         height = 112, width = 92)
  )
}


########## UI
ui <- fluidPage(
  #useShinyjs(),
  
  # Titre
  headerPanel("Banque de photos pour reconnaissance faciale"),
  sidebarLayout(
    sidebarPanel(
      numericInput('n', "Numéro de l'individu à afficher", 1, min = 1, max = 40, step = 1)
    ),
    
    mainPanel(
      h2(textOutput("phrase")),
      fluidRow(
        width = 10,
        lapply(
          X = 1:5,
          FUN = create_rows
        )
      ),
      fluidRow(
        width = 10,
        lapply(
          X = 6:10,
          FUN = create_rows
        )
      )
      
    )
  )
)

and the code causing the unwanted behavior server:

require(png)
require(shiny)
#require()

########## PRE-PROCESSING
Nsub <- 40
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){
  
  DataMat <- listDataMat[[variable]]
  nsamples <- nrow(DataMat)
  
  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){
  
  create_rows <- function(i) {
    column(2,
           checkboxGroupInput(paste0("exclure",i),
                              label = h3(""),
                              choices = list("exclure" = 0)
           ),
           renderImage({
             dispImgs(input$n,i)
           })
    )
    
  }
  
  # output$phrase <- renderText({
  #   paste("Les 10 photos de l'individu", input$n)
  # })
  
  lapply(
    X = 1:10,
    FUN = function(i){
      observeEvent(input[[paste0("out",i)]], {
        #excluded[[input$n]] = !excluded[[input$n]]
      })
    }
  )
  
  #creating mainPanel for image display
  output$mainPanel <- renderUI({
    mainPanel(
      h2(paste("Les 10 photos de l'individu", input$n)),
      fluidRow(
        width=10,
        lapply(
          X = 1:5,
          FUN = create_rows
        )
      ),
      fluidRow(
        width=10,
        lapply(
          X = 6:10,
          FUN = create_rows
        )
      )
    )
    
  })
  
}

and ui.R:

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

######### HELPER FUNC
create_rows <- function(i) {
  column(2,imageOutput(paste0('photo', i), height = 112, width = 92)
         # checkboxGroupInput(paste0("out",i),
         #                    label = h3(""),
         #                    choices = list("exclu" = 0)
         #                    )
  )
}


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

    )
  
)

Best regards.

CodePudding user response：

Bonjour

You can adjust the height of your image div (class .shiny-image-output) in your create_rows() function by passing the height as an argument to the renderImage() function, for example:

  create_rows <- function(i) {
    column(2,
           checkboxGroupInput(paste0("exclure",i),
                              label = h3(""),
                              choices = list("exclure" = 0)
           ),
           renderImage({
             dispImgs(input$n,i)
           }, outputArgs = c(height="200px"))
    )
    
  }