- Offset starting values for gompertz.

bcgov · Mar 21, 2024 · 4d6507f · 4d6507f
2 parents dd06e91 + 9dc94ec
commit 4d6507f
Show file tree

Hide file tree

Showing 9 changed files with 109 additions and 50 deletions.
diff --git a/R/gompertz.R b/R/gompertz.R
@@ -112,8 +112,8 @@ sgompertz <- function(data, pars = NULL) {
   data <- data.frame(x = x)
   fit <- suppressWarnings(vglm(x ~ 1, gompertz, coefstart = pars, data = data))
   list(
-    log_location = unname(coef(fit)[2]),
-    log_shape = unname(coef(fit)[1])
+    log_location = unname(coef(fit)[2]) * (1 + 1e-3),
+    log_shape = unname(coef(fit)[1]) * (1 - 1e-3)
   )
 }
 

diff --git a/tests/testthat/_snaps/data/boron_unstable.csv b/tests/testthat/_snaps/data/boron_unstable.csv
@@ -1,6 +1,6 @@
 dist,term,est,se
-gompertz,location,0.0394098,0.0119839
-gompertz,shape,0.00260152,0.00997852
+gompertz,location,0.0394073,0.0119791
+gompertz,shape,0.00260432,0.00997275
 invpareto,scale,75.2608,0
 invpareto,shape,0.568403,0.107418
 llogis_llogis,locationlog1,0.896677,0.379787

diff --git a/tests/testthat/_snaps/gompertz/hc_prob.csv b/tests/testthat/_snaps/gompertz/hc_prob.csv
@@ -1,7 +1,7 @@
 dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
