print_report.R 14.6 KB
Newer Older
1
#!/usr/bin/env Rscript
Gael  MILLOT's avatar
Gael MILLOT committed
2
3
4

#########################################################################
##                                                                     ##
Gael  MILLOT's avatar
Gael MILLOT committed
5
##     print_report.R                                                  ##
Gael  MILLOT's avatar
Gael MILLOT committed
6
7
8
9
10
11
12
13
14
15
##                                                                     ##
##     Gael A. Millot                                                  ##
##     Bioinformatics and Biostatistics Hub                            ##
##     Computational Biology Department                                ##
##     Institut Pasteur Paris                                          ##
##                                                                     ##
#########################################################################



Gael  MILLOT's avatar
Gael MILLOT committed
16

Gael  MILLOT's avatar
Gael MILLOT committed
17
18
19
20
21
22
23
24
################################ Aim


################################ End Aim


################################ Introduction

25
# https://stackoverflow.com/questions/59668347/rmarkdown-turn-off-title
Gael  MILLOT's avatar
Gael MILLOT committed
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

################################ End Introduction


################################ Acknowlegments


################################ End Acknowlegments


################################ Initialization


# R version checking
if(version$version.string != "R version 4.0.5 (2021-03-31)"){
Gael  MILLOT's avatar
Gael MILLOT committed
41
    stop(paste0("\n\n================\n\nERROR IN plot_read_length.R\n", version$version.string, " IS NOT THE 4.0.5 RECOMMANDED\n\n================\n\n"))
Gael  MILLOT's avatar
Gael MILLOT committed
42
43
44
45
46
47
48
49
}
# other initializations
erase.objects = TRUE # write TRUE to erase all the existing objects in R before starting the algorithm and FALSE otherwise. Beginners should use TRUE
if(erase.objects == TRUE){
    rm(list = ls(all.names = TRUE))
    erase.objects = TRUE
}
erase.graphs = TRUE # write TRUE to erase all the graphic windows in R before starting the algorithm and FALSE otherwise
Gael  MILLOT's avatar
Gael MILLOT committed
50
script <- "print_report"
Gael  MILLOT's avatar
Gael MILLOT committed
51
52
53
54
55
56
57
58
59
60
61
62
63
64


################################ End Initialization


################################ Parameters that need to be set by the user


################################ End Parameters that need to be set by the user


################################ Config import


65
tempo.cat <- "KIND OF RUN (SCRIPT, COPY-PASTE OR SOURCE): "
Gael  MILLOT's avatar
Gael MILLOT committed
66
if(interactive() == FALSE){ # if(grepl(x = commandArgs(trailingOnly = FALSE), pattern = "R\\.exe$|\\/R$|Rcmd\\.exe$|Rcmd$|Rgui\\.exe$|Rgui$|Rscript\\.exe$|Rscript$|Rterm\\.exe$|Rterm$")){ # detection of script usage
67
68
    run.way <- "SCRIPT"
    cat(paste0("\n\n", tempo.cat, run.way, "\n"))
Gael  MILLOT's avatar
Gael MILLOT committed
69
70
71
    command <- paste0(commandArgs(trailingOnly = FALSE), collapse = ",") # recover the full command
    args <- commandArgs(trailingOnly = TRUE) # recover arguments written after the call of the R script
    if(any(is.na(args))){
Gael  MILLOT's avatar
Gael MILLOT committed
72
        stop(paste0("\n\n================\n\nERROR IN print_report.R\nTHE args OBJECT HAS NA\n\n================\n\n"), call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
73
    }
74
75
76
77
78
    tempo.arg.names <- c(
        "cute", 
        "report", 
        "log"
    ) # objects names exactly in the same order as in the bash code and recovered in args. Here only one, because only the path of the config file to indicate after the print_report.R script execution
Gael  MILLOT's avatar
Gael MILLOT committed
79
    if(length(args) != length(tempo.arg.names)){
Gael  MILLOT's avatar
Gael MILLOT committed
80
        stop(paste0("\n\n================\n\nERROR IN print_report.R\nTHE NUMBER OF ELEMENTS IN args (", length(args),") IS DIFFERENT FROM THE NUMBER OF ELEMENTS IN tempo.arg.names (", length(tempo.arg.names),")\nargs:", paste0(args, collapse = ","), "\ntempo.arg.names:", paste0(tempo.arg.names, collapse = ","), "\n\n================\n\n"), call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
81
82
83
84
85
    }
    for(i1 in 1:length(tempo.arg.names)){
        assign(tempo.arg.names[i1], args[i1])
    }
    rm(tempo.arg.names, args, i1)
Gael  MILLOT's avatar
test    
Gael MILLOT committed
86
}else if(sys.nframe() == 0L){ # detection of copy-paste/direct execution (for debugging). With script it is also 0, with source, it is 4
87
88
    run.way <- "COPY-PASTE"
    cat(paste0("\n\n", tempo.cat, run.way, "\n"))
Gael  MILLOT's avatar
test    
Gael MILLOT committed
89
}else{
90
91
    run.way <- "SOURCE" # using source(), sys.nframe() is 4
    cat(paste0("\n\n", tempo.cat, run.way, "\n"))
Gael  MILLOT's avatar
Gael MILLOT committed
92
}
93
rm(tempo.cat)
Gael  MILLOT's avatar
Gael MILLOT committed
94
95
96
97


################################ End Config import

Gael  MILLOT's avatar
Gael MILLOT committed
98
99
################################ Test

100
101
102
# cute <- "https://gitlab.pasteur.fr/gmillot/cute_little_R_functions/-/raw/v10.9.0/cute_little_R_functions.R" 
# report <- "report.txt"
# log <- "print_report.txt"
Gael  MILLOT's avatar
Gael MILLOT committed
103
104

################################ end Test
Gael  MILLOT's avatar
Gael MILLOT committed
105
106
107
108
109
110
111
112
113

################################ Recording of the initial parameters


param.list <- c(
    "erase.objects", 
    "erase.graphs", 
    "script", 
    "run.way",
114
    if(run.way == "SCRIPT"){"command"}, 
Gael  MILLOT's avatar
Gael MILLOT committed
115
    "cute", 
116
    "report", 
Gael  MILLOT's avatar
Gael MILLOT committed
117
118
119
    "log"
)
if(any(duplicated(param.list))){
Gael  MILLOT's avatar
Gael MILLOT committed
120
    stop(paste0("\n\n================\n\nINTERNAL CODE ERROR 1 IN print_report.R\nTHE param.list OBJECT CONTAINS DUPLICATED ELEMENTS:\n", paste(param.list[duplicated(param.list)], collapse = " "), "\n\n================\n\n"), call. = FALSE) # message for developers
Gael  MILLOT's avatar
Gael MILLOT committed
121
122
123
124
}
if(erase.objects == TRUE){
    created.object.control <- ls()[ ! ls() %in% "param.list"]
    if( ! (all(created.object.control %in% param.list) & all(param.list %in% created.object.control))){
Gael  MILLOT's avatar
Gael MILLOT committed
125
        stop(paste0("\n\n================\n\nINTERNAL CODE ERROR 2 IN print_report.R\nINCONSISTENCIES BETWEEN THE ARGUMENTS USED AND THE PARAMETERS REQUIRED IN THE EXECUTABLE CODE FILE\nTHE ARGUMENTS NOT PRESENT IN THE EXECUTABLE FILE (print_report.R) ARE:\n", paste(created.object.control[ ! created.object.control %in% param.list], collapse = " "), "\nTHE PARAMETERS OF THE EXECUTABLE FILE (print_report.R) NOT PRESENT IN THE ARGUMENTS ARE:\n", paste(param.list[ ! param.list %in% created.object.control], collapse = " "), "\n\n================\n\n"), call. = FALSE) # message for developers
Gael  MILLOT's avatar
Gael MILLOT committed
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    }
}
char.length <- nchar(param.list)
space.add <- max(char.length) - char.length + 5
param.ini.settings <- character(length = length(param.list))
for(i in 1:length(param.list)){
    param.ini.settings[i] <- paste0("\n", param.list[i], paste0(rep(" ", space.add[i]), collapse = ""), paste0(get(param.list[i]), collapse = ",")) # no env = sys.nframe(), inherit = FALSE in get() because look for function in the classical scope
}


################################ End Recording of the initial parameters


################################ Functions


# Functions are built such that they should have no direct use of Global objects (going through the R scope), and only use function arguments
# 1) Cute little function is sourced for the moment into the .GlobalEnv environment, but may be interesting to put it into a new environement just above .GlobalEnv environment. See https://stackoverflow.com/questions/9002544/how-to-add-functions-in-an-existing-environment
# 2) Argument names of each function must not be a name of Global objects (error message otherwise)
# 3) Argument name of each function ends with "_fun" in the first function, "_2fun" in the second, etc. This prevent conflicts with the argument partial names when using these functions, notably when they are imbricated


################ import functions from cute little functions toolbox

if(length(cute) != 1){
Gael  MILLOT's avatar
Gael MILLOT committed
151
    stop(paste0("\n\n============\n\nERROR IN plot_read_length.R\ncute PARAMETER MUST BE LENGTH 1: ", paste(cute, collapse = " "), "\n\n============\n\n"), call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
152
153
154
}else if(grepl(x = cute, pattern = "^http")){
    tempo.try <- try(suppressWarnings(suppressMessages(source(cute, local = .GlobalEnv))), silent = TRUE)
    if(any(grepl(x = tempo.try, pattern = "^[Ee]rror"))){
Gael  MILLOT's avatar
Gael MILLOT committed
155
        stop(paste0("\n\n============\n\nERROR IN plot_read_length.R\nHTTP INDICATED IN THE cute PARAMETER DOES NOT EXISTS: ", cute, "\n\n============\n\n"), call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
156
157
158
159
160
    }else{
        source(cute, local = .GlobalEnv) # source the fun_ functions used below
    }
}else if( ! grepl(x = cute, pattern = "^http")){
    if( ! file.exists(cute)){
Gael  MILLOT's avatar
Gael MILLOT committed
161
        stop(paste0("\n\n============\n\nERROR IN plot_read_length.R\nFILE INDICATED IN THE cute PARAMETER DOES NOT EXISTS: ", cute, "\n\n============\n\n"), call. = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
162
163
164
165
    }else{
        source(cute, local = .GlobalEnv) # source the fun_ functions used below
    }
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
166
    tempo.cat <- paste0("\n\n================\n\nINTERNAL CODE ERROR 3 IN plot_read_length.R: CODE HAS TO BE MODIFIED\n\n============\n\n")
Gael  MILLOT's avatar
Gael MILLOT committed
167
168
169
170
    stop(tempo.cat, call. = FALSE)
}


Gael  MILLOT's avatar
Gael MILLOT committed
171
172
# required cute function checking
req.function <- c(
Gael  MILLOT's avatar
Gael MILLOT committed
173
    "fun_check", 
Gael  MILLOT's avatar
Gael MILLOT committed
174
    "fun_pack", 
Gael  MILLOT's avatar
Gael MILLOT committed
175
    "fun_report"
Gael  MILLOT's avatar
Gael MILLOT committed
176
177
178
179
180
181
182
183
)
tempo <- NULL
for(i1 in req.function){
    if(length(find(i1, mode = "function")) == 0L){
        tempo <- c(tempo, i1)
    }
}
if( ! is.null(tempo)){
Gael  MILLOT's avatar
Gael MILLOT committed
184
    tempo.cat <- paste0("ERROR IN plot_read_length.R\nREQUIRED cute FUNCTION", ifelse(length(tempo) > 1, "S ARE", " IS"), " MISSING IN THE R ENVIRONMENT:\n", paste0(tempo, collapse = "()\n"))
Gael  MILLOT's avatar
Gael MILLOT committed
185
186
187
188
189
    stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end required function checking


Gael  MILLOT's avatar
Gael MILLOT committed
190
191
192
193
################ local function: package import


# R Packages required
Gael  MILLOT's avatar
Gael MILLOT committed
194
library("rmarkdown")
195
196
197
if(rmarkdown::pandoc_available()){
  cat("pandoc", as.character(rmarkdown::pandoc_version()), "is available\n")
}
Gael  MILLOT's avatar
Gael MILLOT committed
198
199
200
201
# req.package.list <- c(
#     "rmarkdown"
# )
# for(i in 1:length(req.package.list)){suppressMessages(library(req.package.list[i], character.only = TRUE))}
Gael  MILLOT's avatar
Gael MILLOT committed
202
# fun_pack(req.package = req.package.list, load = TRUE, lib.path = NULL) # packages are imported even if inside functions are written as package.name::function() in the present code
Gael  MILLOT's avatar
Gael MILLOT committed
203
204
205
206
207


################################ End Functions


Gael  MILLOT's avatar
Gael MILLOT committed
208
################################ Pre-ignition checking
Gael  MILLOT's avatar
Gael MILLOT committed
209
210


Gael  MILLOT's avatar
Gael MILLOT committed
211
212
213
# reserved words
# end reserved words
# argument primary checking
Gael  MILLOT's avatar
Gael MILLOT committed
214
215
arg.check <- NULL #
text.check <- NULL #
Gael  MILLOT's avatar
Gael MILLOT committed
216
217
checked.arg.names <- NULL # for function debbuging: used by r_debugging_tools
ee <- expression(arg.check <- c(arg.check, tempo$problem) , text.check <- c(text.check, tempo$text) , checked.arg.names <- c(checked.arg.names, tempo$object.name))
218
tempo <- fun_check(data = report, class = "vector", typeof = "character", length = 1) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
219
tempo <- fun_check(data = log, class = "vector", typeof = "character", length = 1) ; eval(ee)
Gael  MILLOT's avatar
Gael MILLOT committed
220
221
222
if(any(arg.check) == TRUE){ # normally no NA
    stop(paste0("\n\n================\n\n", paste(text.check[arg.check], collapse = "\n"), "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between == #
}
Gael  MILLOT's avatar
Gael MILLOT committed
223
224
225
226
227
228
# end argument primary checking
# second round of checking and data preparation
# management of NA arguments
# end management of NA arguments
# management of NULL arguments
tempo.arg <-c(
229
    "report", 
Gael  MILLOT's avatar
Gael MILLOT committed
230
    "log"
Gael  MILLOT's avatar
Gael MILLOT committed
231
232
233
)
tempo.log <- sapply(lapply(tempo.arg, FUN = get, env = sys.nframe(), inherit = FALSE), FUN = is.null)
if(any(tempo.log) == TRUE){# normally no NA with is.null()
Gael  MILLOT's avatar
Gael MILLOT committed
234
    tempo.cat <- paste0("ERROR IN print_report.R:\n", ifelse(sum(tempo.log, na.rm = TRUE) > 1, "THESE ARGUMENTS\n", "THIS ARGUMENT\n"), paste0(tempo.arg[tempo.log], collapse = "\n"),"\nCANNOT BE NULL")
Gael  MILLOT's avatar
Gael MILLOT committed
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
    stop(paste0("\n\n================\n\n", tempo.cat, "\n\n================\n\n"), call. = FALSE) # == in stop() to be able to add several messages between ==
}
# end management of NULL arguments
# code that protects set.seed() in the global environment
# end code that protects set.seed() in the global environment
# warning initiation
ini.warning.length <- options()$warning.length
options(warning.length = 8170)
warn <- NULL
# warn.count <- 0 # not required
# end warning initiation
# other checkings
# end other checkings
# reserved word checking
# end reserved word checking
# end second round of checking and data preparation
# package checking
# end package checking


################################ End pre-ignition checking


################################ Main code
Gael  MILLOT's avatar
Gael MILLOT committed
259
260
261
262


################ Ignition

Gael  MILLOT's avatar
Gael MILLOT committed
263

Gael  MILLOT's avatar
Gael MILLOT committed
264
fun_report(data = paste0("\n\n################################################################ print_report PROCESS\n\n"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
265
266
ini.date <- Sys.time()
ini.time <- as.numeric(ini.date) # time of process begin, converted into seconds
Gael  MILLOT's avatar
Gael MILLOT committed
267
268
269
fun_report(data = paste0("\n\n################################ RUNNING DATE AND STARTING TIME\n\n"), output = log, path = "./", overwrite = FALSE)
fun_report(data = paste0(ini.date, "\n\n"), output = log, path = "./", overwrite = FALSE)
fun_report(data = paste0("\n\n################################ RUNNING\n\n"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
270

Gael  MILLOT's avatar
Gael MILLOT committed
271
272
273
274
275
276
277
278
279
280
281
282
283

################ End ignition


################ Graphical parameter initialization


################ End graphical parameter initialization


################ Data import


Gael  MILLOT's avatar
Gael MILLOT committed
284
################ end Data import
Gael  MILLOT's avatar
Gael MILLOT committed
285
286


Gael  MILLOT's avatar
Gael MILLOT committed
287
############ modifications of imported tables
Gael  MILLOT's avatar
Gael MILLOT committed
288
289


Gael  MILLOT's avatar
Gael MILLOT committed
290
291
292
############ end modifications of imported tables


Gael  MILLOT's avatar
Gael MILLOT committed
293
rmarkdown::render(
294
295
296
297
298
299
300
301
    input = report,
    output_file = "report.html",
    # output_dir = ".",
    # intermediates_dir = "./",
    # knit_root_dir = "./",
    run_pandoc = TRUE,
    quiet = TRUE,
    clean = TRUE
Gael  MILLOT's avatar
Gael MILLOT committed
302
)
Gael  MILLOT's avatar
Gael MILLOT committed
303
304


Gael  MILLOT's avatar
Gael MILLOT committed
305
306
307
################ Environment saving


Gael  MILLOT's avatar
Gael MILLOT committed
308
fun_report(data = paste0("\n\n################################ RUNNING END"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
309
310
311
end.date <- Sys.time()
end.time <- as.numeric(end.date)
total.lapse <- round(lubridate::seconds_to_period(end.time - ini.time))
Gael  MILLOT's avatar
Gael MILLOT committed
312
313
314
fun_report(data = paste0("\n\nEND TIME: ", end.date), output = log, path = "./", overwrite = FALSE)
fun_report(data = paste0("\n\nTOTAL TIME LAPSE: ", total.lapse), output = log, path = "./", overwrite = FALSE)
fun_report(data = paste0("\n\nALL DATA SAVED IN all_objects.RData"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
315
316
317


################ end Environment saving
Gael  MILLOT's avatar
Gael MILLOT committed
318
319
320
321
322


################ Warning messages


Gael  MILLOT's avatar
Gael MILLOT committed
323
fun_report(data = paste0("\n\n################################ RECAPITULATION OF WARNING MESSAGES"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
324
if( ! is.null(warn)){
Gael  MILLOT's avatar
Gael MILLOT committed
325
    fun_report(data = paste0("\n\n", warn), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
326
}else{
Gael  MILLOT's avatar
Gael MILLOT committed
327
    fun_report(data = paste0("\n\nNO WARNING MESSAGE TO REPORT"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
328
329
330
}


Gael  MILLOT's avatar
Gael MILLOT committed
331
332
333
################ end Warning messages


Gael  MILLOT's avatar
Gael MILLOT committed
334
335
336
################ Parameter printing


Gael  MILLOT's avatar
Gael MILLOT committed
337
338
339
fun_report(data = paste0("\n\n################################ INITIAL SETTINGS OF PARAMETERS"), output = log, path = "./", overwrite = FALSE)
fun_report(data = param.ini.settings, output = log, path = "./", overwrite = FALSE, , vector.cat = TRUE)
fun_report(data = paste0("\n\n################################ R SYSTEM AND PACKAGES"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
340
341
342
tempo <- sessionInfo()
tempo$otherPkgs <- tempo$otherPkgs[order(names(tempo$otherPkgs))] # sort the packages
tempo$loadedOnly <- tempo$loadedOnly[order(names(tempo$loadedOnly))] # sort the packages
Gael  MILLOT's avatar
Gael MILLOT committed
343
344
fun_report(data = tempo, output = log, path = "./", overwrite = FALSE, , vector.cat = TRUE)
fun_report(data = paste0("\n\n################################ JOB END\n\nTIME: ", end.date, "\n\nTOTAL TIME LAPSE: ", total.lapse, "\n"), output = log, path = "./", overwrite = FALSE)
Gael  MILLOT's avatar
Gael MILLOT committed
345
346


Gael  MILLOT's avatar
Gael MILLOT committed
347
348
349
################ end Parameter printing


Gael  MILLOT's avatar
Gael MILLOT committed
350
351
352
353
354
355
356
357
################################ End Main code