Columns escaped seem false in DT::datatable( ) with many columns

[philibe]

Hello,

If I change an initial column myCol to an url (for example), and copy the old column myColInitialValue at the end of the dataframe df with a new name, I thought that
a which(colnames(df)=='myCol') send back the col # of myColInitialValue but It seems to be an issue in DT::datatable()

Here is a reprex below and a question in Stackoverflow:

• dplyr - mutate: columns escaped are false in DT:datatable

My goal is for the escape parameter of DT::datatable(). I use escape=FALSE in waiting that. With constants it doesn't work also but the DT package seems also get the bad # column. :)

Here is my source with the issue of the bad column escaped:

• the # column is correct
• when I was debugging I get a dataframe with incorrect order of column
  but I didn't get again, I didn't reproduce it.
• but even with the correct number with which() the escaped column displayed in shiny/ datatable is wrong

I cannot upgrade all packages because I have qualification server and production server but not really test computer in my small company, I cannot break all.

options(encoding = "UTF-8")

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

hostipserver <- str_trim(system("hostname -I", intern=TRUE))
hostportserver <- ":8080"

app<-
  shinyApp(
    ui = basicPage(
      navbarMenu("Bla",
                 tabPanel("blabla",
                          fluidPage(
                            h3("outblabla_1"),
                            p("toto_1 and toto_2 have to be worked urls but only toto_2 is ok. varcible is a worked url but I don't want it."),
                            fluidRow(
                              column (12,
                                      div(DT::dataTableOutput('outblabla_1'), 
                                          style = "font-size:80%;white-space: nowrap;width:93%")
                              )
                            ),
                            h3("outblabla_2"),
                             p("toto_1 and toto_2 have to be worked urls but only toto_2 is ok"),
                            fluidRow(
                              column (12,
                                      div(DT::dataTableOutput('outblabla_2'), 
                                          style = "font-size:80%;white-space: nowrap;width:93%")
                              )
                            )                            
                          )
                 )
      )           
    ),
    
    server = function(input, output) {
      
      blabla <-  reactive({
        test<-data.frame(        
          matrix (rep(c(c(999.2,2), 1200), 4000), nrow = 40, ncol = 30)
        )
        colnames(test) <-  paste0("toto_", 1:30)
        
        test<-test %>% mutate (toto_9 = ifelse (toto_9==2,TRUE,FALSE))
        
        return( test)        
        
      })
      get_url_pdf <-function (mydatatable,nom_colonne_initiale_pour_url, nom_colonne_code_rempl, 
                              repertoire_cible,nom_colonne_test_fichier = "" ) {
        
        # exemple mutate(iris [1:3,], !!("varcible") :=  UQ(rlang::sym("Species") ))
        
        
        (mydatatable
         %>% ungroup()
         %>% mutate (
           nom_colonne_test_fichier=nom_colonne_test_fichier,
           varsource =  !!(rlang::sym(nom_colonne_initiale_pour_url) ),
           nom_fichier_pdf=paste0(gsub("\\.", "_",  varsource),'.pdf'),
           var_nom_colonne_test_fichier=ifelse(nom_colonne_test_fichier=='',"",UQ(rlang::sym(nom_colonne_test_fichier))),
           fichier_pdf_existe=ifelse(var_nom_colonne_test_fichier=="",file_test("-f", paste0(repertoire_cible , nom_fichier_pdf)),var_nom_colonne_test_fichier),     
           varcible =  ifelse(fichier_pdf_existe,paste0('<a class="url_pdf" href="http://',hostipserver ,hostportserver,'/rapportpdfpath/',nom_fichier_pdf,'"  target = "_blank">',varsource,'</a>'), varsource)  ,    
           !!(nom_colonne_initiale_pour_url) :=varcible  , 
           !!(nom_colonne_code_rempl) :=varsource         
         )
        )
        
      }      
      
      output$outblabla_1<- DT::renderDataTable( { 
        mydatatable<-blabla()
        mydatatable<- ( mydatatable
                        %>% ungroup()
                        %>% get_url_pdf(.,nom_colonne_initiale_pour_url = "toto_1",
                                        nom_colonne_code_rempl="toto_1_old",
                                        repertoire_cible = my_path_of_pdf, nom_colonne_test_fichier="toto_9"
                        )
                        %>% get_url_pdf(.,nom_colonne_initiale_pour_url = "toto_2",
                                        nom_colonne_code_rempl="toto_2_old",
                                        repertoire_cible = my_path_of_pdf, nom_colonne_test_fichier="toto_9"
                        )                        
        )
        
        
        
        
        escape_vector<-which(colnames(mydatatable) %in% list("toto_1","toto_2"))  
        print('escape 1' , paste0(escape_vector,(dput(escape_vector))))
        res<-DT::datatable(  mydatatable,
                             style = "bootstrap",   class = "compact", filter='top', 
                             selection = c("single"),
                             escape=escape_vector,
                             options = list(
                               deferRender = TRUE,
                               bSortClasses = TRUE,iDisplayLength = 5,   width = "100%",
                               scrollX=TRUE ,
                               lengthMenu  = list(c(5, 25, 50, 75, 100, -1), list('5', '25','50','75','100', 'All')),                      
                               search = list(
                                 smart = TRUE,
                                 regex = TRUE, 
                                 caseInsensitive = TRUE
                               )                      
                               
                             )
        );
      })
      
      output$outblabla_2<- DT::renderDataTable( { 
        mydatatable<-blabla()
        mydatatable<- ( mydatatable
                        %>% ungroup()
                        %>% mutate(
                          nom_fichier_pdf_1='a',#paste0(gsub("\\.", "_",  toto_1),'.pdf'),
                          nom_fichier_pdf_2='b',#paste0(gsub("\\.", "_",  toto_2),'.pdf'),
                          
                        toto_1_old=toto_1,
                        toto_1=ifelse(toto_9,paste0('<a class="url_pdf" href="http://',hostipserver ,hostportserver,'/rapportpdfpath/',nom_fichier_pdf_1,'"  target = "_blank">',toto_1,'</a>'), toto_1),
                        toto_2_old=toto_2,
                        toto_2=ifelse(toto_9,paste0('<a class="url_pdf" href="http://',hostipserver ,hostportserver,'/rapportpdfpath/',nom_fichier_pdf_2,'"  target = "_blank">',toto_2,'</a>'), toto_2)                        
                        )
                        
                    
        )
        
        
        
        
        escape_vector<-which(colnames(mydatatable) %in% list("toto_1","toto_2"))  
        print('escape 2' , paste0(escape_vector,(dput(escape_vector))))
        res<-DT::datatable(  mydatatable,
                             style = "bootstrap",   class = "compact", filter='top', 
                             selection = c("single"),
                             escape=c(1,2),
                             options = list(
                               deferRender = TRUE,
                               bSortClasses = TRUE,iDisplayLength = 5,   width = "100%",
                               scrollX=TRUE ,
                               lengthMenu  = list(c(5, 25, 50, 75, 100, -1), list('5', '25','50','75','100', 'All')),                      
                               search = list(
                                 smart = TRUE,
                                 regex = TRUE, 
                                 caseInsensitive = TRUE
                               )                      
                               
                             )
        );
      })      
    })
