Re: [問題] 關於線性的近似方法 有點怪
※ 引述《jackhzt (巴克球)》之銘言：
: [問題類型]:
: 程式諮詢(我想用R 做某件事情，但是我不知道要怎麼用R 寫出來)
: [軟體熟悉度]:
: 入門(寫過其他程式，只是對語法不熟悉)
: [問題敘述]:piecewise linear approximation(PLA)
: 目的:使用線性的方式，切割一個序列 ( 時間序列)
: 目標方法: 簡單來說連結起點和終點， 依時間依序比較點和線的距離
: 太大就將點和終點連線， 以新的線再依序和接下來的點比距離， 重複做
: 以下是原文敘述:
: http://imgur.com/eUcKxg6
: 問題:
: (step1):
: Input time series Q(i : j) and threshold value "error". A vector Bp
: is used to restore the breakpoints. "k" records the number of
: the present breakpoints. "pos" denotes the position of the
: newest breakpoint.
: Initially, i = 1, j = m, where m is the length of time series.
: Since the first point and the last point
: are the special breakpoints, let k = 2, Bp(1) = q1 and
: Bp(2) = qm.
: (step2):
: For time series Q(i : j), create line segment L(i : j) according
: to the formula (6). Set two variables l = i + 1 and
: best_so_far = 0. *公式6在我的程式碼中有付
: (step3):
: Calculate the distance of point ql to the line segment L(i : j),
: that is D(ql,L(i : j)).
: (step4):
: If D(ql,L(i : j)) > best_so_far, best_so_far = D(ql,L(i : j)) and
: pos = l.
: (step5):
: l = l + 1. If l>=j, go to the step 6; otherwise, go back to step3.
: (step6):
: If best_so_farPe, k = k + 1, Bp(k) = q_pos, go back to the Step
: 2 and let the two subsequences Q(i : pos) and Q(pos : j)
: redo the step 2 to step 6, respectively.
: (step7):
: Sort the element of vector Bp by an ascending time and
: output the sorted result.
: 出自:http://tinyurl.com/hhosdmk -3.1
: 1.我的程式碼看起來有點問題，尤其是step 6這地方不太會表示，有高手可以解惑嗎?
: 2.有沒有比較正常的打法?我的打法好像問題很大
: 3.package方面有試過一些，但是有辦法表達和上面敘述一樣的package目前好像沒找到
: 程式碼可貼於以下網站： http://ideone.com/TOEISf
: 求高手救援
我不確定我有做對，看圖應該是對了
基本上這個要套用遞迴才能解決
程式如下：
好讀版：http://pastebin.com/95ATSHHV
q<-c(18, 15, 24, 23, 18, 22, 19, 29, 22, 25, 20, 19, 18, 20, 26, 32,
26, 26, 34, 29, 23, 34, 22, 19, 21, 19, 34, 23, 23, 23, 30, 21,
15, 29, 32, 19, 21, 28, 22, 32, 29, 25, 28, 28, 23, 12, 26, 24,
27, 14, 38, 27, 28, 25, 38, 34, 25, 37, 15, 28, 15, 23, 23, 28,
15, 15, 19, 25, 28, 16, 19, 17, 23, 19, 16, 18, 18, 17, 20, 18,
21, 13, 11, 12, 13, 16, 13, 16, 10, 13, 14, 6, 19, 18, 19, 15,
17, 6, 14, 28, 15, 20, 16, 12)
# distance function
dis_f <- function(t, q, i, j){
a <- (q[j]-q[i])/(j-i)
abs((q[i]*j-q[j]*i)/(j-i) + a * t - q[t]) / sqrt(a^2 + 1)
}
pla <- function(q, i, j, time, eplison){
if (i > j || j - i <= 1)
return(sort(time))
# find the maximum distance (Following two lines represents the Step 3~5)
dis_t <- dis_f((i+1):(j-1), q, i, j) # calculate distance of qi~qj
loc <- which.max(dis_t)
# find the position
pos <- i + loc
# record the position
best_so_far <- dis_t[loc]
# print the segment
cat(sprintf("segment: %i, %i, %.2f\n", i, j, best_so_far))
# Step 6: find more segments
if (best_so_far >= eplison)
{
# record the time
time <- c(time, pos)
if (pos < j)
{
time <- pla(q, i, pos, time, eplison)
time <- pla(q, pos, j, time, eplison)
}
}
return(sort(time))
}
# calculate eplison
eplison <- sd(dis_f(1:length(q), q, 1, length(q)))
time <- pla(q, 1, length(q), c(1, length(q)), eplison)
plot(1:length(q), q,type="o")
lines(time, q[time], col = 2)
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 140.109.74.87
※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1458630164.A.3E0.html
※ 編輯: celestialgod (140.109.74.87), 03/22/2016 15:06:07
推
03/22 15:25, , 1F
03/22 15:25, 1F
討論串 (同標題文章)
本文引述了以下文章的的內容：
完整討論串 (本文為第 2 之 2 篇)：
R_Language 近期熱門文章
PTT數位生活區 即時熱門文章