how to popup the rowname while hovering the cell - r

With the help of this code i can hover the row name only for first column but i need to hover the row name for all the columns need help on this
Thanks in advance
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table2")
),
server = function(input, output) {
output$table2<-DT::renderDataTable({
responseDataFilter2_home<-mtcars
displayableData<-DT::datatable(
responseDataFilter2_home,
options = list(rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"var full_text = aData[0] ",
"$('td:eq(1)', nRow).attr('title', full_text);",
"}"),
columnDefs = list(
list(width = '800%', targets = c(1)))),
selection = 'single',
escape=FALSE,
)
})
}
)

library(DT)
datatable(
mtcars,
options = list(
rowCallback = JS(
"function(row, data, displayNum, displayIndex, dataIndex) {",
" var rowName = data[0];",
" $(row).find('td').attr('title', rowName);",
"}")
)
)

Related

Updating DataTable using DropDown Within DataTable

I am trying to update a sample DataTable dynamically using dropdowns that I created within the DataTable. However, it doesn't seem to update regardless of what I try. The sample code below is what I am currently working with in order to update the Species column when the input is selected from the species_selector column.
library(shiny)
library(DT)
ui <- fluidPage(
title = 'Selectinput column in a table',
h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
DT::dataTableOutput('foo'),
actionButton(inputId = "submit", label = "Submit"),
verbatimTextOutput('sel')
)
server <- function(input, output, session) {
data <- head(iris, 5)
for (i in 1:nrow(data)) {
data$species_selector[i] <- as.character(selectInput(paste0("sel", i), "", choices = unique(iris$Species), width = "100px"))
}
output$foo = DT::renderDataTable(
data, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
observeEvent(input$submit, {
update_data <- reactive({
df <- data
for(i in 1:nrow(df)) {
df$Species[i] <- as.character(input[[paste0("sel", i)]])
}
return(df)
})
data <- update_data()
})
output$sel = renderPrint({
for(i in 1:nrow(data)) {
data$Species[i] <- as.character(input[[paste0("sel", i)]])
}
data
})
}
shinyApp(ui, server)
Any help would be appreciated. Thank you!
Is it something like this you want?
library(shiny)
library(DT)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(i, item){
value <- values[i]
if(i == 1L){
opt <- tags$option(value = value, selected = "selected", item)
}else{
opt <- tags$option(value = value, item)
}
as.character(opt)
}, seq_along(values), items
), collapse = ""))
as.character(tags$select(id = id, options))
}
js <- c(
"function(settings) {",
" var table = this.api().table();",
" var $tbl = $(table.table().node());",
" var id = $tbl.closest('.datatables').attr('id');",
" var nrows = table.rows().count();",
" function selectize(i) {",
" var $slct = $('#slct' + i);",
" $slct.select2({",
" width: '100%',",
" closeOnSelect: true",
" });",
" $slct.on('change', function(e) {",
" var info = [{",
" row: i,",
" col: 4,",
" value: $slct.val()",
" }];",
" Shiny.setInputValue(id + '_cell_selection:DT.cellInfo', info);",
" });",
" }",
" for(var i = 1; i <= nrows; i++) {",
" selectize(i);",
" }",
"}"
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
DTOutput("dtable"),
tags$hr(),
h2("Edited table:"),
tableOutput("table")
)
server <- function(input, output, session) {
dat <- head(iris, 3L)
Dat <- reactiveVal(dat)
for(i in 1L:nrow(dat)){
dat$species_selector[i] <-
selector(id = paste0("slct", i), values = unique(iris$Species))
}
output[["dtable"]] <- renderDT({
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
"function() { Shiny.unbindAll(this.api().table().node()); }"
),
drawCallback = JS(
"function() { Shiny.bindAll(this.api().table().node()); }"
)
)
)
}, server = TRUE)
observeEvent(input[["dtable_cell_selection"]], {
info <- input[["dtable_cell_selection"]]
Dat(editData(Dat(), info, rownames = FALSE))
})
output[["table"]] <- renderTable({
Dat()
})
}
shinyApp(ui, server)
You can take help of reactive values to save the dataframe and perform the changes in the same.
library(shiny)
library(DT)
data <- head(iris, 5)
for (i in 1:nrow(data)) {
data$species_selector[i] <- as.character(selectInput(paste0("sel", i), "", choices = unique(iris$Species), width = "100px"))
}
ui <- fluidPage(
title = 'Selectinput column in a table',
h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
DT::dataTableOutput('foo'),
actionButton(inputId = "submit", label = "Submit"),
verbatimTextOutput('sel')
)
server <- function(input, output, session) {
rv <- reactiveValues(data = data)
output$foo = DT::renderDataTable(
rv$data, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
observeEvent(input$submit, {
for(i in 1:nrow(rv$data)) {
rv$data$Species[i] <- as.character(input[[paste0("sel", i)]])
}
})
}
shinyApp(ui, server)

Display multiple strings in a cell of a datatable that can be removed by clicking on them

I have the shiny app below in which I convert the d dataframe to a dataframe in which the unique items will be summarized based on the name and a new column will be added with their count. Then I use DT package to display this dataframe. I wonder if DT or shinywidgets or maybe another method can be used in order to display the table like in the screenshot below in which the user will be able to display the different strings in the items column as separated words that he will be able to remove. Here is an example in the second column.
library(shiny)
library(DT)
library(jsonlite)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(value, item){
as.character(tags$option(value = value, item))
}, c("", values), c("", items)
), collapse = ""))
as.character(
tags$select(
id = id, class = "form-control", multiple = "multiple", options
)
)
}
name<-c("Jack","Bob","Jack","Bob")
item<-c("apple","olive","banana","tomato")
d<-data.frame(name,item)
words<-tapply(d$item, d$name, I)
nrows <- length(words)
js <- c(
"function(settings) {",
sprintf("var nrows = %d;", nrows),
sprintf("var words = %s;", toJSON(words)),
" var table = this.api().table();",
" function selectize(i) {",
" $('#slct' + i).selectize({",
" items: words[i-1],",
" onChange: function(value) {",
" table.cell(i-1, 2).data(value.length);",
" }",
" });",
" }",
" for(var i = 1; i <= nrows; i++) {",
" selectize(i);",
" Shiny.setInputValue('slct' + i, words[i-1]);",
" }",
"}"
)
ui <- fluidPage(
br(),
DTOutput("table"),
div( # this is a hidden selectize input whose role is to make
# available 'selectize.js'
style = "display: none;",
selectInput("id", "label", c("x", "y"))
)
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = c(unique(d$name)),
Words = vapply(
1:nrows,
function(i){
selector(paste0("slct", i), words[[i]])
},
character(1)
),
Count = lengths(words),
stringsAsFactors = FALSE
)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); }'
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
We can do that with a selectizeInput:
library(shiny)
library(DT)
js <- c(
"function(settings){",
" $('#mselect').selectize();",
"}"
)
ui <- fluidPage(
br(),
DTOutput("table"),
div(
style = "display: none;",
selectInput("id", "label", c("x", "y"))
)
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = "bar",
BAZ = '<select id="mselect" class="form-control" multiple="multiple">
<option value=""></option>
<option value="A">Apple</option>
<option value="B">Banana</option>
<option value="C">Lemon</option>
</select>',
stringsAsFactors = FALSE)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js)
)
)
})
}
shinyApp(ui, server)
EDIT
library(shiny)
library(DT)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(value, item){
as.character(tags$option(value = value, item))
}, c("",values), c("",items)
), collapse = ""))
as.character(
tags$select(
id = id, class = "form-control", multiple = "multiple", options
)
)
}
words1 <- c("apple", "banana")
words2 <- c("olive", "tomato")
js <- c(
"function(settings) {",
sprintf("var words1 = [%s];", toString(shQuote(words1))),
sprintf("var words2 = [%s];", toString(shQuote(words2))),
" $('#slct1').selectize({items: words1});",
" $('#slct2').selectize({items: words2});",
" Shiny.setInputValue('slct1', words1);",
" Shiny.setInputValue('slct2', words2);",
"}"
)
ui <- fluidPage(
br(),
verbatimTextOutput("words1"),
DTOutput("table"),
div( # this is a hidden selectize input whose role is to make
# available 'selectize.js'
style = "display: none;",
selectInput("id", "label", c("x", "y"))
)
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = c("bar", "baz"),
Words = c(
selector("slct1", words1),
selector("slct2", words2)
),
stringsAsFactors = FALSE
)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); }'
)
)
)
}, server = FALSE)
output[["words1"]] <- renderPrint({
input[["slct1"]]
})
}
shinyApp(ui, server)
EDIT
With the counts:
library(shiny)
library(DT)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(value, item){
as.character(tags$option(value = value, item))
}, c("",values), c("",items)
), collapse = ""))
as.character(
tags$select(
id = id, class = "form-control", multiple = "multiple", options
)
)
}
words1 <- c("apple", "banana")
words2 <- c("olive", "tomato")
js <- c(
"function(settings) {",
sprintf("var words1 = [%s];", toString(shQuote(words1))),
sprintf("var words2 = [%s];", toString(shQuote(words2))),
" var table = this.api().table();",
" $('#slct1').selectize({",
" items: words1,",
" onChange: function(value) {",
" var count = value.length;",
" table.cell(0,2).data(count);",
" }",
" });",
" $('#slct2').selectize({",
" items: words2,",
" onChange: function(value) {",
" var count = value.length;",
" table.cell(1,2).data(count);",
" }",
" });",
" Shiny.setInputValue('slct1', words1);",
" Shiny.setInputValue('slct2', words2);",
"}"
)
ui <- fluidPage(
br(),
verbatimTextOutput("words1"),
DTOutput("table"),
div( # this is a hidden selectize input whose role is to make
# available 'selectize.js'
style = "display: none;",
selectInput("id", "label", c("x", "y"))
)
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = c("bar", "baz"),
Words = c(
selector("slct1", words1),
selector("slct2", words2)
),
Count = c(length(words1), length(words2)),
stringsAsFactors = FALSE
)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); }'
)
)
)
}, server = FALSE)
output[["words1"]] <- renderPrint({
input[["slct1"]]
})
}
shinyApp(ui, server)
EDIT
For an arbitrary number of rows:
library(shiny)
library(DT)
library(jsonlite)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(value, item){
as.character(tags$option(value = value, item))
}, c("", values), c("", items)
), collapse = ""))
as.character(
tags$select(
id = id, class = "form-control", multiple = "multiple", options
)
)
}
words <- list(
c("apple", "banana"),
c("olive", "tomato")
)
nrows <- length(words)
js <- c(
"function(settings) {",
sprintf("var nrows = %d;", nrows),
sprintf("var words = %s;", toJSON(words)),
" var table = this.api().table();",
" function selectize(i) {",
" $('#slct' + i).selectize({",
" items: words[i-1],",
" onChange: function(value) {",
" table.cell(i-1, 2).data(value.length);",
" }",
" });",
" }",
" for(var i = 1; i <= nrows; i++) {",
" selectize(i);",
" Shiny.setInputValue('slct' + i, words[i-1]);",
" }",
"}"
)
ui <- fluidPage(
br(),
verbatimTextOutput("words1"),
DTOutput("table"),
div( # this is a hidden selectize input whose role is to make
# available 'selectize.js'
style = "display: none;",
selectInput("id", "label", c("x", "y"))
)
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = c("bar", "baz"),
Words = vapply(
1:nrows,
function(i){
selector(paste0("slct", i), words[[i]])
},
character(1)
),
Count = lengths(words),
stringsAsFactors = FALSE
)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); }'
)
)
)
}, server = FALSE)
output[["words1"]] <- renderPrint({
input[["slct1"]]
})
}
shinyApp(ui, server)
Here is another version. It uses the JavaScript library select2 instead of selectize. I find this one more convenient for the removal of the selected options: they are removed on clicking, while with selectize one needs the keyboard to remove an option.
library(shiny)
library(DT)
selector <- function(id, values, items = values){
options <- HTML(paste0(mapply(
function(value, item){
as.character(tags$option(value = value, selected = "selected", item))
}, values, items
), collapse = ""))
as.character(
tags$select(
id = id, multiple = "multiple", options
)
)
}
words <- list(
c("apple", "banana"),
c("olive", "tomato")
)
nrows <- length(words)
js <- c(
"function(settings) {",
sprintf("var nrows = %d;", nrows),
" var table = this.api().table();",
" function selectize(i) {",
" var $slct = $('#slct' + i);",
" $slct.select2({",
" width: '100%',",
" closeOnSelect: false",
" });",
" $slct.on('change', function(e) {",
" table.cell(i-1, 2).data($slct.val().length);",
" });",
" }",
" for(var i = 1; i <= nrows; i++) {",
" selectize(i);",
" }",
"}"
)
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/css/select2.min.css"),
tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.13/js/select2.min.js")
),
br(),
verbatimTextOutput("words1"),
DTOutput("table")
)
server <- function(input, output, session) {
output[["table"]] <- renderDT({
dat <- data.frame(
FOO = c("bar", "baz"),
Words = vapply(
1:nrows,
function(i){
selector(paste0("slct", i), words[[i]])
},
character(1)
),
Count = lengths(words),
stringsAsFactors = FALSE
)
datatable(
data = dat,
selection = "none",
escape = FALSE,
rownames = FALSE,
options = list(
initComplete = JS(js),
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); }'
)
)
)
}, server = FALSE)
output[["words1"]] <- renderPrint({
input[["slct1"]]
})
}
shinyApp(ui, server)

