Re: [問題] 如何畫abline於特定的區間上
熟知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://www.ptt.cc/bbs/R_Language/M.1437791987.A.BB4.html
推
07/25 16:20, , 1F
07/25 16:20, 1F
→
07/25 16:21, , 2F
07/25 16:21, 2F
我當初撰寫的時候沒有再測試一遍,抱歉
我更改好程式碼了
推
07/25 17:07, , 3F
07/25 17:07, 3F
回有bug的程式碼不如沒回(攤手
推
07/25 19:03, , 4F
07/25 19:03, 4F
→
07/25 19:04, , 5F
07/25 19:04, 5F
→
07/25 19:06, , 6F
07/25 19:06, 6F
→
07/25 19:06, , 7F
07/25 19:06, 7F
直接在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
推
07/25 19:34, , 8F
07/25 19:34, 8F
討論串 (同標題文章)
本文引述了以下文章的的內容:
完整討論串 (本文為第 3 之 3 篇):
R_Language 近期熱門文章
PTT數位生活區 即時熱門文章