From 1bf59b6de0f9f744d6758bc93f529f1cf9220a70 Mon Sep 17 00:00:00 2001
From: Ben Bolker <bbolker@gmail.com>
Date: Fri, 5 Apr 2024 17:06:40 -0400
Subject: [PATCH] experimental start for ordinal augment

---
 DESCRIPTION         |  1 +
 R/ordinal_tidiers.R | 49 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100644 R/ordinal_tidiers.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 9ccce94..7f5180c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -66,6 +66,7 @@ Suggests:
     MCMCglmm,
     mediation,
     mgcv,
+    ordinal,
     pander,
     pbkrtest,
     rstan,
diff --git a/R/ordinal_tidiers.R b/R/ordinal_tidiers.R
new file mode 100644
index 0000000..5158d35
--- /dev/null
+++ b/R/ordinal_tidiers.R
@@ -0,0 +1,49 @@
+predict.clmm <- function(object, ...) {
+    ## hack clmm object so it looks sufficiently like a clm[m]2 object
+    ##  for the predict.clm2 method to work ...
+    object$location <- object$formula
+    if (object$link == "logit") object$link <- "logistic"
+    attr(object$location, "terms") <- object$terms
+    class(object) <- c("clm2")
+    predict(object, ...)
+}
+
+## predict values for every level in an ordinal response
+## copied/modified from 
+predict.all.clmm <- function(object, newdata, ...) {
+    respvar <- attr(object$terms, "response")
+    mf <- model.frame(object)
+    nlev <- length(levels(mf[[respvar]]))
+    if (!missing(newdata)) mf <- model.frame(object$formula, data = newdata)
+    ndat <- do.call(rbind,
+                    replicate(nlev, mf, simplify = FALSE))
+    ndat[[respvar]] <- ordered(rep(seq(nlev), each = nrow(mf)))
+    res <- matrix(predict(object, newdata = ndat), ncol=nlev)
+}
+
+#' name ordinal_tidiers
+#' 
+#' the \code{tidy} method for \code{clmm} objects (from the
+#' \code{ordinal} package) lives in the \code{broom} package.
+#'
+#' @importFrom tibble tibble
+#' @export
+augment.clmm <- function(...,
+                         data = stats::model.frame(x), newdata, ...) {
+
+    if (!missing(newdata)) data <- newdata
+    
+}
+
+if (FALSE) {
+    library(ordinal)
+
+    fmm1 <- clmm(rating ~ temp + contact + (1|judge), data = wine)
+    fmm2 <- clmm2(rating ~ temp + contact, random = judge, data = wine)
+
+    
+    mm <- predict.all.clmm(fmm1)
+    stopifnot(all.equal(predict(fmm1), predict(fmm2),
+                        tolerance  = 1e-6))
+
+}