1
votes

Comment rendre dynamiquement des images en cliquant sur une référence de colonne de table après le tri de la table

J'essaie de faire afficher les images associées à des lignes de données sur un clic de bouton après avoir été filtrées. Cela peut se trouver dans une boîte d'informations ou simplement sous le tableau.

J'ai également essayé d'afficher les images dans le tableau, mais elles sont trop petites pour être utiles, alors ce serait mieux si elles le pouvaient être séparé du tableau pour que je puisse spécifier la taille.

J'ai un fichier .csv avec le type d'informations suivant et j'essayais des images stockées localement ou sur le Web (d'où les deux colonnes d'image).

.csv exemple ID, continu, cassé, PB, Lips L, Lips R, Sig. dor. ou ped. scar, Image (dans le dossier www), ImageTest

1820, Y, N, 2, Y, Y, Y, 1820CelloHeadshot.jpg, http://rwcatalog.neaq.org/ImageViewer.aspx?ImageId=826703

Voici ce que j'ai jusqu'à présent pour le codage qui fonctionne pour la table et le tri:

library(shiny)
library(DT)
library(tidyverse)

# default global search value
if (!exists("default_search")) default_search <- ""

# default column search values
if (!exists("default_search_columns")) default_search_columns <- NULL

# Define UI for data upload app ----
ui <- fluidPage(

# App title ----
titlePanel(title = h1("Upload file and select columns", align = "center")),

 # Sidebar layout with input and output definitions ----
sidebarLayout(

  # Sidebar panel for inputs ----
sidebarPanel(

  # Input: Select a file ----
  fileInput("uploaded_file", "Choose CSV File",
            multiple = TRUE,
            accept = c("text/csv",
                       "text/comma-separated-values,text/plain",
                       ".csv")),

  # Horizontal line ----
  tags$hr(),

  # Input: Checkbox if file has header ----
  checkboxInput("header", "Header", TRUE),

  # Input: Select separator ----
  radioButtons("sep", "Separator",
               choices = c(Semicolon = ";",
                           Comma = ",",
                           Tab = "\t"),
               selected = ","),


  # Horizontal line ----
  tags$hr(),

  # Input: Select number of rows to display ----
  radioButtons("disp", "Display",
               choices = c(All = "all",
                           Head = "head"),
               selected = "all"),

  # Select variables to display ----
  uiOutput("checkbox")

),

# Main panel for displaying outputs ----
mainPanel(

  tabsetPanel(
    id = "dataset",
    tabPanel("FILE", DT::dataTableOutput("rendered_file"))
  )
)

 )
  )

# Define server logic to read selected file ----
server <- function(input, output, session) {

 # Read file ----
 df <- reactive({
 req(input$uploaded_file)
 read.csv(input$uploaded_file$datapath,
         header = input$header,
         sep = input$sep)  

  })

  # Dynamically generate UI input when data is uploaded ----
  output$checkbox <- renderUI({
checkboxGroupInput(inputId = "select_var", 
                   label = "Select variables", 
                   choices = names(df()))
  })

 # Select columns to print ----
  df_sel <- reactive({
  req(input$select_var)
  df_sel <- df() %>% select(input$select_var)
   })

  # Print data table ----  
  output$rendered_file <- DT::renderDataTable(

class = "display nowrap compact",
filter = "top",

{
if(input$disp == "head") {
  head(df_sel())
}
else {
  df_sel()
}
  })

}

# Create Shiny app ----
shinyApp(ui, server)

Cette partie fonctionne bien, je ne sais pas comment coder pour un bouton qui spécifierait que je veux seulement pour enregistrer et rendre les images à partir des résultats filtrés. Toute aide ou idée serait appréciée!

r shiny

0 commentaires

3 Réponses :

0
votes

Quelque chose comme ça?

library(shiny)
library(DT)
library(slickR)

dat <- data.frame(
  image = c("Barth sextic", "Mandelbulb", "Space egg"),
  file = c("BarthSextic.png", "Mandelbulb.png", "SpaceEgg.png")
)

ui <- fluidPage(
  DTOutput("table"),
  div(
    slickROutput("images"),
    style = "width: 75%; margin: auto;"
  )
)

server <- function(input, output){

  output[["table"]] <- renderDT({
    datatable(dat, filter = "top")
  })

  df <- reactive({
    req(input[["table_rows_current"]])
    dat[input[["table_rows_current"]], ]
  })

  output[["images"]] <- renderSlickR({
    slickR(paste0("www/", df()$file))
  })

}

