Nothing
# Copyright (C) 2011 J. Schiffner
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 or 3 of the License
# (at your option).
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# http://www.r-project.org/Licenses/
#
# @param wf A string. The name of the window function.
# @param bw The bandwidth parameter.
# @param k The number of nearest neighbors.
# @param nn.only (Logical. Only required for window functions with infinite support.) Should only the \code{k} nearest neighbors or
# all observations receive positive weights?
# @param n The number of training observations.
# @param \dots Unused.
#
#' @noRd
checkwf <- function(wf = c("biweight", "cauchy", "cosine", "epanechnikov", "exponential",
"gaussian", "optcosine", "rectangular", "triangular"), bw, k, nn.only = TRUE, n, ...) {
wf <- match.arg(wf)
if (missing(bw)) { # bw missing
if (missing(k)) # bw and k missing
stop("either 'bw' or 'k' have to be specified")
else { # only k given -> adaptive bandwidth
# checks on k
if ((!is.numeric(k)) || !length(k))
stop("'k' must be numeric of length > 0")
if (length(k) > 1) {
k <- k[1]
warning("only first element of 'k' used")
}
if (k <= 0)
stop("'k' must be positive")
if (k + 1 > n)
stop("'k + 1' is larger than 'n'")
if (abs(k - round(k)) > .Machine$double.eps^0.5)
warning("'k' should be a natural number and is rounded off")
## window functions with adaptive bandwidth
variant <- 3
# window functions with infinite support are cut depending on nn.only
if (wf %in% c("cauchy", "exponential", "gaussian")) {
if(!nn.only)
variant <- 4
} else if (wf == "rectangular") {
if (k == n) {
warning("nonlocal solution")
variant <- 0
}
}
adaptive <- TRUE
bw <- NULL
}
} else { # bw given -> fixed bandwidth
# checks on bw
if ((!is.numeric(bw)) || !length(bw))
stop("'bw' must be numeric of length > 0")
if (length(bw) > 1) {
bw <- bw[1]
warning("only first element of 'bw' used")
}
if (bw <= 0)
stop("'bw' must be positive")
if (missing(k)) { # only bw given -> fixed bandwidth, ignore nn.only
if (!missing(nn.only))
warning("argument 'nn.only' is ignored")
nn.only <- NULL
## window functions with fixed bandwidth
variant <- 1
k <- NULL
} else { # bw and k given -> fixed bandwidth with nn.only
if (!missing(nn.only))
if (!nn.only)
stop("if 'bw' and 'k' are given argument 'nn.only' must be TRUE")
# checks on k
if ((!is.numeric(k)) || !length(k))
stop("'k' must be numeric of length > 0")
if (length(k) > 1) {
k <- k[1]
warning("only first element of 'k' used")
}
if (k <= 0)
stop("'k' must be positive")
if (k > n)
stop("'k' is larger than 'n'")
if (abs(k - round(k)) > .Machine$double.eps^0.5)
warning("'k' should be a natural number and is rounded off")
## window functions with fixed bandwidth and nn.only
variant <- 2
}
adaptive <- FALSE
}
return(list(wf = wf, bw = bw, k = k, nn.only = nn.only, adaptive = adaptive, variant = variant))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.