diff --git a/.Rbuildignore b/.Rbuildignore index 72278f5..7b0f72c 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,4 @@ ^doc$ ^Meta$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore index c9fd253..f8e39c9 100644 --- a/.gitignore +++ b/.gitignore @@ -40,3 +40,4 @@ vignettes/*.pdf inst/doc doc Meta +.Rproj.user diff --git a/R/.gitignore b/R/.gitignore new file mode 100644 index 0000000..54f2db8 --- /dev/null +++ b/R/.gitignore @@ -0,0 +1 @@ +functions.R diff --git a/R/functions.R b/R/functions.R index 6aed378..f9e5782 100644 --- a/R/functions.R +++ b/R/functions.R @@ -33,6 +33,7 @@ rwaves <- function(x){ # VARIABLES waveforms <- cum <- Sum <- File <- f1 <- f117 <- `:=` <- n <- time <- NULL index1 <- index2 <- id <- sv <- d <- f24 <- f91 <- f95 <- f201 <- NULL + id2 <- res <- NULL ########################################################################### # FORMULA # total number of "X" @@ -312,15 +313,37 @@ rwaves <- function(x){ } return(out) } - # % of 12 during 5 + # % of time spent in 12 during 5, Matteo's attempt ff201 <- function(x){ - newname <- paste0("f201") - out <- tibble(Sum = as.numeric(ff200(x)) * 100) %>% - dplyr::rename(!!newname := Sum) - if(nrow(out) == 0){ - out[1, 1] <- 0 - } - return(out) + newname <- paste0("f201") + x$cum <- c(diff(x$time), x$time[length(x$time)]) + out <- x %>% + dplyr::mutate(index1 = dplyr::case_when(waveforms == 5 ~ 1, + waveforms %in% c(2, 99) ~ 0, + TRUE ~ 3)) %>% + dplyr::mutate(index1 = ifelse(index1 == 3, NA, index1)) %>% + tidyr::fill(index1) %>% + dplyr::mutate(index1 = ifelse(is.na(index1), 0, index1)) %>% + dplyr::mutate(id = LETTERS[replace(with(rle(index1), + rep(cumsum(values), lengths)), index1 == 0, NA)]) %>% + dplyr::filter(!is.na(id)) %>% + dplyr::mutate(index2 = dplyr::case_when(waveforms == 12 ~ 1, + waveforms == 5 ~ 0, + TRUE ~ 3)) %>% + dplyr::mutate(index2 = ifelse(index2 == 3, NA, index2)) %>% + dplyr::mutate(index2 = ifelse(is.na(index2), 0, index2)) %>% + dplyr::mutate(id2 = LETTERS[replace(with(rle(index2), + rep(cumsum(values), lengths)), index2 == 0, NA)]) %>% + dplyr::filter(!is.na(id2)) %>% + dplyr::group_by(index2) %>% + dplyr::summarise(sv = sum(cum)) %>% + dplyr::mutate(Sum = sv / as.numeric(ff91(x))*100) %>% + dplyr::select(Sum) %>% + dplyr::rename(!!newname := Sum) + if(nrow(out) == 0){ + out[1, 1] <- 0 + } + return(out) } # Total duration of nonphloematic phase ff98 <- function(x){ @@ -357,41 +380,103 @@ rwaves <- function(x){ } return(out) } + # Time from 1st probe (="2") to 1st E2 ("=5") + ff112 <- function(x){ + newname <- paste0("f112") + x$cum <- c(diff(x$time), x$time[length(x$time)]) + tmp <- x %>% + dplyr::filter(waveforms == 2) %>% + dplyr::slice(1) %>% + dplyr::pull(time) + tmpb <- x %>% + dplyr::filter(waveforms == 5) %>% + dplyr::slice(1) %>% + dplyr::pull(time) + out <- dplyr::tibble(res := tmpb - tmp) %>% + dplyr::rename(!!newname := res) + if(nrow(out) == 0){ + out[1, 1] <- 0 + } + return(out) + } + # Time from 1st probe (="2") to 1st sustained E2 (> 600 seconds) + ff109 <- function(x){ + newname <- paste0("f109") + x$cum <- c(diff(x$time), x$time[length(x$time)]) + tmp <- x %>% + dplyr::filter(waveforms == 2) %>% + dplyr::slice(1) %>% + dplyr::pull(time) + tmpb <- x %>% + dplyr::mutate(index1 = dplyr::case_when(waveforms == 5 ~ 1, + waveforms %in% c(2, 99) ~ 0, + TRUE ~ 3)) %>% + dplyr::mutate(index1 = ifelse(index1 == 3, NA, index1)) %>% + tidyr::fill(index1) %>% + dplyr::mutate(index1 = ifelse(is.na(index1), 0, index1)) %>% + dplyr::mutate(id = LETTERS[replace(with(rle(index1), + rep(cumsum(values), lengths)), index1 == 0, NA)]) %>% + dplyr::filter(id == as.character(x %>% + dplyr::mutate(index1 = dplyr::case_when(waveforms == 5 ~ 1, + waveforms %in% c(2, 99) ~ 0, + TRUE ~ 3)) %>% + dplyr::mutate(index1 = ifelse(index1 == 3, NA, index1)) %>% + tidyr::fill(index1) %>% + dplyr::mutate(index1 = ifelse(is.na(index1), 0, index1)) %>% + dplyr::mutate(id = LETTERS[replace(with(rle(index1), + rep(cumsum(values), lengths)), index1 == 0, NA)]) %>% + dplyr::group_by(id) %>% + dplyr::summarise(sv = sum(cum)) %>% + dplyr::filter(!is.na(id), + sv >= 600) %>% + dplyr::select(id) %>% + dplyr::slice(1))) %>% + dplyr::slice(1) %>% + dplyr::pull(time) + out <- dplyr::tibble(res := tmpb - tmp) %>% + dplyr::rename(!!newname := res) + if(nrow(out) == 0){ + out[1, 1] <- 0 + } + return(out) + } + ########################################################################### # FUNCTION ## Intermediate table tmp <- x %>% - dplyr::group_by(File) %>% - tidyr::nest() + dplyr::group_by(File) %>% + tidyr::nest() ## Final table tmp %>% - dplyr::mutate(f1 = purrr::map(data, ~ff1(.x, 1))) %>% - dplyr::mutate(f2 = purrr::map(data, ~ff2(.x, 1))) %>% - dplyr::mutate(f3 = purrr::map(data, ~ff3(.x, 1))) %>% - dplyr::mutate(f14 = purrr::map(data, ~ff14(.x))) %>% - dplyr::mutate(f24 = purrr::map(data, ~ff24(.x))) %>% - dplyr::mutate(f29 = purrr::map(data, ~ff2(.x, 2))) %>% - dplyr::mutate(f57 = purrr::map(data, ~ff1(.x, 7))) %>% - dplyr::mutate(f58 = purrr::map(data, ~ff2(.x, 7))) %>% - dplyr::mutate(f75 = purrr::map(data, ~ff1(.x, 4))) %>% - dplyr::mutate(f78 = purrr::map(data, ~ff2(.x, 4))) %>% - dplyr::mutate(f89 = purrr::map(data, ~ff89(.x))) %>% - dplyr::mutate(f90 = purrr::map(data, ~ff90(.x))) %>% - dplyr::mutate(f91 = purrr::map(data, ~ff91(.x))) %>% - dplyr::mutate(f92 = purrr::map(data, ~ff92(.x))) %>% - dplyr::mutate(f93 = purrr::map(data, ~ff93(.x))) %>% - dplyr::mutate(f95 = purrr::map(data, ~ff95(.x))) %>% - dplyr::mutate(f96 = purrr::map(data, ~ff96(.x))) %>% - dplyr::mutate(f98 = purrr::map(data, ~ff98(.x))) %>% - dplyr::mutate(f107 = purrr::map(data, ~ff107(.x))) %>% - dplyr::mutate(f115 = purrr::map(data, ~ff115(.x, 2))) %>% - dplyr::mutate(f117 = purrr::map(data, ~ff115(.x, 7))) %>% - dplyr::mutate(f118 = purrr::map(data, ~ff115(.x, 4))) %>% - dplyr::mutate(f119 = purrr::map(data, ~ff119(.x))) %>% - dplyr::mutate(f119E = purrr::map(data, ~ff119E(.x))) %>% - dplyr::mutate(f200 = purrr::map(data, ~ff200(.x))) %>% - dplyr::mutate(f201 = purrr::map(data, ~ff201(.x))) %>% - # tidyr::unnest(c(f1,f2,f3,f14,f24,f29,f67,f57,f58,f115,f116,f117)) - tidyr::unnest(f1:f201) + dplyr::mutate(f1 = purrr::map(data, ~ff1(.x, 1))) %>% + dplyr::mutate(f2 = purrr::map(data, ~ff2(.x, 1))) %>% + dplyr::mutate(f3 = purrr::map(data, ~ff3(.x, 1))) %>% + dplyr::mutate(f14 = purrr::map(data, ~ff14(.x))) %>% + dplyr::mutate(f24 = purrr::map(data, ~ff24(.x))) %>% + dplyr::mutate(f29 = purrr::map(data, ~ff2(.x, 2))) %>% + dplyr::mutate(f57 = purrr::map(data, ~ff1(.x, 7))) %>% + dplyr::mutate(f58 = purrr::map(data, ~ff2(.x, 7))) %>% + dplyr::mutate(f75 = purrr::map(data, ~ff1(.x, 4))) %>% + dplyr::mutate(f78 = purrr::map(data, ~ff2(.x, 4))) %>% + dplyr::mutate(f89 = purrr::map(data, ~ff89(.x))) %>% + dplyr::mutate(f90 = purrr::map(data, ~ff90(.x))) %>% + dplyr::mutate(f91 = purrr::map(data, ~ff91(.x))) %>% + dplyr::mutate(f92 = purrr::map(data, ~ff92(.x))) %>% + dplyr::mutate(f93 = purrr::map(data, ~ff93(.x))) %>% + dplyr::mutate(f95 = purrr::map(data, ~ff95(.x))) %>% + dplyr::mutate(f96 = purrr::map(data, ~ff96(.x))) %>% + dplyr::mutate(f98 = purrr::map(data, ~ff98(.x))) %>% + dplyr::mutate(f107 = purrr::map(data, ~ff107(.x))) %>% + dplyr::mutate(f109 = purrr::map(data, ~ff109(.x))) %>% + dplyr::mutate(f112 = purrr::map(data, ~ff112(.x))) %>% + dplyr::mutate(f115 = purrr::map(data, ~ff115(.x, 2))) %>% + dplyr::mutate(f117 = purrr::map(data, ~ff115(.x, 7))) %>% + dplyr::mutate(f118 = purrr::map(data, ~ff115(.x, 4))) %>% + dplyr::mutate(f119 = purrr::map(data, ~ff119(.x))) %>% + dplyr::mutate(f119E = purrr::map(data, ~ff119E(.x))) %>% + dplyr::mutate(f200 = purrr::map(data, ~ff200(.x))) %>% + dplyr::mutate(f201 = purrr::map(data, ~ff201(.x))) %>% + tidyr::unnest(f1:f201) } diff --git a/Rwaves.Rproj b/Rwaves.Rproj new file mode 100644 index 0000000..21a4da0 --- /dev/null +++ b/Rwaves.Rproj @@ -0,0 +1,17 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source