R/lopo_viewer.R

In kismet303/lopo3000: LoPo 3000 Experimental package using RShiny for interactive LoPo

lopo_viewer <- function(df, ns) {
DT::datatable(df, 
              options = list(
                dom = 't',
                initComplete = htmlwidgets::JS(
                  "function(settings, json) {",
                  "$(this.api().table().header()).css({'background-color': 'lightgrey', 'color': '#000', 'font-size': '10px' });",
                  "$(this.api().table().body()).css({   'font-size': '12px',   'text-align': 'center' });",
                  "}"), 
                
                searchHighlight = TRUE,
                columnDefs = list(
                  list(targets = 1, 
                       render = htmlwidgets::JS(paste0( "function(data, type, row, meta) {",
                                                        "if (data == 'NA') {", 
                                                        "return ' <i id=\"buttonss_'+ row[10] +'\" class=\"far fa-times-circle text-danger \" style=\"font-size:30px \" ></i>' }",
                                                        "else  {",
                                                        "return ' <i id=\"buttonsst_'+ row[10] +'\" class=\"far fa-file-alt text-success \"   style=\"font-size:30px \"  onclick=\"Shiny.onInputChange(&quot;",ns("see_button"), "&quot;, this.id + &quot;_&quot; + Math.random())\"></i> ' }",
                                                        "}"))),    
                  
                  list(targets = 2, 
                       render = htmlwidgets::JS(paste0( "function(data, type, row, meta) {",
                                                        "if (data == 'PROG_OK') {", 
                                                        "return ' <i id=\"buttonbb_'+ row[10] +'\" class=\"fas fa-arrow-alt-circle-right text-success \" style=\"font-size:30px \" onclick=\"Shiny.onInputChange(&quot;", ns("run_button"), "&quot;, this.id + &quot;_&quot; + Math.random() )\"></i> ' }",
                                                        "else  {",
                                                        "return ' <i id=\"buttonbbt_'+ row[10] +'\" class=\"fas fa-arrow-circle-up text-danger \"   style=\"font-size:30px \"  onclick=\"Shiny.onInputChange(&quot;",  ns("create_button"), "&quot;, this.id + &quot;_&quot; + Math.random() )\"></i>' }",
                                                        "}"))), 
                  
                  list(targets=3, 
                       render = htmlwidgets::JS(paste0( "function(data, type, row, meta) {",
                                                        "if (data == 'AE') {",
                                                        "return '<small class=\"badge pull-center bg-red\">' + data + ' </small>' }",
                                                        "else if (data == 'Disposition') {",
                                                        "return '<small class=\"badge pull-center bg-yellow\">' + data + ' </small>' }",
                                                        "else if (data == 'Exposure') {",
                                                        "return '<small class=\"badge pull-center bg-green\">' + data + ' </small>' }",
                                                        "else if (data == 'Demography') {",
                                                        "return '<small class=\"badge pull-center bg-teal\">' + data + ' </small>' }",
                                                        "else if (data == 'Con Med') {",
                                                        "return '<small class=\"badge pull-center bg-blue\">' + data + ' </small>' }",
                                                        "else if (data == 'Death') {",
                                                        "return '<small class=\"badge pull-center bg-grey\">' + data + ' </small>' }",
                                                        "else  {",
                                                        "return '<small class=\"badge pull-center bg-violet\">' + data + ' </small>' }",
                                                        "}"))),
                  
                  list(targets = 10, 
                       render = htmlwidgets::JS(paste0( "function(data, type, row, meta) {",
                                                        "return '",
                                                        "<table>",
                                                        "<td align=\"center\"> <button id=\"button_'+ row[10] +'\"   class=\"btn btn-primary btn-xs \" style=\"font-size:7px \" onclick=\"Shiny.onInputChange(&quot;", ns("edit_button"), "&quot;, this.id + &quot;_&quot; + Math.random())\">Edit</button> </td>",
                                                        "<td align=\"center\"> <button id=\"buttonss_'+ row[10] +'\" class=\"btn btn-danger btn-xs\" style=\"font-size:7px \" onclick=\"Shiny.onInputChange(&quot;", ns("del_button"), "&quot;, this.id + &quot;_&quot; + Math.random())\">Delete</button> </td>",
                                                        "</table>'  }"
                       ))),
                  
                  list(targets = 11, visible = FALSE),
                  list(targets = c(1,0),width = '20px'),
                  list(targets = c(3,4),width = '150px'),
                  list(targets = c(2, 5,6,7,8,9),width = '50px'),
                  list(targets = c(10),width = '10px'),
                  list(targets = c(4,5,3),
                       render = htmlwidgets::JS("function(data, type, row, meta) {",
                                                "return type === 'display' && data.length > 50 && data  ?",
                                                "'<p align=\"left\"><span title=\"' +  data + '\">' + data.substr(0, 50) + '...</span></p>' : '<p align=\"left\">' + data + '</p>' ;",
                                                "}")  ) 
                ),
                scrollY = 600, 
                scroller = TRUE,
                scrollX = T,
                pageLength = 25
              ), 
              extensions = c('Buttons','Responsive'))
}

# Testing
# Note Font Awesome icons won't display in testing.
# col_list <- c('See', 'Action', 'Domain', 'Titles', 'Footnotes', 'Filters', 'GDS Template',
#               'Program ID','outType','idbis', 'CRUD')
# s_path <- "inst/example_lopo/BP40657.sqlite"
# file.copy(from = s_path, to = tempdir(), overwrite = TRUE)
# lopo <- getLopo("BP40657", file.path(tempdir(), "BP40657.sqlite"))
# lopo$CRUD <- "Edit - Delete"
# df <- lopo %>% dplyr::select(col_list)
# lopo_viewer(df, NS("id"))