Shape-Constrained Local Linear Regression via Douglas-Rachford

Description

Local linear regression is applied to bivariate data. The response is ‘sharpened’ or perturbed in a way to render a curve estimate that satisfies some specified shape constraints.

Usage

DR_sharpen(
x, y, xgrid=NULL, M=200,  h=NULL, mode=NULL, 
    ratio_1=0.14,ratio_2=0.14,ratio_3=0.14,ratio_4=0.14,
    constraint_1=NULL, constraint_2=NULL, constraint_3=NULL,
    constraint_4=NULL, norm="l2", augmentation=FALSE, maxit = 10^5)

Arguments

Details

Data are perturbed the smallest possible L2 or L1 or Linf distance subject to the constraint that the local linear estimate satisfies some specified shape constraints.

Value

Author(s)

D.Wang and W.J.Braun

References

Wang, D. (2022). Penalized and constrained data sharpening methods for kernel regression (Doctoral dissertation, University of British Columbia).

Examples

set.seed(1234567)
gam<-4
g <- function(x) (3*sin(x*(gam*pi))+5*cos(x*(gam*pi))+6*x)*x
n<-100
M<-200
noise <- 1
x<-sort(runif(n,0,1))
y<-g(x)+rnorm(n,sd=noise)
z<- seq(min(x)+1/M, max(x)-1/M, length=M) ############xgrid points
h1<-dpill(x,y)
A<-lprOperator(h=h1,x=x,z=z,p=1)
local_fit<-t(A)
ss_1<-c(sign(numericalDerivative(z,g,k=1)))
DR_sharpen(x=x, y=y, xgrid=z, h=h1, constraint_1=ss_1, norm="linf",maxit =10^3)

Ridge/Enet/LASSO Sharpening via the mean/local polynomial regression with large bandwidth/linear regression.

Description

This is a function to shrink responses towards their mean/estimations of local polynomial regression with large bandwidth/estimations of linear regression as a form of data sharpening to remove roughness, and reduce the bias (when "combine=TRUE"), prior to use in local polynomial regression.

Usage

RELsharpening(x,y,alpha,type,bigh,hband,combine)

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-RELsharpening(x, y,alpha=c(0.2,0.8),"big_h", dpill(x,y)*4, dpill(x,y),combine=TRUE)
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Penalized data sharpening for Local Linear, Quadratic and Cubic Regression

Description

Penalized data sharpening has been proposed as a way to enforce certain constraints on a local polynomial regression estimator. In addition to a bandwidth, a coefficient of the penalty term is also required. We propose propose systematic approaches for choosing these tuning parameters, in part, by considering the optimization problem from the perspective of ridge regression.

Usage

data_sharpening(xx,yy,zz,p,h=NULL,gammaest=NULL,penalty,lambda=NULL)

Arguments

Value

the sharpened response variable.

Author(s)

D.Wang and W.J.Braun

Examples

  set.seed(1234567)
  gam<-4
  gamest<-gam
  g <- function(x) 3*sin(x*(gam*pi))+5*cos(x*(gam*pi))+6*x
  sigma<-3
  xx<-seq(0,1,length=100)
  yy<-g(xx)+rnorm(100,sd=sigma)
  zz<-xx
  h1<-dpilc(xx,yy)
  local_fit<-t(lprOperator(h=h1,xx=xx,zz=zz,p=2))%*%yy
  y_sharp<-data_sharpening(xx=xx,yy=yy,zz=zz,p=2,gammaest=gamest,penalty="Periodicity")
  sharp_fit<-t(lprOperator(h=h1,xx=xx,zz=zz,p=2))%*%y_sharp
  plot(c(min(xx),max(xx)),c(min(yy)-0.5,max(yy)+0.5),type="n",,xlab="x",ylab="y")
  legend("bottomright",legend=c("curve_local","curve_sharpen"), col=c(1,3),bty="n",pch=c("-","-"))
  lines(xx,local_fit)
  lines(xx,sharp_fit,col=3, lwd=2)
  points(xx,yy,col= rgb(0.8,0.2,0.2,0.2))

Shape Constraint Matrix Construction

Description

Construct a shape constraint matrix at a corresponding sequence of x data and sequence of gridpoint z.

Usage

  derivOperator(penalty,gamma,h, xx,zz,p) 

Arguments

Value

shape constraint matrix

Author(s)

X.J. Hu

Select a Bandwidth for Local Quadratic and Cubic Regression

Description

Use direct plug-in methodology to select the bandwidth of a local quadratic and local cubic Gaussian kernel regression estimate, as an extension of Wand's dpill function.

Usage

