From noreply at r-forge.r-project.org Mon Jul 1 15:53:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 1 Jul 2013 15:53:49 +0200 (CEST) Subject: [Robast-commits] r670 - branches/robast-0.9/pkg/RobExtremes/R Message-ID: <20130701135349.7D22818561D@r-forge.r-project.org> Author: ruckdeschel Date: 2013-07-01 15:53:49 +0200 (Mon, 01 Jul 2013) New Revision: 670 Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R Log: [RobExtremes] added Gerald's corrections as to Weibull and as to ddigamma Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-06-17 10:32:24 UTC (rev 669) +++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-07-01 13:53:49 UTC (rev 670) @@ -403,10 +403,10 @@ return(L2Fam) } -#ddigamma(t,s) is d/ds \int_t^\infty exp(-x) x^(-s) dx +#ddigamma(t,s) is d/ds \int_0^t exp(-x) x^(s-1) dx ddigamma <- function(t,s){ - int <- function(x) exp(-x)*(-log(x))*x^(-s) + int <- function(x) exp(-x)*(log(x))*x^(s-1) integrate(int, lower=0, upper=t)$value } \ No newline at end of file Modified: branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-06-17 10:32:24 UTC (rev 669) +++ branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-07-01 13:53:49 UTC (rev 670) @@ -66,18 +66,18 @@ D <- t(c(D1, D2)) rownames(D) <- "quantile"; colnames(D) <- NULL D }, list(p0 = p)) - btes <- substitute({ if(theta[2]>=1L) es <- NA else { + btes <- substitute({ if(theta[2]<= (-1L)) es <- NA else { s1 <- 1+1/theta[2] - pg <- pgamma(-log(p0),s1, lower.tail = FALSE) + pg <- pgamma(-log(1-p0),s1, lower.tail = FALSE) g0 <- gamma(s1) es <- theta[1] * g0 * pg /(1-p0)} names(es) <- "expected shortfall" es }, list(p0 = p)) - bDes <- substitute({ if(theta[2]>=1L){ D1 <- D2 <- NA} else { + bDes <- substitute({ if(theta[2]<= (-1L)){ D1 <- D2 <- NA} else { s1 <- 1+1/theta[2] - pg <- pgamma(-log(p0), s1, lower.tail = FALSE) + pg <- pgamma(-log(1-p0), s1, lower.tail = FALSE) g0 <- gamma(s1) - dd <- digamma(s1)*g0 - ddigamma(-log(p0),s1) + dd <- digamma(s1)*g0 - ddigamma(-log(1-p0),s1) D1 <- g0 * pg / (1-p0) D2 <- theta[1] * dd /(1-p0)} D <- t(c(D1, D2)) From noreply at r-forge.r-project.org Tue Jul 2 11:20:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 11:20:54 +0200 (CEST) Subject: [Robast-commits] r671 - branches/robast-0.9/pkg/RobExtremes/R Message-ID: <20130702092054.1BB69180B3A@r-forge.r-project.org> Author: ruckdeschel Date: 2013-07-02 11:20:53 +0200 (Tue, 02 Jul 2013) New Revision: 671 Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R Log: [RobExtremes] added Gerald's second round of corrections as to Weibull and as to ddigamma Modified: branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-07-01 13:53:49 UTC (rev 670) +++ branches/robast-0.9/pkg/RobExtremes/R/GEVFamily.R 2013-07-02 09:20:53 UTC (rev 671) @@ -185,9 +185,9 @@ dd <- ddigamma(-log(p0),1-theta[2]) g0 <- gamma(1-theta[2]) D1 <- (g0*pg/(1-p0)-1)/theta[2] - D21 <- theta[1]*D1/theta[2] - D22 <- theta[1]*dd/(1-p0)/theta[2] - D2 <- -D21+D22} + D21 <- D1/theta[2] + D22 <- dd/(1-p0)/theta[2] + D2 <- -theta[1]*(D21+D22)} D <- t(c(D1, D2)) rownames(D) <- "expected shortfall" colnames(D) <- NULL Modified: branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-07-01 13:53:49 UTC (rev 670) +++ branches/robast-0.9/pkg/RobExtremes/R/WeibullFamily.R 2013-07-02 09:20:53 UTC (rev 671) @@ -77,10 +77,11 @@ s1 <- 1+1/theta[2] pg <- pgamma(-log(1-p0), s1, lower.tail = FALSE) g0 <- gamma(s1) + ## dd <- ddigamma(Inf,s1)-ddigamma(-log(1-p0),s1) dd <- digamma(s1)*g0 - ddigamma(-log(1-p0),s1) - D1 <- g0 * pg / (1-p0) - D2 <- theta[1] * dd /(1-p0)} - D <- t(c(D1, D2)) + D1 <- g0 * pg + D2 <- - theta[1] * dd /theta[2]^2} + D <- t(c(D1, D2))/(1-p0) rownames(D) <- "expected shortfall" colnames(D) <- NULL D }, list(p0 = p)) From noreply at r-forge.r-project.org Tue Jul 2 15:37:23 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 2 Jul 2013 15:37:23 +0200 (CEST) Subject: [Robast-commits] r672 - branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes Message-ID: <20130702133723.CFF6E184D98@r-forge.r-project.org> Author: pupashenko Date: 2013-07-02 15:37:23 +0200 (Tue, 02 Jul 2013) New Revision: 672 Added: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GEV_Trsp100_LegendTrue_rescaleTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GEV_data_Trsp100_LegendTrue_rescaleTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GPD_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GPD_data_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Gamma.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Gamma_data.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Weibull_Trsp30_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Weibull_data_Trsp30_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperCont.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_GEV_Lo0_Up5_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_GPD_Lo0_Up10_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_Gamma_Lo0_Up5.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_Weibull_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_Trsp100_LegendTrue_rescaleTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_Trsp100_LegendTrue_rescaleTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_data_Trsp100_LegendTrue_rescaleTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_data_Trsp100_LegendTrue_rescaleTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_Trsp30_LegendFalse_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_Trsp30_LegendFalse_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_data_Trsp30_LegendFalse_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_data_Trsp30_LegendFalse_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_data_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_data_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_Trsp30_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_Trsp30_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_data_Trsp30_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_data_Trsp30_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_GEV_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_GPD_Trsp50_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_Gamma_Trsp70.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_Weibull_Trsp30_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/plotOutlyingness_Old.R Removed: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/.Rhistory branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GEV_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GEV_data_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GPD_Trsp50_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_GPD_data_Trsp50_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Gamma_Trsp70.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Gamma_data_Trsp70.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Weibull_Trsp50_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper_Weibull_data_Trsp50_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperCont.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_GEV_Lo0_Up5_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_GPD_Lo0_Up10_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_Gamma_Lo0_Up5.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper_Weibull_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_data_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GEV_data_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_Trsp50_LegendFalse_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_Trsp50_LegendFalse_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_data_Trsp50_LegendFalse_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_GPD_data_Trsp50_LegendFalse_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_Trsp70_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_Trsp70_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_data_Trsp70_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Gamma_data_Trsp70_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_Trsp50_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_Trsp50_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_data_Trsp50_LegendTrue_1.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper_Weibull_data_Trsp50_LegendTrue_2.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_GEV_Trsp100_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_GPD_Trsp50_LegendFalse.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_Gamma_Trsp70.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper_Weibull_Trsp50_LegendTrue.jpeg branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/plotOutlyingness_Old.R Log: All plots are updated: - transparency is automatic - added box - labels and titles a centered - scaling is implemented and performed Deleted: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/.Rhistory =================================================================== --- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/.Rhistory 2013-07-02 09:20:53 UTC (rev 671) +++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/.Rhistory 2013-07-02 13:37:23 UTC (rev 672) @@ -1,512 +0,0 @@ -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = col.abline -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=75, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -########################################## -## ## -## Wrapper for outlyingnessPlot.R ## -## ## -## ## -########################################## -##projection distance -qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)} -QProj <- function(){new("NormType", name="Quantiles", fct=qfun)} -##@x - dataset -##@X - random variable -##@fam - parameter family -##@alpha - confidence level for quantile -# -plotOutlyingness = function(x,alpha=0.99,fam=GParetoFamily(),...,alpha.trsp = 100, with.legend = TRUE){ -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(dots$alpha.trsp)) dots$alpha.trsp <- 100 -if(is.null(dots$with.legend)) dots$with.legend <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'plotOutlyingness'") -if(missing(alpha)) stop("Argument 'alpha' must be given as argument to 'plotOutlyingness'") -if(missing(fam)) stop("Argument 'fam' must be given as argument to 'plotOutlyingness'") -##logarithmic representation (for distributions with positive support) -fam at distribution = log(fam at distribution) -##classical IC -ICmle <- optIC(model=fam,risk=asCov()) -##parameter for plotting -if(with.legend) -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "black", col.lab = "black") -col.Abline = rgb(52,52,52,maxColorValue=255)} -else -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "white", col.lab = "white") -colAbline = "white"} -cutoff.quantile.x = alpha -cutoff.quantile.y = alpha -##call of routine from RobAStBase -outlyingPlotIC(x -,IC.x = ICmle -,IC.y = ICmle -,dist.x = QProj() -#NormType() - Euclidean norm, default - Mahalanobis norm -#,dist.y = NormType() -,adj = 0.1 -,pch = 21 -,col.idn = rgb(102,102,102,maxColorValue=255) -,cex.idn = 1.7 -,col.cutoff = rgb(202,202,202,maxColorValue=255) -,offset = 0 -,cutoff.quantile.x = cutoff.quantile.x -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = colAbline -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=75, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -########################################## -## ## -## Wrapper for outlyingnessPlot.R ## -## ## -## ## -########################################## -##projection distance -qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)} -QProj <- function(){new("NormType", name="Quantiles", fct=qfun)} -##@x - dataset -##@X - random variable -##@fam - parameter family -##@alpha - confidence level for quantile -# -plotOutlyingness = function(x,alpha=0.99,fam=GParetoFamily(),...,alpha.trsp = 100, with.legend = TRUE){ -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(dots$alpha.trsp)) dots$alpha.trsp <- 100 -if(is.null(dots$with.legend)) dots$with.legend <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'plotOutlyingness'") -if(missing(alpha)) stop("Argument 'alpha' must be given as argument to 'plotOutlyingness'") -if(missing(fam)) stop("Argument 'fam' must be given as argument to 'plotOutlyingness'") -##logarithmic representation (for distributions with positive support) -fam at distribution = log(fam at distribution) -##classical IC -ICmle <- optIC(model=fam,risk=asCov()) -##parameter for plotting -if(with.legend) -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "black", col.lab = "black") -col.Abline = rgb(52,52,52,maxColorValue=255)} -else -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "white", col.lab = "white") -colAbline = "white"} -print(colAbline) -cutoff.quantile.x = alpha -cutoff.quantile.y = alpha -##call of routine from RobAStBase -outlyingPlotIC(x -,IC.x = ICmle -,IC.y = ICmle -,dist.x = QProj() -#NormType() - Euclidean norm, default - Mahalanobis norm -#,dist.y = NormType() -,adj = 0.1 -,pch = 21 -,col.idn = rgb(102,102,102,maxColorValue=255) -,cex.idn = 1.7 -,col.cutoff = rgb(202,202,202,maxColorValue=255) -,offset = 0 -,cutoff.quantile.x = cutoff.quantile.x -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = colAbline -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=75, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -########################################## -## ## -## Wrapper for outlyingnessPlot.R ## -## ## -## ## -########################################## -##projection distance -qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)} -QProj <- function(){new("NormType", name="Quantiles", fct=qfun)} -##@x - dataset -##@X - random variable -##@fam - parameter family -##@alpha - confidence level for quantile -# -plotOutlyingness = function(x,alpha=0.99,fam=GParetoFamily(),...,alpha.trsp = 100, with.legend = TRUE){ -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(dots$alpha.trsp)) dots$alpha.trsp <- 100 -if(is.null(dots$with.legend)) dots$with.legend <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'plotOutlyingness'") -if(missing(alpha)) stop("Argument 'alpha' must be given as argument to 'plotOutlyingness'") -if(missing(fam)) stop("Argument 'fam' must be given as argument to 'plotOutlyingness'") -##logarithmic representation (for distributions with positive support) -fam at distribution = log(fam at distribution) -##classical IC -ICmle <- optIC(model=fam,risk=asCov()) -##parameter for plotting -if(with.legend) -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "black", col.lab = "black")} -else -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "white", col.lab = "white")} -cutoff.quantile.x = alpha -cutoff.quantile.y = alpha -##call of routine from RobAStBase -outlyingPlotIC(x -,IC.x = ICmle -,IC.y = ICmle -,dist.x = QProj() -#NormType() - Euclidean norm, default - Mahalanobis norm -#,dist.y = NormType() -,adj = 0.1 -,pch = 21 -,col.idn = rgb(102,102,102,maxColorValue=255) -,cex.idn = 1.7 -,col.cutoff = rgb(202,202,202,maxColorValue=255) -,offset = 0 -,cutoff.quantile.x = cutoff.quantile.x -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = rgb(52,52,52,maxColorValue=255) -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=75, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -########################################## -## ## -## Wrapper for outlyingnessPlot.R ## -## ## -## ## -########################################## -##projection distance -qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)} -QProj <- function(){new("NormType", name="Quantiles", fct=qfun)} -##@x - dataset -##@X - random variable -##@fam - parameter family -##@alpha - confidence level for quantile -# -plotOutlyingness = function(x,alpha=0.99,fam=GParetoFamily(),...,alpha.trsp = 100, with.legend = TRUE){ -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(dots$alpha.trsp)) dots$alpha.trsp <- 100 -if(is.null(dots$with.legend)) dots$with.legend <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'plotOutlyingness'") -if(missing(alpha)) stop("Argument 'alpha' must be given as argument to 'plotOutlyingness'") -if(missing(fam)) stop("Argument 'fam' must be given as argument to 'plotOutlyingness'") -##logarithmic representation (for distributions with positive support) -fam at distribution = log(fam at distribution) -##classical IC -ICmle <- optIC(model=fam,risk=asCov()) -##parameter for plotting -if(with.legend) -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "black", col.lab = "black")} -else -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "white", col.lab = "white")} -cutoff.quantile.x = alpha -cutoff.quantile.y = alpha -##call of routine from RobAStBase -outlyingPlotIC(x -,IC.x = ICmle -,IC.y = ICmle -,dist.x = QProj() -#NormType() - Euclidean norm, default - Mahalanobis norm -#,dist.y = NormType() -,adj = 0.1 -,pch = 21 -,col.idn = rgb(102,102,102,maxColorValue=255) -,cex.idn = 1.7 -,col.cutoff = rgb(202,202,202,maxColorValue=255) -,offset = 0 -,cutoff.quantile.x = cutoff.quantile.x -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = rgb(52,52,52,maxColorValue=255) -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=50, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -myplot <- function(x,y, ..., withCall =TRUE){ -### -### 1. grab the dots (and probably manipulate it within the wrapper function) -### -dots <- as.list(match.call(expand.dots=FALSE))$"..." -### -## do something to fix the good default arguments -### -### 2. build up the argument list for the (powerful/fullfledged) -### graphics/diagnostics function; -### mind not to evaluate the x and (possibly) y args to provide automatic -### axis annotation -### -args <- c(list(x=substitute(x),y=substitute(y)),dots, type="l") -### -### 3. build up the call but grab it and write it into an object -### -cl <- substitute(do.call(plot,args0), list(args0=args)) -### manipulate it so that the wrapper do.call is ommitted -cl0 <- as.list(cl)[-1] -mycall <- c(cl0,unlist(cl0[-1])) -mycall <- as.call(mycall) -### -### 4. evaluate the call (i.e., produce the graphic) -### -eval(mycall) -### -### 5. return the call (if withCall==TRUE) -### -if(withCall) return(mycall) else return(invisible(NULL)) -} -x <- 1:20 -y <- rnorm(20) -cl <- myplot(x,y,col="red") -eval(cl) -cl <- myplot(x,y) -args <- c(list(x=substitute(x),y=substitute(y)),dots, type="l") -dots <- as.list(match.call(expand.dots=FALSE))$"..." -cl <- substitute(do.call(plot,args0), list(args0=args)) -cl0 <- as.list(cl)[-1] -mycall <- c(cl0,unlist(cl0[-1])) -mycall <- as.call(mycall) -### -### 4. evaluate the call (i.e., produce the graphic) -### -eval(mycall) -### -### 5. return the call (if withCall==TRUE) -### -if(withCall) return(mycall) else return(invisible(NULL)) -########################################## -## ## -## Wrapper for outlyingnessPlot.R ## -## ## -## ## -########################################## -##projection distance -qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)} -QProj <- function(){new("NormType", name="Quantiles", fct=qfun)} -##@x - dataset -##@X - random variable -##@fam - parameter family -##@alpha - confidence level for quantile -# -plotOutlyingness = function(x,alpha=0.99,fam=GParetoFamily(),...,alpha.trsp = 100, with.legend = TRUE){ -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(dots$alpha.trsp)) dots$alpha.trsp <- 100 -if(is.null(dots$with.legend)) dots$with.legend <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'plotOutlyingness'") -if(missing(alpha)) stop("Argument 'alpha' must be given as argument to 'plotOutlyingness'") -if(missing(fam)) stop("Argument 'fam' must be given as argument to 'plotOutlyingness'") -args <- c(list(x=substitute(x),alpha=substitute(alpha),fam=substitute(fam)),dots, type="l") -cl <- substitute(do.call(plot,args0), list(args0=args)) -### manipulate it so that the wrapper do.call is ommitted -cl0 <- as.list(cl)[-1] -mycall <- c(cl0,unlist(cl0[-1])) -mycall <- as.call(mycall) -### -### 4. evaluate the call (i.e., produce the graphic) -### -eval(mycall) -##logarithmic representation (for distributions with positive support) -fam at distribution = log(fam at distribution) -##classical IC -ICmle <- optIC(model=fam,risk=asCov()) -##parameter for plotting -if(with.legend) -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "black", col.lab = "black")} -else -{par(cex=1,bty="n", col = addAlphTrsp2col(rgb(102,102,102,maxColorValue=255), alpha.trsp), -col.main = "white", col.lab = "white")} -cutoff.quantile.x = alpha -cutoff.quantile.y = alpha -##call of routine from RobAStBase -outlyingPlotIC(x -,IC.x = ICmle -,IC.y = ICmle -,dist.x = QProj() -#NormType() - Euclidean norm, default - Mahalanobis norm -#,dist.y = NormType() -,adj = 0.1 -,pch = 21 -,col.idn = rgb(102,102,102,maxColorValue=255) -,cex.idn = 1.7 -,col.cutoff = rgb(202,202,202,maxColorValue=255) -,offset = 0 -,cutoff.quantile.x = cutoff.quantile.x -,cutoff.quantile.y = cutoff.quantile.y -,cutoff.x = cutoff() -,cutoff.y = cutoff.sememp() -,robCov.x = TRUE -,robCov.y = TRUE -,tf.x = function(x)log(x) -,cex.main = 1.5 -,cex.lab = 1.5 -,cex = 1.5 -#,col.lab=FhGred -,lwd.cutoff = 3 -#,jitt.fac = 300 -,col.abline = rgb(52,52,52,maxColorValue=255) -,cex.abline = 1.2 -,adj.abline = c(0.8, 0.2) -,main = ""#"Outlyingness Plot" -,xlab="Theoretical log-quantiles" -,ylab="Mahalanobis distance" -) -} -##Example -require(RobExtremes) -X = GPareto() -fam = GParetoFamily() -x = r(X)(1000) -plotOutlyingness(x,alpha=0.95,fam=fam,alpha.trsp=50, with.legend = TRUE) -plotOutlyingness(x,alpha=0.99,fam=fam, with.legend = FALSE) -myplot <- function(x,y, ..., withCall = TRUE){ -### -### 1. grab the dots (and probably manipulate it within the wrapper function) -### -mc <- as.list(match.call(expand.dots = FALSE))[-1] -dots <- mc$"..." -if(is.null(mc$withCall)) mc$withCall <- TRUE -if(missing(x)) stop("Argument 'x' must be given as argument to 'myplot'") -if(missing(y)) stop("Argument 'y' must be given as argument to 'myplot'") -### -## do something to fix the good default arguments -### -### 2. build up the argument list for the (powerful/fullfledged) -### graphics/diagnostics function; -### mind not to evaluate the x and (possibly) y args to provide automatic -### axis annotation -### -args <- c(list(x=substitute(x),y=substitute(y)),dots,type="l") -### -### 3. build up the call but grab it and write it into an object -### -cl <- substitute(do.call(plot,args0), list(args0=args)) -### manipulate it so that the wrapper do.call is ommitted -cl0 <- as.list(cl)[-1] -mycall <- c(cl0[1],unlist(cl0[-1])) -mycall <- as.call(mycall) -### -### 4. evaluate the call (i.e., produce the graphic) -### -eval(mycall) -### -### 5. return the call (if withCall==TRUE) -### -if(mc$withCall) print(mycall) -} -x <- 1:20 -y <- rnorm(20) -cl <- myplot(x,y,col="red", withCall=TRUE) -cl <- myplot(x,y,col="blue") -cl <- myplot(x,y,col="green", withCall=FALSE) Deleted: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R =================================================================== --- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R 2013-07-02 09:20:53 UTC (rev 671) +++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R 2013-07-02 13:37:23 UTC (rev 672) @@ -1,53 +0,0 @@ - myplot <- function(x,y, ..., withCall = TRUE){ - ### - ### 1. grab the dots (and probably manipulate it within the wrapper function) - ### - mc <- as.list(match.call(expand.dots = FALSE))[-1] - dots <- mc$"..." - if(is.null(mc$withCall)) mc$withCall <- TRUE - - if(missing(x)) stop("Argument 'x' must be given as argument to 'myplot'") - if(missing(y)) stop("Argument 'y' must be given as argument to 'myplot'") - ### - ## do something to fix the good default arguments - ### - ### 2. build up the argument list for the (powerful/fullfledged) - ### graphics/diagnostics function; - ### mind not to evaluate the x and (possibly) y args to provide automatic - ### axis annotation - ### - args <- c(list(x=substitute(x),y=substitute(y)),dots,type="l") - print(args) - print("###################################################") - ### - ### 3. build up the call but grab it and write it into an object - ### - cl <- substitute(do.call(plot,args0), list(args0=args)) - print(cl) - print("###################################################") - ### manipulate it so that the wrapper do.call is ommitted - cl0 <- as.list(cl)[-1] - print(cl0) - print("###################################################") - mycall <- c(cl0[1],unlist(cl0[-1])) - print(mycall) - print("###################################################") - mycall <- as.call(mycall) - print(mycall) - print("###################################################") - ### - ### 4. evaluate the call (i.e., produce the graphic) - ### - eval(mycall) - ### - ### 5. return the call (if withCall==TRUE) - ### - if(mc$withCall) print(mycall) - -} - -x <- 1:20 -y <- rnorm(20) -cl <- myplot(x,y,col="red", withCall=TRUE) -cl <- myplot(x,y,col="blue") -cl <- myplot(x,y,col="green", withCall=FALSE) \ No newline at end of file Added: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R =================================================================== --- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R (rev 0) +++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/HelpFunction.R 2013-07-02 13:37:23 UTC (rev 672) @@ -0,0 +1,53 @@ + myplot <- function(x,y, ..., withCall = TRUE){ + ### + ### 1. grab the dots (and probably manipulate it within the wrapper function) + ### + mc <- as.list(match.call(expand.dots = FALSE))[-1] + dots <- mc$"..." + if(is.null(mc$withCall)) mc$withCall <- TRUE + + if(missing(x)) stop("Argument 'x' must be given as argument to 'myplot'") + if(missing(y)) stop("Argument 'y' must be given as argument to 'myplot'") + ### + ## do something to fix the good default arguments + ### + ### 2. build up the argument list for the (powerful/fullfledged) + ### graphics/diagnostics function; + ### mind not to evaluate the x and (possibly) y args to provide automatic + ### axis annotation + ### + args <- c(list(x=substitute(x),y=substitute(y)),dots,type="l") + print(args) + print("###################################################") + ### + ### 3. build up the call but grab it and write it into an object + ### + cl <- substitute(do.call(plot,args0), list(args0=args)) + print(cl) + print("###################################################") + ### manipulate it so that the wrapper do.call is ommitted + cl0 <- as.list(cl)[-1] + print(cl0) + print("###################################################") + mycall <- c(cl0[1],unlist(cl0[-1])) + print(mycall) + print("###################################################") + mycall <- as.call(mycall) + print(mycall) + print("###################################################") + ### + ### 4. evaluate the call (i.e., produce the graphic) + ### + eval(mycall) + ### + ### 5. return the call (if withCall==TRUE) + ### + if(mc$withCall) print(mycall) + +} + +x <- 1:20 +y <- rnorm(20) +cl <- myplot(x,y,col="red", withCall=TRUE) +cl <- myplot(x,y,col="blue") +cl <- myplot(x,y,col="green", withCall=FALSE) \ No newline at end of file Deleted: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R =================================================================== --- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-07-02 09:20:53 UTC (rev 671) +++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-07-02 13:37:23 UTC (rev 672) @@ -1,172 +0,0 @@ -########################################## -## ## -## Wrapper for AllPlot.R ## -## (plot method for IC) ## -## ## -########################################## - -##IC - influence curve -##y - dataset -## with.legend - optional legend indicator -## withCall - optional indicator of the function call -# -ICAllPlotWrapper = function(IC, y,...,alpha.trsp = 100,with.legend = TRUE, withCall = TRUE){ - ### - ### 1. grab the dots (and manipulate it within the wrapper function) - ### - ### - ### do something to fix the good default arguments - ### - mc <- as.list(match.call(expand.dots = FALSE))[-1] - dots <- mc$"..." - if(is.null(mc$alpha.trsp)) alpha.trsp <- 100 - if(is.null(mc$with.legend)) mc$with.legend <- TRUE - if(is.null(mc$withCall)) mc$withCall <- TRUE - if(missing(IC)) stop("Argument 'IC' must be given as argument to 'ICAllPlotWrapper'") - ### - ### 2. build up the argument list for the (powerful/fullfledged) - ### graphics/diagnostics function; - ## - - if(missing(y)){ - argsList <- list(x = substitute(IC) - ,withSweave = substitute(getdistrOption("withSweave")) - ,main = substitute(FALSE) - ,inner = substitute(TRUE) - ,sub = substitute(FALSE) - ,col.inner = substitute(par("col.main")) - ,cex.inner = substitute(0.8) - ,bmar = substitute(par("mar")[1]) - ,tmar = substitute(par("mar")[3]) - ,with.legend = substitute(FALSE) - ,legend = substitute(NULL) - ,legend.bg = substitute("white") - ,legend.location = substitute("bottomright") - ,legend.cex = substitute(0.8) - ,withMBR = substitute(FALSE) - ,MBRB = substitute(NA) - ,MBR.fac = substitute(2) - ,col.MBR = substitute(par("col")) - ,lty.MBR = substitute("dashed") - ,lwd.MBR = substitute(0.8) - ,scaleX = substitute(FALSE) - ,scaleX.fct = substitute(p(eval(IC at CallL2Fam))) - ,scaleX.inv = substitute(q(eval(IC at CallL2Fam))) - ,scaleY = substitute(FALSE) - ,scaleY.fct = substitute(pnorm) - ,scaleY.inv=substitute(qnorm) - ,scaleN = substitute(9) - ,x.ticks = substitute(NULL) - ,y.ticks = substitute(NULL) - ,mfColRow = substitute(TRUE) - ,to.draw.arg = substitute(NULL) - ,adj = substitute(0.1) - ,cex.main = substitute(1.5) - ,cex.lab = substitute(1.5) - ,cex = substitute(1.5) - ,bty = substitute("n") - ,panel.first= substitute(grid()) - ,col = substitute("blue") - ) - }else{ - argsList <- list(x = substitute(IC) - ,y = substitute(y) - ,cex.pts = substitute(0.3) - ,col.pts = substitute(addAlphTrsp2col(rgb(0,255,0,maxColorValue=255), substitute(alpha.trsp))) - ,pch.pts = substitute(1) - ,jitter.fac = substitute(1) - ,with.lab = substitute(FALSE) - ,lab.pts = substitute(NULL) - ,lab.font = substitute(NULL) - ,alpha.trsp = substitute(NA) - ,which.lbs = substitute(NULL) - ,which.Order = substitute(NULL) - ,return.Order = substitute(FALSE) - ,adj = substitute(0.1) - ,cex.main = substitute(1.5) - ,cex.lab = substitute(1.5) - ,cex = substitute(1.5) - ,bty = substitute("n") - ,panel.first= substitute(grid()) - ,col = substitute("blue") - ) - } - - - - ##parameter for plotting - if(mc$with.legend) - { - argsList$col.main <- "black" - argsList$col.lab <- "black" - } - else - { - argsList$col.main <- "white" - argsList$col.lab <- "white" - } - - args <- c(argsList, dots) - ### - ### 3. build up the call but grab it and write it into an object - ### - cl <- substitute(do.call(plot,args0), list(args0=args)) - ### manipulate it so that the wrapper do.call is ommitted - cl0 <- as.list(cl)[-1] - mycall <- c(cl0[1],unlist(cl0[-1])) - mycall <- as.call(mycall) - ### - ### 4. evaluate the call (i.e., produce the graphic) - ### - eval(mycall) - ### - ### 5. return the call (if withCall==TRUE) - ### - if(mc$withCall) print(mycall) - -} - -##Examples -require(RobExtremes) -require(distr) - -# GPD -fam = GParetoFamily() -IC <- optIC(model = fam, risk = asCov()) -Y=distribution(fam) -y = r(Y)(1000) -dev.new() -ICAllPlotWrapper(IC, alpha.trsp=50, with.legend = FALSE) -dev.new() -ICAllPlotWrapper(IC, y, alpha.trsp=50, with.legend = FALSE) - -# GEV -fam = GEVFamily() -IC <- optIC(model = fam, risk = asCov()) -Y=distribution(fam) -y = r(Y)(1000) -dev.new() -ICAllPlotWrapper(IC, with.legend = TRUE, withCall = TRUE) -dev.new() -ICAllPlotWrapper(IC, y, with.legend = TRUE, withCall = TRUE) - -# Gamma -fam = GammaFamily() -IC <- optIC(model = fam, risk = asCov()) -Y=distribution(fam) -y = r(Y)(1000) -dev.new() -ICAllPlotWrapper(IC, alpha.trsp=70) -dev.new() -ICAllPlotWrapper(IC, y, alpha.trsp=70) - -# Weibull -fam = WeibullFamily() -IC <- optIC(model = fam, risk = asCov()) -Y=distribution(fam) -y = r(Y)(1000) -dev.new() -ICAllPlotWrapper(IC, alpha.trsp=50, with.legend = TRUE, withCall = FALSE) -dev.new() -ICAllPlotWrapper(IC, y, alpha.trsp=50, with.legend = TRUE, withCall = FALSE) - Added: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R =================================================================== --- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R (rev 0) +++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-07-02 13:37:23 UTC (rev 672) @@ -0,0 +1,214 @@ +########################################## +## ## +## Wrapper for AllPlot.R ## +## (plot method for IC) ## +## ## +########################################## + +##IC - influence curve +##y - dataset +## with.legend - optional legend indicator +## withCall - optional indicator of the function call +# +ICAllPlotWrapper = function(IC, y,...,alpha.trsp = 100, with.legend = TRUE, rescale = FALSE ,withCall = TRUE){ + ### + ### 1. grab the dots (and manipulate it within the wrapper function) + ### + ### + ### do something to fix the good default arguments + ### + if(missing(IC)) stop("Argument 'IC' must be given as argument to 'ICAllPlotWrapper'") + mc <- as.list(match.call(expand.dots = FALSE))[-1] + dots <- mc$"..." + if(missing(y)){ + alpha.trsp <- 100 + } else { + if(is.null(mc$alpha.trsp)){ + alpha.trsp <- 30 + if(length(y) < 1000){ + alpha.trsp <- 50 + } + if(length(y) < 100){ + alpha.trsp <- 100 + } + } + } + if(is.null(mc$with.legend)) mc$with.legend <- TRUE + if(is.null(mc$rescale)) mc$rescale <- FALSE + if(is.null(mc$withCall)) mc$withCall <- TRUE + ### + ### 2. build up the argument list for the (powerful/fullfledged) + ### graphics/diagnostics function; + ## + + ## For GEVFamily we have to scale the axes + if((mc$rescale) & (as.list(IC at CallL2Fam)[[1]] == "GEVFamily")){ + if(missing(y)){ + scaleList <- list(scaleX = substitute(TRUE) + ,scaleX.fct = substitute(p(eval(IC at CallL2Fam))) + ,scaleX.inv = substitute(q(eval(IC at CallL2Fam))) + ,scaleY = substitute(TRUE) + ,scaleY.fct = substitute(pnorm) + ,scaleY.inv = substitute(qnorm) + ,x.ticks = substitute(NULL) + ,y.ticks = substitute(NULL) + ) + } else { + scaleList <- list(scaleX = substitute(TRUE) + ,scaleY = substitute(TRUE) + ) + } + }else{ + if(missing(y)){ + scaleList <- list(scaleX = substitute(FALSE) + ,scaleX.fct = substitute(p(eval(IC at CallL2Fam))) + ,scaleX.inv = substitute(q(eval(IC at CallL2Fam))) + ,scaleY = substitute(FALSE) + ,scaleY.fct = substitute(pnorm) + ,scaleY.inv=substitute(qnorm) + ,x.ticks = substitute(NULL) + ,y.ticks = substitute(NULL) + ) + } else { + scaleList <- list(scaleX = substitute(FALSE) + ,scaleY = substitute(FALSE) + ) + } + } + + + if(missing(y)){ + argsList <- c(list(x = substitute(IC) + ,withSweave = substitute(getdistrOption("withSweave")) + ,main = substitute(FALSE) + ,inner = substitute(TRUE) + ,sub = substitute(FALSE) + ,col.inner = substitute(par("col.main")) + ,cex.inner = substitute(0.8) + ,bmar = substitute(par("mar")[1]) + ,tmar = substitute(par("mar")[3]) + ,with.legend = substitute(FALSE) + ,legend = substitute(NULL) + ,legend.bg = substitute("white") + ,legend.location = substitute("bottomright") + ,legend.cex = substitute(0.8) + ,withMBR = substitute(FALSE) + ,MBRB = substitute(NA) + ,MBR.fac = substitute(2) + ,col.MBR = substitute(par("col")) + ,lty.MBR = substitute("dashed") + ,lwd.MBR = substitute(0.8) + ,scaleN = substitute(9) + ,mfColRow = substitute(TRUE) + ,to.draw.arg = substitute(NULL) + ,adj = substitute(0.5) + ,cex.main = substitute(1.5) + ,cex.lab = substitute(1.5) + ,cex = substitute(1.5) + ,bty = substitute("o") + ,panel.first= substitute(grid()) + ,col = substitute("blue") + ), scaleList) + }else{ + argsList <- c(list(x = substitute(IC) + ,y = substitute(y) + ,cex.pts = substitute(0.3) + ,col.pts = substitute(addAlphTrsp2col(rgb(0,255,0,maxColorValue=255), substitute(alpha.trsp))) [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 672 From noreply at r-forge.r-project.org Fri Jul 5 23:10:01 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 5 Jul 2013 23:10:01 +0200 (CEST) Subject: [Robast-commits] r673 - in branches/robast-0.9/pkg: RobAStRDA/R RobExtremes/inst/AddMaterial/interpolation RobExtremesBuffer Message-ID: <20130705211001.1FFE618476B@r-forge.r-project.org> Author: ruckdeschel Date: 2013-07-05 23:10:00 +0200 (Fri, 05 Jul 2013) New Revision: 673 Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-OMSE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-RMXE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-MBRE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-OMSE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-RMXE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-MBRE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-RMXE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GeraldLMScripts.R branches/robast-0.9/pkg/RobExtremesBuffer/MatthiasLMScripts.R branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-MBRE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-OMSE-s.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-RMXE-s.pdf Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R branches/robast-0.9/pkg/RobExtremesBuffer/BernhardLMScripts.R branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GEV-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/GPD-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Gamma-RMXE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/MishaLMScripts.R branches/robast-0.9/pkg/RobExtremesBuffer/PeterLMScripts.R branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-MBRE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-OMSE.pdf branches/robast-0.9/pkg/RobExtremesBuffer/Weibull-RMXE.pdf Log: RobAStRDA: finished smoothing of LMs Modified: branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R =================================================================== --- branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-07-02 13:37:23 UTC (rev 672) +++ branches/robast-0.9/pkg/RobAStRDA/R/interpolAux.R 2013-07-05 21:10:00 UTC (rev 673) @@ -50,9 +50,16 @@ for(i in 1:ncol(LMGrid)){ gmi <- gridRestrForSmooth[[i]] if(is.null(df[[i]])){ - LMGrid[gmi,i] <- smooth.spline(thGrid[gmi],LMGrid[gmi,i])$y +## LMGrid[gmi, i] <- smooth.spline(thGrid[gmi], LMGrid[gmi, +## i])$y + SmoothSpline <- smooth.spline(thGrid[gmi], LMGrid[gmi, i]) + LMGrid[, i] <- predict(SmoothSpline, thGrid)$y } else { - LMGrid[gmi,i] <- smooth.spline(thGrid[gmi],LMGrid[gmi,i],df=df[[i]])$y +## LMGrid[gmi, i] <- smooth.spline(thGrid[gmi], LMGrid[gmi, +## i], df = df[[i]])$y + SmoothSpline <- smooth.spline(thGrid[gmi], LMGrid[gmi, i], + df = df[[i]]) + LMGrid[, i] <- predict(SmoothSpline, thGrid)$y } } return(cbind(xi=thGrid,LM=LMGrid)) Modified: branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda =================================================================== (Binary files differ) Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R =================================================================== --- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-07-02 13:37:23 UTC (rev 672) +++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-07-05 21:10:00 UTC (rev 673) @@ -155,16 +155,16 @@ plotLM("MBRE","GE","all", type="l") plotLM("MBRE","GE","all", sm = TRUE, df = 10, gridR = -(1:15)) plotLM("MBRE","GE","all", sm = TRUE, df = 4, gridR = -(1:15)) -plotLM("OMSE","Gamma","all", plotG=-(1:8), pre=pdf("Gamma-OMSE.pdf"), post=dev.off()) -plotLM("OMSE","Gener","all", plotG=-(1:8), pre=pdf("GPD-OMSE.pdf"), post=dev.off()) -plotLM("OMSE","GEV","all", plotG=-(1:8), pre=pdf("GEV-OMSE.pdf"), post=dev.off()) -plotLM("OMSE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-OMSE.pdf"), post=dev.off()) -plotLM("MBRE","Gam","all", plotG=-(1:8), pre=pdf("Gamma-MBRE.pdf"), post=dev.off()) -plotLM("MBRE","Gene","all", plotG=-(1:8), pre=pdf("GPD-MBRE.pdf"), post=dev.off()) -plotLM("MBRE","GE","all", plotG=-(1:8), pre=pdf("GEV-MBRE.pdf"), post=dev.off()) -plotLM("MBRE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-MBRE.pdf"), post=dev.off()) -plotLM("RMXE","Gam","all", plotG=-(1:8), pre=pdf("Gamma-RMXE.pdf"), post=dev.off()) -plotLM("RMXE","Gene","all", plotG=-(1:8), pre=pdf("GPD-RMXE.pdf"), post=dev.off()) -plotLM("RMXE","GE","all", plotG=-(1:8), pre=pdf("GEV-RMXE.pdf"), post=dev.off()) -plotLM("RMXE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-RMXE.pdf"), post=dev.off()) +plotLM("OMSE","Gamma","all", plotG=-(1:8), withS=TRUE, pre=pdf("Gamma-OMSE-s.pdf"), post=dev.off()) +plotLM("OMSE","Gener","all", plotG=-(1:8), withS=TRUE, pre=pdf("GPD-OMSE-s.pdf"), post=dev.off()) +plotLM("OMSE","GEV","all", plotG=-(1:8), withS=TRUE, pre=pdf("GEV-OMSE-s.pdf"), post=dev.off()) +plotLM("OMSE","Wei","all", plotG=-(1:8), withS=TRUE, pre=pdf("Weibull-OMSE-s.pdf"), post=dev.off()) +plotLM("MBRE","Gam","all", plotG=-(1:8), withS=TRUE, pre=pdf("Gamma-MBRE-s.pdf"), post=dev.off()) +plotLM("MBRE","Gene","all", plotG=-(1:8), withS=TRUE, pre=pdf("GPD-MBRE-s.pdf"), post=dev.off()) +plotLM("MBRE","GE","all", plotG=-(1:8), withS=TRUE, pre=pdf("GEV-MBRE-s.pdf"), post=dev.off()) +plotLM("MBRE","Wei","all", plotG=-(1:8), withS=TRUE, pre=pdf("Weibull-MBRE-s.pdf"), post=dev.off()) +plotLM("RMXE","Gam","all", plotG=-(1:8), withS=TRUE, pre=pdf("Gamma-RMXE-s.pdf"), post=dev.off()) +plotLM("RMXE","Gene","all", plotG=-(1:8),withS=TRUE, pre=pdf("GPD-RMXE-s.pdf"), post=dev.off()) +plotLM("RMXE","GE","all", plotG=-(1:8), withS=TRUE, pre=pdf("GEV-RMXE-s.pdf"), post=dev.off()) +plotLM("RMXE","Wei","all", plotG=-(1:8), withS=TRUE, pre=pdf("Weibull-RMXE-s.pdf"), post=dev.off()) } Modified: branches/robast-0.9/pkg/RobExtremesBuffer/BernhardLMScripts.R =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/BernhardLMScripts.R 2013-07-02 13:37:23 UTC (rev 672) +++ branches/robast-0.9/pkg/RobExtremesBuffer/BernhardLMScripts.R 2013-07-05 21:10:00 UTC (rev 673) @@ -31,6 +31,9 @@ # * RobRex # ## evtl naechste Zeile modifizieren +#Peter +baseDir0 <- "C:/rtest/RobASt" +#Bernhard baseDir0 <- "/home/bernhard/university/svn/r-forge/robast" interpolDir <- "branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation" interpolFile <- "plotInterpol.R" @@ -44,6 +47,7 @@ ############################################### ### WARNING: new .MakeSmoothGridList()!!! ### +#setwd(file.path(baseDir0,"branches/robast-0.9/pkg/RobExtremesBuffer")) source("MakeSmoothGridListBe.R") ############################################### @@ -136,7 +140,7 @@ ### schreiben der gegl?tteten Gitter ins rda-file, ## aber zun?chst noch woanders (myRDA1) gespeichert: -.saveGridToRda(CSVFiles2, toFileRDA = myRDA1, withMerge = TRUE, +.saveGridToRda(CSVFiles2, toFileRDA = myRDA1, withMerge = FALSE, withPrint = TRUE, withSmooth = TRUE, df = dfR2, gridRestrForSmooth=gridR2) @@ -170,7 +174,7 @@ myplot3("all", df=dfR3, gridR=gridR3, withSmooth=FALSE, pre=X11()) ### schreiben der gegl?tteten Gitter ins rda-file, ## aber zun?chst noch woanders (myRDA1) gespeichert: -.saveGridToRda(CSVFiles3, toFileRDA = myRDA1, withMerge = TRUE, +.saveGridToRda(CSVFiles3, toFileRDA = myRDA1, withMerge = FALSE, withPrint = TRUE, withSmooth = TRUE, df = dfR3, gridRestrForSmooth=gridR3) Added: branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE-s.pdf =================================================================== --- branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE-s.pdf (rev 0) +++ branches/robast-0.9/pkg/RobExtremesBuffer/GEV-MBRE-s.pdf 2013-07-05 21:10:00 UTC (rev 673) @@ -0,0 +1,341 @@ +%PDF-1.4 +%????????\r +1 0 obj +<< +/CreationDate (D:20130705225100) +/ModDate (D:20130705225100) +/Title (R Graphics Output) +/Producer (R 3.0.0) +/Creator (R) +>> +endobj +2 0 obj +<< /Type /Catalog /Pages 3 0 R >> +endobj +7 0 obj +<< /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> +endobj +8 0 obj +<< +/Length 53529 /Filter /FlateDecode +>> +stream +x???K?-???7??8?.?u?????Qn??2?.?=jPV?h?l +l??;?^k????d^]evI]1?+??yd???I???????_?????????????????W?K?u????????????o??^??W??w????h^?????*?})???W?K???{??{?+Z??z??+??/??\??}is?K??{????k?????+?????????c????????????y~??U??????????W?_????????????/???L?????9~Y????|)?_?o???_j?9???+$?/%^o???/)?~??%???????!?????wy???e?y???%?C???K???h ?? '???5??2?)P"?)B&<7e????B?? +Y??4 k???e>?E????$K?? !7?v????bK??7??R$?J)??&?Q +??R? ??L?Y????L?nrR????W?U??? ?P??*3 +?2d???J???6>?Q?????w>hP?A?????5? +2R?t? ?2S&?r?l8????j????>?CN>??m????~?i??|?Dy??????~?[{r9!9?Kf+?d???2????&??\?A6??A?@?^]? 9?[t?^?)?D???%?gr?(d??Mv +g???v?2B??)?z???2?b??3?????:???????g??'{?.?A??\v???g?? +?5r? ?DW0Q?.?)?+t????F??>?!W?)?5R???b?*Sf*S?????k????"xc??r?%~?m??,Bk??F??(?)??t???M?D?)??}UN?????QE???dD??9_21?A??I??)p2)6?\?-e2???&??????K?j?|????&???}?^??m??P??&; 3B}(??MH????Fg??d?s??]??/]&??l$??y?VV??s at +??MN???z???/-???fu???2?*(QfR?-??A?~Uv0????I??Nd???????rI?v4????%????40????)??U?P???vJf??A?I??????\???#CF$??\}?b?C?>h?????:??_?D???oL4??Q????W???Zw?d ???1?d??|????5L6???>m?,?I????????_?IM?j?>j4O&;d??????>*d??/???_?&r&??-.????@d????H?5 ++M??O??&????????is~??0+y???W??????j?
?????~??v??F???? ?.???d?$???Kz5??:??\]???-??Q?????#q?p???;?\????????&?S?0??r?7z??}M"2r????[].i-?p????d +?j?LH??^??[????p?tI/?/X}?+????????6??]2B?jv? +??3??,J?|?7??]P??????Q?L??^?? ?!?}???{?*0B?>,^?F+32???J???Va?[?%m?.??/?M?t?????[?:?????????#??u?A?????&??]?_NA[>wY!?C??XZ???@?0a?7??0Q*???q??gV??| ???????F7`?5?K???S*???? +?K?t???kBZ?eV?i??[EH?`?ri?ya?8??dJCK?dB?(Q???LQ??Uw?c?:s?.Y??c?? i??*QuN??}??S +{?K???J??e?D???+&?f?I??1?????U???????L?n?0?vA??S2?E??????(?O???--?g??|&?????\????5?w[?pKF1???h???m"BZof?? +iK??????#???%??? ?b?? i}?M?j?Ye??X??????sR????%??? }?,?Q??????Q`???z[RZ??|?K?Z?o'????????fP?lbV??jA??>9??d?o????{??l?K?^??z5QEm mzY?&?X?CDf??????Id#1)??\?0????????d?l? +????f??m?g???k? t??7Y?!ip?5?b?4?^{?????>??X??a?^+?.&?T+???W?X?[????}s??s???|?(BC???M?T+g?^???]??F?? +L?N???$R???m,?-????)^???f?0????N?$??!f?t_??N?/'JdrP???? K??????~{-)e?{F? ;??W?$?`G?"???B`U???Jcer:??JC?N?q?????[???6???x??^m?^?^%?^ +??xU?x????#?Z_^?N?J6?????#^?|???W?2????W??/?W??w?U??x? ?_???Qx5?nx???:^?A?3^-??????6??_'^?e??????x?0e?UbN?U?T?????????????U?Vx???W*??P?U?Y?UrM?UBP?U? +?2Tx?Rx?s??n?Z^7????W##?F"R?U?7^??????,??_'^?????????-?j%?^uh???x??*??*???*?+?jgR???????,?Z???nx?I ?z??WI=?W???W???W?S?WY<5~U?fJ?UrM?U?T?U`??WE[?W????jz??*C?W;?"O??+r?US?U?&?<?\M??F?W??HR+?J)?J?*??_7?J?*?J??s????~??_7?JI???H?W??jz??j{?^??^?$^??~'^M?^????*y??*y??*??*K?????*y??*Y????h???:?*???hV????W#?2e?U?O??? +???~????G?U"?o????cx????Jb???? +????W3??Jb??2??jz?^O%^%@^??^??^%?^%O^%?^??7^ +?^%1^?^??^%?^??7^%@%^-$????u???u??????????u??H?*?J?*?J)??Im??_'^E???W#??*??j}??*#???-?? _?W}L?x?l??L?J?*?J? +????.?????WJ?J???????7^]???????WC?W?D7^??^%O%^?y??WYx????*??j?7:?*i+?j??U??W;%??$@u?J?????x?gn?v?T??4v ?N??Wi9?x?;??W'y????PfF"?????#GTQ??H?L?J?I?U6+???%??*?W?j&?$^??Q?f23?UV`?U?o ??>&?+??$??:?A?l'^?D;?? +??*?r????@x?a?-??VR3??x??6?W?? +?Ax?-??[A?? +F&??d? ?}L?od?x?????i?v???W??%??1? ??MAx??^m? Aqbd????j'?'O???+??x*Bs5?F????Hx????_#"W?V?2rBhmE(? ?jge ^???j??'^??ol?:?T?{???&s?7y??c???N?*?O?J?%?:0?^D???DQ??dO???} ?????-?H?
P??@??>P???T}??U??@??>P???T}??U??@??>P???T}??U?????y??7fL?t???|p{?=fO?????c?}??H?????1f??????b?????q???????????G??3?#???8?=]?;OqO?~:?]u????:h??????,???? 8b`?p? ??1??01??g?l??9???cE??*Q?{?k??????=?!?3???_?XO???#??u??*????????C??-???r?z???]???\ ?????????????????????????;?W\?{?;?KW:!t???L??%?? ???b+>???5?q
+DQ
+u??Y?iZ?????^?f???i]??g?GKv?
+&???t?zW~eU???Uz?m??m?h5??)K?lW????RgX?F??
+B? ?<1]i???Ll=Qw?|?f????y+??V?:??6?Yk
+?=?w??S??6??Nm???5"??>q??g??(6??'S?P??f??.??? ?J?????I#tD??????:?x??b? ????+5?X]????????ZK?H?t~?J??
+????]??0?=??
+6)?o??E7??,
+?O??4e?g???tq]N??_?????5????`??????__?'?hLX???7??3a??x>|?J????R$??L'????B?b?????GQ?+?M??z?a#?~1??d??B??????}W??????A????4B?e?,z???????e?$?0]`?B???Vf?d???Q{?H,\?y]?q?f???e??~c?^*??+4??&/??c?. Y??
+?????>???W???O???~?7??g?/???c?IY???_?*}??????????4?zr??a??V??Y??;`?t??O???????7;Rk????????{????q?t?l?t???Gj?t?w7O_|????)?=N<=r??yzVz??U??)}????:xz?&O/?????xx?!?+,??????O???{l?O?zy?????E??????;7?(?<}????4???^?x??????x??????'??.??]$?=yz?&O
+'Oz>yz_'O?o*>y:????!??BM???????-???????x??O????????y?x?x?????
+OW8yz/?V?????'?x?????u??'?O?^N???/???O???<]|[<]|;???l?t?'?.?N??_<]????)?x??????x?xy?w~.?.^M???????O?OOWz???n???{??????+???|?t?????:x?x8y:?]O?O??????O/?????x???x??'??????O???<]?\<]<[<]|]h?t?????~O?^?xzS????????????4y????Kg???46j??
+???+?????g=??????O?^??????8y:?????X<}???)O?N?????????k??yzo'O/???????]??<}??t?E?t????g?o??$?N???????x;yz?&OG????<(???????+????????s?s?t=?<}?u??(>N????_?gO?????'?N?^?x????U???7???g???a?t????7?>.???9???y???????'???7???O??[<=)????s?t??????????A?g?_???*?Q?????o?????x:????]?x7?K??=P????z?t?G6O??yzS?]<=??W??(??
+2???[9;5??$?p?t??????:yzQ8yz/'OG?yzU???????x?O??H??x:/(_<}????.M?>??#????????I{?????x9y:????7???xz?'O_?[/O??????_m??????5y:?O??/O?N~?x:????KOn????68?'???V??C?c??????9yz'O?x?y??????o???=o??????????'O??????PGj????????????<??'??x????X??<]?1??i??"?M??????u?s?/??U?K??:????+????????????'?.?/?^??)????~?xz??V<}?_??:?cO?<?????~O?N??x?????Q|\<]?????????O_Z??[?????/?N^?yz?OG~???i????o~_?A???J?Ox^????=??W?u??????/??yz???????#??<??<}P??%??!??????!S???a?t?????x