qqnorm ve qqline in ggplot2

Question

Kalıntıların qq grafiğini almak istediğim doğrusal bir model LM var. Normalde ben R baz grafikleri kullanırsınız:

qqnorm(residuals(LM), ylab="Residuals") 
qqline(residuals(LM)) 

Ben komplo qqnorm bölümünü nasıl çözebiliriz ama qqline yönetmek gibi olamaz: Sanıyorum

ggplot(LM, aes(sample=.resid)) + 
    stat_qq() 

Oldukça basit bir şeyi özlüyorum ama bunu yapmanın kolay bir yolu olmalı.

DÜZENLEME: Aşağıdaki çözüm için çok teşekkürler. Bilgiyi doğrusal modelden ayıklamak için kodu (çok az) değiştirdim, böylece arsa R temel grafik paketindeki uygunluk grafiği gibi çalışır.

ggQQ <- function(LM) # argument: a linear model 
{ 
    y <- quantile(LM$resid[!is.na(LM$resid)], c(0.25, 0.75)) 
    x <- qnorm(c(0.25, 0.75)) 
    slope <- diff(y)/diff(x) 
    int <- y[1L] - slope * x[1L] 
    p <- ggplot(LM, aes(sample=.resid)) + 
     stat_qq(alpha = 0.5) + 
     geom_abline(slope = slope, intercept = int, color="blue") 

    return(p) 
} 

Answer 1

Aşağıdaki kod, istediğiniz arsayı verecektir. Ggplot paketi qqline parametrelerini hesaplamak için kod içermiyor gibi görünmüyor, bu yüzden (anlaşılabilir) tek linerda böyle bir arsaya ulaşmanın mümkün olup olmadığını bilmiyorum.

qqplot.data <- function (vec) # argument: vector of numbers 
{ 
    # following four lines from base R's qqline() 
    y <- quantile(vec[!is.na(vec)], c(0.25, 0.75)) 
    x <- qnorm(c(0.25, 0.75)) 
    slope <- diff(y)/diff(x) 
    int <- y[1L] - slope * x[1L] 

    d <- data.frame(resids = vec) 

    ggplot(d, aes(sample = resids)) + stat_qq() + geom_abline(slope = slope, intercept = int) 

} 

Answer 2

Neden aşağıdakiler değil? Bazı vektör, diyelim Verilen

,

myresiduals <- rnorm(100)^2 

ggplot(data=as.data.frame(qqnorm(myresiduals , plot=F)), mapping=aes(x=x, y=y)) + 
    geom_point() + geom_smooth(method="lm", se=FALSE) 

Ama bu birlikte geleneksel grafik kullanmak zorunda garip görünüyor ggplot2 desteklemek için çalışır.

Aynı etkiyi kuantum plotu istediğimiz vektörle başlayıp ggplot2'de uygun "stat" ve "geom" işlevlerini uygulayarak bir şekilde bulamaz mıyız?

Hadley Wickham bu mesajları görüntülüyor mu? Belki bize daha iyi bir yol gösterebilir.

Answer 3

Doğrusal modeller için standart Q-Q diyagnostiği, standardize edilmiş artıklarının miktarlarına karşı N (0,1) teorik nicellerini gösterir. @ Peter'ın ggQQ işlevi artıkları çizer. Parçacık aşağıdaki değişikliği yapar ve komployu plot(lm(...))'dan ne alacağı gibi yapmak için birkaç kozmetik değişiklik ekler. Kullanım

ggQQ = function(lm) { 
    # extract standardized residuals from the fit 
    d <- data.frame(std.resid = rstandard(lm)) 
    # calculate 1Q/4Q line 
    y <- quantile(d$std.resid[!is.na(d$std.resid)], c(0.25, 0.75)) 
    x <- qnorm(c(0.25, 0.75)) 
    slope <- diff(y)/diff(x) 
    int <- y[1L] - slope * x[1L] 

    p <- ggplot(data=d, aes(sample=std.resid)) + 
    stat_qq(shape=1, size=3) +   # open circles 
    labs(title="Normal Q-Q",    # plot title 
     x="Theoretical Quantiles",  # x-axis label 
     y="Standardized Residuals") + # y-axis label 
    geom_abline(slope = slope, intercept = int, linetype="dashed") # dashed reference line 
    return(p) 
} 

Örnek:

# sample data (y = x + N(0,1), x in [1,100]) 
df <- data.frame(cbind(x=c(1:100),y=c(1:100+rnorm(100)))) 
ggQQ(lm(y~x,data=df)) 

Answer 4

da bu işlevle güven aralıkları/güven bantları ekleyebilir (car:::qqPlot kopyalanan kod parçaları)