shiny::runApp(app)

xfun::session_info('DT')

R version 3.4.4 (2018-03-15)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 16.04.4 LTS, RStudio 1.2.1322

Locale:
  LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
  LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
  LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
  LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

Package version:
  assertthat_0.2.0   backports_1.1.3    BH_1.66.0.1        cli_1.0.0          colorspace_1.4.1  
  crayon_1.3.4       crosstalk_1.0.0    digest_0.6.17      DT_0.7             ellipsis_0.2.0.1  
  fansi_0.4.0        ggplot2_3.1.1.9000 glue_1.3.1         graphics_3.4.4     grDevices_3.4.4   
  grid_3.4.4         gtable_0.2.0       htmltools_0.3.6    htmlwidgets_1.3    httpuv_1.5.1      
  jsonlite_1.5       labeling_0.3       later_0.8.0        lattice_0.20.35    lazyeval_0.2.1    
  magrittr_1.5       MASS_7.3.50        Matrix_1.2.14      methods_3.4.4      mgcv_1.8.23       
  mime_0.5           munsell_0.5.0      nlme_3.1.137       pillar_1.4.2       pkgconfig_2.0.2   
  plyr_1.8.4         promises_1.0.1     R6_2.3.0           RColorBrewer_1.1.2 Rcpp_1.0.1        
  reshape2_1.4.3     rlang_0.4.0        scales_1.0.0       shiny_1.3.2        sourcetools_0.1.7 
  stats_3.4.4        stringi_1.2.2      stringr_1.3.1      tibble_2.1.1       tools_3.4.4       
  utf8_1.1.3         utils_3.4.4        vctrs_0.2.0        viridisLite_0.3.0  withr_2.1.2       
  xtable_1.8.3       yaml_2.2.0         zeallot_0.1.0   

---

By filing an issue to this repo, I promise that

• I have fully read the issue guide at https://yihui.name/issue/.
• I have provided the necessary information about my issue.
  • If I'm asking a question, I have already asked it on Stack Overflow or RStudio Community, waited for at least 24 hours, and included a link to my question there.
  • If I'm filing a bug report, I have included a minimal, self-contained, and reproducible example, and have also included xfun::session_info('DT'). I have upgraded all my packages to their latest versions (e.g., R, RStudio, and R packages), and also tried the development version: remotes::install_github('rstudio/DT').
  • If I have posted the same issue elsewhere, I have also mentioned it in this issue.
• I have learned the Github Markdown syntax, and formatted my issue correctly.

I understand that my issue may be closed if I don't fulfill my promises.

[shrektan]

