1#  File src/library/stats/R/qqnorm.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2021 The R Core Team
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  A copy of the GNU General Public License is available at
17#  https://www.R-project.org/Licenses/
18
19qqnorm <- function(y, ...) UseMethod("qqnorm")
20
21qqnorm.default <-
22    function(y, ylim, main = "Normal Q-Q Plot",
23	     xlab = "Theoretical Quantiles", ylab = "Sample Quantiles",
24	     plot.it = TRUE, datax = FALSE, ...)
25{
26    if(has.na <- any(ina <- is.na(y))) { ## keep NA's in proper places
27        yN <- y
28        y <- y[!ina]
29    }
30    if(0 == (n <- length(y)))
31        stop("y is empty or has only NAs")
32    if (plot.it && missing(ylim))
33        ylim <- range(y)
34    x <- qnorm(ppoints(n))[order(order(y))]
35    if(has.na) {
36        y <- x; x <- rep.int(NA_real_, length(ina)); x[!ina] <- y
37        y <- yN
38    }
39    if(plot.it)
40        if (datax)
41            plot(y, x, main = main, xlab = ylab, ylab = xlab, xlim = ylim, ...)
42        else
43            plot(x, y, main = main, xlab = xlab, ylab = ylab, ylim = ylim, ...)
44    invisible(if(datax) list(x = y, y = x) else list(x = x, y = y))
45}
46
47## Splus also has qqnorm.aov(), qqnorm.aovlist(), qqnorm.maov() ...
48
49qqline <- function(y, datax = FALSE, distribution = qnorm,
50                   probs = c(0.25, 0.75), qtype = 7, ...)
51{
52    stopifnot(length(probs) == 2, is.function(distribution))
53    y <- as.vector(quantile(y, probs, names=FALSE, type=qtype, na.rm = TRUE))
54    x <- distribution(probs)
55    if (datax) {
56        slope <- diff(x)/diff(y)
57        int <- x[[1L]] - slope*y[[1L]]
58    } else {
59        slope <- diff(y)/diff(x)
60        int <- y[[1L]] - slope*x[[1L]]
61    }
62    abline(int, slope, ...)
63}
64