3

If I have a datatable (DT) that contains values, can I have a plotly(a barplot) in blue area based on those values in datatable? For example for variable "Value2", we have a barplot.

enter image description here

I saw this post and I hope it can be done by add some JavaScript code to the above R code.

 # R code
library(dplyr)
library(plotly) 
library(DT)
library(crosstalk)
library(summarywidget)
library(htmltools)
data_2<-structure(list(ID = 1:8, Name1 = c("A", "A", "A", "C", "B", "B", 
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0, 
1, 1, 0, 0, 0, 0, 2), Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 
54.3, 60.4, 49.2), Lon = c(5, -3, -2, -1, 4, 3, -5, 0), lab_DB = c("blue", 
"blue", "blue", "green", "red", "red", "blue", "red")), class =     "data.frame", row.names =     c(NA,-8L))

sdf <- SharedData$new(data_2, ~ID)
DT1<-datatable(
  sdf,  filter = 'top',
  extensions =  c('Select', 'Buttons'),   selection = 'none', options =     list(select =     list(style = 'os', items = 'row'),dom = 'Bfrtip',autoWidth =     TRUE,buttons =  list('copy' ,
                                                                list(extend =     'collection',  buttons = c('csv', 'excel', 'pdf', 'print'),
                                                                     text =     'Download')                                                          
)),caption=tags$caption("Value2:  #0: ",summarywidget(sdf ,     selection=~Value2==0)
,"      Value2:  #1: ",summarywidget(sdf , selection=~Value2==1)
,"      Value2:  #2: ",summarywidget(sdf , selection=~Value2==2)
))

bscols(widths = c(6, 4),   DT1, div(style = css(width="100%", height="400px",     background_color="blue")))

The expected bar plot should be like

enter image description here

That is, a simple bar plot for variable "Value2".

Masoud
  • 535
  • 3
  • 19
  • Please check updated code . – Swati Jul 25 '21 at 06:36
  • Wouldn't a shiny app be the way to go about this if you know R and are not excited about learning Javascript? There are a few examples on the web. – Mark Neal Jul 28 '21 at 01:13
  • @MarkNeal, I think the best way is using shiny app. But unfortunately I am not familiar with it! – Masoud Jul 28 '21 at 03:56
  • Mastering shiny is available for free on the web, and within two hours you may well get the basics. Easier than hacking JavaScript in my experience! – Mark Neal Jul 28 '21 at 06:36

1 Answers1

1

Here is a solution with shiny. Instead of using {crosstalk} I added a callback to the datatable to get the number of the selected column. We can use this number to subset your data and create said plotly bar chart which shows the count of all unique values in a column.

library(shiny)
library(dplyr)
library(plotly) 
library(DT)
library(crosstalk)
library(summarywidget)
library(htmltools)


data_2 <- structure(
  list(ID = 1:8,
       Name1 = c("A", "A", "A", "C", "B", "B", "A", "B"),
       Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"), 
       Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
       Value2 = c(0, 1, 1, 0, 0, 0, 0, 2),
       Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
       Lon = c(5, -3, -2, -1, 4, 3, -5, 0),
       lab_DB = c("blue", "blue", "blue", "green", "red", "red", "blue", "red")),
  class = "data.frame",
  row.names = c(NA,-8L))

ui <- fluidPage(
  fluidRow(
    column(6,
           DTOutput("table")),
    column(6, style = "padding-top: 105px;",
               plotlyOutput("plot"))
  )
)

