如何在数据表中单击时弹出单元格图像？

Question

我创建一个数据表，一列包含图像，我想在单击单元格图像时弹出一个窗口以显示更大的图像。

代码如下：

library(shiny)
library(DT)

dat <- data.frame(
  country = c('USA', 'China'),
  flag = c('<img src="http://bpic.588ku.com//element_origin_min_pic/16/11/14/2f4de8bcf22409518c2fe2d74a49d9c7.jpg" height="52"></img>',
           '<img src="http://upload.wikimedia.org/wikipedia/commons/thumb/f/fa/Flag_of_the_People%27s_Republic_of_China.svg/200px-Flag_of_the_People%27s_Republic_of_China.svg.png" height="52"></img>'
  )
)

ui<-fluidPage(
  DT::dataTableOutput('mytable')
)

server<-function(input, output){
  output$mytable <- DT::renderDataTable({

    DT::datatable(dat, escape = FALSE)
  })
}

shinyApp(ui=ui,server=server)

目标结果：

Answer 1

这是我在网上找到的一个示例，可以根据您的情况进行调整。

library("shiny")
library("datasets")
library("DT")
library("shinyBS")

ui = shinyUI(fluidPage(
  DT::dataTableOutput("mtcarsTable"),
  bsModal("mtCarsModal", "My Modal", "",textOutput('mytext'), size = "small")
))

on_click_js = "
Shiny.onInputChange('mydata', '%s');
$('#mtCarsModal').modal('show')
"

convert_to_link = function(x) {
  as.character(tags$a(href = "#", onclick = sprintf(on_click_js,x), x))
}

shinyApp(
  ui = ui,
  server = function(input, output, session) {

    mtcarsLinked <- reactive({   
      mtcars$mpg <- sapply(
        datasets::mtcars$mpg,convert_to_link)
      return(mtcars)
    })

    output$mtcarsTable <- DT::renderDataTable({
      DT::datatable(mtcarsLinked(), 
                           class = 'compact',
                           escape = FALSE, selection='none'
      )
    })
    output$mytext = renderText(sprintf('mpg value is %s',input$mydata))
  }
)

来源： https: //github.com/ebailey78/shinyBS/issues/26

如果我应该只发布链接作为评论而不是答案，请告诉我，我将删除它并这样做。