-average,0.05,0.179431,0.307761,0.0992247,1.2374,1,parametric,100,0.92,"c(`000000001_gompertz` = 0.232636, `000000003_gompertz` = 0.104637, `000000004_gompertz` = 0.546398, `000000005_gompertz` = 0.597141, `000000006_gompertz` = 0.232612, `000000007_gompertz` = 0.260431, `000000008_gompertz` = 0.194922, `000000009_gompertz` = 0.687422, `000000010_gompertz` = 0.158599, `000000011_gompertz` = 0.252416, `000000012_gompertz` = 0.212662, `000000013_gompertz` = 1.32511, `000000014_gompertz` = 0.196367, `000000015_gompertz` = 0.556544, `000000016_gompertz` = 0.542006, `000000017_gompertz` = 0.258814, 
-`000000018_gompertz` = 0.467321, `000000019_gompertz` = 0.444488, `000000020_gompertz` = 0.252327, `000000021_gompertz` = 1.00609, `000000022_gompertz` = 0.262124, `000000023_gompertz` = 0.201934, `000000024_gompertz` = 0.221751, `000000025_gompertz` = 0.370771, `000000026_gompertz` = 0.381563, `000000027_gompertz` = 0.587611, `000000028_gompertz` = 0.154166, `000000031_gompertz` = 0.104224, `000000032_gompertz` = 0.249995, `000000033_gompertz` = 0.462125, `000000034_gompertz` = 0.396521, `000000035_gompertz` = 0, 
-`000000036_gompertz` = 0.258785, `000000037_gompertz` = 0.242243, `000000038_gompertz` = 0.347565, `000000039_gompertz` = 0.294371, `000000040_gompertz` = 1.14334, `000000041_gompertz` = 0.135071, `000000042_gompertz` = 0.119921, `000000043_gompertz` = 0.313962, `000000044_gompertz` = 0.0979543, `000000045_gompertz` = 0.135268, `000000046_gompertz` = 0.260895, `000000047_gompertz` = 0.507332, `000000049_gompertz` = 1.83762, `000000050_gompertz` = 0.183626, `000000051_gompertz` = 0.119591, `000000052_gompertz` = 0.166217, 
-`000000053_gompertz` = 0.375883, `000000054_gompertz` = 0.159972, `000000055_gompertz` = 0.378644, `000000056_gompertz` = 0.198184, `000000057_gompertz` = 0.854106, `000000058_gompertz` = 0.113661, `000000059_gompertz` = 0.0460331, `000000060_gompertz` = 0.261158, `000000061_gompertz` = 0.349721, `000000062_gompertz` = 0.155654, `000000063_gompertz` = 0.257054, `000000065_gompertz` = 0.862269, `000000066_gompertz` = 0.252522, `000000067_gompertz` = 1.27307, `000000068_gompertz` = 0.306418, `000000069_gompertz` = 0.102574, 
-`000000071_gompertz` = 0.882302, `000000072_gompertz` = 0.738851, `000000074_gompertz` = 0.290652, `000000075_gompertz` = 0.427994, `000000076_gompertz` = 0.325665, `000000077_gompertz` = 0.260397, `000000078_gompertz` = 0.331447, `000000079_gompertz` = 1.05246, `000000080_gompertz` = 0.616053, `000000081_gompertz` = 0.183084, `000000082_gompertz` = 0.18414, `000000083_gompertz` = 0.141403, `000000084_gompertz` = 0.324513, `000000085_gompertz` = 0.366182, `000000086_gompertz` = 0.671934, `000000087_gompertz` = 0.274896, 
-`000000088_gompertz` = 0.283223, `000000089_gompertz` = 0.252231, `000000090_gompertz` = 0.24439, `000000091_gompertz` = 0.109753, `000000092_gompertz` = 0.192221, `000000093_gompertz` = 0.15623, `000000094_gompertz` = 0.392484, `000000095_gompertz` = 0.171969, `000000096_gompertz` = 0.217711, `000000097_gompertz` = 0.54861, `000000098_gompertz` = 0.431443, `000000100_gompertz` = 0.298392)"
+average,0.05,0.179453,0.307799,0.0992422,1.23754,1,parametric,100,0.92,"c(`000000001_gompertz` = 0.232668, `000000003_gompertz` = 0.104651, `000000004_gompertz` = 0.546479, `000000005_gompertz` = 0.59723, `000000006_gompertz` = 0.232644, `000000007_gompertz` = 0.26047, `000000008_gompertz` = 0.194946, `000000009_gompertz` = 0.687566, `000000010_gompertz` = 0.158672, `000000011_gompertz` = 0.252489, `000000012_gompertz` = 0.212705, `000000013_gompertz` = 1.32526, `000000014_gompertz` = 0.196413, `000000015_gompertz` = 0.556619, `000000016_gompertz` = 0.542088, `000000017_gompertz` = 0.258851, 
+`000000018_gompertz` = 0.467362, `000000019_gompertz` = 0.444558, `000000020_gompertz` = 0.252365, `000000021_gompertz` = 1.00627, `000000022_gompertz` = 0.262159, `000000023_gompertz` = 0.201961, `000000024_gompertz` = 0.221781, `000000025_gompertz` = 0.370823, `000000026_gompertz` = 0.381622, `000000027_gompertz` = 0.587692, `000000028_gompertz` = 0.154181, `000000031_gompertz` = 0.10423, `000000032_gompertz` = 0.250053, `000000033_gompertz` = 0.462225, `000000034_gompertz` = 0.39652, `000000035_gompertz` = 0, 
+`000000036_gompertz` = 0.258822, `000000037_gompertz` = 0.242274, `000000038_gompertz` = 0.347614, `000000039_gompertz` = 0.29439, `000000040_gompertz` = 1.14346, `000000041_gompertz` = 0.135087, `000000042_gompertz` = 0.119971, `000000043_gompertz` = 0.314016, `000000044_gompertz` = 0.0979661, `000000045_gompertz` = 0.135296, `000000046_gompertz` = 0.260949, `000000047_gompertz` = 0.50742, `000000049_gompertz` = 1.83785, `000000050_gompertz` = 0.183739, `000000051_gompertz` = 0.119605, `000000052_gompertz` = 0.166286, 
+`000000053_gompertz` = 0.375928, `000000054_gompertz` = 0.16, `000000055_gompertz` = 0.378692, `000000056_gompertz` = 0.198193, `000000057_gompertz` = 0.854231, `000000058_gompertz` = 0.113677, `000000059_gompertz` = 0.0460489, `000000060_gompertz` = 0.26119, `000000061_gompertz` = 0.349783, `000000062_gompertz` = 0.155674, `000000063_gompertz` = 0.25708, `000000065_gompertz` = 0.862409, `000000066_gompertz` = 0.252748, `000000067_gompertz` = 1.27322, `000000068_gompertz` = 0.30646, `000000069_gompertz` = 0.102607, 
+`000000071_gompertz` = 0.882485, `000000072_gompertz` = 0.738937, `000000074_gompertz` = 0.2907, `000000075_gompertz` = 0.428083, `000000076_gompertz` = 0.325723, `000000077_gompertz` = 0.260432, `000000078_gompertz` = 0.331494, `000000079_gompertz` = 1.0526, `000000080_gompertz` = 0.616152, `000000081_gompertz` = 0.183109, `000000082_gompertz` = 0.184165, `000000083_gompertz` = 0.141392, `000000084_gompertz` = 0.324602, `000000085_gompertz` = 0.366267, `000000086_gompertz` = 0.672032, `000000087_gompertz` = 0.274923, 
+`000000088_gompertz` = 0.283306, `000000089_gompertz` = 0.252262, `000000090_gompertz` = 0.244424, `000000091_gompertz` = 0.109766, `000000092_gompertz` = 0.192248, `000000093_gompertz` = 0.156249, `000000094_gompertz` = 0.392504, `000000095_gompertz` = 0.171986, `000000096_gompertz` = 0.217738, `000000097_gompertz` = 0.548714, `000000098_gompertz` = 0.431485, `000000100_gompertz` = 0.298434)"
diff --git a/tests/testthat/_snaps/plot-cdf/fits_delta.png b/tests/testthat/_snaps/plot-cdf/fits_delta.png
diff --git a/tests/testthat/_snaps/schwarz-tillmans/gof.csv b/tests/testthat/_snaps/schwarz-tillmans/gof.csv
@@ -1,5 +1,5 @@
 dist,ad,ks,cvm,aic,aicc,bic,delta,weight
