Skip to content

Commit 05b9b23

Browse files
mhesselbarthmhesselbarth
authored
Merge pull request #63 from r-spatialecology/master
v1.1
2 parents 3ca8194 + 2bf094c commit 05b9b23

22 files changed

+416
-352
lines changed

‎.gitignore

+1
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,4 @@
44
.Ruserdata
55
.DS_Store
66
inst/doc
7+
Rplots.pdf

‎DESCRIPTION

+1-1
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.0.1
4+
Version: 1.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]",

‎NEWS.md

+6
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
1+
# shar 1.1
2+
* Improvements
3+
* Use energy_df to get energy for printing if available
4+
* Updated tests
5+
* More stable progress printing
6+
17
# shar 1.0.1
28
* Improvements
39
* No calculation of energy for printig (too slow)

‎R/plot_energy.R

+7-1
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,12 @@ plot_energy <- function(pattern,
4141
call. = FALSE)
4242
}
4343

44+
if (all(pattern$energy_df == "NA")) {
45+
46+
stop("There is no 'energy_df' slot. Please use pattern reconstruction for valid input data.",
47+
call. = FALSE)
48+
}
49+
4450
# get number of rows
4551
range_i <- range(vapply(X = pattern$energy_df,
4652
FUN = function(x) range(x$i), FUN.VALUE = numeric(2)))
@@ -58,7 +64,7 @@ plot_energy <- function(pattern,
5864
graphics::plot(NULL,
5965
xlim = range_i,
6066
ylim = range_energy,
61-
main = "Energy over time",
67+
main = "Energy over iterations",
6268
xlab = "Iterations",
6369
ylab = "Energy")
6470

‎R/print.rd_mar.R

+21-1
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,11 @@ print.rd_mar <- function(x,
4646
includes_observed <- "included"
4747
}
4848

49+
# get extent of window
50+
extent_window <- paste0(c(x$randomized[[1]]$window$xrange,
51+
x$randomized[[1]]$window$yrange), collapse = " ")
52+
53+
4954
# get number of randomized patterns plus observed pattern
5055
number_patterns <- length(x$randomized) + number_patterns_obs
5156

@@ -63,10 +68,25 @@ print.rd_mar <- function(x,
6368
collapse = " ")
6469
}
6570

71+
# check if eneergy_df is available
72+
if (is.list(x$energy_df)) {
73+
74+
mean_energy <- round(mean(vapply(x$energy_df, function(x) {
75+
76+
utils::tail(x, n = 1)[, 2]
77+
}, FUN.VALUE = numeric(1))), digits = digits)
78+
}
79+
80+
else {
81+
mean_energy <- "NA"
82+
}
83+
6684
# print result
6785
cat(paste0("No. of pattern: ", number_patterns, "\n",
6886
"Method: ", x$method, "\n",
6987
"Observed pattern: ", includes_observed, "\n",
7088
"Iterations (mean): ", mean_iterations, "\n",
71-
"Stop criterion (no. of patterns): ", stop_criterion, "\n"), ...)
89+
"Energy (mean): ", mean_energy, "\n",
90+
"Stop criterion (no. of patterns): ", stop_criterion, "\n",
91+
"Extent: ", extent_window, " (xmin, xmax, ymin, ymax) \n"), ...)
7292
}

‎R/print.rd_pat.R

+20-1
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,10 @@ print.rd_pat <- function(x,
5151
includes_observed <- "included"
5252
}
5353

54+
# get extent of window
55+
extent_window <- paste0(c(x$randomized[[1]]$window$xrange,
56+
x$randomized[[1]]$window$yrange), collapse = " ")
57+
5458
# get number of randomized patterns plus observed pattern
5559
number_patterns <- length(x$randomized) + number_patterns_obs
5660

@@ -68,10 +72,25 @@ print.rd_pat <- function(x,
6872
collapse = " ")
6973
}
7074

75+
# check if eneergy_df is available
76+
if (is.list(x$energy_df)) {
77+
78+
mean_energy <- round(mean(vapply(x$energy_df, function(x) {
79+
80+
utils::tail(x, n = 1)[, 2]
81+
}, FUN.VALUE = numeric(1))), digits = digits)
82+
}
83+
84+
else {
85+
mean_energy <- "NA"
86+
}
87+
7188
# print result
7289
cat(paste0("No. of pattern: ", number_patterns, "\n",
7390
"Method: ", x$method, "\n",
7491
"Observed pattern: ", includes_observed, "\n",
7592
"Iterations (mean): ", mean_iterations, "\n",
76-
"Stop criterion (no. of patterns): ", stop_criterion, "\n"), ...)
93+
"Energy (mean): ", mean_energy, "\n",
94+
"Stop criterion (no. of patterns): ", stop_criterion, "\n",
95+
"Extent: ", extent_window, " (xmin, xmax, ymin, ymax) \n"), ...)
7796
}

‎R/print.rd_ras.R

+9-4
Original file line numberDiff line numberDiff line change
@@ -43,14 +43,19 @@ print.rd_ras <- function(x,
4343
includes_observed <- "included"
4444
}
4545

46+
# get extent of window
47+
extent_window <- paste0(c(raster::xmin(x$randomized[[1]]),
48+
raster::xmax(x$randomized[[1]]),
49+
raster::ymin(x$randomized[[1]]),
50+
raster::ymax(x$randomized[[1]])),
51+
collapse = " ")
52+
4653
# get number of randomized patterns plus observed pattern
4754
number_raster <- length(x$randomized) + number_raster_obs
4855

