phalen (version 1.0)

basher: Basher Penalty

Description

Growth and decay penalties for numeric vectors.

Usage

basher(X, A, K)

Arguments

X

A numeric vector.

A

The value at which the penalty starts.

K

The asymptotic ceiling or floor of penalized vector X.

Value

basher returns an object of class "basher."

y

The numeric vector X with penalities applied.

A

The value at which the penalty starts.

K

The asymptotic ceiling or floor of penalized vector X (i.e., y).

r

The growth or decay rate of the penalty.

M

An extra parameter set so that y = X at A.

penalty

The type of penalty applied.

Details

To create a growth penalty, where values greater than A are penalized, K must be greater than A. The growth penalty is K(1-exp(-r(X-M)))) for all values of X greater than A.

To create a decay penalty, where values less than A are penalized, K must be less than A. The decay penalty is K(1+exp(r(X-M))) for all values of X less than A.

Examples

  # get the inpatient cost per day, sorted
  data(ipadmits)
  attach(ipadmits)
  ipc = sort(ipadmits$cost)
  plot(ipc,type = "l",col = wash("gry",0.8),lwd=3)
  
  # apply penalty starting 2000. Penalized value not to exceed 4500
  ipc.bash = basher(X = ipc, A = 2000, K = 4500)
  lines(ipc.bash$y,col = wash("blu1",1),lwd = 3)
  plot(ipc,ipc,type = "l",col = wash("gry",0.8),lwd=3)
  lines(ipc,ipc.bash$y,col = wash("blu1",1),lwd = 3)
  
  # apply lower penalty ending at 1500.  Penalized value floor = 500
  ipc.bash = basher(X = ipc, A = 1500, K = 500)
  plot(ipc,type = "l",col = wash("gry",0.8),lwd=3)
  lines(ipc.bash$y,col = wash("blu1",1),lwd = 3)
  plot(ipc,ipc,type = "l",col = wash("gry",0.8),lwd=3)
  lines(ipc,ipc.bash$y,col = wash("blu1",1),lwd = 3)
  
  # combine above ceiling and floor penalties
  ipc.bash = basher(X = ipc, A = 2000, K = 4500)
  ipc.bash = basher(X = ipc.bash$y, A = 1500, K = 500)
  
  plot(ipc,type = "l",col = wash("gry",0.8),lwd=3)
  lines(ipc.bash$y,col = wash("blu1",1),lwd = 3)
  plot(ipc,ipc,type = "l",col = wash("gry",0.8),lwd=3)
  lines(ipc,ipc.bash$y,col = wash("blu1",1),lwd = 3)
  detach(ipadmits)