向量/时间序列中的非线性压缩解压缩“x”和“y”轴

Question

例如，我有一个向量y，我想沿“x”“y”轴非线性地改变它并得到转换向量

set.seed(123)
y <- cumsum(rnorm(50))
par(mar=c(0,2,0,0))
plot(y,t="l",lwd=2) ; abline(v=seq(1,length(y),3),col=8)

我找到了一个在“x”轴上进行非线性变换的函数

one_dimensional_fish_eye <- function (x1, x2, y, method="natural"){
  n <- length(y)
  x <- seq(min(x1), max(x1), length=n)
  x3 <- splinefun(x1, x2, method = method)(x)
  if (! all(x3 == sort(x3))) {
    warning("Non monotonic transformation!")
  }
  d <- cbind(x=x3, y=y)
  op1 <- par(mar=c(.1,.1,.1,.1))
  plot(d, type="l", lwd=3, axes = FALSE)
  box()
  abline(v=d[seq(0,length(y),by=ceiling(length(y)/50)),1],col=8)
  op2 <- par(fig=c(.02,.2,.8,.98), mar=c(0,0,0,0), new=TRUE)
  plot(x, x3, type = "l", lwd = 3, axes = FALSE)
  polygon(rep(par("usr")[1:2], 2)[c(1,2,4,3)], 
          rep(par("usr")[3:4], each=2), 
          border = NA, col = "white")
  lines(x, x3, type = "l", lwd = 3, col="blue")
  box(lwd=3, col="blue")
  par(op2)
  par(op1)
  return(d)
}

运行函数

one_dimensional_fish_eye(y = y,
  c(0, .33, .67, 1),
  c(0, .6, .9, 1))

结果

            x          y
 [1,] 0.00000000 -0.5604756
 [2,] 0.04132695 -0.7906531
 [3,] 0.08255667  0.7680552
 [4,] 0.12359192  0.8385636
 [5,] 0.16433545  0.9678513
 [6,] 0.20469003  2.6829163
 [7,] 0.24455843  3.1438325
 [8,] 0.28384341  1.8787713
 [9,] 0.32244773  1.1919184
[10,] 0.36027415  0.7462564
[11,] 0.39722544  1.9703382

我可以对水平轴做同样的事情吗？ 像这样的

hrz <- sin(1:10)*4
plot(y,t="l",lwd=2) ; abline(h=hrz,col=8)

也许有一个包可以进行这种转换？ 谢谢 UPD=============================================== =========

我需要一个函数，它以两个变形向量和一个初始时间序列作为输入，并在输出一个变形时间序列

X = some ts
verical_def = vector
horizontal_def = vector

deform_func = (X , verical_def ,  horizontal_def )
out = deformed X

UPD2============================================ ==== 我不知道这是否会有所帮助，但我会尝试更全面地解释我将要做什么。

我如何看待查找两个时间序列之间距离的函数

1. 有两个时间序列“A”和“B”

2. 有一个函数接受一个时间序列（“B”）和两个失真向量作为输入（关于这个函数的问题在这里）

3. 优化算法使用第2点的函数找到失真向量，以达到ts“B”与ts“A”的最大相似度

我只需要一个可以扭曲水平和垂直轴的函数。

Answer 1

经过一番反思，我认为最好还是使用你找到的函数，并稍微修改一下以达到你的目的..

可能是这样的：

set.seed(123)
y <- cumsum(rnorm(50))
par(mar=c(0,2,0,0))
plot(y,t="l",lwd=2) ; abline(v=seq(1,length(y),3),col=8)

two_dimensional_fish_eye <- function (x1, x2, y1, y2, y, method="natural"){
  n <- length(y)
  x <- seq(min(x1), max(x1), length=n)
  x3 <- splinefun(x1, x2, method = method)(x)
  if (! all(x3 == sort(x3))) {
    warning("Non monotonic transformation on x axis!")
  }
  y3 <- splinefun(y1, y2, method = method)(y)
  y4 <- splinefun(y1, y2, method = method)(seq(min(y),max(y),by=ceiling(length(y)/50)))
  if (! all(y4 == sort(y4))) {
    warning("Non monotonic transformation on y axis!")
  }
  d <- cbind(x=x3, y=y3)
  print(y4)
  op1 <- par(mar=c(.1,.1,.1,.1))
  plot(d, type="l", lwd=3, axes = FALSE)
  box()
  abline(v=d[seq(0,length(y),by=ceiling(length(y)/50)),1],col=8)
  abline(h=y4,col=8)
  par(op1)
  return(d)
}


a <- two_dimensional_fish_eye(y = y,  
                              y1 =  c(-1, -0.67, -0.33, 0, .33, .67, 1),
                              y2 = c(-1, -0.9, -0.6, 0, .6, .9, 1),
                        x1 =  c(0, .33, .67, 1),
                        x2 = c(0, .6, .9, 1))