The time_modified field is now updated correctly by `steadySingleSp…

…ecies()`, `setColours()` and `setLinetypes()`. Closes #295

NEWS.md

@@ -18,6 +18,8 @@
 - The function `plotBiomassObservedVsModel()` now plots the ratio of modelled
   to observed biomass as default (`ratio = T`), as this is more useful visually
   to see how far off modelled biomass is from observed biomass.
+- The `time_modified` field is now updated correctly by `steadySingleSpecies()`,
+  `setColours()` and `setLinetypes()`.
 - Deprecated `matchYields()` and `calibrateYield()`.
 - Improved some unit tests.
 - Some improvements to documentation.

R/setColours.R

@@ -35,8 +35,13 @@
 setColours <- function(params, colours) {
     assert_that(is(params, "MizerParams"))
     colours <- validColours(colours)
+    if (identical(colours, as.list(params@linecolour))) {
+        return(params)
+    }
     params@linecolour <- unlist(
         modifyList(as.list(params@linecolour), colours))
+
+    params@time_modified <- lubridate::now()
     params
 }
 
@@ -69,8 +74,13 @@ validColours <- function(colours) {
 setLinetypes <- function(params, linetypes) {
     assert_that(is(params, "MizerParams"))
     linetypes <- validLinetypes(linetypes)
+    if (identical(linetypes, as.list(params@linetype))) {
+        return(params)
+    }
     params@linetype <- unlist(
         modifyList(as.list(params@linetype), as.list(linetypes)))
+
+    params@time_modified <- lubridate::now()
     params
 }
 

R/setMetadata.R

@@ -22,6 +22,9 @@
 #' set by the extension packages.
 #' * `time_created` A POSIXct date-time object with the creation time.
 #' * `time_modified` A POSIXct date-time object with the last modified time.
+#' 
+#' Setting the metadata with this function does not count as a modification of
+#' the object, so the `time_modified` field will not be updated.
 #'
 #' @param params The MizerParams object for the model
 #' @param title A string with the title for the model
@@ -70,8 +73,6 @@ setMetadata <- function(params, title, description,
         metadata$doi <- doi
     }
     params@metadata <- modifyList(metadata, list(...))
-
-    params@time_modified <- lubridate::now()
     params
 }
 

R/steadySingleSpecies.R

@@ -74,5 +74,6 @@ steadySingleSpecies <- function(params, species = NULL,
         params@initial_n <- params@initial_n * factor
     }
 
+    params@time_modified <- lubridate::now()
     params
 }

tests/testthat/helper.R