-gompertz,0.602167,0.120189,0.082256,237.611,238.091,240.276,0,0.271
+gompertz,0.602769,0.120197,0.0823572,237.611,238.091,240.276,0,0.271
 weibull,0.434234,0.116894,0.0542281,237.625,238.105,240.29,0.014,0.269
 gamma,0.440212,0.116849,0.055402,237.63,238.11,240.295,0.019,0.268
 lnorm,0.507035,0.106514,0.0703318,239.028,239.508,241.693,1.417,0.133

diff --git a/tests/testthat/_snaps/schwarz-tillmans/hc.csv b/tests/testthat/_snaps/schwarz-tillmans/hc.csv
@@ -1,5 +1,5 @@
 dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
-gompertz,0.05,1.29946,NA,NA,NA,0.270604,parametric,0,NA,numeric(0)
+gompertz,0.05,1.29989,NA,NA,NA,0.270604,parametric,0,NA,numeric(0)
 weibull,0.05,1.08673,NA,NA,NA,0.268699,parametric,0,NA,numeric(0)
 gamma,0.05,1.07428,NA,NA,NA,0.268024,parametric,0,NA,numeric(0)
 lnorm,0.05,1.68118,NA,NA,NA,0.133222,parametric,0,NA,numeric(0)

diff --git a/tests/testthat/_snaps/schwarz-tillmans/hc_avg.csv b/tests/testthat/_snaps/schwarz-tillmans/hc_avg.csv
@@ -1,2 +1,2 @@
 dist,proportion,est,se,lcl,ucl,wt,method,nboot,pboot,samples
-average,0.05,1.25052,NA,NA,NA,1,parametric,0,NA,numeric(0)
+average,0.05,1.25063,NA,NA,NA,1,parametric,0,NA,numeric(0)
diff --git a/tests/testthat/_snaps/zzz-unstable.md b/tests/testthat/_snaps/zzz-unstable.md
@@ -38,3 +38,79 @@
         <chr>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>      <dbl> <dbl> <I<list>> 
       1 average     1  3.90  2.50 0.343  9.20     1 parametric   100  0.86 <dbl [86]>
 
