[Robast-commits] r679 - branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 17 09:28:20 CEST 2013
Author: pupashenko
Date: 2013-07-17 09:28:20 +0200 (Wed, 17 Jul 2013)
New Revision: 679
Modified:
branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R
branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R
branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R
branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R
Log:
Update zu Wrappern
Modified: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-07-13 10:17:14 UTC (rev 678)
+++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/ICAllPlotWrapper.R 2013-07-17 07:28:20 UTC (rev 679)
@@ -5,6 +5,18 @@
## ##
##########################################
+### 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)
+}
+
##IC - influence curve
##y - dataset
## with.legend - optional legend indicator
@@ -134,8 +146,6 @@
), scaleList)
}
-
-
##parameter for plotting
if(mc$with.legend)
{
@@ -148,7 +158,7 @@
argsList$col.lab <- "white"
}
- args <- c(argsList, dots)
+ args <- merge.lists(argsList, dots)
###
### 3. build up the call but grab it and write it into an object
###
@@ -177,38 +187,42 @@
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
y = r(Y)(1000)
+# dev.new()
+# ICAllPlotWrapper(IC, with.legend = FALSE)
dev.new()
-ICAllPlotWrapper(IC, with.legend = FALSE)
-dev.new()
-ICAllPlotWrapper(IC, y, with.legend = FALSE)
+ICAllPlotWrapper(IC, y, withCall = FALSE)
# GEV
fam = GEVFamily()
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
y = r(Y)(1000)
+# dev.new()
+# ICAllPlotWrapper(IC, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
dev.new()
-ICAllPlotWrapper(IC, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
-dev.new()
-ICAllPlotWrapper(IC, y, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
+ICAllPlotWrapper(IC, y, rescale = TRUE, withCall = FALSE)
# Gamma
fam = GammaFamily()
+rfam = InfRobModel(fam, ContNeighborhood(0.5))
IC <- optIC(model = fam, risk = asCov())
+# ICr <- optIC(model = rfam, risk = asBias())
Y=distribution(fam)
y = r(Y)(1000)
+# dev.new()
+# ICAllPlotWrapper(IC)
+# dev.new()
+# ICAllPlotWrapper(ICr)
dev.new()
-ICAllPlotWrapper(IC)
-dev.new()
-ICAllPlotWrapper(IC, y)
+ICAllPlotWrapper(IC, y, withCall = FALSE)
# Weibull
fam = WeibullFamily()
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
y = r(Y)(1000)
+# dev.new()
+# ICAllPlotWrapper(IC, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
dev.new()
-ICAllPlotWrapper(IC, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
-dev.new()
-ICAllPlotWrapper(IC, y, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
+ICAllPlotWrapper(IC, y, withCall = FALSE)
Modified: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R 2013-07-13 10:17:14 UTC (rev 678)
+++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperPointPlotWrapper.R 2013-07-17 07:28:20 UTC (rev 679)
@@ -5,6 +5,18 @@
## ##
##########################################
+### 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)
+}
+
##@fam - parameter family
## lower - left point of the x-axis
## upper - right point of the x-axis
@@ -82,7 +94,7 @@
argsList$col.lab <- "white"
}
- args <- c(argsList, dots)
+ args <- merge.lists(argsList, dots)
###
### 3. build up the call but grab it and write it into an object
###
@@ -107,25 +119,27 @@
require(distr)
# WRite the correct path to the modified file cniperCont.R from the ROptEst package
-source("D:/Dropbox/My Mathematics/Researches Misha/Current Research/11.06 - KL PhD/PhD Thesis/Reports for Project/13.05.31 - Wrapper for RobAStBase, RobExtremes/cniperCont.R")
+source("D:/Dropbox/My Mathematics/Researches Misha/Current Research/11.06 - KL PhD/PhD Thesis/Reports for Project/13.07.16 - Wrapper for RobAStBase, RobExtremes/cniperCont.R")
# GPD
dev.new()
fam = GParetoFamily()
-cniperPointPlotWrapper(fam=fam, lower = 0, upper = 10, with.legend = FALSE)
+cniperPointPlotWrapper(fam=fam, main = "GPD", lower = 0, upper = 10, withCall = FALSE)
# GEV
dev.new()
fam = GEVFamily()
-cniperPointPlotWrapper(fam=fam, lower = 0, upper = 5, with.legend = TRUE, withCall = TRUE)
+cniperPointPlotWrapper(fam=fam, main = "GEV", lower = 0, upper = 5, withCall = FALSE)
# Gamma
dev.new()
fam = GammaFamily()
-cniperPointPlotWrapper(fam=fam, lower = 0, upper = 5)
+cniperPointPlotWrapper(fam=fam, main = "Gamma", lower = 0, upper = 5, withCall = FALSE)
# Weibull
dev.new()
fam = WeibullFamily()
-cniperPointPlotWrapper(fam=fam, with.legend = TRUE, withCall = FALSE)
+cniperPointPlotWrapper(fam=fam, main = "Weibull", withCall = FALSE)
+
+
Modified: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R 2013-07-13 10:17:14 UTC (rev 678)
+++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/infoPlotWrapper.R 2013-07-17 07:28:20 UTC (rev 679)
@@ -5,6 +5,18 @@
## ##
##########################################
+### 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)
+}
+
##IC - influence curve
##data - dataset
## with.legend - optional legend indicator
@@ -109,9 +121,6 @@
,panel.first= substitute(grid())
,col = substitute("blue")
), scaleList)
-
-
-
##parameter for plotting
if(mc$with.legend)
@@ -125,7 +134,7 @@
argsList$col.lab <- "white"
}
- args <- c(argsList, dots)
+ args <- merge.lists(argsList, dots)
###
### 3. build up the call but grab it and write it into an object
###
@@ -154,10 +163,10 @@
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
data = r(Y)(1000)
+# dev.new()
+# infoPlotWrapper(IC, alpha.trsp=30, with.legend = FALSE)
dev.new()
-infoPlotWrapper(IC, alpha.trsp=30, with.legend = FALSE)
-dev.new()
-infoPlotWrapper(IC, data, alpha.trsp=30, with.legend = FALSE)
+infoPlotWrapper(IC, data, withCall = FALSE)
# GEV
@@ -165,29 +174,29 @@
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
data = r(Y)(1000)
+# dev.new()
+# infoPlotWrapper(IC, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
dev.new()
-infoPlotWrapper(IC, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
-dev.new()
-infoPlotWrapper(IC, data, alpha.trsp=100, with.legend = TRUE, rescale = TRUE, withCall = TRUE)
+infoPlotWrapper(IC, data, rescale = TRUE, withCall = FALSE)
# Gamma
fam = GammaFamily()
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
data = r(Y)(1000)
+# dev.new()
+# infoPlotWrapper(IC)
dev.new()
-infoPlotWrapper(IC)
-dev.new()
-infoPlotWrapper(IC, data)
+infoPlotWrapper(IC, data, withCall = FALSE)
# Weibull
fam = WeibullFamily()
IC <- optIC(model = fam, risk = asCov())
Y=distribution(fam)
data = r(Y)(1000)
+# dev.new()
+# infoPlotWrapper(IC, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
dev.new()
-infoPlotWrapper(IC, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
-dev.new()
-infoPlotWrapper(IC, data, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
+infoPlotWrapper(IC, data, withCall = FALSE)
Modified: branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R
===================================================================
--- branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R 2013-07-13 10:17:14 UTC (rev 678)
+++ branches/robast-0.9/pkg/13.05.31 - Wrapper for RobAStBase, RobExtremes/outlyingPlotWrapper.R 2013-07-17 07:28:20 UTC (rev 679)
@@ -5,6 +5,18 @@
## ##
##########################################
+### 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)
+}
+
## projection distance
qfun = function(x){p0 = p(X)(x); q0 = q(X)(p0)}
QProj <- function(){new("NormType", name="Quantiles", fct=qfun)}
@@ -95,7 +107,7 @@
argsList$col.lab <- "white"
}
- args <- c(argsList, dots)
+ args <- merge.lists(argsList, dots)
###
### 3. build up the call but grab it and write it into an object
###
@@ -124,26 +136,25 @@
fam = GParetoFamily()
X=distribution(fam)
x = r(X)(1000)
-outlyingPlotWrapper(x,alpha=0.99,fam=fam, alpha.trsp=50, with.legend = FALSE)
+outlyingPlotWrapper(x,alpha=0.99,fam=fam, main = "GPD", withCall = FALSE)
# GEV
dev.new()
fam = GEVFamily()
X=distribution(fam)
x = r(X)(1000)
-outlyingPlotWrapper(x,alpha=0.95,fam=fam, with.legend = TRUE, withCall = TRUE)
+outlyingPlotWrapper(x,alpha=0.95,fam=fam, main = "GEV", withCall = FALSE)
# Gamma
dev.new()
fam = GammaFamily()
X=distribution(fam)
x = r(X)(1000)
-outlyingPlotWrapper(x,alpha=0.95,fam=fam, alpha.trsp=70)
+outlyingPlotWrapper(x,alpha=0.95,fam=fam, main = "Gamma", withCall = FALSE)
# Weibull
dev.new()
fam = WeibullFamily()
X=distribution(fam)
x = r(X)(1000)
-outlyingPlotWrapper(x,alpha=0.95,fam=fam, alpha.trsp=30, with.legend = TRUE, withCall = FALSE)
-
+outlyingPlotWrapper(x,alpha=0.95,fam=fam, main = "Weibull", withCall = FALSE)
More information about the Robast-commits
mailing list