@@ -2,9 +2,14 @@
 # changed except for the time_modified
 expect_unchanged <- function(object, expected) {
     if (is(object, "MizerParams")) {
+        # has updated time_modified
+        expect_false(identical(object@time_modified, expected@time_modified))
         object@time_modified <- expected@time_modified
     }
     if (is(object, "MizerSim")) {
+        # has updated time_modified
+        expect_false(identical(object@params@time_modified,
+                               expected@params@time_modified))
         object@params@time_modified <- expected@params@time_modified
     }
 

tests/testthat/test-match.R

@@ -2,7 +2,7 @@ test_that("matchBiomasses works", {
     params <- setBevertonHolt(NS_params)
 
     # Does nothing when no observed biomass
-    expect_unchanged(matchBiomasses(params), params)
+    expect_identical(matchBiomasses(params), params)
     species_params(params)$biomass_observed <- NA
     expect_unchanged(matchBiomasses(params), params)
     # Does nothing if observed already equals model
@@ -31,7 +31,7 @@ test_that("matchNumbers works", {
     params <- setBevertonHolt(NS_params)
 
     # Does nothing when no observed numbers
-    expect_unchanged(matchNumbers(params), params)
+    expect_identical(matchNumbers(params), params)
     species_params(params)$number_observed <- NA
     expect_unchanged(matchNumbers(params), params)
     # Does nothing if observed already equals model

tests/testthat/test-setBevertonHolt.R

@@ -47,6 +47,11 @@ test_that("setBevertonHolt sets erepro correctly when setting same value for som
     expect_identical(params@species_params$erepro[1:2], c(0.1, 0.2))
 })
 
+test_that("setBevertonHolt updates `time_modified`", {
+    expect_false(identical(setBevertonHolt(NS_params, erepro = 1)@time_modified, 
+                           NS_params@time_modified))
+})
+
 # R_max ----
 test_that("setBevertonHolt sets R_max correctly when setting all values", {
     params <- setBevertonHolt(NS_params,

tests/testthat/test-setColours.R

@@ -2,6 +2,8 @@
 test_that("setColours and getColours works", {
     params <- NS_params
     no_col <- length(getColours(params))
+    # nothing changes when setting the same colours
+    expect_identical(setColours(params, getColours(params)), params)
     # set new entry
     params <- setColours(params, list("test" = "orange"))
     expect_length(getColours(params), no_col + 1)
@@ -20,12 +22,16 @@ test_that("setColours and getColours works", {
         "The following are not valid colour values and will be ignored: igit, igitigit")
     expect_length(getColours(params), no_col + 2)
     expect_identical(getColours(params)[["test"]], "blue")
+    # Expect updated time_modified
+    expect_false(identical(params@time_modified, NS_params@time_modified))
 })
 
 # setLinetypes, getLinetypes ----
 test_that("setLinetypes and getLinetypes works", {
     params <- NS_params
     no_types <- length(getLinetypes(params))
+    # nothing changes when using existing types
+    expect_identical(setLinetypes(params, getLinetypes(params)), params)
     # set new entry
     params <- setLinetypes(params, list("test" = "dashed"))
     expect_equal(length(getLinetypes(params)), no_types + 1)
@@ -44,4 +50,6 @@ test_that("setLinetypes and getLinetypes works", {
         "The following are not valid lineypes")
     expect_length(getLinetypes(params), no_types + 2)
     expect_identical(getLinetypes(params)[["test"]], "dotted")
+    # Expect updated time_modified
+    expect_false(identical(params@time_modified, NS_params@time_modified))
 })

tests/testthat/test-setExtEncounter.R

@@ -11,9 +11,12 @@ test_that("setExtEncounter works", {
     p2 <- setExtEncounter(params, 3 * params@mu_b)
     expect_equal(p2@ext_encounter, 3 * params@mu_b)
 
-    # only mu_b changed
+    # only ext_encounter changed
     p2@ext_encounter <- params@ext_encounter
     expect_unchanged(p2, params)
+
+    # has updated time_modified
+    expect_false(identical(params@time_modified, p2@time_modified))
 })
 
 test_that("Comment works on ext_encounter", {

tests/testthat/test-setExtMort.R

@@ -14,7 +14,11 @@ test_that("setExtMort works", {
     p2 <- setExtMort(params, 3 * params@mu_b)
     comment(p2@mu_b) <- NULL
     expect_equal(p2@mu_b, 3 * params@mu_b)
+
+    # has updated time_modified
+    expect_false(identical(params@time_modified, p2@time_modified))
 })
+
 test_that("Comment works on mu_b", {
     params <- NS_params
     # if no comment, it is set automatically

tests/testthat/test-setFishing.R

@@ -88,6 +88,8 @@ test_that("Set Fishing works", {
     expect_unchanged(params, setFishing(params))
     gear_params(params) <- params@gear_params
     expect_unchanged(params, params1)
+    # has updated time_modified
+    expect_false(identical(params@time_modified, params1@time_modified))
 })
 
 test_that("Setting selectivity works", {

tests/testthat/test-setMaxIntakeRate.R

@@ -6,9 +6,9 @@ test_that("setMaxIntakeRate works", {
     expect_identical(2 * params@intake_max, p2@intake_max)
     # only intake max changed
     p2@intake_max <- params@intake_max
-    p2@time_modified <- params@time_modified
-    expect_identical(p2, params)
+    expect_unchanged(p2, params)
 })
+
 test_that("Comment works on intake_max", {
     params <- NS_params
     # if no comment, it is set automatically

tests/testthat/test-setMetadata.R

@@ -4,6 +4,8 @@ test_that("setMetadata works", {
                           description = "description",
                           authors = "Gustav Delius",
                           new = "new")
+    # This should not change time_modified
+    expect_identical(params@time_modified, NS_params@time_modified)
     metadata <- getMetadata(params)
     expect_identical(metadata$title, "title")
     expect_identical(metadata$description, "description")

tests/testthat/test-steady.R

@@ -87,6 +87,8 @@ test_that("steady() preserves R_max", {
                        suppressMessages(),
                    "The following species require an unrealistic reproductive")
     expect_equal(p2@species_params$R_max, params@species_params$R_max)
+    # Test that steady updates time_modified
+    expect_false(identical(p2@time_modified, params@time_modified))
 })
 
 # valid_species_arg ----

tests/testthat/test-steadySingleSpecies.R

@@ -6,12 +6,14 @@ test_that("steadySingleSpecies only affects selected species", {
     # but Cod changed
     expect_gt(params@initial_n["Cod", 100], 
               NS_params@initial_n["Cod", 100])
+    # Test that steadySingleSpecies updates time_modified
+    expect_false(identical(NS_params@time_modified, params@time_modified))
 })
 
 test_that("steadySingleSpecies is idempotent on single-species model", {
     ss <- newSingleSpeciesParams()
     ss2 <- steadySingleSpecies(ss)
-    expect_equal(ss@initial_n, ss2@initial_n)
+    expect_unchanged(ss, ss2)
 })
 
 test_that("steadySingleSpecies `keep` argument works", {

tests/testthat/test-upgrade.R

@@ -3,26 +3,26 @@ sim <- project(params, t_max = 0.1, t_save = 0.1)
 
 ## upgradeParams ----
 test_that("upgradeParams leaves new params unchanged", {
-    expect_unchanged(upgradeParams(params), params)
+    expect_identical(upgradeParams(params), params)
 })
 test_that("upgradeParams preserves comments", {
     comment(params) <- "test"
     for (slot in (slotNames(params))) {
         comment(slot(params, slot)) <- slot
     }
-    expect_unchanged(upgradeParams(params), params)
+    expect_identical(upgradeParams(params), params)
 })
 
 ## upgradeSim ----
 test_that("upgradeSim leaves new sim unchanged", {
-    expect_unchanged(upgradeSim(sim), sim)
+    expect_identical(upgradeSim(sim), sim)
 })
 test_that("upgradeSim preserves comments", {
     comment(sim) <- "test"
     for (slot in (slotNames(sim))) {
         comment(slot(sim, slot)) <- slot
     }
-    expect_unchanged(upgradeSim(sim), sim)
+    expect_identical(upgradeSim(sim), sim)
 })
 
 test_that("Object from version 0.4 can be upgraded", {