improve wquant

R/wquant.R

@@ -1,6 +1,8 @@
 ##' Weighted quantile function
 ##'
-##' Computes weighted quantiles
+##' Computes weighted quantiles.
+##'
+##' \code{wquant} computes a quantile of type 7 according to the typology of \code{\link[stats]{quantile}}.
 ##' 
 ##' @param x numeric; a vector of data.
 ##' @param weights numeric; vector of weights.
@@ -16,7 +18,16 @@
 ##' x <- c(1,1,1,2,2,3,3,3,3,4,5,5,6,6,6)
 ##' quantile(x)
 ##' wquant(c(1,2,3,4,5,6),weights=c(3,2,4,1,2,3))
-##' 
+##'
+##' \dontshow{
+##'   stopifnot(quantile(x)==wquant(c(1,2,3,4,5,6),weights=c(3,2,4,1,2,3)))
+##'   try(wquant(c(1,NA),c(1,2)))
+##'   try(wquant(c(1,2),c(NA,1)))
+##'   try(wquant(c(1,2,3),c(1,2)))
+##'   try(wquant(c(1,2,3),c(1,1,1),probs=c(0.1,NA)))
+##'   try(wquant(c(1,2,3),c(1,2,3),probs=c(0.1,2)))
+##' }
+##'
 ##' @rdname wquant
 ##' @importFrom stats approx setNames
 ##' @export
@@ -29,7 +40,9 @@ wquant <- function (
   if (length(x)!=length(weights))
     pStop("wquant",sQuote("x")," and ",sQuote("weights"),
       " must be of equal length.")
-  if (!is.numeric(probs) || all(is.na(probs)) ||
+  if (any(is.na(x)) || any(is.na(weights)))
+    pStop("wquant","NA values are disallowed.")
+  if (!is.numeric(probs) || any(is.na(probs)) ||
         isTRUE(any(probs < 0 | probs > 1))) {
     pStop("wquant",sQuote("probs"),
       " must be a numeric vector with values in [0,1].")
@@ -47,6 +60,7 @@ wquant <- function (
     x=cumsum(weights),y=x,xout=c(low,high),
     method="constant",f=1,rule=2
   )$y
-  qs <- (1-ord)*allq[seq_len(k)]+ord*allq[-seq_len(k)]
+  dim(allq) <- c(k,2)
+  qs <- (1-ord)*allq[,1]+ord*allq[,2]
   setNames(qs,names(probs))
 }