server <- function(input, output) {
  
  sdf <- SharedData$new(data_2, ~ID)
  
  output$table <- renderDT({
    
    datatable(
      
      data_2,
      filter = 'top',
      extensions = c('Select', 'Buttons'),
      selection = 'none',
      options = list(select = list(style = 'os',
                                   items = 'row'),
                     dom = 'Bfrtip',
                     autoWidth = TRUE,
                     buttons = list('copy' ,
                                    list(extend = 'collection',
                                         buttons = c('csv', 'excel', 'pdf', 'print'),
                                         text = 'Download'))),
      caption = tags$caption("Value2:  #0: ",
                             summarywidget(sdf, selection = ~Value2 == 0),
                             "      Value2:  #1: ", summarywidget(sdf, selection = ~Value2 == 1),
                             "      Value2:  #2: ", summarywidget(sdf, selection = ~Value2 == 2)),
      
      # This part is new: callback to get col number as `input$col`
      callback = JS("table.on('click.dt', 'td', function() {
            var col=table.cell(this).index().column;
            var data = [col];
           Shiny.onInputChange('col',data );
    });")
    )
  },
  server = FALSE)
  

  # plotly bar chart
  output$plot <- renderPlotly({
    
    req(input$col)
    
    dat <- table(data_2[, input$col])
    
    fig <- plot_ly(
      x = names(dat),
      y = dat,
      name = "Count",
      type = "bar"
    )
    
    fig
    
  })
  
}

shinyApp(ui, server)

Here my session info, since the code above seems not to be working on the OP's machine:

R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 18363)

Matrix products: default

locale:
[1] LC_COLLATE=German_Germany.1252  LC_CTYPE=German_Germany.1252   
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C                   
[5] LC_TIME=German_Germany.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] shiny_1.5.0              htmltools_0.5.0          summarywidget_0.0.0.9000
 [4] crosstalk_1.1.0.1        DT_0.15                  plotly_4.9.2.1          
 [7] forcats_0.5.0            stringr_1.4.0            purrr_0.3.4             
[10] readr_1.3.1              tibble_3.1.1             ggplot2_3.3.3           
[13] tidyverse_1.3.0          tidyr_1.1.1              dplyr_1.0.1             

loaded via a namespace (and not attached):
 [1] httr_1.4.2        jsonlite_1.7.0    viridisLite_0.3.0 modelr_0.1.8      assertthat_0.2.1 
 [6] blob_1.2.1        cellranger_1.1.0  yaml_2.2.1        pillar_1.6.1      backports_1.1.7  
[11] glue_1.4.1        digest_0.6.25     promises_1.1.1    rvest_0.3.6       colorspace_1.4-1 
[16] httpuv_1.5.4      clipr_0.7.0       pkgconfig_2.0.3   broom_0.7.0       haven_2.3.1      
[21] xtable_1.8-4      scales_1.1.1      processx_3.4.3    whisker_0.4       later_1.1.0.1    
[26] generics_0.0.2    ellipsis_0.3.2    withr_2.2.0       lazyeval_0.2.2    cli_2.0.2        
[31] magrittr_1.5      crayon_1.3.4      readxl_1.3.1      mime_0.9          evaluate_0.14    
[36] ps_1.3.3          fs_1.5.0          fansi_0.4.1       xml2_1.3.2        rsconnect_0.8.16 
[41] tools_4.0.2       data.table_1.13.0 hms_0.5.3         lifecycle_1.0.0   munsell_0.5.0    
[46] reprex_0.3.0      callr_3.4.3       compiler_4.0.2    tinytex_0.31      rlang_0.4.10     
[51] grid_4.0.2        rstudioapi_0.11   htmlwidgets_1.5.1 rmarkdown_2.8     gtable_0.3.0     
[56] DBI_1.1.0         R6_2.4.1          lubridate_1.7.9   knitr_1.29        fastmap_1.0.1    
[61] utf8_1.1.4        stringi_1.4.6     Rcpp_1.0.5        vctrs_0.3.8       dbplyr_1.4.4     
[66] tidyselect_1.1.0  xfun_0.22        
> 
TimTeaFan
  • 17,549
  • 4
  • 18
  • 39
  • @Masoud: It works fine here. Please have a look at my `sessionInfo()` which I added to my answer. Maybe you are running different R or package versions. – TimTeaFan Jul 29 '21 at 13:11
  • Yes, It works fine. It needs a click on a column! – Masoud Jul 29 '21 at 13:32
  • Yes sure, thats was the whole point of this dashboard, or did I understand it wrong? – TimTeaFan Jul 29 '21 at 13:34
  • Could you look at https://stackoverflow.com/questions/68422154/problem-with-using-barplot-and-scatter-plot-in-leaflet?noredirect=1#comment120980623_68422154 ? – Masoud Jul 29 '21 at 13:37