R-epository/DT_options.R at master · ssayols/R-epository · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
# nice looking options for DT, plus some hints on how to contorl certain aspects
# taken from https://gist.github.com/senthilthyagarajan/4448495e2ecb6fd9456cc1924502c43c
library(shiny)
library(DT)

table_frame <-
  function() {
    htmltools::withTags(table(class = 'display',
                              thead(
                                tr(
                                  th(rowspan = 2, 'Latitude'),
                                  th(rowspan = 2, 'Longitude'),
                                  th(rowspan = 2, 'Month'),
                                  th(rowspan = 2, 'Year'),
                                  th(class = 'dt-center', colspan = 3, 'Cloud'),
                                  th(rowspan = 2, 'Ozone'),
                                  th(rowspan = 2, 'Pressure'),
                                  th(rowspan = 2, 'Surface Temperature'),
                                  th(rowspan = 2, 'Temperature'),
                                  tr(lapply(rep(
                                    c('High', 'Low', 'Mid'), 1
                                  ), th))
                                )
                              )))
  }

table_options <- function() {
  list(
    dom = 'Bfrtip',
    #Bfrtip
    pageLength = 10,
    buttons = list(
      c('copy', 'csv', 'excel', 'pdf', 'print'),
      list(
        extend = "collection",
        text = 'Show All',
        action = DT::JS(
          "function ( e, dt, node, config ) {
          dt.page.len(-1);
          dt.ajax.reload();}"
        )
        ),
      list(
        extend = "collection",
        text = 'Show Less',
        action = DT::JS(
          "function ( e, dt, node, config ) {
          dt.page.len(10);
          dt.ajax.reload();}"
        )
        )
        ),
    deferRender = TRUE,
    lengthMenu = list(c(10, 20,-1), c('10', '20', 'All')),
    searching = FALSE,
    editable = TRUE,
    scroller = TRUE,
    lengthChange = FALSE
    ,
    initComplete = JS(
      "function(settings, json) {",
      "$(this.api().table().header()).css({'background-color': '#517fb9', 'color': '#fff'});",
      "}"
    )
      )
}

ui <- fluidPage(
br(),
br(),
  dataTableOutput("output_table"))

server <- function(input, output, session) {
  output$output_table <- DT::renderDataTable({
    as.data.frame(nasa) %>%
      top_n(200) %>%
      DT::datatable(
        rownames = FALSE,
        editable = TRUE,
        class = 'cell-border',
        escape = FALSE,
        container = table_frame(),
        options = table_options(),
        extensions = 'Buttons'
      )
  })

}

shinyApp(ui, server)