Skip to content

Commit 5d6f449

Browse files
mhesselbarthmhesselbarth
authored
Merge pull request #69 from r-spatialecology/main
v1.2.1
2 parents 96fa4da + af75d03 commit 5d6f449

9 files changed

+180
-30
lines changed

‎DESCRIPTION

+3-3
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Type: Package
22
Package: shar
33
Title: Species-Habitat Associations
4-
Version: 1.2
4+
Version: 1.2.1
55
Authors@R: c(person("Maximillian H.K.", "Hesselbarth", email = "[email protected]",
66
role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1125-9918")),
77
person("Marco", "Sciaini", email = "[email protected]",
@@ -14,8 +14,8 @@ Description:
1414
Methods are mainly based on Plotkin et al. (2000) <doi:10.1006/jtbi.2000.2158> and
1515
Harms et al. (2001) <doi:10.1111/j.1365-2745.2001.00615.x>.
1616
License: GPL (>= 3)
17-
URL: https://r-spatialecology.github.io/shar
18-
BugReports: https://github.com/r-spatialecology/shar/issues
17+
URL: https://r-spatialecology.github.io/shar/
18+
BugReports: https://github.com/r-spatialecology/shar/issues/
1919
Depends: R (>= 3.1)
2020
Imports:
2121
classInt,

‎NEWS.md

+5
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,8 @@
1+
## shar 1.2.1
2+
* Improvements
3+
* `reconstruct_pattern_homo()` has arguments to specify number of points and window
4+
* `reconstruct_pattern_marks()` allows to have different number of points for `pattern` and `marked_pattern` argument
5+
16
# shar 1.2
27
* Improvements
38
* Include new `spatstat` package structure

‎R/reconstruct_pattern_homo.R

+58-8
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88
#' @param max_runs Maximum number of iterations of e_threshold is not reached.
99
#' @param no_change Reconstrucction will stop if energy does not decrease for this number of iterations.
1010
#' @param annealing Probability to keep relocated point even if energy did not decrease.
11+
#' @param n_points Number of points to be simulated.
12+
#' @param window Window of simulated pattern.
1113
#' @param comp_fast If pattern contains more points than threshold, summary functions are estimated in a computational fast way.
1214
#' @param weights Weights used to calculate energy. The first number refers to Gest(r), the second number to pcf(r).
1315
#' @param r_length Number of intervals from r = 0 to r = rmax the summary functions are evaluated.
@@ -32,6 +34,9 @@
3234
#' decrease. The number of steps can be controlled by \code{no_change} and is set to
3335
#' \code{no_change = Inf} as default to never stop automatically.
3436
#'
37+
#' If \code{n_points} and \code{window} are not specified (default), the simulated pattern
38+
#' has the same number of points and window as the input pattern.
39+
#'
3540
#' The weights must be 0 < sum(weights) <= 1. To weight both summary functions identical,
3641
#' use \code{weights = c(0.5, 0.5)}.
3742
#'
@@ -49,7 +54,11 @@
4954
#'
5055
#' @examples
5156
#' \dontrun{
52-
#' pattern_recon <- reconstruct_pattern_homo(species_a, n_random = 19, max_runs = 1000)
57+
#' pattern_recon_a <- reconstruct_pattern_homo(species_a, n_random = 19,
58+
#' max_runs = 1000)
59+
#'
60+
#' pattern_recon_b <- reconstruct_pattern_homo(species_a, n_points = 70,
61+
#' n_random = 19, max_runs = 1000)
5362
#' }
5463
#'
5564
#' @aliases reconstruct_pattern_homo
@@ -69,6 +78,8 @@ reconstruct_pattern_homo <- function(pattern,
6978
max_runs = 1000,
7079
no_change = Inf,
7180
annealing = 0.01,
81+
n_points = NULL,
82+
window = NULL,
7283
comp_fast = 1000,
7384
weights = c(0.5, 0.5),
7485
r_length = 250,
@@ -79,22 +90,50 @@ reconstruct_pattern_homo <- function(pattern,
7990

8091
# check if n_random is >= 1
8192
if (n_random < 1) {
93+
8294
stop("n_random must be >= 1.", call. = FALSE)
95+
96+
}
97+
98+
# use number of points of pattern if not provided
99+
if (is.null(n_points)) {
100+
101+
message("> Using number of points 'pattern'.")
102+
103+
n_points <- pattern$n
104+
105+
}
106+
107+
# use window of pattern if not provided
108+
if (is.null(window)) {
109+
110+
message("> Using window of 'pattern'.")
111+
112+
window <- pattern$window
113+
83114
}
84115

116+
# calculate intensity
117+
intensity <- n_points / spatstat.geom::area(window)
118+
85119
# check if number of points exceed comp_fast limit
86-
if (pattern$n > comp_fast) {
120+
if (n_points > comp_fast) {
87121

88122
# Print message that summary functions will be computed fast
89123
if (verbose) {
124+
90125
message("> Using fast compuation of summary functions.")
126+
91127
}
92128

93129
comp_fast <- TRUE
130+
94131
}
95132

96133
else {
134+
97135
comp_fast <- FALSE
136+
98137
}
99138

100139
# set names of randomization randomized_1 ... randomized_n
@@ -116,6 +155,7 @@ reconstruct_pattern_homo <- function(pattern,
116155
if (sum(weights) > 1 || sum(weights) == 0) {
117156

118157
stop("The sum of 'weights' must be 0 < sum(weights) <= 1.", call. = FALSE)
158+
119159
}
120160

121161
# unmark pattern
@@ -126,20 +166,21 @@ reconstruct_pattern_homo <- function(pattern,
126166
if (verbose) {
127167
warning("Unmarked provided input pattern. For marked pattern, see reconstruct_pattern_marks().",
128168
call. = FALSE)
169+
129170
}
130171
}
131172

132173
# calculate r
133174
r <- seq(from = 0,
134-
to = spatstat.core::rmax.rule(W = pattern$window,
135-
lambda = spatstat.geom::intensity.ppp(pattern)),
175+
to = spatstat.core::rmax.rule(W = window,
176+
lambda = intensity),
136177
length.out = r_length)
137178

138179
# create Poisson simulation data
139-
simulated <- spatstat.core::runifpoint(n = pattern$n,
140-
nsim = 1, drop = TRUE,
141-
win = pattern$window,
142-
warn = FALSE)
180+
simulated <- spatstat.core::runifpoint(n = n_points,
181+
nsim = 1, drop = TRUE,
182+
win = window,
183+
warn = FALSE)
143184

144185
# fast computation of summary functions
145186
if (comp_fast) {
@@ -212,11 +253,13 @@ reconstruct_pattern_homo <- function(pattern,
212253
if (annealing != 0) {
213254

214255
random_annealing <- stats::runif(n = max_runs, min = 0, max = 1)
256+
215257
}
216258

217259
else {
218260

219261
random_annealing <- rep(0, max_runs)
262+
220263
}
221264

222265
# pattern reconstruction algorithm (optimaztion of energy) - not longer than max_runs
@@ -294,7 +337,9 @@ reconstruct_pattern_homo <- function(pattern,
294337

295338
# increase counter no change
296339
else {
340+
297341
energy_counter <- energy_counter + 1
342+
298343
}
299344

300345
# count iterations
@@ -307,13 +352,16 @@ reconstruct_pattern_homo <- function(pattern,
307352
if (verbose) {
308353

309354
if (!plot) {
355+
310356
Sys.sleep(0.01)
357+
311358
}
312359

313360
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
314361
" || max_runs: ", floor(i / max_runs * 100), "%",
315362
" || energy = ", round(energy_current, 5), "\t\t",
316363
appendLF = FALSE)
364+
317365
}
318366

319367
# exit loop if e threshold or no_change counter max is reached
@@ -323,13 +371,15 @@ reconstruct_pattern_homo <- function(pattern,
323371
stop_criterion_list[[current_pattern]] <- "e_threshold/no_change"
324372

325373
break
374+
326375
}
327376
}
328377

329378
# close plotting device
330379
if (plot) {
331380

332381
grDevices::dev.off()
382+
333383
}
334384

335385
# remove NAs if stopped due to energy

‎R/reconstruct_pattern_marks.R

+29-8
Original file line numberDiff line numberDiff line change
@@ -72,26 +72,30 @@ reconstruct_pattern_marks <- function(pattern,
7272
if (!n_random >= 1) {
7373

7474
stop("n_random must be >= 1.", call. = FALSE)
75+
7576
}
7677

7778
# check if pattern is marked
7879
if (spatstat.geom::is.marked(pattern) || !spatstat.geom::is.marked(marked_pattern)) {
7980

8081
stop("'pattern' must be unmarked and 'marked_pattern' marked", call. = FALSE)
81-
}
82-
83-
if (any(pattern$window$xrange != marked_pattern$window$xrange) ||
84-
any(pattern$window$yrange != marked_pattern$window$yrange) ||
85-
pattern$n != marked_pattern$n) {
8682

87-
stop("'pattern' and 'pattern' must have same window and number of points",
88-
call. = FALSE)
8983
}
9084

85+
# if (any(pattern$window$xrange != marked_pattern$window$xrange) ||
86+
# any(pattern$window$yrange != marked_pattern$window$yrange) ||
87+
# pattern$n != marked_pattern$n) {
88+
#
89+
# stop("'pattern' and 'pattern' must have same window and number of points",
90+
# call. = FALSE)
91+
#
92+
# }
93+
9194
# check if marks are numeric
9295
if (class(marked_pattern$marks) != "numeric") {
9396

9497
stop("marks must be 'numeric'", call. = FALSE)
98+
9599
}
96100

97101
# set names of randomization randomized_1 ... randomized_n
@@ -119,7 +123,8 @@ reconstruct_pattern_marks <- function(pattern,
119123
simulated <- pattern
120124

121125
# assign shuffled marks to pattern
122-
spatstat.geom::marks(simulated) <- rcpp_sample(x = marked_pattern$marks, n = marked_pattern$n)
126+
spatstat.geom::marks(simulated) <- rcpp_sample(x = marked_pattern$marks, n = simulated$n,
127+
replace = TRUE)
123128

124129
# calculate summary functions
125130
kmmr_observed <- spatstat.core::markcorr(marked_pattern,
@@ -159,11 +164,13 @@ reconstruct_pattern_marks <- function(pattern,
159164
if (annealing != 0) {
160165

161166
random_annealing <- stats::runif(n = max_runs, min = 0, max = 1)
167+
162168
}
163169

164170
else {
165171

166172
random_annealing <- rep(0, max_runs)
173+
167174
}
168175

169176
# pattern reconstruction algorithm (optimaztion of energy) - not longer than max_runs
@@ -226,7 +233,9 @@ reconstruct_pattern_marks <- function(pattern,
226233

227234
# increase counter no change
228235
else {
236+
229237
energy_counter <- energy_counter + 1
238+
230239
}
231240

232241
# count iterations
@@ -239,7 +248,9 @@ reconstruct_pattern_marks <- function(pattern,
239248
if (verbose) {
240249

241250
if (!plot) {
251+
242252
Sys.sleep(0.01)
253+
243254
}
244255

245256
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
@@ -255,23 +266,28 @@ reconstruct_pattern_marks <- function(pattern,
255266
stop_criterion[[current_pattern]] <- "e_threshold/no_change"
256267

257268
break
269+
258270
}
259271
}
260272

261273
if (plot) {
274+
262275
grDevices::dev.off()
276+
263277
}
264278

265279
# remove NAs if stopped due to energy
266280
if (stop_criterion[[current_pattern]] == "e_threshold/no_change") {
267281

268282
energy_df <- energy_df[1:iterations, ]
283+
269284
}
270285

271286
# save results in lists
272287
energy_list[[current_pattern]] <- energy_df
273288
iterations_list[[current_pattern]] <- iterations
274289
result_list[[current_pattern]] <- simulated_current
290+
275291
}
276292

277293

@@ -304,7 +320,9 @@ reconstruct_pattern_marks <- function(pattern,
304320

305321
# only one random pattern is present that should be returend
306322
else if (n_random == 1) {
323+
307324
reconstruction <- reconstruction$randomized[[1]]
325+
308326
}
309327
}
310328
}
@@ -316,12 +334,15 @@ reconstruct_pattern_marks <- function(pattern,
316334
if (simplify && verbose) {
317335

318336
warning("'simplify = TRUE' not possible for 'return_input = TRUE'.", call. = FALSE)
337+
319338
}
320339
}
321340

322341
# write result in new line if progress was printed
323342
if (verbose) {
343+
324344
message("\r")
345+
325346
}
326347

327348
return(reconstruction)

‎cran-comments.md

+3
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
For details changes, please see NEWS.md.
22

3+
## shar 1.2.1
4+
Improvement of existing functions
5+
36
## shar 1.2
47
Update spatstat dependencies
58

0 commit comments

Comments
 (0)