在r中添加三階多項式及其方程到ggplot

Question

我繪製了以下數據並添加了一個黃土平滑器。我想添加一個三階多項式及其方程（包括殘差）到圖中。有什麼建議？

set.seed(1410) 
dsmall<-diamonds[sample(nrow(diamonds), 100), ] 
df<-data.frame("x"=dsmall$carat, "y"=dsmall$price) 

p <-ggplot(df, aes(x, y)) 
p <- p + geom_point(alpha=2/10, shape=21, fill="blue", colour="black", size=5) 

#Add a loess smoother 
p<- p + geom_smooth(method="loess",se=TRUE) 

我如何添加一個3階多項式？我曾嘗試過：

p<- p + geom_smooth(method="lm", se=TRUE, fill=NA,formula=lm(y ~ poly(x, 3, raw=TRUE)),colour="red") 

最後如何將三階多項式方程和殘差加到圖上？ 我曾嘗試：

lm_eqn = function(df){ 
    m=lm(y ~ poly(x, 3, df))#3rd degree polynomial 
    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)) 
} 


data.label <- data.frame(x = 1.5,y = 10000,label = c(lm_eqn(df))) 


p<- p + geom_text(data=data.label,aes(x = x, y = y,label =label), size=8,family="Times",face="italic",parse = TRUE) 

Answer 1

第1部分：以適應多項式，使用參數：

• method=lm - 你這樣做是正確
• formula=y ~ poly(x, 3, raw=TRUE) - 即不要在呼叫這個包裹到lm

代碼：

p + stat_smooth(method="lm", se=TRUE, fill=NA, 
       formula=y ~ poly(x, 3, raw=TRUE),colour="red") 

---

第2部分：添加方程式：

• 修改你的函數lm_eqn()正確指定數據源lm - 你在錯誤的地方
有一個右括號
• 使用annotate()來定位標籤，而不是geom_text

代碼：

lm_eqn = function(df){ 
    m=lm(y ~ poly(x, 3), df)#3rd degree polynomial 
    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)) 
} 


p + annotate("text", x=0.5, y=15000, label=lm_eqn(df), hjust=0, size=8, 
      family="Times", face="italic", parse=TRUE) 

Answer 2

答案1，是一個良好的開端，但它不是一個3階多項式爲要求，並能妥善處理不能與參數估計負值。最簡單的就是使用包polynom。我將展示一個沒有定義函數的版本，因爲在這種情況下，應該使用一個ggplotstat_。

下面我將展示如何生成要用作任何度數多項式的解析標籤的文本。我使用signif()而不是format()，因爲這對於參數估計更有用。另請注意，face不再需要。使用family = "Times"不是便攜式的，使用"serif"可以實現同樣的效果。所有的辛苦工作都由as.character.polynomial()完成！

library(polynom) 
library(ggplot2) 

set.seed(1410) 
dsmall <- diamonds[sample(nrow(diamonds), 100), ] 
df <- data.frame("x"=dsmall$carat, "y"=dsmall$price) 

my.formula <- y ~ poly(x, 3, raw = TRUE) 
p <- ggplot(df, aes(x, y)) 
p <- p + geom_point(alpha=2/10, shape=21, fill="blue", colour="black", size=5) 
p <- p + geom_smooth(method = "lm", se = FALSE, 
        formula = my.formula, 
        colour = "red") 

m <- lm(my.formula, df) 
my.eq <- as.character(signif(as.polynomial(coef(m)), 3)) 
label.text <- paste(gsub("x", "~italic(x)", my.eq, fixed = TRUE), 
       paste("italic(R)^2", 
        format(summary(m)$r.squared, digits = 2), 
        sep = "~`=`~"), 
        sep = "~~~~") 

p + annotate(geom = "text", x = 0.2, y = 15000, label = label.text, 
      family = "serif", hjust = 0, parse = TRUE, size = 4) 

最後請注意：方差與平均值增加，所以使用lm()和3階多項式模型可能是不適合這些數據的分析，最好的辦法。