release 2.6.1 on CRAN, update website

strengejacke · Oct 15, 2018 · f65b455 · f65b455
1 parent 1dfcd76
commit f65b455
Show file tree

Hide file tree

Showing 162 changed files with 627 additions and 1,749 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,8 +2,8 @@ Package: sjPlot
 Type: Package
 Encoding: UTF-8
 Title: Data Visualization for Statistics in Social Science
-Version: 2.6.0.9000
-Date: 2018-08-24
+Version: 2.6.1
+Date: 2018-10-14
 Authors@R: c(
     person("Daniel", "Lüdecke", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-8895-3206")),
     person("Carsten", "Schwemmer", email = "[email protected]", role = "ctb")
@@ -28,7 +28,7 @@ Imports:
     broom (>= 0.4.5),
     dplyr (>= 0.7.5),
     forcats,
-    ggeffects (>= 0.5.0),
+    ggeffects (>= 0.6.0),
     glmmTMB,
     ggplot2 (>= 2.2.1),
     knitr,
@@ -41,9 +41,9 @@ Imports:
     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,

diff --git a/NAMESPACE b/NAMESPACE
@@ -160,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)

diff --git a/NEWS.md b/NEWS.md
@@ -12,12 +12,16 @@
 
 * 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
 

diff --git a/R/Deprecated.R b/R/Deprecated.R
diff --git a/R/html_print.R b/R/html_print.R
@@ -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))

diff --git a/R/plot_gpt.R b/R/plot_gpt.R
@@ -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{plot_model()}}), \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

diff --git a/R/plot_model.R b/R/plot_model.R
@@ -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)) {
@@ -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,
       ...
     )
 

diff --git a/R/plot_model_estimates.R b/R/plot_model_estimates.R
@@ -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,
+        ...
+      )
+
+    }
   }
 }
 
diff --git a/R/plot_models.R b/R/plot_models.R
@@ -77,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,
@@ -102,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,
@@ -120,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)) {
@@ -150,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]
       ))
 
@@ -202,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)
@@ -238,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)
 

diff --git a/R/plot_point_estimates.R b/R/plot_point_estimates.R
@@ -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, scales = "free_x")
 
 
   # set axis and plot titles
 
+  if (length(axis.title) > 1) axis.title <- axis.title[1]
+
   p <-
     p + labs(
       x = NULL,