Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

IIASA 2023 improvements #308

Merged
merged 64 commits into from
Nov 1, 2023
Merged
Changes from 1 commit
Commits
Show all changes
64 commits
Select commit Hold shift + click to select a range
7e1ebc9
extracts helper functions
Nowosad Sep 24, 2023
9c147c7
adds extras to calculate_lsm
Nowosad Sep 24, 2023
8c561a6
adds many extras
Nowosad Sep 24, 2023
1c5903f
updates lsm_p_area
Nowosad Sep 24, 2023
fd25f0a
updates lsm_p_circle
Nowosad Sep 24, 2023
da18bad
adds extras to complexity met
Nowosad Sep 24, 2023
b903d04
cleans lsi functions
Nowosad Sep 24, 2023
a8752fb
updates cpp funs
Nowosad Sep 25, 2023
1699a1d
uses int
Nowosad Sep 25, 2023
cab9829
moves as.int to claculate lsm
Nowosad Sep 25, 2023
67d9e01
moves resolution and points to extras
Nowosad Sep 25, 2023
65e4592
adds the prepare extras mechanism
Nowosad Sep 26, 2023
37ed2c4
improves handling of extras
Nowosad Sep 27, 2023
50e3cde
adds wip
Nowosad Sep 29, 2023
90059bc
updates to ggplot2 changes
Nowosad Sep 29, 2023
6f54760
replaces tibbles with new tibbles (errors still may occur)
Nowosad Sep 29, 2023
0b40f30
all of the examples work
Nowosad Sep 29, 2023
5b5b8fc
fixes typos
Nowosad Sep 30, 2023
af0127f
fixes points
Nowosad Oct 1, 2023
0a0ee82
updates window
Nowosad Oct 3, 2023
5e4bcbd
cleans empty line
Nowosad Oct 3, 2023
66f2451
improves docs
Nowosad Oct 3, 2023
fb8df00
updates ver
Nowosad Oct 3, 2023
48e8486
Merge remote-tracking branch 'origin/main' into commoncalcs
Nowosad Oct 5, 2023
ecb533e
updates sysdata
Nowosad Oct 5, 2023
463e4d5
tries to update internal files
Nowosad Oct 5, 2023
100f064
updates missing arg
Nowosad Oct 5, 2023
856c9de
updates res calc
Nowosad Oct 5, 2023
147b170
updates missing args
Nowosad Oct 5, 2023
a581338
adds missing commas
Nowosad Oct 5, 2023
e373df5
adds missing arg
Nowosad Oct 5, 2023
ac7327f
adds missing args
Nowosad Oct 5, 2023
875848d
updates missing resolution
Nowosad Oct 5, 2023
b84c6c7
fixes missing resolution
Nowosad Oct 5, 2023
9969c40
compress sysdata
Nowosad Oct 5, 2023
3fea7f9
specify compression
Nowosad Oct 5, 2023
a489f1b
updates example
Nowosad Oct 6, 2023
63bb346
speeds up get_nearestneighbour
Nowosad Oct 6, 2023
4d025d6
cleans and improves style
Nowosad Oct 6, 2023
d443788
cleans
Nowosad Oct 6, 2023
b2d97dc
improves code enn
Nowosad Oct 6, 2023
2e312f6
improves docs and style
Nowosad Oct 6, 2023
8976eef
improves code
Nowosad Oct 6, 2023
cd0e339
renames extras function
Nowosad Oct 6, 2023
512e93a
adds docs for internal funs
Nowosad Oct 6, 2023
665285c
improves code style
Nowosad Oct 6, 2023
cf038da
adds namespace
Nowosad Oct 6, 2023
ad7f0ff
cleans extras prep
Nowosad Oct 6, 2023
d4694c6
fixes obj name
Nowosad Oct 6, 2023
2ef4b8a
fixes partial matches
Nowosad Oct 6, 2023
26c5c42
removes old file
Nowosad Oct 6, 2023
d25bb90
cleans deps
Nowosad Oct 6, 2023
8b94e44
hides docs
Nowosad Oct 6, 2023
5087867
updates docs
Nowosad Oct 6, 2023
42985c4
cleans old comments
Nowosad Oct 6, 2023
b5b9740
adds 2.1.0 news
Nowosad Oct 6, 2023
dc07195
cleans docs
Nowosad Oct 6, 2023
bdaf760
adds get_perimeter_patch
Nowosad Oct 8, 2023
029fa94
updates NEWS
Nowosad Oct 8, 2023
f53583e
fixes perimeter_patch calcs
Nowosad Oct 8, 2023
165d036
Fixes `window_lsm` behaviour for situations with NAs values and non-s…
Nowosad Oct 8, 2023
badc7dd
adds tabulate speedup
Nowosad Oct 8, 2023
1e7b0d4
improves news
Nowosad Oct 8, 2023
e266358
Adds moving window note (relates to #300)
Nowosad Oct 31, 2023
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
replaces tibbles with new tibbles (errors still may occur)
Nowosad committed Sep 29, 2023
commit 6f5476025cfbe4348633c58345e508d65f132b2c
2 changes: 1 addition & 1 deletion R/data_info.R
Original file line number Diff line number Diff line change
@@ -39,5 +39,5 @@ data_info <- function(landscape){
yes = "integer",
no = "non-integer"))