dpilc(xx, yy, blockmax = 5, divisor = 20, trim = 0.01,
                 proptrun = 0.05, gridsize = 401L, range.x = range(x))

Arguments

Details

This function is a local cubic (also quadratic) extension of the dpill function of Wand's KernSmooth package. The kernel is the standard normal density. Least squares octic fits over blocks of data are used to obtain an initial estimate. As in Wand's implementation of the Ruppert, Sheather and Wand selector, Mallow's C_p is used to select the number of blocks. An option is available to make use of a periodic penalty (with possible trend) relating the 4th derivative of the regression function to a constant (gamma) times the 2nd derivative. This avoids the need to calculate the octic fits and reverts back to the original quartic fits of dpill with appropriate adjustments to the estimated functionals needed in the direct-plug-in bandwidth calculation. This code is similar to dpilq but uses a 6th degree polyomial approximation instead of an 8th degree polynomial approximation.

Value

the selected bandwidth.

Warning

If there are severe irregularities (i.e. outliers, sparse regions) in the x values then the local polynomial smooths required for the bandwidth selection algorithm may become degenerate and the function will crash. Outliers in the y direction may lead to deterioration of the quality of the selected bandwidth.

Author(s)

D.Wang and W.J.Braun

References

Ruppert, D., Sheather, S. J. and Wand, M. P. (1995). An effective bandwidth selector for local least squares regression. Journal of the American Statistical Association, 90, 1257–1270.

Wand, M. P. and Jones, M. C. (1995). Kernel Smoothing. Chapman and Hall, London.

See Also

ksmooth, locpoly.

Examples

x <- faithful$eruptions
y <- faithful$waiting
plot(x, y)
h <- dpill(x, y)
fit <- locpoly(x, y, bandwidth = h, degree=1)
lines(fit)
h <- dpilc(x, y)
fit <- locpoly(x, y, bandwidth = h, degree=2)
lines(fit, col=3, lwd=2)
fit <- locpoly(x, y, bandwidth = h, degree=3)
lines(fit, col=2, lwd=2)

dpilc_PTW: Local Polynomial Bandwith Estimation with Blockwise Selection and Pointwise Results

Description

The function uses raw or trimmed data, applies grid-based binning, and estimates local bandwidth based on the provided parameters.

Usage

dpilc_PTW(xx, yy, blockmax = 5, divisor = 20, trim = 0.01, proptrun = 0.05, 
          gridsize = 401L, range.x = range(x), use_raw_data = FALSE)

Arguments

Details

This function provides a point-wise calculation of the functional theta(4,4) at each data point \(x_i\). It employs various auxiliary functions for binning the data, calculating local polynomial estimations, and performing necessary cross-validation. The function returns a point-wise estimate of the relevant quantity, which is used for localized analysis of the data distribution.

The core methodology used in this function is based on the nonparametric regression framework. For detailed information on the theoretical aspects and derivations, refer to Chapter 3 of Fan and Gijbels (1996).

Value

A list with three elements:

Author(s)

D.Wang and W.J.Braun

References

Fan, J., & Gijbels, I. (1996). Local Polynomial Modelling and its Applications. Chapman and Hall/CRC.

See Also

locpoly

Examples

  # Example usage:
  x <- rnorm(100)
  y <- rnorm(100)

  # Run the pointwise estimation
  result <- dpilc_PTW(x, y, blockmax = 5, divisor = 20, trim = 0.01, 
                      proptrun = 0.05, gridsize = 40, range.x = range(x), 
                      use_raw_data = TRUE)
  
  # Inspect the result
  plot(result$x, result$h, type = "l", col = "blue", xlab = "X", ylab = "Bandwidth Estimate")

Local Polynomial Estimator Matrix Construction

Description

Construct a matrix based on the local polynomial estimation at a corresponding sequence of x data and sequence of gridpoint z.

Usage

  lprOperator(h,xx,zz,p)

Arguments

Value

local polynomial estimator matrix

Author(s)

X.J. Hu

Noon Temperatures in Winnipeg, Manitoba

Description

Time Series of noon temperature observations from the Winnipeg International Airport from January 1, 1960 through December 31, 1980.

Usage

data(noontemp)

Format

A single vector.

Numerical Derivative of Smooth Function

Description

Cubic spline interpolation of columns of a matrix for purpose of computing numerical derivatives at a corresponding sequence of gridpoints.

Usage

numericalDerivative(x, g, k, delta=.001) 

Arguments

Value

numeric vector of kth derivative of g(x)

Author(s)

W.J. Braun

Projection operator for rectangle or nonnegative space

Description

