Commit b6240717 authored by Gael  MILLOT's avatar Gael MILLOT
Browse files

tempo saving

parent 1c942182
......@@ -366,16 +366,18 @@ fun_info <- function(data){
# end argument checking
# main code
data.name <- deparse(substitute(data))
output <- list("FILE_NAME" = data.name)
output <- list("NAME" = data.name)
tempo <- list("CLASS" = class(data))
output <- c(output, tempo)
tempo <- list("FILE_HEAD" = head(data))
tempo <- list("TYPE" = typeof(data))
output <- c(output, tempo)
tempo <- list("HEAD" = head(data))
output <- c(output, tempo)
if( ! is.null(data)){
tempo <- list("FILE_TAIL" = tail(data))
tempo <- list("TAIL" = tail(data))
output <- c(output, tempo)
if( ! is.null(dim(data))){
tempo <- list("FILE_DIMENSION" = dim(data))
tempo <- list("DIMENSION" = dim(data))
names(tempo[[1]]) <- c("NROW", "NCOL")
output <- c(output, tempo)
}
......@@ -2158,7 +2160,7 @@ return(list(mat = mat, warnings = warning))
######## fun_permut() #### progressively breaks a vector order
 
 
fun_permut <- function(data1, data2 = NULL, n = NULL, seed = 555, count.print = 10, text.print = "", cor.method = "spearman", cor.limit = 0.2, warn.print = FALSE, path.lib = NULL){
fun_permut <- function(data1, data2 = NULL, n = NULL, seed = NULL, count.print = 10, text.print = "", cor.method = "spearman", cor.limit = 0.2, warn.print = FALSE, path.lib = NULL){
# AIM
# reorder the elements of the data1 vector by flipping 2 randomly selected consecutive positions either:
# 1) n times (when n is precised) or
......@@ -2188,7 +2190,11 @@ fun_permut <- function(data1, data2 = NULL, n = NULL, seed = 555, count.print =
# $cor: a spearman correlation between the initial positions (1:length(data1) and the final positions if data2 is not specified and the final correlation between data1 and data2 otherwise, according to cor.method
# $count: the number of loops used
# EXAMPLES
# fun_permut(data1 = LETTERS[1:5], data2 = NULL, n = 20, seed = 1, count.print = 10, text.print = "", cor.method = "spearman", cor.limit = 0.2)
# example (1) showing that for loop is faster than while loop
# ini.time <- as.numeric(Sys.time()) ; count <- 0 ; for(i0 in 1:1e9){count <- count + 1} ; tempo.time <- as.numeric(Sys.time()) ; tempo.lapse <- round(lubridate::seconds_to_period(tempo.time - ini.time)) ; tempo.lapse
# example (2) showing that for loop is faster than while loop
# ini.time <- as.numeric(Sys.time()) ; count <- 0 ; while(count < 1e9){count <- count + 1} ; tempo.time <- as.numeric(Sys.time()) ; tempo.lapse <- round(lubridate::seconds_to_period(tempo.time - ini.time)) ; tempo.lapse
# fun_permut(data1 = LETTERS[1:5], data2 = NULL, n = 20, seed = 1, count.print = 10, text.print = "CPU NB 4", cor.method = "spearman", cor.limit = 0.2)
# fun_permut(data1 = 101:110, data2 = 21:30, n = 20, seed = 1, count.print = 10, text.print = "", cor.method = "spearman", cor.limit = 0.2)
# a way to use the cor.limit argument just considering data1
# obs1 <- 101:110 ; fun_permut(data1 = obs1, data2 = obs1, seed = 1, count.print = 10, cor.method = "spearman", cor.limit = 0.2)
......@@ -2285,7 +2291,7 @@ loop1 <- 1e9
}else{
loop2 <- 1
}
cat(paste0("\n\nFOR LOOP STEP | ROUND: ", round, " | LOOP1: ", format(loop1, big.mark=","), " | LOOP2: ", format(loop2, big.mark=","), " | TEMPO CORRELATION: ", tempo.cor, "\n"))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FOR LOOP STEP | ROUND: ", round, " | LOOP1: ", format(loop1, big.mark=","), " | LOOP2: ", format(loop2, big.mark=","), " | CORRELATION LIMIT: ", fun_round(cor.limit, 4), " | TEMPO CORRELATION: ", fun_round(tempo.cor, 4), "\n"))
if(loop2 == 1 & loop1 < 100000){
BREAK <- TRUE
}else{
......@@ -2305,7 +2311,7 @@ tempo.time[1] <- as.numeric(Sys.time())
tempo.lapse[1] <- round(lubridate::seconds_to_period(tempo.time - tempo.time.loop))
final.loop[1] <- (tempo.time - tempo.time.loop) / ((i3 - 1) * loop1 + i4) * total.loop # intra nb.compar loop lapse: time lapse / cycles done * cycles remaining
final.exp[1] <- as.POSIXct(final.loop, origin = tempo.date.loop)
cat(paste0("\nFOR LOOP | ROUND ", round, ifelse(text.print == "", "", paste0(" | ", text.print)), " | LOOP 1: ", format(i4, big.mark=","), " / ", format(loop1, big.mark=","), ifelse(loop2 == 1, "", paste0(" | LOOP 2: ", format(i3, big.mark=","), " / ", format(loop2, big.mark=","), " | TOTAL LOOP 1+2 ", format((i3 - 1) * loop1 + i4, big.mark=","), " / ", total.loop)), " | ", format(count, big.mark=","), " PERMUTATION IN data1 | TIME SPENT: ", tempo.lapse, " | EXPECTED END: ", final.exp))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FOR LOOP | ROUND ", round, " | LOOP 1: ", format(i4, big.mark=","), " / ", format(loop1, big.mark=","), ifelse(loop2 == 1, "", paste0(" | LOOP 2: ", format(i3, big.mark=","), " / ", format(loop2, big.mark=","), " | TOTAL LOOP 1+2 ", format((i3 - 1) * loop1 + i4, big.mark=","), " / ", total.loop)), " | ", format(count, big.mark=","), " PERMUTATION IN data1 | TIME SPENT: ", tempo.lapse, " | EXPECTED END: ", final.exp))
}
}
}
......@@ -2368,7 +2374,7 @@ if(count == tempo.count.print){
tempo.count.print[1] <- tempo.count.print + count.print
tempo.time[1] <- as.numeric(Sys.time())
tempo.lapse[1] <- round(lubridate::seconds_to_period(tempo.time - ini.time))
cat(paste0("\nFOR LOOP ", i2, " / ", n, ifelse(text.print == "", "", paste0(" | ", text.print)), " | TIME SPENT: ", tempo.lapse))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FOR LOOP ", i2, " / ", n, " | TIME SPENT: ", tempo.lapse))
}
# pos.check <- c(pos.check, pos)
}
......@@ -2406,7 +2412,7 @@ count2[1] <- 1 # 1 and not 0 because already 1 performed just below
pos[1] <- sample.int(n = pos.seq.max, size = 1, replace = FALSE) # selection of 1 position
tempo.pos[(pos + 1):pos] <- tempo.pos[pos:(pos + 1)]
tempo.cor[1] <- abs(cor(x = data1[tempo.pos], y = data2, use = "pairwise.complete.obs", method = cor.method))
cat("\nFIRST WHILE LOOP STEP\n")
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FIRST WHILE LOOP STEP"))
while(tempo.cor == abs(cor.ini)){
count[1] <- count + 1
count2[1] <- count2 + 1
......@@ -2417,10 +2423,10 @@ if(count2 == tempo.count.print){
tempo.count.print[1] <- tempo.count.print + count.print
tempo.time[1] <- as.numeric(Sys.time())
tempo.lapse[1] <- round(lubridate::seconds_to_period(tempo.time - ini.time))
cat(paste0("\nFIRST WHILE LOOP ", format(count2, big.mark=","), " / ? ", ifelse(text.print == "", "", paste0(" | ", text.print)), " | ", format(count, big.mark=","), " PERMUTATION IN data1 | CORRELATION LIMIT: ", cor.limit, " | TEMPO CORRELATION: ", round(tempo.cor, 3), " | TIME SPENT: ", tempo.lapse))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FIRST WHILE LOOP ", format(count2, big.mark=","), " / ? | ", format(count, big.mark=","), " PERMUTATION IN data1 | CORRELATION LIMIT: ", fun_round(cor.limit, 4), " | TEMPO CORRELATION: ", fun_round(tempo.cor, 4), " | TIME SPENT: ", tempo.lapse))
}
}
cat("\nFIRST WHILE LOOP END")
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FIRST WHILE LOOP END"))
tempo.cor[1] <- abs(cor(x = data1[tempo.pos], y = data2, use = "pairwise.complete.obs", method = cor.method))
if(tempo.cor < cor.limit){
tempo.warnings <- paste0("THE FOR LOOP STEPS HAVE BEEN TOO FAR AND THE SECOND WHILE LOOP STEP HAS NOT BEEN USED")
......@@ -2437,13 +2443,13 @@ count[1] <- tempo.res[[2]]
BREAK[1] <- tempo.res[[3]]
tempo.cor[1] <- abs(cor(x = data1[tempo.pos], y = data2, use = "pairwise.complete.obs", method = cor.method))
}
cat(paste0("\n\nFOR LOOP END | TEMPO CORRELATION: ", tempo.cor, "\n"))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "FOR LOOP END | CORRELATION LIMIT: ", fun_round(cor.limit, 4), " | TEMPO CORRELATION: ", fun_round(tempo.cor, 4)))
tempo.cor[1] <- abs(cor(x = data1[tempo.pos], y = data2, use = "pairwise.complete.obs", method = cor.method))
tempo.date.loop <- Sys.time()
tempo.time.loop <- as.numeric(tempo.date.loop)
tempo.cor.loop <- tempo.cor
count4[1] <- 0
cat("\nSECOND WHILE LOOP STEP\n")
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "SECOND WHILE LOOP STEP"))
while(tempo.cor > cor.limit){
count[1] <- count + 1
count4[1] <- count4 + 1
......@@ -2456,16 +2462,17 @@ tempo.time[1] <- as.numeric(Sys.time())
tempo.lapse[1] <- round(lubridate::seconds_to_period(tempo.time - ini.time))
final.loop[1] <- (tempo.time - tempo.time.loop) / (tempo.cor.loop - tempo.cor) * (tempo.cor - cor.limit) # tempo.cor.loop - tempo.cor always positive and tempo.cor decreases progressively starting from tempo.cor.loop
final.exp[1] <- as.POSIXct(final.loop, origin = tempo.date.loop)
cat(paste0("\nSECOND WHILE LOOP ", ifelse(text.print == "", "", paste0(" | ", text.print)), format(count4, big.mark=","), " / ? | ", format(count, big.mark=","), " PERMUTATION IN data1 | CORRELATION LIMIT: ", cor.limit, " | TEMPO CORRELATION: ", round(tempo.cor, 3), " | TIME SPENT: ", tempo.lapse, " | EXPECTED END: ", final.exp))
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "SECOND WHILE LOOP ", format(count4, big.mark=","), " / ? | ", format(count, big.mark=","), " PERMUTATION IN data1 | CORRELATION LIMIT: ", fun_round(cor.limit, 4), " | TEMPO CORRELATION: ", fun_round(tempo.cor, 4), " | TIME SPENT: ", tempo.lapse, " | EXPECTED END: ", final.exp))
}
}
cat("\nSECOND WHILE LOOP END\n\n")
cat(paste0("\n", ifelse(text.print == "", "", paste0(text.print, " | ")), "SECOND WHILE LOOP END\n\n"))
}
tempo.cor <- ifelse(neg.cor == TRUE, -tempo.cor, tempo.cor)
}
}
if(warn.print == TRUE & ! is.null(warning)){
warning(warning)
cat("\n\n")
}
output <- list(data = data1[tempo.pos], warnings = warnings, cor = if(is.null(data2)){cor(ini.pos, tempo.pos, method = "spearman")}else{tempo.cor}, count = count)
return(output)
......@@ -6347,6 +6354,7 @@ fun_gg_heatmap <- function(data1, legend.name1 = "", low.color1 = "blue", mid.co
# REQUIRED FUNCTIONS FROM CUTE_LITTLE_R_FUNCTION
# fun_check()
# fun_pack()
# fun_round()
# RETURN
# a heatmap if plot argument is TRUE
# a list of the graph info if return argument is TRUE:
......@@ -6489,6 +6497,10 @@ if(length(find("fun_pack", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_pack() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
if(length(find("fun_round", mode = "function")) == 0){
tempo.cat <- paste0("\n\n================\n\nERROR IN ", function.name, ": REQUIRED fun_round() FUNCTION IS MISSING IN THE R ENVIRONMENT\n\n================\n\n")
stop(tempo.cat)
}
# end required function checking
# no reserved words required for this function
# argument checking
......@@ -6673,7 +6685,7 @@ tempo.gg.name <- "gg.indiv.plot."
tempo.gg.count <- 0 # to facilitate debugging
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::ggplot())
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_raster(data = data1, mapping = ggplot2::aes_string(x = names(data1)[ifelse(rotate == FALSE, 2, 1)], y = names(data1)[ifelse(rotate == FALSE, 1, 2)], fill = names(data1)[3]), show.legend = show.scale)) # show.legend option do not remove the legend, only the aesthetic of the legend (dot, line, etc.)
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_gradient2(low = low.color1, high = high.color1, mid = mid.color1, midpoint = midpoint1, limit = limit1, breaks = c(limit1, midpoint1), name = legend.name1))
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_fill_gradient2(low = low.color1, high = high.color1, mid = mid.color1, midpoint = midpoint1, limit = limit1, breaks = c(limit1[1], midpoint1, limit1[2]), labels = fun_round(c(limit1[1], midpoint1, limit1[2])), name = legend.name1))
if( ! is.null(data2)){
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::geom_raster(data = data2, mapping = ggplot2::aes_string(x = names(data2)[ifelse(rotate == FALSE, 2, 1)], y = names(data2)[ifelse(rotate == FALSE, 1, 2)], alpha = names(data2)[3]), fill = color2, show.legend = FALSE))
assign(paste0(tempo.gg.name, tempo.gg.count <- tempo.gg.count + 1), ggplot2::scale_discrete_manual(aesthetics = "alpha", values = if(invert2 == FALSE){c(0, alpha2)}else{c(alpha2, 0)}, guide = FALSE))
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment