andreas/daDoctoR
1
0
Fork 0
mirror of https://github.com/agdamsbo/daDoctoR.git synced 2024-11-24 12:41:54 +01:00
Code Issues Projects Releases Wiki Activity

Compare commits

base: andreas:a0c4b3f9c3cf7a172fb919116fe41df4a70236e8
Branches Tags
andreas:master
andreas:main
..
compare: andreas:3b01487a0e31e06b60d0414387dfb1ca405f1294
Branches Tags
andreas:master
andreas:main

No commits in common. "a0c4b3f9c3cf7a172fb919116fe41df4a70236e8" and "3b01487a0e31e06b60d0414387dfb1ca405f1294" have entirely different histories.
a0c4b3f9c3 ... 3b01487a0e

5 changed files with 6 additions and 22 deletions
Show Stats Expand all files Collapse all files

2
DESCRIPTION
View File

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

2
R/age_calc.R
View File

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

14
R/quantile_cut.R
View File

@ -7,30 +7,22 @@
#' @param na.rm Remove NA's. Default is TRUE. #' @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 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 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 #' @keywords quantile
#' @export #' @export
#' @examples #' @examples
#' aa <- as.numeric(sample(1:1000,2000,replace = TRUE)) #' 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)) ## Cuts quartiles
quantile_cut<-function (x, groups,y=NULL, na.rm = TRUE, group.names = NULL, ordered.f = FALSE, inc.outs=FALSE,detail.lst=TRUE) quantile_cut<-function (x, groups,y=NULL, na.rm = TRUE, group.names = NULL, ordered.f = FALSE)
{ {
if (!is.null(y)){ if (!is.null(y)){
q<-quantile(y, probs = seq(0, 1, 1/groups), na.rm = na.rm, names = TRUE, type = 7) 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,na.rm = TRUE)
q[length(q)]<-max(x,na.rm = TRUE)
}
} }
if (is.null(y)){ if (is.null(y)){
q<-quantile(x, probs = seq(0, 1, 1/groups), na.rm = na.rm, names = TRUE, type = 7) 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, d<-cut(x, q, include.lowest = TRUE, labels = group.names,
ordered_result = ordered.f) ordered_result = ordered.f)
if (detail.lst){return(list(d,q))} else {return(d)} return(list(d,q))
} }

8
man/quantile_cut.Rd
View File

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

2
packing.R
View File

@ -16,7 +16,7 @@ devtools::document()
# Commit and push # Commit and push
commit_message<-"updated quantile_cut adds na.rm=TRUE to min() and max()" commit_message<-"updated dob_extract_cpr to also support cpr format ddmmyyxxxx"
library(git2r) library(git2r)
library(lubridate) library(lubridate)