作者celestialgod (攸蓝)
看板R_Language
标题Re: [问题] 如何画abline於特定的区间上
时间Sat Jul 25 10:39:44 2015
熟知lattice的话，用它的panel function可以让code变得很简洁
而且写起来也不会像是R内建的plot冗长
还提供groups绘图的功能，不需要回圈去做各个模型
范例如下：
library(data.table)
library(dplyr)
library(magrittr)
library(lattice)
library(ifultools)
dat = data.table(x = seq(0,2*pi,length=50), y = runif(50))
z = with(dat, linearSegmentation(x,y,n.fit = 10,angle.tolerance=15))
dat %<>% mutate(groups = cut(1:nrow(.), c(0, z, nrow(.)))) %>%
mutate(groups = paste0("group ", as.integer(groups)))
panel.partlmline = function(x, y, ..., identifier = "plmline"){
if (length(x) > 1)
{
coefs = coef(lm(as.numeric(y) ~ as.numeric(x)))
panel.curve(coefs[1]+coefs[2]*x, min(x), max(x), ...)
}
}
# 直接从panel.lmline下去做更改，要画part line请爱用curve
xyplot(y ~ x, dat, type = "b", group = groups,
panel = function(x, y, groups, subscripts, ...){
panel.xyplot(x, y, groups = groups, subscripts = subscripts, ...)
panel.abline(v = x[z], lty=2)
panel.superpose(x, y, groups = groups, subscripts = subscripts, ...,
panel.groups = "panel.partlmline", lwd = 2)
}, auto.key = list(points = FALSE, lines = TRUE, columns = 2))
图长这样：
http://i.imgur.com/K2qoMPz.png
-
※ 引述《sinclairJ (SunnyGymBoy)》之铭言：
: 如题 abline画出的线都是占整个版面 如下图
: ppt.cc/Nivoy
: 我要如何只画特定的区间? 如下图
: ppt.cc/9HpS6
: 目前的程式码如下
: #产生资料
: x=runif(50)
: y=runif(50)
: #得知区间
: library(ifultools)
: x <- seq(0,2*pi,length=50)
: y <- as.numeric(y)
: z <- linearSegmentation(x,y,n.fit = 10,angle.tolerance=15)
: plot(x,y,type="o", col="blue")
: abline(v=x[z], lty=2)
: #>z [1]14 36 表示1-13个资料点做一次回归 14~35 36~50以此类推
: #产生三个区间之资料
: data=t(rbind(x,y))
: data1=as.data.frame(data[c(1:13),])
: data2=as.data.frame(data[c(14:35),])
: data3=as.data.frame(data[c(36:50),])
: #分别对三个区间做回归
: model1=lm(y~x,data1) #intercept=0.5041,slope=-0.00728
: model2=lm(y~x,data2) #intercept=0.41374 ,slope=0.03807
: model3=lm(y~x,data3) #intercept=1.6148 ,slope=-0.2295
: #画abline
: abline(a=0.5041,b=-0.00728,col="red",lwd=2)
: abline(a=0.41374,b=0.003807,col="green",lwd=2)
: abline(a=1.6148,b=-0.2295,col="blue",lwd=2)
: 有请各位先进教导小弟一下~感谢!
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 123.205.27.107
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1437791987.A.BB4.html
2F：→ sinclairJ: 请问c大这是什麽原因? 07/25 16:21
我当初撰写的时候没有再测试一遍，抱歉
我更改好程式码了
3F：推 sinclairJ: 您客气了 没有你不知道该如何是好 我晚点试试看~谢谢! 07/25 17:07
回有bug的程式码不如没回(摊手
4F：推 sinclairJ: C大再请问一下 若我要在某个group的center line之上下 07/25 19:03
5F：→ sinclairJ: 再多画两条线 有点像管制图的概念这样 想请教这样如何 07/25 19:04
6F：→ sinclairJ: 完成?因为刚想直接用segments在图上加上线段 07/25 19:06
7F：→ sinclairJ: 但他说必须要重新画一个新的 QQ 07/25 19:06
直接在panel.partlmline里面加panel.curve
panel.partlmline = function(x, y, ..., identifier = "plmline"){
if (length(x) > 1)
{
coefs = coef(lm(as.numeric(y) ~ as.numeric(x)))
panel.curve(coefs[1]+coefs[2]*x, min(x), max(x), ...)
panel.curve(ub_coefs[1]+ub_coefs[2]*x, min(x), max(x), ...)
panel.curve(lb_coefs[1]+lb_coefs[2]*x, min(x), max(x), ...)
}
}
ub_coefs, lb_coefs就看你怎麽算出来
※ 编辑: celestialgod (123.205.27.107), 07/25/2015 19:14:34
8F：推 sinclairJ: 晚点试试看! 感谢! 07/25 19:34