Can the example be simpler?

[philibe]

The same example but with only the second datable, without the function:

options(encoding = "UTF-8")
library(DT)
library(shiny)
library(dplyr)
library(stringr)
hostipserver <- str_trim(system("hostname -I", intern=TRUE))
hostportserver <- ":8080"
app<-
  shinyApp(
    ui = basicPage(
      navbarMenu("Bla",
                 tabPanel("blabla",
                          fluidPage(
                            h3("outblabla_2"),
                            p("toto_1 and toto_2 have to be worked urls but only toto_2 is ok"),
                            fluidRow(
                              column (12,
                                      div(DT::dataTableOutput('outblabla_2'), 
                                          style = "font-size:80%;white-space: nowrap;width:93%")
                              )
                            )                            
                          )
                 )
      )           
    ),
    server = function(input, output) {
      blabla <-  reactive({
        test<-data.frame(        
          matrix (rep(c(c(999.2,2), 1200), 4000), nrow = 40, ncol = 30)
        )
        colnames(test) <-  paste0("toto_", 1:30)
        test<-test %>% mutate (toto_9 = ifelse (toto_9==2,TRUE,FALSE))
        return( test)        
      })
      output$outblabla_2<- DT::renderDataTable( { 
        mydatatable<-blabla()
        mydatatable<- ( mydatatable
                        %>% ungroup()
                        %>% mutate(
                          nom_fichier_pdf_1='a',#paste0(gsub("\\.", "_",  toto_1),'.pdf'),
                          nom_fichier_pdf_2='b',#paste0(gsub("\\.", "_",  toto_2),'.pdf'),
                        toto_1_old=toto_1,
                        toto_1=ifelse(toto_9,paste0('<a class="url_pdf" href="http://',hostipserver ,hostportserver,'/rapportpdfpath/',nom_fichier_pdf_1,'"  target = "_blank">',toto_1,'</a>'), toto_1),
                        toto_2_old=toto_2,
                        toto_2=ifelse(toto_9,paste0('<a class="url_pdf" href="http://',hostipserver ,hostportserver,'/rapportpdfpath/',nom_fichier_pdf_2,'"  target = "_blank">',toto_2,'</a>'), toto_2)                        
                        )
        )
        escape_vector<-which(colnames(mydatatable) %in% list("toto_1","toto_2"))  
        print('escape 2' , paste0(escape_vector,(dput(escape_vector))))
        res<-DT::datatable(  mydatatable,
                             style = "bootstrap",   class = "compact", filter='top', 
                             selection = c("single"),
                             escape=escape_vector,
                             options = list(
                               deferRender = TRUE,
                               bSortClasses = TRUE,iDisplayLength = 5,   width = "100%",
                               scrollX=TRUE ,
                               lengthMenu  = list(c(5, 25, 50, 75, 100, -1), list('5', '25','50','75','100', 'All')),                      
                               search = list(
                                 smart = TRUE,
                                 regex = TRUE, 
                                 caseInsensitive = TRUE
                               )                      
                             )
        );
      })      
    })
shiny::runApp(app)

[shrektan]

The solution

I don't know if you want to escape the first two columns or unescape them. The thing is what which() returns is 1:2 but you are expected to use -(2:3) if the first two displayed columns are supposed to be not escaped (a.k.a, show the link). So what you need to do is to change:

escape_vector<-which(colnames(mydatatable) %in% list("toto_1","toto_2"))  

to

escape_vector<- -(which(colnames(mydatatable) %in% list("toto_1","toto_2"))  + 1)
# notice the minus sign

The reason

The reason need to use -(2:3) instead of -(1:2) is that the rowname is counted as 1 column.

A simpler example

tbl <- 
  data.frame(
    a = "<a href = 'about:blank'>a</a>",
    b = "<a href = 'about:blank'>b</a>",
    c = "<a href = 'about:blank'>b</a>",
    stringsAsFactors = FALSE
  )
DT::datatable(
  tbl,
  # rownames = FALSE, # uncomment this line to see the differences
  escape = -(which(colnames(tbl) == 'b') + 1)
)

BTW, it doesn't have to be so complicated... Lines like options(encoding = "UTF-8") are all redundant, in my option. It takes time to cut off all the unnecessary lines and we may still not know where the problem is. Please try to provide a more concise example next time.

Thanks.

[philibe]

Sometimes it's not obvious to cut off, but I understand that it's more consuming time for you than for me to cut off all the unnecessary lines: I will try to be more concise next time. :)

I did see that it was -c(columns) but it didn't work, therefore I tried everything.

I miss "that the rowname is counted as 1 column" . In https://rstudio.github.io/DT/ the escape documentation is without rownames. My issue is not therefore an bug, but a feature requested for add this detail in this documentation for the escape example :P

Thank you very much :)

PS: You have a user on stackoverflow, you answer on it, or I do it ?

[shrektan]

Thanks. I've answered on Stackoverflow and filed two PR on the docs.