.packageName <- "lokern"
### glkerns   kernel regression smoothing with bandwidth selection

glkerns <- function(x, y, deriv = 0, n.out = 300, x.out = NULL,
		    korder = deriv + 2, hetero = FALSE, is.rand = TRUE,
		    inputb = is.numeric(bandwidth) && bandwidth > 0,
		    m1 = 400, xl = NULL, xu = NULL, s = NULL, sig = NULL,
		    bandwidth = NULL)
{
    ## control and sort inputgrid x  and data y
    n <- length(x)
    if (length(y) != n)
        stop("Input grid `x' and data `y' must have the same length.")
    if (n < 3) stop("must have n >= 3 observations")
    sorvec <- sort.list(x)
    x <- x[sorvec]
    y <- y[sorvec]

    ## compute/sort outputgrid `x.out' (n.out : length of outputgrid)

    if (is.null(x.out)) {
        n.out <- as.integer(n.out)
        x.out <- seq(min(x), max(x), length = n.out)
    }
    else
        n.out <- length(x.out <- sort(x.out))

    if(n.out == 0) stop("Must have `n.out' >= 1")

    ## hetero	homo- or heteroszedasticity of error variables
    ## is.rand	random or non-random t-grid
    ## inputb	input bandwidth or estimation of plug-in bandwidth

    ## m1 : discretization for integral functional estimation
    if ((m1 <- as.integer(m1)) < 3)# was "10", but fortran has 3
        stop("number of discretizations `m1' is too small")

    ## xl, xu: lower/upper bound for integral approximation and
    ##		variance estimation
    if (is.null(xl) || is.null(xu)) {
        xl <- 1
        xu <- 0
    }

    ## s mid-point grid
    if (is.null(s) || length(s) != n+1)
        s <- as.double(rep(0, n+1))

    ## sig          input variance
    if (is.null(sig)) sig <- 0. #-> Fortran takes 0 = "compute default"

    inputb <- as.logical(inputb)
    if (is.null(bandwidth) || bandwidth < 0)
        bandwidth <- 0.
    else if (bandwidth == 0 && inputb)
        stop("bandwidth = 0 must have inputb = FALSE")

    ## deriv          derivative of regression function to be estimated
    ## korder         kernel order
    if (deriv < 0 || deriv > 4)
        stop("Order of derivative `deriv' must be in {0,1,..,4}.")
    if (deriv > 2 && !inputb)
        stop("Order of derivative must be <= 2  if (! inputb).")
    if (is.null(korder))
        korder <- deriv+2
    else if (korder > 6) {
        warning("Kernel order `korder' must be <= 6; set to deriv + 2")
        korder <- deriv+2
    } else if (korder > 4 && !inputb) {
        warning("Kernel order must be <= 4 if(!inputb); set to deriv+2")
        korder <- deriv+2
    }

    ## calling fortran routine
    res <- .Fortran("glkerns",
                    x = as.double(x),
                    y = as.double(y),
                    as.integer(n),
                    x.out = as.double(x.out),
                    as.integer(n.out),
                    deriv = as.integer(deriv),
                    korder = as.integer(korder),
                    hetero = as.integer(hetero),
                    is.rand = as.integer(is.rand),
                    as.integer(inputb),
                    m1,
                    xl = as.double(xl),
                    xu = as.double(xu),
                    s = as.double(s),
                    sig = as.double(sig),
                    work1 = double((n+1)*5),
                    work2 = double(m1*3),
                    bandwidth = as.double(bandwidth),
                    est = double(n.out),
                    PACKAGE = "lokern"
                    )
    if(res$korder != korder)
        warning(paste("`korder' set to ", res$korder,", internally"))

    list(x = x, y = y, bandwidth = res$bandwidth, x.out = x.out,
	 est = res$est, sig = res$sig,
	 deriv = res$deriv, korder = res$korder,
	 xl = res$xl, xu = res$xu, s = res$s)
}
### lokerns   kernel regression smoothing with local bandwidth selection

