Is there any way to define multiple javascripts in DT Shiny? I have dropdowns at each row of table. I want some dropdowns to be selected as 'Prevention' by default? I want to define the following JS code in DT. This code sets 5th drop down (from top) to be assigned as 'Prevention'. But it's not working.
function setSelectedIndex(s, valsearch)
for (i = 0; i< s.options.length; i++)
{
if (s.options[i].value == valsearch)
{
s.options[i].selected = true;
break;
}
}
return;}
setSelectedIndex(document.getElementById('selecter_5'),'Prevention');
The code below is the main Shiny code I am using -
library(shiny)
library(DT)
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
runApp(list(
ui = basicPage(
h2('The mtcars data'),
DT::dataTableOutput('mytable'),
h2("Selected"),
tableOutput("checked")
)
,
server = function(input, output) {
# datatable with checkbox
output$mytable = DT::renderDataTable({
#Display table with select
DT::datatable(cbind(Pick=paste0('
<select id="selecter_', mymtcars$id, '">
<option disabled selected>Choose Status</option>
<option>Non-Fraud</option>
<option>Fraud</option>
<option>Prevention</option>
</select>',""), mymtcars),
extensions = c('Scroller'),
filter = 'top',
selection=list(mode = 'multiple'),
options = list(
scrollX = TRUE,
scroller = TRUE,
scrollY = "400px",
orderClasses = TRUE,
pageLength = 50,
fixedHeader = TRUE,
dom = 'Bfrtip',
drawCallback= JS(
'function(settings) {
Shiny.bindAll(this.api().table().node());}'
)), escape=F) }, server = T)
# helper function for reading checkbox
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
# output read checkboxes
output$checked <- renderTable({
data.frame(selected=shinyValue("selecter_",nrow(mtcars)))
})
}))
Related
I am trying to place a button inside the datatable where if the user wants to reset the sorted column they can hit the button and table gets reset or changed to it's original order. At the moment, when I press the button, it is not triggering any event on click. The event should replace the data in the server part.
I am currently following these posts:
shiny DT datatable - reset filters
https://github.com/rstudio/DT/issues/76
Reset a DT table to the original sort order
However, in the last two posts above, even though they get the job done, the button is not part of the datatable.
Here is my reprex:
library(DT)
library(shiny)
library(shinyjs)
# function placed in the global.R
clearSorting <- function(proxy) {
shinyjs::runjs(paste0("$('#' + document.getElementById('", proxy$id,"').getElementsByTagName('table')[0].id).dataTable().fnSort([]);"))
}
# ui.R
ui <- fluidPage(
DT::DTOutput(outputId = "table"),
shinyjs::useShinyjs()
)
# servcer.R
server <- function(input, output) {
output$table <- renderDT({
DT::datatable(data = iris,
filter = 'top',
extensions = c('Buttons'),
options = list(scrollY = 600,
scrollX = TRUE,
autoWidth = TRUE,
dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
buttons = list(
list(
extend = '',
text = 'Reset Table',
action = JS("function() {document.getElementById('reset_sort').click();}")
)
),
scrollCollapse= TRUE,
lengthChange = TRUE,
widthChange= TRUE))
})
observeEvent(input$reset_sort, {
data <- iris
clearSorting(proxy = DT::dataTableProxy(outputId = "table"))
DT::replaceData(proxy = DT::dataTableProxy(outputId = "table"),
data = data,
rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
Here is a way:
library(DT)
js <- c(
"function(e, dt, node, config){",
" dt.iterator('table', function(s){",
" s.aaSorting.length = 0;",
" s.aiDisplay.sort(function(a,b){",
" return a-b;",
" });",
" s.aiDisplayMaster.sort(function(a,b){",
" return a-b;",
" });",
" }).draw();",
"}"
)
datatable(
iris,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
list(
extend = "collection",
text = "Reset columns order",
action = JS(js)
)
)
)
)
To use it in Shiny, you may need to set server = FALSE in renderDT:
output$table <- renderDT({
......
}, server = FALSE)
I'm not proficient in Javascript and would like to replicate a dropdown function as is available in the rhandsontable package but for the DT package.
How could this be achieved in the most efficient way?
Example
library(DT)
i <- 1:5
datatable(iris[1:20, ],
editable = T,
options = list(
columnDefs = list(
list(
targets = 5,
render = JS(
# can't get my head around what should be in the renderer...
)
))
))
The goal is to have the i variable act as validator for the allowed input in the DT object.
Any help is much appreciated!
I blatantly stole the idea from Yihui's app for including radioButtons in DT.
Code:
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'),
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());")
)
output$sel = renderPrint({
str(sapply(1:nrow(data), function(i) input[[paste0("sel", i)]]))
})
}
shinyApp(ui, server)
Output:
In the code below, I am saving user selected rows into CSV file. It is working perfectly fine. Problem arises if I add filter='top', selection = 'multiple' in datatable() function then it stops returning row value (row position). The user-defined function rowSelect() returns row value.
See the complete code below -
library(shiny)
library(RODBC)
library(DT)
library(shinyalert)
mydata = mtcars
mydata$id = 1:nrow(mydata)
d = data.frame(stringsAsFactors = F)
runApp(
list(ui = pageWithSidebar(
headerPanel('Examples of Table'),
sidebarPanel(
textInput("collection_txt",label="RowIndex")
,br(),useShinyalert(),
actionButton("run", "Write Data"),
br(),
p("Writeback with every user input. CSV file gets saved on your working directory!")),
mainPanel(
DT::dataTableOutput("mytable")
))
, server = function(input, output, session) {
shinyInput <- function(FUN,id,num,...) {
inputs <- character(num)
for (i in seq_len(num)) {
inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
}
inputs
}
rowSelect <- reactive({
rows=names(input)[grepl(pattern = "srows_",names(input))]
paste(unlist(lapply(rows,function(i){
if(input[[i]]==T){
return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
}
})))
})
observe({
updateTextInput(session, "collection_txt", value = rowSelect() ,label = "RowIndex:" )
})
df_subset <- reactive({
d = data.frame(n = rowSelect(), stringsAsFactors = F)
return(d)
})
observeEvent(input$run, {write.csv(mydata[as.numeric(df_subset()$n),], file = "Writeback.csv" , row.names=F)
shinyalert(title = "Task Completed!", type = "success")})
output$mytable = DT::renderDataTable({
DT::datatable(cbind(Flag=paste0('<input type="checkbox" id="srows_', mydata$id, '" value="', mydata$id, '">',""),
mydata), extensions = 'Buttons', options = list(orderClasses = TRUE,
pageLength = 5, lengthChange = FALSE, dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel'),
drawCallback= JS(
'function(settings) {
Shiny.unbindAll(this.api().table().node());
Shiny.bindAll(this.api().table().node());}')
),escape=F)
}
)
}), launch.browser = T
)
Any help would be highly appreciated!
The tables displayed through the DataTables interface from DT package appear messy (e.g. disordered elements, strange looking pagination ...) when using reactive values which their input come from the rows selected in the first table. Using R version 3.4.3, and shiny 1.1.0 and DT 0.4 which both are sourced from CRAN.
The minimal code:
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("dt"),
actionButton("go", "Go"),
wellPanel(DT::dataTableOutput("selected"))
)
server <- function(input, output, session) {
output$dt <- DT::renderDataTable({
DT::datatable(
mtcars,
style = 'bootstrap',
filter = 'top',
rownames = FALSE,
extensions = 'Buttons',
selection = list(mode = 'single'),
options = list(
pageLength = 10,
dom = '<"top"ifl>t<"bottom"Bp>',
buttons = c('copy', 'csv', 'excel'),
searchHighlight = TRUE
)
)
})
rv <- reactiveValues(val = FALSE)
observeEvent(input$go, {
rv$val <- input$go
})
observeEvent(input$dt_rows_selected, {
rv$val <- FALSE
})
output$selected <- DT::renderDataTable({
if (rv$val == FALSE)
return()
reactive({
validate(need(input$dt_rows_selected != "", "Select a row."))
mtcars[input$dt_rows_selected, ]
}) -> .mtcars
isolate({
DT::datatable(
.mtcars(),
style = 'bootstrap',
filter = 'top',
rownames = FALSE,
extensions = 'Buttons',
selection = list(mode = 'single'),
options = list(
pageLength = 10,
dom = '<"top"ifl>t<"bottom"Bp>',
buttons = c('copy', 'csv', 'excel'),
searchHighlight = TRUE
)
) -> table
})
table
})
}
shinyApp(ui, server)
It looks decent without the second table:
The issue is caused by the part style = 'bootstrap' which does not work well with return(NULL). Replacing if (rv$val == FALSE) return() with req(rv$val) in the output has solved the problem. Has taken the reference here.
I am trying to navigate to another datatable tab in R shiny on clicking a row in the first datatable.
I see similar examples here.
However I am not able to use them as I am fetching data from database directly in to the datatable.
Hyperlink from one DataTable to another in Shiny
Can you guide me how to complete it?
output$TbTable <- DT::renderDataTable(datatable(sqlOutput(),style = 'bootstrap', class = 'table-striped table-hover table-condensed',
extensions = c("FixedColumns","Scroller"),
filter = 'top',
options = list(
# dom = 't',
# deferRender = TRUE,
searching = TRUE,
autoWidth = TRUE,
# scrollCollapse = TRUE,
rownames = FALSE,
scroller = TRUE,
scrollX = TRUE,
scrollY = "500px",
#fixedHeader = TRUE,
class = 'cell-border stripe',
fixedColumns = list(
leftColumns = 3,
heightMatch = 'none', escape = FALSE,
options = list(initComplete = JS(
'function(table) {
table.on("click.dt", "tr", function() {
Shiny.onInputChange("rows", table.row( this ).index());
tabs = $(".tabbable .nav.nav-tabs li a");
$(tabs[1]).click();
});
}'))
))))
Can you help me on this?
Thanks,
I am not so deeply involved with DT but this JS callback function works:
function(settings, json) {
var table = this.DataTable();
table.on("click.dt", "tr", function() {
Shiny.onInputChange("rows", table.row( this ).index());
var tabs = $(".tabbable .nav.nav-tabs li a");
$(tabs[1]).click();
});
}
MRE:
library(shiny)
library(ggplot2) # for the diamonds dataset
library(htmlwidgets)
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset === "diamonds"',
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
),
conditionalPanel(
'input.dataset === "mtcars"',
helpText("Click the column header to sort a column.")
),
conditionalPanel(
'input.dataset === "iris"',
helpText("Display 5 records by default.")
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("diamonds", DT::dataTableOutput("mytable1")),
tabPanel("mtcars", DT::dataTableOutput("mytable2")),
tabPanel("iris", DT::dataTableOutput("mytable3"))
)
)
)
)
jss <- '
function(settings, json) {
var table = this.DataTable();
table.on("click.dt", "tr", function() {
Shiny.onInputChange("rows", table.row( this ).index());
var tabs = $(".tabbable .nav.nav-tabs li a");
$(tabs[1]).click();
});
}'
server <- function(input, output) {
# choose columns to display
diamonds2 = diamonds[sample(nrow(diamonds), 1000), ]
output$mytable1 <- DT::renderDataTable({
DT::datatable(diamonds2[, input$show_vars, drop = FALSE], options = list(initComplete = JS(jss)))
})
# sorted columns are colored now because CSS are attached to them
output$mytable2 <- DT::renderDataTable({
DT::datatable(mtcars, options = list(orderClasses = TRUE))
})
# customize the length drop-down menu; display 5 rows per page by default
output$mytable3 <- DT::renderDataTable({
DT::datatable(iris, options = list(initComplete = JS(jss)))})
}
shinyApp(ui, server)