Shiny Datatable in Landscape Orientation

DT Package PDF Extension Button

You can use the customize callback of the pdf extension to change the pdfMake options, which is the workhorse of the pdf rendering. For example you can set the column width such that each column uses only a percentage of the total width.

Similarly, you can change the styling of the title with the same idea:

library(shiny)
library(DT)

js_cb <- JS("function(pdf_opts, btn, dt) {
let n = pdf_opts.content[1].table.body[0].length;
// each column occupies a percentage of the total width
let widths = Array(n).fill(100 / n + '%');
pdf_opts.content[1].table.widths = widths;
pdf_opts.styles.title.fontSize = 8; // change fontsize
}")

data <- cbind(iris,iris,iris)

shinyApp(
ui = fluidPage(DT::dataTableOutput('tbl')),
server = function(input, output) {
output$tbl = DT::renderDataTable(
data,
extensions = "Buttons",
options = list(dom = "Bt",
buttons = list(list(extend = "pdf",
pageSize = "A4",
orientation = "landscape",
filename = "tt",
customize = js_cb,
title = "A smaller title here")))
)
}
)

How to excract data from edited datatable in shiny

You need to define a reactiveValues data frame. Then you need to update it via observeEvent whenever any cell is modified via mytable_cell_edit. The updated dataframe is now available in the server side, and part of it is now printed in the second table. You can use DF1$data for further analysis or subsetting. Full updated code is below.

library(shiny)
library(dplyr)
library(DT)

line<-c(1,1,1,1,1)
op<-c(155,155,155,156,156)
batch<-c(1,2,3,1,2)
voile<-c(1,NA,NA,NA,NA)
depot<-c(2,NA,2,NA,NA)

boe<-data.frame(line,op,batch)

ui <- fluidPage(

# Application title
titlePanel("test dust"),

actionButton("refresh", label = "refresh"),

DTOutput("mytable"), DTOutput("tb2"),

actionButton("save", label = "save"),

)

# Define server logic required to draw a histogram
server <- function(input, output) {
DF1 <- reactiveValues(data=NULL)

DTdust<- eventReactive(input$refresh, {
req(input$refresh)
DTdust <-data.frame(line,op,batch,voile,depot)
})

merged<-reactive({
req(DTdust())
merged<-merge(boe,DTdust(),all.x = TRUE)
})

mergedfiltred<-reactive({
mergedfiltred <- filter(merged(),is.na(voile)|is.na(depot) )
DF1$data <- mergedfiltred
mergedfiltred
})

output$mytable = renderDT(
mergedfiltred(),
editable = list(target = 'cell', disable = list(columns = c(1:3))), selection = 'none'
)

observeEvent(input$mytable_cell_edit, {
info = input$mytable_cell_edit
str(info)
i = info$row
j = info$col
v = info$value

DF1$data[i, j] <<- DT::coerceValue(v, DF1$data[i, j])
})

output$tb2 <- renderDT({
df2 <- DF1$data[,2:5]
plen <- nrow(df2)
datatable(df2, class = 'cell-border stripe',
options = list(dom = 't', pageLength = plen, initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}")))

})

}

# Run the application
shinyApp(ui = ui, server = server)

output

Printing like a character but sorting like numeric in Shiny and DataTable

A bit late, but the DT Package now has format functions, including formatCurrency:

# format the columns A and C as currency, and D as percentages
datatable(m) %>% formatCurrency(c('A', 'C')) %>% formatPercentage('D', 2)

From the Functions page:

Under the hood, these formatting functions are just wrappers for the rowCallback option to generate the appropriate JavaScript code.
Similarly, there is a formatDate() function that can be used to format date/time columns. It has a method argument that takes values from a list of possible conversion methods: toDateString, toISOString, toLocaleDateString, toLocaleString, toLocaleTimeString, toString, toTimeString, toUTCString.

stripes for DT::datatable

You can try using the following rowCallback funtion:

DT::datatable(ds,
options=list(info=F, searching=F, paging=F,
rowCallback=JS(
'function(row,data) {
if($(row)["0"]["_DT_RowIndex"] % 6 <3)
$(row).css("background","orange")
}'))) %>% formatRound("value2",2)

Basically you can get the DT row index $(row)["0"]["_DT_RowIndex"] and use the modulo % operator to color rows.

Select text in htmlOutput based on datatable in shiny

You can use gsub to wrap the selected text in a span with a CSS attribute to change the background color.

In your server.R, you could try (ellipsis where code doesn't change):

server <- function(input, output) {
sample_text = "A sample sentence for demo purpose";
output$content <- renderText(sample_text)

.....

observeEvent(input$pairs_cell_clicked,{

.....

output$content <- renderText(HTML(gsub(info$value,paste0("<span style='background-color:orange'>",info$value,"</span>"),sample_text)))
})
}

EDIT:

To mimic the user selecting the text using his mouse you could do:

select_text = JS(
'table.on("click.td", "tr", function () {
contentdiv = document.getElementById("content");
var selectedCell=this.lastChild;
var sentence = contentdiv.innerHTML;
var target = selectedCell.innerHTML;
var sentenceIndex = sentence.indexOf(target);
selection = window.getSelection();
range = document.createRange();
range.setStart(contentdiv.firstChild, sentenceIndex);
range.setEnd(contentdiv.firstChild, (sentenceIndex + target.length));
selection.removeAllRanges();
selection.addRange(range);
})'
)

server <- function(input, output) {
sample_text = "A sample sentence for demo purpose";
output$content <- renderText(sample_text)
df <- data.frame(SrNo=1:5, Pairs=c("A sample", "sample sentence",
"sentence for", "for demo", "demo purpose"))
output$pairs <- renderDataTable({datatable(df, selection = "single", callback=select_text)})

observeEvent(input$pairs_cell_clicked,{
info = input$pairs_cell_clicked
if(is.null(info$value)) return()
output$selection <- renderText(info$value)
})
}

JS inspired from this answer.



Related Topics



Leave a reply



Submit