问题
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)
回答1:
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 )
来源：https://stackoverflow.com/questions/57123813/dplyr-mutate-columns-escaped-are-false-in-dtdatatable-title-edited-was-dpl