# Stretch time series vectors

Jan 31st, 2013
223
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. visit my blog: http://reakkt.com
2.
3. ## StretchVector
4. # x - rozciagany wektor
5. # n - docelowa dlugosc wektora
6. StretchVector <- function(x,n) {
7.
8.   k <- length(x)
9.
10.   if (k>1) {
11.
12.     to.fill <- n-k
13.
14.     fill.avg <- ceiling(n/k)
15.
16.     fill.vector <- rep(fill.avg,k)
17.
18.     while (sum(fill.vector)!=n) {
19.
20.       # znak wymaganej korekty
21.       correction.sign <- ifelse(sum(fill.vector)>n,-1,+1)
22.
23.       # wielkosc wymaganej korekty
24.       correction.needed <- sum(fill.vector)-n
25.
26.       # srednia wymagana korekta
27.       correction.avg <- ceiling(correction.needed/k)
28.
29.       # inicjalizacja wektora korekcyjnego
30.       correction.vector <- rep(1,correction.needed)
31.
32.       # losowanie pozycji 'fill.vector', ktore maja zostac skorygowane
33.       correction.positions   <- sample(1:k,correction.needed)
34.
35.       fill.vector[correction.positions] <- fill.vector[correction.positions]+correction.vector*correction.sign
36.
37.     }
38.
39.   } else fill.vector <- n
40.
41.   # wlasciwe rozciaganie wektora 'x'
42.
43.   x.stretched <- NULL
44.
45.   for (i in 1:k) x.stretched <- c(x.stretched,rep(x[i],fill.vector[i]))
46.
47.   return( list(x=x.stretched, v=fill.vector) )
48.
49. }
50.
51. # najdluzszy wektor:
52. x1l <- round(runif(1,100,200))
53.
54. n <- x1l
55.
56. x2l <- round(runif(1,3,n*0.9))
57. x3l <- round(runif(1,3,n*0.9))
58.
59. x1 <- cumsum(rnorm(x1l))
60. x2 <- cumsum(rnorm(x2l))
61. x3 <- cumsum(rnorm(x3l))
62.
63. x2s <- StretchVector(x2,n)
64. x3s <- StretchVector(x3,n)
65.
66. # zaznaczanie oryginalnych punktow wektorow:
67. x2s\$o <- NULL; for (i in 1:length(x2s\$v)) x2s\$o <- c(x2s\$o,x2[i],rep(NA,x2s\$v[i]-1))
68. x3s\$o <- NULL; for (i in 1:length(x3s\$v)) x3s\$o <- c(x3s\$o,x3[i],rep(NA,x3s\$v[i]-1))
69.
70. x.all <- cbind(x1,x2s\$x,x3s\$x)
71.
72. matplot(x.all,type="l",lty="solid")
73. points(x2s\$o,col="Red")
74. points(x3s\$o,col="Green")
75. # srednia:
76. lines(apply(x.all, 1, mean),type="l",lty="dotted",lwd=4,col="Black")
77.
78. # oryginalne dlugosci wektorow:
79. n;x2l;x3l