diff --git a/R/zzz_calibration_aspect.R b/R/zzz_calibration_aspect.R new file mode 100644 index 00000000..1e93d56f --- /dev/null +++ b/R/zzz_calibration_aspect.R @@ -0,0 +1,29 @@ +# Keep the upper interactive calibration panel on a 1:1 predicted/observed scale. +# +# The histogram is a separate lower subplot and intentionally remains +# unconstrained. This wrapper is loaded after calibration.R so the plotting +# implementation itself stays unchanged apart from the final Plotly layout. + +.create_plotly_curve_from_calibration_curve_list_unconstrained <- + create_plotly_curve_from_calibration_curve_list + +create_plotly_curve_from_calibration_curve_list <- function(calibration_curve_list, + type = "discrete") { + calibration_curve <- + .create_plotly_curve_from_calibration_curve_list_unconstrained( + calibration_curve_list, + type = type + ) + + calibration_curve |> + plotly::layout( + yaxis = list( + title = "Observed", + range = calibration_curve_list$axes_ranges$yaxis, + showgrid = FALSE, + scaleanchor = "x", + scaleratio = 1, + constrain = "domain" + ) + ) +} diff --git a/tests/testthat/test-calibration-interactive-aspect.R b/tests/testthat/test-calibration-interactive-aspect.R new file mode 100644 index 00000000..c57c234d --- /dev/null +++ b/tests/testthat/test-calibration-interactive-aspect.R @@ -0,0 +1,23 @@ +test_that("interactive calibration main panel is square", { + probs <- list(model = seq(0.05, 0.95, length.out = 20)) + reals <- list(rep(c(0, 1), 10)) + + for (type in c("discrete", "smooth")) { + fig <- create_calibration_curve( + probs = probs, + reals = reals, + type = type, + interactive = TRUE + ) + + built <- plotly::plotly_build(fig) + + expect_equal(built$x$layout$xaxis$range, built$x$layout$yaxis$range) + expect_equal(built$x$layout$yaxis$scaleanchor, "x") + expect_equal(built$x$layout$yaxis$scaleratio, 1) + expect_equal(built$x$layout$yaxis$constrain, "domain") + + # The histogram uses yaxis2 and is intentionally not square-constrained. + expect_null(built$x$layout$yaxis2$scaleanchor) + } +})