shinyApp(ui, server)

Avec un diaporama:

library(shiny)
library(DT)

dat <- data.frame(
  image = c("Barth sextic", "Mandelbulb", "Space egg"),
  file = c("BarthSextic.png", "Mandelbulb.png", "SpaceEgg.png")
)

ui <- fluidPage(
  DTOutput("table"),
  uiOutput("images")
)

server <- function(input, output){

  output[["table"]] <- renderDT({
    datatable(dat, filter = "top")
  })

  df <- reactive({
    dat[input[["table_rows_current"]], ]
  })

  output[["images"]] <- renderUI({
    imgs <- lapply(df()$file, function(file){
      tags$div(
        tags$img(src= file, width="100%"),
        style = "width: 400px;"
      )
    })
    do.call(tagList, imgs)
  })

}

shinyApp(ui, server)

1 commentaires

C'est ce que je voulais faire! Je n'ai tout simplement pas compris comment l'intégrer avec le téléchargement d'un bit de fichier .csv.

0
votes

Oui, c'est ce à quoi je pensais! Je n'arrive pas à le faire afficher correctement lorsque j'ajoute le téléchargement du .csv. J'ai sorti certains des autres éléments de la barre latérale d'origine pour déterminer où se trouvait le problème. Et j'ai renommé la colonne d'image en "whaleimage".

library(shiny)
library(DT)
library(tidyverse)

# Define UI for data upload app ----
ui <- fluidPage(

# App title ----
titlePanel(title = h1("Upload file and select columns", align = "center")),

# Sidebar layout with input and output definitions ----
sidebarLayout(

# Sidebar panel for inputs ----
sidebarPanel(

  # Input: Select a file ----
  fileInput("whaleid", "Choose CSV File",
            multiple = TRUE,
            accept = c("text/csv",
                       "text/comma-separated-values,text/plain",
                       ".csv")),

  # Horizontal line ----
  tags$hr(),


  # Select variables to display ----
  DTOutput("table"),
  uiOutput("images")

),

# Main panel for displaying outputs ----
mainPanel(
  tableOutput("table"),
imageOutput("images"))
))

server <- function(input, output){

output$table <- renderDT({
datatable(whaleid, filter = "top")
})

df <- reactive({
whaleid[input$table_rows_current, ]
})

output$images <- renderUI({
imgs <- lapply(df()$whaleimage, function(whaleimage){
  tags$div(
    tags$img(src= whaleimage, width="100%"),
    style = "width: 400px;"
  )
})
do.call(tagList, imgs)
})

}

# Create Shiny app ----
shinyApp(ui, server)

0 commentaires

0
votes

Je l'ai retravaillé maintenant et je peux afficher les images, mais je n'arrive pas à savoir où spécifier la commande "table_rows_current" afin de n'afficher que les images filtrées. Des idées?

 library(shiny)     #  Shiny web app
 library(DT)        #  for data tables

 # ui object
 ui <- fluidPage(  

 titlePanel("Upload file"),

sidebarLayout(
sidebarPanel(

  # Input: Select a file ----
  fileInput("uploaded_file", "Choose CSV File",
            multiple = TRUE,
            accept = c("text/csv",
                       "text/comma-separated-values,text/plain",
                       ".csv")),

  # Horizontal line ----
  tags$hr(),

  # Input: Checkbox if file has header ----
  checkboxInput("header", "Header", TRUE),

  # Input: Select separator ----
  radioButtons("sep", "Separator",
               choices = c(Semicolon = ";",
                           Comma = ",",
                           Tab = "\t"),
               selected = ",")

),
mainPanel(

  tabsetPanel(
    id = "dataset",
    tabPanel("FILE", DT::dataTableOutput("rendered_file"), htmlOutput("headshots")))
)
)
)  




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

# Read file ----
df <- reactive({
req(input$uploaded_file)
read.csv(input$uploaded_file$datapath,
         header = input$header,
         sep = input$sep)

##column selection for image display

df_sel <- reactive({
df[input$table_rows_current,]
})

})

# Print data table ----  
output$rendered_file <- DT::renderDataTable({datatable(df(), class = "display nowrap 
compact", filter = "top")})

# Print images of selection ----
output$headshots <- renderUI({
imgs <-lapply(df_sel()$whaleimage, function(file){ 
  tags$div(
  tags$img(src= file, width="100%"),
  style = "width: 400px;"
)
})
do.call(tagList, imgs)
})
}



 # run the app
 shinyApp(ui, server)

0 commentaires