有没有更优雅的方法将0到1之间的x投影到w形状？

Question

我需要将0到1之间的值（x）投影到w形状（y=f(x)）：

我可以通过以下功能实现我的目标：

f <- function(x) {
  if (x < 0.25) {
    return (1-4*x)
  }
  if (x < 0.50) {
    return (-1 + 4*x)
  }
  if (x < 0.75) {
    return (3 - 4*x)
  }
  return (-3 + 4*x)
}


x <- 0:20/20
y <- lapply(x, f)

plot(x, y)
lines(x,y, col='red')

然而，我倾向于相信我的问题有一个更优雅的解决方案，可能是一个班轮。

R中有这样的事吗？

Answer 1

f <- function(x)
abs(abs(2 - 4 * x) - 1)

plot(f)

Answer 2

这是一个矢量化解决方案。

f2 <- function(x) {
  y <- 1 - 4 * x
  y[0.25 <= x  & x < 0.50] <- -1 + 4 * x[0.25 <= x  & x < 0.50]
  y[0.50 <= x  & x < 0.75] <-  3 - 4 * x[0.50 <= x  & x < 0.75]
  y[0.75 <= x]             <- -3 + 4 * x[0.75 <= x]
  return(y)
}

这样做的好处是它快得多

x <- seq(0, 1, length = 1001)
library(microbenchmark)
microbenchmark(
  original = {y1 <- sapply(x, f)},
  vectorised = {y2 <- f2(x)}
)
all.equal(y1, y2)

时间

Unit: microseconds
       expr      min        lq       mean    median       uq      max neval cld
   original 1170.487 1198.0590 1500.39726 1534.2840 1566.953 8317.288   100   b
 vectorised   51.767   55.2405   58.65856   56.9055   58.981  107.117   100  a 

Answer 3

 f=function(x){ 
      f_x = 4*pmin(abs(x-0.25),abs(x-0.75))
      return(f_x)
     }