Added converged slot to lcModelPartition

philips-software · Nov 4, 2022 · 9135ee8 · 9135ee8
1 parent c95c151
commit 9135ee8
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 5 deletions.
diff --git a/R/modelLMKM.R b/R/modelLMKM.R
@@ -2,8 +2,7 @@
 setClass('lcModelLMKM',
   representation(
     coefNames = 'character',
-    trajectoryCoefs = 'matrix',
-    converged = 'logical'
+    trajectoryCoefs = 'matrix'
   ),
   contains = 'lcModelPartition'
 )

diff --git a/R/modelPartition.R b/R/modelPartition.R
@@ -4,7 +4,8 @@ setClass(
   representation(
     name = 'character',
     center = 'function',
-    trajectoryClusterIndices = 'integer'
+    trajectoryClusterIndices = 'integer',
+    converged = 'ANY'
   ),
   contains = 'lcApproxModel'
 )
@@ -50,6 +51,7 @@ lcModelPartition = function(
   name = 'part',
   center = meanNA,
   method = NULL,
+  converged = TRUE,
   model = NULL,
   envir = parent.frame()
 ) {
@@ -169,7 +171,8 @@ lcModelPartition = function(
     id = id,
     time = time,
     response = response,
-    estimationTime = 0
+    estimationTime = 0,
+    converged = converged
   )
 
   if (!is.null(method)) {
@@ -255,7 +258,11 @@ setMethod('clusterTrajectories', 'lcModelPartition',
 #. converged ####
 #' @rdname interface-custom
 setMethod('converged', 'lcModelPartition', function(object, ...) {
-  TRUE
+  if (methods::.hasSlot(object, 'converged')) {
+    object@converged
+  } else {
+    TRUE
+  }
 })
 
 

diff --git a/man/lcModelPartition.Rd b/man/lcModelPartition.Rd
diff --git a/tests/testthat/test-partition.R b/tests/testthat/test-partition.R
@@ -17,6 +17,7 @@ test_that('integer assignments', {
   expect_valid_lcModel(model)
   expect_equivalent(trajectoryAssignments(model), trajectoryAssignments(refmodel))
   expect_equivalent(nClusters(model), nClusters(refmodel))
+  expect_true(converged(model))
 })
 
 
@@ -137,3 +138,32 @@ test_that('clusterTrajectories at subset of times', {
     )
   )
 })
+
+test_that('non-converged partition result', {
+  intAssignments = trajectoryAssignments(refmodel) %>% as.integer()
+
+  model = lcModelPartition(
+    testLongData,
+    response = 'Value',
+    trajectoryAssignments = intAssignments,
+    nClusters = nClusters(refmodel),
+    converged = FALSE
+  )
+
+  expect_false(converged(model))
+})
+
+test_that('numeric converged partition result', {
+  intAssignments = trajectoryAssignments(refmodel) %>% as.integer()
+
+  model = lcModelPartition(
+    testLongData,
+    response = 'Value',
+    trajectoryAssignments = intAssignments,
+    nClusters = nClusters(refmodel),
+    converged = 3
+  )
+
+  expect_equal(converged(model), 3)
+})
+