Question

我试图将不同的消息添加到R Shiny的数据表的不同行中。但是，当我运行下面的代码（这只是示例代码，但是我想要类似的东西）时，它只会将消息添加到该行之一。如何添加到多行？

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)

Answer 1

在这里，我修改了您的代码，现在看看它是否对您有用：

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)

将弹出框添加到行名R Shiny

1 个答案: