Merge branch 'matteo-rpm-master'

mchiapello · Sep 3, 2020 · 51bf002 · 51bf002
2 parents e8a99c0 + 9529736
commit 51bf002
Show file tree

Hide file tree

Showing 5 changed files with 144 additions and 38 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,2 +1,4 @@
 ^doc$
 ^Meta$
+^.*\.Rproj$
+^\.Rproj\.user$
diff --git a/.gitignore b/.gitignore
@@ -40,3 +40,4 @@ vignettes/*.pdf
 inst/doc
 doc
 Meta
+.Rproj.user
diff --git a/R/.gitignore b/R/.gitignore
@@ -0,0 +1 @@
+functions.R
diff --git 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
@@ -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
-Original file line number
+Diff line change
@@ Expand Up / @@ -40,3 +40,4 @@ vignettes/*.pdf @@
     inst/doc
     doc
     Meta
+    .Rproj.user