P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 07:26:13 +01:00
Code Releases Activity

(v1.0.1.9001) PCA unit tests

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-03-08 09:12:11 +01:00
parent fa0d9c58d9
commit 9fc858f208
15 changed files with 71 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.0.1.9000 Version: 1.0.1.9001
Date: 2020-03-07 Date: 2020-03-08
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person(role = c("aut", "cre"), person(role = c("aut", "cre"),

1
NAMESPACE
View File

@ -327,6 +327,7 @@ importFrom(stats,complete.cases)
importFrom(stats,glm) importFrom(stats,glm)
importFrom(stats,lm) importFrom(stats,lm)
importFrom(stats,pchisq) importFrom(stats,pchisq)
importFrom(stats,prcomp)
importFrom(stats,predict) importFrom(stats,predict)
importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_longer)
importFrom(tidyr,pivot_wider) importFrom(tidyr,pivot_wider)

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.0.1.9000 # AMR 1.0.1.9001
### New ### New
* Support for easy principal component analysis for AMR, using the new `pca()` function * Support for easy principal component analysis for AMR, using the new `pca()` function

11
R/ggplot_pca.R
View File

@ -33,6 +33,7 @@
#' @param ellipse_prob statistical size of the ellipse in normal probability #' @param ellipse_prob statistical size of the ellipse in normal probability
#' @param ellipse_size the size of the ellipse line #' @param ellipse_size the size of the ellipse line
#' @param ellipse_alpha the alpha (transparency) of the ellipse line #' @param ellipse_alpha the alpha (transparency) of the ellipse line
#' @param points_size the size of the points
#' @param points_alpha the alpha (transparency) of the points #' @param points_alpha the alpha (transparency) of the points
#' @param arrows a logical to indicate whether arrows should be drawn #' @param arrows a logical to indicate whether arrows should be drawn
#' @param arrows_textsize the size of the text for variable names #' @param arrows_textsize the size of the text for variable names
@ -42,7 +43,7 @@
#' @param arrows_alpha the alpha (transparency) of the arrows and their text #' @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 base_textsize the text size for all plot elements except the labels and arrows
#' @param ... Parameters passed on to functions #' @param ... Parameters passed on to functions
#' @source The [ggplot_pca()] function is based on the [ggbiplot()] function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015). #' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015).
#' #'
#' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were: #' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
#' 1. Rewritten code to remove the dependency on packages `plyr`, `scales` and `grid` #' 1. Rewritten code to remove the dependency on packages `plyr`, `scales` and `grid`
@ -324,10 +325,14 @@ pca_calculations <- function(pca_model,
sigma <- var(cbind(x$xvar, x$yvar)) sigma <- var(cbind(x$xvar, x$yvar))
mu <- c(mean(x$xvar), mean(x$yvar)) mu <- c(mean(x$xvar), mean(x$yvar))
ed <- sqrt(qchisq(ellipse_prob, df = 2)) ed <- sqrt(qchisq(ellipse_prob, df = 2))
data.frame(sweep(circle %*% chol(sigma) * ed, 2, mu, FUN = "+"), el <- data.frame(sweep(circle %*% chol(sigma) * ed, 2, mu, FUN = "+"),
groups = x$groups[1]) groups = x$groups[1])
names(el)[1:2] <- c("xvar", "yvar")
el
})) }))
names(ell)[1:2] <- c("xvar", "yvar") if (NROW(ell) == 0) {
ell <- NULL
}
} else { } else {
ell <- NULL ell <- NULL
} }

1
R/pca.R
View File

@ -31,6 +31,7 @@
#' The result of the [pca()] function is a [`prcomp`] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain numeric values. These are probably the groups and labels, and will be used by [ggplot_pca()]. #' The result of the [pca()] function is a [`prcomp`] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain numeric values. These are probably the groups and labels, and will be used by [ggplot_pca()].
#' @rdname pca #' @rdname pca
#' @exportMethod prcomp.data.frame #' @exportMethod prcomp.data.frame
#' @importFrom stats prcomp
#' @export #' @export
#' @examples #' @examples
#' # `example_isolates` is a dataset available in the AMR package. #' # `example_isolates` is a dataset available in the AMR package.

2
docs/404.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="https://msberends.gitlab.io/AMR/index.html">AMR (for R)</a> <a class="navbar-link" href="https://msberends.gitlab.io/AMR/index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

2
docs/LICENSE-text.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

2
docs/articles/index.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

2
docs/authors.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

2
docs/index.html
View File

@ -43,7 +43,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

