Commit 4699195d authored by Andreas Tille's avatar Andreas Tille

Update upstream source from tag 'upstream/2.6.0'

Update to upstream version '2.6.0'
with Debian dir fe8b2ab7d0a0e2a0b925e269450fa40f548d7b5e
parents 22a298e5 2a19a5f9
......@@ -2,10 +2,10 @@ Package: sjPlot
Type: Package
Encoding: UTF-8
Title: Data Visualization for Statistics in Social Science
Version: 2.4.1
Date: 2018-02-05
Version: 2.6.0
Date: 2018-08-23
Authors@R: c(
person("Daniel", "Lüdecke", email = "d.luedecke@uke.de", role = c("aut", "cre")),
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")
)
Maintainer: Daniel Lüdecke <d.luedecke@uke.de>
......@@ -19,22 +19,20 @@ Description: Collection of plotting and table output functions for data
labelled data.
License: GPL-3
Depends: R (>= 3.2), graphics, grDevices, stats, utils
Imports: arm, broom (>= 0.4.2), dplyr (>= 0.7.1), effects, forcats,
ggeffects (>= 0.3.1), glmmTMB, ggplot2 (>= 2.2.1), knitr, lme4
(>= 1.1-12), magrittr, MASS, merTools (>= 0.3.0), modelr, nlme,
psych, purrr, rlang, scales, sjlabelled (>= 1.0.7), sjmisc (>=
2.6.3), sjstats (>= 0.14.0), tidyselect, tibble (>= 1.3.3),
Imports: broom (>= 0.4.5), dplyr (>= 0.7.5), forcats, ggeffects (>=
0.5.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),
tidyr (>= 0.7.0)
Suggests: AICcmodavg, car, cluster, GPArotation, gridExtra, ggrepel,
ggridges, lmerTest, lmtest, rstanarm, survey, viridis,
wesanderson, Zelig
URL: https://github.com/strengejacke/sjPlot
Suggests: AICcmodavg, brms, car, cluster, GPArotation, gridExtra,
ggrepel, ggridges, pscl, rstanarm, survey, TMB, Zelig, testthat
URL: https://strengejacke.github.io/sjPlot/
BugReports: https://github.com/strengejacke/sjPlot/issues
RoxygenNote: 6.0.1
RoxygenNote: 6.1.0
VignetteBuilder: knitr
NeedsCompilation: no
Packaged: 2018-02-05 16:45:04 UTC; Daniel
Author: Daniel Lüdecke [aut, cre],
Packaged: 2018-08-23 16:17:25 UTC; Daniel
Author: Daniel Lüdecke [aut, cre] (<https://orcid.org/0000-0002-8895-3206>),
Carsten Schwemmer [ctb]
Repository: CRAN
Date/Publication: 2018-02-05 16:57:18 UTC
Date/Publication: 2018-08-23 16:50:03 UTC
This diff is collapsed.
# Generated by roxygen2: do not edit by hand
S3method(knit_print,sjTable)
S3method(knit_print,sjt_descr)
S3method(knit_print,sjt_frq)
S3method(knit_print,sjt_grpdescr)
S3method(knit_print,sjt_grpmean)
S3method(knit_print,sjt_grpmeans)
S3method(knit_print,sjt_mwu)
S3method(knit_print,sjt_reliab)
S3method(print,sjTable)
S3method(print,sjt_descr)
S3method(print,sjt_equi_test)
S3method(print,sjt_frq)
S3method(print,sjt_grpdescr)
S3method(print,sjt_grpmean)
......@@ -10,6 +18,7 @@ S3method(print,sjt_grpmeans)
S3method(print,sjt_mwu)
S3method(print,sjt_reliab)
export("%>%")
export(css_theme)
export(dist_chisq)
export(dist_f)
export(dist_norm)
......@@ -18,11 +27,18 @@ export(font_size)
export(get_model_data)
export(label_angle)
export(legend_style)
export(plot_gpt)
export(plot_grid)
export(plot_likert)
export(plot_model)
export(plot_models)
export(plot_residuals)
export(plot_scatter)
export(save_plot)
export(scale_color_sjplot)
export(scale_fill_sjplot)
export(set_theme)
export(show_sjplot_pals)
export(sjc.cluster)
export(sjc.dend)
export(sjc.elbow)
......@@ -50,23 +66,22 @@ export(sjp.scatter)
export(sjp.stackfrq)
export(sjp.xtab)
export(sjplot)
export(sjplot_pal)
export(sjt.corr)
export(sjt.df)
export(sjt.fa)
export(sjt.frq)
export(sjt.glm)
export(sjt.glmer)
export(sjt.grpmean)
export(sjt.itemanalysis)
export(sjt.lm)
export(sjt.lmer)
export(sjt.mwu)
export(sjt.pca)
export(sjt.stackfrq)
export(sjt.xtab)
export(sjtab)
export(tab_df)
export(tab_dfs)
export(tab_model)
export(theme_538)
export(theme_blank)
export(theme_sjplot)
......@@ -75,32 +90,27 @@ export(view_df)
import(ggplot2)
importFrom(MASS,glm.nb)
importFrom(MASS,lda)
importFrom(arm,se.ranef)
importFrom(broom,augment)
importFrom(broom,tidy)
importFrom(dplyr,"%>%")
importFrom(dplyr,arrange)
importFrom(dplyr,arrange_)
importFrom(dplyr,between)
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows)
importFrom(dplyr,case_when)
importFrom(dplyr,filter)
importFrom(dplyr,full_join)
importFrom(dplyr,group_by)
importFrom(dplyr,group_by_)
importFrom(dplyr,if_else)
importFrom(dplyr,inner_join)
importFrom(dplyr,mutate)
importFrom(dplyr,n_distinct)
importFrom(dplyr,rename_)
importFrom(dplyr,sample_n)
importFrom(dplyr,select)
importFrom(dplyr,select_)
importFrom(dplyr,slice)
importFrom(dplyr,summarise)
importFrom(dplyr,summarize)
importFrom(dplyr,ungroup)
importFrom(effects,allEffects)
importFrom(effects,effect)
importFrom(forcats,fct_reorder)
importFrom(forcats,fct_rev)
importFrom(ggeffects,ggeffect)
......@@ -108,38 +118,33 @@ importFrom(ggeffects,ggpredict)
importFrom(glmmTMB,fixef)
importFrom(grDevices,axisTicks)
importFrom(grDevices,cm)
importFrom(grDevices,colorRampPalette)
importFrom(grDevices,dev.off)
importFrom(grDevices,jpeg)
importFrom(grDevices,png)
importFrom(grDevices,rgb)
importFrom(grDevices,svg)
importFrom(grDevices,tiff)
importFrom(graphics,abline)
importFrom(graphics,par)
importFrom(graphics,plot)
importFrom(graphics,points)
importFrom(graphics,rect)
importFrom(graphics,text)
importFrom(knitr,asis_output)
importFrom(knitr,knit_print)
importFrom(lme4,VarCorr)
importFrom(lme4,confint.merMod)
importFrom(lme4,fixef)
importFrom(lme4,getME)
importFrom(lme4,ranef)
importFrom(magrittr,"%>%")
importFrom(merTools,predictInterval)
importFrom(modelr,crossv_kfold)
importFrom(nlme,getCovariateFormula)
importFrom(nlme,getData)
importFrom(nlme,getResponse)
importFrom(nlme,intervals)
importFrom(psych,KMO)
importFrom(psych,describe)
importFrom(psych,fa)
importFrom(psych,fa.parallel)
importFrom(psych,principal)
importFrom(purrr,as_vector)
importFrom(purrr,compact)
importFrom(purrr,flatten_chr)
importFrom(purrr,flatten_dbl)
importFrom(purrr,map)
importFrom(purrr,map2)
importFrom(purrr,map2_df)
......@@ -149,7 +154,10 @@ importFrom(purrr,map_df)
importFrom(purrr,map_if)
importFrom(purrr,map_lgl)
importFrom(purrr,pmap)
importFrom(purrr,reduce)
importFrom(rlang,.data)
importFrom(rlang,enquo)
importFrom(rlang,quo_name)
importFrom(scales,brewer_pal)
importFrom(scales,grey_pal)
importFrom(scales,percent)
......@@ -158,13 +166,11 @@ importFrom(sjlabelled,copy_labels)
importFrom(sjlabelled,get_dv_labels)
importFrom(sjlabelled,get_label)
importFrom(sjlabelled,get_labels)
importFrom(sjlabelled,get_note)
importFrom(sjlabelled,get_term_labels)
importFrom(sjlabelled,get_values)
importFrom(sjlabelled,set_labels)
importFrom(sjmisc,add_columns)
importFrom(sjmisc,group_labels)
importFrom(sjmisc,group_str)
importFrom(sjmisc,group_var)
importFrom(sjmisc,is_empty)
importFrom(sjmisc,is_even)
......@@ -195,8 +201,8 @@ importFrom(sjstats,hoslem_gof)
importFrom(sjstats,icc)
importFrom(sjstats,mean_n)
importFrom(sjstats,mic)
importFrom(sjstats,model_family)
importFrom(sjstats,model_frame)
importFrom(sjstats,outliers)
importFrom(sjstats,p_value)
importFrom(sjstats,phi)
importFrom(sjstats,pred_vars)
......@@ -214,7 +220,6 @@ importFrom(sjstats,weight2)
importFrom(sjstats,wtd_sd)
importFrom(sjstats,xtab_statistics)
importFrom(stats,AIC)
importFrom(stats,anova)
importFrom(stats,aov)
importFrom(stats,as.formula)
importFrom(stats,binomial)
......@@ -224,7 +229,6 @@ importFrom(stats,complete.cases)
importFrom(stats,confint)
importFrom(stats,cor)
importFrom(stats,cor.test)
importFrom(stats,cov2cor)
importFrom(stats,cutree)
importFrom(stats,dchisq)
importFrom(stats,deviance)
......@@ -244,9 +248,8 @@ importFrom(stats,kruskal.test)
importFrom(stats,lm)
importFrom(stats,loess)
importFrom(stats,logLik)
importFrom(stats,median)
importFrom(stats,mad)
importFrom(stats,model.frame)
importFrom(stats,model.matrix)
importFrom(stats,na.omit)
importFrom(stats,na.pass)
importFrom(stats,nobs)
......@@ -258,17 +261,13 @@ importFrom(stats,poly)
importFrom(stats,ppoints)
importFrom(stats,prcomp)
importFrom(stats,predict)
importFrom(stats,predict.glm)
importFrom(stats,pt)
importFrom(stats,qchisq)
importFrom(stats,qf)
importFrom(stats,qnorm)
importFrom(stats,qqline)
importFrom(stats,qqnorm)
importFrom(stats,qt)
importFrom(stats,quantile)
importFrom(stats,rect.hclust)
importFrom(stats,reorder)
importFrom(stats,residuals)
importFrom(stats,rstudent)
importFrom(stats,runif)
......@@ -282,23 +281,10 @@ importFrom(stats,vcov)
importFrom(stats,weighted.mean)
importFrom(stats,wilcox.test)
importFrom(stats,xtabs)
importFrom(tibble,add_column)
importFrom(tibble,add_row)
importFrom(tibble,as_tibble)
importFrom(tibble,has_name)
importFrom(tibble,has_rownames)
importFrom(tibble,is.tibble)
importFrom(tibble,lst)
importFrom(tibble,rownames_to_column)
importFrom(tibble,tibble)
importFrom(tibble,tidy_names)
importFrom(tidyr,gather)
importFrom(tidyr,nest)
importFrom(tidyr,spread)
importFrom(tidyr,unnest)
importFrom(tidyselect,contains)
importFrom(tidyselect,ends_with)
importFrom(tidyselect,starts_with)
importFrom(utils,browseURL)
importFrom(utils,setTxtProgressBar)
importFrom(utils,txtProgressBar)
This diff is collapsed.
#' @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.")
}
This diff is collapsed.
......@@ -10,10 +10,6 @@ col_check2 <- function(geom.colors, collen) {
geom.colors <- scales::brewer_pal(palette = geom.colors[1])(collen)
} else if (is.sjplot.pal(geom.colors[1])) {
geom.colors <- get_sjplot_colorpalette(geom.colors[1], collen)
} else if (is.wes.pal(geom.colors[1])) {
geom.colors <- get_wesanderson_colorpalette(geom.colors[1], collen)
} else if (geom.colors[1] %in% c("v", "viridis")) {
geom.colors <- get_viridis_colorpalette(collen)
# do we have correct amount of colours?
} else if (geom.colors[1] == "gs") {
geom.colors <- scales::grey_pal()(collen)
......@@ -54,55 +50,12 @@ is.brewer.pal <- function(pal) {
is.sjplot.pal <- function(pal) {
pal %in% c("aqua", "warm", "dust", "blambus", "simply", "us", "random")
}
is.wes.pal <- function(pal) {
pal %in% c("GrandBudapest", "Moonrise1", "Royal1", "Moonrise2", "Cavalcanti", "Royal2",
"GrandBudapest2", "Moonrise3", "Chevalier", "Zissou", "FantasticFox",
"Darjeeling", "Rushmore", "BottleRocket", "Darjeeling2")
}
get_wesanderson_colorpalette <- function(pal, len) {
if (!requireNamespace("wesanderson", quietly = TRUE)) {
warning("Package `wesanderson` required for this color palette.", call. = F)
return(NULL)
}
wesanderson::wes_palette(name = pal, n = len)
}
get_viridis_colorpalette <- function(len) {
if (!requireNamespace("viridis", quietly = TRUE)) {
warning("Package `viridis` required for this color palette.", call. = F)
return(NULL)
}
viridis::viridis(n = len)
pal %in% names(sjplot_colors)
}
get_sjplot_colorpalette <- function(pal, len) {
col <- NULL
if (pal == "random")
pal <- sample(c("aqua", "warm", "dust", "blambus", "simply", "us"), size = 1)
if (pal == "aqua")
col <- c("#BAF5F3", "#46A9BE", "#8B7B88", "#BD7688", "#F2C29E", "#BAF5F3", "#46A9BE", "#8B7B88")
else if (pal == "warm")
col <- c("#F8EB85", "#F1B749", "#C45B46", "#664458", "#072835", "#F8EB85", "#F1B749", "#C45B46")
else if (pal == "dust")
col <- c("#AAAE9D", "#F8F7CF", "#F7B98B", "#7B5756", "#232126", "#AAAE9D", "#F8F7CF", "#F7B98B")
else if (pal == "blambus")
col <- c("#5D8191", "#F2DD26", "#494949", "#BD772D", "#E02E1F", "#5D8191", "#F2DD26", "#494949")
else if (pal == "simply")
col <- c("#CD423F", "#FCDA3B", "#0171D3", "#018F77", "#F5C6AC", "#CD423F", "#FCDA3B", "#0171D3")
else if (pal == "us")
col <- c("#004D80", "#376C8E", "#37848E", "#9BC2B6", "#B5D2C0", "#004D80", "#376C8E", "#37848E")
col <- sjplot_colors[[pal]]
if (len > length(col)) {
warning("More colors requested than length of color palette.", call. = F)
......
# bind global variables
utils::globalVariables(c("Freq", "vif"))
# Help-functions
# is factor with char levels?
#' @importFrom sjmisc is_num_fac
is_labelled_factor <- function(x) is.factor(x) && !sjmisc::is_num_fac(x)
# get additional arguments for geoms
get_dot_args <- function(x) {
# ---------------------------------------
# get ...-argument, and check if it was "width"
# ---------------------------------------
eb.width <- x[["width"]]
if (is.null(eb.width)) eb.width <- 0
# get ...-argument, and check if it was "alpha"
ci.alpha <- x[["alpha"]]
if (is.null(ci.alpha)) ci.alpha <- .15
# get ...-argument, and check if it was "level"
ci.lvl <- x[["level"]]
if (is.null(ci.lvl)) ci.lvl <- .95
list(eb.width = eb.width,
ci.alpha = ci.alpha,
ci.lvl = ci.lvl)
}
# evaluates arguments
get_dot_data <- function(data, dots) {
# any dots?
......@@ -56,16 +29,6 @@ get_dot_data <- function(data, dots) {
dot_names <- function(dots) unname(unlist(lapply(dots, as.character)))
# function to create pretty breaks
# for log-scales
#' @importFrom grDevices axisTicks
base_breaks <- function(n = 10) {
function(x) {
grDevices::axisTicks(log10(range(x, na.rm = TRUE)), log = TRUE, nint = n)
}
}
#' @importFrom sjmisc str_contains to_label to_value replace_na word_wrap
#' @importFrom sjstats resp_val resp_var
get_lm_data <- function(fit) {
......@@ -118,25 +81,29 @@ print.table.summary <- function(baseplot,
x.x <- -Inf
}
baseplot <- baseplot +
annotate("text",
label = modsum,
parse = TRUE,
x = x.x,
y = Inf,
vjust = "top",
hjust = t.hjust)
annotate(
"text",
label = modsum,
parse = TRUE,
x = x.x,
y = Inf,
vjust = "top",
hjust = t.hjust
)
}
return(baseplot)
baseplot
}
get_var_name <- function(x) {
if (is.null(x)) return(NULL)
# remove "data frame name"
dollar_pos <- regexpr("$", x, fixed = T)[1]
if (dollar_pos != -1)
x <-
substr(x, start = dollar_pos + 1, stop = nchar(x))
return(x)
x <- substr(x, start = dollar_pos + 1, stop = nchar(x))
x
}
......@@ -177,8 +144,8 @@ create.frq.df <- function(x,
labels <- sjlabelled::get_labels(
x,
attr.only = T,
include.values = "n",
include.non.labelled = T
values = "n",
non.labelled = T
)
#---------------------------------------------------
# weight variable
......@@ -189,7 +156,7 @@ create.frq.df <- function(x,
#---------------------------------------------------
if (!is.null(labels)) {
# add rownames and values as columns
dat <- data.frame(n = names(labels), v = as.character(labels), stringsAsFactors = FALSE)
dat <- data_frame(n = names(labels), v = as.character(labels))
colnames(dat) <- c("val", "label")
# character vectors need to be converted with to_value
# to avoid NAs, but only if character is non-numeric
......@@ -268,7 +235,7 @@ create.frq.df <- function(x,
# wrap labels?
# -------------------------------------
if (!is.infinite(wrap.labels) && !is.null(labels)) {
if (anyNA(labels)) labels <- na.omit(labels)
if (anyNA(labels)) labels <- stats::na.omit(labels)
labels <- sjmisc::word_wrap(labels, wrap.labels)
}
# -------------------------------------
......@@ -357,7 +324,7 @@ create.xtab.df <- function(x,
colnames(mydat)[2] <- "Var2"
# spread variables back, so we have a table again
mydat <- tidyr::spread(mydat, Var2, Freq)
mydat <- tidyr::spread(mydat, .data$Var2, .data$Freq)
# rename column names
colnames(mydat)[1] <- "label"
......@@ -648,7 +615,7 @@ retrieveModelLabels <- function(models, group.pred) {
}
}
}
return(unique(fit.labels))
unique(fit.labels)
}
......@@ -660,28 +627,6 @@ Chisquare.glm <- function(rr, digits = 3) {
}
# compute model statistics for lm
#' @importFrom stats pf AIC
sju.modsum.lm <- function(fit) {
# get F-statistics
fstat <- summary(fit)$fstatistic
# Calculate p-value for F-test
pval <- stats::pf(fstat[1], fstat[2], fstat[3], lower.tail = FALSE)
# indicate significance level by stars
pan <- get_p_stars(pval)
# create mathematical term
modsum <- as.character(as.expression(
substitute(beta[0] == a * "," ~~ R^2 == r2 * "," ~~ "adj. " * R^2 == ar2 * "," ~~ "F" == f*panval * "," ~~ "AIC" == aic,
list(a = format(coef(fit)[1], digits = 3),
r2 = format(summary(fit)$r.squared, digits = 3),
ar2 = format(summary(fit)$adj.r.squared, digits = 3),
f = sprintf("%.2f", fstat[1]),
panval = pan,
aic = sprintf("%.2f", stats::AIC(fit))))))
return(modsum)
}
# Erzeugt eine rotierte Faktorladungen einer Hauptkomponentenanalyse
# (Paramter "data") mit einer bestimmten Anzahl an Faktoren (Parameter "factors")
# auf Grundlage der Varimax-Rotation
......@@ -715,85 +660,6 @@ unlistlabels <- function(lab) {
}
#' @importFrom sjstats model_frame
get_model_response_label <- function(fit) {
m_f <- sjstats::model_frame(fit)
unname(sjlabelled::get_label(m_f[[1]], def.value = colnames(m_f)[1]))
}
#' @importFrom stats reorder
sjp.vif <- function(fit) {
# -----------------------------------
# check package availability
# -----------------------------------
if (!requireNamespace("car", quietly = TRUE)) {
stop("Package `car` needed for this function to work. Please install it.", call. = F)
}
vifval <- NULL
vifplot <- NULL
mydat <- NULL
# check if we have more than 1 term
if (length(coef(fit)) > 2) {
# variance inflation factor
# claculate VIF
vifval <- car::vif(fit)
if (is.matrix(vifval)) {
val <- vifval[, 1]
} else {
val <- vifval
}
# retrieve highest VIF-value to determine y-axis range
maxval <- val[which.max(val)]
# determine upper limit of y-axis
upperLimit <- 10
# check whether maxval exceeds the critical VIF-Limit
# of 10. If so, set upper limit to max. value
if (maxval >= upperLimit) upperLimit <- ceiling(maxval)
mydat <- data.frame(vif = round(val, 2))
# Neue Variable erstellen, damit die Ergebnisse sortiert werden
# können (siehe reorder in ggplot-Funktion)
mydat$vars <- row.names(mydat)
# die variablenlabel sollen noch mal sortiert werden, nach
# VIF-Werten aufsteigend. Dies ist für die X-Achsenbeschriftung
# nötig, da diese sonst nicht mehr mit den sortierten VIF-Werten
# (Balkenreihenfolge auf X-Achse) übereinstimmt
mydat <- cbind(mydat, mydat[order(val), 2])
# Spalten sollen Namen kriegen
names(mydat) <- c("vif", "vars", "label")
# grafik ausgeben, dabei die variablen der X-Achse nach aufsteigenden
# VIF-Werten ordnen
vifplot <- ggplot(mydat, aes(x = stats::reorder(vars, vif), y = vif)) +
# Balken zeichnen. Stat=identity heißt, dass nicht die counts, sondern
# die tatsächlichen Zahlenwerte (VIF-Werte) abgebildet werden sollen
geom_bar(stat = "identity", width = 0.7, fill = "#80acc8") +
# grüne Linie zeichnen, die den guten Bereich anzeigt (VIF < 5)
geom_hline(yintercept = 5, linetype = 2, colour = "darkgreen", alpha = 0.7) +
# rote Linie zeichnen, die den tolerablen Bereich anzeigt (VIF < 10)
geom_hline(yintercept = 10, linetype = 2, colour = "darkred", alpha = 0.7) +
# grüne und rote Line beschriften
annotate("text", x = 1, y = 4.7, label = "good", size = 4, colour = "darkgreen") +
annotate("text", x = 1, y = 9.7, label = "tolerable", size = 4, colour = "darkred") +
# als X-Achsenbeschriftung die Variablennamen setzen
scale_x_discrete(labels = mydat$label) +
# Keine weiteren Titel an X- und Y-Achse angeben
labs(title = "Variance Inflation Factors (multicollinearity)",
x = NULL,
y = NULL) +
# maximale Obergrenze der Y-Achse setzen
scale_y_continuous(limits = c(0, upperLimit), expand = c(0, 0)) +
# Beschriftung der X-Achse (Variablenlabel) in 45-Grad-Winkel setzen
theme(axis.text.x = element_text(angle = 45, vjust = 0.5, size = rel(1.2)))
print(vifplot)
}
invisible(structure(class = "sjpvif",
list(plot = vifplot,
df = mydat,
vifval = vifval)))
}