lokerns <- function(x, y, deriv = 0, n.out = 300, x.out = NULL,
		    korder = deriv + 2, hetero = FALSE, is.rand = TRUE,
		    inputb = is.numeric(bandwidth) && bandwidth > 0,
		    m1 = 400, xl = NULL, xu = NULL, s = NULL, sig = NULL,
		    bandwidth = NULL)
{
    ## control and sort inputgrid x  and data y
    n <- length(x)
    if (length(y) != n)
        stop("Input grid `x' and data `y' must have the same length.")
    if (n < 3) stop("must have n >= 3 observations")
    sorvec <- sort.list(x)
    x <- x[sorvec]
    y <- y[sorvec]

    ## compute/sort outputgrid `x.out' (n.out : length of outputgrid)

    if (is.null(x.out)) {
        n.out <- as.integer(n.out)
        x.out <- seq(min(x), max(x), length = n.out)
    }
    else
        n.out <- length(x.out <- sort(x.out))

    if(n.out == 0) stop("Must have `n.out' >= 1")

    ## hetero	homo- or heteroszedasticity of error variables
    ## is.rand	random or non-random t-grid
    ## inputb	input bandwidth or estimation of plug-in bandwidth

    ## m1 : discretization for integral functional estimation
    if ((m1 <- as.integer(m1)) < 3)# was "10", but fortran has 3
        stop("number of discretizations `m1' is too small")

    ## xl, xu: lower/upper bound for integral approximation and
    ##		variance estimation
    if (is.null(xl) || is.null(xu)) {
        xl <- 1
        xu <- 0
    }

    ## s	mid-point grid
    if (is.null(s) || length(s) != n+1)
        s <- as.double(rep(0, n+1))

    ## sig      input variance
    if (is.null(sig)) sig <- 0. #-> Fortran takes 0 = "compute default"

    inputb <- as.logical(inputb)
    if(is.null(bandwidth)) {
        bandwidth <- double(n.out)
        if(inputb) stop("NULL bandwidth must have inputb = FALSE")
    } else if(length(bandwidth) != n.out)
        stop("`bandwidth' must be of length `n.out', i.e., ", n.out)

    ## deriv          derivative of regression function to be estimated
    ## korder         kernel order
    if (deriv < 0) stop("Order of derivative is negative.")
    if (deriv > 4 || (deriv > 2 && !inputb))
        stop("Order of derivative is too large.")
    if (is.null(korder) || korder > 6 || (korder > 4 && !inputb))
        korder <- deriv+2

    ## calling fortran routine
    res <- .Fortran("lokerns",
                    x = as.double(x),
                    y = as.double(y),
                    n,				# Fortran arg.names :
                    x.out = as.double(x.out),
                    as.integer(n.out),		# m
                    deriv = as.integer(deriv),  # nue
                    korder = as.integer(korder),# kord
                    ihetero = as.integer(hetero),# ihetero
                    is.rand = as.integer(is.rand),# irnd
                    as.integer(inputb),		# ismo
                    m1,
                    xl = as.double(xl),
                    xu = as.double(xu),
                    s = as.double(s),
                    sig = as.double(sig),
                    work1 = double((n+1)*5),
                    work2 = double(3 * m1),
                    work3 = double(n.out),
                    bandwidth = as.double(bandwidth),
                    est = double(n.out),
                    PACKAGE = "lokern"
                    )
    if(res$korder != korder)
	warning(paste("`korder' set to ", res$korder,", internally"))

    list(x = x, y = y, bandwidth = res$bandwidth, x.out = x.out,
	 est = res$est, sig = res$sig,
	 deriv = res$deriv, korder = res$korder,
	 xl = res$xl, xu = res$xu, s = res$s)
}
#### varNPreg.R : Nonparametric Variance Estimator
####
#### S/R interface to the resest() Fortran subroutine

#### Copyright  Martin Maechler (2001).
#### This software is distributed under the terms of the GNU GENERAL
#### PUBLIC LICENSE Version 2, June 1991, see the COPYING file from R,
#### or http://www.gnu.org/copyleft/gpl.html

varNPreg <- function(x,y)
{
    ## Purpose: Nonparametric Leave-1-out Residuals and Variance Estimator
    ##	in the model   y[i] = mu(x(i)) + E[i] ,  E[i] ~ (0, sigma^2), i.i.d

    ## Author: Martin Maechler, Date:  9 Jul 2001, 14:47
    if(2 >= (n <- length(x))) stop("n := length(x)  must be at least 3")
    if(is.unsorted(x)) stop("`x' must be ordered increasingly")
    if(n != length(y)) stop("`x' and `y' must have same length")
    .Fortran("resest",
             as.double(x), as.double(y), n,
             res = double(n),
             snr = double(1),
             sigma2 = double(1), PACKAGE = "lokern")[4:6]
}
#### varest.R : Nonparametric Variance Estimator
####
#### S/R interface to the resest() Fortran subroutine

#### Copyright  Martin Maechler (2001).
#### This software is distributed under the terms of the GNU GENERAL
#### PUBLIC LICENSE Version 2, June 1991, see the COPYING file from R,
#### or http://www.gnu.org/copyleft/gpl.html

varest <- function(x,y)
{
    ## Purpose: Nonparametric Leave-1-out Residuals and Variance Estimator
    ##	in the model   y[i] = mu(x(i)) + E[i] ,  E[i] ~ (0, sigma^2), i.i.d
    ## -------------------------------------------------------------------------
    ## Arguments: (x,y)
    ## -------------------------------------------------------------------------
    ##     subroutine resest(t,x,n, res,snr,sigma2)
    ##-----------------------------------------------------------------------
    ## purpose:
    ##
    ##       computes one-leave-out residuals for nonparametric estimation
    ##       of residual variance (local linear approximation followed by
    ##       reweighting)
    ##
    ## parameters:
    ##
    ##     input   t(n)      abscissae (ordered: t(i) <= t(i+1))
    ##     input   x(n)      data
    ##     input   n         length of data ( >2 )
    ##     output  res(n)    residuals at t(1),...,t(n)
    ##     output  snr       explained variance of the true curve
    ##     output  sigma2    estimation of sigma^2 (residual variance)

    ## Author: Martin Maechler, Date:  9 Jul 2001, 14:47
    if(2 >= (n <- length(x))) stop("n := length(x)  must be at least 3")
    if(is.unsorted(x)) stop("`x' must be ordered increasingly")
    if(n != length(y)) stop("`x' and `y' must have same length")
    .Fortran("resest",
             as.double(x), as.double(y), n,
             res = double(n),
             snr = double(1),
             sigma2 = double(1), PACKAGE = "lokern")[4:6]
}
.First.lib <- function(lib, pkg) library.dynam("lokern",pkg,lib)


