From noreply at r-forge.r-project.org Fri Aug 1 19:24:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Aug 2014 19:24:31 +0200 (CEST) Subject: [Robast-commits] r772 - in branches/robast-1.0/pkg/ROptEst: R man Message-ID: <20140801172431.4BDBB186BFF@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-01 19:24:30 +0200 (Fri, 01 Aug 2014) New Revision: 772 Modified: branches/robast-1.0/pkg/ROptEst/R/cniperCont.R branches/robast-1.0/pkg/ROptEst/man/cniperCont.Rd branches/robast-1.0/pkg/ROptEst/man/internal_Cniperplots.Rd Log: [ROptEst] fixed issue with points plotting in Cniperpoint-plots Modified: branches/robast-1.0/pkg/ROptEst/R/cniperCont.R =================================================================== --- branches/robast-1.0/pkg/ROptEst/R/cniperCont.R 2014-07-28 11:56:34 UTC (rev 771) +++ branches/robast-1.0/pkg/ROptEst/R/cniperCont.R 2014-08-01 17:24:30 UTC (rev 772) @@ -3,26 +3,24 @@ ## helper function for cniper-type plots to plot in data data, # data to be plot in dots, # dots from the calling function - origCl, # call from the calling function fun, # function to determine risk difference L2Fam, # L2Family IC # IC1 in cniperContPlot and eta in cniperPointPlot ){ dotsP <- .makedotsP(dots) - dotsP$col <- rep(eval(origCl$col.pts), length.out=n) - dotsP$pch <- rep(eval(origCl$pch.pts), length.out=n) - al <- eval(origCl$alpha.trsp) - if(!is.na(al)) - dotsP$col <- sapply(dotsP$col, addAlphTrsp2col, alpha=al) + al <- dotsP$alpha.trsp + if(!is.null(al)) if(!is.na(al)) + dotsP$col <- sapply(dotsP$col, + addAlphTrsp2col, alpha=al) n <- if(!is.null(dim(data))) nrow(data) else length(data) - if(!is.null(lab.pts)) - lab.pts <- rep(origCl$lab.pts, length.out=n) + if(!is.null(dots$lab.pts)) + lab.pts <- rep(lab.pts, length.out=n) + sel <- .SelectOrderData(data, function(x)sapply(x,fun), - eval(origCl$which.lbs), - eval(origCl$which.Order)) + dots$which.lbs, dots$which.Order) i.d <- sel$ind i0.d <- sel$ind1 y.d <- sel$y @@ -30,10 +28,19 @@ n <- length(i.d) resc.dat <- .rescalefct(x.d, function(x) sapply(x,fun), - eval(origCl$scaleX), origCl$scaleX.fct, origCl$scaleX.inv, - eval(origCl$scaleY), origCl$scaleY.fct, + dots$scaleX, dots$scaleX.fct, dots$scaleX.inv, + dots$scaleY, dots$scaleY.fct, dots$xlim, dots$ylim, dots) + dotsP$scaleX <- dotsP$scaleY <- dotsP$scaleN <-NULL + dotsP$scaleX.fct <- dotsP$scaleY.fct <- NULL + dotsP$scaleX.inv <- dotsP$scaleY.inv <- NULL + dotsP$cex.pts <- dotsP$col.pts <- dotsP$lab.pts <- dotsP$pch.pts <- NULL + dotsP$jitter.fac <- dotsP$with.lab <- dotsP$alpha.trsp <- NULL + dotsP$return.Order <- dotsP$cex.pts.fun <- NULL + dotsP$x.ticks <- dotsP$y.ticks <- NULL + dotsP$lab.font <- dotsP$which.lbs <- dotsP$which.lbs <- NULL + dotsP$x <- resc.dat$X dotsP$y <- resc.dat$Y @@ -49,18 +56,20 @@ absy.f <- t(IC.rv) %*% QF %*% IC.rv absy <- absInfoEval(x.d, absy.f) - if(is.null(origCl$cex.pts)) origCl$cex.pts <- par("cex") - dotsP$cex <- log(absy+1)*3*rep(origCl$cex.pts, length.out=n) + if(is.null(dots$cex.pts)) dots$cex.pts <- par("cex") dotsT <- dotsP + dotsT$cex <- dotsP$cex/2 + dotsP$cex <- .cexscale(absy,absy,cex=dots$cex.pts, fun = dots$cex.pts.fun) + dotsP$col <- dots$col.pts + dotsT$pch <- NULL - dotsT$cex <- dotsP$cex/2 - dotsT$labels <- if(is.null(lab.pts)) i.d else lab.pts[i.d] + dotsT$labels <- if(is.null(dots$lab.pts)) i.d else dots$lab.pts[i.d] do.call(points,dotsP) - if(!is.null(origCl$with.lab)) - if(origCl$with.lab) do.call(text,dotsT) - if(!is.null(origCl$return$order)) - if(origCl$return.Order) return(i0.d) + if(!is.null(dots$with.lab)) + if(dots$with.lab) do.call(text,dotsT) + if(!is.null(dots$return.Order)) + if(dots$return.Order) return(i0.d) return(invisible(NULL)) } @@ -105,14 +114,19 @@ scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, - cex.pts = 1, col.pts = par("col"), + cex.pts = 1, cex.pts.fun = NULL, col.pts = par("col"), pch.pts = 19, jitter.fac = 1, with.lab = FALSE, lab.pts = NULL, lab.font = NULL, alpha.trsp = NA, which.lbs = NULL, which.Order = NULL, return.Order = FALSE){ - mc <- match.call(expand.dots = FALSE) - dots <- as.list(mc$"...") + mcD <- match.call(expand.dots = FALSE) + dots <- as.list(mcD$"...") + mc <- match.call(#call = sys.call(sys.parent(1)), + expand.dots = TRUE) + mcl <- as.list(mc[-1]) + + if(!is(IC1,"IC")) stop ("IC1 must be of class 'IC'") if(!is(IC2,"IC")) stop ("IC2 must be of class 'IC'") if(!identical(IC1 at CallL2Fam, IC2 at CallL2Fam)) @@ -142,51 +156,75 @@ resc <- .rescalefct(x, fun, scaleX, scaleX.fct, scaleX.inv, scaleY, scaleY.fct, dots$xlim, dots$ylim, dots) - dots$x <- resc$X - dots$y <- resc$Y - dots$type <- "l" - if(is.null(dots$main)) dots$main <- gettext("Cniper region plot") - if(is.null(dots$xlab)) dots$xlab <- gettext("Dirac point") - if(is.null(dots$ylab)) - dots$ylab <- gettext("Asymptotic Risk difference (IC1 - IC2)") + dotsPl <- dots + dotsPl$x <- resc$X + dotsPl$y <- resc$Y + dotsPl$type <- "l" + if(is.null(dotsPl$main)) dotsPl$main <- gettext("Cniper region plot") + if(is.null(dotsPl$xlab)) dotsPl$xlab <- gettext("Dirac point") + if(is.null(dotsPl$ylab)) + dotsPl$ylab <- gettext("Asymptotic Risk difference (IC1 - IC2)") colSet <- ltySet <- lwdSet <- FALSE - if(!is.null(dots$col)) {colSet <- TRUE; colo <- eval(dots$col)} + if(!is.null(dotsPl$col)) {colSet <- TRUE; colo <- eval(dotsPl$col)} if(colSet) { colo <- rep(colo,length.out=2) - dots$col <- colo[1] + dotsPl$col <- colo[1] } - if(!is.null(dots$lwd)) {lwdSet <- TRUE; lwdo <- eval(dots$lwd)} + if(!is.null(dotsPl$lwd)) {lwdSet <- TRUE; lwdo <- eval(dotsPl$lwd)} if(lwdSet) { lwdo <- rep(lwdo,length.out=2) - dots$lwd <- lwdo[1] + dotsPl$lwd <- lwdo[1] } - if(!is.null(dots$lty)) {ltySet <- TRUE; ltyo <- eval(dots$lty)} + if(!is.null(dotsPl$lty)) {ltySet <- TRUE; ltyo <- eval(dotsPl$lty)} if(ltySet && ((!is.numeric(ltyo) && length(ltyo)==1)|| is.numeric(ltyo))){ ltyo <- list(ltyo,ltyo) - dots$lty <- ltyo[[1]] + dotsPl$lty <- ltyo[[1]] }else{ if (ltySet && !is.numeric(ltyo) && length(ltyo)==2){ - dots$lty <- ltyo[[1]] + dotsPl$lty <- ltyo[[1]] } } - do.call(plot,dots) + do.call(plot,dotsPl) - dots <- .makedotsLowLevel(dots) dots$x <- dots$y <- NULL - if(colSet) dots$col <- colo[2] - if(lwdSet) dots$lwd <- lwdo[2] - if(ltySet) dots$lty <- ltyo[[2]] + dotsl <- .makedotsLowLevel(dots) + if(colSet) dotsl$col <- colo[2] + if(lwdSet) dotsl$lwd <- lwdo[2] + if(ltySet) dotsl$lty <- ltyo[[2]] - dots$h <- if(scaleY) scaleY.fct(0) else 0 - do.call(abline, dots) + dotsl$h <- if(scaleY) scaleY.fct(0) else 0 + do.call(abline, dotsl) .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct, scaleY.inv, dots$xlim, dots$ylim, resc$X, ypts = 400, n = scaleN, x.ticks = x.ticks, y.ticks = y.ticks) - if(!is.null(data)) - return(.plotData(data, dots, mc, fun, L2Fam, IC1)) + if(!is.null(data)){ + dots$scaleX <- scaleX + dots$scaleX.fct <- scaleX.fct + if(!is.null(mcl$scaleX.inv)) dots$scaleX.inv <- scaleX.inv + dots$scaleY <- scaleY + dots$scaleY.fct <- scaleY.fct + dots$scaleY.inv <- scaleY.inv + dots$scaleN <- scaleN + dots$x.ticks <- x.ticks + dots$y.ticks <- y.ticks + dots$cex.pts <- cex.pts + dots$cex.pts.fun <- cex.pts.fun + dots$col.pts <- col.pts + dots$pch.pts <- pch.pts + dots$jitter.fac <- jitter.fac + dots$with.lab <- with.lab + dots$lab.pts <- lab.pts + dots$lab.font <- lab.font + dots$alpha.trsp <- alpha.trsp + dots$which.lbs <- which.lbs + dots$which.Order <- which.Order + dots$return.Order <- return.Order + + return(.plotData(data=data, dots=dots, fun=fun, L2Fam=L2Fam, IC=IC1)) + } invisible(NULL) } @@ -220,7 +258,7 @@ scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, - cex.pts = 1, col.pts = par("col"), + cex.pts = 1, cex.pts.fun = NULL, col.pts = par("col"), pch.pts = 19, jitter.fac = 1, with.lab = FALSE, lab.pts = NULL, lab.font = NULL, alpha.trsp = NA, which.lbs = NULL, which.Order = NULL, @@ -252,3 +290,13 @@ + .cexscale <- function(y, y1=y, maxcex=4,mincex=0.05,cex, fun=NULL){ + if(is.null(fun)) fun <- function(x) log(1+abs(x)) + ly <- fun(y) + ly1 <- fun(unique(c(y,y1))) + my <- min(ly1,na.rm=TRUE) + My <- max(ly1,na.rm=TRUE) + ly0 <- (ly-my)/My + ly1 <- ly0*(maxcex-mincex)+mincex + return(cex*ly1) + } Modified: branches/robast-1.0/pkg/ROptEst/man/cniperCont.Rd =================================================================== --- branches/robast-1.0/pkg/ROptEst/man/cniperCont.Rd 2014-07-28 11:56:34 UTC (rev 771) +++ branches/robast-1.0/pkg/ROptEst/man/cniperCont.Rd 2014-08-01 17:24:30 UTC (rev 772) @@ -17,7 +17,7 @@ scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, - cex.pts = 1, col.pts = par("col"), + cex.pts = 1, cex.pts.fun = NULL, col.pts = par("col"), pch.pts = 19, jitter.fac = 1, with.lab = FALSE, lab.pts = NULL, lab.font = NULL, alpha.trsp = NA, which.lbs = NULL, which.Order = NULL, @@ -33,7 +33,7 @@ scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, - cex.pts = 1, col.pts = par("col"), + cex.pts = 1, cex.pts.fun = NULL, col.pts = par("col"), pch.pts = 19, jitter.fac = 1, with.lab = FALSE, lab.pts = NULL, lab.font = NULL, alpha.trsp = NA, which.lbs = NULL, which.Order = NULL, @@ -87,6 +87,10 @@ \item{y.ticks}{numeric; defaults to NULL; (then ticks are chosen automatically); if non-NULL, user-given y-ticks (on original scale);} \item{cex.pts}{size of the points of the second argument plotted} + \item{cex.pts.fun}{rescaling function for the size of the points to be plotted; + either \code{NULL} (default), then \code{log(1+abs(x))} is used for + the rescaling, or a function which is then used for the + rescaling.} \item{col.pts}{color of the points of the second argument plotted} \item{pch.pts}{symbol of the points of the second argument plotted} \item{with.lab}{logical; shall labels be plotted to the observations?} Modified: branches/robast-1.0/pkg/ROptEst/man/internal_Cniperplots.Rd =================================================================== --- branches/robast-1.0/pkg/ROptEst/man/internal_Cniperplots.Rd 2014-07-28 11:56:34 UTC (rev 771) +++ branches/robast-1.0/pkg/ROptEst/man/internal_Cniperplots.Rd 2014-08-01 17:24:30 UTC (rev 772) @@ -9,7 +9,7 @@ and \code{cniperPointPlot}.} \usage{ -.plotData(data, dots, origCl, fun, L2Fam, IC ) +.plotData(data, dots, fun, L2Fam, IC ) .getFunCnip(IC1,IC2, risk, L2Fam, r, b20=NULL) } \arguments{ From noreply at r-forge.r-project.org Fri Aug 1 20:06:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Aug 2014 20:06:49 +0200 (CEST) Subject: [Robast-commits] r773 - in branches/robast-1.0/pkg/RobAStBase: R man Message-ID: <20140801180650.0AFAB18750D@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-01 20:06:49 +0200 (Fri, 01 Aug 2014) New Revision: 773 Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd Log: [RobAStBase] comparePlot, infoPlot, and the plot-Method for ICs gain an argument x.vec; if given it is the x-grid on which to evaluate the ICs; by default this argument is NULL; then (as before) the grid is selected automatically according to the distribution of the IC. This can be useful for usage with a rescaling of the x-Axis to avoid that the evaluation points be selected too unevenly (i.e. on an equally spaced grid in the original scale, but then, after rescaling non-equally... The grid has to be specified in original scale; i.e.; when used with rescaling, should be chosen non-equally spaced... Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-01 18:06:49 UTC (rev 773) @@ -7,7 +7,7 @@ legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), lty.MBR = "dashed", lwd.MBR = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL){ @@ -84,14 +84,20 @@ upper <- max(upper,xM) } h <- upper - lower - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)) + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) plty <- "l" lty <- "solid" }else{ - if(is(e1, "DiscreteDistribution")) x.vec <- support(e1) - else{ - x.vec <- r(e1)(1000) - x.vec <- sort(unique(x.vec)) + if(!is.null(x.vec)){ + if(is(distr, "DiscreteDistribution")) + x.vec <- intersect(x.vec,support(e1)) + }else{ + if(is(e1, "DiscreteDistribution")) x.vec <- support(e1) + else{ + x.vec <- r(e1)(1000) + x.vec <- sort(unique(x.vec)) + } } plty <- "p" lty <- "dotted" Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-01 18:06:49 UTC (rev 773) @@ -10,7 +10,7 @@ legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), lty.MBR = "dashed", lwd.MBR = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL, @@ -112,13 +112,19 @@ upper <- max(upper,xM) } h <- upper - lower - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)) + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) plty <- "l" if(missing(lty)) lty <- "solid" }else{ - if(is(distr, "DiscreteDistribution")) x.vec <- support(distr) else{ - x.vec <- r(distr)(1000) - x.vec <- sort(unique(x.vec)) + if(!is.null(x.vec)){ + if(is(distr, "DiscreteDistribution")) + x.vec <- intersect(x.vec,support(distr)) + }else{ + if(is(distr, "DiscreteDistribution")) x.vec <- support(distr) else{ + x.vec <- r(distr)(1000) + x.vec <- sort(unique(x.vec)) + } } plty <- "p" if(missing(lty)) lty <- "dotted" Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-01 18:06:49 UTC (rev 773) @@ -8,7 +8,7 @@ bmar = par("mar")[1], tmar = par("mar")[3], with.legend = TRUE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL, @@ -108,14 +108,20 @@ upper <- max(upper,xM) } h <- upper - lower - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)) + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) plty <- "l" if(missing(lty)) lty <- "solid" }else{ - if(is(distr, "DiscreteDistribution")) x.vec <- support(distr) - else{ - x.vec <- r(distr)(1000) - x.vec <- sort(unique(x.vec)) + if(!is.null(x.vec)){ + if(is(distr, "DiscreteDistribution")) + x.vec <- intersect(x.vec,support(distr)) + }else{ + if(is(e1, "DiscreteDistribution")) x.vec <- support(distr) + else{ + x.vec <- r(e1)(1000) + x.vec <- sort(unique(x.vec)) + } } plty <- "p" if(missing(lty)) lty <- "dotted" Modified: branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-01 18:06:49 UTC (rev 773) @@ -21,7 +21,7 @@ legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), lty.MBR = "dashed", lwd.MBR = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL, @@ -80,6 +80,15 @@ \item{col.MBR}{color for the MBR lines; as usual \code{col}-argument;} \item{lty.MBR}{line type for the MBR lines; as usual \code{lty}-argument;} \item{lwd.MBR}{line width for the MBR lines; as usual \code{lwd}-argument;} + \item{x.vec}{a numeric vector of grid points to evaluate the influence curve; + by default, \code{x.vec} is \code{NULL}; then the grid is + produced automatically according to the distribution of the IC. + \code{x.vec} can be useful for usage with a rescaling of the + x-axis to avoid that the evaluation points be selected too + unevenly (i.e. on an equally spaced grid in the original scale, + but then, after rescaling non-equally). + The grid has to be specified in original scale; i.e.; when used + with rescaling, it should be chosen non-equally spaced. } \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of the underlying distribution)?} \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?} Modified: branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-01 18:06:49 UTC (rev 773) @@ -18,7 +18,7 @@ bmar = par("mar")[1], tmar = par("mar")[3], with.legend = TRUE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL, @@ -72,6 +72,15 @@ of such arguments, one for each plotted panel.} \item{legend.bg}{background color for the legend} \item{legend.cex}{magnification factor for the legend} + \item{x.vec}{a numeric vector of grid points to evaluate the influence curve; + by default, \code{x.vec} is \code{NULL}; then the grid is + produced automatically according to the distribution of the IC. + \code{x.vec} can be useful for usage with a rescaling of the + x-axis to avoid that the evaluation points be selected too + unevenly (i.e. on an equally spaced grid in the original scale, + but then, after rescaling non-equally). + The grid has to be specified in original scale; i.e.; when used + with rescaling, it should be chosen non-equally spaced. } \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of the underlying distribution)?} \item{scaleY}{logical; shall Y-axis be rescaled for abs.info-plot Modified: branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-01 17:24:30 UTC (rev 772) +++ branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-01 18:06:49 UTC (rev 773) @@ -15,7 +15,7 @@ legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), lty.MBR = "dashed", lwd.MBR = 0.8, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL) @@ -66,6 +66,15 @@ \item{col.MBR}{color for the MBR lines; as usual \code{col}-argument;} \item{lty.MBR}{line type for the MBR lines; as usual \code{lty}-argument;} \item{lwd.MBR}{line width for the MBR lines; as usual \code{lwd}-argument;} + \item{x.vec}{a numeric vector of grid points to evaluate the influence curve; + by default, \code{x.vec} is \code{NULL}; then the grid is + produced automatically according to the distribution of the IC. + \code{x.vec} can be useful for usage with a rescaling of the + x-axis to avoid that the evaluation points be selected too + unevenly (i.e. on an equally spaced grid in the original scale, + but then, after rescaling non-equally). + The grid has to be specified in original scale; i.e.; when used + with rescaling, it should be chosen non-equally spaced. } \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of the underlying distribution)?} \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?} From noreply at r-forge.r-project.org Fri Aug 1 20:11:23 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 1 Aug 2014 20:11:23 +0200 (CEST) Subject: [Robast-commits] r774 - branches/robast-1.0/pkg/ROptEst/R Message-ID: <20140801181123.57E1118649E@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-01 20:11:23 +0200 (Fri, 01 Aug 2014) New Revision: 774 Modified: branches/robast-1.0/pkg/ROptEst/R/AllPlot.R Log: [ROptEst] adjusted plot-Method for ICs to include the new argument x.vec Modified: branches/robast-1.0/pkg/ROptEst/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/ROptEst/R/AllPlot.R 2014-08-01 18:06:49 UTC (rev 773) +++ branches/robast-1.0/pkg/ROptEst/R/AllPlot.R 2014-08-01 18:11:23 UTC (rev 774) @@ -7,7 +7,7 @@ legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), lty.MBR = "dashed", lwd.MBR = 0.8, n.MBR = 10000, - scaleX = FALSE, scaleX.fct, scaleX.inv, + x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm, scaleN = 9, x.ticks = NULL, y.ticks = NULL, mfColRow = TRUE, to.draw.arg = NULL){ From noreply at r-forge.r-project.org Mon Aug 4 13:17:13 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 4 Aug 2014 13:17:13 +0200 (CEST) Subject: [Robast-commits] r775 - branches/robast-1.0/pkg/RobAStBase/R Message-ID: <20140804111713.EA56C1868C1@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-04 13:17:13 +0200 (Mon, 04 Aug 2014) New Revision: 775 Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R Log: [RobAStBase] comparePlot, infoPlot, and the plot-Method for ICs now if scaleX == TRUE by default use an equidistant grid on the rescaled x-Axis. Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-01 18:11:23 UTC (rev 774) +++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-04 11:17:13 UTC (rev 775) @@ -84,8 +84,16 @@ upper <- max(upper,xM) } h <- upper - lower - if(is.null(x.vec)) - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)){ + if(scaleX){ + xpl <- scaleX.fct(lower - 0.1*h) + xpu <- scaleX.fct(upper + 0.1*h) + xp.vec <- seq(from = xpl, to = xpu, length = 1000) + x.vec <- scaleX.inv(xp.vec) + }else{ + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + } + } plty <- "l" lty <- "solid" }else{ Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-01 18:11:23 UTC (rev 774) +++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-04 11:17:13 UTC (rev 775) @@ -112,8 +112,16 @@ upper <- max(upper,xM) } h <- upper - lower - if(is.null(x.vec)) - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)){ + if(scaleX){ + xpl <- scaleX.fct(lower - 0.1*h) + xpu <- scaleX.fct(upper + 0.1*h) + xp.vec <- seq(from = xpl, to = xpu, length = 1000) + x.vec <- scaleX.inv(xp.vec) + }else{ + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + } + } plty <- "l" if(missing(lty)) lty <- "solid" }else{ Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-01 18:11:23 UTC (rev 774) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-04 11:17:13 UTC (rev 775) @@ -108,8 +108,16 @@ upper <- max(upper,xM) } h <- upper - lower - if(is.null(x.vec)) - x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + if(is.null(x.vec)){ + if(scaleX){ + xpl <- scaleX.fct(lower - 0.1*h) + xpu <- scaleX.fct(upper + 0.1*h) + xp.vec <- seq(from = xpl, to = xpu, length = 1000) + x.vec <- scaleX.inv(xp.vec) + }else{ + x.vec <- seq(from = lower - 0.1*h, to = upper + 0.1*h, length = 1000) + } + } plty <- "l" if(missing(lty)) lty <- "solid" }else{ From noreply at r-forge.r-project.org Tue Aug 5 18:49:40 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 5 Aug 2014 18:49:40 +0200 (CEST) Subject: [Robast-commits] r776 - in branches/robast-1.0/pkg/RobAStBase: R man Message-ID: <20140805164940.29B231874DA@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-05 18:49:39 +0200 (Tue, 05 Aug 2014) New Revision: 776 Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R branches/robast-1.0/pkg/RobAStBase/R/ddPlot.R branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R branches/robast-1.0/pkg/RobAStBase/R/qqplot.R branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd branches/robast-1.0/pkg/RobAStBase/man/ddPlot-methods.Rd branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd branches/robast-1.0/pkg/RobAStBase/man/internal_plots.Rd branches/robast-1.0/pkg/RobAStBase/man/internals_ddPlot.Rd branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd Log: [RobAStBase] + bugfix in outlyingnessPlot: for robCov.y ==TRUE (default) the inverse covariance matrix was used for standardization instead of the original one + .ddPlot.MatNtNtCoCo, and also ddPlot, outlyingnessPlot gain an additional argument 'doplot' defaulting to TRUE; if FALSE, no plot is produced and only the return value is calculated. + arguments scaleY.fct and scaleY.inv in the plot-method for ICs, and in comparePlot und infoPlot now also may be lists of functions, one for each of the panels to be plot; hence scaling of the y-axis can now be done individually for each panel. + in the axis annotation (after rescaling) there are checks now whether values +-infinity are taken at all. (This was a bug before for distributions passed on as cdf and quantile function with finite left or right endpoint.) + qqplot-method for c("ANY","InfRobModel") gains argument 'cex.pts.fun' to better control the scaling of points-sizes Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -56,6 +56,9 @@ dots$yaxt <- "n" } + scaleY.fct <- .fillList(scaleY.fct, dims0) + scaleY.inv <- .fillList(scaleY.inv, dims0) + MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T) MBRB <- MBRB * MBR.fac @@ -251,18 +254,29 @@ fct <- function(x) sapply(x, IC1 at Map[[indi]]) print(xlim[,i]) resc <-.rescalefct(x.vec, fct, scaleX, scaleX.fct, - scaleX.inv, scaleY, scaleY.fct, xlim[,i], + scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dots) dots <- resc$dots dots$xlim <- xlim[,i] dots$ylim <- ylim[,i] x.vec1 <- resc$X y.vec1 <- resc$Y + + finiteEndpoints <- rep(FALSE,4) + if(scaleX){ + finiteEndpoints[1] <- is.finite(scaleX.inv(min(x.vec1, xlim[1,i]))) + finiteEndpoints[2] <- is.finite(scaleX.inv(max(x.vec1, xlim[2,i]))) + } + if(scaleY){ + finiteEndpoints[3] <- is.finite(scaleY.inv(min(y.vec1, ylim[1,i]))) + finiteEndpoints[4] <- is.finite(scaleY.inv(max(y.vec1, ylim[2,i]))) + } do.call(plot, args=c(list(x=x.vec1, y=y.vec1, type = plty, lty = lty, xlab = xlab, ylab = ylab), dots)) .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, - scaleY,scaleY.fct, scaleY.inv, + scaleY,scaleY.fct[[i]], scaleY.inv[[i]], xlim[,i], ylim[,i], x.vec1, ypts = 400, n = scaleN, + finiteEndpoints = finiteEndpoints, x.ticks = x.ticks, y.ticks = y.ticks[[i]]) if(withMBR){ MBR.i <- MBRB[i,] @@ -272,7 +286,7 @@ if(is(e1, "DiscreteDistribution")){ x.vec1D <- seq(from = min(x.vec), to = max(x.vec), length = 1000) rescD <-.rescalefct(x.vec1D, fct, scaleX, scaleX.fct, - scaleX.inv, scaleY, scaleY.fct, xlim[,i], + scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dots) x.vecD <- rescD$X y.vecD <- rescD$Y @@ -341,7 +355,6 @@ dots.without <- dots dots.without$col <- dots.without$cex <- dots.without$pch <- NULL - pL <- expression({}) if(!is.null(dots$panel.last)) pL <- dots$panel.last @@ -353,7 +366,7 @@ print(xlim[,i]) resc.dat <-.rescalefct(y0s, function(x) sapply(x,ICMap0[[indi]]), scaleX, scaleX.fct, scaleX.inv, - scaleY, scaleY.fct, xlim[,i], ylim[,i], + scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dwo0) y1 <- resc.dat$X ICy <- resc.dat$Y Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -87,6 +87,9 @@ } + scaleY.fct <- .fillList(scaleY.fct, dims0) + scaleY.inv <- .fillList(scaleY.inv, dims0) + MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T) MBRB <- MBRB * MBR.fac @@ -288,7 +291,7 @@ pL <- substitute({ doIt <- function(sel.l,fct.l,j.l){ rescd <- .rescalefct(sel.l$data, fct.l, scaleX, scaleX.fct, - scaleX.inv, scaleY, scaleY.fct, xlim[,i], + scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dotsP) if(is(distr, "DiscreteDistribution")) rescd$Y <- jitter(rescd$Y, factor = jitter.fac0[j.l]) @@ -329,7 +332,7 @@ fct1 <- function(x) sapply(x, IC1 at Map[[indi]]) resc.args <- c(list(x.vec, "fc"=fct1, scaleX, scaleX.fct, - scaleX.inv, scaleY, scaleY.fct, xlim[,i], + scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dotsP)) resc1 <- do.call(.rescalefct, resc.args) resc.args$fc <- fct2 <- function(x) sapply(x, IC2 at Map[[indi]]) @@ -353,6 +356,17 @@ yM <- max(matp,na.rm=T) y0 <- matp[,1] y0[1:2] <- c(ym,yM) + + finiteEndpoints <- rep(FALSE,4) + if(scaleX){ + finiteEndpoints[1] <- is.finite(scaleX.inv(min(x.vec1, xlim[1],na.rm=TRUE))) + finiteEndpoints[2] <- is.finite(scaleX.inv(max(x.vec1, xlim[2],na.rm=TRUE))) + } + if(scaleY){ + finiteEndpoints[3] <- is.finite(scaleY.inv(min(ym, ylim[1,i],na.rm=TRUE))) + finiteEndpoints[4] <- is.finite(scaleY.inv(max(yM, ylim[2,i],na.rm=TRUE))) + } + do.call(plot, args=c(list(x = resc1$X, y = y0, type = "n", xlab = xlab, ylab = ylab, lty = lty[1], col = addAlphTrsp2col(col[1],0), @@ -364,19 +378,21 @@ do.call(matlines, args = c(list( x = resc1$X, y = matp, lty = lty, col = col, lwd = lwd), dotsL)) + .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, - scaleY,scaleY.fct, scaleY.inv, xlim[,i], + scaleY,scaleY.fct[[i]], scaleY.inv[[i]], xlim[,i], ylim[,i], resc1$X, ypts = 400, n = scaleN, + finiteEndpoints = finiteEndpoints, x.ticks = x.ticks, y.ticks = y.ticks[[i]]) if(withMBR){ MBR.i <- MBRB[i,] - if(scaleY) MBR.i <- scaleY.fct(MBR.i) + if(scaleY) MBR.i <- scaleY.fct[[i]](MBR.i) abline(h=MBR.i, col=col.MBR, lty=lty.MBR, lwd = lwd.MBR) } if(is(distr, "DiscreteDistribution")){ rescD.args <- c(list(x.vecD, "fc"=fct1, scaleX, scaleX.fct, - scaleX.inv, scaleY, scaleY.fct, xlim[,i], + scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], dotsP)) resc1D <- do.call(.rescalefct, rescD.args) rescD.args$fc <- fct2 @@ -404,7 +420,7 @@ if(with.legend){ if(is.null(legend)) legend <- xc legend(.legendCoord(legend.location, scaleX, scaleX.fct, - scaleY, scaleY.fct), col = col, bg = legend.bg, + scaleY, scaleY.fct[[i]]), col = col, bg = legend.bg, legend = legend, dotsLeg, cex = legend.cex) } Modified: branches/robast-1.0/pkg/RobAStBase/R/ddPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/ddPlot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/ddPlot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -12,7 +12,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "%7.2f", text.abline.x.fmt.qx = "%4.2f%%", text.abline.y.fmt.cy = "%7.2f", text.abline.y.fmt.qy = "%4.2f%%", - jitt.fac){ + jitt.fac, doplot = TRUE){ mc <- as.list(match.call(expand.dots = TRUE, call = sys.call(sys.parent(1)))[-1]) mc$data <- data @@ -33,7 +33,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "%7.2f", text.abline.x.fmt.qx = "%4.2f%%", text.abline.y.fmt.cy = "%7.2f", text.abline.y.fmt.qy = "%4.2f%%", - jitt.fac){ + jitt.fac, doplot = TRUE){ mc <- match.call(call = sys.call(sys.parent(1))) mc$data <- t(as.matrix(data)) @@ -55,7 +55,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "%7.2f", text.abline.x.fmt.qx = "%4.2f%%", text.abline.y.fmt.cy = "%7.2f", text.abline.y.fmt.qy = "%4.2f%%", - jitt.fac){ + jitt.fac, doplot = TRUE){ mc <- match.call(call = sys.call(sys.parent(1))) mc$data <- matrix(data,nrow=1) Modified: branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-05 16:49:39 UTC (rev 776) @@ -28,7 +28,8 @@ text.abline.x.fmt.qx = "%4.2f%%", text.abline.y.fmt.cy = "%7.2f", text.abline.y.fmt.qy = "%4.2f%%", - jitt.fac = 10){ + jitt.fac = 10, + doplot = TRUE){ dots <- match.call(expand.dots = FALSE)$"..." @@ -252,34 +253,35 @@ ndata.y0[!isna] <- jitter(ndata.y0[!isna], factor=jitt.pts[2]) pdots$col <- col - do.call(plot, args = c(list(x = ndata.x0, y=ndata.y0, type = "p"), pdots)) - do.call(box,args=c(adots)) + if(doplot){ + do.call(plot, args = c(list(x = ndata.x0, y=ndata.y0, type = "p"), pdots)) + do.call(box,args=c(adots)) - pusr <- par("usr") - mid.x <- mean(pusr[c(1,2)]) - mid.y <- mean(pusr[c(3,4)]) - abtdots.y$x <- if(is.null(text.abline.y.x)) mid.x else text.abline.y.x - abtdots.x$y <- if(is.null(text.abline.x.y)) mid.y else text.abline.x.y + pusr <- par("usr") + mid.x <- mean(pusr[c(1,2)]) + mid.y <- mean(pusr[c(3,4)]) + abtdots.y$x <- if(is.null(text.abline.y.x)) mid.x else text.abline.y.x + abtdots.x$y <- if(is.null(text.abline.x.y)) mid.y else text.abline.x.y - do.call(abline, args = c(list(v=co.x), abdots[[1]])) - do.call(abline, args = c(list(h=co.y), abdots[[2]])) + do.call(abline, args = c(list(v=co.x), abdots[[1]])) + do.call(abline, args = c(list(h=co.y), abdots[[2]])) - if(ab.textL[1]) - do.call(text, args = c(list(y=co.y*1.03), abtdots.y)) + if(ab.textL[1]) + do.call(text, args = c(list(y=co.y*1.03), abtdots.y)) # do.call(text, args = c(list(co.x-5,mid.y,paste(cutoff.quantile.y*100,"%-cutoff = ",round(co.x,digits=2)),srt=90))) - if(ab.textL[2]) - do.call(text, args = c(list(x=co.x*1.03), abtdots.x,srt=90)) + if(ab.textL[2]) + do.call(text, args = c(list(x=co.x*1.03), abtdots.x,srt=90)) # do.call(text, args = c(list(mid.x,co.y+5,paste(cutoff.quantile.x*100," %-cutoff = ",round(co.y,digits=2))))) - if(length(id.xy)) - do.call(text, args = c(list(jitter(ndata.x[id.xy],factor=jitt.fac), + if(length(id.xy)) + do.call(text, args = c(list(jitter(ndata.x[id.xy],factor=jitt.fac), jitter(ndata.y[id.xy],factor=jitt.fac), labels=lab.pts[id.xy]), tdots)) #axis(side=4) # axis(side=1) - - return(list(id.x=id0.x, id.y= id0.y, id.xy = id0.xy, + } + return(invisible(list(id.x=id0.x, id.y= id0.y, id.xy = id0.xy, qtx = quantile(ndata.x), qty = quantile(ndata.y), cutoff.x.v = co.x, cutoff.y.v = co.y - )) + ))) } Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -63,6 +63,8 @@ cex.pts.fun <- .fillList(cex.pts.fun, (dims0+in1to.draw)*2) } + scaleY.fct <- .fillList(scaleY.fct, length(to.draw1)) + scaleY.inv <- .fillList(scaleY.inv, length(to.draw1)) if(!is.null(x.ticks)) dots$xaxt <- "n" if(!is.null(y.ticks)){ @@ -414,10 +416,10 @@ dotsP0 <- dotsP resc.rel <- .rescalefct(y0, cbind(y0.vec,ICy0), scaleX, scaleX.fct, scaleX.inv, - FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0) + FALSE, scaleY.fct[[i]], dots$xlim, dots$ylim, dotsP0) resc.rel.c <- .rescalefct(y0c, cbind(y0c.vec,ICy0c), scaleX, scaleX.fct, scaleX.inv, - FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0) + FALSE, scaleY.fct[[i]], dots$xlim, dots$ylim, dotsP0) c1fun <- if(is.null(cexfun)) NULL else cexfun[[(i1-1)*2+1]] c2fun <- if(is.null(cexfun)) NULL else cexfun[[(i1-1)*2+2]] @@ -471,6 +473,17 @@ scaleY0 <- scaleY & (yaxt0[1]!="n") x.ticks0 <- if(xaxt0[1]!="n") x.ticks else NULL y.ticks0 <- if(yaxt0[1]!="n") y.ticks[[1]] else NULL + + finiteEndpoints <- rep(FALSE,4) + if(scaleX){ + finiteEndpoints[1] <- is.finite(scaleX.inv(min(resc.C$X, xlim[1],na.rm=TRUE))) + finiteEndpoints[2] <- is.finite(scaleX.inv(max(resc.C$X, xlim[2],na.rm=TRUE))) + } + if(scaleY){ + finiteEndpoints[3] <- is.finite(scaleY.inv(min(resc.C$Y, ylim[1,1],na.rm=TRUE))) + finiteEndpoints[4] <- is.finite(scaleY.inv(max(resc.C$Y, ylim[2,1],na.rm=TRUE))) + } + .plotRescaledAxis(scaleX0, scaleX.fct, scaleX.inv, scaleY0,scaleY.fct, scaleY.inv, dots$xlim, dots$ylim, resc$X, ypts = 400, @@ -525,14 +538,27 @@ scaleY0 <- scaleY & (yaxt0[i+in1to.draw]!="n") x.ticks0 <- if(xaxt0[i+in1to.draw]!="n") x.ticks else NULL y.ticks0 <- if(yaxt0[i+in1to.draw]!="n") y.ticks[[i+in1to.draw]] else NULL + + finiteEndpoints <- rep(FALSE,4) + if(scaleX){ + finiteEndpoints[1] <- is.finite(scaleX.inv(min(resc$X, xlim[1],na.rm=TRUE))) + finiteEndpoints[2] <- is.finite(scaleX.inv(max(resc$X, xlim[2],na.rm=TRUE))) + } + if(scaleY){ + finiteEndpoints[3] <- is.finite(scaleY.inv[[i+in1to.draw]](min(yvec1, ylim[1,i+in1to.draw],na.rm=TRUE))) + finiteEndpoints[4] <- is.finite(scaleY.inv[[i+in1to.draw]](max(yvec1, ylim[2,i+in1to.draw],na.rm=TRUE))) + } + .plotRescaledAxis(scaleX0, scaleX.fct, scaleX.inv, - FALSE,scaleY.fct, scaleY.inv, dots$xlim, + FALSE,scaleY.fct[[i+in1to.draw]], + scaleY.inv[[i+in1to.draw]], dots$xlim, dots$ylim, resc$X, ypts = 400, n = scaleN, + finiteEndpoints = finiteEndpoints, x.ticks = x.ticks0, y.ticks = y.ticks0, withbox = withbox) if(with.legend) legend(.legendCoord(legend.location[[i1]], - scaleX, scaleX.fct, scaleY, scaleY.fct), + scaleX, scaleX.fct, scaleY, scaleY.fct[[i]]), bg = legend.bg, legend = legend[[i1]], col = c(colI, col), lwd = c(lwdI, lwd), lty = c(ltyI, lty), cex = legend.cex*fac.leg) Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -24,6 +24,7 @@ tf.x = data, tf.y = data, jitt.fac=10, + doplot = TRUE, main = gettext("Outlyingness \n by means of a distance-distance plot") ){ mc <- as.list(match.call(expand.dots = FALSE))[-1] @@ -48,7 +49,7 @@ dimevIC <- dim(evIC)[1] devIC <- data.frame(t(evIC[1:dimevIC,,drop=FALSE])) CMcd <- PosSemDefSymmMatrix(getCov(CovMcd(devIC,alpha=0.5))) - asVar <- solve(CMcd) + asVar <- CMcd # cat("\n", sep="", gettext("Robust asVar"), ":\n") # print(asVar) } @@ -143,6 +144,7 @@ lwd.cutoff = mc$lwd.cutoff, col.cutoff = mc$col.cutoff, jitt.fac = mc$jitt.fac, + doplot = doplot, main = main))) } Modified: branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R 2014-08-05 16:49:39 UTC (rev 776) @@ -57,6 +57,7 @@ .plotRescaledAxis <- function(scaleX,scaleX.fct, scaleX.inv, scaleY,scaleY.fct, scaleY.inv, xlim, ylim, X, ypts = 400, n = 11, + finiteEndpoints = rep(FALSE,4), x.ticks = NULL, y.ticks = NULL, withbox = TRUE){ # plots rescaled axes acc. to logicals scaleX, scaleY # to this end uses trafos scaleX.fct with inverse scale.inv @@ -87,8 +88,8 @@ if(i0){ xf <- c(NA,xf); X <- c(0, X)} if(i1){ xf <- c(xf,NA); X <- c(X, 1)} axis(1,at=X,labels=xf) - if(i0) axis(1,at=0,labels=expression(-infinity)) - if(i1) axis(1,at=1,labels=expression(infinity)) + if(finiteEndpoints[1]&i0) axis(1,at=0,labels=expression(-infinity)) + if(finiteEndpoints[2]&i1) axis(1,at=1,labels=expression(infinity)) }else{ if(is.null(xlim)){ xlim <- c(-Inf,Inf)}else{ if(is.na(xlim[1])) xlim[1] <- -Inf @@ -137,8 +138,8 @@ if(i0){ yf <- c(NA,yf); Y <- c(0, Y)} if(i1){ yf <- c(yf,NA); Y <- c(Y, 1)} axis(2,at=Y,labels=yf) - if(i0) axis(2,at=0,labels=expression(-infinity)) - if(i1) axis(2,at=1,labels=expression(infinity)) + if(finiteEndpoints[3]&i0) axis(2,at=0,labels=expression(-infinity)) + if(finiteEndpoints[4]&i1) axis(2,at=1,labels=expression(infinity)) }else{ if(is.null(ylim)){ ylim <- c(-Inf,Inf)}else{ if(is.na(ylim[1])) ylim[1] <- -Inf Modified: branches/robast-1.0/pkg/RobAStBase/R/qqplot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/qqplot.R 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/R/qqplot.R 2014-08-05 16:49:39 UTC (rev 776) @@ -58,7 +58,7 @@ function(x, y, n = length(x), withIdLine = TRUE, withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf, plot.it = TRUE, xlab = deparse(substitute(x)), - ylab = deparse(substitute(y)), ..., n.adj = TRUE){ + ylab = deparse(substitute(y)), ..., cex.pts.fun = NULL, n.adj = TRUE){ mc <- match.call(call = sys.call(sys.parent(1))) if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x)) @@ -88,7 +88,17 @@ L2Dx <- evalRandVar(L2D,matrix(x))[,,1] scx <- solve(sqrt(FI),L2Dx) xD <- fct(distance)(scx) - x.cex <- 3/(1+log(1+xD)) + cex.pts <- if(is.null(mcl[["cex.pts"]])){ + if(is.null(mcl[["cex"]])){ + par("cex") + }else{ + eval(mcl$cex)} + }else{ + eval(mcl$cex.pts) + } + + x.cex <- 3/(1+.cexscale(xD,xD,cex=cex.pts, fun = cex.pts.fun)) + mcl$cex.pch <- x.cex return(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), Modified: branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -103,10 +103,14 @@ missing, the quantile function of the underlying observation distribution.} \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the range of the respective coordinate of the IC - to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.} + to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}; + can also be a list of functions with one list element for each + of the panels to be plot. } \item{scaleY.inv}{an isotone, vectorized function mapping for each coordinate the range [0,1] into the range of the respective coordinate of the IC; - defaulting to the quantile function of \eqn{{\cal N}(0,1)}{N(0,1)}.} + defaulting to the quantile function of \eqn{{\cal N}(0,1)}{N(0,1)}; + can also be a list of functions with one list element for each + of the panels to be plot. } \item{scaleN}{integer; defaults to 9; on rescaled axes, number of x and y ticks if drawn automatically;} \item{x.ticks}{numeric; defaults to NULL; (then ticks are chosen automatically); Modified: branches/robast-1.0/pkg/RobAStBase/man/ddPlot-methods.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/ddPlot-methods.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/ddPlot-methods.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -22,7 +22,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "\%7.2f", text.abline.x.fmt.qx = "\%4.2f\%\%", text.abline.y.fmt.cy = "\%7.2f", text.abline.y.fmt.qy = "\%4.2f\%\%", - jitt.fac) + jitt.fac, doplot = TRUE) \S4method{ddPlot}{numeric}(data, dist.x = NormType(), dist.y = NormType(), cutoff.x, cutoff.y, ..., cutoff.quantile.x = 0.95, cutoff.quantile.y = cutoff.quantile.x, @@ -36,7 +36,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "\%7.2f", text.abline.x.fmt.qx = "\%4.2f\%\%", text.abline.y.fmt.cy = "\%7.2f", text.abline.y.fmt.qy = "\%4.2f\%\%", - jitt.fac) + jitt.fac, doplot = TRUE) \S4method{ddPlot}{data.frame}(data, dist.x = NormType(), dist.y = NormType(), cutoff.x, cutoff.y, ..., cutoff.quantile.x = 0.95, cutoff.quantile.y = cutoff.quantile.x, @@ -50,7 +50,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "\%7.2f", text.abline.x.fmt.qx = "\%4.2f\%\%", text.abline.y.fmt.cy = "\%7.2f", text.abline.y.fmt.qy = "\%4.2f\%\%", - jitt.fac) + jitt.fac, doplot = TRUE) } \arguments{ \item{data}{data coercable to \code{matrix}; the data at which to produce the \code{ddPlot}.} @@ -120,6 +120,7 @@ \item{text.abline.y.fmt.cy}{format string to format the cutoff value in label in y direction.} \item{text.abline.y.fmt.qy}{format string to format cutoff probability in label in y direction.} \item{jitt.fac}{factor for jittering, see \code{jitter};} + \item{doplot}{logical; shall a plot be produced? if \code{FALSE} only the return values are produced.} } \details{ The \code{matrix}-method calls \code{.ddPlot.MatNtNtCoCo}, @@ -137,7 +138,7 @@ } } \value{ -a list with items +a list (returned as \code{invisible()}) with items \item{id.x}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff} \item{id.y}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{y}-cutoff} \item{id.xy}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff and the \code{y}-cutoff} Modified: branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -93,13 +93,17 @@ such that for any \code{x} in the domain, \code{scaleX.inv(scaleX.fct(x))==x}; if \code{scaleX} is \code{TRUE} and \code{scaleX.inv} is - missing, the quantile function of the underlying observation distribution.} + missing, the quantile function of the underlying observation distribution. } \item{scaleY.fct}{an isotone, vectorized function mapping the range of the norm of the IC to [0,1]; defaulting - to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.} + to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}; + can also be a list of functions with one list element for each + of the panels to be plot.} \item{scaleY.inv}{an isotone, vectorized function mapping [0,1] into the range of the norm of the IC; defaulting to the quantile function - of \eqn{{\cal N}(0,1)}{N(0,1)}.} + of \eqn{{\cal N}(0,1)}{N(0,1)}; + can also be a list of functions with one list element for each + of the panels to be plot.} \item{scaleN}{integer; defaults to 9; on rescaled axes, number of x and y ticks if drawn automatically;} \item{x.ticks}{numeric; defaults to NULL; (then ticks are chosen automatically); Modified: branches/robast-1.0/pkg/RobAStBase/man/internal_plots.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/internal_plots.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/internal_plots.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -20,6 +20,7 @@ xlim, ylim, dots) .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct, scaleY.inv, xlim, ylim, X, ypts = 400, n = 11, + finiteEndpoints = rep(FALSE,4), x.ticks = NULL, y.ticks = NULL, withbox = TRUE) .legendCoord(x, scaleX, scaleX.fct, scaleY, scaleY.fct) .SelectOrderData(data, fct, which.lbs, which.Order) @@ -53,6 +54,8 @@ scale).} \item{ylim}{numeric vector of length 2: limits of the plotted y region (in original scale).} + \item{finiteEndpoints}{a logical of length 4: are the unscaled \code{xlim[1]}, + \code{xlim[2]}, \code{ylim[1]}, \code{ylim[2]} finite? } \item{x.ticks}{numeric: coordinates in original scale of user-given ticks on x-axis.} \item{y.ticks}{numeric: coordinates in original scale of user-given ticks on y-axis.} \item{n}{integer: number of default ticks in x and y axis.} Modified: branches/robast-1.0/pkg/RobAStBase/man/internals_ddPlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/internals_ddPlot.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/internals_ddPlot.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -23,7 +23,7 @@ text.abline.y.x = NULL, text.abline.y.y = NULL, text.abline.x.fmt.cx = "\%7.2f", text.abline.x.fmt.qx = "\%4.2f\%\%", text.abline.y.fmt.cy = "\%7.2f", text.abline.y.fmt.qy = "\%4.2f\%\%", - jitt.fac) + jitt.fac, doplot = TRUE) } \arguments{ \item{data}{data in \code{matrix} form (columns are observations; rows are variable @@ -94,6 +94,7 @@ \item{text.abline.y.fmt.cy}{format string to format the cutoff value in label in y direction.} \item{text.abline.y.fmt.qy}{format string to format cutoff probability in label in y direction.} \item{jitt.fac}{factor for jittering, see \code{jitter};} + \item{doplot}{logical; shall a plot be produced? if \code{FALSE} only the return values are produced.} } \details{ @@ -112,7 +113,7 @@ \value{ -a list with items +a list (returned as \code{invisible()}) with items \item{id.x}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff} \item{id.y}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{y}-cutoff} \item{id.xy}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff and the \code{y}-cutoff} Modified: branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/outlyingPlotIC.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -11,7 +11,7 @@ id.n, cex.pts = 1,lab.pts, jitt.pts = 0, alpha.trsp = NA, adj, cex.idn, col.idn, lty.cutoff, lwd.cutoff, col.cutoff, robCov.x = TRUE, robCov.y = TRUE, tf.x = data, tf.y = data, - jitt.fac = 10, + jitt.fac = 10, doplot = TRUE, main = gettext("Outlyingness \n by means of a distance-distance plot") ) } @@ -67,6 +67,7 @@ transformed y-coordinates when applied to the data; by default identity.} \item{jitt.fac}{factor for jittering, see \code{\link{jitter}};} + \item{doplot}{logical; shall a plot be produced? if \code{FALSE} only the return values are produced.} \item{main}{the main title.} } \details{ @@ -77,7 +78,7 @@ } \value{ -a list with items +a list (returned as \code{invisible()}) with items \item{id.x}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff} \item{id.y}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{y}-cutoff} \item{id.xy}{the indices of (possibly transformed) data (within subset \code{id.n}) beyond the \code{x}-cutoff and the \code{y}-cutoff} Modified: branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -80,13 +80,17 @@ \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?} \item{scaleX.fct}{an isotone, vectorized function mapping the domain of the IC to [0,1]; if \code{scaleX} is \code{TRUE} and \code{scaleX.fct} is - missing, the cdf of the underlying observation distribution.} + missing, the cdf of the underlying observation distribution; + can also be a list of functions with one list element for each + of the panels to be plot.} \item{scaleX.inv}{the inverse function to \code{scale.fct}, i.e., an isotone, vectorized function mapping [0,1] to the domain of the IC such that for any \code{x} in the domain, \code{scaleX.inv(scaleX.fct(x))==x}; if \code{scaleX} is \code{TRUE} and \code{scaleX.inv} is - missing, the quantile function of the underlying observation distribution.} + missing, the quantile function of the underlying observation distribution; + can also be a list of functions with one list element for each + of the panels to be plot.} \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the range of the respective coordinate of the IC to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.} Modified: branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-04 11:17:13 UTC (rev 775) +++ branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-05 16:49:39 UTC (rev 776) @@ -13,7 +13,7 @@ n = length(x), withIdLine = TRUE, withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf, plot.it = TRUE, xlab = deparse(substitute(x)), - ylab = deparse(substitute(y)), ..., n.adj = TRUE) + ylab = deparse(substitute(y)), ..., cex.pts.fun = NULL, n.adj = TRUE) \S4method{qqplot}{ANY,kStepEstimate}(x, y, [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/robast -r 776 From noreply at r-forge.r-project.org Tue Aug 5 18:55:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 5 Aug 2014 18:55:39 +0200 (CEST) Subject: [Robast-commits] r777 - branches/robast-1.0/pkg/ROptEst/R Message-ID: <20140805165539.58C46187560@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-05 18:55:39 +0200 (Tue, 05 Aug 2014) New Revision: 777 Modified: branches/robast-1.0/pkg/ROptEst/R/plotWrapper.R Log: [ROptEst] bugfix: in wrapper function CniperPointPlot, arguments 'data' and 'alpha.trsp' had not been passed on correctly Modified: branches/robast-1.0/pkg/ROptEst/R/plotWrapper.R =================================================================== --- branches/robast-1.0/pkg/ROptEst/R/plotWrapper.R 2014-08-05 16:49:39 UTC (rev 776) +++ branches/robast-1.0/pkg/ROptEst/R/plotWrapper.R 2014-08-05 16:55:39 UTC (rev 777) @@ -71,12 +71,14 @@ ### 2. build up the argument list for the (powerful/fullfledged) ### graphics/diagnostics function; ## + data <- dots$data + alpha.trsp <- eval(dots$alpha.trsp); if(is.null(alpha.trsp)) alpha.trsp <- NA ## Scaling of the axes scaleList <- rescaleFunction(fam, FALSE, rescale) argsList <- c(list(L2Fam = substitute(fam) - ,data = substitute(NULL) + ,data = data ,neighbor = substitute(ContNeighborhood(radius = 0.5)) ,risk = substitute(asMSE()) ,lower = substitute(lower) @@ -91,7 +93,7 @@ ,with.lab = substitute(FALSE) ,lab.pts = substitute(NULL) ,lab.font = substitute(NULL) - ,alpha.trsp = substitute(alpha.trsp) + ,alpha.trsp = alpha.trsp ,which.lbs = substitute(NULL) ,which.Order = substitute(NULL) ,return.Order = substitute(FALSE) From noreply at r-forge.r-project.org Tue Aug 5 19:30:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 5 Aug 2014 19:30:44 +0200 (CEST) Subject: [Robast-commits] r778 - branches/robast-1.0/pkg/RobAStBase/R Message-ID: <20140805173044.795E7187673@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-05 19:30:44 +0200 (Tue, 05 Aug 2014) New Revision: 778 Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R Log: [RobAStBase] argh:oversaw some issues with finiteEndpoints Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-05 16:55:39 UTC (rev 777) +++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-05 17:30:44 UTC (rev 778) @@ -268,8 +268,8 @@ finiteEndpoints[2] <- is.finite(scaleX.inv(max(x.vec1, xlim[2,i]))) } if(scaleY){ - finiteEndpoints[3] <- is.finite(scaleY.inv(min(y.vec1, ylim[1,i]))) - finiteEndpoints[4] <- is.finite(scaleY.inv(max(y.vec1, ylim[2,i]))) + finiteEndpoints[3] <- is.finite(scaleY.inv[[i]](min(y.vec1, ylim[1,i]))) + finiteEndpoints[4] <- is.finite(scaleY.inv[[i]](max(y.vec1, ylim[2,i]))) } do.call(plot, args=c(list(x=x.vec1, y=y.vec1, type = plty, lty = lty, xlab = xlab, ylab = ylab), dots)) Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-05 16:55:39 UTC (rev 777) +++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-05 17:30:44 UTC (rev 778) @@ -363,8 +363,8 @@ finiteEndpoints[2] <- is.finite(scaleX.inv(max(x.vec1, xlim[2],na.rm=TRUE))) } if(scaleY){ - finiteEndpoints[3] <- is.finite(scaleY.inv(min(ym, ylim[1,i],na.rm=TRUE))) - finiteEndpoints[4] <- is.finite(scaleY.inv(max(yM, ylim[2,i],na.rm=TRUE))) + finiteEndpoints[3] <- is.finite(scaleY.inv[[i]](min(ym, ylim[1,i],na.rm=TRUE))) + finiteEndpoints[4] <- is.finite(scaleY.inv[[i]](max(yM, ylim[2,i],na.rm=TRUE))) } do.call(plot, args=c(list(x = resc1$X, y = y0, Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-05 16:55:39 UTC (rev 777) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-05 17:30:44 UTC (rev 778) @@ -480,8 +480,8 @@ finiteEndpoints[2] <- is.finite(scaleX.inv(max(resc.C$X, xlim[2],na.rm=TRUE))) } if(scaleY){ - finiteEndpoints[3] <- is.finite(scaleY.inv(min(resc.C$Y, ylim[1,1],na.rm=TRUE))) - finiteEndpoints[4] <- is.finite(scaleY.inv(max(resc.C$Y, ylim[2,1],na.rm=TRUE))) + finiteEndpoints[3] <- is.finite(scaleY.inv[[1]](min(resc.C$Y, ylim[1,1],na.rm=TRUE))) + finiteEndpoints[4] <- is.finite(scaleY.inv[[1]](max(resc.C$Y, ylim[2,1],na.rm=TRUE))) } .plotRescaledAxis(scaleX0, scaleX.fct, scaleX.inv, Modified: branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R 2014-08-05 16:55:39 UTC (rev 777) +++ branches/robast-1.0/pkg/RobAStBase/R/plotRescaledAxis.R 2014-08-05 17:30:44 UTC (rev 778) @@ -88,8 +88,8 @@ if(i0){ xf <- c(NA,xf); X <- c(0, X)} if(i1){ xf <- c(xf,NA); X <- c(X, 1)} axis(1,at=X,labels=xf) - if(finiteEndpoints[1]&i0) axis(1,at=0,labels=expression(-infinity)) - if(finiteEndpoints[2]&i1) axis(1,at=1,labels=expression(infinity)) + if(!finiteEndpoints[1]&i0) axis(1,at=0,labels=expression(-infinity)) + if(!finiteEndpoints[2]&i1) axis(1,at=1,labels=expression(infinity)) }else{ if(is.null(xlim)){ xlim <- c(-Inf,Inf)}else{ if(is.na(xlim[1])) xlim[1] <- -Inf @@ -138,8 +138,8 @@ if(i0){ yf <- c(NA,yf); Y <- c(0, Y)} if(i1){ yf <- c(yf,NA); Y <- c(Y, 1)} axis(2,at=Y,labels=yf) - if(finiteEndpoints[3]&i0) axis(2,at=0,labels=expression(-infinity)) - if(finiteEndpoints[4]&i1) axis(2,at=1,labels=expression(infinity)) + if(!finiteEndpoints[3]&i0) axis(2,at=0,labels=expression(-infinity)) + if(!finiteEndpoints[4]&i1) axis(2,at=1,labels=expression(infinity)) }else{ if(is.null(ylim)){ ylim <- c(-Inf,Inf)}else{ if(is.na(ylim[1])) ylim[1] <- -Inf From noreply at r-forge.r-project.org Sun Aug 10 14:42:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Aug 2014 14:42:06 +0200 (CEST) Subject: [Robast-commits] r779 - in branches/robast-1.0/pkg: ROptEst/inst RobAStBase/inst RobAStRDA/inst RobExtremes/inst Message-ID: <20140810124206.E7C0A1874CE@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-10 14:42:06 +0200 (Sun, 10 Aug 2014) New Revision: 779 Modified: branches/robast-1.0/pkg/ROptEst/inst/NEWS branches/robast-1.0/pkg/RobAStBase/inst/NEWS branches/robast-1.0/pkg/RobAStRDA/inst/NEWS branches/robast-1.0/pkg/RobExtremes/inst/NEWS Log: updated NEWS files Modified: branches/robast-1.0/pkg/ROptEst/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/ROptEst/inst/NEWS 2014-08-05 17:30:44 UTC (rev 778) +++ branches/robast-1.0/pkg/ROptEst/inst/NEWS 2014-08-10 12:42:06 UTC (rev 779) @@ -8,6 +8,35 @@ information) ####################################### +version 1.0 +####################################### + +user-visible CHANGES: ++ cniperPointPlot gains capacity to deal with "interpolRisk" - risks + +GENERAL ENHANCEMENTS: + +under the hood: ++ preparations for evalation of LMs on xi grid for GEVFamilyMuUnknown. ++ new methods for normtype and biastype for interpolRisk, as well as getRiskFctBV + => now cniperPointPlot should work for GPD-type data ++ removed ::: internal dependencies (within distr&robast-Fam's of pkgs) by + copying respective routines ++ adjusted plot-Method for ICs to include the new argument x.vec + + +BUGFIXES: ++ two bugs in plotWrapper.R in pkgs RobAStBase and ROptEst detected by Misha ++ needed version of RandVar was wrongly specified in ROptEst in the branch 1.0 ++ fixed errors detected by Matthias / Misha in AllPlot.R, comparePlot.R, getReq.R ++ fixed issue with updateStep in kStepEstimator when using interpol risks + (somehow modifyIC had not been attached in prior steps...) ++ labels did not work correctly, warnings due to calling plot with "withMaxRisk" ++ fixed issue with points plotting in Cniperpoint-plots ++ in wrapper function CniperPointPlot, arguments 'data' and 'alpha.trsp' had not + been passed on correctly + +####################################### version 0.9 ####################################### Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-05 17:30:44 UTC (rev 778) +++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 12:42:06 UTC (rev 779) @@ -8,6 +8,66 @@ information) ####################################### +version 1.0 +####################################### + +user-visible CHANGES: ++ infoPlot and comparePlot gain an argument cex.pts.fun to enable individual + scaling of the point sizes to be plotted onto each of the plotted curves ++ .ddPlot.MatNtNtCoCo, and also ddPlot, outlyingnessPlot gain an + additional argument 'doplot' defaulting to TRUE; if FALSE, no plot + is produced and only the return value is calculated. ++ arguments scaleY.fct and scaleY.inv in the plot-method for ICs, + and in comparePlot und infoPlot now also may be lists of functions, + one for each of the panels to be plot; hence scaling of the y-axis + can now be done individually for each panel. ++ introduce jitter for points in ddPlot for DiscreteDistributions ++ comparePlot, infoPlot, and the plot-Method for ICs gain an argument x.vec; + if given it is the x-grid on which to evaluate the ICs; by default this + argument is NULL; then (as before) the grid is selected automatically + according to the distribution of the IC. This can be useful for usage with a + rescaling of the x-Axis to avoid that the evaluation points be selected too + unevenly (i.e. on an equally spaced grid in the original scale, but then, after + rescaling non-equally... The grid has to be specified in original scale; i.e.; + when used with rescaling, should be chosen non-equally spaced... ++ comparePlot, infoPlot, and the plot-Method for ICs now if scaleX is TRUE by + default use an equidistant grid on the rescaled x-Axis. ++ qqplot-method for c("ANY","InfRobModel") gains argument + 'cex.pts.fun' to better control the scaling of points-sizes + +GENERAL ENHANCEMENTS: + +under the hood: ++ introduced automatic scaling of points in comparePlot.R and infoPlot.R ++ .cexscale is now documented ++ the argument of .fillList is now automatically cast to list (if necessary). ++ interpolRisks gain biastype and normtype methods, as well as getRiskFctBV + => now cniperPointPlot should work for GPD-type data ++ added reference for copied routine stats:::format.perc ++ in the axis annotation (after rescaling) there are checks now + whether values +-infinity are taken at all. (This was a bug + before for distributions passed on as cdf and quantile function + with finite left or right endpoint.) + +BUGFIXES: ++ two bugs in plotWrapper.R in pkgs RobAStBase and ROptEst detected by Misha ++ bug in kStepEstimator: after evaluation of starting estimator, IC must be + shifted to correct parameter value -> new arguments withPreModif, withPostModif ++ in comparePlot it should be resc.Dargs instead of rescD.args ++ fixed errors detected by Matthias / Misha in comparePlot.R, cutoff-class.R, + ddPlot_utils.R, infoPlot.R, outlyingPlot.R ++ comparePlot now plots the whole range ++ ddPlots / outlyingPlot.R now have alpha transparency and jitter and cex.pts ++ infoPlot plots the correct y-axis (no overplotting) ++ minor fixes in InfoPlotWrapper.Rd, outlyingPlotIC.Rd ++ fixed NA-buglet in plotWrapper.R (detected by Dasha Pupashenko) ++ fixed a little bug with the use of .cexscale (with list of functions) ++ bugfix in outlyingnessPlot: for robCov.y ==TRUE (default) the + inverse covariance matrix was used for standardization instead + of the original one + + +####################################### version 0.9 ####################################### @@ -81,9 +141,6 @@ - - - ####################################### version 0.8 ####################################### Modified: branches/robast-1.0/pkg/RobAStRDA/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStRDA/inst/NEWS 2014-08-05 17:30:44 UTC (rev 778) +++ branches/robast-1.0/pkg/RobAStRDA/inst/NEWS 2014-08-10 12:42:06 UTC (rev 779) @@ -8,6 +8,20 @@ information) ####################################### +version 1.0 +####################################### + +user-visible CHANGES: + +GENERAL ENHANCEMENTS: + +under the hood: ++ warning methods about not importing from methods ... + +BUGFIXES: + + +####################################### version 0.9 ####################################### Modified: branches/robast-1.0/pkg/RobExtremes/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobExtremes/inst/NEWS 2014-08-05 17:30:44 UTC (rev 778) +++ branches/robast-1.0/pkg/RobExtremes/inst/NEWS 2014-08-10 12:42:06 UTC (rev 779) @@ -8,6 +8,57 @@ information) ####################################### +version 1.0 +####################################### + +user-visible CHANGES: ++ GEV now has a robust starting estimator for mu unknown ++ GEVFamily and GEVFamilyMuUnknown now have changed default starting estimators + realized in startEstGEV.R : a CvM-MDE with xi varying on a grid... + +GENERAL ENHANCEMENTS: + +under the hood: ++ deleted some .bak file from R folder ++ risk measures VaR, CVaR, and EL for GPD, Weibull, Gamma, ... (ScaleShapeModels) ++ packed startEstGEV.R into a try-catch... ++ checking script to check GEV in scripts folder ++ prepared code for evaluation of LMs on xi grid for GEVFamilyMuUnknown family; ++ .pretreat.of.interest and .define.tau.Dtau are more accurate now; ++ moved some packages to Imports to avoid note on many packages in Depends, + added Encoding due to warning about character 2292 in my locale ++ removed ::: internal dependencies (within distr&robast-Fam's of pkgs) by + copying respective routines + +BUGFIXES: ++ fixed issue with updateStep in kStepEstimator when using interpol risks + (somehow modifyIC had not been attached in prior steps...) ++ added \value tag in getCVaR.Rd ++ fixed some issues with help of getVaR, getCVaR, ... ++ new print method for the results of these functions (and a corresponding S3class) ++ GParetoFamily now handles left endpoint correctly and catches xi < -1/2 ++ GEVFamily[MuUnknown] for xi>0 now handles left endpoint correctly and catches xi < -1/2 ++ warning for large xi is switched off in GEVFamily[MuUnknown] if called internally ++ double definition of ddigamma eliminated ++ bugfix in bounds / must be right for shape < 0 ++ eliminated some erroneous prints ++ in startEstGEV.R, the sigma search range could include negative values, + now only let pass admissible starting estimators ++ bug in (population) variance of GEV xi=0 discovered ++ fixed the problem with inadmissible return values of MLE in startEstGEV.R ++ startEstGEV.R now works with soft bound 1+ xi (x-mu)/sigma > 0 (only to hold + for lower quantile...) controlled by argument secLevel ++ fixed issue with check.validity as notified by B. Spangl, and extended + starting estimator in GParetoFamily ++ fixed Matthias' error-issue in TeaserExample.R in cniperCont.R /plotWrapper.R + -- used the wrong variance ++ fixed buglets in GEVFamilyMuUnknown which hindered evaluation of LagrangeMults, ++ cleaned small buglet in modifyPar ++ corrected link in Var.Rd ++ put code in \dontrun to reduce checking time + + +####################################### version 0.9 ####################################### From noreply at r-forge.r-project.org Sun Aug 10 19:55:08 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Aug 2014 19:55:08 +0200 (CEST) Subject: [Robast-commits] r780 - in branches/robast-1.0/pkg/RobAStBase: R inst Message-ID: <20140810175508.66253187588@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-10 19:55:08 +0200 (Sun, 10 Aug 2014) New Revision: 780 Modified: branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R branches/robast-1.0/pkg/RobAStBase/R/oneStepEstimator.R branches/robast-1.0/pkg/RobAStBase/inst/NEWS Log: [RobAStBase]: output in kStepEstimator() and oneStepEstimator() is filtered by .checkEstClassForParamFamily(); this allows to return an object of S4 class specific to the resp. parametric family (by means of S4 method dispatch); this is used in pkg 'RobExtremes' to produce, e.g., objects of class "GEVkStepEstimate", i.e. which inherit from both "kStepEstimate", so that a diag-method for "GEVEstimate" becomes available for this class. Modified: branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R 2014-08-10 12:42:06 UTC (rev 779) +++ branches/robast-1.0/pkg/RobAStBase/R/kStepEstimator.R 2014-08-10 17:55:08 UTC (rev 780) @@ -342,7 +342,7 @@ dimnames(asVar) <- list(nms.theta.idx, nms.theta.idx) } - return(new("kStepEstimate", estimate.call = es.call, + estres <- new("kStepEstimate", estimate.call = es.call, name = paste(steps, "-step estimate", sep = ""), estimate = theta, samplesize = nrow(x0), asvar = asVar, trafo = tf, fixed = fixed, nuis.idx = nuis.idx, @@ -350,7 +350,9 @@ untransformed.asvar = u.var, asbias = asBias, pIC = IC, steps = steps, Infos = Infos, start = start, startval = start.val, ustartval = u.start.val, ksteps = ksteps, - uksteps = uksteps, pICList = pICList, ICList = ICList)) + uksteps = uksteps, pICList = pICList, ICList = ICList) + return(.checkEstClassForParamFamily(L2Fam,estres)) + } # (est1.NS <- kStepEstimator(x, IC2.NS, est0, steps = 1)) Modified: branches/robast-1.0/pkg/RobAStBase/R/oneStepEstimator.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/oneStepEstimator.R 2014-08-10 12:42:06 UTC (rev 779) +++ branches/robast-1.0/pkg/RobAStBase/R/oneStepEstimator.R 2014-08-10 17:55:08 UTC (rev 780) @@ -55,13 +55,16 @@ nuis.idx <- if(is(start,"Estimate")) start at nuis.idx else NULL fixed <- if(is(start,"Estimate")) start at fixed else NULL - new("kStepEstimate", name = "1-step estimate", estimate = res, + estres <- new("kStepEstimate", name = "1-step estimate", estimate = res, untransformed.estimate = res, untransformed.asvar = NULL, fixed = fixed, nuis.idx = nuis.idx, completecases = completecases, estimate.call = es.call, samplesize = nrow(x0), asvar = asVar, asbias = asBias, pIC = IC, steps = 1L, Infos = Infos, start = start, startval = start.val, ustartval = start.val) + L2Fam <- eval(CallL2Fam(IC)) + + return(.checkEstClassForParamFamily(L2Fam,estres)) } Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 12:42:06 UTC (rev 779) +++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 17:55:08 UTC (rev 780) @@ -48,6 +48,14 @@ whether values +-infinity are taken at all. (This was a bug before for distributions passed on as cdf and quantile function with finite left or right endpoint.) ++ output in kStepEstimator() and oneStepEstimator() is filtered + by .checkEstClassForParamFamily(); this allows to return an + object of S4 class specific to the resp. parametric family (by means of + S4 method dispatch); this is used in pkg 'RobExtremes' to produce, e.g., + objects of class "GEVkStepEstimate", i.e. which inherit from both + "kStepEstimate", so that a diag-method for "GEVEstimate" becomes + available for this class. + BUGFIXES: + two bugs in plotWrapper.R in pkgs RobAStBase and ROptEst detected by Misha From noreply at r-forge.r-project.org Sun Aug 10 19:58:50 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Aug 2014 19:58:50 +0200 (CEST) Subject: [Robast-commits] r781 - branches/robast-1.0/pkg/RobAStBase/R Message-ID: <20140810175850.DB5DD1875A4@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-10 19:58:50 +0200 (Sun, 10 Aug 2014) New Revision: 781 Modified: branches/robast-1.0/pkg/RobAStBase/R/qqplot.R Log: [RobAStBase] qqplot: output is filtered by invisible(); in addition, in the method for kStepEstimate, the parametric family is shifted to the return value of the parameter estimate before plotting Modified: branches/robast-1.0/pkg/RobAStBase/R/qqplot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/qqplot.R 2014-08-10 17:55:08 UTC (rev 780) +++ branches/robast-1.0/pkg/RobAStBase/R/qqplot.R 2014-08-10 17:58:50 UTC (rev 781) @@ -48,8 +48,8 @@ x.cex <- 3/(1+log(1+xD)) mcl$cex.pch <- x.cex - return(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), - args=mcl)) + return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), + args=mcl))) }) @@ -101,8 +101,8 @@ mcl$cex.pch <- x.cex - return(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), - args=mcl)) + return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), + args=mcl))) }) ## into RobAStBase @@ -129,9 +129,11 @@ stop("IC of the kStepEstimator needs to be of class 'IC'") L2Fam <- eval(IC at CallL2Fam) + param <- ParamFamParameter(main=untransformed.estimate(y), nuisance=nuisance(y), + fixed=fixed(y)) + L2Fam0 <- modifyModel(L2Fam,param) + mcl$y <- L2Fam0 - mcl$y <- L2Fam - if(is(IC,"HampIC")){ dim0 <- nrow(FisherInfo(L2Fam)) L <- as(diag(dim0)%*%L2Fam at L2deriv, "EuclRandVariable") @@ -154,6 +156,6 @@ mcl$col.pch <- .fadeColor(col.pch,wx^exp.fadcol.pch, bg = bg) } - return(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), - args=mcl)) + return(invisible(do.call(getMethod("qqplot", signature(x="ANY", y="ProbFamily")), + args=mcl))) }) From noreply at r-forge.r-project.org Sun Aug 10 23:43:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 10 Aug 2014 23:43:33 +0200 (CEST) Subject: [Robast-commits] r782 - in branches/robast-1.0/pkg/RobAStBase: R inst man Message-ID: <20140810214333.CD90C1858B0@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-10 23:43:33 +0200 (Sun, 10 Aug 2014) New Revision: 782 Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R branches/robast-1.0/pkg/RobAStBase/inst/NEWS branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd Log: [RobAStBase] + qqplot: some speedup in examples + wrapper functions ICPlot, InfoPlot, and ComparePlot use refined grids, i.e., the grids are plotted on user given coordinates (or rescaled coordinates) Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-10 17:58:50 UTC (rev 781) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-10 21:43:33 UTC (rev 782) @@ -312,7 +312,16 @@ pL.rel <- pL.abs <- pL <- expression({}) if(!is.null(dots$panel.last)) {pL.rel <- pL.abs <- pL <- dots$panel.last} + pF.rel <- pF.abs <- expression({}) + if(!is.null(dots$panel.first)) + {pF.rel <- pF.abs <- dots$panel.first} + pF.rel <- substitute({.absInd <- FALSE + pF}, list(pF=pF.rel)) + pF.abs <- substitute({.absInd <- TRUE + pF}, list(pF=pF.abs)) + dotsP$panel.last <- dotsP$panel.first <- NULL + if(!is.null(data)){ n <- if(!is.null(dim(data))) nrow(data) else length(data) @@ -465,7 +474,8 @@ do.call(plot, args=c(list(resc.C$X, resc.C$Y, type = plty, lty = ltyI, col = colI, lwd = lwdI, - xlab = xlab, ylab = ylab.abs, panel.last = pL.abs), + xlab = xlab, ylab = ylab.abs, panel.last = pL.abs, + panel.first = pF.abs), dotsP1)) do.call(lines, args=c(list(resc$X, resc$Y, type = plty, lty = lty, lwd = lwd, col = col), dotsL)) @@ -529,8 +539,8 @@ do.call(plot, args=c(list(resc$X, y.vec1, type = plty, lty = lty, xlab = xlab, ylab = ylab.rel, - col = col, lwd = lwd, panel.last = pL.rel), - dotsP)) + col = col, lwd = lwd, panel.last = pL.rel, + panel.first = pF.rel), dotsP)) do.call(lines, args = c(list(resc.C$X, y.vec1C, type = plty, lty = ltyI, col = colI, lwd = lwdI), dotsL)) Modified: branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-10 17:58:50 UTC (rev 781) +++ branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-10 21:43:33 UTC (rev 782) @@ -104,7 +104,23 @@ 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 + + + ##### plotting in grid + + ..panelFirst <- .producePanelFirstS( + dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), TRUE, + x.ticks = eval(dots[["x.ticks"]]), + scaleX = eval(dots[["scaleX"]]), + scaleX.fct = dots[["scaleX.fct"]], + y.ticks = eval(dots[["y.ticks"]]), + scaleY = eval(dots[["scaleY"]]), + scaleY.fct = dots[["scaleY.fct"]]) + + ..panelLast <- dots[["panel.last"]] ### + + ### ### 2. build up the argument list for the (powerful/fullfledged) ### graphics/diagnostics function; ## @@ -153,7 +169,8 @@ ,cex.lab = substitute(1.5) ,cex = substitute(1.5) ,bty = substitute("o") - ,panel.first= substitute(grid()) + ,panel.first= ..panelFirst + ,panel.last= ..panelLast ,col = substitute("blue") ), scaleList) @@ -170,6 +187,7 @@ } args <- .merge.lists(argsList, dots) + ### ### 3. build up the call but grab it and write it into an object ### @@ -269,7 +287,22 @@ 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 + + ##### plotting in grid + ..panelFirst <- .producePanelFirstS( + dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), FALSE, + x.ticks = eval(dots[["x.ticks"]]), + scaleX = eval(dots[["scaleX"]]), + scaleX.fct = dots[["scaleX.fct"]], + y.ticks = eval(dots[["y.ticks"]]), + scaleY = eval(dots[["scaleY"]]), + scaleY.fct = dots[["scaleY.fct"]]) + + ..panelLast <- dots[["panel.last"]] ### + + + ### ### 2. build up the argument list for the (powerful/fullfledged) ### graphics/diagnostics function; ## @@ -305,8 +338,9 @@ ,cex.lab = substitute(1.5) ,cex = substitute(1.5) ,bty = substitute("o") - ,panel.first= substitute(grid()) ,col = substitute("blue") + ,panel.first= ..panelFirst + ,panel.last= ..panelLast ), scaleList) if(!missing(y)){c(argsList, y = substitute(y) ,cex.pts = substitute(0.3) @@ -325,9 +359,7 @@ ,cex.main = substitute(1.5) ,cex.lab = substitute(1.5) ,cex = substitute(1.5) - ,bty = substitute("o") - ,panel.first= substitute(grid()) - ,col = substitute("blue")) + ,bty = substitute("o")) } ##parameter for plotting @@ -452,7 +484,22 @@ if(is.null(mc$rescale)) mc$rescale <- FALSE if(is.null(mc$withCall)) mc$withCall <- TRUE iny <- if(missing(y)) TRUE else is.null(y) + + ##### plotting in grid + ..panelFirst <- .producePanelFirstS( + dots[["panel.first"]],IC1,eval(dots[["to.draw.arg"]]), FALSE, + x.ticks = eval(dots[["x.ticks"]]), + scaleX = eval(dots[["scaleX"]]), + scaleX.fct = dots[["scaleX.fct"]], + y.ticks = eval(dots[["y.ticks"]]), + scaleY = eval(dots[["scaleY"]]), + scaleY.fct = dots[["scaleY.fct"]]) + + ..panelLast <- dots[["panel.last"]] ### + + + ### ### 2. build up the argument list for the (powerful/fullfledged) ### graphics/diagnostics function; ## @@ -512,8 +559,9 @@ ,cex.lab = substitute(1.5) ,cex = substitute(1.5) ,bty = substitute("o") - ,panel.first= substitute(grid()) ,col = substitute("blue") + ,panel.first= ..panelFirst + ,panel.last= ..panelLast ), scaleList) if(!is.null(IC3)) argsList$obj3 <- substitute(IC3) @@ -555,3 +603,92 @@ } +.getDimsTD <- function(L2Fam,to.draw.arg){ + trafO <- trafo(L2Fam at param) + dims <- nrow(trafO) + dimnms <- c(rownames(trafO)) + if(is.null(dimnms)) + dimnms <- paste("dim",1:dims,sep="") + to.draw <- 1:dims + if(! is.null(to.draw.arg)){ + if(is.character(to.draw.arg)) + to.draw <- pmatch(to.draw.arg, dimnms) + else if(is.numeric(to.draw.arg)) + to.draw <- to.draw.arg + } + return(length(to.draw)) +} + + +.producePanelFirstS <- function(panelFirst,IC,to.draw.arg,isInfoPlot=FALSE, + x.ticks, scaleX, scaleX.fct, + y.ticks, scaleY, scaleY.fct){ + + + L2Fam <- eval(IC at CallL2Fam) + if(is.null(scaleX.fct)) scaleX.fct <- p(L2Fam) + ndim <- .getDimsTD(L2Fam,to.draw.arg) + if(is.null(scaleY.fct)){ + scaleY.fct <- .fillList(pnorm,ndim) + }else{ + scaleY.fct <- .fillList(scaleY.fct,ndim) + } + ..y.ticks <- .fillList(y.ticks,ndim) + .xticksS <- substitute({ + .x.ticks <- x.ticks0 + if(is.null(.x.ticks)) + .x.ticks <- axTicks(1, axp=par("xaxp"), usr=par("usr")) + scaleX00 <- FALSE + if(!is.null(scaleX0)) scaleX00 <- scaleX0 + if(scaleX00) .x.ticks <- scaleX.fct0(.x.ticks) + }, + list(x.ticks0 = x.ticks, scaleX0 = scaleX, scaleX.fct0 = scaleX.fct) + ) + + getYI <- if(isInfoPlot){ + substitute({ + i0 <- if(exists("i")) get("i") else 1 + .y.ticks <- if(.absInd) NULL else .y.ticksL[[i0]] + }) + }else{ + substitute({ + .y.ticks <- .y.ticksL[[i]] + }) + + } + assYI <- if(isInfoPlot){ + substitute({ + i0 <- if(exists("i")) get("i") else 1 + if(.absInd) .y.ticks <- scaleY.fct0[[i0]](.y.ticks) + }) + }else{ + substitute({ + .y.ticks <- scaleY.fct0[[i]](.y.ticks) + }, list(scaleY.fct0 = scaleY.fct)) + + } + + .yticksS <- substitute({ + .y.ticksL <- y.ticks0 + getYI0 + if(is.null(.y.ticks)) + .y.ticks <- axTicks(2, axp=par("yaxp"), usr=par("usr")) + scaleY00 <- FALSE + if(!is.null(scaleY0)) scaleY00 <- scaleY0 + if(scaleY00) assYI0 + }, + list(y.ticks0 = y.ticks, scaleY0 = scaleY, scaleY.fct0 = scaleY.fct, + getYI0 = getYI, assYI0 = assYI) + ) + + ..panelFirst <- substitute({ + pF + .xticksS0 + .yticksS0 + abline(v=.x.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd")) + abline(h=.y.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd")) + },list(pF=if(is.null(panelFirst)) expression({}) else panelFirst, + .xticksS0 = .xticksS, .yticksS0 = .yticksS + )) + return(..panelFirst) +} \ No newline at end of file Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 17:58:50 UTC (rev 781) +++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 21:43:33 UTC (rev 782) @@ -34,7 +34,8 @@ default use an equidistant grid on the rescaled x-Axis. + qqplot-method for c("ANY","InfRobModel") gains argument 'cex.pts.fun' to better control the scaling of points-sizes - ++ new helper function cutoff.quant() to produce cutoff from model quantiles + GENERAL ENHANCEMENTS: under the hood: Modified: branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-10 17:58:50 UTC (rev 781) +++ branches/robast-1.0/pkg/RobAStBase/man/qqplot.Rd 2014-08-10 21:43:33 UTC (rev 782) @@ -131,7 +131,7 @@ neighbor = ContNeighborhood(radius = 0.4)) x <- r(Norm(15,sqrt(30)))(20) qqplot(x, RobM) -qqplot(x, RobM, alpha.CI=0.9) +qqplot(x, RobM, alpha.CI=0.9, add.points.CI=FALSE) ## further examples for ANY,kStepEstimator-method ## in example to roptest() in package ROptEst } From noreply at r-forge.r-project.org Mon Aug 11 00:21:47 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 11 Aug 2014 00:21:47 +0200 (CEST) Subject: [Robast-commits] r783 - in branches/robast-1.0/pkg/RobAStBase: . R inst man Message-ID: <20140810222147.7C3711876D0@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-11 00:21:47 +0200 (Mon, 11 Aug 2014) New Revision: 783 Modified: branches/robast-1.0/pkg/RobAStBase/NAMESPACE branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R branches/robast-1.0/pkg/RobAStBase/inst/NEWS branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd Log: + new helper function cutoff.quant() to produce cutoff from model quantiles Modified: branches/robast-1.0/pkg/RobAStBase/NAMESPACE =================================================================== --- branches/robast-1.0/pkg/RobAStBase/NAMESPACE 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/NAMESPACE 2014-08-10 22:21:47 UTC (rev 783) @@ -72,7 +72,7 @@ export("InfluenceCurve", "IC", "ContIC", "TotalVarIC") export(".eq", ".getDistr", "getBoundedIC") export("RobAStBaseOptions", "getRobAStBaseOption") -export("cutoff","cutoff.chisq","cutoff.sememp") +export("cutoff","cutoff.chisq","cutoff.sememp", "cutoff.quant") export("outlyingPlotIC", "RobAStBaseMASK") export("OMSRRisk","MBRRisk","RMXRRisk") export("getRiskFctBV") Modified: branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/R/cutoff-class.R 2014-08-10 22:21:47 UTC (rev 783) @@ -50,3 +50,25 @@ qchisq(df = dim, cutoff.quantile)^.5 }), cutoff.quantile = 0.95)} + +cutoff.quant <- function(qfct){ + if(missing(qfct)) qfct <- NULL + cutoff(name = "quantile", + body.fct0 = substitute({ + if(is.null(qfctA)){ + if(exists("..ICloc")){ + L2m <- eval(CallL2Fam(get("..ICloc"))) + qfct0 <- q(L2m) + }else{ + qfct0 <- qnorm + } + }else{ + qfct0 <- qfctA + } + q0 <- qfct0(cutoff.quantile) + if(exists("..trf")){ + q0 <- get("..trf")(q0) + } + return(q0) + }, list(qfctA=qfct)), + cutoff.quantile = 0.95)} Modified: branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/R/ddPlot_utils.R 2014-08-10 22:21:47 UTC (rev 783) @@ -86,13 +86,17 @@ if(is.null(cutoff.x)) cutoff.x <- cutoff(norm = dist.x, cutoff.quantile = cutoff.quantile.x) - else {assign("norm", dist.x, environment(fct(cutoff.x))) - assign("cutoff.quantile", cutoff.quantile.x, environment(fct(cutoff.x)))} + else {assign("norm", dist.x, envir=environment(fct(cutoff.x))) + assign("cutoff.quantile", cutoff.quantile.x, envir=environment(fct(cutoff.x))) + assign("..trf", if(missing(transform.x)||is.null(transform.x)) function(x)x else transform.x, + envir=environment(fct(cutoff.x)))} if(is.null(cutoff.y)) cutoff.y <- cutoff(norm = dist.y, cutoff.quantile = cutoff.quantile.y) - else {assign("norm", dist.y, environment(fct(cutoff.y))) - assign("cutoff.quantile", cutoff.quantile.y, environment(fct(cutoff.y)))} + else {assign("norm", dist.y, envir=environment(fct(cutoff.y))) + assign("cutoff.quantile", cutoff.quantile.y, envir=environment(fct(cutoff.y))) + assign("..trf", if(missing(transform.y)||is.null(transform.y)) function(x)x else transform.y, + envir=environment(fct(cutoff.y)))} if(!is(dist.x, "NormType")) stop("Argument 'dist.x' of 'ddPlot' must be of class 'NormType'") if(!is(dist.y, "NormType")) stop("Argument 'dist.y' of 'ddPlot' must be of class 'NormType'") Modified: branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/R/outlyingPlot.R 2014-08-10 22:21:47 UTC (rev 783) @@ -124,11 +124,13 @@ tf.y <- function(x) apply(x,2,function(xx) evalIC(IC.y,xx)) }else{tf.y <- mc$tf.y} - do.call(ddPlot,args=c(list(data=data),dots, + if(!missing(cutoff.x)) assign("..ICloc", IC.x, envir=environment(fct(cutoff.x))) + if(!missing(cutoff.y)) assign("..ICloc", IC.y, envir=environment(fct(cutoff.y))) + do.call(ddPlot,args=c(list(data=data),dots, list(dist.x = mc$dist.x, dist.y = mc$dist.y, - cutoff.x = mc$cutoff.x, - cutoff.y = mc$cutoff.y, + cutoff.x = cutoff.x, + cutoff.y = cutoff.y, cutoff.quantile.x = mc$cutoff.quantile.x, cutoff.quantile.y = mc$cutoff.quantile.y, transform.x = tf.x, Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-10 22:21:47 UTC (rev 783) @@ -30,6 +30,8 @@ unevenly (i.e. on an equally spaced grid in the original scale, but then, after rescaling non-equally... The grid has to be specified in original scale; i.e.; when used with rescaling, should be chosen non-equally spaced... ++ wrapper functions ICPlot, InfoPlot, and ComparePlot use refined grids, i.e., + the grids are plotted on user given coordinates (or rescaled coordinates) + comparePlot, infoPlot, and the plot-Method for ICs now if scaleX is TRUE by default use an equidistant grid on the rescaled x-Axis. + qqplot-method for c("ANY","InfRobModel") gains argument Modified: branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-08-10 21:43:33 UTC (rev 782) +++ branches/robast-1.0/pkg/RobAStBase/man/cutoff.Rd 2014-08-10 22:21:47 UTC (rev 783) @@ -2,6 +2,7 @@ \alias{cutoff} \alias{cutoff.sememp} \alias{cutoff.chisq} +\alias{cutoff.quant} \title{Generating function(s) for class 'cutoff'} \description{ @@ -13,6 +14,7 @@ norm = NormType(), QF, nsim = 100000) cutoff.sememp() cutoff.chisq() +cutoff.quant(qfct) } \arguments{ \item{name}{argument for name slot of \code{cutoff} object} @@ -26,6 +28,7 @@ normal and \eqn{Q} a corresponding quadratic form} \item{QF}{ a quadratic (positive semidefinite, symmetric) matrix used as quadratic form } + \item{qfct}{ a (nominal) quantile function } } \details{ \code{cutoff} generates a valid object of class \code{"cutoff"}. @@ -47,6 +50,13 @@ \code{cutoff.chisq()} is a helper function generating the theoretical (asymptotic) quantile of (the square root of) a (self-standardized) quadratic form, assuming multivariate normality; i.e.; a corresponding quantile of a Chi-Square distribution. + +\code{cutoff.quant()} is a helper function generating the theoretical quantile +corresponding to the quantile function \code{qfct}; if \code{qfct} is missing, +it searches the caller environment for an object \code{..ICloc}, and if this +exists it uses the respective model quantile function; the fallback is +\code{qnorm}. At any rate, if there is an object \code{..trf} in the scope of +the function it is used to transfer the quantile (after its evaluation). } \value{Object of class \code{"cutoff"}.} \author{ From noreply at r-forge.r-project.org Mon Aug 11 03:48:40 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 11 Aug 2014 03:48:40 +0200 (CEST) Subject: [Robast-commits] r784 - in branches/robast-1.0/pkg/RobExtremes: . R inst man Message-ID: <20140811014840.A282C185797@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-11 03:48:39 +0200 (Mon, 11 Aug 2014) New Revision: 784 Added: branches/robast-1.0/pkg/RobExtremes/R/checkEstClassForParamFamiliyMethods.R branches/robast-1.0/pkg/RobExtremes/R/gevgpddiag.R branches/robast-1.0/pkg/RobExtremes/man/internal-methods.Rd branches/robast-1.0/pkg/RobExtremes/man/ismevgpdgevdiag-methods.Rd Modified: branches/robast-1.0/pkg/RobExtremes/DESCRIPTION branches/robast-1.0/pkg/RobExtremes/NAMESPACE branches/robast-1.0/pkg/RobExtremes/R/AllClass.R branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R branches/robast-1.0/pkg/RobExtremes/R/LDEstimator.R branches/robast-1.0/pkg/RobExtremes/inst/TOBEDONE Log: [RobExtremes] provide wrapper for ismev-diagnostics ie gev.diag, gev.prof, gev.profxi, gpd.diag, gpd.prof, gpd.profxi Modified: branches/robast-1.0/pkg/RobExtremes/DESCRIPTION =================================================================== --- branches/robast-1.0/pkg/RobExtremes/DESCRIPTION 2014-08-10 22:21:47 UTC (rev 783) +++ branches/robast-1.0/pkg/RobExtremes/DESCRIPTION 2014-08-11 01:48:39 UTC (rev 784) @@ -5,7 +5,7 @@ Description: Optimally robust estimation for extreme value distributions using S4 classes and methods (based on packages distr, distrEx, distrMod, RobAStBase, and ROptEst) Depends: R (>= 2.14.0), methods, distrMod(>= 2.5.2), ROptEst(>= 0.9), robustbase(>= 0.8-0), evd, actuar -Suggests: RUnit (>= 0.4.26) +Suggests: RUnit (>= 0.4.26), ismev (>= 1.39) Imports: RobAStRDA, distr, distrEx, RandVar, RobAStBase Author: Peter Ruckdeschel, Matthias Kohl, Nataliya Horbenko Maintainer: Peter Ruckdeschel Modified: branches/robast-1.0/pkg/RobExtremes/NAMESPACE =================================================================== --- branches/robast-1.0/pkg/RobExtremes/NAMESPACE 2014-08-10 22:21:47 UTC (rev 783) +++ branches/robast-1.0/pkg/RobExtremes/NAMESPACE 2014-08-11 01:48:39 UTC (rev 784) @@ -45,4 +45,6 @@ export("loc", "loc<-", "kMAD", "Sn", "Qn", "asvarMedkMAD","asvarPickands", "asvarQBCC") exportMethods("rescaleFunction") -S3method(print, riskMeasure) \ No newline at end of file +S3method(print, riskMeasure) +exportMethods("gev.diag", "gpd.diag","gev.prof", "gpd.prof", + "gev.profxi", "gpd.profxi") \ No newline at end of file Modified: branches/robast-1.0/pkg/RobExtremes/R/AllClass.R =================================================================== --- branches/robast-1.0/pkg/RobExtremes/R/AllClass.R 2014-08-10 22:21:47 UTC (rev 783) +++ branches/robast-1.0/pkg/RobExtremes/R/AllClass.R 2014-08-11 01:48:39 UTC (rev 784) @@ -277,3 +277,14 @@ mat = matrix(1)) ), contains = "Estimate") + +setOldClass("gev.fit") +setOldClass("gpd.fit") +setClass("GPDEstimate", contains="Estimate") +setClass("GPDMCEstimate", contains=c("MCEstimate", "GPDEstimate")) +setClass("GPDLDEstimate", contains=c("LDEstimate", "GPDEstimate")) +setClass("GPDkStepEstimate", contains=c("kStepEstimate", "GPDEstimate")) +setClass("GEVEstimate", contains="Estimate") +setClass("GEVLDEstimate", contains=c("LDEstimate", "GEVEstimate")) +setClass("GEVkStepEstimate", contains=c("kStepEstimate", "GEVEstimate")) +setClass("GEVMCEstimate", contains=c("MCEstimate", "GEVEstimate")) Modified: branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R =================================================================== --- branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R 2014-08-10 22:21:47 UTC (rev 783) +++ branches/robast-1.0/pkg/RobExtremes/R/AllGeneric.R 2014-08-11 01:48:39 UTC (rev 784) @@ -28,3 +28,21 @@ if(!isGeneric(".loc")){ setGeneric(".loc", function(L2Fam, ...) standardGeneric(".loc")) } +if(!isGeneric("gev.diag")){ + setGeneric("gev.diag", function(z) standardGeneric("gev.diag")) +} +if(!isGeneric("gev.prof")){ + setGeneric("gev.prof", function(z, ...) standardGeneric("gev.prof")) +} +if(!isGeneric("gev.profxi")){ + setGeneric("gev.profxi", function(z, ...) standardGeneric("gev.profxi")) +} +if(!isGeneric("gpd.diag")){ + setGeneric("gpd.diag", function(z) standardGeneric("gpd.diag")) +} +if(!isGeneric("gpd.prof")){ + setGeneric("gpd.prof", function(z, ...) standardGeneric("gpd.prof")) +} +if(!isGeneric("gpd.profxi")){ + setGeneric("gpd.profxi", function(z, ...) standardGeneric("gpd.profxi")) +} Modified: branches/robast-1.0/pkg/RobExtremes/R/LDEstimator.R =================================================================== --- branches/robast-1.0/pkg/RobExtremes/R/LDEstimator.R 2014-08-10 22:21:47 UTC (rev 783) +++ branches/robast-1.0/pkg/RobExtremes/R/LDEstimator.R 2014-08-11 01:48:39 UTC (rev 784) @@ -143,7 +143,7 @@ estim at dispersion <- LDMval["disp"] estim at location <- LDMval["loc"] - return(estim) + return(.checkEstClassForParamFamily(ParamFamily,estim)) } @@ -170,7 +170,7 @@ .withEvalAsVar = .withEvalAsVar, vdbg = vdbg) es at estimate.call <- es.call - return(es) + return(.checkEstClassForParamFamily(ParamFamily,es)) } medQn <- function(x, ParamFamily, q.lo =1e-3, q.up=15, nuis.idx = NULL, @@ -189,7 +189,7 @@ asvar.fct = asvar.fct, na.rm = na.rm, ..., .withEvalAsVar = .withEvalAsVar) es at estimate.call <- es.call - return(es) + return(.checkEstClassForParamFamily(ParamFamily,es)) } medSn <- function(x, ParamFamily, q.lo =1e-3, q.up=10, nuis.idx = NULL, @@ -208,7 +208,7 @@ asvar.fct = asvar.fct, na.rm = na.rm, ..., .withEvalAsVar = .withEvalAsVar) es at estimate.call <- es.call - return(es) + return(.checkEstClassForParamFamily(ParamFamily,es)) } medkMADhybr <- function(x, ParamFamily, k=1, q.lo =1e-3, q.up=15, @@ -223,7 +223,7 @@ ..., .withEvalAsVar = FALSE), silent=TRUE) if(! any(is.na(estimate(es))) && !is(es,"try-error")) - {return(es)} + {return(.checkEstClassForParamFamily(ParamFamily,es))} k1 <- 3.23 while(i Author: ruckdeschel Date: 2014-08-11 03:51:25 +0200 (Mon, 11 Aug 2014) New Revision: 785 Modified: branches/robast-1.0/pkg/RobExtremes/R/startEstGEV.R branches/robast-1.0/pkg/RobExtremes/R/startEstGPD.R branches/robast-1.0/pkg/RobExtremes/inst/NEWS Log: [RobExtremes] updated NEWS and minimal change in startEstGEV.R and startEstGPD.R Modified: branches/robast-1.0/pkg/RobExtremes/R/startEstGEV.R =================================================================== --- branches/robast-1.0/pkg/RobExtremes/R/startEstGEV.R 2014-08-11 01:48:39 UTC (rev 784) +++ branches/robast-1.0/pkg/RobExtremes/R/startEstGEV.R 2014-08-11 01:51:25 UTC (rev 785) @@ -13,7 +13,8 @@ fu <- function(x,...) .getBetaXiGEV(x,mu,xiGrid = xiGrid,withPos=withPos) e0 <- NULL - + es <- c(NA,NA) + ### first try (to ensure global consistency): PickandsEstimator try({mygev <- GEVFamily(loc=0,scale=1,shape=0.1, withPos=withPos, ..withWarningGEV=FALSE) @@ -25,7 +26,7 @@ if(!is.null(e0)) if(!is(e0,"try-error")){ mygev <- GEVFamily(loc=0,scale=e0[1],shape=e0[2], withPos=withPos, start0Est = fu, ..withWarningGEV=FALSE) - mde0 <- try(MDEstimator(x0, mygev, distance=CvMDist, startPar=c("scale"=es0[1],"shape"=es0[2])),silent=TRUE) + mde0 <- try(MDEstimator(x0, mygev, distance=CvMDist, startPar=c("scale"=e0[1],"shape"=e0[2])),silent=TRUE) es0 <- c(NA,NA) if(!is(mde0,"try-error")){ es <- estimate(mde0) Modified: branches/robast-1.0/pkg/RobExtremes/R/startEstGPD.R =================================================================== --- branches/robast-1.0/pkg/RobExtremes/R/startEstGPD.R 2014-08-11 01:48:39 UTC (rev 784) +++ branches/robast-1.0/pkg/RobExtremes/R/startEstGPD.R 2014-08-11 01:51:25 UTC (rev 785) @@ -10,7 +10,8 @@ fu <- function(x,...) .getBetaXiGPD(x,mu,xiGrid = xiGrid,withPos=withPos) e0 <- NULL - + es <- c(NA,NA) + ### first try (to ensure global consistency): PickandsEstimator try({mygpd <- GParetoFamily(loc=0,scale=1,shape=0.1, withPos=withPos) e1 <- medkMADhybr(x,ParamFamily=mygpd, k=10) Modified: branches/robast-1.0/pkg/RobExtremes/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobExtremes/inst/NEWS 2014-08-11 01:48:39 UTC (rev 784) +++ branches/robast-1.0/pkg/RobExtremes/inst/NEWS 2014-08-11 01:51:25 UTC (rev 785) @@ -15,6 +15,8 @@ + GEV now has a robust starting estimator for mu unknown + GEVFamily and GEVFamilyMuUnknown now have changed default starting estimators realized in startEstGEV.R : a CvM-MDE with xi varying on a grid... ++ provide wrapper for ismev-diagnostics ie gev.diag, gev.prof, gev.profxi, + gpd.diag, gpd.prof, gpd.profxi GENERAL ENHANCEMENTS: From noreply at r-forge.r-project.org Tue Aug 19 03:51:56 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 19 Aug 2014 03:51:56 +0200 (CEST) Subject: [Robast-commits] r786 - in branches/robast-1.0/pkg/RobAStBase: R inst man Message-ID: <20140819015157.0DC3C1857B9@r-forge.r-project.org> Author: ruckdeschel Date: 2014-08-19 03:51:56 +0200 (Tue, 19 Aug 2014) New Revision: 786 Added: branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd Modified: branches/robast-1.0/pkg/RobAStBase/R/00internal.R branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R branches/robast-1.0/pkg/RobAStBase/inst/NEWS branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd Log: [RobAStBase] + comparePlot, infoPlot, and the plot-Method for ICs gain an argument with.automatic.grid; if TRUE a corresponding grid oriented at tickmarks is produced; this also works for rescaled axes + arguments panel.first, panel.last for plot-methods can now be lists Modified: branches/robast-1.0/pkg/RobAStBase/R/00internal.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/00internal.R 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/R/00internal.R 2014-08-19 01:51:56 UTC (rev 786) @@ -17,6 +17,7 @@ {as.character(arg) %in% names(formals(fct))} .fillList <- function(list0, len = length(list0)){ + if(is.null(list0)) return(vector("list",len)) if(!is.list(list0)) list0 <- list(list0) if(len == length(list0)) return(list0) @@ -129,3 +130,18 @@ } +.panel.mingle <- function(dots, element){ + pF <- dots[[element]] + if(is.list(pF)) return(pF) + pFr <- if(typeof(pF)=="symbol") eval(pF) else{ + pFc <- as.call(pF) + if(as.list(pFc)[[1]] == "list"){ + lis <- vector("list",length(as.list(pFc))-1) + for(i in 1:length(lis)){ + lis[[i]] <- pFc[[i+1]] + } + lis + }else pF + } + return(pFr) +} Modified: branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/R/AllPlot.R 2014-08-19 01:51:56 UTC (rev 786) @@ -3,6 +3,7 @@ main = FALSE, inner = TRUE, sub = FALSE, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = FALSE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), @@ -59,6 +60,38 @@ scaleY.fct <- .fillList(scaleY.fct, dims0) scaleY.inv <- .fillList(scaleY.inv, dims0) + pF <- expression({}) + if(!is.null(dots[["panel.first"]])){ + pF <- .panel.mingle(dots,"panel.first") + } + ..panelFirst <- .fillList(pF,dims0) + if(with.automatic.grid) + ..panelFirst <- .producePanelFirstS( + ..panelFirst,x, to.draw.arg, FALSE, + x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct, + y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct) + gridS <- if(with.automatic.grid) + substitute({grid <- function(...){}}) else expression({}) + pF <- vector("list",dims0) + if(dims0>0) + for(i in 1:dims0){ + pF[[i]] <- substitute({ gridS0 + pF0}, + list(pF0=..panelFirst[[i]], gridS0=gridS)) + } + + pL <- expression({}) + if(!is.null(dots[["panel.last"]])){ + pL <- .panel.mingle(dots,"panel.last") + } + ..panelLast <- .fillList(pL,dims0) + pL <- vector("list",dims0) + if(dims0>0) + for(i in 1:dims0) + pL[[i]] <- if(is.null(..panelLast[[i]])) expression({}) else ..panelLast[[i]] + + dots$panel.last <- dots$panel.first <- NULL + MBRB <- matrix(rep(t(MBRB), length.out=dims0*2),ncol=2, byrow=T) MBRB <- MBRB * MBR.fac @@ -271,8 +304,12 @@ finiteEndpoints[3] <- is.finite(scaleY.inv[[i]](min(y.vec1, ylim[1,i]))) finiteEndpoints[4] <- is.finite(scaleY.inv[[i]](max(y.vec1, ylim[2,i]))) } + + do.call(plot, args=c(list(x=x.vec1, y=y.vec1, type = plty, lty = lty, - xlab = xlab, ylab = ylab), dots)) + xlab = xlab, ylab = ylab, + panel.first = pF[[i]], + panel.last = pL[[i]]), dots)) .plotRescaledAxis(scaleX, scaleX.fct, scaleX.inv, scaleY,scaleY.fct[[i]], scaleY.inv[[i]], xlim[,i], ylim[,i], x.vec1, ypts = 400, n = scaleN, @@ -355,15 +392,22 @@ dots.without <- dots dots.without$col <- dots.without$cex <- dots.without$pch <- NULL + dims0 <- .getDimsTD(L2Fam,dots[["to.draw.arg"]]) + pL <- expression({}) if(!is.null(dots$panel.last)) - pL <- dots$panel.last + pL <- .panel.mingle(dots,"panel.last") + pL <- .fillList(pL, dims0) + if(dims0) for(i in 1:dims0){ + if(is.null(pL[[i]])) pL[[i]] <- expression({}) + } dots$panel.last <- NULL + pL <- substitute({ y1 <- y0s ICy <- sapply(y0s,ICMap0[[indi]]) - print(xlim[,i]) + #print(xlim[,i]) resc.dat <-.rescalefct(y0s, function(x) sapply(x,ICMap0[[indi]]), scaleX, scaleX.fct, scaleX.inv, scaleY, scaleY.fct[[i]], xlim[,i], ylim[,i], Modified: branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/R/comparePlot.R 2014-08-19 01:51:56 UTC (rev 786) @@ -6,6 +6,7 @@ col = par("col"), lwd = par("lwd"), lty, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = FALSE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), @@ -253,7 +254,31 @@ dotsT$main <- dotsT$cex.main <- dotsT$col.main <- dotsT$line <- NULL - pL <- if(!is.null(dotsP$panel.last)) dotsP$panel.last else expression({}) + pF <- expression({}) + if(!is.null(dots[["panel.first"]])){ + pF <- .panel.mingle(dots,"panel.first") + } + ..panelFirst <- .fillList(pF,dims0) + if(with.automatic.grid) + ..panelFirst <- .producePanelFirstS( + ..panelFirst,obj1 , to.draw.arg, FALSE, + x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct, + y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct) + gridS <- if(with.automatic.grid) + substitute({grid <- function(...){}}) else expression({}) + pF <- vector("list",dims0) + if(dims0>0) + for(i in 1:dims0){ + pF[[i]] <- substitute({ gridS0 + pF0}, + list(pF0=..panelFirst[[i]], gridS0=gridS)) + } + dots$panel.first <- NULL + pL <- expression({}) + if(!is.null(dots[["panel.last"]])){ + pL <- .panel.mingle(dots,"panel.last") + } + pL <- .fillList(pL, dims0) dotsP$panel.last <- NULL sel1 <- sel2 <- sel3 <- sel4 <- NULL @@ -370,7 +395,7 @@ do.call(plot, args=c(list(x = resc1$X, y = y0, type = "n", xlab = xlab, ylab = ylab, lty = lty[1], col = addAlphTrsp2col(col[1],0), - lwd = lwd[1]), dotsP, list(panel.last = pL))) + lwd = lwd[1]), dotsP, list(panel.last = pL[[i]], panel.first=pF[[i]]))) if(plty=="p") do.call(matpoints, args = c(list( x = resc1$X, y = matp, col = col), dots.points)) Modified: branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/R/infoPlot.R 2014-08-19 01:51:56 UTC (rev 786) @@ -6,6 +6,7 @@ main = FALSE, inner = TRUE, sub = FALSE, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = TRUE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, @@ -309,17 +310,46 @@ } - pL.rel <- pL.abs <- pL <- expression({}) - if(!is.null(dots$panel.last)) - {pL.rel <- pL.abs <- pL <- dots$panel.last} - pF.rel <- pF.abs <- expression({}) - if(!is.null(dots$panel.first)) - {pF.rel <- pF.abs <- dots$panel.first} - pF.rel <- substitute({.absInd <- FALSE - pF}, list(pF=pF.rel)) - pF.abs <- substitute({.absInd <- TRUE - pF}, list(pF=pF.abs)) + pL <- expression({}) + if(!is.null(dots[["panel.last"]])){ + pL <- .panel.mingle(dots,"panel.last") + } + pL <- .fillList(pL, length(to.draw)) + if(in1to.draw){ + pL.rel <- pL[[1]] + pL.abs <- pL[-1] + }else{ pL.abs <- pL } + + pF <- expression({}) + if(!is.null(dots[["panel.first"]])){ + pF <- .panel.mingle(dots,"panel.first") + } + ..panelFirst <- .fillList(pF, length(to.draw)) + if(with.automatic.grid) + ..panelFirst <- .producePanelFirstS( + ..panelFirst,object, to.draw.arg, TRUE, + x.ticks = x.ticks, scaleX = scaleX, scaleX.fct = scaleX.fct, + y.ticks = y.ticks, scaleY = scaleY, scaleY.fct = scaleY.fct) + gridS <- if(with.automatic.grid) + substitute({grid <- function(...){}}) else expression({}) + if(in1to.draw){ + pF.rel <- substitute({ gridS0 + .absInd <- FALSE + pF0 <- pF + pF0[[1+i]] }, list(pF=..panelFirst, gridS0=gridS)) + pF.abs <- substitute({ gridS0 + .absInd <- TRUE + pF + }, list(pF=..panelFirst[[1]], gridS0=gridS)) + }else{ + pF.abs <- NULL + pF.rel <- substitute({ gridS0 + .absInd <- FALSE + pF0 <- pF + pF0[[i]] + }, list(pF=..panelFirst, gridS0=gridS)) + } dotsP$panel.last <- dotsP$panel.first <- NULL if(!is.null(data)){ Added: branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R (rev 0) +++ branches/robast-1.0/pkg/RobAStBase/R/internalGridHelpers.R 2014-08-19 01:51:56 UTC (rev 786) @@ -0,0 +1,97 @@ +.getDimsTD <- function(L2Fam,to.draw.arg){ + trafO <- trafo(L2Fam at param) + dims <- nrow(trafO) + dimnms <- c(rownames(trafO)) + if(is.null(dimnms)) + dimnms <- paste("dim",1:dims,sep="") + to.draw <- 1:dims + if(! is.null(to.draw.arg)){ + if(is.character(to.draw.arg)) + to.draw <- pmatch(to.draw.arg, dimnms) + else if(is.numeric(to.draw.arg)) + to.draw <- to.draw.arg + } + return(length(to.draw)) +} + + +.producePanelFirstS <- function(panelFirst,IC,to.draw.arg, isInfoPlot=FALSE, + x.ticks, scaleX, scaleX.fct, + y.ticks, scaleY, scaleY.fct){ + + + L2Fam <- eval(IC at CallL2Fam) + if(is.null(scaleX.fct)) scaleX.fct <- p(L2Fam) + ndim <- .getDimsTD(L2Fam,to.draw.arg) + if(is.null(scaleY.fct)){ + scaleY.fct <- .fillList(pnorm,ndim) + }else{ + scaleY.fct <- .fillList(scaleY.fct,ndim) + } + ..y.ticks <- .fillList(y.ticks,ndim) + .xticksS <- substitute({ + .x.ticks <- x.ticks0 + if(is.null(.x.ticks)) + .x.ticks <- axTicks(1, axp=par("xaxp"), usr=par("usr")) + scaleX00 <- FALSE + if(!is.null(scaleX0)) scaleX00 <- scaleX0 + if(scaleX00) .x.ticks <- scaleX.fct0(.x.ticks) + }, + list(x.ticks0 = x.ticks, scaleX0 = scaleX, scaleX.fct0 = scaleX.fct) + ) + + getYI <- if(isInfoPlot){ + substitute({ + i0 <- if(exists("i")) get("i") else 1 + .y.ticks <- if(.absInd) NULL else .y.ticksL[[i0]] + }) + }else{ + substitute({ + .y.ticks <- .y.ticksL[[i]] + }) + + } + + assYI <- if(isInfoPlot){ + substitute({ + i0 <- if(exists("i")) get("i") else 1 + if(.absInd) .y.ticks <- scaleY.fct0[[i0]](.y.ticks) + }, list(scaleY.fct0 = scaleY.fct)) + }else{ + substitute({ + .y.ticks <- scaleY.fct0[[i]](.y.ticks) + }, list(scaleY.fct0 = scaleY.fct)) + + } + + .yticksS <- substitute({ + .y.ticksL <- y.ticks0 + getYI0 + if(is.null(.y.ticks)) + .y.ticks <- axTicks(2, axp=par("yaxp"), usr=par("usr")) + scaleY00 <- FALSE + if(!is.null(scaleY0)) scaleY00 <- scaleY0 + if(scaleY00) assYI0 + }, + list(y.ticks0 = y.ticks, scaleY0 = scaleY, scaleY.fct0 = scaleY.fct, + getYI0 = getYI, assYI0 = assYI) + ) + + ..panelFirst <- panelFirst + if(length(panelFirst)){ + for(i in 1:length(panelFirst)){ + ..panelFirst[[i]] <- substitute({ + pFi + .xticksS0 + .yticksS0 + abline(v=.x.ticks,col= "lightgray", + lty = "dotted", lwd = par("lwd")) + abline(h=.y.ticks,col= "lightgray", + lty = "dotted", lwd = par("lwd")) + },list(pFi = if(is.null(panelFirst[[i]])) expression({}) else panelFirst[[i]], + .xticksS0 = .xticksS, .yticksS0 = .yticksS) + ) + } + } + return(..panelFirst) +} Modified: branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R =================================================================== --- branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/R/plotWrapper.R 2014-08-19 01:51:56 UTC (rev 786) @@ -106,18 +106,6 @@ if(is.null(mc$withCall)) mc$withCall <- TRUE - ##### plotting in grid - - ..panelFirst <- .producePanelFirstS( - dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), TRUE, - x.ticks = eval(dots[["x.ticks"]]), - scaleX = eval(dots[["scaleX"]]), - scaleX.fct = dots[["scaleX.fct"]], - y.ticks = eval(dots[["y.ticks"]]), - scaleY = eval(dots[["scaleY"]]), - scaleY.fct = dots[["scaleY.fct"]]) - - ..panelLast <- dots[["panel.last"]] ### ### @@ -143,6 +131,7 @@ ,cex.inner = substitute(0.8) ,bmar = substitute(par("mar")[1]) ,tmar = substitute(par("mar")[3]) + ,with.automatic.grid = substitute(TRUE) ,with.legend = substitute(TRUE) ,legend = substitute(NULL) ,legend.bg = substitute("white") @@ -169,8 +158,8 @@ ,cex.lab = substitute(1.5) ,cex = substitute(1.5) ,bty = substitute("o") - ,panel.first= ..panelFirst - ,panel.last= ..panelLast + ,panel.first= substitute(NULL) + ,panel.last= substitute(NULL) ,col = substitute("blue") ), scaleList) @@ -288,21 +277,8 @@ if(is.null(mc$rescale)) mc$rescale <- FALSE if(is.null(mc$withCall)) mc$withCall <- TRUE - ##### plotting in grid - ..panelFirst <- .producePanelFirstS( - dots[["panel.first"]],IC,eval(dots[["to.draw.arg"]]), FALSE, - x.ticks = eval(dots[["x.ticks"]]), - scaleX = eval(dots[["scaleX"]]), - scaleX.fct = dots[["scaleX.fct"]], - y.ticks = eval(dots[["y.ticks"]]), - scaleY = eval(dots[["scaleY"]]), - scaleY.fct = dots[["scaleY.fct"]]) - ..panelLast <- dots[["panel.last"]] ### - - - ### ### 2. build up the argument list for the (powerful/fullfledged) ### graphics/diagnostics function; ## @@ -319,6 +295,7 @@ ,cex.inner = substitute(0.8) ,bmar = substitute(par("mar")[1]) ,tmar = substitute(par("mar")[3]) + ,with.automatic.grid = substitute(TRUE) ,with.legend = substitute(FALSE) ,legend = substitute(NULL) ,legend.bg = substitute("white") @@ -339,8 +316,8 @@ ,cex = substitute(1.5) ,bty = substitute("o") ,col = substitute("blue") - ,panel.first= ..panelFirst - ,panel.last= ..panelLast + ,panel.first= substitute(NULL) + ,panel.last= substitute(NULL) ), scaleList) if(!missing(y)){c(argsList, y = substitute(y) ,cex.pts = substitute(0.3) @@ -485,17 +462,6 @@ if(is.null(mc$withCall)) mc$withCall <- TRUE iny <- if(missing(y)) TRUE else is.null(y) - ##### plotting in grid - ..panelFirst <- .producePanelFirstS( - dots[["panel.first"]],IC1,eval(dots[["to.draw.arg"]]), FALSE, - x.ticks = eval(dots[["x.ticks"]]), - scaleX = eval(dots[["scaleX"]]), - scaleX.fct = dots[["scaleX.fct"]], - y.ticks = eval(dots[["y.ticks"]]), - scaleY = eval(dots[["scaleY"]]), - scaleY.fct = dots[["scaleY.fct"]]) - - ..panelLast <- dots[["panel.last"]] ### @@ -521,6 +487,7 @@ ,cex.inner = substitute(0.8) ,bmar = substitute(par("mar")[1]) ,tmar = substitute(par("mar")[3]) + ,with.automatic.grid = substitute(TRUE) ,with.legend = substitute(FALSE) ,legend = substitute(NULL) ,legend.bg = substitute("white") @@ -560,8 +527,8 @@ ,cex = substitute(1.5) ,bty = substitute("o") ,col = substitute("blue") - ,panel.first= ..panelFirst - ,panel.last= ..panelLast + ,panel.first= substitute(NULL) + ,panel.last= substitute(NULL) ), scaleList) if(!is.null(IC3)) argsList$obj3 <- substitute(IC3) @@ -603,92 +570,3 @@ } -.getDimsTD <- function(L2Fam,to.draw.arg){ - trafO <- trafo(L2Fam at param) - dims <- nrow(trafO) - dimnms <- c(rownames(trafO)) - if(is.null(dimnms)) - dimnms <- paste("dim",1:dims,sep="") - to.draw <- 1:dims - if(! is.null(to.draw.arg)){ - if(is.character(to.draw.arg)) - to.draw <- pmatch(to.draw.arg, dimnms) - else if(is.numeric(to.draw.arg)) - to.draw <- to.draw.arg - } - return(length(to.draw)) -} - - -.producePanelFirstS <- function(panelFirst,IC,to.draw.arg,isInfoPlot=FALSE, - x.ticks, scaleX, scaleX.fct, - y.ticks, scaleY, scaleY.fct){ - - - L2Fam <- eval(IC at CallL2Fam) - if(is.null(scaleX.fct)) scaleX.fct <- p(L2Fam) - ndim <- .getDimsTD(L2Fam,to.draw.arg) - if(is.null(scaleY.fct)){ - scaleY.fct <- .fillList(pnorm,ndim) - }else{ - scaleY.fct <- .fillList(scaleY.fct,ndim) - } - ..y.ticks <- .fillList(y.ticks,ndim) - .xticksS <- substitute({ - .x.ticks <- x.ticks0 - if(is.null(.x.ticks)) - .x.ticks <- axTicks(1, axp=par("xaxp"), usr=par("usr")) - scaleX00 <- FALSE - if(!is.null(scaleX0)) scaleX00 <- scaleX0 - if(scaleX00) .x.ticks <- scaleX.fct0(.x.ticks) - }, - list(x.ticks0 = x.ticks, scaleX0 = scaleX, scaleX.fct0 = scaleX.fct) - ) - - getYI <- if(isInfoPlot){ - substitute({ - i0 <- if(exists("i")) get("i") else 1 - .y.ticks <- if(.absInd) NULL else .y.ticksL[[i0]] - }) - }else{ - substitute({ - .y.ticks <- .y.ticksL[[i]] - }) - - } - assYI <- if(isInfoPlot){ - substitute({ - i0 <- if(exists("i")) get("i") else 1 - if(.absInd) .y.ticks <- scaleY.fct0[[i0]](.y.ticks) - }) - }else{ - substitute({ - .y.ticks <- scaleY.fct0[[i]](.y.ticks) - }, list(scaleY.fct0 = scaleY.fct)) - - } - - .yticksS <- substitute({ - .y.ticksL <- y.ticks0 - getYI0 - if(is.null(.y.ticks)) - .y.ticks <- axTicks(2, axp=par("yaxp"), usr=par("usr")) - scaleY00 <- FALSE - if(!is.null(scaleY0)) scaleY00 <- scaleY0 - if(scaleY00) assYI0 - }, - list(y.ticks0 = y.ticks, scaleY0 = scaleY, scaleY.fct0 = scaleY.fct, - getYI0 = getYI, assYI0 = assYI) - ) - - ..panelFirst <- substitute({ - pF - .xticksS0 - .yticksS0 - abline(v=.x.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd")) - abline(h=.y.ticks,col= "lightgray", lty = "dotted", lwd = par("lwd")) - },list(pF=if(is.null(panelFirst)) expression({}) else panelFirst, - .xticksS0 = .xticksS, .yticksS0 = .yticksS - )) - return(..panelFirst) -} \ No newline at end of file Modified: branches/robast-1.0/pkg/RobAStBase/inst/NEWS =================================================================== --- branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/inst/NEWS 2014-08-19 01:51:56 UTC (rev 786) @@ -12,6 +12,10 @@ ####################################### user-visible CHANGES: ++ comparePlot, infoPlot, and the plot-Method for ICs gain an argument + with.automatic.grid; if TRUE a corresponding grid oriented at tickmarks + is produced; this also works for rescaled axes ++ arguments panel.first, panel.last for plot-methods can now be lists + infoPlot and comparePlot gain an argument cex.pts.fun to enable individual scaling of the point sizes to be plotted onto each of the plotted curves + .ddPlot.MatNtNtCoCo, and also ddPlot, outlyingnessPlot gain an Modified: branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/man/comparePlot.Rd 2014-08-19 01:51:56 UTC (rev 786) @@ -17,6 +17,7 @@ col = par("col"), lwd = par("lwd"), lty, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = FALSE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), @@ -61,6 +62,9 @@ to the current setting of \code{cex}; as in \code{\link[graphics]{par}}} \item{col.inner}{character or integer code; color for the inner title} + \item{with.automatic.grid}{logical; should a grid be plotted alongside + with the ticks of the axes, automatically? If \code{TRUE} a respective + call to \code{grid} in argument \code{panel.first} is ignored. } \item{with.legend}{logical; shall a legend be plotted?} \item{legend}{either \code{NULL} or a list of length (number of plotted panels) of items which can be used as argument \code{legend} in @@ -201,6 +205,13 @@ length 2*(number of plotted dimensions); in the case of longer length, these are the values for \code{ylim} for the plotted dimensions of the IC, one pair for each dimension. + +In addition, argument \code{\dots} may contain arguments \code{panel.first}, +\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning +and at the very end of each panel (within the then valid coordinates). +To be able to use these hooks for each panel individually, they may also be +lists of expressions (of the same length as the number of panels and +run through in the same order as the panels). } %\value{} Modified: branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/man/infoPlot.Rd 2014-08-19 01:51:56 UTC (rev 786) @@ -16,6 +16,7 @@ main = FALSE, inner = TRUE, sub = FALSE, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = TRUE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, x.vec = NULL, scaleX = FALSE, scaleX.fct, scaleX.inv, @@ -62,6 +63,9 @@ to the current setting of \code{cex}; as in \code{\link[graphics]{par}}.} \item{col.inner}{character or integer code; color for the inner title} + \item{with.automatic.grid}{logical; should a grid be plotted alongside + with the ticks of the axes, automatically? If \code{TRUE} a respective + call to \code{grid} in argument \code{panel.first} is ignored. } \item{with.legend}{logical; shall a legend be plotted?} \item{legend}{either \code{NULL} or a list of length (number of plotted panels) of items which can be used as argument \code{legend} in @@ -218,6 +222,13 @@ The \code{\dots} argument may also contain an argument \code{withbox} which if \code{TRUE} warrants that even if \code{xaxt} and \code{yaxt} both are \code{FALSE}, a box is drawn around the respective panel. + +In addition, argument \code{\dots} may contain arguments \code{panel.first}, +\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning +and at the very end of each panel (within the then valid coordinates). +To be able to use these hooks for each panel individually, they may also be +lists of expressions (of the same length as the number of panels and +run through in the same order as the panels). } %\value{} \references{ Added: branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd (rev 0) +++ branches/robast-1.0/pkg/RobAStBase/man/internal_GridHelpers.Rd 2014-08-19 01:51:56 UTC (rev 786) @@ -0,0 +1,59 @@ +\name{internal_helpers_for_producing_grids_in_plots_RobAStBase} +\alias{internal_helpers_for_producing_grids_in_plots_RobAStBase} +\alias{.getDimsTD} +\alias{.producePanelFirstS} + +\title{Internal / Helper functions of package RobAStBase for grids in plot functions} + +\description{ +These functions are internally used helper functions for \code{\link{plot}}, +\code{\link{infoPlot}} \code{\link{comparePlot}} in package \pkg{RobAStBase}.} + +\usage{ +.getDimsTD(L2Fam,to.draw.arg) +.producePanelFirstS(panelFirst,IC,to.draw.arg, isInfoPlot=FALSE, + x.ticks, scaleX, scaleX.fct, + y.ticks, scaleY, scaleY.fct) +} +\arguments{ + \item{L2Fam}{the model at which the plot is produced (of class \code{L2ParamFamily}).} + \item{to.draw.arg}{Either \code{NULL} (default; + everything is plotted) or a vector of either integers + (the indices of the subplots to be drawn) or characters + --- the names of the subplots to be drawn: these + names are to be chosen either among the row names of + the trafo matrix + \code{rownames(trafo(eval(x at CallL2Fam)@param))} + or if the last expression is \code{NULL} a + vector \code{"dim"}, \code{dimnr} running through + the number of rows of the trafo matrix. + } + \item{panelFirst}{argument \code{panel.first} to be mingled for grid plotting.} + \item{IC}{object of class \code{"InfluenceCurve"} } + \item{isInfoPlot}{logical; is this function to be used in \code{infoPlot} or + (\code{TRUE}) in another plot (\code{FALSE})? } + \item{x.ticks}{numeric: coordinates in original scale of user-given ticks on x-axis.} + \item{scaleX}{logical; shall X-axis be rescaled (by default according to the cdf of + the underlying distribution)?} + \item{scaleX.fct}{an isotone, vectorized function mapping the domain of the IC + to [0,1]; if \code{scaleX} is \code{TRUE} and \code{scaleX.fct} is + missing, the cdf of the underlying observation distribution.} + \item{y.ticks}{numeric: coordinates in original scale of user-given ticks on y-axis.} + \item{scaleY}{logical; shall Y-axis be rescaled (by default according to a probit scale)?} + \item{scaleY.fct}{an isotone, vectorized function mapping for each coordinate the + range of the respective coordinate of the IC + to [0,1]; defaulting to the cdf of \eqn{{\cal N}(0,1)}{N(0,1)}.} +} +\details{ +\code{.getDimsTD} computes the number of panels to be plotted. +\code{.producePanelFirstS} produces an unevaluated expression to be +used as argument \code{panel.first} in the diagnostic plots; i.e.; +knowing the actual tickmarks of the axis at the time of evaluation, +code is inserted to plot horizontal and vertical grid lines through +these tickmarks. +} + + +\keyword{internal} +\concept{utilities} +\keyword{hplot} Modified: branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd =================================================================== --- branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-11 01:51:25 UTC (rev 785) +++ branches/robast-1.0/pkg/RobAStBase/man/plot-methods.Rd 2014-08-19 01:51:56 UTC (rev 786) @@ -11,6 +11,7 @@ main = FALSE, inner = TRUE, sub = FALSE, col.inner = par("col.main"), cex.inner = 0.8, bmar = par("mar")[1], tmar = par("mar")[3], + with.automatic.grid = TRUE, with.legend = FALSE, legend = NULL, legend.bg = "white", legend.location = "bottomright", legend.cex = 0.8, withMBR = FALSE, MBRB = NA, MBR.fac = 2, col.MBR = par("col"), @@ -46,6 +47,9 @@ to the current setting of \code{cex}; as in \code{\link[graphics]{par}}} \item{col.inner}{character or integer code; color for the inner title} + \item{with.automatic.grid}{logical; should a grid be plotted alongside + with the ticks of the axes, automatically? If \code{TRUE} a respective + call to \code{grid} in argument \code{panel.first} is ignored. } \item{with.legend}{logical; shall a legend be plotted?} \item{legend}{either \code{NULL} or a list of length (number of plotted panels) of items which can be used as argument \code{legend} in @@ -184,6 +188,12 @@ The \code{IC,numeric}-method calls the \code{IC,missing}-method but in addition plots the values of a dataset into the IC. +In addition, argument \code{\dots} may contain arguments \code{panel.first}, +\code{panel.last}, i.e., hook expressions to be evaluated at the very beginning +and at the very end of each panel (within the then valid coordinates). +To be able to use these hooks for each panel individually, they may also be +lists of expressions (of the same length as the number of panels and +run through in the same order as the panels). } \examples{ IC1 <- new("IC")