Compute the projection operator for rectangle or nonnegative space. For example, we construct

\lambda P_{C}(x/\lambda) = projection_C(\lambda,C,x)

, where C can be rectangle or nonnegative space.

Usage

projection_C(
lambda,family=c("rectangle","nonnegative"),
input,bound=c(-1,1))

Arguments

Details

Take x as input, \lambda as parameter. Calculate \lambda P_{C}(x/\lambda) for a given C family

Value

Author(s)

D.Wang and W.J.Braun

Examples

set.seed(1234567)
family <- "nonnegative"
temp_p1<-runif(10,-1,1)
projection_C(0.5,family=family,temp_p1)

Projection operator for norm balls.

Description

Compute the projection operator for norm balls. For example, we construct

\lambda P_{B_{\| \cdot \|_*}[0,r]}(x/\lambda) = projection_nb(\lambda,r,\| \cdot \|_*,x)

, where \| \cdot \|_* can be l_{1}-norm, l_{2}-norm, and l_{\infty}-norm.

Usage

projection_nb(
lambda,radius,family=c("norm2","norm1","norminf"),
input)

Arguments

Details

Take x as input, \lambda and r as parameters. Calculate \lambda P_{B_{\| \cdot \|_*}[0,r]}(x/\lambda) for a given norm ball type.

Value

Author(s)

D.Wang and W.J.Braun

Examples

set.seed(1234567)
family <- "norm1"
temp_p1<-rep(10,100)
projection_nb(3,1,family=family,temp_p1)

Ridge/Enet/LASSO Sharpening via the local polynomial regression with large bandwidth.

Description

This is a function to shrink responses towards their estimations of local polynomial regression with large bandwidth as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_bigh(x, y, alpha, bigh) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_bigh(x, y,alpha=c(0.2,0.8), dpill(x,y)*4)
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the local polynomial regression with large bandwidth and then applying the residual sharpening method.

Description

This is a function to shrink responses towards their estimations of local polynomial regression with large bandwidth and then apply residual sharpening as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_bigh_c(x, y, alpha, bigh, hband) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_bigh_c(x, y,alpha=c(0.2,0.8), dpill(x,y)*4, dpill(x,y))
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the linear regression.

Description

This is a function to shrink responses towards their estimations of linear regression as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_linear(x, y, alpha) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_linear(x, y,alpha=c(0.2,0.8))
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the linear regression and then applying the residual sharpening method.

Description

This is a function to shrink responses towards their estimations of linear regression and then apply residual sharpening as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_linear_c(x, y, alpha, hband) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_linear_c(x, y,alpha=c(0.2,0.8),dpill(x,y))
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the Mean

Description

This is a function to shrink responses towards their mean as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_mean(y, alpha) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_mean(y,alpha=c(0.2,0.8))
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the Mean and then applying the residual sharpening method.

Description

This is a function to shrink responses towards their mean and then apply residual sharpening as a form of data sharpening to remove roughness, prior to use in local polynomial regression.

Usage

 relsharp_mean_c(x, y, alpha, hband) 

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharp_mean_c(x, y,alpha=c(0.2,0.8), dpill(x,y))
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Ridge/Enet/LASSO Sharpening via the penalty matrix.

Description

This is a data sharpening function to remove roughness, prior to use in local polynomial regression.

Usage

relsharpen(x, y, h, alpha, p=2, M=51)

Arguments

Details

Note that the predictor values are assumed to be equally spaced.

Value

numeric matrix of sharpened responses, with each column corresponding to different values of alpha

Author(s)

D.Wang

Examples

x<-seq(0,10,length=100)
g <- function(x) sin(x)
y<-g(x)+rnorm(100)
ys<-relsharpen(x, y, dpill(x,y), alpha=c(0.2,0.8), p=2, M=51)
y.lp2<-locpoly(x,ys[,1],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp8<-locpoly(x,ys[,2],bandwidth=dpill(x,y),degree=1,gridsize=100)
y.lp<-locpoly(x,y,bandwidth=dpill(x,y),degree=1,gridsize=100)
curve(g,x,xlim=c(0,10))
lines(y.lp2,col=2)
lines(y.lp8,col=3)
lines(y.lp,col=5)
norm(as.matrix(g(x) - y.lp2$y),type="2")
norm(as.matrix(g(x) - y.lp8$y),type="2")
norm(as.matrix(g(x) - y.lp$y),type="2")

Functions for Testing Purposes

Description

Functions that can be used in simulations to test the effectiveness of the sharpening procedures.

Usage

 testfun(x, k) 

Arguments

Value

numeric vector of function output

Author(s)

D.Wang