Supprimer les valeurs aberrantes de la courbe en treillis (splom)

Question

Je voudrais tracer certaines données sous la forme d'une matrice de nuage de points avec treillis. Cependant, les données contiennent des valeurs aberrantes. Cela conduit à un tracé très serré des données principales. Je voudrais retirer les valeurs aberrantes des parcelles. Une observation peut être une valeur aberrante pour une variable mesurée, mais pas pour une autre, de sorte qu'un calcul des valeurs aberrantes devant être supprimées est requis pour chaque diagramme de dispersion dans la matrice. Comme les valeurs aberrantes constituent un maximum de 10 observations sur environ 10 000, je pensais simplement supprimer les 10 observations ayant la valeur la plus faible pour chaque variable (les valeurs aberrantes sont généralement celles dans la direction la plus négative). Je sais que je dois modifier la fonction du panneau, mais je suis coincé avec la façon de le faire. En outre, mon panneau inférieur est un hexbinplot, donc il devrait être modifié aussi, et j'espère que cela fonctionnera de la même manière. est-ce que quelqu'un a une idée?

MWE:

require(lattice) 
require(hexbin) 
data(iris) 

iris.out <- iris 
iris.out[2,1] <- 1 
iris.out[3,1] <- .2 
iris.out[4,2] <- .1 
iris.out[5,2] <- .2 

splom(~iris.out[1:4], groups = Species, data = iris, 
    lower.panel = function(...,groups){ 
    panel.hexbinplot(xbins = 20, 
        colramp = function(n){heat.ob(n, beg=15, end=225)},...,groups=NULL) 
    }, 
    diag.panel = function(x,...){ 
    yrng <- current.panel.limits()$ylim 
    d <- density(x, na.rm = TRUE) 
    d$y <- with(d, yrng[1] + 0.95 * diff(yrng) * y/max(y)) 
    panel.lines(d, col = "darkgrey") 
    diag.panel.splom(x, ...) 
    } 

)

Answer 1

J'ai peut-être une solution partielle. Pour les graphiques à deux variables, j'ai supprimé les valeurs aberrantes, définies par les 10 valeurs observées les plus basses, à la fois dans x et y. De plus, le facteur 'groupes' n'est implémenté que dans le panneau supérieur.

splom(~iris.out[1:4], 
    lower.panel=function(x,y,...){ 
    x.out=order(x,decreasing=FALSE)[1:10] 
    y.out=order(x,decreasing=FALSE)[1:10] 
    out=c(x.out,y.out) 
    x=x[-out] 
    y=y[-out] 
    panel.hexbinplot(x,y, xbins =20,colramp = function(n){heat.ob(n, beg=15, end=225)},...) 
    }, 
    diag.panel = function(x,...){ 
    x=x[-order(x,decreasing=FALSE)[1:10]] 
    yrng <- current.panel.limits()$ylim 
    d <- density(x, na.rm = TRUE) 
    d$y <- with(d, yrng[1] + 0.95 * diff(yrng) * y/max(y)) 
    panel.lines(d, col = "darkgrey") 
    diag.panel.splom(x, ...) 
    }, 
    upper.panel=function(x,y,groups=iris$Species,...){ 
    x.out=order(x,decreasing=FALSE)[1:10] 
    y.out=order(x,decreasing=FALSE)[1:10] 
    out=c(x.out,y.out) 
    x=x[-out] 
    y=y[-out] 
    panel.splom(x,y,groups=iris$Species,...) 
    } 
)