1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-13 05:21:50 +02:00

(v1.2.0.9037) survey on website

This commit is contained in:
2020-07-28 18:39:57 +02:00
parent ab2b359e6b
commit 1b65d76cfb
140 changed files with 1309 additions and 941 deletions

View File

@ -40,6 +40,7 @@
#' @param arrows_colour the colour of the arrow and their text
#' @param arrows_size the size (thickness) of the arrow lines
#' @param arrows_textsize the size of the text at the end of the arrows
#' @param arrows_textangled a logical whether the text at the end of the arrows should be angled
#' @param arrows_alpha the alpha (transparency) of the arrows and their text
#' @param base_textsize the text size for all plot elements except the labels and arrows
#' @param ... Parameters passed on to functions
@ -58,20 +59,25 @@
#' # `example_isolates` is a dataset available in the AMR package.
#' # See ?example_isolates.
#'
#' \dontrun{
#' # See ?pca for more info about Principal Component Analysis (PCA).
#' library(dplyr)
#' pca_model <- example_isolates %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' group_by(species = mo_shortname(mo)) %>%
#' summarise_if (is.rsi, resistance) %>%
#' pca(FLC, AMC, CXM, GEN, TOB, TMP, SXT, CIP, TEC, TCY, ERY)
#' if (require("dplyr")) {
#' pca_model <- example_isolates %>%
#' filter(mo_genus(mo) == "Staphylococcus") %>%
#' group_by(species = mo_shortname(mo)) %>%
#' summarise_if (is.rsi, resistance) %>%
#' pca(FLC, AMC, CXM, GEN, TOB, TMP, SXT, CIP, TEC, TCY, ERY)
#'
#' # old (base R)
#' biplot(pca_model)
#'
#' # old
#' biplot(pca_model)
#'
#' # new
#' ggplot_pca(pca_model)
#' # new
#' ggplot_pca(pca_model)
#'
#' if (require("ggplot2")) {
#' ggplot_pca(pca_model) +
#' scale_colour_viridis_d() +
#' labs(title = "Title here")
#' }
#' }
ggplot_pca <- function(x,
choices = 1:2,
@ -91,26 +97,28 @@ ggplot_pca <- function(x,
arrows_colour = "darkblue",
arrows_size = 0.5,
arrows_textsize = 3,
arrows_textangled = TRUE,
arrows_alpha = 0.75,
base_textsize = 10,
...) {
stop_ifnot_installed("ggplot2")
stop_ifnot(length(choices) == 2, "`choices` must be of length 2")
stop_ifnot(is.logical(scale), "`scale` must be TRUE or FALSE")
stop_ifnot(is.logical(pc.biplot), "`pc.biplot` must be TRUE or FALSE")
stop_ifnot(is.numeric(choices), "`choices` must be numeric")
stop_ifnot(is.numeric(labels_textsize), "`labels_textsize` must be numeric")
stop_ifnot(is.numeric(labels_text_placement), "`labels_text_placement` must be numeric")
stop_ifnot(is.logical(ellipse), "`ellipse` must be TRUE or FALSE")
stop_ifnot(is.numeric(ellipse_prob), "`ellipse_prob` must be numeric")
stop_ifnot(is.numeric(ellipse_size), "`ellipse_size` must be numeric")
stop_ifnot(is.numeric(ellipse_alpha), "`ellipse_alpha` must be numeric")
stop_ifnot(is.logical(arrows), "`arrows` must be TRUE or FALSE")
stop_ifnot(is.logical(arrows_textangled), "`arrows_textangled` must be TRUE or FALSE")
stop_ifnot(is.logical(ellipse), "`ellipse` must be TRUE or FALSE")
stop_ifnot(is.logical(pc.biplot), "`pc.biplot` must be TRUE or FALSE")
stop_ifnot(is.logical(scale), "`scale` must be TRUE or FALSE")
stop_ifnot(is.numeric(arrows_alpha), "`arrows_alpha` must be numeric")
stop_ifnot(is.numeric(arrows_size), "`arrows_size` must be numeric")
stop_ifnot(is.numeric(arrows_textsize), "`arrows_textsize` must be numeric")
stop_ifnot(is.numeric(arrows_alpha), "`arrows_alpha` must be numeric")
stop_ifnot(is.numeric(base_textsize), "`base_textsize` must be numeric")
stop_ifnot(is.numeric(choices), "`choices` must be numeric")
stop_ifnot(is.numeric(ellipse_alpha), "`ellipse_alpha` must be numeric")
stop_ifnot(is.numeric(ellipse_prob), "`ellipse_prob` must be numeric")
stop_ifnot(is.numeric(ellipse_size), "`ellipse_size` must be numeric")
stop_ifnot(is.numeric(labels_text_placement), "`labels_text_placement` must be numeric")
stop_ifnot(is.numeric(labels_textsize), "`labels_textsize` must be numeric")
calculations <- pca_calculations(pca_model = x,
groups = groups,
@ -206,12 +214,20 @@ ggplot_pca <- function(x,
type = "open"),
colour = arrows_colour,
size = arrows_size,
alpha = arrows_alpha) +
ggplot2::geom_text(data = df.v,
ggplot2::aes(label = varname, x = xvar, y = yvar, angle = angle, hjust = hjust),
colour = arrows_colour,
size = arrows_textsize,
alpha = arrows_alpha)
alpha = arrows_alpha)
if (arrows_textangled == TRUE) {
g <- g + ggplot2::geom_text(data = df.v,
ggplot2::aes(label = varname, x = xvar, y = yvar, angle = angle, hjust = hjust),
colour = arrows_colour,
size = arrows_textsize,
alpha = arrows_alpha)
} else {
g <- g + ggplot2::geom_text(data = df.v,
ggplot2::aes(label = varname, x = xvar, y = yvar, hjust = hjust),
colour = arrows_colour,
size = arrows_textsize,
alpha = arrows_alpha)
}
}
# Add caption label about total explained variance