Skip to content

Commit

Permalink
Merge pull request #168 from easystats/visualization_matrix
Browse files Browse the repository at this point in the history 
update vis-matrix
  • Loading branch information
@strengejacke
strengejacke authored Jan 24, 2022
2 parents 5448f6b + 0163714 commit 90a5454
Show file tree
Hide file tree
Showing 4 changed files with 99 additions and 96 deletions.
17 changes: 1 addition & 16 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,29 +34,14 @@ S3method(summary,estimate_slopes)
S3method(summary,reshape_grouplevel)
S3method(unstandardize,estimate_predicted)
S3method(unstandardize,visualisation_matrix)
S3method(visualisation_matrix,MixMod)
S3method(visualisation_matrix,brmsfit)
S3method(visualisation_matrix,character)
S3method(visualisation_matrix,data.frame)
S3method(visualisation_matrix,default)
S3method(visualisation_matrix,double)
S3method(visualisation_matrix,factor)
S3method(visualisation_matrix,gamm)
S3method(visualisation_matrix,glm)
S3method(visualisation_matrix,glmerMod)
S3method(visualisation_matrix,glmmTMB)
S3method(visualisation_matrix,hurdle)
S3method(visualisation_matrix,ivreg)
S3method(visualisation_matrix,list)
S3method(visualisation_matrix,lm)
S3method(visualisation_matrix,lmerMod)
S3method(visualisation_matrix,logical)
S3method(visualisation_matrix,merMod)
S3method(visualisation_matrix,numeric)
S3method(visualisation_matrix,polr)
S3method(visualisation_matrix,stanreg)
S3method(visualisation_matrix,svyglm)
S3method(visualisation_matrix,visualisation_matrix)
S3method(visualisation_matrix,zeroinfl)
S3method(visualisation_recipe,estimate_grouplevel)
S3method(visualisation_recipe,estimate_means)
S3method(visualisation_recipe,estimate_predicted)
Expand Down
79 changes: 54 additions & 25 deletions R/visualisation_matrix.data.frame.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' Create a reference matrix, useful for visualisation, with evenly spread and combined values. `data_matrix()` is an alternative name for `visualisation_matrix()`.
#'
#' @param x An object from which to construct the reference grid.
#' @param at,target Can be "all" or list of characters indicating columns of interest. Can also contain assignments (e.g., `at = "Sepal.Length = 2"` or `at = c("Sepal.Length = 2", "Species = 'setosa'")` - note the usage of single and double quotes to assign strings within strings). The remaining variables will be fixed. (`target` is the deprecated name of that argument).
#' @param at,target Can be "all" or list of characters indicating columns of interest. Can also contain assignments (as named list, e.g. `at = list(c(Sepal.Length = c(2, 4), Species = "setosa"))`, or as string, e.g. `at = "Sepal.Length = 2"` or `at = c("Sepal.Length = 2", "Species = 'setosa'")` - note the usage of single and double quotes to assign strings within strings). The remaining variables will be fixed. (`target` is the deprecated name of that argument).
#' @param length Length of numeric "at" variables.
#' @param range Can be one of `c("range", "iqr", "ci", "hdi", "eti")`. If `"range"` (default), will use the min and max of the original vector as end-points. If any other interval, will spread within the range (the default CI width is `95%` but this can be changed by setting something else, e.g., `ci = 0.90`). See [IQR()] and [bayestestR::ci()].
#' @param factors Type of summary for factors. Can be "reference" (set at the reference level), "mode" (set at the most common level) or "all" to keep all levels.
Expand Down Expand Up @@ -36,6 +36,9 @@
#' visualisation_matrix(data, at = c("Sepal.Length = 3", "Species"))
#' visualisation_matrix(data, at = c("Sepal.Length = c(3, 1)", "Species = 'setosa'"))
#'
#' # with list-style at-argument
#' visualisation_matrix(data, at = list(Sepal.Length = c(1, 3), Species = "setosa"))
#'
#' # Standardize
#' vizdata <- visualisation_matrix(data, at = "Sepal.Length")
#' effectsize::standardize(vizdata)
Expand All @@ -59,27 +62,25 @@ visualisation_matrix.data.frame <- function(x, at = "all", target = NULL, factor
if (!is.null(target)) at <- target
target <- at

# find numerics that were coerced to factor in-formula
numeric_factors <- colnames(x)[sapply(x, function(i) isTRUE(attributes(i)$factor))]

specs <- NULL

if (is.null(target)) {
specs <- NULL
targets <- data.frame()
} else {
# Valid target argument
if (all(target == "all")) {
target <- names(x)
}

if (is.numeric(target)) {
if (is.numeric(target) || is.logical(target)) {
target <- names(x)[target]
}

# Deal with targets ==========================================================

# Find eventual user-defined specifications for each target
specs <- do.call(rbind, lapply(target, .visualisation_matrix_clean_target, x = x))
specs$varname <- as.character(specs$varname) # make sure it's a string not fac
specs <- specs[!duplicated(specs$varname), ] # Drop duplicates
# Deal with factor in-formula transformations ============================

# Deal with factor transformations
x[] <- lapply(x, function(i) {
if (isTRUE(attributes(i)$factor)) {
as.factor(i)
Expand All @@ -88,23 +89,43 @@ visualisation_matrix.data.frame <- function(x, at = "all", target = NULL, factor
}
})

specs$is_factor <- sapply(x[specs$varname], function(x) is.factor(x) || is.character(x))
# Create target list of factors -----------------------------------------
facs <- list()
for (fac in specs[specs$is_factor == TRUE, "varname"]) {
facs[[fac]] <- visualisation_matrix(x[[fac]], target = specs[specs$varname == fac, "expression"])
}
# Deal with targets ==========================================================

# Create target list of numerics ----------------------------------------
nums <- list()
for (num in specs[specs$is_factor == FALSE, "varname"]) {
nums[[num]] <- visualisation_matrix(x[[num]],
target = specs[specs$varname == num, "expression"],
reference = reference[[num]],
...
)
if (is.character(target)) {

# Find eventual user-defined specifications for each target
specs <- do.call(rbind, lapply(target, .visualisation_matrix_clean_target, x = x))
specs$varname <- as.character(specs$varname) # make sure it's a string not fac
specs <- specs[!duplicated(specs$varname), ] # Drop duplicates

specs$is_factor <- sapply(x[specs$varname], function(x) is.factor(x) || is.character(x))

# Create target list of factors -----------------------------------------
facs <- list()
for (fac in specs[specs$is_factor == TRUE, "varname"]) {
facs[[fac]] <- visualisation_matrix(x[[fac]],
target = specs[specs$varname == fac, "expression"])
}

# Create target list of numerics ----------------------------------------
nums <- list()
for (num in specs[specs$is_factor == FALSE, "varname"]) {
nums[[num]] <- visualisation_matrix(x[[num]],
target = specs[specs$varname == num, "expression"],
reference = reference[[num]],
...
)
}
} else if (is.list(target)) {

# we have a list as at-values
facs <- target[sapply(x[names(target)], is.factor)]
nums <- target[sapply(x[names(target)], is.numeric)]
}
# Assemble the two

# Assemble the two - the goal is to have two named lists, where variable
# names are the names of the list-elements: one list contains elements of
# numeric variables, the other one factors.
targets <- expand.grid(c(nums, facs))

# Preserve range ---------------------------------------------------------
Expand Down Expand Up @@ -160,6 +181,14 @@ visualisation_matrix.data.frame <- function(x, at = "all", target = NULL, factor
# Reset row names
row.names(targets) <- NULL

# convert factors back to numeric, if these variables were actually
# numeric in the original data
if (!is.null(numeric_factors) && length(numeric_factors)) {
for (i in numeric_factors) {
targets[[i]] <- .factor_to_numeric(targets[[i]])
}
}

# Attributes
attr(targets, "adjusted_for") <- ifelse(length(rest_vars) >= 1, rest_vars, NA)
attr(targets, "at_specs") <- specs
Expand Down
94 changes: 40 additions & 54 deletions R/visualisation_matrix.models.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,29 +3,21 @@
# -------------------------------------------------------------------------

#' @export
visualisation_matrix.glm <- function(x,
at = "all",
factors = "reference",
numerics = "mean",
preserve_range = TRUE,
reference = x,
include_smooth = TRUE,
include_random = FALSE,
include_response = FALSE,
...) {
visualisation_matrix.default <- function(x,
at = "all",
factors = "reference",
numerics = "mean",
preserve_range = TRUE,
reference = x,
include_smooth = TRUE,
include_random = FALSE,
include_response = FALSE,
data = NULL,
...) {
# Retrieve data from model
data <- insight::get_data(x)[insight::find_variables(x, "all", flatten = TRUE)]

# Deal with factor transformations
# f <- insight::find_terms(model)
data[] <- lapply(data, function(i) {
if (isTRUE(attributes(i)$factor)) {
as.factor(i)
} else {
i
}
})

if (is.null(data)) {
data <- insight::get_data(x)[insight::find_variables(x, "all", flatten = TRUE)]
}

# Deal with intercept-only models
if (include_response == FALSE) {
Expand Down Expand Up @@ -76,38 +68,6 @@ visualisation_matrix.glm <- function(x,



#' @export
visualisation_matrix.lm <- visualisation_matrix.glm
#' @export
visualisation_matrix.brmsfit <- visualisation_matrix.glm
#' @export
visualisation_matrix.stanreg <- visualisation_matrix.glm
#' @export
visualisation_matrix.polr <- visualisation_matrix.glm
#' @export
visualisation_matrix.merMod <- visualisation_matrix.glm
#' @export
visualisation_matrix.lmerMod <- visualisation_matrix.glm
#' @export
visualisation_matrix.glmerMod <- visualisation_matrix.glm
#' @export
visualisation_matrix.glmmTMB <- visualisation_matrix.glm
#' @export
visualisation_matrix.MixMod <- visualisation_matrix.glm
#' @export
visualisation_matrix.svyglm <- visualisation_matrix.glm
#' @export
visualisation_matrix.hurdle <- visualisation_matrix.glm
#' @export
visualisation_matrix.zeroinfl <- visualisation_matrix.glm
#' @export
visualisation_matrix.ivreg <- visualisation_matrix.glm
#' @export
visualisation_matrix.gamm <- visualisation_matrix.glm
#' @export
visualisation_matrix.list <- visualisation_matrix.glm # list is gamm4



# -------------------------------------------------------------------------
# Below are visualisation_matrix functions that work on visualisation_matrix
Expand All @@ -123,3 +83,29 @@ visualisation_matrix.visualisation_matrix <- function(x, reference = attributes(

grid
}



# helpers -------------
.factor_to_numeric <- function(x, lowest = NULL)
{
if (is.numeric(x)) {
return(x)
}
if (is.logical(x)) {
return(as.numeric(x))
}
if (anyNA(suppressWarnings(as.numeric(as.character(stats::na.omit(x)))))) {
if (is.character(x)) {
x <- as.factor(x)
}
x <- droplevels(x)
levels(x) <- 1:nlevels(x)
}
out <- as.numeric(as.character(x))
if (!is.null(lowest)) {
difference <- min(out) - lowest
out <- out - difference
}
out
}
5 changes: 4 additions & 1 deletion man/visualisation_matrix.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 90a5454

Please sign in to comment.