File: taperoff.R

package info (click to toggle)
r-cran-sparr 2.3-16-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 884 kB
  • sloc: makefile: 2
file content (18 lines) | stat: -rw-r--r-- 698 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

taperoff <- function(x, zeropoint=0, onepoint=1,
                     type=c("smooth", "cosine")) {
  type <- match.arg(type)
  #   cosine taper is standard in engineering (apparently)
  #
  #   smooth taper is the pure mathematicians' favorite example
  #                of a Smooth Partition of Unity
  y <- (x-zeropoint)/(onepoint - zeropoint)
  z <- switch(type,
              cosine = ifelse(y <= 0, 0,
                              ifelse(y >= 1, 1,
                                     (1 - cos(pi * y))/2)),
              smooth = ifelse(y <= 0, 0,
                              ifelse(y >= 1, 1,
                                     exp(-1/y)/(exp(-1/y) + exp(-1/(1-y))))))
  return(z)
}