Merge pull request #46 from bodkan/check-path

Add an option to specify where SLiM binary is located

R/compilation.R

@@ -348,6 +348,7 @@ configuration (%s)", dir, map_table$map), call. = FALSE)
 #'   on the command-line, "script" - simply return the script)
 #' @param include Vector of paths to custom SLiM scripts which should be
 #'   combined with the backend SLiM code
+#' @param slim_path Optional way to specify path to an appropriate SLiM binary
 #' @param burnin Length of the burnin (in model's time units, i.e. years)
 #' @param seed Random seed (if missing, SLiM's own seed will be used)
 #' @param verbose Write the SLiM output log to the console? (default
@@ -358,7 +359,7 @@ slim <- function(model, seq_length, recomb_rate,
                  save_locations = FALSE, track_ancestry = FALSE,
                  keep_pedigrees = FALSE, ts_recording = FALSE,
                  method = "gui", verbose = FALSE, include = NULL, burnin = 0,
-                 seed = NULL) {
+                 seed = NULL, slim_path = NULL) {
   dir <- model$config$directory
   if (!dir.exists(dir))
     stop(sprintf("Model directory '%s' does not exist", dir), call. = FALSE)
@@ -371,6 +372,13 @@ slim <- function(model, seq_length, recomb_rate,
     stop(sprintf("Directory '%s' does not contain any slendr spatial raster maps", dir),
     call. = FALSE)
 
+  if (!method %in% c("gui", "batch", "script"))
+    stop("Only 'gui', 'batch', and 'script' are recognized as values of
+the 'method' argument", call. = FALSE)
+
+  if (is.character(slim_path) && !all(file.exists(slim_path)))
+    stop("SLiM binary not found at ", slim_path, call. = FALSE)
+
   if (!is.logical(track_ancestry) & !is.numeric(track_ancestry)) {
     stop("'track_ancestry' must be either FALSE or 0 (no tracking), or
 a non-zero integer number (number of neutral ancestry markers)", call. = FALSE)
@@ -402,15 +410,16 @@ a non-zero integer number (number of neutral ancestry markers)", call. = FALSE)
   script_components <- unlist(lapply(c(base_script, include), readLines))
   writeLines(script_components, script_path)
 
-  if (method == "gui")
-    system(sprintf("open -a SLiMgui %s", script_path))
-  else if (method == "batch")
-    system(sprintf("slim %s", script_path), ignore.stdout = !verbose)
-  else if (method == "script")
+  if (method == "script")
     message("Final compiled SLiM script is in ", script_path)
-  else
-    stop("Only 'gui', 'batch', and 'script' are recognized as values of
-the 'method' argument", call. = FALSE)
+  else {
+    if (!is.null(slim_path)) {
+      cmd <- slim_path
+    } else {
+      cmd <- get_binary(method)
+    }
+    system(sprintf("%s %s", cmd, script_path), ignore.stdout = !verbose)
+  }
 }
 
 

R/interface.R

@@ -178,7 +178,7 @@ expand <- function(pop, by, end, start, overlap = 0.8, snapshots = NULL,
     n <- 1
     message("Iterative search for the minimum sufficient number of intermediate
 spatial snapshots, starting at ", n, ". This should only take a couple of
-seconds...")
+seconds but if you don't want to wait, you can set `snapshots = N` manually.")
   } else
     n <- snapshots
 
@@ -310,7 +310,7 @@ between 0 and 1", call. = FALSE)
     n <- 1
     message("Iterative search for the minimum sufficient number of intermediate
 spatial snapshots, starting at ", n, ". This should only take a couple of
-seconds...")
+seconds but if you don't want to wait, you can set `snapshots = N` manually.")
   } else
     n <- snapshots
 

R/utils.R

@@ -1,3 +1,23 @@
+# Get path to an appropriate SLiM binary
+get_binary <- function(method) {
+  if (method == "gui") {
+    if (Sys.info()["sysname"] == "Darwin")
+      return("open -a SLiMgui")
+    else
+      binary <- "SLiMgui"
+  } else
+    binary <- "slim"
+
+  binary_path <- Sys.which(binary)
+  if (all(binary_path == ""))
+    stop(sprintf("%s binary not found. Please modify your $PATH accordingly or
+specify the path manually by setting the 'binary_path' argument.", binary),
+call. = FALSE)
+  else
+    return(as.character(binary_path))
+}
+
+
 # Check whether given population region has not yet been intersected
 check_not_intersected <- function(pop) {
   if (!is.null(attr(pop, "intersected")))
@@ -17,6 +37,7 @@ check_resolution <- function(map, val) {
          call. = FALSE)
 }
 
+
 # Set a bounding box of a given object, and return that object again
 # (for some reason there's no builtin way to set a bounding box in
 # sf <https://twitter.com/TimSalabim3/status/1063099774977667072>)

docs/pkgdown.yml

@@ -3,7 +3,7 @@ pkgdown: 1.6.1
 pkgdown_sha: ~
 articles:
   slendr: slendr.html
-last_built: 2021-06-28T16:25Z
+last_built: 2021-06-29T10:34Z
 urls:
   reference: https://bodkan.net/slendr/reference
   article: https://bodkan.net/slendr/articles

tests/testthat/test-utililites.R

@@ -14,3 +14,10 @@ test_that("distances beyond the world dimension throw and error", {
   expect_silent(check_resolution(map, xrange / 10))
   expect_silent(check_resolution(map, yrange / 10))
 })
+
+test_that("binaries are found for all methods of running SLiM", {
+  skip_on_os("windows")
+  skip_on_os("linux")
+  expect_equal(get_binary("gui"), "open -a SLiMgui")
+  expect_equal(get_binary("batch"), as.character(Sys.which("slim")))
+})