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