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)