tibble::tibble(class = class, n_classes = length(landscape_values))
tibble::new_tibble(list(class = class, n_classes = length(landscape_values)))
}
10 changes: 5 additions & 5 deletions R/get_centroids.R
Original file line number Diff line number Diff line change
@@ -73,11 +73,11 @@ get_centroids_calc <- function(landscape, directions, cell_center, verbose) {
# all values NA
if (all(is.na(landscape))) {

return(tibble::tibble(level = "patch",
return(tibble::new_tibble(list(level = rep("patch", nrow()),
class = as.integer(NA),
id = as.integer(NA),
y = as.double(NA),
y = as.double(NA)))
y = as.double(NA))))
}

# get uniuqe class id
@@ -159,9 +159,9 @@ get_centroids_calc <- function(landscape, directions, cell_center, verbose) {
}
}

tibble::tibble(level = "patch",
tibble::new_tibble(list(level = rep("patch", nrow(centroid)),
class = as.integer(centroid$class),
id = as.integer(id),
id = rep(as.integer(id), nrow(centroid)),
x = as.double(centroid$x),
y = as.double(centroid$y))
y = as.double(centroid$y)))
}
10 changes: 5 additions & 5 deletions R/get_circumscribingcircle.R
Original file line number Diff line number Diff line change
@@ -100,12 +100,12 @@ get_circumscribingcircle_calc <- function(landscape, level, directions) {
)

# resulting tibble
circle <- tibble::tibble(level = "patch",
circle <- tibble::new_tibble(list(level = rep("patch", nrow(circle)),
class = as.integer(circle$class),
id = as.integer(seq_len(nrow(circle))),
value = circle$circle_diameter,
center_x = circle$circle_center_x,
center_y = circle$circle_center_y)
center_y = circle$circle_center_y))
}

# class level (no labeling)
@@ -115,12 +115,12 @@ get_circumscribingcircle_calc <- function(landscape, level, directions) {
circle_class <- rcpp_get_circle(landscape, resolution_xy = resolution[1])

# resulting tibble
circle <- tibble::tibble(level = "class",
circle <- tibble::new_tibble(list(level = rep("class", nrow(circle_class)),
class = as.integer(circle_class$patch_id),
id = as.integer(NA),
id = rep(as.integer(NA), nrow(circle_class)),
value = circle_class$circle_diameter,
center_x = circle_class$circle_center_x,
center_y = circle_class$circle_center_y)
center_y = circle_class$circle_center_y))
}

# shift the coordinates to the original coordinate system
6 changes: 3 additions & 3 deletions R/get_nearestneighbour.R
Original file line number Diff line number Diff line change
@@ -81,10 +81,10 @@ get_nearestneighbour_calc <- function(landscape, return_id,

res <- rcpp_get_nearest_neighbor(terra::as.matrix(points, wide= TRUE)[ord, ])

min_dist <- tibble::tibble(cell = num,
min_dist <- tibble::new_tibble(list(cell = num,
dist = res[rank, 1],
id_focal = points[, 3],
id_neighbour = res[rank, 2])
id_neighbour = res[rank, 2]))

min_dist_aggr <- stats::setNames(stats::aggregate(x = min_dist$dist,
by = list(min_dist$id_focal),
@@ -101,5 +101,5 @@ get_nearestneighbour_calc <- function(landscape, return_id,
min_dist_aggr <- min_dist_aggr[!duplicated(min_dist_aggr), ]
}

tibble::tibble(min_dist_aggr)
tibble::new_tibble(list(min_dist_aggr))
}
8 changes: 4 additions & 4 deletions R/helpers.R
Original file line number Diff line number Diff line change
@@ -76,8 +76,8 @@ get_enn_patch <- function(classes, class_patches, points){
# ENN doesn't make sense if only one patch is present
if (np_class == 1) {

enn <- tibble::tibble(class = patches_class,
dist = as.double(NA))
enn <- tibble::new_tibble(list(class = patches_class,
dist = as.double(NA)))

if (verbose) {
warning(paste0("Class ", patches_class,
@@ -91,8 +91,8 @@ get_enn_patch <- function(classes, class_patches, points){
points = points)
}

tibble::tibble(class = patches_class,
value = enn$dist)
tibble::new_tibble(list(class = rep(patches_class, nrow(enn)),
value = enn$dist))
})
)
}
16 changes: 8 additions & 8 deletions R/lsm_c_ai.R
Original file line number Diff line number Diff line change
@@ -65,11 +65,11 @@ lsm_c_ai_calc <- function(landscape, extras = NULL) {

# all values NA
if (all(is.na(landscape))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "ai",
value = as.double(NA)))
value = as.double(NA))))
}

