有没有一种更优雅的方式来将0和1之间的x投影到w形？

Question

我需要项目0和1之间的值（x）到AW形状（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) 
    } 

利益0