cleanup print method

Author: jgabry

R/loo_compare.R

@@ -183,19 +183,18 @@ print.compare.loo <- function(x, ..., digits = 1, p_worse = TRUE) {
   if (!inherits(x, "data.frame")) {
     class(x) <- c(class(x), "data.frame")
   }
-  xcopy <- x
-  if (NCOL(xcopy) >= 2) {
-    xcopy <- xcopy[, c("elpd_diff", "se_diff")]
-  }
-  xcopy <- cbind(model = x$model, .fr(xcopy, digits))
+  x2 <- cbind(
+    model = x$model,
+    .fr(x[, c("elpd_diff", "se_diff")], digits)
+  )
   if (p_worse && "p_worse" %in% colnames(x)) {
-    xcopy <- cbind(
-      xcopy,
-      p_worse = .fr(x[, "p_worse"], 2),
+    x2 <- cbind(
+      x2,
+      p_worse = .fr(x[, "p_worse"], digits = 2),
       diag_pnorm = x[, "diag_pnorm"]
     )
   }
-  print(xcopy, quote = FALSE)
+  print(x2, quote = FALSE)
   invisible(x)
 }
 

tests/testthat/_snaps/compare.md

@@ -46,6 +46,15 @@
       1 model1       0.0     0.0      NA           
       2 model2      -4.1     0.1    1.00    N < 100
 
+---
+
+    Code
+      print(comp2, p_worse = FALSE)
+    Output
+         model elpd_diff se_diff
+      1 model1       0.0     0.0
+      2 model2      -4.1     0.1
+
 # loo_compare returns expected result (3 models)
 
     WAoAAAACAAQEAgACAwAAAAMTAAAACwAAABAAAAADAAQACQAAAAZtb2RlbDEABAAJAAAABm1v

tests/testthat/test_compare.R

@@ -90,6 +90,7 @@ test_that("loo_compare returns expected results (2 models)", {
   expect_equal(colnames(comp2), comp_colnames)
   expect_snapshot_value(comp2, style = "serialize")
   expect_snapshot(print(comp2))
+  expect_snapshot(print(comp2, p_worse = FALSE))
 
   # specifying objects via ... and via arg x gives equal results
   expect_equal(comp2, loo_compare(x = list(w1, w2)))