Shiny datatable mode editable - restrict specific columns AND ROWS

I would like to restrict editable mode in datatable for columns and rows.
For the moment, in this minimal example, I can edit only specific columns but it doesn't work for restrict rows (not allow rows 1 to 5).
Does anyone have an idea?
Thank you for advance
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(DTOutput('tbl')),
server = function(input, output) {
output$tbl = renderDT(
datatable(data = iris,
options = list(lengthChange = FALSE),
editable = list(target = 'column', disable = list(columns = c(1:3), rows = c(1:5))))
)
}
)
You can adapt the code from the link I provided as shown below.
library(shiny)
library(DT)
disabled_rows = paste0("'", paste0("row", c(1,2,3)), "'") ### disabled rows are listed here
rowCallback <- c(
"function(row, data, displayNum, displayIndex){",
sprintf(" var indices = [%s];", toString(disabled_rows)),
" if(indices.indexOf($(row).attr('id')) > - 1){",
" $(row).find('td').addClass('notselectable').css({'background-color': '#eee', 'color': '#bbb'});",
" }",
"}"
)
get_selected_rows <- c(
"var id = $(table.table().node()).closest('.datatables').attr('id');",
"table.on('click', 'tbody', function(){",
" setTimeout(function(){",
" var indexes = table.rows({selected:true}).indexes();",
" var indices = Array(indexes.length);",
" for(var i = 0; i < indices.length; ++i){",
" indices[i] = indexes[i];",
" }",
" Shiny.setInputValue(id + '_rows_selected', indices);",
" }, 0);",
"});"
)
drag_selection <- c(
"var dt = table.table().node();",
"$(dt).selectable({",
" distance : 10,",
" selecting: function(evt, ui){",
" $(this).find('tbody tr').each(function(i){",
" if($(this).hasClass('ui-selecting')){",
" table.row(i).select();",
" }",
" });",
" }",
"}).on('dblclick', function(){table.rows().deselect();});"
)
dat <- iris
dat$ID <- paste0("row", 1:nrow(iris))
rowNames <- TRUE
colIndex <- as.integer(rowNames)
shinyApp(
ui = fluidPage(DTOutput('tbl')),
server = function(input, output, session) {
### disable selected rows only
# output$tbl <- renderDT({
#
# datatable(
# dat,
# rownames = rowNames,
# callback = JS(get_selected_rows),
# class = 'hover row-border order-column',
# options = list(
# rowId = JS(sprintf("function(data){return data[%d];}",
# ncol(dat)-1+colIndex)),
# rowCallback = JS(rowCallback),
# select = list(style = "multi", selector = "td:not(.notselectable)")
# ),
# extensions = "Select", selection = 'none'
# )
# }, server = TRUE)
### disable selected rows and columns
output$tbl <- renderDT({
datatable(
dat,
rownames = rowNames,
callback = JS(get_selected_rows),
class = 'hover row-border order-column',
options = list(
lengthChange = FALSE,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(dat)-1+colIndex)),
rowCallback = JS(rowCallback),
select = list(style = "multi", selector = "td:not(.notselectable)")
),
extensions = "Select",
editable = list(target = 'column', disable = list(columns = c(2:3) )), selection = 'none',
)
}, server = TRUE)
### disable selected columns only
# output$tbl = renderDT(
# datatable(data = iris,
# options = list(lengthChange = FALSE),
# #extensions = "Select", selection = 'none',
# editable = list(target = 'column', disable = list( columns = c(2:3) )) )
# )
}
)

