andreas/stRoke
1
0
Fork 0
mirror of https://github.com/agdamsbo/stRoke.git synced 2024-11-21 20:40:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

quantile_cut and age_calc tests

Browse Source
This commit is contained in:
AG Damsbo 2022-09-23 09:14:47 +02:00
parent 2a86a2f051
commit fe1c47e1b6
13 changed files with 52 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.Rbuildignore
View File

@ -4,3 +4,6 @@
^_pkgdown\.yml$
^docs$
^pkgdown$
^logo$
^help$

2
.gitignore vendored
View File

@ -49,3 +49,5 @@ po/*~
# RStudio Connect folder
rsconnect/
setup_help.R
logo.R

2
DESCRIPTION
View File

@ -16,3 +16,5 @@ Suggests:
testthat (>= 3.0.0)
Language: en-US
Config/testthat/edition: 3
Imports:
stats

6
R/plot_olr.R
View File

@ -12,8 +12,12 @@
#' @param input can be either "model", which is a olr model (polr()), or "df", which is a dataframe whith three columns for OR, lower CI and upper CI.
#'
#' @return gg object
#' @keywords forestplot
#' @keywords forest plot
#'
#' @export
#'
#' @examples
#'
plot_ord_odds<-function(x, title = NULL,dec=3,lbls=NULL,hori="OR (95 % CI)",vert="Variables",short=FALSE,input=c("model","df")){

13
R/quantile_cut.R
View File

@ -1,23 +1,26 @@
#' Easy function for splitting numeric variable in quantiles
#'
#' Using base/stats functions cut() and quantile().
#'
#' @param x Variable to cut.
#' @param groups Number of groups.
#' @param y alternative vector to draw quantile cuts from. Limits has to be within x. Default is NULL.
#' @param na.rm Remove NA's. Default is TRUE.
#' @param group.names Names of groups to split to. Default is NULL, giving intervals as names.
#' @param ordered.f Set resulting vector as ordered. Default is FALSE.
#' @param detail.list
#' @param inc.outs Flag to include min(x) and max(x) as boarders in case of y!=NULL.
#'
#' @return
#'
#' @keywords quantile
#' @export
#' @examples
#' aa <- as.numeric(sample(1:1000,2000,replace = TRUE))
#' x <- 1:450
#' y <- 6:750
#' summary(quantile_cut(aa,groups=4)) ## Cuts quartiles
quantile_cut<-function (x, groups,y=NULL, na.rm = TRUE, group.names = NULL, ordered.f = FALSE, inc.outs=FALSE,detail.lst=TRUE)
{
#' summary(quantile_cut(aa,groups=4,detail.list=FALSE)) ## Cuts quartiles
quantile_cut<-function (x, groups, y=NULL, na.rm = TRUE, group.names = NULL, ordered.f = FALSE, inc.outs=FALSE,detail.list=TRUE){
if (!is.null(y)){
q<-quantile(y, probs = seq(0, 1, 1/groups), na.rm = na.rm, names = TRUE, type = 7)
if (inc.outs){ # Setting cut boardes to include outliers in x compared to y.
@ -31,6 +34,6 @@ quantile_cut<-function (x, groups,y=NULL, na.rm = TRUE, group.names = NULL, orde
}
d<-cut(x, q, include.lowest = TRUE, labels = group.names,
ordered_result = ordered.f)
if (detail.lst){return(list(d,q))} else {return(d)}
if (detail.list) list(d,q) else d
}

2
docs/pkgdown.yml
View File

@ -2,5 +2,5 @@ pandoc: 2.19.2
pkgdown: 2.0.6
pkgdown_sha: ~
articles: {}
last_built: 2022-09-22T17:56Z
last_built: 2022-09-23T07:14Z

13
docs/reference/quantile_cut.html
View File

@ -50,7 +50,7 @@
<span> group.names <span class="op">=</span> <span class="cn">NULL</span>,</span>
<span> ordered.f <span class="op">=</span> <span class="cn">FALSE</span>,</span>
<span> inc.outs <span class="op">=</span> <span class="cn">FALSE</span>,</span>
<span> detail.lst <span class="op">=</span> <span class="cn">TRUE</span></span>
<span> detail.list <span class="op">=</span> <span class="cn">TRUE</span></span>
<span><span class="op">)</span></span></code></pre></div>
</div>
@ -83,6 +83,10 @@
<dt>inc.outs</dt>
<dd><p>Flag to include min(x) and max(x) as boarders in case of y!=NULL.</p></dd>
<dt>detail.list</dt>
<dd></dd>
</dl></div>
<div class="section level2">
@ -90,10 +94,9 @@
<div class="sourceCode"><pre class="sourceCode r"><code><span class="r-in"><span><span class="va">aa</span> <span class="op">&lt;-</span> <span class="fu"><a href="https://rdrr.io/r/base/numeric.html" class="external-link">as.numeric</a></span><span class="op">(</span><span class="fu"><a href="https://rdrr.io/r/base/sample.html" class="external-link">sample</a></span><span class="op">(</span><span class="fl">1</span><span class="op">:</span><span class="fl">1000</span>,<span class="fl">2000</span>,replace <span class="op">=</span> <span class="cn">TRUE</span><span class="op">)</span><span class="op">)</span></span></span>
<span class="r-in"><span><span class="va">x</span> <span class="op">&lt;-</span> <span class="fl">1</span><span class="op">:</span><span class="fl">450</span></span></span>
<span class="r-in"><span><span class="va">y</span> <span class="op">&lt;-</span> <span class="fl">6</span><span class="op">:</span><span class="fl">750</span></span></span>
<span class="r-in"><span><span class="fu"><a href="https://rdrr.io/r/base/summary.html" class="external-link">summary</a></span><span class="op">(</span><span class="fu">quantile_cut</span><span class="op">(</span><span class="va">aa</span>,groups<span class="op">=</span><span class="fl">4</span><span class="op">)</span><span class="op">)</span> <span class="co">## Cuts quartiles</span></span></span>
<span class="r-out co"><span class="r-pr">#&gt;</span> Length Class Mode </span>
<span class="r-out co"><span class="r-pr">#&gt;</span> [1,] 2000 factor numeric</span>
<span class="r-out co"><span class="r-pr">#&gt;</span> [2,] 5 -none- numeric</span>
<span class="r-in"><span><span class="fu"><a href="https://rdrr.io/r/base/summary.html" class="external-link">summary</a></span><span class="op">(</span><span class="fu">quantile_cut</span><span class="op">(</span><span class="va">aa</span>,groups<span class="op">=</span><span class="fl">4</span>,detail.list<span class="op">=</span><span class="cn">FALSE</span><span class="op">)</span><span class="op">)</span> <span class="co">## Cuts quartiles</span></span></span>
<span class="r-out co"><span class="r-pr">#&gt;</span> [1,249] (249,510] (510,754] (754,998] </span>
<span class="r-out co"><span class="r-pr">#&gt;</span> 502 498 500 500 </span>
</code></pre></div>
</div>
</main><aside class="col-md-3"><nav id="toc"><h2>On this page</h2>

2
docs/search.json
View File

File diff suppressed because one or more lines are too long

3
man/plot_ord_odds.Rd
View File

@ -38,4 +38,5 @@ gg object
\description{
Heavily inspired by https://www.r-bloggers.com/plotting-odds-ratios-aka-a-forrestplot-with-ggplot2/
}
\keyword{forestplot}
\keyword{forest}
\keyword{plot}

6
man/quantile_cut.Rd
View File

@ -12,7 +12,7 @@ quantile_cut(
group.names = NULL,
ordered.f = FALSE,
inc.outs = FALSE,
detail.lst = TRUE
detail.list = TRUE
)
}
\arguments{
@ -29,6 +29,8 @@ quantile_cut(
\item{ordered.f}{Set resulting vector as ordered. Default is FALSE.}
\item{inc.outs}{Flag to include min(x) and max(x) as boarders in case of y!=NULL.}
\item{detail.list}{}
}
\description{
Using base/stats functions cut() and quantile().
@ -37,6 +39,6 @@ Using base/stats functions cut() and quantile().
aa <- as.numeric(sample(1:1000,2000,replace = TRUE))
x <- 1:450
y <- 6:750
summary(quantile_cut(aa,groups=4)) ## Cuts quartiles
summary(quantile_cut(aa,groups=4,detail.list=FALSE)) ## Cuts quartiles
}
\keyword{quantile}

25
setup help.R
View File

@ -1,25 +0,0 @@
usethis::use_description(list(License = "GPL-3"))
usethis::use_namespace()
dir.create("R")
usethis::use_package_doc()
usethis::use_roxygen_md()
usethis::use_package()
spelling::spell_check_setup()
pkgdown:::build_site()
# https://privefl.github.io/advr38book/packages.html#pkg-start
# Update version
source("ver_upd.R")
updatePackageVersion()
# Commit and push
commit_message<-"Updated description"
git2r::commit(all=TRUE, message=paste(commit_message,lubridate::now()))
system("/usr/bin/git push origin HEAD:refs/heads/main")

2
tests/testthat/test-age_calc.R
View File

@ -3,4 +3,4 @@ test_that("age_calc works for vectors of length 1 (scalars)", {
expect_equal(round(result), 73)
})
================================================================================
################################################################################

15
tests/testthat/test-quantile_cut.R Normal file
View File

@ -0,0 +1,15 @@
test_that("quatile_cut() works for detail.list==FALSE", {
result <- quantile_cut(iris$Sepal.Length,3,detail.list=FALSE)
expect_equal(length(levels(result)), 3)
expect_s3_class(result, "factor")
})
################################################################################
test_that("quatile_cut() works for detail.list==FALSE", {
result <- quantile_cut(iris$Sepal.Length,3,detail.list=TRUE)
expect_length(result, 2)
expect_type(result, "list")
})
################################################################################