8
docs/news/index.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>
@ -226,9 +226,9 @@
</div> </div>
<div id="amr-1019000" class="section level1"> <div id="amr-1019001" class="section level1">
<h1 class="page-header"> <h1 class="page-header">
<a href="#amr-1019000" class="anchor"></a>AMR 1.0.1.9000<small> Unreleased </small> <a href="#amr-1019001" class="anchor"></a>AMR 1.0.1.9001<small> Unreleased </small>
</h1> </h1>
<div id="new" class="section level3"> <div id="new" class="section level3">
<h3 class="hasAnchor"> <h3 class="hasAnchor">
@ -1489,7 +1489,7 @@
<div id="tocnav"> <div id="tocnav">
<h2>Contents</h2> <h2>Contents</h2>
<ul class="nav nav-pills nav-stacked"> <ul class="nav nav-pills nav-stacked">
<li><a href="#amr-1019000">1.0.1.9000</a></li> <li><a href="#amr-1019001">1.0.1.9001</a></li>
<li><a href="#amr-101">1.0.1</a></li> <li><a href="#amr-101">1.0.1</a></li>
<li><a href="#amr-100">1.0.0</a></li> <li><a href="#amr-100">1.0.0</a></li>
<li><a href="#amr-090">0.9.0</a></li> <li><a href="#amr-090">0.9.0</a></li>

10
docs/reference/ggplot_pca.html
View File

@ -79,7 +79,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>
@ -117,9 +117,9 @@
</li> </li>
<li> <li>
<a href="../articles/PCA.html"> <a href="../articles/PCA.html">
<span class="fa fa-compress-alt"></span> <span class="fa fa-compress"></span>
Conduct Principal Component Analysis for AMR Conduct principal component analysis for AMR
</a> </a>
</li> </li>
<li> <li>
@ -307,6 +307,10 @@
<th>ellipse_alpha</th> <th>ellipse_alpha</th>
<td><p>the alpha (transparency) of the ellipse line</p></td> <td><p>the alpha (transparency) of the ellipse line</p></td>
</tr> </tr>
<tr>
<th>points_size</th>
<td><p>the size of the points</p></td>
</tr>
<tr> <tr>
<th>points_alpha</th> <th>points_alpha</th>
<td><p>the alpha (transparency) of the points</p></td> <td><p>the alpha (transparency) of the points</p></td>

2
docs/reference/index.html
View File

@ -78,7 +78,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9000</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.0.1.9001</span>
</span> </span>
</div> </div>

4
man/ggplot_pca.Rd
View File

@ -4,7 +4,7 @@
\alias{ggplot_pca} \alias{ggplot_pca}
\title{PCA biplot with \code{ggplot2}} \title{PCA biplot with \code{ggplot2}}
\source{ \source{
The \code{\link[=ggplot_pca]{ggplot_pca()}} function is based on the \code{\link[=ggbiplot]{ggbiplot()}} function from the \code{ggbiplot} package by Vince Vu, as found on GitHub: \url{https://github.com/vqv/ggbiplot} (retrieved: 2 March 2020, their latest commit: \href{https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9}{\code{7325e88}}; 12 February 2015). The \code{\link[=ggplot_pca]{ggplot_pca()}} function is based on the \code{ggbiplot()} function from the \code{ggbiplot} package by Vince Vu, as found on GitHub: \url{https://github.com/vqv/ggbiplot} (retrieved: 2 March 2020, their latest commit: \href{https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9}{\code{7325e88}}; 12 February 2015).
As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were: As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
\enumerate{ \enumerate{
@ -71,6 +71,8 @@ ggplot_pca(
\item{ellipse_alpha}{the alpha (transparency) of the ellipse line} \item{ellipse_alpha}{the alpha (transparency) of the ellipse line}
\item{points_size}{the size of the points}
\item{points_alpha}{the alpha (transparency) of the points} \item{points_alpha}{the alpha (transparency) of the points}
\item{arrows}{a logical to indicate whether arrows should be drawn} \item{arrows}{a logical to indicate whether arrows should be drawn}

37
tests/testthat/test-pca.R Normal file
View File

@ -0,0 +1,37 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2020 Berends MS, Luz CF et al. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
context("pca.R")
test_that("PCA works", {
library(dplyr)
resistance_data <- example_isolates %>%
filter(mo %in% as.mo(c("E. coli", "K. pneumoniae", "S. aureus"))) %>%
select(mo, AMC, CXM, CTX, TOB, TMP) %>%
group_by(order = mo_order(mo), # group on anything, like order
genus = mo_genus(mo)) %>% # and genus as we do here
summarise_if(is.rsi, resistance, minimum = 0)
expect_s3_class(pca(resistance_data), "prcomp")
expect_s3_class(prcomp(resistance_data), "prcomp")
ggplot_pca(pca(resistance_data), ellipse = TRUE)
})