Merge pull request #17 from r-spatialecology/utility-functions

Utility functions
r-spatialecology · May 16, 2024 · c4be14e · c4be14e
2 parents 716e149 + 8529e64
commit c4be14e
Show file tree

Hide file tree

Showing 23 changed files with 65 additions and 65 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: vectormetrics
 Title: Landscape Metrics for Categorical Map Patterns in Vector Data
-Version: 0.2.3
+Version: 0.2.4
 Authors@R: 
     c(person("Tomasz", "Matuszek", role = c("cre", "aut"),
              email = "[email protected]"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -2,6 +2,10 @@
 
 S3method(get_patches,sf)
 export(get_axes)
+export(get_circum_diam)
+export(get_eac_perim)
+export(get_hull_area)
+export(get_hull_perim)
 export(get_patches)
 export(vm_c_area_cv)
 export(vm_c_area_mn)
@@ -117,22 +121,18 @@ export(vm_p_area)
 export(vm_p_cai)
 export(vm_p_circ)
 export(vm_p_circle)
-export(vm_p_circum)
 export(vm_p_coh)
 export(vm_p_comp)
 export(vm_p_convex)
 export(vm_p_core)
 export(vm_p_detour)
-export(vm_p_eac_perim)
 export(vm_p_elong)
 export(vm_p_enn)
 export(vm_p_eri)
 export(vm_p_exchange)
 export(vm_p_frac)
 export(vm_p_fullness)
 export(vm_p_girth)
-export(vm_p_hull_a)
-export(vm_p_hull_p)
 export(vm_p_ncore)
 export(vm_p_perarea)
 export(vm_p_perim)

diff --git a/R/vm_p_circum.R → R/get_circum_diam.R b/R/vm_p_circum.R → R/get_circum_diam.R
@@ -8,10 +8,10 @@
 #' @return the function returns tibble with the calculated values in column "value",
 #' this function returns also some important information such as level, class, patch id and metric name.
 #' @examples
-#' vm_p_circum(vector_patches, "class", "patch")
+#' get_circum_diam(vector_patches, "class", "patch")
 #' @export
 
-vm_p_circum <- function(landscape, class_col = NULL, patch_col = NULL) {
+get_circum_diam <- function(landscape, class_col = NULL, patch_col = NULL) {
   # check whether the input is a MULTIPOLYGON or a POLYGON
   if(!all(sf::st_geometry_type(landscape) %in% c("MULTIPOLYGON", "POLYGON"))){
     rlang::abort("Please provide POLYGON or MULTIPOLYGON")

diff --git a/R/vm_p_eac_perim.R → R/get_eac_perim.R b/R/vm_p_eac_perim.R → R/get_eac_perim.R
@@ -8,10 +8,10 @@
 #' @return the function returns tibble with the calculated values in column "value",
 #' this function returns also some important information such as level, class, patch id and metric name.
 #' @examples
-#' vm_p_eac_perim(vector_patches, "class", "patch")
+#' get_eac_perim(vector_patches, "class", "patch")
 #' @export
 
-vm_p_eac_perim <- function(landscape, class_col = NULL, patch_col = NULL) {
+get_eac_perim <- function(landscape, class_col = NULL, patch_col = NULL) {
   # check whether the input is a MULTIPOLYGON or a POLYGON
   if(!all(sf::st_geometry_type(landscape) %in% c("MULTIPOLYGON", "POLYGON"))){
     rlang::abort("Please provide POLYGON or MULTIPOLYGON")

diff --git a/R/vm_p_hull_a.R → R/get_hull_area.R b/R/vm_p_hull_a.R → R/get_hull_area.R
@@ -8,10 +8,10 @@
 #' @return the function returns tibble with the calculated values in column "value",
 #' this function returns also some important information such as level, class, patch id and metric name.
 #' @examples
-#' vm_p_hull_a(vector_patches, "class", "patch")
+#' get_hull_area(vector_patches, "class", "patch")
 #' @export
 
-vm_p_hull_a <- function(landscape, class_col = NULL, patch_col = NULL) {
+get_hull_area <- function(landscape, class_col = NULL, patch_col = NULL) {
   # check whether the input is a MULTIPOLYGON or a POLYGON
   if (!all(sf::st_geometry_type(landscape) %in% c("MULTIPOLYGON", "POLYGON"))) {
     rlang::abort("Please provide POLYGON or MULTIPOLYGON")

diff --git a/R/vm_p_hull_p.R → R/get_hull_perim.R b/R/vm_p_hull_p.R → R/get_hull_perim.R
@@ -8,10 +8,10 @@
 #' @return the function returns tibble with the calculated values in column "value",
 #' this function returns also some important information such as level, class, patch id and metric name.
 #' @examples
-#' vm_p_hull_p(vector_patches, "class", "patch")
+#' get_hull_perim(vector_patches, "class", "patch")
 #' @export
 
-vm_p_hull_p <- function(landscape, class_col = NULL, patch_col = NULL) {
+get_hull_perim <- function(landscape, class_col = NULL, patch_col = NULL) {
   # check whether the input is a MULTIPOLYGON or a POLYGON
   if(!all(sf::st_geometry_type(landscape) %in% c("MULTIPOLYGON", "POLYGON"))){
     rlang::abort("Please provide POLYGON or MULTIPOLYGON")

diff --git a/R/vm_p_circle.R b/R/vm_p_circle.R
@@ -49,7 +49,7 @@ vm_p_circle <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape <- landscape[, c(class_col, patch_col)]
 
   # calculate diameter of smallest circumscribing circle
-  dis_max <- vm_p_circum(landscape, class_col, patch_col)$value
+  dis_max <- get_circum_diam(landscape, class_col, patch_col)$value
 
   # calculate circle metric
   circle_area <- vm_p_area(landscape, class_col, patch_col)$value * 10000

diff --git a/R/vm_p_convex.R b/R/vm_p_convex.R
@@ -30,7 +30,7 @@ vm_p_convex <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape$perim <- vm_p_perim(landscape, class_col, patch_col)$value
 
   # calculate the perimeter of convex hull
-  landscape$conv_perim <- vm_p_hull_p(landscape, class_col, patch_col)$value
+  landscape$conv_perim <- get_hull_perim(landscape, class_col, patch_col)$value
 
   # ratio of perimeter of convex hull and polygon perimeters
   conv_index <- landscape$conv_perim / landscape$perim

diff --git a/R/vm_p_detour.R b/R/vm_p_detour.R
@@ -27,10 +27,10 @@ vm_p_detour <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape <- landscape[, c(class_col, patch_col)]
 
   # calculate the length of each perimeter hull
-  landscape$convex_perim <- vm_p_hull_p(landscape, class_col, patch_col)$value
+  landscape$convex_perim <- get_hull_perim(landscape, class_col, patch_col)$value
 
   # ratio of perimeter of equal-area circle and its convex hull
-  detour_index <- vm_p_eac_perim(landscape, class_col, patch_col)$value / landscape$convex_perim
+  detour_index <- get_eac_perim(landscape, class_col, patch_col)$value / landscape$convex_perim
 
   # return results tibble
   tibble::new_tibble(list(

diff --git a/R/vm_p_girth.R b/R/vm_p_girth.R
@@ -31,7 +31,7 @@ vm_p_girth <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape$insc_circle_rad <- sqrt(insc_circle_area[1:nrow(landscape)] / pi)
 
   # calculate the radius of equal-area circle
-  landscape$radius <- vm_p_eac_perim(landscape, class_col, patch_col)$value / (2 * pi)
+  landscape$radius <- get_eac_perim(landscape, class_col, patch_col)$value / (2 * pi)
 
   # ratio of perimeter of equal-area circle and polygon perimeters
   girth_index <- landscape$insc_circle_rad / landscape$radius

diff --git a/R/vm_p_perim_idx.R b/R/vm_p_perim_idx.R
@@ -30,7 +30,7 @@ vm_p_perim_idx <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape$perim <- vm_p_perim(landscape, class_col, patch_col)$value
 
   # calculate the perimeter of equal-area circle
-  landscape$circle_perim <- vm_p_eac_perim(landscape, class_col, patch_col)$value
+  landscape$circle_perim <- get_eac_perim(landscape, class_col, patch_col)$value
 
   # ratio of perimeter of equal-area circle and polygon perimeters
   perim_index <- landscape$circle_perim / landscape$perim

diff --git a/R/vm_p_proxim.R b/R/vm_p_proxim.R
@@ -47,7 +47,7 @@ vm_p_proxim <- function(landscape, class_col = NULL, patch_col = NULL, n = 1000,
   }
   close(progress_bar)
 
-  radiuses <- vm_p_eac_perim(landscape, class_col, patch_col)$value / (2 * pi) * 0.66
+  radiuses <- get_eac_perim(landscape, class_col, patch_col)$value / (2 * pi) * 0.66
   proximity <- radiuses / landscape$igp_dist
 
   # return results tibble

diff --git a/R/vm_p_range.R b/R/vm_p_range.R
@@ -27,10 +27,10 @@ vm_p_range <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape <- landscape[, c(class_col, patch_col)]
 
   # calculate the diameter of equal-area circle
-  landscape$circle_diam <- vm_p_eac_perim(landscape, class_col, patch_col)$value / pi
+  landscape$circle_diam <- get_eac_perim(landscape, class_col, patch_col)$value / pi
 
   # calculate the diameter of smallest circumscribing circle
-  landscape$circum_diam <- vm_p_circum(landscape, class_col, patch_col)$value
+  landscape$circum_diam <- get_circum_diam(landscape, class_col, patch_col)$value
 
   # ratio of perimeter of equal-area circle and its convex hull
   range_index <- landscape$circle_diam / landscape$circum_diam

diff --git a/R/vm_p_shape.R b/R/vm_p_shape.R
@@ -29,7 +29,7 @@ vm_p_shape <- function(landscape, class_col = NULL, patch_col = NULL) {
 
   # shape metric is the ratio between actual perimeter and the hypothetical minimum perimeter of the patch
   # the hypothetical minimum perimeter of the patch is perimeter of the circle with same amount of area
-  shape <- peri$value / vm_p_eac_perim(landscape, class_col, patch_col)$value
+  shape <- peri$value / get_eac_perim(landscape, class_col, patch_col)$value
 
   # return results tibble 
   tibble::new_tibble(list(

diff --git a/R/vm_p_solid.R b/R/vm_p_solid.R
@@ -30,7 +30,7 @@ vm_p_solid <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape$area <- vm_p_area(landscape, class_col, patch_col)$value * 10000
 
   # calculate the perimeter of convex hull
-  landscape$conv_area <- vm_p_hull_a(landscape, class_col, patch_col)$value
+  landscape$conv_area <- get_hull_area(landscape, class_col, patch_col)$value
 
   # ratio of perimeter of convex hull and polygon perimeters
   solid_index <- landscape$area / landscape$conv_area

diff --git a/R/vm_p_sphere.R b/R/vm_p_sphere.R
@@ -24,7 +24,7 @@ vm_p_sphere <- function(landscape, class_col = NULL, patch_col = NULL) {
   landscape <- landscape[, c(class_col, patch_col)]
 
   # calculate the radius of minimum circumscribing circle
-  landscape$circum <- vm_p_circum(landscape, class_col, patch_col)$value / 2
+  landscape$circum <- get_circum_diam(landscape, class_col, patch_col)$value / 2
 
   # calculate the radius of maximum inscribed circle
   insc_circle_area <- landscape |> sf::st_geometry() |> sf::st_inscribed_circle() |> sf::st_area()

diff --git a/man/vm_p_circum.Rd → man/get_circum_diam.Rd b/man/vm_p_circum.Rd → man/get_circum_diam.Rd
diff --git a/man/vm_p_eac_perim.Rd → man/get_eac_perim.Rd b/man/vm_p_eac_perim.Rd → man/get_eac_perim.Rd
diff --git a/man/vm_p_hull_a.Rd → man/get_hull_area.Rd b/man/vm_p_hull_a.Rd → man/get_hull_area.Rd
diff --git a/man/vm_p_hull_p.Rd → man/get_hull_perim.Rd b/man/vm_p_hull_p.Rd → man/get_hull_perim.Rd
diff --git a/tests/testthat/test_vm_p_circ.R b/tests/testthat/test_vm_p_circ.R
@@ -1,4 +1,4 @@
-testthat::test_that("check vm_p_circum value", {
+testthat::test_that("check vm_p_circ value", {
   expect_equal(vm_p_circ(square, "class")$value, 0.787, tolerance = 0.01)
   expect_equal(vm_p_circ(diamond, "class")$value, 0.628, tolerance = 0.01)
   expect_equal(vm_p_circ(circle, "class")$value, 1, tolerance = 0.01)

diff --git a/tests/testthat/test_vm_p_circum.R b/tests/testthat/test_vm_p_circum.R
@@ -1,27 +1,27 @@
-testthat::test_that("check vm_p_circum value", {
-  expect_equal(vm_p_circum(square, "class")$value, 1.41, tolerance = 0.01)
-  expect_equal(vm_p_circum(diamond, "class")$value, 8, tolerance = 0.01)
-  expect_equal(vm_p_circum(circle, "class")$value, 2)
+testthat::test_that("check get_circum_diam value", {
+  expect_equal(get_circum_diam(square, "class")$value, 1.41, tolerance = 0.01)
+  expect_equal(get_circum_diam(diamond, "class")$value, 8, tolerance = 0.01)
+  expect_equal(get_circum_diam(circle, "class")$value, 2)
 })
 
-testthat::test_that("check vm_p_circum result assertions", {
-  expect_error(vm_p_circum(vector_patches |> sf::st_centroid(), "class"))
+testthat::test_that("check get_circum_diam result assertions", {
+  expect_error(get_circum_diam(vector_patches |> sf::st_centroid(), "class"))
 })
 
-testthat::test_that("check vm_p_circum result structure", {
-  expect_s3_class(vm_p_circum(square, "class"), "tbl_df")
-  expect_equal(ncol(vm_p_circum(square, "class")), 5)
-  expect_equal(nrow(vm_p_circum(vector_patches, "class")), nrow(vector_patches))
-  expect_true(!is.na(vm_p_circum(squaretxt, "class")$class))
+testthat::test_that("check get_circum_diam result structure", {
+  expect_s3_class(get_circum_diam(square, "class"), "tbl_df")
+  expect_equal(ncol(get_circum_diam(square, "class")), 5)
+  expect_equal(nrow(get_circum_diam(vector_patches, "class")), nrow(vector_patches))
+  expect_true(!is.na(get_circum_diam(squaretxt, "class")$class))
   expect_equal(
-    nrow(vector_patches |> dplyr::inner_join(vm_p_circum(vector_patches, "class", "patch"), by = c("patch" = "id"))),
+    nrow(vector_patches |> dplyr::inner_join(get_circum_diam(vector_patches, "class", "patch"), by = c("patch" = "id"))),
     nrow(vector_patches)
   )
   expect_true(all(
-    vector_patches |> dplyr::inner_join(vm_p_circum(vector_patches, "class", "patch"), by = c("patch" = "id")) |> 
+    vector_patches |> dplyr::inner_join(get_circum_diam(vector_patches, "class", "patch"), by = c("patch" = "id")) |> 
       dplyr::mutate(same_class = class.x == class.y) |> dplyr::pull(same_class)
   ))
-  expect_type(vm_p_circum(square, "class")$class, "character")
-  expect_type(vm_p_circum(square, "class")$id, "character")
-  expect_type(vm_p_circum(square, "class")$value, "double")
+  expect_type(get_circum_diam(square, "class")$class, "character")
+  expect_type(get_circum_diam(square, "class")$id, "character")
+  expect_type(get_circum_diam(square, "class")$value, "double")
 })
diff --git a/tests/testthat/test_vm_p_comp.R b/tests/testthat/test_vm_p_comp.R
@@ -1,14 +1,14 @@
-testthat::test_that("check vm_p_circum value", {
+testthat::test_that("check vm_p_comp value", {
   expect_equal(vm_p_comp(square, "class")$value, 0.7853, tolerance = 0.001)
   expect_equal(vm_p_comp(diamond, "class")$value, 0.628, tolerance = 0.001)
   expect_equal(vm_p_comp(circle, "class")$value, 1, tolerance = 0.001)
 })
 
-testthat::test_that("check vm_p_circum result assertions", {
+testthat::test_that("check vm_p_comp result assertions", {
   expect_error(vm_p_comp(vector_patches |> sf::st_centroid(), "class"))
 })
 
-testthat::test_that("check vm_p_circum result structure", {
+testthat::test_that("check vm_p_comp result structure", {
   expect_s3_class(vm_p_comp(square, "class"), "tbl_df")
   expect_equal(ncol(vm_p_comp(square, "class")), 5)
   expect_equal(nrow(vm_p_comp(vector_patches, "class")), nrow(vector_patches))