andreas/daDoctoR
1
0
Fork 0
mirror of https://github.com/agdamsbo/daDoctoR.git synced 2025-01-18 03:16:34 +01:00
Code Issues Projects Releases Wiki Activity

updated quantile_cut to add flags for including outliers when y!=NULL and flag to give result as detailed list (previous standard) 2022-08-26 14:54:36

Browse Source
This commit is contained in:
AG Damsbo 2022-08-26 14:54:36 +02:00
parent 3b01487a0e
commit 9e7560c562
5 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: daDoctoR
Title: Functions For Health Research
Version: 0.22.6
Version: 0.22.7
Year: 2021
Author: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>
Maintainer: Andreas Gammelgaard Damsbo <agdamsbo@pm.me>

2
R/age_calc.R
View File

@ -15,6 +15,7 @@
age_calc<-function (dob, enddate = Sys.Date(), units = "years", precise = TRUE)
## Build upon the work of Jason P. Becker, as part of the eeptools
## Alternative is to just use lubridate::time_length
{
if (!inherits(dob, "Date") | !inherits(enddate, "Date")) {
@ -31,6 +32,7 @@ age_calc<-function (dob, enddate = Sys.Date(), units = "years", precise = TRUE)
start <- as.POSIXlt(dob)
end <- as.POSIXlt(enddate)
if (precise) {
start_is_leap <- ifelse(start$year%%400 == 0, TRUE, ifelse(start$year%%100 ==
0, FALSE, ifelse(start$year%%4 == 0, TRUE, FALSE)))

14
R/quantile_cut.R
View File

@ -7,22 +7,30 @@
#' @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 inc.outs Flag to include min(x) and max(x) as boarders in case of y!=NULL.
#' @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)
quantile_cut<-function (x, groups,y=NULL, na.rm = TRUE, group.names = NULL, ordered.f = FALSE, inc.outs=FALSE,detail.lst=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.
q[1]<-min(x)
q[length(q)]<-max(x)
}
}
if (is.null(y)){
q<-quantile(x, probs = seq(0, 1, 1/groups), na.rm = na.rm, names = TRUE, type = 7)
}
d<-cut(x, q, include.lowest = TRUE, labels = group.names,
ordered_result = ordered.f)
return(list(d,q))
if (detail.lst){return(list(d,q))} else {return(d)}
}

8
man/quantile_cut.Rd
View File

@ -10,7 +10,9 @@ quantile_cut(
y = NULL,
na.rm = TRUE,
group.names = NULL,
ordered.f = FALSE
ordered.f = FALSE,
inc.outs = FALSE,
detail.lst = TRUE
)
}
\arguments{
@ -25,12 +27,16 @@ quantile_cut(
\item{group.names}{Names of groups to split to. Default is NULL, giving intervals as names.}
\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.}
}
\description{
Using base/stats functions cut() and quantile().
}
\examples{
aa <- as.numeric(sample(1:1000,2000,replace = TRUE))
x <- 1:450
y <- 6:750
summary(quantile_cut(aa,groups=4)) ## Cuts quartiles
}
\keyword{quantile}

2
packing.R
View File

@ -16,7 +16,7 @@ devtools::document()
# Commit and push
commit_message<-"updated dob_extract_cpr to also support cpr format ddmmyyxxxx"
commit_message<-"updated quantile_cut to add flags for including outliers when y!=NULL and flag to give result as detailed list (previous standard)"
library(git2r)
library(lubridate)