diff --git a/NEWS.md b/NEWS.md index 854c05ce..c27ce340 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # loo (development version) +* Change the output of `loo_compare()` for subsampled loo objects from a matrix to a data.frame by @florence-bockting in #393 * Fix `loo_compare()` when used with subsampling: compute model comparison by comparison-model minus reference-model by @florence-bockting in #391 * Update user messages in `print()` by @ishaan-arora-1, @florence-bockting in #328. diff --git a/R/loo_compare.psis_loo_ss_list.R b/R/loo_compare.psis_loo_ss_list.R index 194eb69f..5cbcf393 100644 --- a/R/loo_compare.psis_loo_ss_list.R +++ b/R/loo_compare.psis_loo_ss_list.R @@ -24,8 +24,12 @@ loo_compare.psis_loo_ss_list <- function(x, ...) { for(i in 2:length(ord)){ elpd_diff_mat[i,] <- loo_compare_ss(ref_loo = x[ord[1]], compare_loo = x[ord[i]]) } - comp <- cbind(elpd_diff_mat, comp) - rownames(comp) <- rnms + comp <- cbind( + data.frame(model = rnms, stringsAsFactors = FALSE), + as.data.frame(elpd_diff_mat), + as.data.frame(comp) + ) + rownames(comp) <- NULL class(comp) <- c("compare.loo_ss", "compare.loo", class(comp)) return(comp) @@ -174,11 +178,13 @@ loo_compare_checks.psis_loo_ss_list <- function(loos) { #' @rdname loo_compare #' @export print.compare.loo_ss <- function(x, ..., digits = 1) { - xcopy <- x - if (NCOL(xcopy) >= 2) { - xcopy <- xcopy[, c("elpd_diff", "se_diff", "subsampling_se_diff")] - } - print(.fr(xcopy, digits), quote = FALSE) + cols <- c("model", "elpd_diff", "se_diff", "subsampling_se_diff") + cols <- intersect(cols, colnames(x)) + + x_sub <- x[, cols, drop = FALSE] + x_sub[setdiff(cols, "model")] <- .fr(x_sub[setdiff(cols, "model")], digits) + print(as.data.frame(x_sub), quote = FALSE, row.names = FALSE) + invisible(x) } diff --git a/tests/testthat/_snaps/loo_subsampling_cases.md b/tests/testthat/_snaps/loo_subsampling_cases.md index 4cff4eb9..1c458653 100644 --- a/tests/testthat/_snaps/loo_subsampling_cases.md +++ b/tests/testthat/_snaps/loo_subsampling_cases.md @@ -104,34 +104,34 @@ Code print(comp) Output - elpd_diff se_diff subsampling_se_diff - model2 0.0 0.0 0.0 - model1 -16.5 22.5 0.4 + model elpd_diff se_diff subsampling_se_diff + model2 0.0 0.0 0.0 + model1 -16.5 22.5 0.4 --- Code print(comp) Output - elpd_diff se_diff subsampling_se_diff - model2 0.0 0.0 0.0 - model1 -16.1 4.4 0.1 + model elpd_diff se_diff subsampling_se_diff + model2 0.0 0.0 0.0 + model1 -16.1 4.4 0.1 --- Code print(comp2) Output - elpd_diff se_diff subsampling_se_diff - model2 0.0 0.0 0.0 - model1 -16.3 4.4 0.1 + model elpd_diff se_diff subsampling_se_diff + model2 0.0 0.0 0.0 + model1 -16.3 4.4 0.1 --- Code print(comp3) Output - elpd_diff se_diff subsampling_se_diff - model2 0.0 0.0 0.0 - model1 -16.5 4.4 0.3 + model elpd_diff se_diff subsampling_se_diff + model2 0.0 0.0 0.0 + model1 -16.5 4.4 0.3 diff --git a/tests/testthat/test_loo_subsampling.R b/tests/testthat/test_loo_subsampling.R index bf566ff7..a4f51b47 100644 --- a/tests/testthat/test_loo_subsampling.R +++ b/tests/testthat/test_loo_subsampling.R @@ -1047,23 +1047,26 @@ test_that("loo_compare_subsample", { ) ) - expect_equal(lcss[, 1], lcsso[, 1], tolerance = 1) - expect_equal(lcss2[, 1], lcsso[, 1], tolerance = 1) - expect_equal(lcssohh[, 1], lcsso[, 1], tolerance = 1) - expect_equal(lcssf1[, 1], lcsso[, 1], tolerance = 1) - expect_equal(lcssf2[, 1], lcsso[, 1], tolerance = 1) + expect_equal(lcss$elpd_diff, lcsso$elpd_diff, tolerance = 1) + expect_equal(lcss2$elpd_diff, lcsso$elpd_diff, tolerance = 1) + expect_equal(lcssohh$elpd_diff, lcsso$elpd_diff, tolerance = 1) + expect_equal(lcssf1$elpd_diff, lcsso$elpd_diff, tolerance = 1) + expect_equal(lcssf2$elpd_diff, lcsso$elpd_diff, tolerance = 1) - expect_gt(lcss[, 2][2], lcsso[, 2][2]) - expect_gt(lcss[, 2][3], lcsso[, 2][3]) - expect_gt(lcss2[, 2][2], lcsso[, 2][2]) - expect_equal(lcss2[, 2][3], lcsso[, 2][3]) - expect_gt(lcssohh[, 2][2], lcsso[, 2][2]) - expect_equal(lcssohh[, 2][3], lcsso[, 2][3]) + expect_gt(lcss$se_diff[2], lcsso$se_diff[2]) + expect_gt(lcss$se_diff[3], lcsso$se_diff[3]) + expect_gt(lcss2$se_diff[2], lcsso$se_diff[2]) + expect_equal(lcss2$se_diff[3], lcsso$se_diff[3]) + expect_gt(lcssohh$se_diff[2], lcsso$se_diff[2]) + expect_equal(lcssohh$se_diff[3], lcsso$se_diff[3]) expect_silent( lcss2m <- loo:::loo_compare.psis_loo_ss_list(x = list(lss2o1, lss3o1)) ) - expect_equal(unname(lcss2m[,]), unname(lcsso[1:2, ])) + expect_equal( + lcss2m[, setdiff(colnames(lcss2m), "model")], + lcsso[1:2, setdiff(colnames(lcsso), "model")] + ) expect_snapshot(lcssapi <- loo_compare(lss1, lss2, lss3)) expect_equal(lcssapi, lcss) @@ -1073,8 +1076,9 @@ test_that("loo_compare_subsample", { expect_equal(lcss2mapi, lcss2m) # check that comparison is comp - ref model (i.e., elpd_diff is neg.) for (m in list(lcss, lcss2, lcssohh)) { - expect_lt(m[2, "elpd_diff"], 0) - expect_lt(m[3, "elpd_diff"], 0) + expect_lt(m$elpd_diff[2], 0) + expect_lt(m$elpd_diff[3], 0) + expect_true("data.frame" %in% class(m)) } }) diff --git a/vignettes/loo2-large-data.Rmd b/vignettes/loo2-large-data.Rmd index 7f7083f0..ac659ff6 100644 --- a/vignettes/loo2-large-data.Rmd +++ b/vignettes/loo2-large-data.Rmd @@ -481,7 +481,7 @@ print(comp) ``` Warning: Different subsamples in 'model2' and 'model1'. Naive diff SE is used. - elpd_diff se_diff subsampling_se_diff +model elpd_diff se_diff subsampling_se_diff model2 0.0 0.0 0.0 model1 -16.5 22.5 0.4 ``` @@ -542,7 +542,7 @@ print(comp) ``` ``` - elpd_diff se_diff subsampling_se_diff +model elpd_diff se_diff subsampling_se_diff model2 0.0 0.0 0.0 model1 -16.1 4.4 0.1 ``` @@ -580,7 +580,7 @@ the loo calculations for both `model1` and `model2` are included in the computations for the comparison. ``` - elpd_diff se_diff subsampling_se_diff +model elpd_diff se_diff subsampling_se_diff model2 0.0 0.0 0.0 model1 -16.3 4.4 0.3 ```