-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
upgrade robustbase (0.99-4-1-1) unstable
- Loading branch information
1 parent
9eb09de
commit ddc5e32
Showing
111 changed files
with
3,800 additions
and
2,005 deletions.
There are no files selected for viewing
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,7 +1,8 @@ | ||
Package: robustbase | ||
Version: 0.93-9 | ||
VersionNote: Released 0.93-8 on 2021-06-02 to CRAN | ||
Date: 2021-09-27 | ||
Version: 0.99-4-1 | ||
VersionNote: Released 0.99-4 on 2024-08-19, 0.99-3 on 2024-07-01 and | ||
0.99-2 on 2024-01-27 to CRAN | ||
Date: 2024-09-24 | ||
Title: Basic Robust Statistics | ||
Authors@R: c(person("Martin","Maechler", role=c("aut","cre"), email="[email protected]", comment = c(ORCID = "0000-0002-8685-9910")) | ||
, person("Peter", "Rousseeuw", role="ctb", comment = "Qn and Sn") | ||
|
@@ -20,7 +21,10 @@ Authors@R: c(person("Martin","Maechler", role=c("aut","cre"), email="maechler@st | |
comment = "MM-, tau-, CM-, and MTL- nlrob") | ||
, person("Maria", "Anna di Palma", role = "ctb", comment = "initial version of Comedian") | ||
) | ||
URL: https://robustbase.R-forge.R-project.org/ | ||
URL: https://robustbase.R-forge.R-project.org/, | ||
https://R-forge.R-project.org/R/?group_id=59, | ||
https://R-forge.R-project.org/scm/viewvc.php/pkg/robustbase/?root=robustbase, | ||
svn://svn.r-forge.r-project.org/svnroot/robustbase/pkg/robustbase | ||
BugReports: https://R-forge.R-project.org/tracker/?atid=302&group_id=59 | ||
Description: "Essential" Robust Statistics. | ||
Tools allowing to analyze data with robust methods. This includes | ||
|
@@ -38,7 +42,7 @@ EnhancesNote: linked to in man/*.Rd | |
LazyData: yes | ||
NeedsCompilation: yes | ||
License: GPL (>= 2) | ||
Packaged: 2021-09-27 07:40:12 UTC; maechler | ||
Packaged: 2024-09-25 09:50:14 UTC; maechler | ||
Author: Martin Maechler [aut, cre] (<https://orcid.org/0000-0002-8685-9910>), | ||
Peter Rousseeuw [ctb] (Qn and Sn), | ||
Christophe Croux [ctb] (Qn and Sn), | ||
|
@@ -51,4 +55,4 @@ Author: Martin Maechler [aut, cre] (<https://orcid.org/0000-0002-8685-9910>), | |
Maria Anna di Palma [ctb] (initial version of Comedian) | ||
Maintainer: Martin Maechler <[email protected]> | ||
Repository: CRAN | ||
Date/Publication: 2021-09-27 10:10:02 UTC | ||
Date/Publication: 2024-09-27 15:30:02 UTC |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -50,13 +50,11 @@ covMcd <- function(x, | |
logdet.Lrg <- 50 ## <-- FIXME add to rrcov.control() and then use that | ||
## Analyze and validate the input parameters ... | ||
if(length(seed) > 0) { | ||
if(length(seed) < 3 || seed[1L] < 100) | ||
if(length(seed) < 3L || seed[1L] < 100L) | ||
stop("invalid 'seed'. Must be compatible with .Random.seed !") | ||
if(exists(".Random.seed", envir=.GlobalEnv, inherits=FALSE)) { | ||
seed.keep <- get(".Random.seed", envir=.GlobalEnv, inherits=FALSE) | ||
on.exit(assign(".Random.seed", seed.keep, envir=.GlobalEnv)) | ||
} | ||
assign(".Random.seed", seed, envir=.GlobalEnv) | ||
if(!is.null(seed.keep <- get0(".Random.seed", envir = .GlobalEnv, inherits = FALSE))) | ||
on.exit(assign(".Random.seed", seed.keep, envir = .GlobalEnv)) | ||
assign(".Random.seed", seed, envir = .GlobalEnv) | ||
} | ||
|
||
## For back compatibility, as some new args did not exist pre 2013-04, | ||
|
@@ -238,7 +236,13 @@ covMcd <- function(x, | |
ans <- c(ans, cov.wt(x, wt = weights, cor=cor)) | ||
|
||
if(sum.w != n) { | ||
cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 | ||
## VT::05.04.2023 | ||
## The correct consistency correction factor for the reweighted estimate | ||
## would be .MCDcons(p, 0.975) and not .MCDcons(p, sum.w/n) - see mail from | ||
## Andreas Alfons from 29.01.2020 and Croux and Haesbroeck (1999), equations 4.1 and 4.2. | ||
## cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 | ||
cdelta.rew <- .MCDcons(p, 0.975) | ||
|
||
correct.rew <- if(use.correction) .MCDcnp2.rew(p, n, alpha) else 1. | ||
cnp2 <- c(cdelta.rew, correct.rew) | ||
ans$cov <- cdelta.rew * correct.rew * ans$cov | ||
|
@@ -270,7 +274,12 @@ covMcd <- function(x, | |
## the MCD location and scatter matrix, the latter being singular | ||
## (as it should be), as well as the equation of the hyperplane. | ||
|
||
dim(mcd$coeff) <- c(5, p) | ||
## VT::31.08.2022 - raw.only was not implemeted for the case nsamp="deterministic" | ||
## (if the FORTRAN code is not called mcd$coeff and mcd$weights do not exist). | ||
## Reported by Aurore Archimbaud <[email protected]> | ||
if(!is.null(mcd$coeff)) | ||
dim(mcd$coeff) <- c(5, p) | ||
|
||
ans$cov <- ans$raw.cov <- mcd$initcovariance | ||
ans$center <- ans$raw.center <- as.vector(mcd$initmean) | ||
|
||
|
@@ -280,9 +289,7 @@ covMcd <- function(x, | |
} | ||
ans$n.obs <- n | ||
|
||
if(raw.only) { | ||
ans$raw.only <- TRUE | ||
} else { | ||
if(mcd$exactfit != 0) { | ||
## no longer relevant: | ||
## if(mcd$exactfit == -1) | ||
## stop("The program allows for at most ", mcd$kount, " observations.") | ||
|
@@ -297,15 +304,27 @@ covMcd <- function(x, | |
ans$singularity <- | ||
list(kind = "on.hyperplane", exactCode = mcd$exactfit, | ||
p = p, h = h, count = mcd$kount, coeff = mcd$coeff[1,]) | ||
|
||
ans$crit <- -Inf # = log(0) | ||
weights <- mcd$weights | ||
|
||
} else { | ||
## VT::31.08.2022 - raw.only was not implemeted for the case nsamp="deterministic" | ||
ans$raw.only <- TRUE | ||
ans$crit <- mcd$mcdestimate | ||
weights <- mcd$weights | ||
if(is.null(mcd$weights)) { | ||
## FIXME? here, we assume that mcd$initcovariance is not singular: | ||
mah <- mahalanobis(x, mcd$initmean, mcd$initcovariance, tol = tolSolve) | ||
weights <- wgtFUN(mah) | ||
} | ||
} | ||
ans$alpha <- alpha | ||
ans$quan <- h | ||
if(names && !is.null(nms <- dimn[[2]])) { | ||
names(ans$raw.center) <- nms | ||
dimnames(ans$raw.cov) <- list(nms,nms) | ||
} | ||
ans$crit <- -Inf # = log(0) | ||
weights <- mcd$weights | ||
|
||
} ## end (raw.only || exact fit) | ||
|
||
|
@@ -322,7 +341,12 @@ covMcd <- function(x, | |
## Compute and apply the consistency correction factor for | ||
## the reweighted cov | ||
if(!sing.rewt && sum.w != n) { | ||
cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 | ||
## VT::05.04.2023 | ||
## The correct consistency correction factor for the reweighted estimate | ||
## would be .MCDcons(p, 0.975) and not .MCDcons(p, sum.w/n) - see mail from | ||
## Andreas Alfons from 29.01.2020 and Croux and Haesbroeck (1999), equations 4.1 and 4.2. | ||
## cdelta.rew <- .MCDcons(p, sum.w/n) ## VT::19.3.2007 | ||
cdelta.rew <- .MCDcons(p, 0.975) | ||
correct.rew <- if(use.correction) .MCDcnp2.rew(p, n, alpha) else 1. | ||
cnp2 <- c(cdelta.rew, correct.rew) | ||
ans$cov <- cdelta.rew * correct.rew * ans$cov | ||
|
@@ -519,11 +543,11 @@ print.mcd <- function(x, digits = max(3, getOption("digits") - 3), print.gap = 2 | |
"\n", sep="") | ||
## VT::29.03.2007 - solve a conflict with fastmcd() in package robust - | ||
## also returning an object of class "mcd" | ||
xx <- NA | ||
if(!is.null(x$crit)) | ||
xx <- format(x$crit, digits = digits) | ||
else if (!is.null(x$raw.objective)) | ||
xx <- format(log(x$raw.objective), digits = digits) | ||
xx <- if(!is.null(x$crit)) | ||
format(x$crit, digits = digits) | ||
else if (!is.null(x$raw.objective)) | ||
format(log(x$raw.objective), digits = digits) | ||
else NA | ||
cat("Log(Det.): ", xx , "\n\nRobust Estimate of Location:\n") | ||
print(x$center, digits = digits, print.gap = print.gap, ...) | ||
cat("Robust Estimate of Covariance:\n") | ||
|
@@ -573,7 +597,7 @@ print.summary.mcd <- | |
##' (see calfa in Croux and Haesbroeck) | ||
##' @param p | ||
##' @param alpha alpha ~= h/n = quan/n | ||
##' also use for the reweighted MCD, calling with alpha = 'sum(weights)/n' | ||
##' also use for the reweighted MCD, calling with alpha = 0.975 | ||
MCDcons <- # <- *not* exported, but currently used in pkgs rrcov, rrcovNA | ||
.MCDcons <- function(p, alpha) | ||
{ | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,38 @@ | ||
## trimmed mad := trimmed *[M]ean* of [A]bsolute [D]eviations (from the median; more generally 'center') | ||
## = === {no default for trim on purpose} | ||
tmad <- function(x, center = median(x), trim, na.rm = FALSE) | ||
{ | ||
stopifnot(is.numeric(trim), length(trim) == 1L, 0 <= trim, trim <= 0.5) | ||
if(na.rm) | ||
x <- x[!is.na(x)] | ||
## TODO: consistency correction (for non-large) 'n' as a function of trim | ||
## ---- not needed for huberize() though | ||
## n <- length(x) | ||
mean(abs(x - center), trim=trim) | ||
} | ||
|
||
## Estimates mu (optionally, via huberM(.)) and sigma of x | ||
## x: without NA: na.rm=TRUE must have happened | ||
## sets boundaries at M +/- c*sigma | ||
## sets outliers to be equal to lower/upper boundaries | ||
huberize <- function(x, M = huberM(x, k=k)$mu, c = k, | ||
trim = (5:1)/16, # Lukas Graz' MSc thesis had c(0.25, 0.15, 0.075) | ||
k = 1.5, | ||
warn0 = getOption("verbose"), saveTrim = TRUE) | ||
{ | ||
stopifnot(is.numeric(M), length(M) == 1, | ||
length(trim) >= 1, trim >= 0, diff(trim) < 0) # trim must be strictly decreasing | ||
qn. <- Qn(x) | ||
j <- 0L | ||
while(!is.na(qn.) && qn. == 0 && j < length(trim)) | ||
qn. <- tmad(x, center = M, trim = trim[j <- j+1L]) | ||
## ~~~~ | ||
if(qn. == 0 && warn0) | ||
warning(sprintf("Qn(x) == 0 and tmad(x, trim=%g) == 0", trim[j])) | ||
upper <- M + qn.*c # qnorm(c,lower.tail = F) | ||
lower <- M - qn.*c | ||
x[x > upper] <- upper | ||
x[x < lower] <- lower | ||
## store the final 'trim' used (if there was one) as attribute: | ||
if(j && saveTrim) structure(x, trim = trim[j]) else x | ||
} |
Oops, something went wrong.