add tests with mb and add persp plot

Author: Bart

.github/workflows/R-CMD-check.yaml

@@ -14,6 +14,7 @@ jobs:
     runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      MBPWD: ${{ secrets.MBPWD }}
       R_KEEP_PKG_SOURCE: yes
     steps:
       - uses: actions/checkout@v4

.github/workflows/pkgdown.yaml

@@ -38,8 +38,6 @@ jobs:
           needs: website
 
       - name: Build site
-        env:
-          MBPWD: ${{ secrets.MBPWD }}
         run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE)
         shell: Rscript {0}
 

.github/workflows/test-coverage.yaml

@@ -14,6 +14,7 @@ jobs:
     runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      MBPWD: ${{ secrets.MBPWD }}
 
     steps:
       - uses: actions/checkout@v4

DESCRIPTION

@@ -24,7 +24,8 @@ Suggests:
     knitr,
     move2,
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    withr
 Config/testthat/edition: 3
 RoxygenNote: 7.3.2
 VignetteBuilder: knitr

tests/testthat/test-acc.R

@@ -34,47 +34,3 @@ test_that("properties are correctly calculated",{
 
 })
 
-test_that("multiplication works", {
-  skip("To work on")
-  acc(list(
-    matrix(1:12, ncol = 3, dimnames = list(NULL, letters[1:3])),
-    matrix(1:8, ncol = 2, dimnames = list(NULL, letters[4:5]))
-  ), frequency = 2:3)
-  new_acc(list(
-    matrix(units::set_units(1:12, "g"), ncol = 3),
-    matrix(units::set_units(1:8, "g"), ncol = 2)
-  ))
-  new_acc(list(
-    structure(units::set_units(1:10, "g"), dim = c(5L, 2L)),
-    structure(units::set_units(1:15, "g"), dim = c(5L, 3L))
-  ), frequency = c(20, 30), axes = list(c("x", "y"), c("x", "y", "z")))
-  new_acc(list(
-    structure(units::set_units(1:10, "m/s"), dim = c(5L, 2L)),
-    structure(units::set_units(1:15, "m/s"), dim = c(5L, 3L))
-  ))
-})
-test_that("size", {
-  skip()
-  # aa <- move2::movebank_retrieve("study_attribute", study_id = 4502577, sensor_type_id = 2365683) |>
-  #   dplyr::pull("short_name") |>
-  #   grep(pat = "eobs_acceler", value = T)
-  # a <- move2::movebank_download_study(4502577, attributes = aa)
-  # matrixList <- a$eobs_accelerations_raw |>
-  #   tail() |>
-  #   strsplit(" ") |>
-  #   lapply(as.integer) |>
-  #   lapply(matrix, ncol = 3, byrow = T)
-  # new_acc(matrixList)
-  # aaa <- a$eobs_accelerations_raw[100000 + 1:1000]
-  # aac <- as_acc(aaa)
-  # pryr::object_size(aaa)
-  # pryr::object_size(aac)
-  # pryr::object_size(unlist(aac))
-  # pryr::object_size(packBits(lapply(lapply(unlist(aac), intToBits), head, 12) |> unlist(), "integer"))
-  # l <- array(unlist(aac), c(68, 3, 1000))
-  # c(apply(l, 2:3, mean))
-  # bench::mark(
-  #   unlist(lapply(aac, apply, 2, mean)),
-  #   c(apply(l, 2:3, mean))
-  # )
-})

tests/testthat/test-plot_time.R

@@ -0,0 +1,9 @@
+test_that("plot_time", {
+  x <- acc(list(
+    matrix(1:12, ncol = 3, dimnames = list(NULL, letters[1:3])),
+    matrix(1:8, ncol = 2, dimnames = list(NULL, letters[4:5]))
+  ), frequency = units::set_units(2:3,'Hz'))
+  expect_silent(graph<-plot_time(x, Sys.time()+c(0,10)))
+  expect_s3_class(graph,"dygraphs")
+
+})

vignettes/moveAcc.Rmd

@@ -7,7 +7,7 @@ vignette: >
   %\VignetteEncoding{UTF-8}
 ---
 
-```{r, include = FALSE}
+```{r setup, include = FALSE}
 knitr::opts_chunk$set(
   collapse = TRUE,
   comment = "#>"
@@ -23,7 +23,7 @@ if (Sys.getenv("MBPWD") != "") {
 Sys.setlocale("LC_TIME", "en_US.utf8")
 ```
 
-```{r setup}
+```{r load}
 library(moveAcc)
 ```
 The goal of the package is to create a vector representation of acceleration bursts in R. Acceleration bursts are a frequently collected by animal tracking devices and consist of measurements of the acceleration in one till three axis. These measurements are recorded with a fixed frequency for a few seconds. These burst are frequently considered one "instantaneous" sample of the activity or behavior of an animal.
@@ -103,7 +103,42 @@ mt_stack(lbbg_data, kinkajous_data)
 
 With the `plot_time` function it is possible to explor the acceleration bursts. In this plot you can zoom using your mouse.
 
-```{r plot}
+```{r plot, fig.width=6}
 plot_time(lbbg_data$acceleration, mt_time(lbbg_data))
 ```
 
+Alternatively you can plot one burst directly, in this case showing the clear wing beats on the z axis.
+
+
+```{r plot_one, fig.width=6}
+plot_time(lbbg_data$acceleration[340], mt_time(lbbg_data)[340])
+```
+We can also visualize one burst in three dimensions showing the cyclic patterns in the acceleration.
+
+```{r plot3d, fig.width=6, fig.height=6}
+bb<-vctrs::field(lbbg_data$acceleration[340],"bursts")[[1]]
+b<-units::drop_units(bb)
+e<-0.1
+persp(z=matrix(min(b[,'tilt_z'])-e, ncol=2, nrow=2),
+      x=range(b[,'tilt_x']),
+      y=range(b[,'tilt_y']),       
+      xlim=range(b[,'tilt_x'])+c(-e,e),
+      ylim=range(b[,'tilt_y'])+c(-e,e), 
+      zlim=range(b[,'tilt_z'])+c(-e,e),
+      border=NA,
+      xlab=paste0("X [",as.character(units(bb)),']'), 
+      ticktype = "detailed", cex.axis = 0.65,
+      ylab=paste0("Y [",as.character(units(bb)),']'), 
+      zlab=paste0("Z [",as.character(units(bb)),']'), 
+      theta = -160, phi = 20, expand = 0.5, col = "white", scale=F)->p
+# Draw line on bottom of plot
+lines(trans3d(b[,'tilt_x'],b[,'tilt_y'],min(b[,'tilt_z'])-e,p), col="tomato")
+# Lines to connect observations to bottom
+apply(b,1, function(x, bottom){
+  lines(trans3d(x['tilt_x'],x['tilt_y'],c(x['tilt_z'], bottom-e),p), col="gray")
+}, bottom=min(b[,'tilt_z']))
+
+lines(trans3d(b[,'tilt_x'],b[,'tilt_y'],b[,'tilt_z'],p), col="red")
+points(trans3d(b[,'tilt_x'],b[,'tilt_y'],b[,'tilt_z'],p), col="red", pch=19)
+
+```