我相信R帮助文档在@RobHyndman的注释中指出的修订之后就很清楚了,但是我发现它有点压倒性。我会发布此答案,以防它帮助某人快速了解选项和他们的假设。
要掌握quantile(x, probs=probs)
,我想查看源代码。这也比我在R中预期的要难,因此我实际上只是从github存储库中抢了下来看起来足够新。我对默认(类型7)的行为感兴趣,因此我对其中的一些进行了注释,但对每个选项却没有做同样的事情。
您可以在代码中逐步看到“类型7”方法的内插方式,还添加了几行内容来打印一些重要的值。
quantile.default <-function(x, probs = seq(0, 1, 0.25), na.rm = FALSE, names = TRUE
, type = 7, ...){
if(is.factor(x)) {
if(!is.ordered(x) || ! type %in% c(1L, 3L))
stop("factors are not allowed")
lx <- levels(x)
} else lx <- NULL
if (na.rm){
x <- x[!is.na(x)]
} else if (anyNA(x)){
stop("missing values and NaN's not allowed if 'na.rm' is FALSE")
}
eps <- 100*.Machine$double.eps
if (any((p.ok <- !is.na(probs)) & (probs < -eps | probs > 1+eps)))
stop("'probs' outside [0,1]")
n <- length(x)
if(na.p <- any(!p.ok)) {
o.pr <- probs
probs <- probs[p.ok]
probs <- pmax(0, pmin(1, probs))
}
np <- length(probs)
if (n > 0 && np > 0) {
if(type == 7) {
index <- 1 + (n - 1) * probs
lo <- floor(index)
hi <- ceiling(index)
x <- sort(x, partial = unique(c(lo, hi)))
qs <- x[lo]
i <- which(index > lo)
h <- (index - lo)[i]
qs[i] <- (1 - h) * qs[i] + h * x[hi[i]]
cat("floor pos=", c(lo))
cat("\nceiling pos=", c(hi))
cat("\nfloor values= ", c(x[lo]))
cat( "\nwhich floors not targets? ", c(i))
cat("\ninterpolate between ", c(x[lo[i]]), ";", c(x[hi[i]]))
cat( "\nadjustment values= ", c(h))
cat("\nquantile estimates:")
}else if (type <= 3){
nppm <- if (type == 3){ n * probs - .5
} else {n * probs}
j <- floor(nppm)
h <- switch(type,
(nppm > j),
((nppm > j) + 1)/2,
(nppm != j) | ((j %% 2L) == 1L))
} else{
switch(type - 3,
{a <- 0; b <- 1},
a <- b <- 0.5,
a <- b <- 0,
a <- b <- 1,
a <- b <- 1 / 3,
a <- b <- 3 / 8)
fuzz <- 4 * .Machine$double.eps
nppm <- a + probs * (n + 1 - a - b)
j <- floor(nppm + fuzz)
h <- nppm - j
if(any(sml <- abs(h) < fuzz)) h[sml] <- 0
x <- sort(x, partial =
unique(c(1, j[j>0L & j<=n], (j+1)[j>0L & j<n], n))
)
x <- c(x[1L], x[1L], x, x[n], x[n])
qs <- x[j+2L]
qs[h == 1] <- x[j+3L][h == 1]
other <- (0 < h) & (h < 1)
if(any(other)) qs[other] <- ((1-h)*x[j+2L] + h*x[j+3L])[other]
}
} else {
qs <- rep(NA_real_, np)}
if(is.character(lx)){
qs <- factor(qs, levels = seq_along(lx), labels = lx, ordered = TRUE)}
if(names && np > 0L) {
names(qs) <- format_perc(probs)
}
if(na.p) {
o.pr[p.ok] <- qs
names(o.pr) <- rep("", length(o.pr))
names(o.pr)[p.ok] <- names(qs)
o.pr
} else qs
}
x<-c(1,2,2,2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5,5,5,6,6,7,99)
y<-c(1,2,2,2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5,5,5,6,6,7,9)
z<-c(1,2,2,2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5,5,5,6,6,7)
probs<-c(0.5, 0.75, 0.95, 0.975)
quantile.default(x,probs=probs, names=F)
quantile.default(y,probs=probs, names=F)
quantile.default(z,probs=probs, names=F)
sqrt(quantile.default(x^2, probs=probs, names=F))
exp(quantile.default(log(x), probs=probs, names=F))