dplyr-mutate:转义的列在DT中为false:已编辑数据表标题;是(dplyr-mutate:使用动态变量名...(用于DT :: datatable`)) [英] dplyr - mutate: columns escaped are false in DT:datatable title edited; was (dplyr - mutate: use dynamic variable names...(used for `DT::datatable`))

查看:73
本文介绍了dplyr-mutate:转义的列在DT中为false:已编辑数据表标题;是(dplyr-mutate:使用动态变量名...(用于DT :: datatable`))的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

此技巧 dplyr-变异:使用动态变量名称,@ Tom Roth的答案效果很好,但是我有



[edit:似乎不是动态变量。 Reprex添加了/ edit]



如果我将初始列 myCol 更改为url,然后复制数据框 df 末尾的旧列 myColInitialValue 具有新名称,因此我认为 which(colnames(df)=='myCol')发回 myColInitialValue 的列号,但这似乎是一个问题DT :: datatable()



我的目标是使用 DT的转义参数: :datatable()。我用 escape = FALSE 来等待。使用常量也不能使用,但是 DT包似乎也弄坏了#列。 :)



这是我的来源,其中的坏栏问题已转义:




  • #列是正确的

  • 在调试时,我得到的数据框的列
    的顺序不正确,但是我没有再得到,我没有重现它。

  • 但即使使用 which()正确的数字,闪亮/数据表中显示的转义列也是错误的



  output $ Myoutputdatatable<-DT :: renderDataTable({
mydatatable< -Myreactivefunction()
mydatatable<--(mydatatable
%>%ungroup()
%>%get_url_pdf(。,nom_colonne_initiale_pour_url = s_code,
nom_colonne_code_rempl = s_code_old,
repertoire_cible = my_path_of_pdf,nom_colonne_test_fichier = s_exists)

%>%get_url_pdf(。,nom_colonne_initiale_pour_url = sp_code,
nom_colonne_code_rempl = sp_code_old,
repertoire_cible = my_path_of_pdf,nom_colonne_test_fichier = sp_exists)


escape_vector< -which(colnames(mydatatable)%in%list( s_code , sp_code))

res< -DT :: datatable(mydatatable,
style = bootstrap,class = compact,filter ='top',
selection = c( single),
escape = escape_vector,
options = list(
deferRender = TRUE,
bSortClasses = TRUE,iDisplayLength = 20,width = 100% ,
scrollX = TRUE,
lengthMenu = list(c(5,25,50,75,100,-1),list('5','25','50','75 ','100','All')),
搜索=列表(
smart = TRUE,
regex = TRUE,
caseInsensitive = TRUE



);

res<-(res
%>%formatStyle(column = c( s_code_old),
valueColumns = c( s_code_old),target ='row ',
color = styleEqual(c('__ UNKNOWN__'),c( red))


res
})

使用我的函数,使用@Tom Roth关于 mutate()中动态变量的答案

  get_url_pdf< -function(mydatatable,nom_colonne_initiale_pour_url,nom_colonne_code_rempl,
repertoire_cible, nom_colonne_test_fichier =){

#示例mutate(iris [1:3,],!!( varcible):= UQ(rlang :: sym( Species)))


(mydatatable
%>%ungroup()
%>%变异(
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(test_fir_col ,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



}

编辑:添加了REPREX

  
库(DT)
库(发光)
库(dplyr)

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和必须使用toto_2网址,但只有toto_2可以。 varcible是一个有效的URL,但我不想要它。),
fluidRow(
列(12,
div(DT :: dataTableOutput('outblabla_1'),
style = font-size:80%; white-space:nowrap; width:93%)

),
h3( outblabla_2),
p( toto_1和toto_2必须使用网址,但只有toto_2可以,
fluidRow(
列(12,
div(DT :: dataTableOutput('outblabla_2'),
style = font-size:80%; white-space:nowrap; width:93%)





),

服务器=函数(输入,输出){

blabla<-反应性({
test< -data.frame(
矩阵(rep(c(c(999.2,2),1200),4000),nrow = 40,ncol = 30)

colnames(test)<-paste0( toto_ ,1:30)

test< -test%&%;%变异(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 =){

(例如mutate)虹膜[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 =粘贴0(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(exb = b)(exb) '< 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



}

输出$ 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




















)美元b


escape_vector< ---(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,宽度= 100% ,
scrollX = TRUE,
lengthMenu = list(c(5,25,50,75,100,-1),list('5','25','50','75 ','100','All')),
搜索= 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')),
搜索= list(
聪明= TRUE,
regex = TRUE,
caseInsensitive = TRUE



);
})
})
Shiny :: runApp(app)


解决方案

作为 rstudio / DT#691 ,因为该行名被视为一列,所以您应该在该列位置添加一个额外的1L。而且,由于真正的目的是 unscape 某些列,因此所提供的向量上应该有一个负号。



简而言之,

  escape_vector<-其中(colnames(mydatatable)%in%list( toto_1, toto_2))

应更改为



< pre class = lang-r prettyprint-override> escape_vector<--(which(colnames(mydatatable)%in%c( toto_1, toto_2))+ 1L)


This tips dplyr - mutate: use dynamic variable names, answer of @Tom Roth works very well, but I have a little issue.

[edit: It seems than dynamic variables are not the cause. Reprex added /edit]

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, therefore I thought that a which(colnames(df)=='myCol') send back the col # of myColInitialValue but It seems to be an issue 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

output$Myoutputdatatable <- DT::renderDataTable( { 
  mydatatable<-Myreactivefunction()
  mydatatable<- ( mydatatable 
                  %>% ungroup() 
                  %>% get_url_pdf(.,nom_colonne_initiale_pour_url = "s_code", 
                                  nom_colonne_code_rempl="s_code_old", 
                                  repertoire_cible = my_path_of_pdf, nom_colonne_test_fichier="s_exists")

                  %>% get_url_pdf(.,nom_colonne_initiale_pour_url = "sp_code", 
                                  nom_colonne_code_rempl="sp_code_old", 
                                  repertoire_cible = my_path_of_pdf, nom_colonne_test_fichier="sp_exists")

  ) 
  escape_vector<-which(colnames(mydatatable) %in% list("s_code","sp_code"))  

  res<-DT::datatable(  mydatatable,
                       style = "bootstrap",   class = "compact", filter='top', 
                       selection = c("single"),
                       escape=escape_vector,
                       options = list(
                         deferRender = TRUE,
                         bSortClasses = TRUE,iDisplayLength = 20,   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
                         )                      

                       )
  );

  res <- ( res 
           %>% formatStyle( columns = c("s_code_old"), 
                            valueColumns = c("s_code_old"), target='row', 
                            color = styleEqual(c('__UNKNOWN__'), c("red")) 
           )
  )
  res
} ) 

With my function with the use of the answer of @Tom Roth about dynamic variable in mutate().

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         
   )
  )

}

EDIT: REPREX ADDED


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

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)

解决方案

As the answer in rstudio/DT#691, since the rowname is regarded as one column, you should add an additional 1L on the column position. Moreover, since the real intent is to unescape the certain columns, there should be a minus sign on the vector provided.

In short,

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

should be changed to

escape_vector <- -( which(colnames(mydatatable) %in% c("toto_1","toto_2")) + 1L ) 

这篇关于dplyr-mutate:转义的列在DT中为false:已编辑数据表标题;是(dplyr-mutate:使用动态变量名...(用于DT :: datatable`))的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