[Robast-commits] r688 - in branches/robast-0.9/pkg: 13.07.16 - Wrapper for RobAStBase, RobExtremes ROptEst ROptEst/R ROptEst/man RobAStBase RobAStBase/R RobAStBase/man RobExtremes RobExtremes/R RobExtremes/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Sep 11 00:13:29 CEST 2013
Author: ruckdeschel
Date: 2013-09-11 00:13:29 +0200 (Wed, 11 Sep 2013)
New Revision: 688
Added:
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/rescaleFunctionP.R
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/zusaetzlicheBsp.R
branches/robast-0.9/pkg/ROptEst/R/plotWrapper.R
branches/robast-0.9/pkg/ROptEst/man/CniperPointPlotWrapper.Rd
branches/robast-0.9/pkg/RobAStBase/R/plotWrapper.R
branches/robast-0.9/pkg/RobAStBase/R/rescaleFct.R
branches/robast-0.9/pkg/RobAStBase/man/ComparePlotWrapper.Rd
branches/robast-0.9/pkg/RobAStBase/man/InfoPlotWrapper.Rd
branches/robast-0.9/pkg/RobAStBase/man/PlotICWrapper.Rd
branches/robast-0.9/pkg/RobAStBase/man/mergelists.Rd
branches/robast-0.9/pkg/RobAStBase/man/rescaleFunction-methods.Rd
branches/robast-0.9/pkg/RobExtremes/R/rescaleFct.R
branches/robast-0.9/pkg/RobExtremes/man/GEVFamilyMuUnknown.Rd
branches/robast-0.9/pkg/RobExtremes/man/rescaleFunction-methods.Rd
Modified:
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperCont.R
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R
branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R
branches/robast-0.9/pkg/ROptEst/NAMESPACE
branches/robast-0.9/pkg/ROptEst/R/cniperCont.R
branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd
branches/robast-0.9/pkg/RobAStBase/NAMESPACE
branches/robast-0.9/pkg/RobAStBase/R/AllGeneric.R
branches/robast-0.9/pkg/RobAStBase/R/comparePlot.R
branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R
branches/robast-0.9/pkg/RobAStBase/man/comparePlot.Rd
branches/robast-0.9/pkg/RobAStBase/man/internal_plots.Rd
branches/robast-0.9/pkg/RobExtremes/NAMESPACE
branches/robast-0.9/pkg/RobExtremes/man/InternalReturnClasses-class.Rd
Log:
integrated Wrapper functions into RobAStBase, ROptEst, and RobExtremes
Modified: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -90,7 +90,7 @@
## with.legend - optional legend indicator
## withCall - optional indicator of the function call
#
-ICAllPlotWrapper = function(IC, y,...,alpha.trsp = 100, with.legend = TRUE, rescale = FALSE ,withCall = TRUE){
+PlotIC <- function(IC, y,...,alpha.trsp = 100, with.legend = TRUE, rescale = FALSE ,withCall = TRUE){
###
### 1. grab the dots (and manipulate it within the wrapper function)
###
Modified: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperCont.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperCont.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperCont.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -1,9 +1,3 @@
-.rescalefct <- RobAStBase:::.rescalefct
-.plotRescaledAxis <- RobAStBase:::.plotRescaledAxis
-.makedotsP <- RobAStBase:::.makedotsP
-.makedotsLowLevel <- RobAStBase:::.makedotsLowLevel
-.SelectOrderData <- RobAStBase:::.SelectOrderData
-
.plotData <- function(
## helper function for cniper-type plots to plot in data
data, # data to be plot in
Modified: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -73,7 +73,7 @@
## with.legend - optional legend indicator
## withCall - optional indicator of the function call
#
-cniperPointPlotWrapper = function(fam,...
+CniperPointPlot <- function(fam,...
,lower = getdistrOption("DistrResolution")
,upper=1-getdistrOption("DistrResolution")
,with.legend = TRUE, withCall = TRUE){
@@ -95,7 +95,10 @@
### graphics/diagnostics function;
##
- argsList <- list(L2Fam = substitute(fam)
+ ## Scaling of the axes
+ scaleList <- rescaleFunction(eval(IC at CallL2Fam), FALSE, mc$rescale)
+
+ argsList <- c(list(L2Fam = substitute(fam)
,data = substitute(NULL)
,neighbor = substitute(ContNeighborhood(radius = 0.5))
,risk = substitute(asMSE())
@@ -103,15 +106,7 @@
,upper = substitute(upper)
,n = substitute(101)
,withMaxRisk = substitute(TRUE)
- ,scaleX = substitute(FALSE)
- ,scaleX.fct = substitute(p(fam))
- ,scaleX.inv = substitute(q(fam))
- ,scaleY = substitute(FALSE)
- ,scaleY.fct = substitute(pnorm)
- ,scaleY.inv = substitute(qnorm)
,scaleN = substitute(9)
- ,x.ticks = substitute(NULL)
- ,y.ticks = substitute(NULL)
,cex.pts = substitute(1)
,col.pts = substitute(par("col"))
,pch.pts = substitute(1)
@@ -130,7 +125,7 @@
,xlab=substitute("Dirac point")
,ylab=substitute("Asymptotic Risk difference (classic - robust)")
,bty = substitute("o")
- )
+ ), scaleList)
##parameter for plotting
if(mc$with.legend)
Modified: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -91,7 +91,7 @@
## with.legend - optional legend indicator
## withCall - optional indicator of the function call
#
-infoPlotWrapper = function(IC, data,...,alpha.trsp = 100,with.legend = TRUE, rescale = FALSE ,withCall = TRUE){
+InfoPlot <- function(IC, data,...,alpha.trsp = 100,with.legend = TRUE, rescale = FALSE ,withCall = TRUE){
###
### 1. grab the dots (and manipulate it within the wrapper function)
###
@@ -124,7 +124,7 @@
##
## Scaling of the axes
- scaleList <- rescaleFunction(as.list(IC at CallL2Fam)[[1]], FALSE, mc$rescale)
+ scaleList <- rescaleFunction(eval(IC at CallL2Fam), FALSE, mc$rescale)
argsList <- c(list(object = substitute(IC)
,data = substitute(data)
Added: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/rescaleFunctionP.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/rescaleFunctionP.R (rev 0)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/rescaleFunctionP.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -0,0 +1,104 @@
+### rescale function
+
+## famName - text argument stating the name of the family for which
+## the rescaling is done
+## dataFlag - flag, whether the the data is plotted or not
+## rescaleFlag
+
+# function returns the list of rescaling arguments to be passed on the
+# corresponding diagnostic function
+
+if(!isGeneric("rescaleFunction")){
+ setGeneric("rescaleFunction", function(famName, ...)
+ standardGeneric("rescaleFunction"))
+}
+
+setMethod("rescalueFunction", signature(famName="ANY"),
+ function(famName, dataFlag){
+ if(dataFlag){
+ scaleList <- list(scaleX = substitute(FALSE)
+ ,scaleY = substitute(FALSE)
+ )
+ } else {
+ scaleList <- list(scaleX = substitute(FALSE)
+ ,scaleX.fct = substitute(p(eval(IC at CallL2Fam)))
+ ,scaleX.inv = substitute(q(eval(IC at CallL2Fam)))
+ ,scaleY = substitute(FALSE)
+ ,scaleY.fct = substitute(pnorm)
+ ,scaleY.inv=substitute(qnorm)
+ ,x.ticks = substitute(NULL)
+ ,y.ticks = substitute(NULL)
+ )
+ }
+
+ return(scaleList)}
+)
+
+setMethod("rescalueFunction", signature(famName="GParetoFamily"),
+ function(famName, dataFlag, rescaleFlag){
+ if(!rescaleFlag)
+ return(getMethod("rescalueFunction", "ANY")(famName,
+ dataFlag))
+ if(dataFlag){
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleY = substitute(TRUE)
+ )
+ } else {
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleX.fct = substitute(p(eval(IC at CallL2Fam)))
+ ,scaleX.inv = substitute(q(eval(IC at CallL2Fam)))
+ ,scaleY = substitute(TRUE)
+ ,scaleY.fct = substitute(pnorm)
+ ,scaleY.inv = substitute(qnorm)
+ ,x.ticks = substitute(NULL)
+ ,y.ticks = substitute(NULL)
+ )
+ }
+ return(scaleList)
+})
+
+setMethod("rescalueFunction", signature(famName="GEVFamily"),
+ function(famName, dataFlag, rescaleFlag){
+ if(!rescaleFlag)
+ return(getMethod("rescalueFunction", "ANY")(famName,
+ dataFlag, rescaleFlag))
+ if(dataFlag){
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleY = substitute(TRUE)
+ )
+ } else {
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleX.fct = substitute(p(eval(IC at CallL2Fam)))
+ ,scaleX.inv = substitute(q(eval(IC at CallL2Fam)))
+ ,scaleY = substitute(TRUE)
+ ,scaleY.fct = substitute(pnorm)
+ ,scaleY.inv = substitute(qnorm)
+ ,x.ticks = substitute(NULL)
+ ,y.ticks = substitute(NULL)
+ )
+ }
+ return(scaleList)
+})
+
+setMethod("rescalueFunction", signature(famName="GEVFamilyUnknownMu"),
+ function(famName, dataFlag, rescaleFlag){
+ if(!rescaleFlag)
+ return(getMethod("rescalueFunction", "ANY")(famName,
+ dataFlag, rescaleFlag))
+ if(dataFlag){
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleY = substitute(TRUE)
+ )
+ } else {
+ scaleList <- list(scaleX = substitute(TRUE)
+ ,scaleX.fct = substitute(p(eval(IC at CallL2Fam)))
+ ,scaleX.inv = substitute(q(eval(IC at CallL2Fam)))
+ ,scaleY = substitute(TRUE)
+ ,scaleY.fct = substitute(pnorm)
+ ,scaleY.inv = substitute(qnorm)
+ ,x.ticks = substitute(NULL)
+ ,y.ticks = substitute(NULL)
+ )
+ }
+ return(scaleList)
+})
Added: branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/zusaetzlicheBsp.R
===================================================================
--- branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/zusaetzlicheBsp.R (rev 0)
+++ branches/robast-0.9/pkg/13.07.16 - Wrapper for RobAStBase, RobExtremes/zusaetzlicheBsp.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -0,0 +1,90 @@
+#' # GPD
+#' fam = GParetoFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' data = r(Y)(1000)
+#' InfoPlot(IC, data, withCall = FALSE)
+#'
+#' # GEV
+#' fam = GEVFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' data = r(Y)(1000)
+#' InfoPlot(IC, data, rescale = TRUE, withCall = FALSE)
+#'
+#' # Weibull
+#' fam = WeibullFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' data = r(Y)(1000)
+#' InfoPlot(IC, data, withCall = FALSE)
+#' # GPD
+#' fam = GParetoFamily()
+#' CniperPointPlot(fam=fam, main = "GPD", lower = 0, upper = 10, withCall = FALSE)
+#' # GEV
+#' fam = GEVFamily()
+#' CniperPointPlot(fam=fam, main = "GEV", lower = 0, upper = 5, withCall = FALSE)
+#' # Gamma
+#' fam = GammaFamily()
+#' CniperPointPlot(fam=fam, main = "Gamma", lower = 0, upper = 5, withCall = FALSE)
+#' # Weibull
+#' fam = WeibullFamily()
+#' CniperPointPlot(fam=fam, main = "Weibull", withCall = FALSE)
+#' @examples
+#' # GPD
+#' fam = GParetoFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' PlotIC(IC, y, withCall = FALSE)
+#'
+#' # GEV
+#' fam = GEVFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' PlotIC(IC, y, rescale = TRUE, withCall = FALSE)
+#'
+#' # Gamma
+#' fam = GammaFamily()
+#' rfam = InfRobModel(fam, ContNeighborhood(0.5))
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' PlotIC(IC, y, withCall = FALSE)
+#'
+#' # Weibull
+#' fam = WeibullFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' PlotIC(IC, y, withCall = FALSE)
+#' @examples
+#' # GPD
+#' fam = GParetoFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' ComparePlot(IC, y, withCall = FALSE)
+#'
+#' # GEV
+#' fam = GEVFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' ComparePlot(IC, y, rescale = TRUE, withCall = FALSE)
+#'
+#' # Gamma
+#' fam = GammaFamily()
+#' rfam = InfRobModel(fam, ContNeighborhood(0.5))
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' ComparePlot(IC, y, withCall = FALSE)
+#'
+#' # Weibull
+#' fam = WeibullFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y=distribution(fam)
+#' y = r(Y)(1000)
+#' ComparePlot(IC, y, withCall = FALSE)
Modified: branches/robast-0.9/pkg/ROptEst/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/ROptEst/NAMESPACE 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/ROptEst/NAMESPACE 2013-09-10 22:13:29 UTC (rev 688)
@@ -38,4 +38,5 @@
export("genkStepCtrl", "genstartCtrl", "gennbCtrl")
export("cniperCont", "cniperPoint", "cniperPointPlot")
export(".generateInterpGrid",".getLMGrid",".saveGridToCSV", ".readGridFromCSV")
-export(".RMXE.th",".OMSE.th", ".MBRE.th")
\ No newline at end of file
+export(".RMXE.th",".OMSE.th", ".MBRE.th")
+export("CniperPointPlot")
\ No newline at end of file
Modified: branches/robast-0.9/pkg/ROptEst/R/cniperCont.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/cniperCont.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/ROptEst/R/cniperCont.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -100,7 +100,7 @@
scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
scaleN = 9, x.ticks = NULL, y.ticks = NULL,
cex.pts = 1, col.pts = par("col"),
- pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ 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){
@@ -215,12 +215,12 @@
scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
scaleN = 9, x.ticks = NULL, y.ticks = NULL,
cex.pts = 1, col.pts = par("col"),
- pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ 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(call = sys.call(sys.parent(1)),
+ mc <- match.call(#call = sys.call(sys.parent(1)),
expand.dots = FALSE)
mcl <- as.list(mc[-1])
dots <- as.list(mc$"...")
Added: branches/robast-0.9/pkg/ROptEst/R/plotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/ROptEst/R/plotWrapper.R (rev 0)
+++ branches/robast-0.9/pkg/ROptEst/R/plotWrapper.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -0,0 +1,141 @@
+################################################################################
+
+##########################################
+## ##
+## Wrapper for cniperPointPlot.R ##
+## ##
+## ##
+##########################################
+
+##############################################################
+#' Wrapper function for cniperPointPlot - Computation and Plot
+#' of Cniper Contamination and Cniper Points
+#'
+#' The wrapper takes most of arguments to the cniperPointPlot
+#' function by default and gives a user possibility to run the
+#' function with low number of arguments
+#'
+#' @param fam object of class L2ParamFamily
+#'
+#' @param ... additional parameters (in particular to be passed on to \code{plot})
+#'
+#' @param lower the lower end point of the contamination interval
+#'
+#' @param upper the upper end point of the contamination interval
+#'
+#' @param rescale the flag for rescaling the axes for better view of the plot
+#'
+#' @param with.legend the flag for showing the legend of the plot
+#'
+#' @param withCall the flag for the call output
+#'
+#' @return invisible(NULL)
+#
+#' @section Details: Calls \code{cniperPointPlot} with suitably chosen defaults; if \code{withCall == TRUE}, the call to \code{cniperPointPlot} is returned.
+#'
+#' @export
+#' @rdname CniperPointPlotWrapper
+#'
+#' @examples
+#' fam <- GammaFamily()
+#' CniperPointPlot(fam=fam, main = "Gamma", lower = 0, upper = 5, withCall = FALSE)
+##############################################################
+
+##@fam - parameter family
+## lower - left point of the x-axis
+## upper - right point of the x-axis
+## alpha.trsp - optional transparency of the plot
+## with.legend - optional legend indicator
+## withCall - optional indicator of the function call
+#
+CniperPointPlot <- function(fam,...
+ ,lower = getdistrOption("DistrResolution")
+ ,upper=1-getdistrOption("DistrResolution")
+ ,with.legend = TRUE
+ ,rescale = FALSE
+ ,withCall = TRUE){
+ ###
+ ### 1. grab the dots (and manipulate it within the wrapper function)
+ ###
+ ###
+ ### do something to fix the good default arguments
+ ###
+ mc <- as.list(match.call(expand.dots = FALSE))[-1]
+ dots <- mc$"..."
+ if(is.null(mc$lower)) lower <- getdistrOption("DistrResolution")
+ if(is.null(mc$upper)) upper <- 1-getdistrOption("DistrResolution")
+ if(is.null(mc$with.legend)) mc$with.legend <- TRUE
+ if(is.null(mc$withCall)) mc$withCall <- TRUE
+ if(missing(fam)) stop("Argument 'fam' must be given as argument to 'CniperPointPlot'")
+ ###
+ ### 2. build up the argument list for the (powerful/fullfledged)
+ ### graphics/diagnostics function;
+ ##
+
+ ## Scaling of the axes
+ print(fam)
+ scaleList <- rescaleFunction(fam, FALSE, rescale)
+ print(scaleList)
+
+ argsList <- c(list(L2Fam = substitute(fam)
+ ,data = substitute(NULL)
+ ,neighbor = substitute(ContNeighborhood(radius = 0.5))
+ ,risk = substitute(asMSE())
+ ,lower = substitute(lower)
+ ,upper = substitute(upper)
+ ,n = substitute(101)
+ ,withMaxRisk = substitute(TRUE)
+ ,scaleN = substitute(9)
+ ,cex.pts = substitute(1)
+ ,col.pts = substitute(par("col"))
+ ,pch.pts = substitute(19)
+ ,jitter.fac = substitute(1)
+ ,with.lab = substitute(FALSE)
+ ,lab.pts = substitute(NULL)
+ ,lab.font = substitute(NULL)
+ ,alpha.trsp = substitute(NA)
+ ,which.lbs = substitute(NULL)
+ ,which.Order = substitute(NULL)
+ ,return.Order = substitute(FALSE)
+ ,adj = 0.5
+ ,cex.main = substitute(1.5)
+ ,cex.lab = substitute(1.5)
+ ,main = ""#"Outlyingness Plot"
+ ,xlab=substitute("Dirac point")
+ ,ylab=substitute("Asymptotic Risk difference (classic - robust)")
+ ,bty = substitute("o")
+ ), scaleList)
+ print(argsList)
+ ##parameter for plotting
+ if(mc$with.legend)
+ {
+ argsList$col.main <- "black"
+ argsList$col.lab <- "black"
+ }
+ else
+ {
+ argsList$col.main <- "white"
+ argsList$col.lab <- "white"
+ }
+
+ args <- .merge.lists(argsList, dots)
+ print(args)
+ ###
+ ### 3. build up the call but grab it and write it into an object
+ ###
+ cl <- substitute(do.call(cniperPointPlot,args0), list(args0=args))
+ ### manipulate it so that the wrapper do.call is ommitted
+ cl0 <- as.list(cl)[-1]
+ mycall <- c(cl0[1],unlist(cl0[-1]))
+ mycall <- as.call(mycall)
+ ###
+ ### 4. evaluate the call (i.e., produce the graphic)
+ ###
+ eval(mycall)
+ ###
+ ### 5. return the call (if withCall==TRUE)
+ ###
+ if(mc$withCall) print(mycall)
+
+}
+#CniperPointPlot(fam=fam, main = "Gamma", lower = 0, upper = 5, withCall = FALSE)
Added: branches/robast-0.9/pkg/ROptEst/man/CniperPointPlotWrapper.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/CniperPointPlotWrapper.Rd (rev 0)
+++ branches/robast-0.9/pkg/ROptEst/man/CniperPointPlotWrapper.Rd 2013-09-10 22:13:29 UTC (rev 688)
@@ -0,0 +1,48 @@
+\name{CniperPointPlot}
+\alias{CniperPointPlot}
+\title{Wrapper function for cniperPointPlot - Computation and Plot
+ of Cniper Contamination and Cniper Points}
+\usage{
+ CniperPointPlot(fam, ...,
+ lower = getdistrOption("DistrResolution"),
+ upper = 1 - getdistrOption("DistrResolution"),
+ with.legend = TRUE, rescale = FALSE, withCall = TRUE)
+}
+\arguments{
+ \item{fam}{object of class L2ParamFamily}
+
+ \item{...}{additional parameters (in particular to be
+ passed on to \code{plot})}
+
+ \item{lower}{the lower end point of the contamination
+ interval}
+
+ \item{upper}{the upper end point of the contamination
+ interval}
+
+ \item{with.legend}{the flag for showing the legend of the
+ plot}
+
+ \item{rescale}{the flag for rescaling the axes for better view of the plot}
+
+ \item{withCall}{the flag for the call output}
+}
+\value{
+ invisible(NULL)
+}
+\description{
+ The wrapper takes most of arguments to the
+ cniperPointPlot function by default and gives a user
+ possibility to run the function with low number of
+ arguments
+}
+\section{Details}{
+ Calls \code{cniperPointPlot} with suitably chosen
+ defaults; if \code{withCall == TRUE}, the call to
+ \code{cniperPointPlot} is returned.
+}
+\examples{
+L2fam <- GammaFamily()
+CniperPointPlot(fam=L2fam, main = "Gamma", lower = 0, upper = 5, withCall = FALSE)
+}
+
Modified: branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd
===================================================================
--- branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/ROptEst/man/cniperCont.Rd 2013-09-10 22:13:29 UTC (rev 688)
@@ -18,7 +18,7 @@
scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
scaleN = 9, x.ticks = NULL, y.ticks = NULL,
cex.pts = 1, col.pts = par("col"),
- pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ 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)
@@ -34,7 +34,7 @@
scaleY = FALSE, scaleY.fct = pnorm, scaleY.inv=qnorm,
scaleN = 9, x.ticks = NULL, y.ticks = NULL,
cex.pts = 1, col.pts = par("col"),
- pch.pts = 1, jitter.fac = 1, with.lab = FALSE,
+ 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)
Modified: branches/robast-0.9/pkg/RobAStBase/NAMESPACE
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/NAMESPACE 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/RobAStBase/NAMESPACE 2013-09-10 22:13:29 UTC (rev 688)
@@ -60,7 +60,8 @@
exportMethods("pICList","ICList", "ksteps", "uksteps",
"start", "startval", "ustartval")
exportMethods("moveL2Fam2RefParam",
- "moveICBackFromRefParam")
+ "moveICBackFromRefParam",
+ "rescaleFunction")
exportMethods("ddPlot", "qqplot")
exportMethods("cutoff.quantile", "cutoff.quantile<-")
exportMethods("samplesize<-", "samplesize")
@@ -75,3 +76,6 @@
export("outlyingPlotIC", "RobAStBaseMASK")
export("OMSRRisk","MBRRisk","RMXRRisk")
export("getRiskFctBV")
+export(".rescalefct",".plotRescaledAxis",".makedotsP",".makedotsLowLevel",".SelectOrderData")
+export(".merge.lists")
+export("InfoPlot", "ComparePlot", "PlotIC")
\ No newline at end of file
Modified: branches/robast-0.9/pkg/RobAStBase/R/AllGeneric.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/AllGeneric.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/RobAStBase/R/AllGeneric.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -235,3 +235,8 @@
setGeneric("moveICBackFromRefParam", function(IC, L2Fam, ...)
standardGeneric("moveICBackFromRefParam"))
}
+
+if(!isGeneric("rescaleFunction")){
+ setGeneric("rescaleFunction", function(L2Fam, ...)
+ standardGeneric("rescaleFunction"))
+}
Modified: branches/robast-0.9/pkg/RobAStBase/R/comparePlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/comparePlot.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/RobAStBase/R/comparePlot.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -1,6 +1,7 @@
setMethod("comparePlot", signature("IC","IC"),
function(obj1,obj2, obj3 = NULL, obj4 = NULL, data = NULL,
..., withSweave = getdistrOption("withSweave"),
+ forceSameModel = FALSE,
main = FALSE, inner = TRUE, sub = FALSE,
col = par("col"), lwd = par("lwd"), lty,
col.inner = par("col.main"), cex.inner = 0.8,
@@ -32,6 +33,9 @@
ncomp <- 2+ (!missing(obj3)|!is.null(obj3)) +
(!missing(obj4)|!is.null(obj4))
+ if(missing(cex.pts)) cex.pts <- 1
+ cex.pts <- rep(cex.pts, length.out= ncomp)
+
if(missing(col)) col <- 1:ncomp
else col <- rep(col, length.out = ncomp)
if(missing(lwd)) lwd <- rep(1,ncomp)
@@ -45,6 +49,7 @@
dots$xlab <- dots$ylab <- NULL
L2Fam <- eval(obj1 at CallL2Fam)
+ if(forceSameModel)
if(!identical(CallL2Fam(obj1),CallL2Fam(obj2)))
stop("ICs need to be defined for the same model")
@@ -127,12 +132,14 @@
IC2 <- as(ID %*% obj2 at Curve, "EuclRandVariable")
if(is(obj3, "IC")){
+ if(forceSameModel)
if(!identical(CallL2Fam(obj1),CallL2Fam(obj3)))
stop("ICs need to be defined for the same model")
IC3 <- as(ID %*% obj3 at Curve, "EuclRandVariable")
}
if(is(obj4, "IC")){
+ if(forceSameModel)
if(!identical(CallL2Fam(obj1),CallL2Fam(obj4)))
stop("ICs need to be defined for the same model")
IC4 <- as(ID %*% obj4 at Curve, "EuclRandVariable")
Modified: branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R 2013-09-09 09:18:10 UTC (rev 687)
+++ branches/robast-0.9/pkg/RobAStBase/R/infoPlot.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -393,8 +393,8 @@
scaleX, scaleX.fct, scaleX.inv,
FALSE, scaleY.fct, dots$xlim, dots$ylim, dotsP0)
- f1 <- resc.rel$scy*3*cex0[1]
- f1c <- resc.rel.c$scy*3*cex0[2]
+ f1 <- resc.rel$scy*0.3*cex0[1]
+ f1c <- resc.rel.c$scy*0.3*cex0[2]
do.pts(resc.rel$X, resc.rel$Y, f1,col.pts[1],pch0[,1])
do.pts(resc.rel.c$X, resc.rel.c$Y, f1c,col.pts[2],pch0[,2])
Added: branches/robast-0.9/pkg/RobAStBase/R/plotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/RobAStBase/R/plotWrapper.R (rev 0)
+++ branches/robast-0.9/pkg/RobAStBase/R/plotWrapper.R 2013-09-10 22:13:29 UTC (rev 688)
@@ -0,0 +1,557 @@
+##########################################
+## ##
+## Wrapper for infoPlot.R ##
+## (infoPlot method for IC) ##
+## ##
+##########################################
+
+##############################################################
+#' Merging Lists
+#'
+#' \code{.merge.lists} takes two lists and merges them.
+#'
+#' @param a the first list
+#'
+#' @param b the second list
+#'
+#' @return the merged list
+#'
+#' @keywords internal
+#' @rdname mergelists
+#'
+##############################################################
+
+### aditional function
+.merge.lists <- function(a, b){
+ a.names <- names(a)
+ b.names <- names(b)
+ m.names <- sort(unique(c(a.names, b.names), fromLast = TRUE))
+ sapply(m.names, function(i) {
+ if (is.list(a[[i]]) & is.list(b[[i]])) .merge.lists(a[[i]], b[[i]])
+ else if (i %in% b.names) b[[i]]
+ else a[[i]]
+ }, simplify = FALSE)
+}
+
+##############################################################
+#' Wrapper function for information plot method
+#'
+#' The wrapper takes most of arguments to the plot method
+#' by default and gives a user possibility to run the
+#' function with low number of arguments
+#'
+#' @param IC object of class \code{IC}
+#'
+#' @param data optional data argument --- for plotting observations into the plot
+#'
+#' @param ... additional parameters (in particular to be passed on to \code{plot})
+#'
+#' @param alpha.trsp the transparency argument (0 to 100) for ploting the data
+#'
+#' @param with.legend the flag for showing the legend of the plot
+#'
+#' @param rescale the flag for rescaling the axes for better view of the plot
+#'
+#' @param withCall the flag for the call output
+#'
+#' @return invisible(NULL)
+#
+#' @section Details: Calls \code{infoPlot} with suitably chosen defaults. If \code{withCall == TRUE}, the call to \code{infoPlot} is returned
+#'
+#' @export
+#' @rdname InfoPlotWrapper
+#'
+#'
+#' @examples
+#' # Gamma
+#' fam <- GammaFamily()
+#' IC <- optIC(model = fam, risk = asCov())
+#' Y <- distribution(fam)
+#' data <- r(Y)(1000)
+#' InfoPlot(IC, data, withCall = FALSE)
+#'
+##############################################################
+
+##IC - influence curve
+##data - dataset
+## with.legend - optional legend indicator
+## withCall - optional indicator of the function call
+#
+InfoPlot <- function(IC, data,...,alpha.trsp = 100,with.legend = TRUE, rescale = FALSE ,withCall = TRUE){
+ ###
+ ### 1. grab the dots (and manipulate it within the wrapper function)
+ ###
+ ###
+ ### do something to fix the good default arguments
+ ###
+ if(missing(IC)) stop("Argument 'IC' must be given as argument to 'InfoPlot'")
+ if(missing(data)) data <- NULL
+ mc <- as.list(match.call(expand.dots = FALSE))[-1]
+ dots <- mc$"..."
+ if(missing(data)){
+ alpha.trsp <- 100
+ } else {
+ if(is.null(mc$alpha.trsp)){
+ alpha.trsp <- 30
+ if(length(data) < 1000){
+ alpha.trsp <- 50
+ }
+ if(length(data) < 100){
+ alpha.trsp <- 100
+ }
+ }
+ }
+ if(is.null(mc$with.legend)) mc$with.legend <- TRUE
+ if(is.null(mc$rescale)) mc$rescale <- FALSE
+ if(is.null(mc$withCall)) mc$withCall <- TRUE
+ ###
+ ### 2. build up the argument list for the (powerful/fullfledged)
+ ### graphics/diagnostics function;
+ ##
+
+ ## Scaling of the axes
+ scaleList <- rescaleFunction(eval(IC at CallL2Fam), FALSE, mc$rescale)
+
+ argsList <- c(list(object = substitute(IC)
+ ,data = substitute(data)
+ ,withSweave = substitute(getdistrOption("withSweave"))
+ ,lwd = substitute(par("lwd"))
+ ,lty = substitute("solid")
+ ,colI = substitute(grey(0.5))
+ ,lwdI = substitute(0.7*par("lwd"))
+ ,ltyI = substitute("dotted")
+ ,main = substitute(FALSE)
+ ,inner = substitute(TRUE)
+ ,sub = substitute(FALSE)
+ ,col.inner = substitute(par("col.main"))
+ ,cex.inner = substitute(0.8)
+ ,bmar = substitute(par("mar")[1])
+ ,tmar = substitute(par("mar")[3])
+ ,with.legend = substitute(TRUE)
+ ,legend = substitute(NULL)
+ ,legend.bg = substitute("white")
+ ,legend.location = substitute("bottomright")
+ ,legend.cex = substitute(0.8)
+ ,scaleN = substitute(9)
+ ,mfColRow = substitute(TRUE)
+ ,to.draw.arg = substitute(NULL)
+ ,cex.pts = substitute(1)
+ ,col.pts = substitute(addAlphTrsp2col(rgb(0,255,0,maxColorValue=255), substitute(alpha.trsp)))
+ ,pch.pts = substitute(19)
+ ,jitter.fac = substitute(1)
+ ,with.lab = substitute(FALSE)
+ ,lab.pts = substitute(NULL)
+ ,lab.font = substitute(NULL)
+ ,alpha.trsp = substitute(NA)
+ ,which.lbs = substitute(NULL)
+ ,which.Order = substitute(NULL)
+ ,return.Order = substitute(FALSE)
+ ,ylab.abs = substitute("absolute information")
+ ,ylab.rel= substitute("relative information")
+ ,adj = substitute(0.5)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 688
More information about the Robast-commits
mailing list