※ 引述《jackhzt (巴克球)》之铭言：
: [问题类型]:
: 程式咨询(我想用R 做某件事情，但是我不知道要怎么用R 写出来)
: [软件熟悉度]:
: 入门(写过其他程式，只是对语法不熟悉)
: [问题叙述]:piecewise linear approximation(PLA)
: 目的:使用线性的方式，切割一个序列 ( 时间序列)
: 目标方法: 简单来说连结起点和终点， 依时间依序比较点和线的距离
: 太大就将点和终点连线， 以新的线再依序和接下来的点比距离， 重复做
: 以下是原文叙述:
:
:
: 问题:
: (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)