update tests

Author: jgabry

R/loo_compare.R

@@ -178,12 +178,7 @@ loo_compare.default <- function(x, ...) {
 #'   the best model? The default is `TRUE`.
 print.compare.loo <- function(x, ..., digits = 1, p_worse = TRUE) {
   if (inherits(x, "old_compare.loo")) {
-    stop(
-      "Output from old loo::compare() detected. ",
-      "Please rerun loo_compare() to get updated output ",
-      "or run unclass() on the object to print it.",
-      call. = FALSE
-    )
+    return(unclass(x))
   }
   if (!inherits(x, "data.frame")) {
     class(x) <- c(class(x), "data.frame")

tests/testthat/_snaps/compare.md

@@ -1,48 +1,77 @@
 # loo_compare returns expected results (2 models)
 
-    WAoAAAACAAQEAgACAwAAAAMTAAAACgAAAA4AAAACAAAAAAAAAADAEDpTX5xF7gAAAA4AAAAC
-    AAAAAAAAAAA/tmpHtC8TAQAAAA4AAAACf/AAAAAAB6I/8AAAAAAAAAAAABAAAAACAAQACQAA
-    AAAABAAJAAAAB04gPCAxMDAAAAAOAAAAAsBU4fDdyUJYwFXllhPDBrkAAAAOAAAAAkARCD2z
-    EXBfQBEalRIN2T8AAAAOAAAAAkAKKMBh1blTQCZnlesA0IoAAAAOAAAAAj/x/WXscvNeP/Gb
-    YJxtZ8cAAAAOAAAAAkBk4fDdyUJYQGXllhPDBrkAAAAOAAAAAkAhCD2zEXBfQCEalRIN2T8A
-    AAQCAAAAAQAEAAkAAAAFbmFtZXMAAAAQAAAACgAEAAkAAAAJZWxwZF9kaWZmAAQACQAAAAdz
-    ZV9kaWZmAAQACQAAAAdwX3dvcnNlAAQACQAAAApkaWFnX3Bub3JtAAQACQAAAAllbHBkX3dh
-    aWMABAAJAAAADHNlX2VscGRfd2FpYwAEAAkAAAAGcF93YWljAAQACQAAAAlzZV9wX3dhaWMA
-    BAAJAAAABHdhaWMABAAJAAAAB3NlX3dhaWMAAAQCAAAAAQAEAAkAAAAFY2xhc3MAAAAQAAAA
-    AgAEAAkAAAALY29tcGFyZS5sb28ABAAJAAAACmRhdGEuZnJhbWUAAAQCAAAAAQAEAAkAAAAJ
-    cm93Lm5hbWVzAAAAEAAAAAIABAAJAAAABm1vZGVsMQAEAAkAAAAGbW9kZWwyAAAA/g==
+    WAoAAAACAAQEAgACAwAAAAMTAAAACwAAABAAAAACAAQACQAAAAZtb2RlbDEABAAJAAAABm1v
+    ZGVsMgAAAA4AAAACAAAAAAAAAAAAAAAAAAAAAAAAAA4AAAACAAAAAAAAAAAAAAAAAAAAAAAA
+    AA4AAAACf/AAAAAAB6J/8AAAAAAHogAAABAAAAACAAQACQAAAAAABAAJAAAAAAAAAA4AAAAC
+    wFTh8N3JQljAVOHw3clCWAAAAA4AAAACQBEIPbMRcF9AEQg9sxFwXwAAAA4AAAACQAoowGHV
+    uVNACijAYdW5UwAAAA4AAAACP/H9Zexy814/8f1l7HLzXgAAAA4AAAACQGTh8N3JQlhAZOHw
+    3clCWAAAAA4AAAACQCEIPbMRcF9AIQg9sxFwXwAABAIAAAABAAQACQAAAAVuYW1lcwAAABAA
+    AAALAAQACQAAAAVtb2RlbAAEAAkAAAAJZWxwZF9kaWZmAAQACQAAAAdzZV9kaWZmAAQACQAA
+    AAdwX3dvcnNlAAQACQAAAApkaWFnX3Bub3JtAAQACQAAAAllbHBkX3dhaWMABAAJAAAADHNl
+    X2VscGRfd2FpYwAEAAkAAAAGcF93YWljAAQACQAAAAlzZV9wX3dhaWMABAAJAAAABHdhaWMA
+    BAAJAAAAB3NlX3dhaWMAAAQCAAAAAQAEAAkAAAAFY2xhc3MAAAAQAAAAAgAEAAkAAAALY29t
+    cGFyZS5sb28ABAAJAAAACmRhdGEuZnJhbWUAAAQCAAAAAQAEAAkAAAAJcm93Lm5hbWVzAAAA
+    DQAAAAKAAAAA/////gAAAP4=
 
-# loo_compare returns expected result (3 models)
+---
+
+    Code
+      print(comp1)
+    Output
+         model elpd_diff se_diff p_worse diag_pnorm
+      1 model1       0.0     0.0      NA           
+      2 model2       0.0     0.0      NA           
+
+---
+
+    WAoAAAACAAQEAgACAwAAAAMTAAAACwAAABAAAAACAAQACQAAAAZtb2RlbDEABAAJAAAABm1v
+    ZGVsMgAAAA4AAAACAAAAAAAAAADAEDpTX5xF7gAAAA4AAAACAAAAAAAAAAA/tmpHtC8TAQAA
+    AA4AAAACf/AAAAAAB6I/8AAAAAAAAAAAABAAAAACAAQACQAAAAAABAAJAAAAB04gPCAxMDAA
+    AAAOAAAAAsBU4fDdyUJYwFXllhPDBrkAAAAOAAAAAkARCD2zEXBfQBEalRIN2T8AAAAOAAAA
+    AkAKKMBh1blTQCZnlesA0IoAAAAOAAAAAj/x/WXscvNeP/GbYJxtZ8cAAAAOAAAAAkBk4fDd
+    yUJYQGXllhPDBrkAAAAOAAAAAkAhCD2zEXBfQCEalRIN2T8AAAQCAAAAAQAEAAkAAAAFbmFt
+    ZXMAAAAQAAAACwAEAAkAAAAFbW9kZWwABAAJAAAACWVscGRfZGlmZgAEAAkAAAAHc2VfZGlm
+    ZgAEAAkAAAAHcF93b3JzZQAEAAkAAAAKZGlhZ19wbm9ybQAEAAkAAAAJZWxwZF93YWljAAQA
+    CQAAAAxzZV9lbHBkX3dhaWMABAAJAAAABnBfd2FpYwAEAAkAAAAJc2VfcF93YWljAAQACQAA
+    AAR3YWljAAQACQAAAAdzZV93YWljAAAEAgAAAAEABAAJAAAABWNsYXNzAAAAEAAAAAIABAAJ
+    AAAAC2NvbXBhcmUubG9vAAQACQAAAApkYXRhLmZyYW1lAAAEAgAAAAEABAAJAAAACXJvdy5u
+    YW1lcwAAAA0AAAACgAAAAP////4AAAD+
 
-    WAoAAAACAAQEAgACAwAAAAMTAAAACgAAAA4AAAADAAAAAAAAAADAEDpTX5xF7sAwDcqRtgQY
-    AAAADgAAAAMAAAAAAAAAAD+2ake0LxMBP8uv7eE07V4AAAAOAAAAA3/wAAAAAAeiP/AAAAAA
-    AAA/8AAAAAAAAAAAABAAAAADAAQACQAAAAAABAAJAAAAB04gPCAxMDAABAAJAAAAB04gPCAx
-    MDAAAAAOAAAAA8BU4fDdyUJYwFXllhPDBrnAWOVjgjbDYgAAAA4AAAADQBEIPbMRcF9AERqV
-    Eg3ZP0AQ8gXcaKATAAAADgAAAANACijAYdW5U0AmZ5XrANCKQEHI2FIa3QoAAAAOAAAAAz/x
-    /WXscvNeP/GbYJxtZ8c/8YDQkmfJXwAAAA4AAAADQGTh8N3JQlhAZeWWE8MGuUBo5WOCNsNi
-    AAAADgAAAANAIQg9sxFwX0AhGpUSDdk/QCDyBdxooBMAAAQCAAAAAQAEAAkAAAAFbmFtZXMA
-    AAAQAAAACgAEAAkAAAAJZWxwZF9kaWZmAAQACQAAAAdzZV9kaWZmAAQACQAAAAdwX3dvcnNl
-    AAQACQAAAApkaWFnX3Bub3JtAAQACQAAAAllbHBkX3dhaWMABAAJAAAADHNlX2VscGRfd2Fp
-    YwAEAAkAAAAGcF93YWljAAQACQAAAAlzZV9wX3dhaWMABAAJAAAABHdhaWMABAAJAAAAB3Nl
-    X3dhaWMAAAQCAAAAAQAEAAkAAAAFY2xhc3MAAAAQAAAAAgAEAAkAAAALY29tcGFyZS5sb28A
-    BAAJAAAACmRhdGEuZnJhbWUAAAQCAAAAAQAEAAkAAAAJcm93Lm5hbWVzAAAAEAAAAAMABAAJ
-    AAAABm1vZGVsMQAEAAkAAAAGbW9kZWwyAAQACQAAAAZtb2RlbDMAAAD+
-
-# compare returns expected result (2 models)
+---
 
     Code
-      comp1
+      print(comp2)
     Output
-      elpd_diff        se 
-            0.0       0.0 
+         model elpd_diff se_diff p_worse diag_pnorm
+      1 model1       0.0     0.0      NA           
+      2 model2      -4.1     0.1    1.00    N < 100
+
+# loo_compare returns expected result (3 models)
+
+    WAoAAAACAAQEAgACAwAAAAMTAAAACwAAABAAAAADAAQACQAAAAZtb2RlbDEABAAJAAAABm1v
+    ZGVsMgAEAAkAAAAGbW9kZWwzAAAADgAAAAMAAAAAAAAAAMAQOlNfnEXuwDANypG2BBgAAAAO
+    AAAAAwAAAAAAAAAAP7ZqR7QvEwE/y6/t4TTtXgAAAA4AAAADf/AAAAAAB6I/8AAAAAAAAD/w
+    AAAAAAAAAAAAEAAAAAMABAAJAAAAAAAEAAkAAAAHTiA8IDEwMAAEAAkAAAAHTiA8IDEwMAAA
+    AA4AAAADwFTh8N3JQljAVeWWE8MGucBY5WOCNsNiAAAADgAAAANAEQg9sxFwX0ARGpUSDdk/
+    QBDyBdxooBMAAAAOAAAAA0AKKMBh1blTQCZnlesA0IpAQcjYUhrdCgAAAA4AAAADP/H9Zexy
+    814/8ZtgnG1nxz/xgNCSZ8lfAAAADgAAAANAZOHw3clCWEBl5ZYTwwa5QGjlY4I2w2IAAAAO
+    AAAAA0AhCD2zEXBfQCEalRIN2T9AIPIF3GigEwAABAIAAAABAAQACQAAAAVuYW1lcwAAABAA
+    AAALAAQACQAAAAVtb2RlbAAEAAkAAAAJZWxwZF9kaWZmAAQACQAAAAdzZV9kaWZmAAQACQAA
+    AAdwX3dvcnNlAAQACQAAAApkaWFnX3Bub3JtAAQACQAAAAllbHBkX3dhaWMABAAJAAAADHNl
+    X2VscGRfd2FpYwAEAAkAAAAGcF93YWljAAQACQAAAAlzZV9wX3dhaWMABAAJAAAABHdhaWMA
+    BAAJAAAAB3NlX3dhaWMAAAQCAAAAAQAEAAkAAAAFY2xhc3MAAAAQAAAAAgAEAAkAAAALY29t
+    cGFyZS5sb28ABAAJAAAACmRhdGEuZnJhbWUAAAQCAAAAAQAEAAkAAAAJcm93Lm5hbWVzAAAA
+    DQAAAAKAAAAA/////QAAAP4=
 
 ---
 
     Code
-      comp2
+      print(comp1)
     Output
-      elpd_diff        se 
-           -4.1       0.1 
+         model elpd_diff se_diff p_worse diag_pnorm
+      1 model1       0.0     0.0      NA           
+      2 model2      -4.1     0.1    1.00    N < 100
+      3 model3     -16.1     0.2    1.00    N < 100
 
 # compare returns expected result (3 models)
 

tests/testthat/test_compare.R

@@ -60,6 +60,7 @@ test_that("loo_compare throws appropriate warnings", {
 
 
 comp_colnames <- c(
+  "model",
   "elpd_diff",
   "se_diff",
   "p_worse",
@@ -77,19 +78,25 @@ test_that("loo_compare returns expected results (2 models)", {
   expect_s3_class(comp1, "compare.loo")
   expect_s3_class(comp1, "data.frame")
   expect_equal(colnames(comp1), comp_colnames)
-  expect_equal(rownames(comp1), c("model1", "model2"))
-  expect_output(print(comp1), "elpd_diff")
-  expect_equal(comp1[1:2, 1], c(0, 0), ignore_attr = TRUE)
-  expect_equal(comp1[1:2, 2], c(0, 0), ignore_attr = TRUE)
+  expect_equal(comp1$model, c("model1", "model2"))
+  expect_equal(comp1$elpd_diff, c(0, 0), ignore_attr = TRUE)
+  expect_equal(comp1$se_diff, c(0, 0), ignore_attr = TRUE)
+  expect_equal(comp1$p_worse, c(NA_real_, NA_real_), ignore_attr = TRUE)
+  expect_snapshot_value(comp1, style = "serialize")
+  expect_snapshot(print(comp1))
 
   comp2 <- loo_compare(w1, w2)
   expect_s3_class(comp2, "compare.loo")
   expect_equal(colnames(comp2), comp_colnames)
-
   expect_snapshot_value(comp2, style = "serialize")
+  expect_snapshot(print(comp2))
 
   # specifying objects via ... and via arg x gives equal results
   expect_equal(comp2, loo_compare(x = list(w1, w2)))
+
+  # custom naming works
+  comp3 <- loo_compare(x = list("A" = w2, "B" = w1))
+  expect_equal(comp3$model, c("B", "A"))
 })
 
 
@@ -98,12 +105,12 @@ test_that("loo_compare returns expected result (3 models)", {
   comp1 <- loo_compare(w1, w2, w3)
 
   expect_equal(colnames(comp1), comp_colnames)
-  expect_equal(rownames(comp1), c("model1", "model2", "model3"))
-  expect_equal(comp1[1, 1], 0)
+  expect_equal(comp1$model, c("model1", "model2", "model3"))
+  expect_equal(comp1$p_worse, c(NA, 1, 1))
   expect_s3_class(comp1, "compare.loo")
   expect_s3_class(comp1, "data.frame")
-
   expect_snapshot_value(comp1, style = "serialize")
+  expect_snapshot(print(comp1))
 
   # specifying objects via '...' gives equivalent results (equal
   # except rownames) to using 'x' argument
@@ -119,13 +126,11 @@ test_that("compare throws deprecation warnings", {
 
 test_that("compare returns expected result (2 models)", {
   expect_warning(comp1 <- loo::compare(w1, w1), "Deprecated")
-  expect_snapshot(comp1)
   expect_equal(comp1[1:2], c(elpd_diff = 0, se = 0))
 
   expect_warning(comp2 <- loo::compare(w1, w2), "Deprecated")
-  expect_snapshot(comp2)
-  expect_named(comp2, c("elpd_diff", "se"))
-  expect_s3_class(comp2, "compare.loo")
+  expect_equal(round(comp2[1:2], 3), c(elpd_diff = -4.057, se = 0.088))
+  expect_s3_class(comp2, "old_compare.loo")
 
   # specifying objects via ... and via arg x gives equal results
   expect_warning(comp_via_list <- loo::compare(x = list(w1, w2)), "Deprecated")