在行上雙擊R中的數據表中的圖像彈出窗口Shiny

Question

我正在尋找在數據表中雙擊行時彈出圖像。 我寫的當前代碼在雙擊該行時顯示警報消息。我想用圖像替換該警報消息。建議達到相同。

代碼

library(shiny) 
library(shinydashboard) 
library(DT) 

ui <- shinyUI(

dashboardPage (
dashboardHeader(title="Report"), 
dashboardSidebar(sidebarMenu(menuItem("Table",tabName="Table"))), 
dashboardBody(  
    tabItems(
    tabItem(tabName = "Table", 
      DT::dataTableOutput("DataTable")  
    ) 
)) 

)) 

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

output$DataTable <- DT::renderDataTable({ 
datatable(iris,rownames=FALSE,selection = 'single',options = list(
    searching = FALSE,ordering=FALSE, 
    dom = 'Bfrtip', 
    buttons = c('copy','excel', 'pdf', 'print', 'colvis'), 
    columnDefs = list(list(visible=FALSE, targets=c(2))), 
    rowCallback = JS(
    "function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {", 
    "var full_text = aData[2]", 
    # Tooltip for the rows 
    "$('td:eq(1)', nRow).attr('title', full_text);", 
    # Showing a hand as a cursor 
    "$('td:eq(1)', nRow).css('cursor','pointer');", 
    "$('td:eq(1)', nRow).css('font-weight','bold');", 
    "}") 
), 
#On double Click show Alert Message 
callback = JS(' 
       table.on("dblclick.dt","tr", function() { 
       var data=table.row(this).data(); 
       alert("You clicked on "+data[4]+"\'s row");} 
      ) 
       ') ) 
}) 
}) 

shinyApp(ui,server) 

Answer 1

使用「SweetAlert」，而不是傳統的JS警告彈出窗口上的數據錶行點擊添加圖片。

編輯：

請下載甜警報插件JS和CSS文件，從這個鏈路https://github.com/t4t5/sweetalert和兩個文件放在WWW文件夾。文件位置 - sweetalert主\ DIST

下面是最終代碼：

library(shiny) 
library(shinydashboard) 
library(DT) 

ui <- shinyUI(

dashboardPage (
dashboardHeader(title="Report"), 
dashboardSidebar(sidebarMenu(menuItem("Table",tabName="Table"))), 
dashboardBody(
    # JS Script and CSS for SweetAlert Plugin 
    tags$head(HTML("<script type='text/javascript' src='sweetalert.min.js'> </script>")), 
    tags$head(
     tags$link(rel = "stylesheet", type = "text/css", href = "sweetalert.css") 
    ), 
    tabItems(
    tabItem(tabName = "Table", 
      DT::dataTableOutput("DataTable")  
    ) 
)) 

)) 

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

output$DataTable <- DT::renderDataTable({ 
datatable(iris,rownames=FALSE,selection = 'single',options = list(
    searching = FALSE,ordering=FALSE, 
    dom = 'Bfrtip', 
    buttons = c('copy','excel', 'pdf', 'print', 'colvis'), 
    columnDefs = list(list(visible=FALSE, targets=c(2))), 
    rowCallback = JS(
    "function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {", 
    "var full_text = aData[2]", 
    # Tooltip for the rows 
    "$('td:eq(1)', nRow).attr('title', full_text);", 
    # Showing a hand as a cursor 
    "$('td:eq(1)', nRow).css('cursor','pointer');", 
    "$('td:eq(1)', nRow).css('font-weight','bold');", 
    "}") 
), 
#On double Click show Alert Message 
callback = JS(' 
       table.on("dblclick.dt","tr", function() { 
       var data=table.row(this).data(); 
      swal({ 
      title: "Sweet!", 
      text: "Here a custom image.", 
      imageUrl: "http://wallpaper-gallery.net/images/high-resolution- image/high-resolution-image-2.jpg", 
      imageSize: "400x300" 
      }); 
} 
) 
    ')) 
}) 
}) 

shinyApp(ui,server)