From 70dfa6ef8e4bf259c7ae1cc21ce6a63211c59e20 Mon Sep 17 00:00:00 2001 From: rafnuss Date: Sun, 30 Oct 2022 23:02:20 -0400 Subject: [PATCH] create `path2df()` and `utils.R` --- NAMESPACE | 1 + R/geopressure.R | 6 +++ R/progress_bar.R | 17 -------- R/utils.R | 79 +++++++++++++++++++++++++++++++++++++ _pkgdown.yml | 4 ++ man/geopressure_map2path.Rd | 7 ++++ man/path2df.Rd | 40 +++++++++++++++++++ 7 files changed, 137 insertions(+), 17 deletions(-) delete mode 100644 R/progress_bar.R create mode 100644 R/utils.R create mode 100644 man/path2df.Rd diff --git a/NAMESPACE b/NAMESPACE index 0e2e49d3..99c7b9f7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ export(light2mat) export(pam_classify) export(pam_read) export(pam_sta) +export(path2df) export(refracted) export(solar) export(trainset_read) diff --git a/R/geopressure.R b/R/geopressure.R index 61901eca..fb738aeb 100644 --- a/R/geopressure.R +++ b/R/geopressure.R @@ -721,6 +721,12 @@ geopressure_ts_path <- function(path, #' stationary period id (`sta_id`) as column. Optionally, if indexes were requested, it will be #' return. You will need to use `which.max(as.matrix(raster))` and not `which.max(raster)` to get #' the correct location. +#' @examples +#' # See `geopressure_prob_map()` for generating pressure_prob +#' pressure_prob_1 <- readRDS(system.file("extdata/1_pressure/", "18LX_pressure_prob_1.rda", +#' package = "GeoPressureR" +#' )) +#' geopressure_map2path(list(pressure_prob_1)) #' @seealso [`geopressure_prob_map()`], [`geopressure_ts_path()`], [GeoPressureManual | Pressure Map #' ](https://raphaelnussbaumer.com/GeoPressureManual/pressure-map.html#compute-altitude) #' @export diff --git a/R/progress_bar.R b/R/progress_bar.R deleted file mode 100644 index bdd959d3..00000000 --- a/R/progress_bar.R +++ /dev/null @@ -1,17 +0,0 @@ -#' Progress bar function -#' @param x value of the current status -#' @param max maximum value that x will reach -#' @param text text to display -#' @noRd - -progress_bar <- function(x, max = 100, text = "") { - percent <- x / max * 100 - cat(sprintf( - "\r[%-50s] %d / %d %s", - paste(rep("=", percent / 2), collapse = ""), - x, max, text - )) - if (x == max) { - cat("\n") - } -} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..220e6081 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,79 @@ +#' Progress bar function +#' @param x value of the current status +#' @param max maximum value that x will reach +#' @param text text to display +#' @noRd + +progress_bar <- function(x, max = 100, text = "") { + percent <- x / max * 100 + cat(sprintf( + "\r[%-50s] %d / %d %s", + paste(rep("=", percent / 2), collapse = ""), + x, max, text + )) + if (x == max) { + cat("\n") + } +} + +#' Path to data.frame +#' +#' This function convert a GeoPressureR path to a data.frame which can be read in [movevis]( +#' https://movevis.org/index.html) for instance. +#' +#' The function basically duplicate location position at the start and end time of each stationary +#' period. +#' +#' @param pam pam logger dataset list with `pam$sta` computed (see `pam_sta`) +#' @param path data.frame containtings the path(s) of the bird with column `lat`, `lon` and `sta_id` +#' at least. Path can be generated with `geopressure_map2path`, `graph_simulation`, `geopressureviz` +#' . +#' +#' @examples +#' pam <- pam_read( +#' pathname = system.file("extdata/0_PAM/18LX", package = "GeoPressureR") +#' ) +#' pam <- trainset_read(pam, +#' pathname = system.file("extdata/1_pressure/labels", package = "GeoPressureR") +#' ) +#' pam <- pam_sta(pam) +#' pressure_prob_1 <- readRDS(system.file("extdata/1_pressure/", "18LX_pressure_prob_1.rda", +#' package = "GeoPressureR" +#' )) +#' path <- geopressure_map2path(list(pressure_prob_1)) +#' path2df(pam, path) +#' @seealso [`movevis::df2move`](https://movevis.org/reference/df2move.html), +#' [`geopressure_map2path`], [`graph_simulation`], [`geopressureviz`] +#' @export +path2df <- function(pam, path) { + + # Check input variable + assertthat::assert_that(is.list(pam)) + assertthat::assert_that(assertthat::has_name(pam, "sta")) + assertthat::assert_that(is.data.frame(pam$sta)) + assertthat::assert_that(assertthat::has_name(pam$sta, c("sta_id", "start", "end"))) + + assertthat::assert_that(is.list(path)) + assertthat::assert_that(assertthat::has_name(path, c("lat", "lon", "sta_id"))) + + if (is.matrix(path$lat)) { + df0 <- data.frame( + lat = utils::stack(as.data.frame(t(path$lat)))$values, + lon = stack(as.data.frame(t(path$lon)))$values, + sta_id = rep(path$sta_id, dim(path$lat)[1]), + track_id = paste0(pam$id, "_", rep(seq(1, dim(path$lat)[1]), dim(path$lat)[2])) + ) + df0 <- merge(df0, pam$sta, by = "sta_id") + } else { + df0 <- merge(as.data.frame(path), pam$sta, by = "sta_id") + df0$track_id <- pam$id + } + + df1 <- df0 + df1$time <- df1$start + df2 <- df0 + df2$time <- df2$end + + df <- rbind(df1, df2) + df[, names(df) %in% c("time", "track_id", "lat", "lon")] +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 9cf8f833..15cf07f2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -39,6 +39,10 @@ reference: desc: Vizualize trajectory with a shiny app contents: - geopressureviz +- title: Utility + desc: Short functions + contents: + - path2df navbar: left: - text: "Reference" diff --git a/man/geopressure_map2path.Rd b/man/geopressure_map2path.Rd index 5b8728ea..48357942 100644 --- a/man/geopressure_map2path.Rd +++ b/man/geopressure_map2path.Rd @@ -27,6 +27,13 @@ latitude and longitude. \code{interp} can be used to interpolate unrealistic pos stationary period based on the position of the longer ones. The interpolation assumes that the first and last stationary period can be safely estimated from the probability map. } +\examples{ +# See `geopressure_prob_map()` for generating pressure_prob +pressure_prob_1 <- readRDS(system.file("extdata/1_pressure/", "18LX_pressure_prob_1.rda", + package = "GeoPressureR" +)) +geopressure_map2path(list(pressure_prob_1)) +} \seealso{ \code{\link[=geopressure_prob_map]{geopressure_prob_map()}}, \code{\link[=geopressure_ts_path]{geopressure_ts_path()}}, \href{https://raphaelnussbaumer.com/GeoPressureManual/pressure-map.html#compute-altitude}{GeoPressureManual | Pressure Map } } diff --git a/man/path2df.Rd b/man/path2df.Rd new file mode 100644 index 00000000..e7a74f99 --- /dev/null +++ b/man/path2df.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{path2df} +\alias{path2df} +\title{Path to data.frame} +\usage{ +path2df(pam, path) +} +\arguments{ +\item{pam}{pam logger dataset list with \code{pam$sta} computed (see \code{pam_sta})} + +\item{path}{data.frame containtings the path(s) of the bird with column \code{lat}, \code{lon} and \code{sta_id} +at least. Path can be generated with \code{geopressure_map2path}, \code{graph_simulation}, \code{geopressureviz} +.} +} +\description{ +This function convert a GeoPressureR path to a data.frame which can be read in \href{https://movevis.org/index.html}{movevis} for instance. +} +\details{ +The function basically duplicate location position at the start and end time of each stationary +period. +} +\examples{ +pam <- pam_read( + pathname = system.file("extdata/0_PAM/18LX", package = "GeoPressureR") +) +pam <- trainset_read(pam, + pathname = system.file("extdata/1_pressure/labels", package = "GeoPressureR") +) +pam <- pam_sta(pam) +pressure_prob_1 <- readRDS(system.file("extdata/1_pressure/", "18LX_pressure_prob_1.rda", + package = "GeoPressureR" +)) +path <- geopressure_map2path(list(pressure_prob_1)) +path2df(pam, path) +} +\seealso{ +\href{https://movevis.org/reference/df2move.html}{\code{movevis::df2move}}, +\code{\link{geopressure_map2path}}, \code{\link{graph_simulation}}, \code{\link{geopressureviz}} +}