updated quantile_cut adds na.rm=TRUE to min() and max() 2022-08-26 15:07:49

DESCRIPTION

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

R/age_calc.R

@@ -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)))

R/quantile_cut.R

@@ -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,na.rm = TRUE)
+      q[length(q)]<-max(x,na.rm = TRUE)
+    }
   }
   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)}
+
 }

man/quantile_cut.Rd

@@ -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}

packing.R

@@ -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 adds na.rm=TRUE to min() and max()"
 
 library(git2r)
 library(lubridate)