|
| 1 | +# Internal generic — use report(x, audience = "ai") instead. |
| 2 | +report_ai <- function(x, ...) { |
| 3 | + UseMethod("report_ai") |
| 4 | +} |
| 5 | + |
| 6 | +report_ai.default <- function(x, ...) { |
| 7 | + insight::format_warning( |
| 8 | + paste0( |
| 9 | + "AI-optimized reports are not yet available for objects of class '", |
| 10 | + class(x)[1], |
| 11 | + "'. Falling back to report()." |
| 12 | + ) |
| 13 | + ) |
| 14 | + report(x, ..., audience = "humans") |
| 15 | +} |
| 16 | + |
| 17 | +report_ai.lm <- function(x, ...) { |
| 18 | + .report_ai_models(x, ...) |
| 19 | +} |
| 20 | + |
| 21 | +report_ai.glm <- report_ai.lm |
| 22 | + |
| 23 | +report_ai.merMod <- function(x, ...) { |
| 24 | + .report_ai_models(x, ...) |
| 25 | +} |
| 26 | + |
| 27 | +report_ai.glmmTMB <- function(x, ...) { |
| 28 | + .report_ai_models(x, ...) |
| 29 | +} |
| 30 | + |
| 31 | + |
| 32 | +# --- Internal Workhorse Function --- |
| 33 | +.report_ai_models <- function(x, ...) { |
| 34 | + mi <- insight::model_info(x) |
| 35 | + dat <- insight::get_data(x) |
| 36 | + n_obs <- insight::n_obs(x) |
| 37 | + form <- insight::find_formula(x) |
| 38 | + |
| 39 | + func_name <- tryCatch( |
| 40 | + { |
| 41 | + dep <- insight::safe_deparse(insight::get_call(x)[[1]]) |
| 42 | + sub(".*::", "", dep) |
| 43 | + }, |
| 44 | + error = function(e) class(x)[1] |
| 45 | + ) |
| 46 | + mod_family <- if (is.null(mi$family)) "Unknown" else mi$family |
| 47 | + |
| 48 | + model_vars_list <- insight::find_variables(x) |
| 49 | + # Use only response + conditional (fixed) variables for descriptives; |
| 50 | + # random grouping variables (e.g. Subject) are excluded. |
| 51 | + fixed_var_comps <- intersect( |
| 52 | + c("response", "conditional"), |
| 53 | + names(model_vars_list) |
| 54 | + ) |
| 55 | + fixed_vars <- unique(unlist( |
| 56 | + model_vars_list[fixed_var_comps], |
| 57 | + use.names = FALSE |
| 58 | + )) |
| 59 | + fixed_vars <- fixed_vars[fixed_vars %in% colnames(dat)] |
| 60 | + |
| 61 | + if (length(fixed_vars) > 0) { |
| 62 | + desc_report <- suppressWarnings(summary(report::report( |
| 63 | + dat[, fixed_vars, drop = FALSE], |
| 64 | + audience = "humans" |
| 65 | + ))) |
| 66 | + desc_lines <- unlist(strsplit( |
| 67 | + as.character(desc_report), |
| 68 | + "\n", |
| 69 | + fixed = TRUE |
| 70 | + )) |
| 71 | + |
| 72 | + if (length(desc_lines) > 1) { |
| 73 | + # Use trimws() to kill the spaces that cause nested bullets |
| 74 | + clean_lines <- trimws(desc_lines[-1]) |
| 75 | + desc_str <- paste(clean_lines, collapse = "\n") |
| 76 | + } else { |
| 77 | + desc_str <- paste(trimws(desc_lines), collapse = "\n") |
| 78 | + } |
| 79 | + } else { |
| 80 | + desc_str <- "- No variables found." |
| 81 | + } |
| 82 | + |
| 83 | + params <- parameters::model_parameters(x, ...) |
| 84 | + |
| 85 | + # Separate fixed and random effects to avoid duplicated table headers |
| 86 | + # (model_parameters returns both in one table for mixed models) |
| 87 | + has_random <- "Effects" %in% |
| 88 | + names(params) && |
| 89 | + any(!is.na(params$Effects) & params$Effects != "fixed") |
| 90 | + |
| 91 | + if (has_random) { |
| 92 | + fixed_params <- params[ |
| 93 | + !is.na(params$Effects) & params$Effects == "fixed", |
| 94 | + , |
| 95 | + drop = FALSE |
| 96 | + ] |
| 97 | + random_params <- params[ |
| 98 | + !is.na(params$Effects) & params$Effects != "fixed", |
| 99 | + , |
| 100 | + drop = FALSE |
| 101 | + ] |
| 102 | + } else { |
| 103 | + fixed_params <- params |
| 104 | + random_params <- NULL |
| 105 | + } |
| 106 | + |
| 107 | + param_table <- insight::format_table(fixed_params) |
| 108 | + param_markdown <- insight::export_table(param_table, format = "markdown") |
| 109 | + param_str <- paste(param_markdown, collapse = "\n") |
| 110 | + |
| 111 | + # Format random effect variances as metadata bullet points |
| 112 | + random_str <- NULL |
| 113 | + if (!is.null(random_params) && nrow(random_params) > 0) { |
| 114 | + coef_col <- intersect( |
| 115 | + c("Coefficient", "Estimate", "SD"), |
| 116 | + names(random_params) |
| 117 | + )[1] |
| 118 | + random_str <- paste( |
| 119 | + vapply( |
| 120 | + seq_len(nrow(random_params)), |
| 121 | + function(i) { |
| 122 | + param_row <- random_params[i, , drop = FALSE] |
| 123 | + param_name <- if ("Parameter" %in% names(param_row)) { |
| 124 | + as.character(param_row$Parameter) |
| 125 | + } else { |
| 126 | + "?" |
| 127 | + } |
| 128 | + group_tag <- if ( |
| 129 | + "Group" %in% |
| 130 | + names(param_row) && |
| 131 | + !is.na(param_row$Group) && |
| 132 | + nzchar(as.character(param_row$Group)) |
| 133 | + ) { |
| 134 | + paste0(" [", param_row$Group, "]") |
| 135 | + } else { |
| 136 | + "" |
| 137 | + } |
| 138 | + val <- if (!is.na(coef_col) && coef_col %in% names(param_row)) { |
| 139 | + sprintf("%.3f", as.numeric(param_row[[coef_col]])) |
| 140 | + } else { |
| 141 | + "?" |
| 142 | + } |
| 143 | + paste0("- ", param_name, group_tag, ": ", val) |
| 144 | + }, |
| 145 | + character(1) |
| 146 | + ), |
| 147 | + collapse = "\n" |
| 148 | + ) |
| 149 | + } |
| 150 | + |
| 151 | + perf <- performance::model_performance(x, ...) |
| 152 | + perf_table <- insight::format_table(perf) |
| 153 | + perf_markdown <- insight::export_table(perf_table, format = "markdown") |
| 154 | + perf_str <- paste(perf_markdown, collapse = "\n") |
| 155 | + |
| 156 | + if ("p" %in% names(fixed_params) && "Parameter" %in% names(fixed_params)) { |
| 157 | + sig_effects <- fixed_params$Parameter[ |
| 158 | + !is.na(fixed_params$p) & |
| 159 | + fixed_params$p < 0.05 & |
| 160 | + fixed_params$Parameter != "(Intercept)" |
| 161 | + ] |
| 162 | + highlights_str <- if (length(sig_effects) == 0) { |
| 163 | + "- Significant effects: None" |
| 164 | + } else { |
| 165 | + sprintf( |
| 166 | + "- Significant effects (p < 0.05): %s", |
| 167 | + toString(sig_effects) |
| 168 | + ) |
| 169 | + } |
| 170 | + } else { |
| 171 | + highlights_str <- "- Significant effects: Could not be determined." |
| 172 | + } |
| 173 | + |
| 174 | + formula_str <- if (is.list(form)) { |
| 175 | + Reduce(paste, deparse(form$conditional)) |
| 176 | + } else { |
| 177 | + Reduce(paste, deparse(form)) |
| 178 | + } |
| 179 | + |
| 180 | + # CI / degrees-of-freedom estimation method |
| 181 | + ci_level <- attr(params, "ci") |
| 182 | + ci_method <- attr(params, "ci_method") |
| 183 | + if (!is.null(ci_level) && !is.null(ci_method)) { |
| 184 | + ci_pct <- sprintf("%.0f%%", ci_level * 100) |
| 185 | + ci_label <- .ci_method_label(ci_method) |
| 186 | + inference_str <- paste0("- Inference: ", ci_pct, " CI [", ci_label, "]") |
| 187 | + } else if (is.null(ci_level)) { |
| 188 | + inference_str <- NULL |
| 189 | + } else { |
| 190 | + inference_str <- paste0( |
| 191 | + "- Inference: ", |
| 192 | + sprintf("%.0f%%", ci_level * 100), |
| 193 | + " CI" |
| 194 | + ) |
| 195 | + } |
| 196 | + |
| 197 | + param_section <- if (is.null(random_str)) { |
| 198 | + paste0("## Parameters\n", param_str) |
| 199 | + } else { |
| 200 | + paste0("## Parameters\n", param_str, "\n\n### Random Effects\n", random_str) |
| 201 | + } |
| 202 | + |
| 203 | + model_section <- paste0( |
| 204 | + "## Model\n", |
| 205 | + "- Call: ", |
| 206 | + func_name, |
| 207 | + "\n", |
| 208 | + "- Formula: ", |
| 209 | + formula_str, |
| 210 | + "\n", |
| 211 | + "- Family: ", |
| 212 | + mod_family, |
| 213 | + "\n", |
| 214 | + "- N: ", |
| 215 | + n_obs, |
| 216 | + if (is.null(inference_str)) "" else paste0("\n", inference_str) |
| 217 | + ) |
| 218 | + |
| 219 | + res <- paste0( |
| 220 | + model_section, |
| 221 | + "\n\n", |
| 222 | + "## Variables\n", |
| 223 | + desc_str, |
| 224 | + "\n\n", |
| 225 | + param_section, |
| 226 | + "\n\n", |
| 227 | + "## Performance\n", |
| 228 | + perf_str, |
| 229 | + "\n\n", |
| 230 | + "## Highlights\n", |
| 231 | + highlights_str |
| 232 | + ) |
| 233 | + |
| 234 | + class(res) <- c("report_ai", "character") |
| 235 | + res |
| 236 | +} |
| 237 | + |
| 238 | +# Helper: human-readable CI / df-method label |
| 239 | +.ci_method_label <- function(method) { |
| 240 | + method_labels <- c( |
| 241 | + wald = "Wald", |
| 242 | + residual = "Residual df (t/F)", |
| 243 | + satterthwaite = "Satterthwaite df", |
| 244 | + kenward = "Kenward-Roger df", |
| 245 | + normal = "Normal (z)", |
| 246 | + profile = "Profile likelihood", |
| 247 | + boot = "Bootstrap", |
| 248 | + uniroot = "Uniroot", |
| 249 | + hdi = "HDI", |
| 250 | + eti = "ETI", |
| 251 | + si = "SI" |
| 252 | + ) |
| 253 | + lab <- method_labels[tolower(as.character(method))] |
| 254 | + if (is.na(lab)) { |
| 255 | + tools::toTitleCase(tolower(as.character(method))) |
| 256 | + } else { |
| 257 | + unname(lab) |
| 258 | + } |
| 259 | +} |
| 260 | + |
| 261 | +#' @export |
| 262 | +print.report_ai <- function(x, ...) { |
| 263 | + cat(x, "\n") |
| 264 | + invisible(x) |
| 265 | +} |
0 commit comments