Question

我正在尝试将与数据行关联的图像过滤后显示在按钮上单击。可以在信息框中，也可以仅在表格下方。

我还尝试过仅在表格中显示图像，但是它们太小而无法使用，因此最好将它们与表格分开，以便我指定尺寸。

我有一个.csv文件，其中包含以下类型的信息，并且正在尝试将图像存储在本地或网络上（因此有两个图像列）。

.csv示例 ID，连续，折断，PB，L唇，R唇，信号多尔或ped。疤痕，图像（在www文件夹中），ImageTest

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

到目前为止，这是我对表和排序有效的编码方式：

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)

这部分工作正常，我只是不确定如何为一个按钮编码，该按钮指定我只想保存和呈现过滤结果中的图像。任何帮助或想法将不胜感激！

Answer 1

像这样吗？

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)

带有幻灯片：

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)

Answer 2

是的，这就是我的想法！但是，当我添加.csv的上传内容时，似乎无法正确显示它。我在原始边栏中取出了一些其他内容，以找出问题所在。然后我将图像列重命名为“ 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)

Answer 3

我现在对其进行了重新设计，可以显示图像，但是无法弄清楚在何处指定“ table_rows_current”命令以仅显示过滤后的图像。有什么想法吗？

 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)

在对表格进行排序后，如何在单击表格列引用时动态渲染图像

3 个答案: