时间戳

首页 > 解决方案 > adding pop up boxes to row names R shiny

r - adding pop up boxes to row names R shiny

问题描述

I am trying to add different messages to different rows in datatable in R shiny. But when I run the below code (this is just an example code, but I want something like that), it only adds the message to one of the row. How can I add to multiple rows?

library(shiny)

library(shinyBS)

library(DT)

ui <- fluidPage(
titlePanel('All you want to know about Titanic'),
fluidRow(

bsButton('tbutton','Lift Titanic'),
br(),
bsTooltip('tbutton', 'This button will inflate a balloon'),
width=2),
mainPanel(dataTableOutput('titanic')
 )
)

server <- function(input, output) {

tdata <- as.data.frame(Titanic)
tdata <- cbind(tdata,tdata)
output$titanic <- DT::renderDataTable({

header <-  htmltools::withTags(table(

  class = 'display',
  thead(
    tr(
      th(rowspan = 1, 'PassengerID'),
      th(colspan = 6, 'Titanic1'),
      th(colspan = 6, 'Titanic2')),
    tr(lapply(c(" ", rep(colnames(as.data.frame(Titanic)), 2)), th))
    )
   )
 )



rownames(tdata)[1] <- 
as.character(popify(actionLink(inputId=paste("t_",i,sep=""), 
label=rownames(tdata)[1]), title=paste("message1"), placement = 
"bottom", trigger = "hover", options = NULL))
rownames(tdata)[2] <- 
as.character(popify(actionLink(inputId=paste("t_",i,sep=""), 
label=rownames(tdata)[2]), title=paste("message2"), placement = 
"bottom", trigger = "hover", options = NULL))
rownames(tdata)[3] <- 
as.character(popify(actionLink(inputId=paste("t_",i,sep=""), 
label=rownames(tdata)[3]), title=paste("message3"), placement = 
"bottom", trigger = "hover", options = NULL))


datatable(tdata, container=header, rownames=TRUE, selection='none', 
escape=FALSE)
   })
}

shinyApp(ui = ui, server = server)

标签： rshinydt

解决方案

在这里，我修改了你的代码，看看它现在是否适合你： 

library(shiny)
library(shinyBS)

library(DT)

ui <- fluidPage(
  titlePanel('All you want to know about Titanic'),
  fluidRow(

    bsButton('tbutton','Lift Titanic'),
    br(),
    bsTooltip('tbutton', 'This button will inflate a balloon'),
    width=2),
  mainPanel(dataTableOutput('titanic')
  )
)

server <- function(input, output) {

  tdata <- as.data.frame(Titanic)
  tdata <- cbind(tdata,tdata)
  output$titanic <- DT::renderDataTable({

    header <-  htmltools::withTags(table(

      class = 'display',
      thead(
        tr(
          th(rowspan = 1, 'PassengerID'),
          th(colspan = 6, 'Titanic1'),
          th(colspan = 6, 'Titanic2')),
        tr(lapply(c(" ", rep(colnames(as.data.frame(Titanic)), 2)), th))
      )
    )
    )

    for (i in 1:3) {

      rownames(tdata)[i] <- 
        as.character(
          popify(
            actionLink(inputId = paste("t_",i,sep=""), label = rownames(tdata)[i]), 
            title = paste0("message", i), 
            placement = "bottom", 
            trigger = "hover", 
            options = NULL
          )
        )

    }
    datatable(
      tdata, container=header, rownames=TRUE, selection='none', escape=FALSE
    )
  })
}

shinyApp(ui = ui, server = server)

推荐阅读