DT::datatable is not loaded when combining formatStyle() with JS code in a shiny app

I have a shiny app in which I want the cursor to change when the user hovers over Species column and also I want to format this column with:
%>%
formatStyle('View', color = 'red', backgroundColor = 'orange', fontWeight = 'bold')
But when I add this certain code line my table is not and loaded and is stuck in 'Processing' mode. This does not happen when I delete the JS part for mouse hovering ability. How can I combine them?
rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"var full_text = aData[1] + ','+ aData[2] + ',' + aData[3] + ','+ aData[4];",
"$('td:eq(5)', nRow).attr('title', full_text);", # Tool Tip
"$('td:eq(5)', nRow).css('cursor', 'pointer');", # Cursor icon changes to hand (pointer) on Hover
"}")
app
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("irisTable")
),
server = function(input, output) {
output$irisTable <- DT::renderDataTable({
DT::datatable(datasets::iris,
options = list(rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"var full_text = aData[1] + ','+ aData[2] + ',' + aData[3] + ','+ aData[4];",
"$('td:eq(5)', nRow).attr('title', full_text);", # Tool Tip
"$('td:eq(5)', nRow).css('cursor', 'pointer');", # Cursor icon changes to hand (pointer) on Hover
"}"),pageLength = 5,columnDefs = list(list(className = 'dt-left', targets = "_all"))),rownames= T,
selection = list(mode = 'single', target = 'cell')
)%>%
formatStyle('Species', color = 'red', backgroundColor = 'orange', fontWeight = 'bold')
})
}
)
That's because formatStyle also uses the rowCallback option but the arguments are named row and data, not nRow and nData. You have to use these names and this works:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput("irisTable")
),
server = function(input, output) {
output$irisTable <- renderDT({
datatable(
datasets::iris,
options = list(
rowCallback = JS(
"function(row, data) {",
"var full_text = data[1] + ',' + data[2] + ',' + data[3] + ',' + data[4];",
"$('td:eq(5)', row).attr('title', full_text);", # Tool Tip
"$('td:eq(5)', row).css('cursor', 'pointer');", # Cursor icon changes to hand (pointer) on Hover
"}"),
pageLength = 5,
columnDefs = list(
list(className = 'dt-left', targets = "_all")
)
),
rownames= TRUE,
selection = list(mode = 'single', target = 'cell')
)%>%
formatStyle('Species', color = 'red', backgroundColor = 'orange', fontWeight = 'bold')
})
}
)

How to have a tool tip on hover?

Is there any way I can have a tool tip or a pop over when I hover over the table column names. I basically want to have pop over which describes column names in R SHINY DATA TABLE.
Following is my code which renders a table. I have tried to search a lot on all forums and could not find a working code.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table2")
),
server = function(input, output) {
output$table2<-DT::renderDataTable({
responseDataFilter2_home<-iris[,c(4,3,1)]
displayableData<-DT::datatable(responseDataFilter2_home,options = list(rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"var full_text = aData[1] + ','+ aData[2]",
"$('td:eq(1)', nRow).attr('title', full_text);",
"}")
))#, stringAsFactors = FALSe, row.names = NULL)
},server = TRUE, selection = 'single', escape=FALSE,options=list(paging=FALSE,searching = FALSE,ordering=FALSE,scrollY = 400,scrollCollapse=TRUE,
columnDefs = list(list(width = '800%', targets = c(1)))),rownames=FALSE,colnames="Name")
}
)
This might help you:
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
dataTableOutput("irisTable")
)
)
server <- function(input, output) {
output$irisTable <- renderDataTable(
iris[,c(4,3,1)], callback = JS("var tips = ['Row Names', 'Here goes one explanation', 'Here goes another explanation',
'And here goes a final explanation'],
header = table.columns().header();
for (var i = 0; i < tips.length; i++) {
$(header[i]).attr('title', tips[i]);
}"))
}
shinyApp(ui = ui, server = server)
Hi you can add HTML to the column names over the parameter colnames
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table2")
),
server = function(input, output) {
output$table2<-DT::renderDataTable({
responseDataFilter2_home<-iris[,c(4,3,1)]
displayableData<-DT::datatable(
responseDataFilter2_home,
options = list(rowCallback = JS(
"function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {",
"var full_text = aData[1] + ','+ aData[2]",
"$('td:eq(1)', nRow).attr('title', full_text);",
"}"),
paging=FALSE,
searching = FALSE,
ordering=FALSE,
scrollY = 400,
scrollCollapse=TRUE,
columnDefs = list(
list(width = '800%', targets = c(1)))),
selection = 'single',
escape=FALSE,
rownames=FALSE,
colnames = c(HTML('<span title ="some popup">Here</span>'),HTML('<span title ="some other popup">Are</span>') , HTML('<span title ="yet another popup">Some</span>')))
})
}
)
hope this helps!

Resources