# get coocurrence matrix of like_adjacencies
@@ -80,8 +80,8 @@ lsm_c_ai_calc <- function(landscape, extras = NULL) {
cells_class <- extras$composition_vector

# save to tibble
cells_class <- tibble::tibble(class = names(cells_class),
value = cells_class)
cells_class <- tibble::new_tibble(list(class = names(cells_class),
value = cells_class))

# calculate maximum adjacencies
cells_class$n <- trunc(sqrt(cells_class$value))
@@ -108,9 +108,9 @@ lsm_c_ai_calc <- function(landscape, extras = NULL) {
# max_adj can be zero if only one cell is present; set to NA
ai[is.nan(ai)] <- NA

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", length(ai)),
class = as.integer(names(like_adjacencies)),
id = as.integer(NA),
metric = "ai",
value = as.double(ai)))
id = rep(as.integer(NA), length(ai)),
metric = rep("ai", length(ai)),
value = as.double(ai))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_area_cv.R
Original file line number Diff line number Diff line change
@@ -68,20 +68,20 @@ lsm_c_area_cv_calc <- function(landscape, directions, resolution, extras = NULL)

# all values NA
if (all(is.na(area$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "area_cv",
value = as.double(NA)))
value = as.double(NA))))
}

# calculate cv
area_cv <- stats::aggregate(area[, 5], by = area[, 2],
FUN = function(x) stats::sd(x) / mean(x) * 100)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(area_cv)),
class = as.integer(area_cv$class),
id = as.integer(NA),
metric = "area_cv",
value = as.double(area_cv$value)))
id = rep(as.integer(NA), nrow(area_cv)),
metric = rep("area_cv", nrow(area_cv)),
value = as.double(area_cv$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_area_mn.R
Original file line number Diff line number Diff line change
@@ -69,19 +69,19 @@ lsm_c_area_mn_calc <- function(landscape, directions, resolution, extras = NULL)

# all values NA
if (all(is.na(area$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "area_mn",
value = as.double(NA)))
value = as.double(NA))))
}

# calculate mean
area_mean <- stats::aggregate(area[, 5], by = area[, 2], FUN = mean)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(area_mean)),
class = as.integer(area_mean$class),
id = as.integer(NA),
metric = "area_mn",
value = as.double(area_mean$value)))
id = rep(as.integer(NA), nrow(area_mean)),
metric = rep("area_mn", nrow(area_mean)),
value = as.double(area_mean$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_area_sd.R
Original file line number Diff line number Diff line change
@@ -69,19 +69,19 @@ lsm_c_area_sd_calc <- function(landscape, directions, resolution, extras = NULL)

# all values NA
if (all(is.na(area$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "area_sd",
value = as.double(NA)))
value = as.double(NA))))
}

