使用facet_wrap時，顯示每個散點圖的回歸方程和R ^ 2

Question

我有一個data.frame（我使用融化函數融化），我從中生成多個散點圖並使用以下方法擬合回歸線：

ggplot(dat, aes(id, value)) + geom_point() + geom_smooth(method="lm", se=FALSE) + facet_wrap(variable~var1, scales="free")

我想在每個散點圖中添加回歸方程和R ^ 2用於相關回歸（即每個散點圖中由geom_smooth產生的回歸方程）。

---

上面的var1只是融化數據的一個id列的名稱，我面對與facet_wrap的facet_grid instad相同的問題。

Answer 1

我實際上已經解決了這個問題，請參閱下面的一個實例，其中因變量是var1。 這是一個時間序列數據集，如果與您的問題無關，請忽略日期部分。

library(plyr)
library(ggplot2)

rm(dat)
dat <- read.table("data.txt", header = TRUE, sep = ",")
dat <- transform(dat, date = as.POSIXct(strptime(date, "%Y-%m-%dT%H:%M:%OS")))

rm(dat.m)
dat.m <- melt(dat, id = c('ccy','date','var1'))

lm_eqn = function(df){
  m = lm(var1 ~ value, df);
  eq <- substitute(italic(y) == a + b %.% italic(x)*","~~italic(r)^2~"="~r2, 
                   list(a = format(coef(m)[1], digits = 2), 
                        b = format(coef(m)[2], digits = 2), 
                        r2 = format(summary(m)$r.squared, digits = 3)))
  as.character(as.expression(eq));                 
}

mymax = function(df){
  max(df$value)
}

rm(regs)
regs <- ddply(dat.m, .(ccy,variable), lm_eqn)
regs.xpos <- ddply(dat.m, .(variable), function(df) (min(df$value)+max(df$value))/2)
regs.ypos <- ddply(dat.m, .(ccy,variable), function(df) min(df$var1) + 0.05*(max(df$var1)-min(df$var1)))

regs$y <- regs.ypos$V1
regs$x <- regs.xpos$V1

rm(gp)
gp <- ggplot(data=dat.m, aes(value, var1)) + geom_point(size = 1, alpha=0.75) + geom_smooth() + geom_smooth(method="lm", se=FALSE, color="red") + geom_text(data=regs, size=3, color="red", aes(x=x, y=y, label=V1), parse=TRUE) + facet_grid(ccy~variable, scales="free")
ggsave("data.png", gp, scale=1.5, width=11, height=8)

Answer 2

好的解決方案 我很驚訝ggplot沒有內置函數來執行此操作...我需要顯示多項式擬合的方程式和R2值（由splines包中的ns（x，order）函數生成），並且已經擴展你的lm_eqn函數可以容納不同階數的多項式。

免責聲明：我對R編碼還很陌生，我知道這段代碼非常混亂。 必須有一個更好的方法來做到這一點，我將開始另一個線程，要求人們改進代碼，並可能將其擴展到其他合適的模型......你可以在這里關注它： https：// groups。 google.com/forum/?fromgroups#!forum/ggplot2

lm_eqn = function(df,x.var,y.var,signif.figs,eq.plot=T,model.type,order){
  if(missing(x.var) | missing(y.var) | class(x.var)!='character' | class(y.var)!='character') stop('x.var and y.var must be the names of the columns you want to use as x and y as a character string.' )
  if(missing(model.type)) stop("model.type must be 'lin' (linear y~x model) or 'poly' (polynomial y~ns(x,order) model, generated by splines package).")
  if(model.type=='poly' & missing(order)) stop("order must be specified if poly method is used.")

  if(eq.plot==T) {
    # Linear y=mx+c equation
    if(model.type=='lin') {
      fit = lm(df[[y.var]] ~ df[[x.var]]);
      eq <- substitute(italic(y) == c + m %.% italic(x)*","~~italic(r)^2~"="~r2, 
                       list(c = signif(coef(fit)[1], signif.figs), 
                            m = signif(coef(fit)[2], signif.figs), 
                            r2 = signif(summary(fit)$r.squared, signif.figs)))
      as.character(as.expression(eq));
    }
    # polynomial expression generated with the ns(x,order) function [splines package]
    if(model.type=='poly') {
      fit = lm(df[[y.var]] ~ ns(df[[x.var]],order));

      base = gsub('!c!',signif(coef(fit)[1],signif.figs),"italic(y) == !c! + ")
      element.1 = "!m! %.% italic(x)~"
      element.2 = " + !m! %.% italic(x)^!o!~"
      element.r2 = gsub('!r2!',signif(summary(fit)$r.squared,signif.figs),"~~italic(r)^2~\"=\"~!r2!")
      eq=""

      for(o in 1:(order)) {
        if(o==1) {
          if(coef(fit)[(o+1)]<0) tmp=gsub("[+]","",base) else tmp=base
          eq=paste(tmp,gsub('!m!',signif(coef(fit)[(o+1)],signif.figs),element.1),sep="")
        }
        if(o>1) {
          if(coef(fit)[(o+1)]<0) tmp=gsub("[+]","",element.2) else tmp=element.2
          eq=paste(eq,gsub('!o!',o,gsub('!m!',signif(coef(fit)[(o+1)],signif.figs),tmp)),sep="")
        }
        if(o==(order)) eq=paste(eq,"\",\"",element.r2,sep="")
      }
    }
  }
  if(eq.plot==F) {
    # Linear y=mx+c equations
    if(model.type=='lin') {
      fit = lm(df[[y.var]] ~ df[[x.var]]);
      eq <- substitute(italic(r)^2~"="~r2, 
                       list(r2 = signif(summary(fit)$r.squared, signif.figs)))
      as.character(as.expression(eq));
    }
    # polynomial expression generated with the ns() function [splines package]
    if(model.type=='poly') {
      fit = lm(df[[y.var]] ~ ns(df[[x.var]],order));

      eq = gsub('!r2!',signif(summary(fit)$r.squared,signif.figs),"italic(r)^2~\"=\"~!r2!")
    }
  }
  return(eq)
}