Add vignette and code for light geopositioning

DESCRIPTION

@@ -17,7 +17,8 @@ Suggests:
     leaflet,
     ggplot2,
     plotly,
-    RColorBrewer
+    RColorBrewer,
+    MASS
 VignetteBuilder: knitr
 Imports: 
     raster,

NAMESPACE

@@ -1,11 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
+export(findTwilights)
 export(geopressure_map)
 export(geopressure_prob_map)
 export(geopressure_ts)
 export(pam_classify)
 export(pam_read)
 export(pam_sta)
+export(refracted)
+export(solar)
 export(trainset_edit)
 export(trainset_read)
 export(trainset_write)
+export(zenith)

R/PAM.R

@@ -13,12 +13,13 @@
 #' @return a list of all measurements
 #'
 #' @examples
-#' pam_data = pam_read(
-#'    pathname = system.file("extdata", package = "GeoPressureR"),
-#'    crop_start = "2017-06-20", crop_end = "2018-05-02")
+#' pam_data <- pam_read(
+#'   pathname = system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
 #' summary(pam_data)
 #' for (i in 1:length(pam_data)) {
-#'    head(pam_data[[i]])
+#'   head(pam_data[[i]])
 #' }
 #' @export
 pam_read <- function(pathname,
@@ -60,7 +61,8 @@ pam_read <- function(pathname,
     } else {
       fname <- strsplit(f, "\\.")[[1]][2]
     }
-    pam[[fname]] <- pam_read_file(paste0(pathname, '/', f), crop_start, crop_end)
+    pam[[fname]] <- pam_read_file(
+      paste0(pathname, "/", f), crop_start, crop_end)
   }
 
   # return
