Commit 10aafbe4 authored by Gael  MILLOT's avatar Gael MILLOT
Browse files

v4.0.0 release

parent 0ed1466d
#### DESCRIPTION
Cute Little R Functions contains 16 functions for R/RStudio that facilitate basic procedures in 1) object analysis, 2) object modification, 3) graphic handling and 4) log file management.
Cute Little R Functions contains 17 functions for R/RStudio that facilitate basic procedures in 1) object analysis, 2) object modification, 3) graphic handling and 4) log file management.
The function names are:
fun_param_check()
fun_object_info()
fun_1D_comp()
fun_2D_comp()
fun_list_comp()
fun_dataframe_flipping()
fun_refactorization()
fun_rounding()
fun_90clock_matrix_rot()
fun_hexa_hsv_color_matrix()
fun_window_width_resizing()
fun_open_window()
fun_graph_param_prior_plot()
fun_feature_post_plot()
fun_close_specif_window()
fun_export_data()
fun_param_check() Check the class, type, mode and length, prop, neg values, na.contains, etc., of an object
fun_object_info() provide a full description of the object
fun_1D_comp() compare two 1D datasets (vector of factor or 1D table) of the same class or not
fun_2D_comp() compare two 2D datasets of the same class or not
fun_list_comp() compare two lists
fun_dataframe_remodeling() remodel data frames
fun_refactorization() refactorize a factor or the factor columns of a data frame, such as only the class present are in the levels (no empty levels). The class order in levels is kept
fun_rounding() round a vector of values, if decimal, with the desired number of decimal digits after the decimal leading zeros
fun_90clock_matrix_rot() 90° clockwise matrix rotation
fun_hexa_hsv_color_matrix() convert a matrix made of numbers into a hexadecimal matrix for rgb colorization
fun_window_width_resizing() rescale the width of a window to open depending on the number of classes to plot
fun_open_window() open a pdf or screen (GUI) graphic window
fun_graph_param_prior_plot() very convenient to erase the axes for post plot axis redrawing using fun_feature_post_plot()
fun_feature_post_plot() redesign axis and provide convenients coordinates for adding elements on the drawn graph
fun_close_specif_window() close only specific graphic windows (devices)
fun_var_trim_display() trim and display values from a numeric vector or matrix
fun_export_data() log file function: print a character string or a data object into a same output file
#### HOW TO USE IT
......@@ -47,6 +48,17 @@ Check for updated versions (more recent release tags) at https://gitlab.pasteur.
#### WHAT'S NEW IN
## v4.0.0
1) fun_var_trim_display() function added
2) fun_feature_post_plot() function now provides additional coordinates when there are margins between the figure region and the device region
3) fun_2D_comp() function now provide the common row and column names, and a bug fixed in the detection of identical row or column content
4) error messages now mention the function that generates this message
## v3.1.0
1) fun_export_data() function modified: argument data cannot be NULL
......
################################################################
## ##
## CUTE LITTLE R FUNCTIONS v3.1.0 ##
## CUTE LITTLE R FUNCTIONS v4.0.0 ##
## ##
## Gael A. Millot ##
## ##
......@@ -18,26 +18,24 @@
################ Object analysis 1
######## fun_param_check() #### Checking class, type, length, etc. of objects 1
######## fun_object_info() #### Recovering object information 7
######## fun_1D_comp() #### comparison of two 1D datasets (vectors, factors, 1D tables) 7
######## fun_1D_comp() #### comparison of two 1D datasets (vectors, factors, 1D tables) 8
######## fun_2D_comp() #### comparison of two 2D datasets (row & col names, dimensions, etc.) 11
######## fun_list_comp() #### comparison of two lists 16
################ Object modification 18
######## fun_dataframe_remodeling() #### remodeling a data frame to have column name as a qualitative column and vice-versa 18
######## fun_refactorization() #### remove classes that are not anymore present in factors or factor columns in data frames 20
######## fun_rounding() #### Rounding number if decimal present 22
######## fun_90clock_matrix_rot() #### 90° clockwise matrix rotation 23
######## fun_hexa_hsv_color_matrix() #### Conversion of a numeric matrix into hexadecimal color matrix 23
################ Graphics 26
######## fun_window_width_resizing() #### window width depending on classes to plot 26
######## fun_open_window() #### Open a GUI or pdf graphic window 27
######## fun_graph_param_prior_plot() #### Graph param before plotting 30
######## fun_feature_post_plot() #### Graph param after plotting 33
######## fun_close_specif_window() #### Closing specific graphic windows 41
################ Exporting results (text & tables) 42
######## fun_export_data() #### Print string or data object into output file 42
######## fun_refactorization() #### remove classes that are not anymore present in factors or factor columns in data frames 21
######## fun_rounding() #### Rounding number if decimal present 23
######## fun_90clock_matrix_rot() #### 90° clockwise matrix rotation 24
######## fun_hexa_hsv_color_matrix() #### Conversion of a numeric matrix into hexadecimal color matrix 25
################ Graphics 28
######## fun_window_width_resizing() #### window width depending on classes to plot 28
######## fun_open_window() #### Open a GUI or pdf graphic window 29
######## fun_graph_param_prior_plot() #### Graph param before plotting 32
######## fun_feature_post_plot() #### Graph param after plotting 35
######## fun_close_specif_window() #### Closing specific graphic windows 43
######## fun_quant_var_trim_display() #### Display values from a quantitative variable and trim according to defined cut-offs 45
################ Exporting results (text & tables) 52
######## fun_export_data() #### Print string or data object into output file 52
################################ FUNCTIONS ################################
......@@ -52,11 +50,11 @@
# Check OK: clear to go Apollo
fun_param_check <- function(data, data.name = NULL, class = NULL, typeof = NULL, mode = NULL, length = NULL, prop = NULL, double.as.integer.allowed = FALSE, options = NULL, all.options.in.data = FALSE, na.contain = FALSE, neg.values = TRUE, print = TRUE){
# AIM:
# Check the class, type, mode and length of the data argument
# Mainly used to check the arguments of other functions
# Check also other kind of data parameters, is it a proportion? Is it type double even if it is an integer?
# If options = NULL, then at least class, type, mode or length must be non null
# If options is non null, then class, type and mode must be NULL, and length can be NULL or specified
# check the class, type, mode and length of the data argument
# mainly used to check the arguments of other functions
# check also other kind of data parameters, is it a proportion? Is it type double even if it is an integer?
# if options = NULL, then at least class, type, mode or length must be non null
# if options is non null, then class, type and mode must be NULL, and length can be NULL or specified
# REQUIRED FUNCTIONS
# none
# ARGUMENTS
......@@ -87,101 +85,101 @@ fun_param_check <- function(data, data.name = NULL, class = NULL, typeof = NULL,
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev))
if( ! is.null(data.name)){
if( ! (length(data.name) == 1 & class(data.name) == "character")){
tempo.cat <- paste0("\n\n================\n\nERROR: data.name ARGUMENT MUST BE A SINGLE CHARACTER ELEMENT AND NOT ", paste(data.name, collapse = " "), "\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): data.name ARGUMENT MUST BE A SINGLE CHARACTER ELEMENT AND NOT ", paste(data.name, collapse = " "), "\n\n================\n\n")
stop(tempo.cat)
}
}
if(is.null(options) & is.null(class) & is.null(typeof) & is.null(mode) & is.null(prop) & is.null(length)){
tempo.cat <- paste0("\n\n================\n\nERROR: AT LEAST ONE OF THE options, class, typeof, mode, prop, OR length ARGUMENT MUST BE SPECIFIED\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): AT LEAST ONE OF THE options, class, typeof, mode, prop, OR length ARGUMENT MUST BE SPECIFIED\n\n================\n\n")
stop(tempo.cat)
}
if( ! is.null(options) & ( ! is.null(class) | ! is.null(typeof) | ! is.null(mode) | ! is.null(prop))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE class, typeof, mode AND prop ARGUMENTS MUST BE NULL IF THE option ARGUMENT IS SPECIFIED\nTHE option ARGUMENT MUST BE NULL IF THE class AND/OR typeof AND/OR mode AND/OR prop ARGUMENT IS SPECIFIED\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE class, typeof, mode AND prop ARGUMENTS MUST BE NULL IF THE option ARGUMENT IS SPECIFIED\nTHE option ARGUMENT MUST BE NULL IF THE class AND/OR typeof AND/OR mode AND/OR prop ARGUMENT IS SPECIFIED\n\n================\n\n")
stop(tempo.cat)
}
if( ! (all(class(neg.values) == "logical") & length(neg.values) == 1 & any(is.na(neg.values)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: THE neg.values ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE neg.values ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
stop(tempo.cat)
}
if(neg.values == FALSE & is.null(class) & is.null(typeof) & is.null(mode)){
tempo.cat <- paste0("\n\n================\n\nERROR: THE neg.values ARGUMENT CANNOT BE SWITCHED TO FALSE IF class, typeof AND mode ARGUMENTS ARE NULL\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE neg.values ARGUMENT CANNOT BE SWITCHED TO FALSE IF class, typeof AND mode ARGUMENTS ARE NULL\n\n================\n\n")
stop(tempo.cat)
}
if( ! is.null(class)){
if( ! all(class %in% c("logical", "integer", "numeric", "complex", "character", "matrix", "array", "data.frame", "list", "factor", "table", "expression", "name", "symbol", "function") & any(is.na(class)) != TRUE)){ # not length == 1 here because ordered factors are class "factor" "ordered" (length == 2)
tempo.cat <- paste0("\n\n================\n\nERROR: class ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"integer\", \"numeric\", \"complex\", \"character\", \"matrix\", \"array\", \"data.frame\", \"list\", \"factor\", \"table\", \"expression\", \"name\", \"symbol\", \"function\" \n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): class ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"integer\", \"numeric\", \"complex\", \"character\", \"matrix\", \"array\", \"data.frame\", \"list\", \"factor\", \"table\", \"expression\", \"name\", \"symbol\", \"function\" \n\n================\n\n")
stop(tempo.cat)
}
if(neg.values == FALSE & ! any(class %in% c("numeric", "matrix", "array", "data.frame", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: class ARGUMENT CANNOT BE OTHER THAN \"numeric\", \"matrix\", \"array\", \"data.frame\", \"table\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
if(neg.values == FALSE & ! any(class %in% c("numeric", "integer", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): class ARGUMENT CANNOT BE OTHER THAN \"numeric\", \"integer\", \"table\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(typeof)){
if( ! (all(typeof %in% c("logical", "integer", "double", "complex", "character", "list", "expression", "name", "symbol", "closure", "special", "builtin")) & length(typeof) == 1 & any(is.na(typeof)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: typeof ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"integer\", \"double\", \"complex\", \"character\", \"list\", \"expression\", \"name\", \"symbol\", \"closure\", \"special\", \"builtin\" \n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): typeof ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"integer\", \"double\", \"complex\", \"character\", \"list\", \"expression\", \"name\", \"symbol\", \"closure\", \"special\", \"builtin\" \n\n================\n\n")
stop(tempo.cat)
}
if(neg.values == FALSE & ! typeof %in% c("double", "integer")){
tempo.cat <- paste0("\n\n================\n\nERROR: typeof ARGUMENT CANNOT BE OTHER THAN \"double\" OR \"integer\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): typeof ARGUMENT CANNOT BE OTHER THAN \"double\" OR \"integer\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(mode)){
if( ! (all(mode %in% c("logical", "numeric", "complex", "character", "list", "expression", "name", "symbol", "function")) & length(mode) == 1 & any(is.na(mode)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: mode ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"numeric\", \"complex\", \"character\", \"list\", \"expression\", \"name\", \"symbol\", \"function\"\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): mode ARGUMENT MUST BE ONE OF THESE VALUE:\n\"logical\", \"numeric\", \"complex\", \"character\", \"list\", \"expression\", \"name\", \"symbol\", \"function\"\n\n================\n\n")
stop(tempo.cat)
}
if(neg.values == FALSE & mode != "numeric"){
tempo.cat <- paste0("\n\n================\n\nERROR: mode ARGUMENT CANNOT BE OTHER THAN \"numeric\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): mode ARGUMENT CANNOT BE OTHER THAN \"numeric\" IF neg.values ARGUMENT IS SWITCHED TO FALSE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(length)){
if( ! (is.numeric(length) & length(length) == 1 & ! grepl(length, pattern = "\\.") & any(is.na(length)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: length ARGUMENT MUST BE A SINGLE INTEGER VALUE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): length ARGUMENT MUST BE A SINGLE INTEGER VALUE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(prop)){
if( ! (is.logical(prop) | length(prop) == 1 & any(is.na(prop)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: prop ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): prop ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
stop(tempo.cat)
}else if(prop == TRUE){
if( ! is.null(class)){
if( ! any(class %in% c("numeric", "matrix", "array", "data.frame", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: class ARGUMENT CANNOT BE OTHER THAN \"numeric\", \"matrix\", \"array\", \"data.frame\", \"table\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): class ARGUMENT CANNOT BE OTHER THAN \"numeric\", \"matrix\", \"array\", \"data.frame\", \"table\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(mode)){
if(mode != "numeric"){
tempo.cat <- paste0("\n\n================\n\nERROR: mode ARGUMENT CANNOT BE OTHER THAN \"numeric\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): mode ARGUMENT CANNOT BE OTHER THAN \"numeric\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! is.null(typeof)){
if(typeof != "double"){
tempo.cat <- paste0("\n\n================\n\nERROR: typeof ARGUMENT CANNOT BE OTHER THAN \"double\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): typeof ARGUMENT CANNOT BE OTHER THAN \"double\" IF prop ARGUMENT IS TRUE\n\n================\n\n")
stop(tempo.cat)
}
}
}
}
if( ! (all(class(double.as.integer.allowed) == "logical") & length(double.as.integer.allowed) == 1 & any(is.na(double.as.integer.allowed)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: THE double.as.integer.allowed ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE double.as.integer.allowed ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
stop(tempo.cat)
}
if( ! (is.logical(all.options.in.data) & length(all.options.in.data) == 1 & any(is.na(all.options.in.data)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: all.options.in.data ARGUMENT MUST BE A SINGLE LOGICAL VALUE (TRUE OR FALSE ONLY)\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): all.options.in.data ARGUMENT MUST BE A SINGLE LOGICAL VALUE (TRUE OR FALSE ONLY)\n\n================\n\n")
stop(tempo.cat)
}
if( ! (all(class(na.contain) == "logical") & length(na.contain) == 1 & any(is.na(na.contain)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: THE na.contain ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE na.contain ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
stop(tempo.cat)
}
if( ! (all(class(print) == "logical") & length(print) == 1 & any(is.na(print)) != TRUE)){
tempo.cat <- paste0("\n\n================\n\nERROR: THE print ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_param_check(): THE print ARGUMENT MUST BE TRUE OR FALSE ONLY\n\n================\n\n")
stop(tempo.cat)
}
# end argument checking
......@@ -399,20 +397,20 @@ fun_1D_comp <- function(data1, data2){
# argument checking
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if( ! any(class(data1) %in% c("logical", "integer", "numeric", "character", "factor", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 ARGUMENT MUST BE A NON NULL VECTOR, FACTOR OR 1D TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_1D_comp(): THE data1 ARGUMENT MUST BE A NON NULL VECTOR, FACTOR OR 1D TABLE\n\n================\n\n")
stop(tempo.cat)
}else if(all(class(data1) %in% "table")){
if(length(dim(data1)) > 1){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 ARGUMENT MUST BE A 1D TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_1D_comp(): THE data1 ARGUMENT MUST BE A 1D TABLE\n\n================\n\n")
stop(tempo.cat)
}
}
if( ! any(class(data2) %in% c("logical", "integer", "numeric", "character", "factor", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data2 ARGUMENT MUST BE A NON NULL VECTOR, FACTOR OR 1D TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_1D_comp(): THE data2 ARGUMENT MUST BE A NON NULL VECTOR, FACTOR OR 1D TABLE\n\n================\n\n")
stop(tempo.cat)
}else if(all(class(data2) %in% "table")){
if(length(dim(data2)) > 1){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data2 ARGUMENT MUST BE A 1D TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_1D_comp(): THE data2 ARGUMENT MUST BE A 1D TABLE\n\n================\n\n")
stop(tempo.cat)
}
}
......@@ -584,20 +582,30 @@ fun_2D_comp <- function(data1, data2){
# $row.nb: nb of rows of the 2 datasets if identical (NULL otherwise)
# $same.col.nb: logical. Are number of columns identical ?
# $col.nb: nb of columns of the 2 datasets if identical (NULL otherwise)
# $same.row.name: logical. Are row names identical ?
# $same.row.name: logical. Are row names identical ? NULL if no row names in the two 2D datasets
# $row.name: name of rows of the 2 datasets if identical (NULL otherwise)
# $same.col.name: logical. Are column names identical ?
# $any.id.row.name: logical. Is there any row names identical ? NULL if no row names in the two 2D datasets
# $same.row.name.pos1: position, in data1, of the row names identical in data2
# $same.row.name.pos2: position, in data2, of the row names identical in data1
# $common.row.names: common row names between data1 and data2 (can be a subset of $name or not). NULL if no common row names
# $same.col.name: logical. Are column names identical ? NULL if no col names in the two 2D datasets
# $col.name: name of columns of the 2 datasets if identical (NULL otherwise)
# $any.id.row: logical. is there identical rows ?
# $same.row.pos1: position, in data1, of the rows identical in data2
# $same.row.pos2: position, in data2, of the rows identical in data1
# $any.id.col: logical. is there identical columns ?
# $same.col.pos1: position in data1 of the cols identical in data2
# $same.col.pos2: position in data2 of the cols identical in data1
# $any.id.col.name: logical. Is there any column names identical ? NULL if no col names in the two 2D datasets
# $same.col.name.pos1: position, in data1, of the column names identical in data2
# $same.col.name.pos2: position, in data2, of the column names identical in data1
# $common.col.names: common column names between data1 and data2 (can be a subset of $name or not). NULL if no common column names
# $any.id.row: logical. is there identical rows (not considering row names) ?
# $same.row.pos1: position, in data1, of the rows identical in data2 (not considering row names)
# $same.row.pos2: position, in data2, of the rows identical in data1 (not considering row names)
# $any.id.col: logical. is there identical columns (not considering column names)?
# $same.col.pos1: position in data1 of the cols identical in data2 (not considering column names)
# $same.col.pos2: position in data2 of the cols identical in data1 (not considering column names)
# $identical.object: logical. Are objects identical (including row & column names)?
# $identical.content: logical. Are content objects identical (identical excluding row & column names)?
# EXAMPLES
# obs1 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; obs2 = as.data.frame(matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5]))) ; fun_2D_comp(obs1, obs2)
# obs1 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; obs2 = as.data.frame(matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5]))) ; obs1 ; obs2 ; fun_2D_comp(obs1, obs2)
# obs1 = matrix(1:10, byrow = TRUE, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; obs2 = matrix(c(1:5, 101:105, 6:10), byrow = TRUE, ncol = 5, dimnames = list(c("a", "z", "b"), c(LETTERS[1:2], "k", LETTERS[5:4]))) ; obs1 ; obs2 ; fun_2D_comp(obs1, obs2)
# obs1 = t(matrix(1:10, byrow = TRUE, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5]))) ; obs2 = t(matrix(c(1:5, 101:105, 6:10), byrow = TRUE, ncol = 5, dimnames = list(c("a", "z", "b"), c(LETTERS[1:2], "k", LETTERS[5:4])))) ; obs1 ; obs2 ; fun_2D_comp(obs1, obs2)
# DEBUGGING
# data1 = matrix(1:10, ncol = 5) ; data2 = matrix(1:10, ncol = 5) # for function debugging
# data1 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; data2 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) # for function debugging
......@@ -608,15 +616,16 @@ fun_2D_comp <- function(data1, data2){
# data1 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; data2 = matrix(101:110, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) # for function debugging
# data1 = data.frame(a = 1:3, b= letters[1:3], row.names = LETTERS[1:3]) ; data2 = data.frame(A = 1:3, B= letters[1:3]) # for function debugging
# data1 = matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; data2 = as.data.frame(matrix(1:10, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5]))) # for function debugging
# data1 = matrix(1:10, byrow = TRUE, ncol = 5, dimnames = list(letters[1:2], LETTERS[1:5])) ; data2 = matrix(c(1:5, 101:105, 6:10), byrow = TRUE, ncol = 5, dimnames = list(c("a", "z", "b"), c(LETTERS[1:2], "k", LETTERS[5:4]))) # for function debugging
# data1 = table(Exp1 = c("A", "A", "A", "B", "B", "B"), Exp2 = c("A1", "B1", "A1", "C1", "C1", "B1")) ; data2 = data.frame(A = 1:3, B= letters[1:3]) # for function debugging
# argument checking
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if( ! any(class(data1) %in% c("matrix", "data.frame", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 ARGUMENT MUST BE A MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_2D_comp(): THE data1 ARGUMENT MUST BE A MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
stop(tempo.cat)
}
if( ! any(class(data2) %in% c("matrix", "data.frame", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data2 ARGUMENT MUST BE A MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_2D_comp(): THE data2 ARGUMENT MUST BE A MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
stop(tempo.cat)
}
# end argument checking
......@@ -630,7 +639,15 @@ fun_2D_comp <- function(data1, data2){
col.nb <- NULL
same.row.name <- NULL
row.name <- NULL
any.id.row.name <- NULL
same.row.name.pos1 <- NULL
same.row.name.pos2 <- NULL
common.row.names <- NULL
same.col.name <- NULL
any.id.col.name <- NULL
same.col.name.pos1 <- NULL
same.col.name.pos2 <- NULL
common.col.names <- NULL
col.name <- NULL
any.id.row <- NULL
same.row.pos1 <- NULL
......@@ -651,8 +668,16 @@ fun_2D_comp <- function(data1, data2){
col.nb <- ncol(data1)
same.row.name <- TRUE
row.name <- dimnames(data1)[[1]]
any.id.row.name <- TRUE
same.row.name.pos1 <- 1:row.nb
same.row.name.pos2 <- 1:row.nb
common.row.names <- dimnames(mat1)[[1]]
same.col.name <- TRUE
col.name <- dimnames(data1)[[2]]
any.id.col.name <- TRUE
same.col.name.pos1 <- 1:col.nb
same.col.name.pos2 <- 1:col.nb
common.col.names <- dimnames(mat1)[[2]]
any.id.row <- TRUE
same.row.pos1 <- 1:row.nb
same.row.pos2 <- 1:row.nb
......@@ -664,17 +689,17 @@ fun_2D_comp <- function(data1, data2){
}else{
identical.object <- FALSE
if(all(class(data1) == "table") & length(dim(data1)) == 1){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 ARGUMENT IS A 1D TABLE. USE THE info_1D_dataset_fun FUNCTION\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_2D_comp(): THE data1 ARGUMENT IS A 1D TABLE. USE THE info_1D_dataset_fun FUNCTION\n\n================\n\n")
stop(tempo.cat)
}
if(all(class(data2) == "table") & length(dim(data2)) == 1){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data2 ARGUMENT IS A 1D TABLE. USE THE info_1D_dataset_fun FUNCTION\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_2D_comp(): THE data2 ARGUMENT IS A 1D TABLE. USE THE info_1D_dataset_fun FUNCTION\n\n================\n\n")
stop(tempo.cat)
}
if( ! identical(class(data1), class(data2))){
same.class <- FALSE
}else if( ! any(class(data1) %in% c("matrix", "data.frame", "table"))){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 AND data2 ARGUMENTS MUST BE EITHER MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_2D_comp(): THE data1 AND data2 ARGUMENTS MUST BE EITHER MATRIX, DATA FRAME OR TABLE\n\n================\n\n")
stop(tempo.cat)
}else{
same.class <- TRUE
......@@ -700,8 +725,8 @@ fun_2D_comp <- function(data1, data2){
}
# row and col names
if(is.null(dimnames(data1)) & is.null(dimnames(data2))){
same.row.name <- TRUE
same.col.name <- TRUE
same.row.name <- NULL
same.col.name <- NULL
# row and col names remain NULL
}else if((is.null(dimnames(data1)) & ! is.null(dimnames(data2))) | ( ! is.null(dimnames(data1)) & is.null(dimnames(data2)))){
same.row.name <- FALSE
......@@ -715,6 +740,32 @@ fun_2D_comp <- function(data1, data2){
same.row.name <- TRUE
row.name <- dimnames(data1)[[1]]
}
# row names
any.id.row.name <- FALSE
if(any(dimnames(data1)[[1]] %in% dimnames(data2)[[1]])){
any.id.row.name <- TRUE
same.row.name.pos1 <- which(dimnames(data1)[[1]] %in% dimnames(data2)[[1]])
}
if(any(dimnames(data2)[[1]] %in% dimnames(data1)[[1]])){
any.id.row.name <- TRUE
same.row.name.pos2 <- which(dimnames(data2)[[1]] %in% dimnames(data1)[[1]])
}
if(any.id.row.name == TRUE){
common.row.names <- unique(c(dimnames(data1)[[1]][same.row.name.pos1], dimnames(data2)[[1]][same.row.name.pos2]))
}
# col names
any.id.col.name <- FALSE
if(any(dimnames(data1)[[2]] %in% dimnames(data2)[[2]])){
any.id.col.name <- TRUE
same.col.name.pos1 <- which(dimnames(data1)[[2]] %in% dimnames(data2)[[2]])
}
if(any(dimnames(data2)[[2]] %in% dimnames(data1)[[2]])){
any.id.col.name <- TRUE
same.col.name.pos2 <- which(dimnames(data2)[[2]] %in% dimnames(data1)[[2]])
}
if(any.id.col.name == TRUE){
common.col.names <- unique(c(dimnames(data1)[[2]][same.col.name.pos1], dimnames(data2)[[2]][same.col.name.pos2]))
}
if( ! identical(dimnames(data1)[[2]], dimnames(data2)[[2]])){
same.col.name <- FALSE
# col names remain NULL
......@@ -741,8 +792,8 @@ fun_2D_comp <- function(data1, data2){
row.names(data1) <- paste0("A", 1:nrow(data1))
row.names(data2) <- paste0("A", 1:nrow(data2))
if(same.col.nb == TRUE){ # because if not the same col nb, the row cannot be identical
same.row.pos1 <- suppressWarnings(which(mapply(FUN = identical, c(as.data.frame(t(data1), stringsAsFactors = FALSE)), c(as.data.frame(t(data2), stringsAsFactors = FALSE)))))
same.row.pos2 <- suppressWarnings(which(mapply(FUN = identical, c(as.data.frame(t(data2), stringsAsFactors = FALSE)), c(as.data.frame(t(data1), stringsAsFactors = FALSE)))))
same.row.pos1 <- which(c(as.data.frame(t(data1), stringsAsFactors = FALSE)) %in% c(as.data.frame(t(data2), stringsAsFactors = FALSE)))
same.row.pos2 <- which(c(as.data.frame(t(data2), stringsAsFactors = FALSE)) %in% c(as.data.frame(t(data1), stringsAsFactors = FALSE)))
names(same.row.pos1) <- NULL
names(same.row.pos2) <- NULL
if(all(is.na(same.row.pos1))){
......@@ -765,8 +816,8 @@ fun_2D_comp <- function(data1, data2){
# same.row.pos1 and 2 remain NULL
}
if(same.row.nb == TRUE){ # because if not the same row nb, the col cannot be identical
same.col.pos1 <- suppressWarnings(which(mapply(FUN = identical, c(data1), c(data2))))
same.col.pos2 <- suppressWarnings(which(mapply(FUN = identical, c(data2), c(data1))))
same.col.pos1 <- which(c(data1) %in% c(data2))
same.col.pos2 <- which(c(data2) %in% c(data1))
names(same.col.pos1) <- NULL
names(same.col.pos2) <- NULL
if(all(is.na(same.col.pos1))){
......@@ -796,7 +847,7 @@ fun_2D_comp <- function(data1, data2){
identical.content <- FALSE
}
}
output <- list(same.class = same.class, class = class, same.dim = same.dim, dim = dim, same.row.nb = same.row.nb, row.nb = row.nb, same.col.nb = same.col.nb , col.nb = col.nb, same.row.name = same.row.name, row.name = row.name, same.col.name = same.col.name, col.name = col.name, any.id.row = any.id.row, same.row.pos1 = same.row.pos1, same.row.pos2 = same.row.pos2, any.id.col = any.id.col, same.col.pos1 = same.col.pos1, same.col.pos2 = same.col.pos2, identical.object = identical.object, identical.content = identical.content)
output <- list(same.class = same.class, class = class, same.dim = same.dim, dim = dim, same.row.nb = same.row.nb, row.nb = row.nb, same.col.nb = same.col.nb , col.nb = col.nb, same.row.name = same.row.name, row.name = row.name, any.id.row.name = any.id.row.name, same.row.name.pos1 = same.row.name.pos1, same.row.name.pos2 = same.row.name.pos2, common.row.names = common.row.names, same.col.name = same.col.name, col.name = col.name,any.id.col.name = any.id.col.name, same.col.name.pos1 = same.col.name.pos1, same.col.name.pos2 = same.col.name.pos2, common.col.names = common.col.names, any.id.row = any.id.row, same.row.pos1 = same.row.pos1, same.row.pos2 = same.row.pos2, any.id.col = any.id.col, same.col.pos1 = same.col.pos1, same.col.pos2 = same.col.pos2, identical.object = identical.object, identical.content = identical.content)
return(output)
}
......@@ -841,11 +892,11 @@ fun_list_comp <- function(data1, data2){
# argument checking
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if( ! any(class(data1) %in% "list")){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data1 ARGUMENT MUST BE A LIST\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_list_comp(): THE data1 ARGUMENT MUST BE A LIST\n\n================\n\n")
stop(tempo.cat)
}
if( ! any(class(data2) %in% "list")){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data2 ARGUMENT MUST BE A LIST\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_list_comp(): THE data2 ARGUMENT MUST BE A LIST\n\n================\n\n")
stop(tempo.cat)
}
# end argument checking
......@@ -964,7 +1015,7 @@ fun_dataframe_remodeling <- function(data, quanti.col.name = "quanti", quali.col
# data = data.frame(b = c("e", "e", "h"), a = 1:3) ; quanti.col.name = "quanti" ; quali.col.name = "quali" # for function debugging
# required function checking
if(length(find("fun_param_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR: REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
# end required function checking
......@@ -978,7 +1029,7 @@ fun_dataframe_remodeling <- function(data, quanti.col.name = "quanti", quali.col
}
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_param_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if( ! any(class(data) %in% "data.frame")){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data ARGUMENT MUST BE A DATA FRAME\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): THE data ARGUMENT MUST BE A DATA FRAME\n\n================\n\n")
stop(tempo.cat)
}
# end argument checking
......@@ -991,21 +1042,21 @@ fun_dataframe_remodeling <- function(data, quanti.col.name = "quanti", quali.col
tempo.factor <- unlist(lapply(data, mode))
if(length(data) == 2){
if( ! ((mode(data[, 1]) == "character" & mode(data[, 2]) == "numeric") | mode(data[, 2]) == "character" & mode(data[, 1]) == "numeric" | mode(data[, 2]) == "numeric" & mode(data[, 1]) == "numeric") ){
tempo.cat <- paste0("\n\n================\n\nERROR: IF data ARGUMENT IS A DATA FRAME MADE OF 2 COLUMNS, EITHER A COLUMN MUST BE NUMERIC AND THE OTHER CHARACTER, OR THE TWO COLUMNS MUST BE NUMERIC\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): IF data ARGUMENT IS A DATA FRAME MADE OF 2 COLUMNS, EITHER A COLUMN MUST BE NUMERIC AND THE OTHER CHARACTER, OR THE TWO COLUMNS MUST BE NUMERIC\n\n================\n\n")
stop(tempo.cat)
}
if((mode(data[, 1]) == "character" | mode(data[, 2]) == "character") & (quanti.col.name != "quanti" | quali.col.name != "quali")){
tempo.cat <- paste0("\n\n================\n\nERROR: IMPROPER quanti.col.name OR quali.col.name RESETTINGS. THESE ARGUMENTS ARE RESERVED FOR DATA FRAMES MADE OF n NUMERIC COLUMNS ONLY\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): IMPROPER quanti.col.name OR quali.col.name RESETTINGS. THESE ARGUMENTS ARE RESERVED FOR DATA FRAMES MADE OF n NUMERIC COLUMNS ONLY\n\n================\n\n")
stop(tempo.cat)
}
}else{
if( ! all(tempo.factor %in% "numeric")){
tempo.cat <- paste0("\n\n================\n\nERROR: IF data ARGUMENT IS A DATA FRAME MADE OF ONE COLUMN, OR MORE THAN 2 COLUMNS, THESE COLUMNS MUST BE NUMERIC\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): IF data ARGUMENT IS A DATA FRAME MADE OF ONE COLUMN, OR MORE THAN 2 COLUMNS, THESE COLUMNS MUST BE NUMERIC\n\n================\n\n")
stop(tempo.cat)
}
}
if(( ! any(tempo.factor %in% "character")) & is.null(names(data))){
tempo.cat <- paste0("\n\n================\n\nERROR: NUMERIC DATA FRAME in the data ARGUMENT MUST HAVE COLUMN NAMES\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_dataframe_remodeling(): NUMERIC DATA FRAME in the data ARGUMENT MUST HAVE COLUMN NAMES\n\n================\n\n")
stop()
}
if(all(tempo.factor %in% "numeric")){
......@@ -1059,7 +1110,7 @@ fun_refactorization <- function(data, also.ordered = TRUE){
# data <- ordered(LETTERS[1:6])[-c(1:2)] ; also.ordered <- TRUE # for function debugging
# required function checking
if(length(find("fun_param_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR: REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_refactorization(): REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
# end required function checking
......@@ -1074,13 +1125,13 @@ fun_refactorization <- function(data, also.ordered = TRUE){
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_param_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if(also.ordered == FALSE){
if( ! (all(class(data) == "data.frame") | all(class(data) == "factor"))){
tempo.cat <- paste0("\n\n================\n\nERROR: data ARGUMENT MUST BE A FACTOR (NON ORDERED BECAUSE THE also.ordered ARGUMENT IS SET TO FALSE) OR A DATA FRAME\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_refactorization(): data ARGUMENT MUST BE A FACTOR (NON ORDERED BECAUSE THE also.ordered ARGUMENT IS SET TO FALSE) OR A DATA FRAME\n\n================\n\n")
stop(tempo.cat)
}
}
if(also.ordered == TRUE){
if( ! (all(class(data) == "data.frame") | all(class(data) == "factor") | all(class(data) %in% c("ordered", "factor")))){
tempo.cat <- paste0("\n\n================\n\nERROR: data ARGUMENT MUST BE A FACTOR OR A DATA FRAME\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_refactorization(): data ARGUMENT MUST BE A FACTOR OR A DATA FRAME\n\n================\n\n")
stop(tempo.cat)
}
}
......@@ -1148,7 +1199,7 @@ fun_rounding <- function(data, dec.nb = 2, after.lead.zero = TRUE){
# data = data = c("10", "100.001", "333.0001254", "12312.1235") ; dec.nb = 2 ; after.lead.zero = TRUE # # for function debugging
# argument checking
if( ! (all(typeof(data) == "character") | all(typeof(data) == "double") | all(typeof(data) == "integer"))){
tempo.cat <- paste0("\n\n================\n\nERROR: data ARGUMENT MUST BE A VECTOR OF NUMBERS (IN NUMERIC OR CHARACTER MODE)\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_rounding(): data ARGUMENT MUST BE A VECTOR OF NUMBERS (IN NUMERIC OR CHARACTER MODE)\n\n================\n\n")
stop(tempo.cat)
}
arg.check <- NULL # for function debbuging
......@@ -1209,14 +1260,14 @@ fun_90clock_matrix_rot <- function(data){
# data = matrix(1:10, ncol = 1)
# required function checking
if(length(find("fun_param_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR: REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_90clock_matrix_rot(): REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
# end required function checking
# argument checking
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if( ! any(class(data) %in% "matrix")){
tempo.cat <- paste0("\n\n================\n\nERROR: THE data ARGUMENT MUST BE A MATRIX\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_90clock_matrix_rot(): THE data ARGUMENT MUST BE A MATRIX\n\n================\n\n")
stop(tempo.cat)
}
# end argument checking
......@@ -1254,7 +1305,7 @@ fun_hexa_hsv_color_matrix <- function(mat1, mat.hsv.h = TRUE, notch = 1, s = 1,
# mat1 = matrix(c(1,1,1,2,1,5,9,NA), ncol = 2) ; dimnames(mat1) <- list(LETTERS[1:4], letters[1:2]); mat.hsv.h = FALSE ; notch = 1 ; s = 1 ; v = 1 ; forced.color = c(hsv(1,1,1), hsv(0,0,0)) # for function debugging
# required function checking
if(length(find("fun_param_check", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR: REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
tempo.cat <- paste0("\n\n================\n\nERROR IN fun_hexa_hsv_color_matrix(): REQUIRED fun_param_check() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
# end required function checking
......@@ -1272,7 +1323,7 @@ fun_hexa_hsv_color_matrix <- function(mat1, mat.hsv.h = TRUE, notch = 1, s = 1,
}
# source("C:/Users/Gael/Documents/Git_versions_to_use/debugging_tools_for_r_dev-v1.2/r_debugging_tools-v1.2.R") ; eval(parse(text = str_basic_arg_check_dev)) ; eval(parse(text = str_arg_check_with_fun_param_check_dev)) # activate this line and use the function to check arguments status and if they have been checked using fun_param_check()
if(mat.hsv.h == TRUE & fun_param_check(data = mat1, mode = "numeric", prop = TRUE, print = FALSE)$problem == TRUE){