R语言实现线性拟合

知识清单

  • lm函数
  • lm对象的属性及回归直线各值的调用
  • 改变坐标轴和坐标轴加箭头
  • 限制abline和其他作图函数的作图范围

1. lm函数

lm(formula, data, subset, weights, na.action,
   method = "qr", model = TRUE, x = FALSE, y = FALSE, qr = TRUE,
   singular.ok = TRUE, contrasts = NULL, offset, ...)

formula代表拟合的公式,如Y~X,则对因变量Y和自变量X作线性拟合拟合模型为 y=a+bx,如Y0+X或YX+0则除对因变量Y和自变量X作线性拟合外,还规定改直线必过原点及拟合模型为y=x

2. lm及回归直线各值的调用

lm对象即lm函数返回的值,其属性包括

> x <- 1:10
> y <- rnorm(10)
> line.model <- lm(y~x)
> names(line.model)
[1] "coefficients"  "residuals"     "effects"       "rank"          "fitted.values"
 [6] "assign"        "qr"            "df.residual"   "xlevels"       "call"         
[11] "terms"         "model"  

常用的有coefficientsresidualsfitted.values,分别表示拟合的得到的各系数的值、残差和预测值。

> line.model$coefficients
(Intercept)           x 
 0.52805925 -0.02797779 
> line.model$residuals
         1          2          3          4          5          6          7          8 
-1.5765711  0.7410797  0.2115830  0.2855004 -0.7603608  0.6079035  1.5795988  1.3858017 
         9         10 
-1.0737913 -1.4007440 
> line.model$fitted.values
        1         2         3         4         5         6         7         8         9 
0.5000815 0.4721037 0.4441259 0.4161481 0.3881703 0.3601925 0.3322147 0.3042369 0.2762591 
       10 
0.2482813 

可以看出该拟合曲线为y=0.52805925 -0.02797779x

其他值的调用,包括p值,给定x预测的y值,拟合系数R方等需要通过summary函数调用

  • p值
f <- summary(line.model)$fstatistic
pf(f[1], f[2], f[3], lower.tail=F)
   value 
0.8384057 
  • 给定x预测相应的y值
predict(line.model, data.frame(x=c(0, 1, 2)))
        1         2         3 
0.5280593 0.5000815 0.4721037 
  • 拟合系数R方
summary(line.model)$r.squared
summary(line.model)$adj.r.squared
[1] 0.005517545
[1] -0.1187928

也可以直接通过summary(line.model)打印出大部分与回归直线相关的一些结果

3. 改变坐标轴、坐标轴加箭头、限制abline和其他作图函数的作图范围见下述代码

# Cairo::CairoPDF("ELISA.pdf", width=7, height=5)
# Cairo::CairoPNG("ELISA.png", width=1400, height=1000, res=200)

# raw data each data has been replicated measured twice
# the last row is the measure of sample
raw_data1 <- c(0.053, 0.057,
               0.366, 0.315,
               0.677, 0.679,
               0.764, 0.792,
               1.008, 0.824,
               0.588, 0.326)

# clean data
data_norm1 <- raw_data1[seq(1, 11, 2)]
data_norm2 <- raw_data1[seq(2, 12, 2)]
data_norm <- (data_norm1+data_norm2)/2
data_norm <- data_norm -data_norm[1]
data1 <- data.frame(conc=c(0, 12.5, 25, 50, 100), od=data_norm[-length(data_norm)])

# line model fit (the model is y=b*x)
line.model <- lm(od~0+conc, data=data1)

# rsquared
summary(line.model)$r.squared

# f statistic
f <- summary(line.model)$fstatistic

# pvalue
pf(f[1], f[2], f[3], lower.tail=F)

# the data to be fitted renamed to x and y
x = data1$conc
y = data1$od

# par(family='Sans SimHei')
# 做散点图,并把坐标轴隐藏,
plot(x, y, pch=16, xlab="浓度 (pg/ml)", ylab="490nm OD值", bty="n",
     xlim=c(min(x), max(x))+c(0, 0.2)*(max(x)-min(x))/5,
     ylim=c(min(y), max(y))+c(0, 0.2)*(max(y)-min(y))/5,
     main="ELISA 标准曲线", axes=FALSE, family = "Microsoft Yahei")

# 自定义坐标轴,at为坐标点位置,labels默认为坐标点的数值
# tck表示坐标刻度长度,pos表示坐标轴的位置
axis(2, at=round(seq(0, max(y), length=7), 2), las=2, tck=0.01, pos=0)
axis(1, at=round(seq(0, max(x), length=6), 2), las=1, tck=0.01, pos=0)

# clip限制当前作图区域的界限
clip(-2, 120, -1, 1)
# 坐标轴加箭头
arrows(100, 0, 105, 0, length=0.1)
arrows(0, max(y), 0, max(y)+0.1, length=0.1)

# 作拟合直线
clip(min(x), max(x), min(y), max(y)+(max(y)-min(y))/6)
abline(line.model, lwd=2, col="red")

# 标注直线方程和拟合系数
text1 <- paste("y = ", round(line.model$coefficients, 5),"x",sep="")
text(x=quantile(x, 0.80), y=quantile(y, .39),
     labels= substitute(paste(text1, r.squared, sep=''), list(
       text1=paste(text1, "\n"), r.squared="")),
     adj=c(0,0))
text(x=quantile(x, 0.80), y=quantile(y, .39),
     labels= substitute(paste(text1, R^2, " = ", r.squared, sep=''), list(
       text1="\n", r.squared=round(summary(line.model)$r.squared, 4))),
     adj=c(0,0))

# 标注样本点
absorb_target = data_norm[length(data_norm)]
conc_target <- absorb_target/line.model$coefficients
points(conc_target, absorb_target, pch=16, col="blue", cex=1.3)
clip(0, conc_target, 0, absorb_target*2)
abline(h=absorb_target, lty=2)
clip(0, conc_target+1, 0, absorb_target)
abline(v=conc_target, lty=2)

# 标注样本点坐标值
clip(min(x), max(x), min(y), max(y)+(max(y)-min(y))/6)
text(conc_target+16, absorb_target, 
     paste("(", round(conc_target, 3), ", ",  round(absorb_target, 3), ")", sep=""))

# dev.off()
ELISA line model.png
最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 194,524评论 5 460
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 81,869评论 2 371
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 141,813评论 0 320
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 52,210评论 1 263
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 61,085评论 4 355
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 46,117评论 1 272
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 36,533评论 3 381
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 35,219评论 0 253
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 39,487评论 1 290
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 34,582评论 2 309
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 36,362评论 1 326
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 32,218评论 3 312
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 37,589评论 3 299
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 28,899评论 0 17
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 30,176评论 1 250
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 41,503评论 2 341
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 40,707评论 2 335

推荐阅读更多精彩内容