@@ -136,10 +138,11 @@ pam_read_file <- function(filename, crop_start, crop_end) {
 #' @return pam
 #'
 #' @examples
-#' pam_data = pam_read(
-#'    pathname = system.file("extdata", package = "GeoPressureR"),
-#'    crop_start = "2017-06-20", crop_end = "2018-05-02")
-#' pam_data = pam_classify(pam_data, min_duration = 30)
+#' pam_data <- pam_read(
+#'   pathname = system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
+#' pam_data <- pam_classify(pam_data, min_duration = 30)
 #' head(pam_data$acceleration)
 #' @export
 pam_classify <- function(pam,
@@ -256,12 +259,14 @@ trainset_edit <- function(pam,
 #'
 #' @examples
 #' \dontrun{
-#' pam_data = pam_read(
-#'    pathname = system.file("extdata", package = "GeoPressureR"),
-#'    crop_start = "2017-06-20", crop_end = "2018-05-02")
-#' pam_data = pam_classify(pam_data)
+#' pam_data <- pam_read(
+#'   pathname = system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
+#' pam_data <- pam_classify(pam_data)
 #' trainset_write(pam_data,
-#'             pathname=system.file("extdata", package = "GeoPressureR"))
+#'   pathname = system.file("extdata", package = "GeoPressureR")
+#' )
 #' }
 #' @export
 trainset_write <- function(pam,
@@ -328,11 +333,13 @@ trainset_write <- function(pam,
 #' (`pam$pressure$class` and `pam$acceleration$class`)
 #'
 #' @examples
-#' pam_data = pam_read(
-#'    pathname = system.file("extdata", package = "GeoPressureR"),
-#'    crop_start = "2017-06-20", crop_end = "2018-05-02")
-#' pam_data = trainset_read(pam_data,
-#'             pathname=system.file("extdata", package = "GeoPressureR"))
+#' pam_data <- pam_read(
+#'   pathname = system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
+#' pam_data <- trainset_read(pam_data,
+#'   pathname = system.file("extdata", package = "GeoPressureR")
+#' )
 #' head(pam_data$pressure)
 #' head(pam_data$acceleration)
 #' @export
@@ -355,7 +362,7 @@ trainset_read <- function(pam,
   testthat::expect_true(
     dir.exists(pathname), paste0("Folder is not found at", pathname)
   )
-  fullpath <- paste0(pathname, '/', filename)
+  fullpath <- paste0(pathname, "/", filename)
   testthat::expect_true(
     file.exists(fullpath), paste0("File is not found at", fullpath)
   )
@@ -382,20 +389,22 @@ trainset_read <- function(pam,
 #' Compute stationary periods
 #'
 #' This function computes the table of stationary periods from the class of
-#' acceleration `pam$acceleration$class` and add it to the pam
+#' acceleration `pam$acceleration$class` and add it to the pam data as `sta_id`
 #'
 #' @param pam pam logger dataset list
 #' @return pam logger dataset list with a the dataframe of stationary periods
 #' `pam$sta` as well as the new label named `sta_id` (`pam$pressure$sta_id` and
 #' `pam$acceleration$sta_id`)
 #'
 #' @examples
-#' pam_data = pam_read(
-#'    pathname = system.file("extdata", package = "GeoPressureR"),
-#'    crop_start = "2017-06-20", crop_end = "2018-05-02")
-#' pam_data = trainset_read(pam_data,
-#'             pathname=system.file("extdata", package = "GeoPressureR"))
-#' pam_data = pam_sta(pam_data)
+#' pam_data <- pam_read(
+#'   pathname = system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
+#' pam_data <- trainset_read(pam_data,
+#'   pathname = system.file("extdata", package = "GeoPressureR")
+#' )
+#' pam_data <- pam_sta(pam_data)
 #' head(pam_data$pressure)
 #' head(pam_data$acceleration)
 #' @export
@@ -412,6 +421,9 @@ pam_sta <- function(pam) {
   testthat::expect_true("date" %in% names(pam$acceleration))
   testthat::expect_true("act" %in% names(pam$acceleration))
   testthat::expect_true("class" %in% names(pam$acceleration))
+  testthat::expect_type(pam$light, "list")
+  testthat::expect_true("date" %in% names(pam$light))
+  testthat::expect_true("obs" %in% names(pam$light))
 
   # Create a table of activities (migration or stationary)
   act_id <- c(1, cumsum(diff(as.numeric(pam$acceleration$class)) != 0) + 1)
@@ -436,7 +448,7 @@ pam_sta <- function(pam) {
   # Compute the duration
   pam$sta$duration <- pam$sta$end - pam$sta$start
   pam$sta$next_flight_duration <- c(act_mig$duration, 0)
-  pam$sta$sta_id <- 1:nrow(pam$sta)
+  pam$sta$sta_id <- seq_len(nrow(pam$sta))
 
   # Assign to each pressure the stationary period to which it belong to.
   pressure_sta_id <- sapply(
@@ -445,6 +457,13 @@ pam_sta <- function(pam) {
   pressure_sta_id[sapply(pressure_sta_id, function(x) length(x) == 0)] <- 0
   pam$pressure$sta_id <- unlist(pressure_sta_id)
 
+  # Assign to each light measurement the stationary period
+  light_sta_id <- sapply(
+    pam$light$date, function(x) which(pam$sta$start < x & x < pam$sta$end)
+  )
+  light_sta_id[sapply(light_sta_id, function(x) length(x) == 0)] <- 0
+  pam$light$sta_id <- unlist(light_sta_id)
+
   # return the updated list
   pam
 }

R/data.R

@@ -6,18 +6,22 @@
 #' `raster_list` was created with
 #' @examples
 #' \dontrun{
-#' pam_data = pam_read(system.file("extdata", package = "GeoPressureR"),
-#' crop_start = "2017-06-20", crop_end = "2018-05-02")
-#' pam_data = trainset_read(pam_data, system.file("extdata", package = "GeoPressureR"))
-#' pam_data = pam_sta(pam_data)
+#' pam_data <- pam_read(system.file("extdata", package = "GeoPressureR"),
+#'   crop_start = "2017-06-20", crop_end = "2018-05-02"
+#' )
+#' pam_data <- trainset_read(pam_data,
+#' system.file("extdata", package = "GeoPressureR"))
+#' pam_data <- pam_sta(pam_data)
 #'
-#' sta_id_keep = pam_data$sta$sta_id[difftime(pam_data$sta$end,pam_data$sta$start, units = "hours")>12]
-#' pam_data$pressure$sta_id[!(pam_data$pressure$sta_id %in% sta_id_keep)] = NA
+#' sta_id_keep <- pam_data$sta$sta_id[difftime(pam_data$sta$end,
+#' pam_data$sta$start, units = "hours") > 12]
+#' pam_data$pressure$sta_id[!(pam_data$pressure$sta_id %in% sta_id_keep)] <- NA
 #'
-#' raster_list = geopressure_map(pam_data$pressure, extent=c(-16,20,0,50), scale=10, max_sample=100)
+#' raster_list <- geopressure_map(pam_data$pressure,
+#' extent = c(-16, 20, 0, 50), scale = 10, max_sample = 100)
 #'
 #' # Save the data for vignette
-#' usethis::use_data(raster_list, overwrite=T)
+#' usethis::use_data(raster_list, overwrite = T)
 #' }
 "raster_list"
 
@@ -29,9 +33,9 @@
 #' `prob_map_list` was created with
 #' @examples
 #' \dontrun{
-#' prob_map_list = geopressure_prob_map(raster_list)
+#' prob_map_list <- geopressure_prob_map(raster_list)
 #' # Save the data for vignette
-#' usethis::use_data(prob_map_list, overwrite=T)
+#' usethis::use_data(prob_map_list, overwrite = T)
 #' }
 "prob_map_list"
 
@@ -43,29 +47,34 @@
 #' `ts_list` was created with
 #' @examples
 #' \dontrun{
-#' ts_list=list()
-#' for (i_r in 1:length(prob_map_list)){
-#'   i_s = metadata(prob_map_list[[i_r]])$sta_id
+#' ts_list <- list()
+#' for (i_r in 1:length(prob_map_list)) {
+#'   i_s <- metadata(prob_map_list[[i_r]])$sta_id
 #'
 #'   # find the max value of probability
-#'   tmp = as.data.frame(prob_map_list[[i_r]],xy=T)
-#'   lon = tmp$x[which.max(tmp[,3])]
-#'   lat = tmp$y[which.max(tmp[,3])]
+#'   tmp <- as.data.frame(prob_map_list[[i_r]], xy = T)
+#'   lon <- tmp$x[which.max(tmp[, 3])]
+#'   lat <- tmp$y[which.max(tmp[, 3])]
 #'
 #'   # query the pressure at this location
-#'   message("query:",i_r,"/",length(sta_id_keep))
-#'   ts_list[[i_r]] = geopressure_ts(lon,
-#'                                   lat,
-#'                                   pressure = subset(pam_data$pressure,sta_id==1))
+#'   message("query:", i_r, "/", length(sta_id_keep))
+#'   ts_list[[i_r]] <- geopressure_ts(lon,
+#'     lat,
+#'     pressure = subset(pam_data$pressure, sta_id == 1)
+#'   )
 #'   # Add sta_id
-#'   ts_list[[i_r]]['sta_id'] = i_s
+#'   ts_list[[i_r]]["sta_id"] <- i_s
 #'
 #'   # Remove mean
-#'   ts_list[[i_r]]$pressure0 = ts_list[[i_r]]$pressure -
-#'    mean(ts_list[[i_r]]$pressure) + mean(pam_data$pressure$obs[id])
+#'   ts_list[[i_r]]$pressure0 <- ts_list[[i_r]]$pressure -
+#'     mean(ts_list[[i_r]]$pressure) + mean(pam_data$pressure$obs[id])
 #' }
 #' # Save the data for vignette
-#' usethis::use_data(ts_list, overwrite=T)
+#' usethis::use_data(ts_list, overwrite = T)
 #' }
 "ts_list"
 
+#' Probability map of light for 18LX
+#'
+#' This dataset was generated with the vignette `Light-based geopositiong`
+"raster_light_list"