+# sgompertz completely unstable!
+
+    Code
+      set.seed(94)
+      ssdtools:::sgompertz(data)
+    Output
+      $log_location
+      [1] -0.8105617
+      
+      $log_shape
+      [1] -300.8251
+      
+    Code
+      set.seed(99)
+      ssdtools:::sgompertz(data)
+    Output
+      $log_location
+      [1] -0.9662517
+      
+      $log_shape
+      [1] -2.602139
+      
+
+# sgompertz with initial values still unstable!
+
+    Code
+      set.seed(94)
+      ssdtools:::sgompertz(sdata)
+    Output
+      $log_location
+      [1] -0.8105617
+      
+      $log_shape
+      [1] -300.8251
+      
+    Code
+      set.seed(94)
+      ssdtools:::sgompertz(sdata, pars)
+    Output
+      $log_location
+      [1] 4.078373
+      
+      $log_shape
+      [1] -2989.932
+      
+    Code
+      set.seed(99)
+      ssdtools:::sgompertz(sdata)
+    Output
+      $log_location
+      [1] -0.9662517
+      
+      $log_shape
+      [1] -2.602139
+      
+    Code
+      set.seed(99)
+      ssdtools:::sgompertz(sdata, pars)
+    Output
+      $log_location
+      [1] 3.433594
+      
+      $log_shape
+      [1] -104.2544
+      
+    Code
+      set.seed(100)
+      ssdtools:::sgompertz(sdata, pars)
+    Output
+      $log_location
+      [1] 3.81493
+      
+      $log_shape
+      [1] -669.3178
+      
+
diff --git a/tests/testthat/test-zzz-unstable.R b/tests/testthat/test-zzz-unstable.R
@@ -123,16 +123,12 @@ test_that("sgompertz completely unstable!", {
     1.00725113964435, 7.04244885481452, 1.32336941144339, 1.51533791792454
   )
   data <- data.frame(left = x, right = x, weight = 1)
-  set.seed(94)
-  expect_equal(ssdtools:::sgompertz(data),
-               list(log_location = -0.8097519, log_shape = -301.126),
-               tolerance = 1e-06
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(data),
-    list(log_location = -0.96528645818605, log_shape = -2.6047441710778)
-  )
+  expect_snapshot({
+    set.seed(94)
+    ssdtools:::sgompertz(data)
+    set.seed(99)
+    ssdtools:::sgompertz(data)
+  })
   set.seed(100)
   expect_error(ssdtools:::sgompertz(data))
 })
@@ -161,33 +157,20 @@ test_that("sgompertz with initial values still unstable!", {
   sdata <- data.frame(left = x, right = x, weight = 1)
   pars <- estimates(fit$gompertz)
 
-  set.seed(94)
-  expect_equal(ssdtools:::sgompertz(sdata),
-               list(log_location = -0.809751972284548, log_shape = -301.126),
-               tolerance = 1e-06
-  )
-  set.seed(94)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 4.06999915669631, log_shape = -2936.08880499417)
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(sdata),
-    list(log_location = -0.96528645818605, log_shape = -2.6047441710778)
-  )
-  set.seed(99)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 3.42665325399873, log_shape = -102.775579919568)
-  )
+  expect_snapshot({
+    set.seed(94)
+    ssdtools:::sgompertz(sdata)
+    set.seed(94)
+    ssdtools:::sgompertz(sdata, pars)
+    set.seed(99)
+    ssdtools:::sgompertz(sdata)
+    set.seed(99)
+    ssdtools:::sgompertz(sdata, pars)
+    set.seed(100)
+    ssdtools:::sgompertz(sdata, pars)
+  })
   set.seed(100)
   expect_error(ssdtools:::sgompertz(sdata))
-  set.seed(100)
-  expect_equal(
-    ssdtools:::sgompertz(sdata, pars),
-    list(log_location = 3.80715953030506, log_shape = -658.432910074053)
-  )
 })
 
 test_that("ssd_hc cis with error", {
@@ -282,7 +265,7 @@ test_that("ssd_plot censored data", {
 test_that("invpareto with extreme data", {
   skip_on_ci()
   skip_on_cran()
-
+  
   data <- data.frame(Conc = c(
     2.48892649039671, 2.5258371156749, 2.51281264491458,
     2.49866046657748, 2.56572740160664, 2.49440006912093, 2.4817062813665,
@@ -360,7 +343,7 @@ test_that("lnorm_lnorm fits anonb", {
 test_that("lnorm_lnorm non-bimodal 1000 data", {
   skip_on_ci()
   skip_on_cran()
-
+  
   data <- data.frame(Conc = c(
     11.6635934627129, 11.3655834538171, 11.8239438136152, 11.4457330597547, 
     11.2733838979158, 11.6555694734405, 11.6077458629663, 11.6253179146231,