# R/limit.R In AkselA/R-kelvincol:

```fitrange <- function(W, lower=0, upper=1) {
if (lower > upper) warning("upper bound must be strictly larger than lower bound")
if (length(W) == 0) return(numeric(0))
newrange <- upper - lower
oldrange <- max(W, na.rm=TRUE) - min(W, na.rm=TRUE)
if (oldrange == 0) {
d <- abs(W - lower) < abs(W - upper)
ifelse(d, lower, upper)
} else {
(W - min(W, na.rm=TRUE)) * (newrange/oldrange) + lower
}
}

limiter <- function(x, type=c("medium", "soft", "hard")) {
type <- match.arg(type)

dtf <- data.frame(
x=c(-0.5, 0, 0.29, 0.5, 0.71, 1, 1.5),
y=c( 0,   0, 0.25, 0.5, 0.75, 1, 1  ))

switch(type,
"hard" = {
x[x < 0] <- 0
x[x > 1] <- 1
x
},
"medium" = {
spline(dtf, xout=x, method="hyman")\$y
},
"soft" = {
spline(dtf[-c(3, 5),], xout=x, method="hyman")\$y
}
)
}

softlimit <- function(x, limit=c(-1, 1)) {
mid <- mean(limit)
dtf <- data.frame(
x=c(-1+limit[1], limit[1], mid, limit[2], limit[2]+1),
y=c(   limit[1], limit[1], mid, limit[2], limit[2] ))

spline(dtf, xout=x, method="hyman")\$y
}
```
AkselA/R-kelvincol documentation built on May 26, 2019, 6:38 a.m.