1## rrcov : Scalable Robust Estimators with High Breakdown Point 2## 3## This program is free software; you can redistribute it and/or modify 4## it under the terms of the GNU General Public License as published by 5## the Free Software Foundation; either version 2 of the License, or 6## (at your option) any later version. 7## 8## This program is distributed in the hope that it will be useful, 9## but WITHOUT ANY WARRANTY; without even the implied warranty of 10## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11## GNU General Public License for more details. 12## 13## You should have received a copy of the GNU General Public License 14## along with this program; if not, a copy is available at 15## http://www.r-project.org/Licenses/ 16 17 18## "FIXME": If you change this, you must "sync" with ../man/rrcov.control.Rd 19## 1) covMcd()'s default in ./covMcd.R 20## 2) ltsReg.default()'s default in ./ltsReg.R 21## 3) covComed()s default in ./comedian.R 22rrcov.control <- 23 function(alpha = 1/2, method = c("covMcd", "covComed", "ltsReg"), 24 nsamp = 500, nmini = 300, kmini = 5, 25 seed = NULL, tolSolve = 1e-14, 26 scalefn = "hrv2012", maxcsteps = 200, 27 trace = FALSE, wgtFUN = "01.original", beta, 28 use.correction = identical(wgtFUN, "01.original"), 29 adjust = FALSE) 30{ 31 method <- match.arg(method) 32 if(missing(beta) || !is.numeric(beta)) 33 beta <- c("covMcd" = 0.975, "ltsReg" = 0.9875, "covComed" = 0.95)[[method]] 34 list(alpha=alpha, nsamp=nsamp, nmini=as.integer(nmini), kmini=as.integer(kmini), 35 seed = as.integer(seed), 36 tolSolve=tolSolve, scalefn=scalefn, maxcsteps=as.integer(maxcsteps), 37 trace=trace, wgtFUN=wgtFUN, beta=beta, 38 use.correction=use.correction, adjust=adjust) 39} 40## allow direct fast access: 41.scalefn.default <- eval(formals(rrcov.control)$scalefn) 42 43## Only for back compatibility, as some new args did not exist pre 2013-04, 44## and callers of ltsReg() / covMcd() may use a "too small" 'control' list: 45getDefCtrl <- function(nm, defCtrl = rrcov.control()) { 46 callerEnv <- parent.frame() 47 if(is.null(get(nm, envir = callerEnv))) 48 assign(nm, defCtrl[[nm]], envir=callerEnv) 49} 50