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

您可以使用tableHTML来使用make_css()来实现它，这会创建一个可以在闪亮的webapp中使用的css文件。您可以查看this插图以了解更多详情。

library(shiny)
library(tableHTML)

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>'
  )
)

使用make_css()创建允许您展开图片的css。它看起来像这样：

img {
  transition: transform 0.25s ease;;
}
img:hover {
  transform: scale(1.5);
}

ui<-fluidPage(
  br(),
  tags$style(make_css(list(c('img'),
                           c('transition'),
                           c('transform 0.25s ease;')))),
  tags$style(make_css(list(c('img:hover'),
                           c('transform'),
                           c('scale(10) translate(50%, 50%)')))),
  uiOutput("mytable")
)

在服务器中，创建tableHTML：

server<-function(input, output){
  output$mytable <- renderUI({

    tableHTML(dat, 
              escape = FALSE, 
              rownames = FALSE) 
  })
}

shinyApp(ui=ui,server=server)

结果如下：

当您将鼠标悬停在图像上时，它会像这样展开：

注意：您可以使用选择theme或将css应用于表格来更改表格的外观。请参阅tableHTML vignette或examples。

Answer 2

以下是我在网上找到的一个可以根据您的情况调整的例子。

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

如果我应该仅将链接发布为评论而不是答案，请告诉我，我会删除此操作。

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

2 个答案: