Determine if DT datatable is clicked in shiny app - r

Here is a working example of my best attempt to get table click event:
library(shiny)
library(DT)
runApp(shinyApp(
ui = fluidPage(DT::dataTableOutput('table')),
server = function(input, output, session) {
output$table <- DT::renderDataTable({
dt <- data.frame(a = 1)
datatable(dt, rownames = FALSE, selection = 'none')
})
observeEvent(input$table_cell_clicked, {
print(Sys.time())
})}
))
The problem is that observeEvent reacts only if user clicks on the cell which differs from previously clicked. Is there a way to get event on any table click?

I think it s may be helpful
Try add callback with Shiny.onInputChange
and add smth which changed all time ( rnd)
smt like
JS("table.on('click.dt', 'td', function() {
var row_=table.cell(this).index().row;
var col=table.cell(this).index().column;
var rnd= Math.random();
var data = [row_, col, rnd];
Shiny.onInputChange('rows',data );
});")
and then use it like :
library(shiny)
library(DT)
runApp(shinyApp(
ui = fluidPage(DT::dataTableOutput('table')),
server = function(input, output, session) {
output$table <- DT::renderDataTable({
datatable(data.frame(a = c(1,2),b=c(2,3)), rownames = FALSE, selection = 'none', callback = JS("table.on('click.dt', 'td', function() {
var row_=table.cell(this).index().row;
var col=table.cell(this).index().column;
var rnd= Math.random();
var data = [row_, col, rnd];
Shiny.onInputChange('rows',data );
});")
)}
)
observeEvent(input$rows, {
print(input$rows)
print(Sys.time())
})}
))
Then parse all row and col from input$rows
PS. in datatables index start from 0 .

Related

shinyApp - How to copy a value from selectInput and paste to a reactive table

I want to copy values from a selectInput and paste it to a reactive table. Below is an example.
library(shiny)
library(tidyverse)
library(DT)
df<-data.frame("Name" = c("apple","cherry"),
"Value" = c(5,6))
ui <- fluidPage(
uiOutput("fruit"),
fluidRow(DT::DTOutput("table1")))
server <- function(input, output, session) {
df1 <- reactiveValues(data = {df})
output$table1 = DT::renderDT({
DT::datatable(df1$data, editable = T)
})
output$fruit <- renderUI({
selectInput(
inputId = "fruit_name",
label = "Name",
multiple = TRUE,
choices = c("apple","cherry","pear", "peach","banana"),
selected = "apple"
)
})
}
shinyApp(server = server, ui = ui)
I hope to be able to choose a fruit name from selectInput, copy it, and paste it to the table under column "Name". It seems shinyApp doesn't support regular copy and paste. Anyway to do it? Thanks!
It's impossible to select the text inside an item. With the code below, you can select an item and use Ctrl-C and Ctrl-V to copy and paste it.
js <- '
document.addEventListener("copy", (event) => {
const anchorNode = document.getSelection().anchorNode;
if (anchorNode instanceof HTMLElement &&
anchorNode.classList.contains("selectize-input")) {
const items = Array.from(anchorNode.getElementsByClassName("item active"));
const string = items.map(i => i.innerText).join(", ");
event.clipboardData.setData("text/plain", string);
event.preventDefault();
}
})
'
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
uiOutput("fruit"),
fluidRow(DTOutput("table1"))
)

How do I attach a click listener to a datatable in DT and Shiny?

I have a Shiny app where I try to attach a click listener to a datatable row.
Here's my code:
require(DT)
require(data.table)
ui <- fluidPage(
fluidRow(
titlePanel("Data Explorer")
),
fluidRow(
column(
DT::dataTableOutput("listTable"),
width = 4
),
column(
width = 8
)
)
)
get.data <- function() {
res <- data.table(a = c(1,2,3), b = c(4,5,6))
return(res)
}
server <- function(input, output) {
output$listTable <- DT::renderDataTable({
showModal(modalDialog("Fetching Data..."))
dt <- datatable(get.data(),
rownames = FALSE,
options = list(autoWidth = TRUE,
selection = 'none',
callback = JS("$('#listTable tbody').on('click.dt', 'tr', function() { console.log('foo'); })")))
removeModal()
return(dt)
})
}
shinyApp(ui = ui, server = server)
All the examples I found via googling have used the implicitly provided table variable to find the root element, but when I try to do that, I just get a ReferenceError: table is not defined.
So I've used a direct JQuery search instead. When I use console.log('foo') as the callback, it works fine. But when I try to attach a listener as I do above, it doesn't attach. When I copy-paste that exact same code into my Firefox console on the page, it works.
What's the issue here?
callback is an argument of the datatable function, it does not belong to the options list. So you have to do like this:
dt <- datatable(
get.data(),
rownames = FALSE,
callback = JS("table.on('click', 'tr', function() { alert('foo'); })"),
options = list(
autoWidth = TRUE,
selection = 'none'
)
)

Shiny and DT: how to reset an output that depends on calculations over inputs?

I really had trouble finding a title for this question, hope it helps.
I have a fairly complex app for which I'm having trouble resetting an output after an actionButton ("Confirm" on this example) triggers the re-evaluation of a reactiveValues number that feeds a reactive table.
This causes that the selected table only renders once and no matter how many times the table that feeds it changes, it keeps showing the same result as the first time it was rendered.
It will be easy for you to see what I mean from this example. Believe me, it is the minimax from the one I'm coming from:
library(shiny)
library(DT)
ui <- fluidPage(
DTOutput("table"),
actionButton("checkvalues", "Check")
)
server <- function(input, output, session) {
primedata <- reactiveValues(data = NULL)
primedata$data <- as.numeric(Sys.time()) %% 10000
tabledata <- reactive({
data <- data.frame(rep(primedata$data, 5))
for (i in 1:5) {
data$V1[i] <- as.character(selectInput(paste0("sel", i), "",
choices = c("None selected" = 0,
"Icecream", "Donut"),
selected = 0, width = "120px"))
}
return(data)
})
output$table <- renderDataTable( #Generar tabla
tabledata(), filter = 'top', escape = FALSE, selection = 'none', server = 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());")
)
# helper function for reading inputs in DT
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
observeEvent(input$checkvalues, {
datos <- tabledata()
selected <- cbind(datos, data.frame(N = shinyValue("sel", nrow(datos))))
selected <- selected %>% group_by(N) %>% summarise("see" = n())
showModal(modalDialog(
title = HTML('<h3 style="text-align:center;">Problem: this table will keep showing the same results as the first one presented</h3>'),
renderDT(datatable(selected, options = list(dom = 't', ordering = F))),
footer = actionButton("Confirm", "Confirm")))
})
observeEvent(input$Confirm, {
primedata$data <- as.numeric(Sys.time()) %% 10000
removeModal()
})
}
shinyApp(ui, server)
When you change primedata$data (by clicking on the Confirm button) this re-renders the table, and you have to unbind before:
ui <- fluidPage(
tags$head(tags$script(
HTML(
"Shiny.addCustomMessageHandler('unbindDT', function(id) {
var $table = $('#'+id).find('table');
if($table.length > 0){
Shiny.unbindAll($table.DataTable().table().node());
}
})")
)),
DTOutput("table"),
actionButton("checkvalues", "Check")
)
observeEvent(input$Confirm, {
session$sendCustomMessage("unbindDT", "table")
primedata$data <- as.numeric(Sys.time()) %% 10000
removeModal()
})

How to download datatable after editing in shiny

I have about 20 thousand images in a datatable in a shiny application. I want to delete images I dont like and then download the resulting datatable (just with pathnames to the images I want).
I have managed to see a dataframe with each row showing me an image. I can delete rows I dont like. I'd like now to be able to download the dataframe (just with the paths of the files rather than the actual images) into a csv. I don't seem to be able to do this using the downloadHandler. What am I missing?
Here is my code:
server.R
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
server<-shinyServer(function(input, output) {
vals<-reactiveValues()
vals$Data<-data.table(
df
)
output$MainBody<-renderUI({
fluidPage(
box(width=12,
hr(),
column(12,dataTableOutput("Main_table")),
tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),
tags$script("$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});")
)
)
})
output$downloadData <- downloadHandler(
filename = function() {
paste(input$Main_table, ".csv", sep = "")
},
content = function(file) {
write.csv(vals$Data, file, row.names = FALSE)
}
)
output$Main_table<-renderDataTable({
DT=vals$Data
datatable(DT,
escape=F)}
)
})
ui.R
ui<-fluidPage(dashboardHeader(disable = T),
dashboardSidebar(disable = T),
downloadLink("downloadData", "Download"),
dashboardBody(uiOutput("MainBody")
)
)
# Run the application
shinyApp(ui = ui, server = server)
The problem is that df is a function from library(stats). Please see ?df. Please, never use df as a variable name - this only causes confusion; take DF instead. You wrapped this function into data.table() and passed it into a reactiveValue (see the print() I added).
This construct is treated as a list() by write.csv() and it doesn't know what do do with a list() causing the following error:
Error in write.table: unimplemented type 'list' in 'EncodeElement'
Accordingly you might want to fix your data.table initialization by e.g. passing NULL instead of df:
library(shiny)
library(shinydashboard)
library(data.table)
library(DT)
server <- shinyServer(function(input, output) {
vals <- reactiveValues(myTabData = data.table(NULL))
vals$Data <- data.table(df)
print(paste("myData:", isolate(vals$Data)))
output$MainBody <- renderUI({
fluidPage(box(
width = 12,
hr(),
column(12, dataTableOutput("Main_table")),
tags$script(
HTML(
'$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {
if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}
}
Shiny.onInputChange("checked_rows",checkboxesChecked);})'
)
),
tags$script(
"$(document).on('click', '#Main_table button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())});"
)
))
})
output$downloadData <- downloadHandler(
filename = function() {
"Main_table.csv"
},
content = function(file) {
write.csv(vals$myTabData, file, row.names = FALSE)
# Warning: Error in write.table: unimplemented type 'list' in 'EncodeElement'
# write.csv(vals$Data, file, row.names = FALSE)
}
)
output$Main_table <- renderDataTable({
DT = vals$Data
datatable(DT, escape = FALSE)
})
})
ui <- fluidPage(
dashboardHeader(disable = T),
dashboardSidebar(disable = T),
downloadLink("downloadData", "Download"),
dashboardBody(uiOutput("MainBody"))
)
shinyApp(ui = ui, server = server)
Furthermore you should fix your filename (input$Main_table is not existing)

DT datatable row is not highlighted when using custom callback in a shiny app

I am following this example of how to get elements from a row that is clicked on. This works fine except it does not highlight the selected row. Here is the code:
library(DT)
library(shiny)
runApp(shinyApp(
ui = fluidPage(DT::dataTableOutput('tab'), verbatimTextOutput('row')),
server = function(input, output) {
output$tab = DT::renderDataTable({
datatable(iris, selection = 'single',
callback = JS("table.on('click.dt', 'tr',
function() {
$(this).toggleClass('selected');
Shiny.onInputChange('row', table.rows('.selected').data().toArray());
});")
)
})
output$row = renderText({input$row})
}
))
Why not existed in DT input$..._rows_selected ?
like
library(shiny)
library(DT)
runApp(shinyApp(
ui = fluidPage(DT::dataTableOutput('tab'), verbatimTextOutput('row')),
server = function(input, output) {
output$tab = DT::renderDataTable({
datatable(iris, selection = "single"
)
})
output$row = renderText({if(length(input$tab_rows_selected)>0) paste(input$tab_rows_selected,as.character(iris[input$tab_rows_selected,]))})
}
))
Update
for example your have dunamic data
dt1=reactive({
return(iris[iris$Species %in% c("setosa","versicolor"),])})
There may be any other data operation
than your code will be
runApp(shinyApp(
ui = fluidPage(DT::dataTableOutput('tab'), verbatimTextOutput('row')),
server = function(input, output) {
dt1=reactive({
return(iris[iris$Species %in% c("setosa","versicolor"),])})
output$tab = DT::renderDataTable({
datatable(dt1(), selection = "single"
)
})
output$row = renderText({if(length(input$tab_rows_selected)>0) paste(input$tab_rows_selected,as.character(dt1()[input$tab_rows_selected,]))})
}
))
My DT version 0.1.45
Update 2
dont know why but i think $(this).toggleClass('selected');
delete class selected which added in standart DT package(toggleClass used twice and you see nothing) .
try
JS("table.on('click.dt', 'tr',
function() {
Shiny.onInputChange('row', table.rows(this).data().toArray());
});")
Or set selection='none'

Resources