...
 
Commits (6)
......@@ -2,8 +2,8 @@ Package: sjPlot
Type: Package
Encoding: UTF-8
Title: Data Visualization for Statistics in Social Science
Version: 2.6.0
Date: 2018-08-23
Version: 2.6.1
Date: 2018-10-14
Authors@R: c(
person("Daniel", "Lüdecke", email = "d.luedecke@uke.de", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-8895-3206")),
person("Carsten", "Schwemmer", email = "carsten.schwemmer@uni-bamberg.de", role = "ctb")
......@@ -20,9 +20,9 @@ Description: Collection of plotting and table output functions for data
License: GPL-3
Depends: R (>= 3.2), graphics, grDevices, stats, utils
Imports: broom (>= 0.4.5), dplyr (>= 0.7.5), forcats, ggeffects (>=
0.5.0), glmmTMB, ggplot2 (>= 2.2.1), knitr, lme4 (>= 1.1-12),
0.6.0), glmmTMB, ggplot2 (>= 2.2.1), knitr, lme4 (>= 1.1-12),
magrittr, MASS, modelr, nlme, psych, purrr, rlang, scales,
sjlabelled (>= 1.0.13), sjmisc (>= 2.7.4), sjstats (>= 0.17.0),
sjlabelled (>= 1.0.14), sjmisc (>= 2.7.5), sjstats (>= 0.17.1),
tidyr (>= 0.7.0)
Suggests: AICcmodavg, brms, car, cluster, GPArotation, gridExtra,
ggrepel, ggridges, pscl, rstanarm, survey, TMB, Zelig, testthat
......@@ -31,8 +31,8 @@ BugReports: https://github.com/strengejacke/sjPlot/issues
RoxygenNote: 6.1.0
VignetteBuilder: knitr
NeedsCompilation: no
Packaged: 2018-08-23 16:17:25 UTC; Daniel
Packaged: 2018-10-14 20:28:49 UTC; Daniel
Author: Daniel Lüdecke [aut, cre] (<https://orcid.org/0000-0002-8895-3206>),
Carsten Schwemmer [ctb]
Repository: CRAN
Date/Publication: 2018-08-23 16:50:03 UTC
Date/Publication: 2018-10-14 21:50:03 UTC
This diff is collapsed.
......@@ -50,26 +50,16 @@ export(sjp.chi2)
export(sjp.corr)
export(sjp.fa)
export(sjp.frq)
export(sjp.glm)
export(sjp.glmer)
export(sjp.gpt)
export(sjp.grpfrq)
export(sjp.int)
export(sjp.kfold_cv)
export(sjp.likert)
export(sjp.lm)
export(sjp.lmer)
export(sjp.pca)
export(sjp.poly)
export(sjp.resid)
export(sjp.scatter)
export(sjp.stackfrq)
export(sjp.xtab)
export(sjplot)
export(sjplot_pal)
export(sjt.corr)
export(sjt.fa)
export(sjt.frq)
export(sjt.glm)
export(sjt.glmer)
export(sjt.itemanalysis)
......@@ -170,6 +160,7 @@ importFrom(sjlabelled,get_term_labels)
importFrom(sjlabelled,get_values)
importFrom(sjlabelled,set_labels)
importFrom(sjmisc,add_columns)
importFrom(sjmisc,add_variables)
importFrom(sjmisc,group_labels)
importFrom(sjmisc,group_var)
importFrom(sjmisc,is_empty)
......
# sjPlot 2.6.1
## General
* Removed defunct functions.
## Deprecated
* `sjt.lm()`, `sjt.glm()`, `sjt.lmer()` and `sjt.glmer()` are now deprecated. Please use `tab_model()` instead.
## Changes to functions
* Arguments `dot.size` and `line.size` in `plot_model()` now also apply to marginal effects and diagnostic plots.
* `plot_model()` now uses a free x-axis scale in facets for models with zero-inflated part.
* `plot_model()` now shows multiple plots for models with zero-inflated parts when `grids = FALSE`.
* `tab_model()` gets a `p.style` and `p.threshold` argument to indicate significance levels as asteriks, and to determine the threshold for which an estimate is considered as significant.
* `plot_model()` and `plot_models()` get a `p.threshold` argument to determine the threshold for which an estimate is considered as significant.
## Bug fixes
* Fixed bug from the last update that made value labels disappear for `plot_likert()`.
* `tab_model()` now also accepts multiple model-objects stored in a `list` as argument, as stated in the help-file.
* The `file`-argument now works again in `sjt.itemanalysis()`.
* Argument `show.ci` in `tab_model()` did not compute confidence intervals for different levels.
# sjPlot 2.6.0
## General
......
#' @title Deprecated functions
#' @name sjp.glmer
#'
#' @description A list of deprecated functions.
#'
#' @param ... Not used.
#' @return Nothing.
#'
#' @export
sjp.glmer <- function(...) {
.Defunct("plot_model", package = "sjPlot", msg = "`sjp.glmer()` is defunct. Please use `plot_model()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.glm <- function(...) {
.Defunct("plot_model", package = "sjPlot", msg = "`sjp.glm()` is defunct. Please use `plot_model()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.lmer <- function(...) {
.Defunct("plot_model", package = "sjPlot", msg = "`sjp.lmer()` is defunct. Please use `plot_model()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.lm <- function(...) {
.Defunct("plot_model", package = "sjPlot", msg = "`sjp.lm()` is defunct. Please use `plot_model()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.int <- function(...) {
.Defunct("plot_model", package = "sjPlot", msg = "`sjp.int()` is defunct. Please use `plot_model()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjt.frq <- function(...) {
.Defunct("frq", package = "sjmisc", msg = "`sjt.frq()` is defunct. Please use `sjmisc::frq()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.scatter <- function(...) {
.Defunct("plot_scatter", package = "sjPlot", msg = "`sjp.scatter()` is defunct. Please use `plot_scatter()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.resid <- function(...) {
.Defunct("plot_residuals", package = "sjPlot", msg = "`sjp.resid()` is defunct. Please use `plot_residuals()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.likert <- function(...) {
.Defunct("plot_likert", package = "sjPlot", msg = "`sjp.likert()` is defunct. Please use `plot_likert()` instead.")
}
#' @rdname sjp.glmer
#' @export
sjp.gpt <- function(...) {
.Defunct("plot_gpt", package = "sjPlot", msg = "`sjp.gpt()` is defunct. Please use `plot_gpt()` instead.")
}
......@@ -261,6 +261,7 @@ tab_model_df <- function(x,
aic.list,
n.models,
title = NULL,
footnote = NULL,
col.header = NULL,
show.re.var = FALSE,
show.icc = FALSE,
......@@ -676,6 +677,15 @@ tab_model_df <- function(x,
## TODO add bottom table border
# add optional "footnote" row ----
if (!is.null(footnote)) {
page.content <- paste0(page.content, " <tr>\n")
page.content <- paste0(page.content, sprintf(" <td colspan=\"%i\" class=\"footnote\">%s</td>\n", ncol(x), footnote))
page.content <- paste0(page.content, "</tr>\n")
}
# add table-caption ----
if (!is.null(title))
......
plot_diag_linear <- function(model,
geom.colors,
dot.size,
line.size,
...) {
plot.list <- list()
geom.colors <- col_check2(geom.colors, 2)
......@@ -8,7 +9,7 @@ plot_diag_linear <- function(model,
p <- diag_vif(model)
if (!is.null(p)) plot.list[[length(plot.list) + 1]] <- p
p <- diag_qq(model, geom.colors)
p <- diag_qq(model, geom.colors, dot.size, line.size)
if (!is.null(p)) plot.list[[length(plot.list) + 1]] <- p
p <- diag_reqq(model, dot.size)
......@@ -17,21 +18,25 @@ plot_diag_linear <- function(model,
p <- diag_norm(model, geom.colors)
if (!is.null(p)) plot.list[[length(plot.list) + 1]] <- p
p <- diag_ncv(model)
p <- diag_ncv(model, dot.size, line.size)
if (!is.null(p)) plot.list[[length(plot.list) + 1]] <- p
plot.list
}
plot_diag_glm <- function(model, geom.colors, dot.size, ...) {
plot_diag_glm <- function(model, geom.colors, dot.size, line.size, ...) {
geom.colors <- col_check2(geom.colors, 2)
diag_reqq(model, dot.size)
}
#' @importFrom stats residuals fitted
diag_ncv <- function(model) {
diag_ncv <- function(model, dot.size, line.size) {
if (is.null(dot.size)) dot.size <- 1
if (is.null(line.size)) line.size <- 1
dat <- data.frame(
res = stats::residuals(model),
fitted = stats::fitted(model)
......@@ -39,8 +44,8 @@ diag_ncv <- function(model) {
ggplot(dat, aes_string(x = "fitted", y = "res")) +
geom_intercept_line2(0, NULL) +
geom_point() +
geom_smooth(method = "loess", se = FALSE) +
geom_point(size = dot.size) +
geom_smooth(method = "loess", se = FALSE, size = line.size) +
labs(
x = "Fitted values",
y = "Residuals",
......@@ -76,7 +81,11 @@ diag_norm <- function(model, geom.colors) {
#' @importFrom stats residuals rstudent fitted
diag_qq <- function(model, geom.colors, ...) {
diag_qq <- function(model, geom.colors, dot.size, line.size, ...) {
if (is.null(dot.size)) dot.size <- 1
if (is.null(line.size)) line.size <- 1
# qq-plot of studentized residuals
if (inherits(model, c("lme", "lmerMod", "glmmTMB"))) {
res_ <- sort(stats::residuals(model), na.last = NA)
......@@ -94,9 +103,9 @@ diag_qq <- function(model, geom.colors, ...) {
# plot it
ggplot(mydf, aes_string(x = "x", y = "y")) +
geom_point() +
geom_point(size = dot.size) +
scale_colour_manual(values = geom.colors) +
stat_smooth(method = "lm", se = FALSE) +
stat_smooth(method = "lm", se = FALSE, size = line.size) +
labs(
title = "Non-normality of residuals and outliers",
subtitle = "Dots should be plotted along the line",
......
#' @importFrom stats update
#' @importFrom dplyr bind_rows select mutate
#' @importFrom tidyr gather
plot_diag_stan <- function(model, geom.colors, axis.lim, facets, ...) {
plot_diag_stan <- function(model, geom.colors, axis.lim, facets, axis.labels, ...) {
# check some defaults
if (missing(facets)) facets <- TRUE
......@@ -105,10 +105,16 @@ plot_diag_stan <- function(model, geom.colors, axis.lim, facets, ...) {
ggridges::geom_density_ridges2(alpha = alpha, rel_min_height = .005, scale = scale) +
scale_fill_manual(values = col_check2(geom.colors, 2))
} else {
p <- ggplot(pp, aes_string(x = "Estimate", fill = "Sample")) +
geom_density(alpha = alpha) +
facet_wrap(~Term, scales = "free") +
scale_fill_manual(values = col_check2(geom.colors, 2))
if (!is.null(axis.labels) && !is.null(names(axis.labels))) {
p <- p + facet_wrap(~Term, scales = "free", labeller = labeller(.default = label_value, Term = axis.labels))
} else {
p <- p + facet_wrap(~Term, scales = "free")
}
}
......@@ -118,3 +124,4 @@ plot_diag_stan <- function(model, geom.colors, axis.lim, facets, ...) {
p + xlab("Distribution")
}
......@@ -25,7 +25,7 @@ utils::globalVariables("n")
#' @param axis.lim Numeric vector of length 2, defining the range of the plot axis.
#' Depending on plot type, may effect either x- or y-axis, or both.
#' For multiple plot outputs (e.g., from \code{type = "eff"} or
#' \code{type = "slope"} in \code{\link{sjp.glm}}), \code{axis.lim} may
#' \code{type = "slope"} in \code{\link{plot_model}}), \code{axis.lim} may
#' also be a list of vectors of length 2, defining axis limits for each
#' plot (only if non-faceted).
#' @param show.p Logical, adds significance levels to values, or value and
......
......@@ -560,7 +560,7 @@ plot_likert <- function(items,
)
) +
geom_text(
data = dplyr::filter(mydat.pos, .data$frq < 0),
data = dplyr::filter(mydat.neg, .data$frq < 0),
aes(
x = .data$x,
y = .data$ypos,
......
......@@ -216,6 +216,9 @@
#' }
#' @param grid Logical, if \code{TRUE}, multiple plots are plotted as grid
#' layout.
#' @param p.threshold Numeric vector of length 3, indicating the treshold for
#' annotating p-values with asterisks. Only applies if
#' \code{p.style = "asterisk"}.
#' @param wrap.title Numeric, determines how many chars of the plot title are
#' displayed in one line and when a line break is inserted.
#' @param wrap.labels Numeric, determines how many chars of the value, variable
......@@ -376,7 +379,7 @@
#' plot_model(m, type = "re")
#'
#' # plot marginal effects
#' plot_model(m, type = "eff", terms = "Days")
#' plot_model(m, type = "pred", terms = "Days")
#'
#' # plot interactions
#' \dontrun{
......@@ -448,6 +451,7 @@ plot_model <- function(model,
dot.size = NULL,
line.size = NULL,
vline.color = NULL,
p.threshold = c(0.05, 0.01, 0.001),
grid,
case,
auto.label = TRUE,
......@@ -480,9 +484,6 @@ plot_model <- function(model,
# get info on model family
fam.info <- sjstats::model_family(model)
## TODO remove once sjstats was updated to >= 0.17.1
if (sjmisc::is_empty(fam.info$is_linear)) fam.info$is_linear <- FALSE
# check whether estimates should be transformed or not
if (missing(transform)) {
......@@ -501,7 +502,7 @@ plot_model <- function(model,
if (type %in% c("est", "std", "std2") && isTRUE(auto.label)) {
# get labels of dependent variables, and wrap them if too long
if (is.null(title)) title <- sjlabelled::get_dv_labels(model, case = case, multi.resp = fam.info$is_multivariate, ...)
if (is.null(title)) title <- sjlabelled::get_dv_labels(model, case = case, mv = fam.info$is_multivariate, ...)
title <- sjmisc::word_wrap(title, wrap = wrap.title)
# labels for axis with term names
......@@ -509,7 +510,7 @@ plot_model <- function(model,
axis.labels <- sjmisc::word_wrap(axis.labels, wrap = wrap.labels)
# title for axis with estimate values
if (is.null(axis.title)) axis.title <- sjmisc::word_wrap(estimate_axis_title(model, axis.title, type, transform), wrap = wrap.title)
if (is.null(axis.title)) axis.title <- sjmisc::word_wrap(estimate_axis_title(fit = model, axis.title = axis.title, type = type, transform = transform, include.zeroinf = TRUE), wrap = wrap.title)
axis.title <- sjmisc::word_wrap(axis.title, wrap = wrap.labels)
}
......@@ -581,6 +582,7 @@ plot_model <- function(model,
bpe.color = bpe.color,
facets = grid,
show.zeroinf = show.zeroinf,
p.threshold = p.threshold,
...
)
......@@ -693,6 +695,7 @@ plot_model <- function(model,
geom.colors = colors,
axis.lim = axis.lim,
facets = grid,
axis.labels = axis.labels,
...
)
......@@ -702,6 +705,7 @@ plot_model <- function(model,
model = model,
geom.colors = colors,
dot.size = dot.size,
line.size = line.size,
...
)
......@@ -711,6 +715,7 @@ plot_model <- function(model,
model = model,
geom.colors = colors,
dot.size = dot.size,
line.size = line.size,
...
)
......
......@@ -2,6 +2,7 @@
#' @importFrom forcats fct_reorder fct_rev
#' @importFrom rlang .data
#' @importFrom sjmisc remove_var
#' @importFrom purrr pmap
plot_model_estimates <- function(model,
dat,
tf,
......@@ -29,6 +30,7 @@ plot_model_estimates <- function(model,
vline.color,
value.size,
facets,
p.threshold,
...) {
# remove intercept(s) from output
......@@ -97,7 +99,7 @@ plot_model_estimates <- function(model,
# add p-asterisks to data
dat$p.stars <- get_p_stars(dat$p.value)
dat$p.stars <- get_p_stars(dat$p.value, p.threshold)
dat$p.label <- sprintf("%.*f", digits, dat$estimate)
if (show.p) dat$p.label <- sprintf("%s %s", dat$p.label, dat$p.stars)
......@@ -228,27 +230,64 @@ plot_model_estimates <- function(model,
)
} else {
plot_point_estimates(
model = model,
dat = dat,
tf = tf,
title = title,
axis.labels = axis.labels,
axis.title = axis.title,
axis.lim = axis.lim,
grid.breaks = grid.breaks,
show.values = show.values,
value.offset = value.offset,
geom.size = geom.size,
line.size = line.size,
geom.colors = geom.colors,
bpe.style = bpe.style,
bpe.color = bpe.color,
vline.color = vline.color,
value.size = value.size,
facets = facets,
...
)
if (obj_has_name(dat, "wrap.facet") && dplyr::n_distinct(dat$wrap.facet, na.rm = TRUE) > 1 && !facets) {
dat <- purrr::map(split(dat, f = dat$wrap.facet), ~ sjmisc::remove_var(.x, "wrap.facet"))
if (length(axis.title) == 1) axis.title <- c(axis.title, "Odds Ratios")
purrr::pmap(list(dat, axis.title, names(dat)), function(.x, .y, .z) {
plot_point_estimates(
model = model,
dat = .x,
tf = tf,
title = paste0(title, " (", .z, ")"),
axis.labels = axis.labels,
axis.title = .y,
axis.lim = NULL,
grid.breaks = NULL,
show.values = show.values,
value.offset = value.offset,
geom.size = geom.size,
line.size = line.size,
geom.colors = geom.colors,
bpe.style = bpe.style,
bpe.color = bpe.color,
vline.color = vline.color,
value.size = value.size,
facets = facets,
...
)
})
} else {
plot_point_estimates(
model = model,
dat = dat,
tf = tf,
title = title,
axis.labels = axis.labels,
axis.title = axis.title,
axis.lim = axis.lim,
grid.breaks = grid.breaks,
show.values = show.values,
value.offset = value.offset,
geom.size = geom.size,
line.size = line.size,
geom.colors = geom.colors,
bpe.style = bpe.style,
bpe.color = bpe.color,
vline.color = vline.color,
value.size = value.size,
facets = facets,
...
)
}
}
}
......@@ -26,8 +26,6 @@
#' is \code{FALSE}.
#'
#' @inheritParams plot_model
#' @inheritParams sjp.lm
#' @inheritParams sjp.lmer
#' @inheritParams sjt.lm
#' @inheritParams sjp.grpfrq
#'
......@@ -79,7 +77,7 @@
#' @importFrom sjstats std_beta p_value model_family
#' @importFrom sjlabelled get_dv_labels get_term_labels
#' @importFrom rlang .data
#' @importFrom sjmisc word_wrap var_rename
#' @importFrom sjmisc word_wrap var_rename add_variables
#' @export
plot_models <- function(...,
transform,
......@@ -104,7 +102,7 @@ plot_models <- function(...,
show.intercept = FALSE,
show.p = TRUE,
p.shape = FALSE,
ci.lvl = .95,
p.threshold = c(0.05, 0.01, 0.001), ci.lvl = .95,
vline.color = NULL,
digits = 2,
grid = FALSE,
......@@ -122,10 +120,6 @@ plot_models <- function(...,
# get info on model family
fam.info <- sjstats::model_family(input_list[[1]])
## TODO remove once sjstats was updated to >= 0.17.1
if (sjmisc::is_empty(fam.info$is_linear)) fam.info$is_linear <- FALSE
# check whether estimates should be transformed or not
if (missing(transform)) {
......@@ -152,7 +146,7 @@ plot_models <- function(...,
fl <- input_list %>%
purrr::map(~ sjstats::std_beta(.x, type = std.est)) %>%
purrr::map(~ sjmisc::var_rename(.x, std.estimate = "estimate")) %>%
purrr::map2(input_list, ~ add_cols(
purrr::map2(input_list, ~ sjmisc::add_variables(
.x, p.value = sjstats::p_value(.y)[["p.value"]][-1]
))
......@@ -204,7 +198,7 @@ plot_models <- function(...,
# add grouping index
for (i in 1:length(fl)) fl[[i]] <- add_cols(fl[[i]], group = as.character(i), .after = Inf)
for (i in 1:length(fl)) fl[[i]] <- sjmisc::add_variables(fl[[i]], group = as.character(i), .after = Inf)
# merge models to one data frame
ff <- dplyr::bind_rows(fl)
......@@ -240,7 +234,7 @@ plot_models <- function(...,
# add p-asterisks to data
ff$p.stars <- get_p_stars(ff$p.value)
ff$p.stars <- get_p_stars(ff$p.value, p.threshold)
ff$p.label <- sprintf("%.*f", digits, ff$estimate)
if (show.p) ff$p.label <- sprintf("%s %s", ff$p.label, ff$p.stars)
......
......@@ -160,19 +160,33 @@ plot_point_estimates <- function(model,
# we need transformed scale for exponentiated estimates
has_zeroinf <- (obj_has_name(dat, "wrap.facet") && dplyr::n_distinct(dat$wrap.facet, na.rm = TRUE) > 1)
if (isTRUE(tf == "exp")) {
p <- p + scale_y_continuous(
trans = "log10",
limits = axis.scaling$axis.lim,
breaks = axis.scaling$ticks,
labels = prettyNum
)
if (has_zeroinf) {
p <- p + scale_y_continuous(trans = "log10")
} else {
p <- p + scale_y_continuous(
trans = "log10",
limits = axis.scaling$axis.lim,
breaks = axis.scaling$ticks,
labels = prettyNum
)
}
} else {
p <- p + scale_y_continuous(
limits = axis.scaling$axis.lim,
breaks = axis.scaling$ticks,
labels = axis.scaling$ticks
)
if (has_zeroinf) {
} else {
p <- p + scale_y_continuous(
limits = axis.scaling$axis.lim,
breaks = axis.scaling$ticks,
labels = axis.scaling$ticks
)
}
}
......@@ -188,13 +202,15 @@ plot_point_estimates <- function(model,
if (obj_has_name(dat, "facet") && dplyr::n_distinct(dat$facet, na.rm = TRUE) > 1)
p <- p +
facet_grid(~facet)
else if (obj_has_name(dat, "wrap.facet") && dplyr::n_distinct(dat$wrap.facet, na.rm = TRUE) > 1)
else if (has_zeroinf)
p <- p +
facet_wrap(~wrap.facet, ncol = 1)
facet_wrap(~wrap.facet, ncol = 1, scales = "free_x")
# set axis and plot titles
if (length(axis.title) > 1) axis.title <- axis.title[1]
p <-
p + labs(
x = NULL,
......
......@@ -32,7 +32,6 @@
#'
#' @inheritParams plot_model
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.lm
#'
#' @examples
#' # load sample date
......
......@@ -36,6 +36,9 @@ plot_type_eff <- function(type,
)
}
if (is.null(dat)) return(NULL)
# evaluate dots-arguments
alpha <- .15
dodge <- .1
......@@ -66,12 +69,9 @@ plot_type_eff <- function(type,
dot.alpha = dot.alpha,
alpha = alpha,
dodge = dodge,
log.y = log.y
## TODO activate once ggeffects-update is on CRAN
# dot.size = dot.size,
# line.size = line.size
log.y = log.y,
dot.size = dot.size,
line.size = line.size
)
# set axis and plot titles
......
#' @importFrom broom tidy
#' @importFrom sjstats robust
#' @importFrom sjmisc add_variables
plot_type_est <- function(type,
ci.lvl,
se,
......@@ -30,6 +31,7 @@ plot_type_est <- function(type,
bpe.color,
facets,
show.zeroinf,
p.threshold,
...) {
if (missing(facets)) facets <- TRUE
......@@ -41,7 +43,7 @@ plot_type_est <- function(type,
} else {
dat <- model %>%
sjstats::std_beta(type = type, ci.lvl = ci.lvl) %>%
add_cols(p.value = sjstats::p_value(model)[["p.value"]][-1]) %>%
sjmisc::add_variables(p.value = sjstats::p_value(model)[["p.value"]][-1]) %>%
sjmisc::var_rename(std.estimate = "estimate")
show.intercept <- FALSE
......@@ -119,6 +121,7 @@ plot_type_est <- function(type,
vline.color = vline.color,
value.size = value.size,
facets = facets,
p.threshold = p.threshold,
...
)
}
......@@ -153,12 +153,9 @@ plot_type_int <- function(model,
dot.alpha = dot.alpha,
alpha = alpha,
dodge = dodge,
log.y = log.y
## TODO activate once ggeffects-update is on CRAN
# dot.size = dot.size,
# line.size = line.size
log.y = log.y,
dot.size = dot.size,
line.size = line.size
)
# set axis and plot titles
......
......@@ -35,34 +35,6 @@ obj_has_rownames <- function(x) {
!identical(as.character(1:nrow(x)), rownames(x))
}
#' @importFrom dplyr select
add_cols <- function(data, ..., .after = 1, .before = NULL) {
if (is.character(.after))
.after <- which(colnames(data) == .after)
if (!is.null(.before) && is.character(.before))
.after <- which(colnames(data) == .before) - 1
if (!is.null(.before) && is.numeric(.before))
.after <- .before - 1
dat <- data.frame(..., stringsAsFactors = FALSE)
if (.after < 1) {
cbind(dat, data)
} else if (is.infinite(.after)) {
cbind(data, dat)
} else {
c1 <- 1:.after
c2 <- (.after + 1):ncol(data)
x1 <- dplyr::select(data, !! c1)
x2 <- dplyr::select(data, !! c2)
cbind(x1, dat, x2)
}
}
#' @importFrom dplyr select
add_cases <- function(data, ..., .after = -1, .before = NULL) {
......
......@@ -36,7 +36,6 @@
#' @inheritParams sjp.pca
#' @inheritParams sjt.pca
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.glmer
#'
#' @note This method for factor analysis relies on the functions
#' \code{\link[psych]{fa}} and \code{\link[psych]{fa.parallel}}
......
......@@ -52,8 +52,6 @@ utils::globalVariables("density")
#' \code{\link[ggplot2]{labs}}, e.g.: \code{$plot.list[[1]] + labs(x = ...)}
#'
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.lm
#' @inheritParams sjp.glmer
#'
#' @return A ggplot-object.
#'
......
......@@ -25,7 +25,6 @@
#' }
#'
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.glmer
#' @inheritParams sjt.pca
#'
#' @examples
......
......@@ -26,8 +26,6 @@
#' @inheritParams tab_model
#' @inheritParams sjt.xtab
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.glmer
#' @inheritParams sjp.lm
#' @inheritParams sjp.corr
#'
#' @return Invisibly returns
......
......@@ -285,7 +285,8 @@ sjt.itemanalysis <- function(df,
use.viewer = TRUE,
encoding = encoding,
show.footnote = TRUE,
footnotes = footns
footnotes = footns,
file = file
)
html2 <- NULL
......
......@@ -110,7 +110,6 @@
#' @inheritParams tab_model
#' @inheritParams plot_model
#' @inheritParams sjt.xtab
#' @inheritParams sjp.lmer
#' @inheritParams sjp.corr
#'
#' @return Invisibly returns
......@@ -186,11 +185,7 @@ sjt.lm <- function(...,
else
p_zero <- "0"
if (stats::runif(1) < .35)
message("`sjt.lm()` and `sjt.lmer()` will become deprecated in the future. Please use `tab_model()` instead.")
## TODO activate in future update
# .Deprecated("tab_model")
.Deprecated("tab_model")
# -------------------------------------
# check arguments
......@@ -306,7 +301,7 @@ sjt.lm <- function(...,
# check for p-value colum
# -------------------------------------
if (!sjmisc::str_contains(colnames(fit.df), "p.value")) {
fit.df <- add_cols(
fit.df <- sjmisc::add_variables(
fit.df,
p.value = sjstats::p_value(input_list[[i]], p.kr)[["p.value"]],
.before = "conf.low"
......
......@@ -108,11 +108,7 @@ sjt.glm <- function(...,
use.viewer = TRUE,
remove.spaces = TRUE) {
if (stats::runif(1) < .35)
message("`sjt.glm()` and `sjt.glmer()` will become deprecated in the future. Please use `tab_model()` instead.")
## TODO activate in future update
# .Deprecated("tab_model")
.Deprecated("tab_model")
# --------------------------------------------------------
......
......@@ -48,7 +48,6 @@
#' to label variable values in the output.
#'
#' @inheritParams tab_model
#' @inheritParams sjp.glmer
#' @inheritParams sjp.grpfrq
#'
#' @return Invisibly returns
......
......@@ -27,7 +27,6 @@
#'
#' @inheritParams tab_df
#' @inheritParams sjt.itemanalysis
#' @inheritParams sjp.glmer
#' @inheritParams sjt.xtab
#' @inheritParams sjp.grpfrq
#' @inheritParams sjp.stackfrq
......
......@@ -122,6 +122,9 @@
#' with Kenward-Roger approximation for the degrees of freedom, using the
#' \pkg{pbkrtest}-package. In this case, use \code{show.df = TRUE} to show
#' the approximated degrees of freedom for each coefficient.
#' @param p.style Character, indicating if p-values should be printed as
#' numeric value (\code{"numeric"}) or as asterisks (\code{"asterisk"}).
#' May be abbreviated.
#' @param CSS A \code{\link{list}} with user-defined style-sheet-definitions,
#' according to the \href{http://www.w3.org/Style/CSS/}{official CSS syntax}.
#' See 'Details' or \href{../doc/table_css.html}{this package-vignette}.
......@@ -149,7 +152,10 @@
#' or opened with the default web browser. Displaying resp. opening a temporary file is the
#' default behaviour (i.e. \code{file = NULL}).
#' \cr \cr
#' Examples are shown in \href{../doc/tab_model_estimates.html}{this package-vignette}.
#' Examples are shown in these three vignettes:
#' \href{../doc/tab_model_estimates.html}{Summary of Regression Models as HTML Table},
#' \href{../doc/tab_mixed.html}{Summary of Mixed Models as HTML Table} and
#' \href{../doc/tab_bayes.html}{Summary of Bayesian Models as HTML Table}.
#'
#' @details \strong{Standardized Estimates}
#' \cr \cr
......@@ -263,6 +269,8 @@ tab_model <- function(
digits.p = 3,
emph.p = TRUE,
p.val = c("wald", "kr"),
p.style = c("numeric", "asterisk"),
p.threshold = c(0.05, 0.01, 0.001),
case = "parsed",
auto.label = TRUE,
......@@ -273,9 +281,20 @@ tab_model <- function(
) {
p.val <- match.arg(p.val)
p.style <- match.arg(p.style)
if (p.style == "asterisk") show.p <- FALSE
models <- list(...)
names(models) <- unlist(lapply(match.call(expand.dots = F)$`...`, deparse))
if (length(class(models[[1]]) == 1) && class(models[[1]]) == "list")
models <- lapply(models[[1]], function(x) x)
names(models) <- unlist(lapply(
match.call(expand.dots = F)$`...`,
function(.x) deparse(.x, width.cutoff = 500L))
)
auto.transform <- missing(transform)
ci.lvl <- ifelse(is.null(show.ci), .95, show.ci)
......@@ -310,10 +329,6 @@ tab_model <- function(
# get info on model family
fam.info <- sjstats::model_family(model)
## TODO remove once sjstats was updated to >= 0.17.1
if (sjmisc::is_empty(fam.info$is_linear)) fam.info$is_linear <- FALSE
# check whether estimates should be transformed or not
if (auto.transform) {
......@@ -361,6 +376,7 @@ tab_model <- function(
)) %>%
dplyr::select(-.data$conf.low, -.data$conf.high) %>%
dplyr::mutate(
p.stars = get_p_stars(.data$p.value, p.threshold),
p.sig = .data$p.value < .05,
p.value = sprintf("%.*f", digits.p, .data$p.value)
)
......@@ -423,6 +439,18 @@ tab_model <- function(
}
# add asterisks to estimates ----
if (p.style == "asterisk") {
if (obj_has_name(dat, "estimate"))
dat$estimate <- sprintf("%.*f <sup>%s</sup>", digits, dat$estimate, dat$p.stars)
if (!show.est && obj_has_name(dat, "std.estimate"))
dat$std.estimate <- sprintf("%.*f <sup>%s</sup>", digits, dat$std.estimate, dat$p.stars)
}
dat <- dplyr::select(dat, -.data$p.stars)
# switch column for p-value and conf. int. ----
dat <- dat[, sort_columns(colnames(dat), is.stan(model), col.order)]
......@@ -545,7 +573,7 @@ tab_model <- function(
if ((show.icc || show.re.var) && is_mixed_model(model)) {
icc <- tryCatch(
sjstats::icc(model),
suppressWarnings(sjstats::icc(model)),
error = function(x) { NULL }
)
}
......@@ -660,7 +688,7 @@ tab_model <- function(
model.data <- split(model.data[[1]], model.data[[1]]["response.level_1"])
} else {
dv.labels <- sjmisc::word_wrap(
sjlabelled::get_dv_labels(models, multi.resp = TRUE, case = case),
sjlabelled::get_dv_labels(models, mv = TRUE, case = case),
wrap = wrap.labels,
linesep = "<br>"
)
......@@ -837,7 +865,8 @@ tab_model <- function(
axis.title = NULL,
type = "est",
transform = transform.data[[i]],
multi.resp = NULL
multi.resp = NULL,
include.zeroinf = FALSE
)
} else if (length(models) == 1) {
......@@ -853,7 +882,8 @@ tab_model <- function(
axis.title = NULL,
type = "est",
transform = transform.data[[1]],
multi.resp = mr
multi.resp = mr,
include.zeroinf = FALSE
)
} else {
......@@ -901,6 +931,18 @@ tab_model <- function(
x
})
if (p.style == "asterisk")
footnote <- sprintf(
"* p&lt;%s&nbsp;&nbsp;&nbsp;** p&lt;%s&nbsp;&nbsp;&nbsp;*** p&lt;%s",
format(p.threshold[1]),
format(p.threshold[2]),
format(p.threshold[3])
)
else
footnote <- NULL
tab_model_df(
x = dat,
zeroinf = zeroinf,
......@@ -920,7 +962,8 @@ tab_model <- function(
show.adj.icc = show.adj.icc,
CSS = CSS,
file = file,
use.viewer = use.viewer
use.viewer = use.viewer,
footnote = footnote
)
}
......@@ -952,7 +995,12 @@ sort_columns <- function(x, is.stan, col.order) {
if (col.order[1] != "term") col.order <- c("term", col.order)
if (!("wrap.facet" %in% col.order)) col.order <- c(col.order, "wrap.facet")
if (is.stan) col.order <- col.order[-which(col.order == "p.value")]
if (is.stan) {
pcol <- which(col.order == "p.value")
if (!sjmisc::is_empty(pcol))
col.order <- col.order[-pcol]
}
as.vector(stats::na.omit(match(col.order, x)))
}
......
......@@ -49,28 +49,21 @@ get_tidy_data <- function(model, ci.lvl, tf, type, bpe, facets, show.zeroinf, p.
#' @importFrom dplyr mutate
tidy_generic <- function(model, ci.lvl, facets, p.val) {
# check for multiple reponse levels
# compute ci, two-ways
if (inherits(stats::coef(summary(model)), "listof")) {
if (!is.null(ci.lvl) && !is.na(ci.lvl))
ci <- 1 - ((1 - ci.lvl) / 2)
else
ci <- .975
# compute ci, two-ways
if (!is.null(ci.lvl) && !is.na(ci.lvl))
ci <- 1 - ((1 - ci.lvl) / 2)
else
ci <- .975
# check for multiple reponse levels
if (inherits(stats::coef(summary(model)), "listof")) {
# get estimates, as data frame
dat <- broom::tidy(model, conf.int = FALSE, exponentiate = FALSE)
# add conf. int.
dat <- dat %>%
dplyr::mutate(
conf.low = .data$estimate - stats::qnorm(ci) * .data$std.error,
conf.high = .data$estimate + stats::qnorm(ci) * .data$std.error
)
# check whether each category should be printed in facets, or
# in a single graph (with dodged geoms)
......@@ -86,7 +79,7 @@ tidy_generic <- function(model, ci.lvl, facets, p.val) {
if (inherits(model, "lmerModLmerTest")) {
dat <- tidy_lmerModLmerTest(model, ci.lvl)
} else {
dat <- broom::tidy(model, conf.int = TRUE, conf.level = ci.lvl, effects = "fixed")
dat <- broom::tidy(model, conf.int = FALSE, effects = "fixed")
}
......@@ -105,9 +98,6 @@ tidy_generic <- function(model, ci.lvl, facets, p.val) {
dat$df <- round(attr(pv, "df.kr", exact = TRUE))
}
dat$conf.low <- dat$estimate - stats::qnorm(ci.lvl) * dat$std.error
dat$conf.high <- dat$estimate + stats::qnorm(ci.lvl) * dat$std.error
} else {
# see if we have p-values. if not, add them
......@@ -119,6 +109,14 @@ tidy_generic <- function(model, ci.lvl, facets, p.val) {
}
}
if (obj_has_name(dat, "std.error")) {
dat$conf.low <- dat$estimate - stats::qnorm(ci) * dat$std.error
dat$conf.high <- dat$estimate + stats::qnorm(ci) * dat$std.error
} else {
dat$conf.low <- NA
dat$conf.high <- NA
}
dat
}
......@@ -133,9 +131,6 @@ tidy_lmerModLmerTest <- function(model, ci.lvl) {
colnames(dat) <- c("term", "estimate", "std.error", "statistic")
dat$conf.low <- dat$estimate - stats::qnorm(ci.lvl) * dat$std.error
dat$conf.high <- dat$estimate + stats::qnorm(ci.lvl) * dat$std.error
dat
}
......@@ -411,7 +406,7 @@ tidy_stan_model <- function(model, ci.lvl, tf, type, bpe, show.zeroinf, facets,
if (length(string_starts_with("b_mu", x = dat$term)) == nrow(dat)) {
dat$term <- substr(dat$term, 5, max(nchar(dat$term)))
# create "response-level" variable
dat <- add_cols(dat, response.level = "", .before = 1)
dat <- sjmisc::add_variables(dat, response.level = "", .before = 1)
dat$response.level <- gsub("(.*)\\_(.*)", "\\1", dat$term)
dat$term <- gsub("(.*)\\_(.*)", "\\2", dat$term)
}
......@@ -438,7 +433,7 @@ tidy_stan_model <- function(model, ci.lvl, tf, type, bpe, show.zeroinf, facets,
# create "response-level" variable
dat <- add_cols(dat, response.level = "", .before = 1)
dat <- sjmisc::add_variables(dat, response.level = "", .before = 1)
# copy name of response into new character variable
# and remove response name from term name
......@@ -454,7 +449,7 @@ tidy_stan_model <- function(model, ci.lvl, tf, type, bpe, show.zeroinf, facets,
# check whether each category should be printed in facets, or
# in a single graph (with dodged geoms)
if (isTRUE(facets))
if (!missing(facets) && isTRUE(facets))
colnames(dat)[1] <- "facet"
else
colnames(dat)[1] <- "response.level"
......
......@@ -107,7 +107,7 @@ axis_limits_and_ticks <- function(axis.lim, min.val, max.val, grid.breaks, expon
#' @importFrom sjstats model_family
#' @importFrom dplyr case_when
estimate_axis_title <- function(fit, axis.title, type, transform = NULL, multi.resp = NULL) {
estimate_axis_title <- function(fit, axis.title, type, transform = NULL, multi.resp = NULL, include.zeroinf = FALSE) {
# no automatic title for effect-plots
if (type %in% c("eff", "pred", "int")) return(axis.title)
......@@ -120,10 +120,7 @@ estimate_axis_title <- function(fit, axis.title, type, transform = NULL, multi.r
else
fitfam <- sjstats::model_family(fit)
## TODO remove once sjstats was updated to >= 0.17.1
if (sjmisc::is_empty(fitfam$is_linear)) fitfam$is_linear <- FALSE
axis.title <- dplyr::case_when(
axis.title <- dplyr::case_when(
!is.null(transform) && transform == "plogis" ~ "Probabilities",
is.null(transform) && fitfam$is_bin ~ "Log-Odds",
is.null(transform) && fitfam$is_ordinal ~ "Log-Odds",
......@@ -136,6 +133,14 @@ estimate_axis_title <- function(fit, axis.title, type, transform = NULL, multi.r
fitfam$is_bin ~ "Odds Ratios",
TRUE ~ "Estimates"
)
if (fitfam$is_zeroinf && isTRUE(include.zeroinf)) {
if (is.null(transform))
axis.title <- c(axis.title, "Log-Odds")
else
axis.title <- c(axis.title, "Odds Ratios")
}
}
axis.title
......@@ -143,12 +148,15 @@ estimate_axis_title <- function(fit, axis.title, type, transform = NULL, multi.r
#' @importFrom dplyr case_when
get_p_stars <- function(pval) {
get_p_stars <- function(pval, thresholds = NULL) {
if (is.null(thresholds)) thresholds <- c(.05, .01, .001)
dplyr::case_when(
is.na(pval) ~ "",
pval < 0.001 ~ "***",
pval < 0.01 ~ "**",
pval < 0.05 ~ "*",
pval < thresholds[3] ~ "***",
pval < thresholds[2] ~ "**",
pval < thresholds[1] ~ "*",
TRUE ~ ""
)
}
......
No preview for this file type
No preview for this file type
r-cran-sjplot (2.6.1-1) unstable; urgency=medium
* New upstream version
* dh-update-R to update Build-Depends
* Lintian-override for documentation outside /usr/share/doc
-- Andreas Tille <tille@debian.org> Tue, 16 Oct 2018 08:29:33 +0200
r-cran-sjplot (2.6.0-1) unstable; urgency=medium
* Initial release (closes: #900007)
......
......@@ -7,26 +7,26 @@ Priority: optional
Build-Depends: debhelper (>= 11~),
dh-r,
r-base-dev,
r-cran-arm,
r-cran-broom,
r-cran-dplyr (>= 0.7.1),
r-cran-effects,
r-cran-dplyr (>= 0.7.5),
r-cran-forcats,
r-cran-ggeffects (>= 0.6.0),
r-cran-glmmtmb,
r-cran-ggplot2 (>= 2.2.1),
r-cran-knitr,
r-cran-lme4 (>= 1.1-12),
r-cran-magrittr,
r-cran-mass,
r-cran-modelr,
r-cran-nlme,
r-cran-psych,
r-cran-purrr,
r-cran-rlang,
r-cran-scales,
r-cran-tidyselect,
r-cran-tibble (>= 1.3.3),
r-cran-tidyr (>= 0.7.0),
r-cran-ggeffects,
r-cran-mertools
r-cran-sjlabelled (>= 1.0.14),
r-cran-sjmisc (>= 2.7.5),
r-cran-sjstats (>= 0.17.1),
r-cran-tidyr (>= 0.7.0)
Standards-Version: 4.2.1
Vcs-Browser: https://salsa.debian.org/r-pkg-team/r-cran-sjplot
Vcs-Git: https://salsa.debian.org/r-pkg-team/r-cran-sjplot.git
......@@ -36,7 +36,7 @@ Package: r-cran-sjplot
Architecture: all
Depends: ${R:Depends},
${misc:Depends}
Recommends: ${R:Recommends}
Recommends: ${R:Recommends},
r-cran-car
Suggests: ${R:Suggests}
Description: GNU R data visualization for statistics in social science
......
# The documentation is where it is expected by GNU R users
r-cran-sjplot: package-contains-documentation-outside-usr-share-doc usr/lib/R/site-library/*
This diff is collapsed.
This diff is collapsed.
......@@ -12,7 +12,7 @@
<meta name="author" content="Daniel Lüdecke" />
<meta name="date" content="2018-08-23" />
<meta name="date" content="2018-10-14" />
<title>Plotting Interaction Effects of Regression Models</title>
......@@ -70,7 +70,7 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
<h1 class="title toc-ignore">Plotting Interaction Effects of Regression Models</h1>
<h4 class="author"><em>Daniel Lüdecke</em></h4>
<h4 class="date"><em>2018-08-23</em></h4>
<h4 class="date"><em>2018-10-14</em></h4>
......
params <-
list(EVAL = TRUE)
## ----set-options, echo = FALSE------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", dev = "png", fig.width = 7, fig.height = 3.5, message = FALSE, warning = FALSE)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
message = FALSE,
dev = "png",
fig.width = 7,
fig.height = 3.5,
warning = FALSE,
eval = if (isTRUE(exists("params"))) params$EVAL else FALSE
)
options(width = 800, tibble.width = Inf)
## -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
......
......@@ -3,14 +3,28 @@ title: "Plotting Marginal Effects of Regression Models"
author: "Daniel Lüdecke"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
params:
EVAL: !r identical(Sys.getenv("NOT_CRAN"), "true")
---
<!--
vignette: >
%\VignetteIndexEntry{Plotting Marginal Effects of Regression Models}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
-->
```{r set-options, echo = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", dev = "png", fig.width = 7, fig.height = 3.5, message = FALSE, warning = FALSE)
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
message = FALSE,
dev = "png",
fig.width = 7,
fig.height = 3.5,
warning = FALSE,
eval = if (isTRUE(exists("params"))) params$EVAL else FALSE
)
options(width = 800, tibble.width = Inf)
```
......
......@@ -12,7 +12,7 @@
<meta name="author" content="Daniel Lüdecke" />
<meta name="date" content="2018-08-23" />
<meta name="date" content="2018-10-14" />
<title>Plotting Marginal Effects of Regression Models</title>
......@@ -70,10 +70,16 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
<h1 class="title toc-ignore">Plotting Marginal Effects of Regression Models</h1>
<h4 class="author"><em>Daniel Lüdecke</em></h4>
<h4 class="date"><em>2018-08-23</em></h4>
<h4 class="date"><em>2018-10-14</em></h4>
<!--
vignette: >
%\VignetteIndexEntry{Plotting Marginal Effects of Regression Models}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
-->
<p>This document describes how to plot marginal effects of various regression models, using the <code>plot_model()</code> function. <code>plot_model()</code> is a generic plot-function, which accepts many model-objects, like <code>lm</code>, <code>glm</code>, <code>lme</code>, <code>lmerMod</code> etc.</p>
<p><code>plot_model()</code> allows to create various plot tyes, which can be defined via the <code>type</code>-argument. The default is <code>type = &quot;fe&quot;</code>, which means that fixed effects (model coefficients) are plotted. To plot marginal effects, call <code>plot_model()</code> with:</p>
<ul>
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -12,7 +12,7 @@
<meta name="author" content="Daniel Lüdecke" />
<meta name="date" content="2018-08-23" />
<meta name="date" content="2018-10-14" />
<title>Item Analysis of a Scale or an Index</title>
......@@ -70,7 +70,7 @@ code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Inf
<h1 class="title toc-ignore">Item Analysis of a Scale or an Index</h1>
<h4 class="author"><em>Daniel Lüdecke</em></h4>
<h4 class="date"><em>2018-08-23</em></h4>
<h4 class="date"><em>2018-10-14</em></h4>