gg_qq <- function(x, distribution = "norm", ..., line.estimate = NULL, conf = 0.95, 
        labels = names(x)){ 
    q.function <- eval(parse(text = paste0("q", distribution))) 
    d.function <- eval(parse(text = paste0("d", distribution))) 
    x <- na.omit(x) 
    ord <- order(x) 
    n <- length(x) 
    P <- ppoints(length(x)) 
    df <- data.frame(ord.x = x[ord], z = q.function(P, ...)) 

    if(is.null(line.estimate)){ 
    Q.x <- quantile(df$ord.x, c(0.25, 0.75)) 
    Q.z <- q.function(c(0.25, 0.75), ...) 
    b <- diff(Q.x)/diff(Q.z) 
    coef <- c(Q.x[1] - b * Q.z[1], b) 
    } else { 
    coef <- coef(line.estimate(ord.x ~ z)) 
    } 

    zz <- qnorm(1 - (1 - conf)/2) 
    SE <- (coef[2]/d.function(df$z)) * sqrt(P * (1 - P)/n) 
    fit.value <- coef[1] + coef[2] * df$z 
    df$upper <- fit.value + zz * SE 
    df$lower <- fit.value - zz * SE 

    if(!is.null(labels)){ 
    df$label <- ifelse(df$ord.x > df$upper | df$ord.x < df$lower, labels[ord],"") 
    } 

    p <- ggplot(df, aes(x=z, y=ord.x)) + 
    geom_point() + 
    geom_abline(intercept = coef[1], slope = coef[2]) + 
    geom_ribbon(aes(ymin = lower, ymax = upper), alpha=0.2) 
    if(!is.null(labels)) p <- p + geom_text(aes(label = label)) 
    print(p) 
    coef 
} 

Örnek:

Animals2 <- data(Animals2, package = "robustbase") 
mod.lm <- lm(log(Animals2$brain) ~ log(Animals2$body)) 
x <- rstudent(mod.lm) 
gg_qq(x) 

Answer 5

Sürüm 2'den beri.0, ggplot2 uzantısı için iyi belgelenmiş bir arayüze sahiptir; (Iyileştirmeler welcome böylece, ilk kez yaptık) bu yüzden artık kolayca kendiliğinden qqline için yeni bir stat yazabilirsiniz:

qq.line <- function(data, qf, na.rm) { 
    # from stackoverflow.com/a/4357932/1346276 
    q.sample <- quantile(data, c(0.25, 0.75), na.rm = na.rm) 
    q.theory <- qf(c(0.25, 0.75)) 
    slope <- diff(q.sample)/diff(q.theory) 
    intercept <- q.sample[1] - slope * q.theory[1] 

    list(slope = slope, intercept = intercept) 
} 

StatQQLine <- ggproto("StatQQLine", Stat, 
    # http://docs.ggplot2.org/current/vignettes/extending-ggplot2.html 
    # https://github.com/hadley/ggplot2/blob/master/R/stat-qq.r 

    required_aes = c('sample'), 

    compute_group = function(data, scales, 
          distribution = stats::qnorm, 
          dparams = list(), 
          na.rm = FALSE) { 
     qf <- function(p) do.call(distribution, c(list(p = p), dparams)) 

     n <- length(data$sample) 
     theoretical <- qf(stats::ppoints(n)) 
     qq <- qq.line(data$sample, qf = qf, na.rm = na.rm) 
     line <- qq$intercept + theoretical * qq$slope 

     data.frame(x = theoretical, y = line) 
    } 
) 

stat_qqline <- function(mapping = NULL, data = NULL, geom = "line", 
         position = "identity", ..., 
         distribution = stats::qnorm, 
         dparams = list(), 
         na.rm = FALSE, 
         show.legend = NA, 
         inherit.aes = TRUE) { 
    layer(stat = StatQQLine, data = data, mapping = mapping, geom = geom, 
      position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
      params = list(distribution = distribution, 
         dparams = dparams, 
         na.rm = na.rm, ...)) 
} 

Bu aynı zamanda dağıtım üzerinde genelleştirildiğinde (tam olarak böyle stat_qq yapar) aşağıdaki gibi ve kullanılabilir:

> test.data <- data.frame(sample=rnorm(100, 10, 2)) # normal distribution 
> test.data.2 <- data.frame(sample=rt(100, df=2)) # t distribution 
> ggplot(test.data, aes(sample=sample)) + stat_qq() + stat_qqline() 
> ggplot(test.data.2, aes(sample=sample)) + stat_qq(distribution=qt, dparams=list(df=2)) + 
+ stat_qqline(distribution=qt, dparams=list(df=2)) 

(qqline ayrı katmanda olduğu için maalesef ben dağıtım parametreleri "yeniden" için bir yol bulamadık, ama bu sadece küçük bir sorun olmalı .)

Answer 6

Bu şeyi normal olasılık kağıtlarıyla yapan eski zamanlayıcılar. Bir ggplot ciddi şekilde göz() + stat_qq() grafik referans çizgisi mükemmel bu

df <- data.frame(y=rpois(100, 4)) 

ggplot(df, aes(sample=y)) + 
    stat_qq() + 
    geom_abline(intercept=mean(df$y), slope = sd(df$y))