# calculate sd
area_sd <- stats::aggregate(area[, 5], by = area[, 2], FUN = stats::sd)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(area_sd)),
class = as.integer(area_sd$class),
id = as.integer(NA),
metric = "area_sd",
value = as.double(area_sd$value)))
id = rep(as.integer(NA), nrow(area_sd)),
metric = rep("area_sd", nrow(area_sd)),
value = as.double(area_sd$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_ca.R
Original file line number Diff line number Diff line change
@@ -68,19 +68,19 @@ lsm_c_ca_calc <- function(landscape, directions, resolution, extras = NULL) {

# all values NA
if (all(is.na(core_patch$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "ca",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for each class
ca <- stats::aggregate(x = core_patch[, 5], by = core_patch[, 2], FUN = sum)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(ca)),
class = as.integer(ca$class),
id = as.integer(NA),
metric = "ca",
value = as.double(ca$value)))
id = rep(as.integer(NA), nrow(ca)),
metric = rep("ca", nrows(ca)),
value = as.double(ca$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_cai_cv.R
Original file line number Diff line number Diff line change
@@ -80,19 +80,19 @@ lsm_c_cai_cv_calc <- function(landscape, directions, consider_boundary, edge_dep

# all values NA
if (all(is.na(cai$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "cai_cv",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for classes
cai_cv <- stats::aggregate(x = cai[, 5], by = cai[, 2], FUN = function(x) stats::sd(x) / mean(x) * 100)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(cai_cv)),
class = as.integer(cai_cv$class),
id = as.integer(NA),
metric = "cai_cv",
value = as.double(cai_cv$value)))
id = rep(as.integer(NA), nrow(cai_cv)),
metric = rep("cai_cv", nrow(cai_cv)),
value = as.double(cai_cv$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_cai_mn.R
Original file line number Diff line number Diff line change
@@ -78,19 +78,19 @@ lsm_c_cai_mn_calc <- function(landscape, directions, consider_boundary, edge_dep

# all values NA
if (all(is.na(cai$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "cai_mn",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for each class
cai_mean <- stats::aggregate(x = cai[, 5], by = cai[, 2], FUN = mean)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(cai_mean)),
class = as.integer(cai_mean$class),
id = as.integer(NA),
metric = "cai_mn",
value = as.double(cai_mean$value)))
id = rep(as.integer(NA), nrow(cai_mean)),
metric = rep("cai_mn", nrow(cai_mean)),
value = as.double(cai_mean$value))))
}
12 changes: 6 additions & 6 deletions R/lsm_c_cai_sd.R
Original file line number Diff line number Diff line change
@@ -80,19 +80,19 @@ lsm_c_cai_sd_calc <- function(landscape, directions, consider_boundary, edge_dep

# all values NA
if (all(is.na(cai$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "cai_sd",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for classes
cai_sd <- stats::aggregate(x = cai[, 5], by = cai[, 2], FUN = stats::sd)

return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = rep("class", nrow(cai_sd)),
class = as.integer(cai_sd$class),
id = as.integer(NA),
metric = "cai_sd",
value = as.double(cai_sd$value)))
id = rep(as.integer(NA), nrow(cai_sd)),
metric = rep("cai_sd", nrow(cai_sd)),
value = as.double(cai_sd$value))))
}
15 changes: 8 additions & 7 deletions R/lsm_c_circle_cv.R
Original file line number Diff line number Diff line change
@@ -78,21 +78,22 @@ lsm_c_circle_cv_calc <- function(landscape, directions, resolution, extras = NUL

# all values NA
if (all(is.na(circle$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "circle_cv",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for classes
circle_cv <- stats::aggregate(x = circle[, 5], by = circle[, 2],
FUN = function(x) stats::sd(x) / mean(x) * 100)

return(tibble::tibble(level = "class",
class = as.integer(circle_cv$class),
id = as.integer(NA),
metric = "circle_cv",
value = as.double(circle_cv$value)))
return(tibble::new_tibble(list(
level = rep("class", nrow(circle_cv)),
class = as.integer(circle_cv$class),
id = rep(as.integer(NA), nrow(circle_cv)),
metric = rep("circle_cv", nrow(circle_cv)),
value = as.double(circle_cv$value))))
}

15 changes: 8 additions & 7 deletions R/lsm_c_circle_mn.R
Original file line number Diff line number Diff line change
@@ -76,20 +76,21 @@ lsm_c_circle_mn_calc <- function(landscape, directions, resolution, extras = NUL

# all values NA
if (all(is.na(circle$value))) {
return(tibble::tibble(level = "class",
return(tibble::new_tibble(list(level = "class",
class = as.integer(NA),
id = as.integer(NA),
metric = "circle_mn",
value = as.double(NA)))
value = as.double(NA))))
}

# summarise for classes
circle_mn <- stats::aggregate(x = circle[, 5], by = circle[, 2], FUN = mean)

return(tibble::tibble(level = "class",
class = as.integer(circle_mn$class),
id = as.integer(NA),
metric = "circle_mn",
value = as.double(circle_mn$value)))
return(tibble::new_tibble(list(
level = rep("class", nrow(circle_mn)),
class = as.integer(circle_mn$class),
id = rep(as.integer(NA), nrow(circle_mn)),
metric = rep("circle_mn", nrow(circle_mn)),
value = as.double(circle_mn$value))))
}

Loading