4956
# print result
5057
cat(paste0("No. of raster: ", number_raster, "\n",
51-
# "Mean energy: ", energy, "\n",
5258
"Method: ", x$method, "\n",
53-
"Observed pattern: ", includes_observed, "\n"),
54-
# "Iterations (mean): ", mean_iterations, "\n"),
55-
...)
59+
"Observed pattern: ", includes_observed, "\n",
60+
"Extent: ", extent_window, " (xmin, xmax, ymin, ymax) \n"), ...)
5661
}

‎R/reconstruct_pattern_cluster.R

+6-2
Original file line numberDiff line numberDiff line change
@@ -308,7 +308,7 @@ reconstruct_pattern_cluster <- function(pattern,
308308
if (plot) {
309309

310310
# https://support.rstudio.com/hc/en-us/community/posts/200661917-Graph-does-not-update-until-loop-completion
311-
Sys.sleep(0.1)
311+
Sys.sleep(0.01)
312312

313313
graphics::plot(x = pcf_observed[[1]], y = pcf_observed[[3]],
314314
type = "l", col = "black",
@@ -337,8 +337,12 @@ reconstruct_pattern_cluster <- function(pattern,
337337
# print progress
338338
if (verbose) {
339339

340+
if (!plot) {
341+
Sys.sleep(0.01)
342+
}
343+
340344
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
341-
" || max_runs: ", i, "/", max_runs,
345+
" || max_runs: ", floor(i / max_runs * 100), "%",
342346
" || energy = ", round(energy_current, 5), "\t\t",
343347
appendLF = FALSE)
344348
}

‎R/reconstruct_pattern_hetero.R

+6-2
Original file line numberDiff line numberDiff line change
@@ -280,7 +280,7 @@ reconstruct_pattern_hetero <- function(pattern,
280280
if (plot) {
281281

282282
# https://support.rstudio.com/hc/en-us/community/posts/200661917-Graph-does-not-update-until-loop-completion
283-
Sys.sleep(0.1)
283+
Sys.sleep(0.01)
284284

285285
graphics::plot(x = pcf_observed[[1]], y = pcf_observed[[3]],
286286
type = "l", col = "black",
@@ -309,8 +309,12 @@ reconstruct_pattern_hetero <- function(pattern,
309309
# print progress
310310
if (verbose) {
311311

312+
if (!plot) {
313+
Sys.sleep(0.01)
314+
}
315+
312316
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
313-
" || max_runs: ", i, "/", max_runs,
317+
" || max_runs: ", floor(i / max_runs * 100), "%",
314318
" || energy = ", round(energy_current, 5), "\t\t",
315319
appendLF = FALSE)
316320
}

‎R/reconstruct_pattern_homo.R

+8-3
Original file line numberDiff line numberDiff line change
@@ -274,13 +274,14 @@ reconstruct_pattern_homo <- function(pattern,
274274
if (plot) {
275275

276276
# https://support.rstudio.com/hc/en-us/community/posts/200661917-Graph-does-not-update-until-loop-completion
277-
Sys.sleep(0.1)
277+
Sys.sleep(0.01)
278278

279279
graphics::plot(x = pcf_observed[[1]], y = pcf_observed[[3]],
280280
type = "l", col = "black",
281281
xlab = "r", ylab = "g(r)")
282282

283-
graphics::lines(x = pcf_relocated[[1]], y = pcf_relocated[[3]], col = "red")
283+
graphics::lines(x = pcf_relocated[[1]], y = pcf_relocated[[3]],
284+
col = "red")
284285

285286
graphics::legend("topright",
286287
legend = c("observed", "reconstructed"),
@@ -303,8 +304,12 @@ reconstruct_pattern_homo <- function(pattern,
303304
# print progress
304305
if (verbose) {
305306

307+
if (!plot) {
308+
Sys.sleep(0.01)
309+
}
310+
306311
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
307-
" || max_runs: ", i, "/", max_runs,
312+
" || max_runs: ", floor(i / max_runs * 100), "%",
308313
" || energy = ", round(energy_current, 5), "\t\t",
309314
appendLF = FALSE)
310315
}

‎R/reconstruct_pattern_marks.R

+7-2
Original file line numberDiff line numberDiff line change
@@ -207,7 +207,7 @@ reconstruct_pattern_marks <- function(pattern,
207207
if (plot) {
208208

209209
# https://support.rstudio.com/hc/en-us/community/posts/200661917-Graph-does-not-update-until-loop-completion
210-
Sys.sleep(0.1)
210+
Sys.sleep(0.01)
211211

212212
graphics::plot(x = kmmr_observed[[1]], y = kmmr_observed[[3]],
213213
type = "l", col = "black",
@@ -235,8 +235,13 @@ reconstruct_pattern_marks <- function(pattern,
235235

236236
# print progress
237237
if (verbose) {
238+
239+
if (!plot) {
240+
Sys.sleep(0.01)
241+
}
242+
238243
message("\r> Progress: n_random: ", current_pattern, "/", n_random,
239-
" || max_runs: ", i, "/", max_runs,
244+
" || max_runs: ", floor(i / max_runs * 100), "%",
240245
" || energy = ", round(energy_current, 5), "\t\t",
241246
appendLF = FALSE)
242247
}

0 commit comments

Comments
 (0)