tests/testthat/test-simul_unnest_simoutput.R
In nldoc/nlrx: Setup, Run and Analyze 'NetLogo' Model Simulations from 'R' via 'XML'
testthat::context("Get nl spatial")
testthat::test_that("Get nl spatial", {
# Run these tests only on Github actions:
testthat::skip_if(!identical(Sys.getenv("GITHUB_ACTIONS"), "true"))
## Check that JAVA is installed:
testthat::expect_true(system('java -version') == 0)
## Check that netLogo installation worked:
nlpath <- ifelse(nlrx:::util_get_os() == "win", "C:/Program Files/NetLogo 6.1.1",
ifelse(nlrx:::util_get_os() == "unix", "/home/runner/work/netlogo/NetLogo 6.1.1",
ifelse(nlrx:::util_get_os() == "mac","/Applications/netlogo/NetLogo 6.1.1",
"FAILED")))
testthat::expect_true(nlpath != "FAILED")
testthat::expect_true(dir.exists(nlpath))
jarpath <- ifelse(nlrx:::util_get_os() == "win", "C:/Program Files/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
ifelse(nlrx:::util_get_os() == "unix", "/home/runner/work/netlogo/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
ifelse(nlrx:::util_get_os() == "mac","/Applications/netlogo/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
"FAILED")))
testthat::expect_true(jarpath != "FAILED")
testthat::expect_true(file.exists(jarpath))
## Now we check if we can run a simple simulation:
## Step1: Create a nl obejct:
modelpath <- file.path(nlpath, "app", "models", "Sample Models",
"Biology", "Wolf Sheep Predation.nlogo")
nl <- nl(nlversion = "6.1.1",
nlpath = nlpath,
modelpath = modelpath,
jvmmem = 1024)
outpath <- tempdir()
## Step2: Add Experiment
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "breed", "pxcor", "pycor", "xcor", "ycor")),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' = list(min=50, max=150, step=10, qfun="qunif"),
'initial-number-wolves' = list(min=50, max=150, step=10, qfun="qunif")),
constants = list("model-version" = "\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
testthat::context("Simoutput attached")
testthat::expect_error(
unnest_simoutput(nl))
testthat::expect_error(
nl_to_raster(nl))
testthat::expect_error(
nl_to_points(nl))
## Attach results to nl:
setsim(nl, "simoutput") <- results
testthat::context("Unnest simoutput:")
results.spatial <- unnest_simoutput(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$agent), "character")
testthat::expect_match(class(results.spatial$breed), "character")
testthat::context("nl_to_raster")
results.spatial <- nl_to_raster(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.raster[[1]])[1], "RasterLayer")
testthat::context("nl_to_points pxcor")
results.spatial <- nl_to_points(nl, coords = "px")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
testthat::context("nl_to_points xcor")
results.spatial <- nl_to_points(nl, coords = "x")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
## Check functioning without explicitly measuring breeds:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "pxcor", "pycor",
"xcor", "ycor")),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
testthat::context("nl_to_points pxcor")
results.spatial <- nl_to_points(nl, coords = "px")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
## Check error message if coordinates are missing:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "breed")),
metrics.patches = c("pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
testthat::expect_error(nl_to_points(nl))
testthat::expect_error(nl_to_raster(nl))
## Check unnest without turtle metrics:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
results.spatial <- unnest_simoutput(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
## nl_to_graph function
testthat::context("nl_to_graph")
modelpath <- file.path(nlpath, "app", "models", "Sample Models",
"Networks", "Giant Component.nlogo")
nl <- nl(nlversion = "6.1.1",
nlpath = nlpath,
modelpath = modelpath,
jvmmem = 1024)
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end1", "[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
testthat::context("Simoutput attached")
testthat::expect_error(
nl_to_graph(nl))
nl@simdesign@simoutput <- run_nl_all(nl)
results.spatial <- nl_to_graph(nl)
testthat::context("nl_to_graph")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.links[[1]])[1], "igraph")
## Check missing who numbers:
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end1")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 2")
testthat::expect_error(nl_to_graph(nl))
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 1")
testthat::expect_error(nl_to_graph(nl))
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("color")),
metrics.links = list("links" = c("[who] of end1", "[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 1")
testthat::expect_error(nl_to_graph(nl))
})
nldoc/nlrx documentation built on Sept. 8, 2024, 6:39 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
testthat::context("Get nl spatial")
testthat::test_that("Get nl spatial", {
# Run these tests only on Github actions:
testthat::skip_if(!identical(Sys.getenv("GITHUB_ACTIONS"), "true"))
## Check that JAVA is installed:
testthat::expect_true(system('java -version') == 0)
## Check that netLogo installation worked:
nlpath <- ifelse(nlrx:::util_get_os() == "win", "C:/Program Files/NetLogo 6.1.1",
ifelse(nlrx:::util_get_os() == "unix", "/home/runner/work/netlogo/NetLogo 6.1.1",
ifelse(nlrx:::util_get_os() == "mac","/Applications/netlogo/NetLogo 6.1.1",
"FAILED")))
testthat::expect_true(nlpath != "FAILED")
testthat::expect_true(dir.exists(nlpath))
jarpath <- ifelse(nlrx:::util_get_os() == "win", "C:/Program Files/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
ifelse(nlrx:::util_get_os() == "unix", "/home/runner/work/netlogo/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
ifelse(nlrx:::util_get_os() == "mac","/Applications/netlogo/NetLogo 6.1.1/app/netlogo-6.1.1.jar",
"FAILED")))
testthat::expect_true(jarpath != "FAILED")
testthat::expect_true(file.exists(jarpath))
## Now we check if we can run a simple simulation:
## Step1: Create a nl obejct:
modelpath <- file.path(nlpath, "app", "models", "Sample Models",
"Biology", "Wolf Sheep Predation.nlogo")
nl <- nl(nlversion = "6.1.1",
nlpath = nlpath,
modelpath = modelpath,
jvmmem = 1024)
outpath <- tempdir()
## Step2: Add Experiment
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "breed", "pxcor", "pycor", "xcor", "ycor")),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' = list(min=50, max=150, step=10, qfun="qunif"),
'initial-number-wolves' = list(min=50, max=150, step=10, qfun="qunif")),
constants = list("model-version" = "\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
testthat::context("Simoutput attached")
testthat::expect_error(
unnest_simoutput(nl))
testthat::expect_error(
nl_to_raster(nl))
testthat::expect_error(
nl_to_points(nl))
## Attach results to nl:
setsim(nl, "simoutput") <- results
testthat::context("Unnest simoutput:")
results.spatial <- unnest_simoutput(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$agent), "character")
testthat::expect_match(class(results.spatial$breed), "character")
testthat::context("nl_to_raster")
results.spatial <- nl_to_raster(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.raster[[1]])[1], "RasterLayer")
testthat::context("nl_to_points pxcor")
results.spatial <- nl_to_points(nl, coords = "px")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
testthat::context("nl_to_points xcor")
results.spatial <- nl_to_points(nl, coords = "x")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
## Check functioning without explicitly measuring breeds:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "pxcor", "pycor",
"xcor", "ycor")),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
testthat::context("nl_to_points pxcor")
results.spatial <- nl_to_points(nl, coords = "px")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.turtles[[1]])[1], "sf")
## Check error message if coordinates are missing:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.turtles = list("turtles" = c("who", "breed")),
metrics.patches = c("pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
testthat::expect_error(nl_to_points(nl))
testthat::expect_error(nl_to_raster(nl))
## Check unnest without turtle metrics:
nl@experiment <- experiment(expname = "nlrx_test",
outpath = outpath,
repetition = 1,
tickmetrics = "true",
idsetup = "setup",
idgo = "go",
idfinal = NA_character_,
runtime = 2,
evalticks = c(1,2),
metrics = c("count sheep","count wolves"),
metrics.patches = c("pxcor", "pycor", "pcolor"),
variables = list('initial-number-sheep' =
list(min=50, max=150,
step=10, qfun="qunif"),
'initial-number-wolves' =
list(min=50, max=150,
step=10, qfun="qunif")),
constants = list("model-version" =
"\"sheep-wolves-grass\"",
"grass-regrowth-time" = 30,
"sheep-gain-from-food" = 4,
"wolf-gain-from-food" = 20,
"sheep-reproduce" = 4,
"wolf-reproduce" = 5,
"show-energy?" = "false"))
nl@simdesign <- simdesign_lhs(nl=nl,
samples=1,
nseeds=1,
precision=3)
results <- run_nl_all(nl)
setsim(nl, "simoutput") <- results
results.spatial <- unnest_simoutput(nl)
testthat::expect_match(class(results.spatial)[1], "tbl_df")
## nl_to_graph function
testthat::context("nl_to_graph")
modelpath <- file.path(nlpath, "app", "models", "Sample Models",
"Networks", "Giant Component.nlogo")
nl <- nl(nlversion = "6.1.1",
nlpath = nlpath,
modelpath = modelpath,
jvmmem = 1024)
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end1", "[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
testthat::context("Simoutput attached")
testthat::expect_error(
nl_to_graph(nl))
nl@simdesign@simoutput <- run_nl_all(nl)
results.spatial <- nl_to_graph(nl)
testthat::context("nl_to_graph")
testthat::expect_match(class(results.spatial)[1], "tbl_df")
testthat::expect_match(class(results.spatial$spatial.links[[1]])[1], "igraph")
## Check missing who numbers:
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end1")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 2")
testthat::expect_error(nl_to_graph(nl))
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("who", "color")),
metrics.links = list("links" = c("[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 1")
testthat::expect_error(nl_to_graph(nl))
nl@experiment <- experiment(expname="networks",
outpath=outpath,
repetition=1,
tickmetrics="false",
idsetup="setup",
idgo="go",
runtime=50,
metrics.turtles = list("turtles" = c("color")),
metrics.links = list("links" = c("[who] of end1", "[who] of end2")),
constants = list("num-nodes" = 80,
"layout?" = "true"))
nl@simdesign <- simdesign_simple(nl, 1)
nl@simdesign@simoutput <- run_nl_all(nl)
testthat::context("Missing [who] of end 1")
testthat::expect_error(nl_to_graph(nl))
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.