|
1 | | -# Author: Roozbeh Valavi |
2 | | -# contact: valavi.r@gmail.com |
3 | | -# Date : May 2023 |
4 | | -# Version 0.2 |
5 | | -# Licence GPL v3 |
6 | | - |
7 | | -# check for x |
8 | | -.check_x <- function(x, name = "x"){ |
9 | | - if(!methods::is(x, "sf")){ |
10 | | - tryCatch( |
11 | | - { |
12 | | - x <- sf::st_as_sf(x) |
13 | | - }, |
14 | | - error = function(cond) { |
15 | | - message(sprintf("'%s' is not convertible to an sf object!", name)) |
16 | | - message(sprintf("'%s' must be an sf or spatial* object.", name)) |
17 | | - } |
18 | | - ) |
19 | | - } |
20 | | - return(x) |
21 | | -} |
22 | | - |
23 | | -# check for column matching colnames(x) |
24 | | -.check_column <- function(column, x){ |
25 | | - if(!is.null(column)){ |
26 | | - if(!column %in% colnames(x)){ |
27 | | - warning(sprintf("There is no column named '%s' in 'x'. Column is ignored!\n", column)) |
28 | | - column <- NULL |
29 | | - } |
30 | | - } |
31 | | - return(column) |
32 | | -} |
33 | | - |
34 | | -# column should be binary or categorical |
35 | | -.check_classes <- function(clen, column, th = 15){ |
36 | | - if(clen > th){ |
37 | | - warning( |
38 | | - sprintf( |
39 | | - paste( |
40 | | - "The are too many unique values in '%s'.", |
41 | | - "Use 'column' only for binary or categorical responses (ignore this if it is).\n" |
42 | | - ), |
43 | | - column |
44 | | - ) |
45 | | - ) |
46 | | - } |
47 | | -} |
48 | | - |
49 | | -# check for r |
50 | | -.check_r <- function(r, name = "r"){ |
51 | | - if(!methods::is(r, "SpatRaster")){ |
52 | | - tryCatch( |
53 | | - { |
54 | | - r <- terra::rast(r) |
55 | | - }, |
56 | | - error = function(cond) { |
57 | | - message(sprintf("'%s' is not convertible to a terra SpatRaster object!", name)) |
58 | | - message(sprintf("'%s' must be a SpatRaster, stars, Raster* object, or path to a raster file on disk.", name)) |
59 | | - } |
60 | | - ) |
61 | | - } |
62 | | - return(r) |
63 | | -} |
64 | | - |
65 | | -# check for required packages |
66 | | -.check_pkgs <- function(pkg){ |
67 | | - pkgna <- names(which(sapply(sapply(pkg, find.package, quiet = TRUE), length) == 0)) |
68 | | - if(length(pkgna) > 0){ |
69 | | - nm <- paste(pkgna, collapse = ", ") |
70 | | - message("This function requires these packages: ", nm, "\nWould you like to install them now?\n1: yes\n2: no") |
71 | | - user <- readline(prompt = paste0("Selection: ")) |
72 | | - if(tolower(user) %in% c("1", "yes", "y")){ |
73 | | - utils::install.packages(pkgna) |
74 | | - } else{ |
75 | | - stop("Please install these packages for function to work: ", nm) |
76 | | - } |
77 | | - } |
78 | | -} |
| 1 | +# Author: Roozbeh Valavi |
| 2 | +# contact: valavi.r@gmail.com |
| 3 | +# Date : May 2023 |
| 4 | +# Version 0.2 |
| 5 | +# Licence GPL v3 |
| 6 | + |
| 7 | +# check points fall within the raster layer |
| 8 | +.check_within <- function(x, r) { |
| 9 | + bbox <- sf::st_bbox(x) |
| 10 | + ex <- terra::ext(r) |
| 11 | + |
| 12 | + y <- bbox[1] >= terra::xmin(ex) & |
| 13 | + bbox[3] <= terra::xmax(ex) & |
| 14 | + bbox[2] >= terra::ymin(ex) & |
| 15 | + bbox[4] <= terra::ymax(ex) |
| 16 | + |
| 17 | + if(!y) stop("The x's bounding box lies outside the raster extent.") |
| 18 | +} |
| 19 | + |
| 20 | + |
| 21 | +# check for x |
| 22 | +.check_x <- function(x, name = "x"){ |
| 23 | + if(!methods::is(x, "sf")){ |
| 24 | + tryCatch( |
| 25 | + { |
| 26 | + x <- sf::st_as_sf(x) |
| 27 | + }, |
| 28 | + error = function(cond) { |
| 29 | + message(sprintf("'%s' is not convertible to an sf object!", name)) |
| 30 | + message(sprintf("'%s' must be an sf or spatial* object.", name)) |
| 31 | + } |
| 32 | + ) |
| 33 | + } |
| 34 | + return(x) |
| 35 | +} |
| 36 | + |
| 37 | +# check for column matching colnames(x) |
| 38 | +.check_column <- function(column, x){ |
| 39 | + if(!is.null(column)){ |
| 40 | + if(!column %in% colnames(x)){ |
| 41 | + warning(sprintf("There is no column named '%s' in 'x'. Column is ignored!\n", column)) |
| 42 | + column <- NULL |
| 43 | + } |
| 44 | + } |
| 45 | + return(column) |
| 46 | +} |
| 47 | + |
| 48 | +# column should be binary or categorical |
| 49 | +.check_classes <- function(clen, column, th = 15){ |
| 50 | + if(clen > th){ |
| 51 | + warning( |
| 52 | + sprintf( |
| 53 | + paste( |
| 54 | + "The are too many unique values in '%s'.", |
| 55 | + "Use 'column' only for binary or categorical responses (ignore this if it is).\n" |
| 56 | + ), |
| 57 | + column |
| 58 | + ) |
| 59 | + ) |
| 60 | + } |
| 61 | +} |
| 62 | + |
| 63 | + |
| 64 | +# check raster extent is valid |
| 65 | +.check_ext <- function(r) { |
| 66 | + tryCatch( |
| 67 | + { |
| 68 | + e <- terra::ext(r) |
| 69 | + vals <- e[1:4] |
| 70 | + }, |
| 71 | + error = function(cond) { |
| 72 | + stop("Failed to extract raster extent: ", conditionMessage(cond)) |
| 73 | + } |
| 74 | + ) |
| 75 | + |
| 76 | + y <- all(is.finite(vals)) && |
| 77 | + (terra::xmax(e) > terra::xmin(e)) && |
| 78 | + (terra::ymax(e) > terra::ymin(e)) |
| 79 | + |
| 80 | + if (!y) stop("Invalid raster extent: values are non-finite, degenerate, or out of range.") |
| 81 | +} |
| 82 | + |
| 83 | +# check for r |
| 84 | +.check_r <- function(r, name = "r"){ |
| 85 | + if(!methods::is(r, "SpatRaster")){ |
| 86 | + tryCatch( |
| 87 | + { |
| 88 | + r <- terra::rast(r) |
| 89 | + }, |
| 90 | + error = function(cond) { |
| 91 | + message(sprintf("'%s' is not convertible to a terra SpatRaster object!", name)) |
| 92 | + message(sprintf("'%s' must be a SpatRaster, stars, Raster* object, or path to a raster file on disk.", name)) |
| 93 | + } |
| 94 | + ) |
| 95 | + } |
| 96 | + .check_ext(r) # check for valid extent |
| 97 | + |
| 98 | + return(r) |
| 99 | +} |
| 100 | + |
| 101 | +# check for required packages |
| 102 | +.check_pkgs <- function(pkg){ |
| 103 | + pkgna <- names(which(sapply(sapply(pkg, find.package, quiet = TRUE), length) == 0)) |
| 104 | + if(length(pkgna) > 0){ |
| 105 | + nm <- paste(pkgna, collapse = ", ") |
| 106 | + message("This function requires these packages: ", nm, "\nWould you like to install them now?\n1: yes\n2: no") |
| 107 | + user <- readline(prompt = paste0("Selection: ")) |
| 108 | + if(tolower(user) %in% c("1", "yes", "y")){ |
| 109 | + utils::install.packages(pkgna) |
| 110 | + } else{ |
| 111 | + stop("Please install these packages for function to work: ", nm) |
| 112 | + } |
| 113 | + } |
| 114 | +} |
| 115 | + |
0 commit comments