[Robast-commits] r646 - in branches/robast-0.9/pkg/RobExtremes: R inst/AddMaterial/interpolation
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 16 22:11:48 CEST 2013
Author: ruckdeschel
Date: 2013-04-16 22:11:48 +0200 (Tue, 16 Apr 2013)
New Revision: 646
Modified:
branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R
branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
Log:
RobExtremes: fixed a bug in internal-getpsi.R (inner centering was wrong!);
enhanced plotLM in plotInterpol.R (in inst/AddMaterial/interpolation/)
Modified: branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2013-04-16 20:09:24 UTC (rev 645)
+++ branches/robast-0.9/pkg/RobExtremes/R/GParetoFamily.R 2013-04-16 20:11:48 UTC (rev 646)
@@ -23,6 +23,7 @@
## generating function
## loc: known/fixed threshold/location parameter
+## -------------------------------------
## scale: scale parameter
## shape: shape parameter
## of.interest: which parameters, transformations are of interest
Modified: branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-04-16 20:09:24 UTC (rev 645)
+++ branches/robast-0.9/pkg/RobExtremes/R/internal-getpsi.R 2013-04-16 20:11:48 UTC (rev 646)
@@ -16,10 +16,10 @@
#print(get("k",environment(get("Lambda1", environment(L2deriv[[1]]@Map[[1]])))))
#print(get("sc",environment(get("Lambda1", environment(L2deriv[[1]]@Map[[1]])))))
- .dbeta <- diag(c(beta,1))
+ .dbeta <- diag(c(beta,1)); .dbeta1 <- diag(c(1/beta,1))
b <- fct[[1]](xi)
a <- c(.dbeta%*%c(fct[[2]](xi),fct[[3]](xi)))
- aw <- c(.dbeta%*%c(fct[[4]](xi),fct[[5]](xi)))
+ aw <- c(.dbeta1%*%c(fct[[4]](xi),fct[[5]](xi)))
am <- mean(c(fct[[7]](xi),fct[[8]](xi)))
A <- .dbeta%*%matrix(c(fct[[6]](xi),am,am,fct[[9]](xi)),2,2)%*%.dbeta
am <- mean(c(fct[[11]](xi),fct[[12]](xi)))
Modified: branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R
===================================================================
--- branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-04-16 20:09:24 UTC (rev 645)
+++ branches/robast-0.9/pkg/RobExtremes/inst/AddMaterial/interpolation/plotInterpol.R 2013-04-16 20:11:48 UTC (rev 646)
@@ -1,7 +1,9 @@
+.MakeSmoothGridList <- RobExtremes:::.MakeSmoothGridList
plotLM <- function(Gridnam,Famnam,whichLM, baseDir="C:/rtest/robast",
withSmooth = FALSE, plotGridRestriction = NULL,
smoothtry = FALSE, df = NULL, gridRestrForSmooth = NULL,
- prehook={}, posthook={}, ...){
+ prehook={}, posthook={}, ylab=NULL, xlab=NULL, main = NULL,
+ lwd=NULL, lty= NULL, col =NULL, inputSmooth = FALSE, ...){
## Gridnam in (Sn,OMSE,RMXE,MBRE) ## uses partial matching!!
## Famnam in "Generalized Pareto Family", ## uses partial matching!!
## "GEV Family",
@@ -23,7 +25,8 @@
## like pdf("myfile.pdf")
## posthook: an expression to be evaluated after plotting --- typically something
## like dev.off()
- ## withSmooth: logical; shall item grid or gridS be used for plotting
+ ## withSmooth: logical; shall item grid or gridS be used for plotting / smoothing
+ ## this way smoothing can be split up in several steps
## ---------------------------
### for interactive try-out of several smoothing values
##
@@ -32,6 +35,7 @@
## df: smoothing parameter (see below)
## gridRestrForSmooth: restriction of smoothing for particular theta-grid-values
## (see below)
+ ## ylab, xlab, lty, lwd, col parameters for plot (or NULL, then defaults are used)
###
## copied from help to .MakeSmoothGridList
##
@@ -50,6 +54,7 @@
# with columnwise restrictions of \code{Y} (and \code{NULL} entries
# are interpreted as no restriction). }
+# file <- file.path(baseDir, "branches/robast-0.9/pkg/RobExtremesBuffer/sysdata.rda")
file <- file.path(baseDir, "branches/robast-0.9/pkg/RobAStRDA/R/sysdata.rda")
if(!file.exists(file)) stop("Fehler mit Checkout")
nE <- new.env()
@@ -68,27 +73,52 @@
GN0 <- Gridnam; if(isSn) GN0 <- "SnGrids"
GN <- paste(".",GN0,sep="")
funN <- paste("fun",".",if(getRversion()<"2.16") "O" else "N",sep="")
- if(!smoothtry){
- gN <- if(withSmooth) "gridS" else "grid"
- gr0 <- gr <- get(GN,envir=nE)[[Famnam0]][[gN]]
- }else{
- gr0 <- gr <- get(GN,envir=nE)[[Famnam0]][["grid"]]
-# gr <- RobAStRDA:::.MakeSmoothGridList(gr[,1],gr[,-1], df = df,
-# gridRestrForSmooth = gridRestrForSmooth)
+ ## gN <- if(withSmooth) "gridS" else "grid"
+ gr0 <- get(GN,envir=nE)[[Famnam0]][["grid"]]
+ gr1 <- get(GN,envir=nE)[[Famnam0]][["gridS"]]
+ gr <- if(withSmooth) gr1 else gr0
+ if(smoothtry){
gr <- .MakeSmoothGridList(gr[,1],gr[,-1], df = df,
gridRestrForSmooth = gridRestrForSmooth)
+ }else{gr <- gr1}
+ print(round(head(gr0[,1]),3))
+ print(round(tail(gr0[,1]),3))
+ print(round((gr0[gr0[,1]>5,1]),3))
+ print(round(summary(diff(gr0[,1])),3))
+ print(c("n"=sum(!is.na(gr0[,1])),"NA"=sum(is.na(gr0[,1]))))
+ z <- if(whichLM=="all") 13 else 1
+ if(is.null(plotGridRestriction)){
+ plotGridRestriction <- list(rep(TRUE, nrow(gr)))
+ pl<- vector("list",z)
+ if(z>1) pl[1:z] <- plotGridRestriction else pl[1] <- plotGridRestriction
+ plotGridRestriction <- pl
+ }else{
+ pl<- vector("list", z)
+ pla <- if(is.list(plotGridRestriction)) plotGridRestriction else list(plotGridRestriction)
+ pl1 <- rep(pla, length.out=z)
+ plotGridRestriction <- pl1
}
- print(head(gr0[,1]))
- print(tail(gr0[,1]))
- print(summary(diff(gr0[,1])))
- print(c(n=sum(!is.na(gr0[,1])),NA=sum(is.na(gr0[,1]))))
- if(is.null(plotGridRestriction)) plotGridRestriction <- rep(TRUE, nrow(gr))
+ namesLM <- c("b","a.a[sc]","a.a[sh]","z.i[sc]","z.i[sh]",
+ "A.a[sc,sc]","A.a[sc,sh]","A.a[sh,sc]","A.a[sh,sh]",
+ "A.i[sc,sc]","A.i[sc,sh]","A.i[sh,sc]","A.i[sh,sh]")
if(!isSn) if(whichLM!="all") if(whichLM<1 | whichLM>13) stop("Falsche Koordinate")
+ if(missing(ylab)||is.null(ylab)) ylab <- "LM"
+ if(missing(xlab)||is.null(xlab)) xlab <- expression(xi)
+ if(missing(main)||is.null(main)) main <- paste(Gridnam,gsub(" [F,f]amily","",Famnam),sep="-")
+ if(missing(lty)||is.null(lty)) lty <- c(2,3,1)
+ if(missing(lwd)||is.null(lwd)) lwd <- c(0.8,0.8,1.8)
+ if(missing(col)||is.null(col)) col <- 1:3
if(!isSn) if(whichLM=="all"){
eval(prehook)
par(mfrow=c(4,4))
- for(i in 2:14)
- plot(gr[plotGridRestriction,1], gr[plotGridRestriction,i], ...)
+ for(i in 2:14){
+ pla <- plotGridRestriction[[i-1]]
+ if(is.null(pla)) pla <- 1:nrow(gr)
+ matplot(gr[pla,1], cbind(gr0[pla,i],gr[pla,i]), xlab=xlab, type="n",
+ ylab=paste(ylab,namesLM[i-1]), main=main, ...)
+ matlines(gr[pla,1],
+ cbind(gr0[pla,i],gr1[pla,i],gr[pla,i]),lwd=lwd, lty=lty, col=col)
+ }
par(mfrow=c(1,1))
eval(posthook)
return(invisible(NULL))
@@ -96,38 +126,45 @@
if(isSn) whichLM <- 1
wM <- whichLM + 1
eval(prehook)
- plot(gr[gridRestriction,1], gr[gridRestriction,wM], ...)
+ pla <- plotGridRestriction[[1]]
+ if(is.null(pla)) pla <- 1: nrow(gr)
+ print(wM)
+ print(head(gr[gridRestrForSmooth[[1]],1]))
+ plot(gr[pla,1], cbind(gr0[pla,wM],gr[pla,wM]), type="n",
+ xlab=xlab, ylab=paste(ylab,namesLM[wM-1]), main = main, ...)
+ matlines(gr[pla,1],
+ cbind(gr0[pla,wM],gr1[pla,wM],gr[pla,wM]),lwd=lwd, lty=lty, col=col)
eval(posthook)
return(invisible(NULL))
}
if(FALSE){
## Examples
-plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8), main ="Gamma-OMSE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("OMSE","Gener","all", type="l", plotG=-(1:8), main ="GPD-OMSE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("OMSE","GEV","all", type="l", plotG=-(1:8), main ="GEV-OMSE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("OMSE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-OMSE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("MBRE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-MBRE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("MBRE","Gene","all", type="l", plotG=-(1:8), main ="GPD-MBRE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("MBRE","GE","all", type="l", plotG=-(1:8), main ="GEV-MBRE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("MBRE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-MBRE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("RMXE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-RMXE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("RMXE","Gene","all", type="l", plotG=-(1:8), main ="GPD-RMXE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("RMXE","GE","all", type="l", plotG=-(1:8), main ="GEV-RMXE", xlab=expression(xi),ylab="LM", pre=windows())
-plotLM("RMXE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-RMXE", xlab=expression(xi),ylab="LM", pre=windows())
+plotLM("OMSE","Gamma","all", plotG=-(1:8), pre=windows())
+plotLM("OMSE","Gener","all", plotG=-(1:8), pre=windows())
+plotLM("OMSE","GEV","all", plotG=-(1:8), pre=windows())
+plotLM("OMSE","Wei","all", plotG=-(1:8), pre=windows())
+plotLM("MBRE","Gam","all", plotG=-(1:8), pre=windows())
+plotLM("MBRE","Gene","all", plotG=-(1:8), pre=windows())
+plotLM("MBRE","GE","all", plotG=-(1:8), pre=windows())
+plotLM("MBRE","Wei","all", plotG=-(1:8), pre=windows())
+plotLM("RMXE","Gam","all", plotG=-(1:8), pre=windows())
+plotLM("RMXE","Gene","all", plotG=-(1:8), pre=windows())
+plotLM("RMXE","GE","all", plotG=-(1:8), pre=windows())
+plotLM("RMXE","Wei","all", plotG=-(1:8), pre=windows())
plotLM("MBRE","GE","all", type="l")
-plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 10, gridR = -(1:15))
-plotLM("MBRE","GE","all", type="l", sm = TRUE, df = 4, gridR = -(1:15))
-plotLM("OMSE","Gamma","all", type="l", plotG=-(1:8), main ="Gamma-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-OMSE.pdf"), post=dev.off())
-plotLM("OMSE","Gener","all", type="l", plotG=-(1:8), main ="GPD-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-OMSE.pdf"), post=dev.off())
-plotLM("OMSE","GEV","all", type="l", plotG=-(1:8), main ="GEV-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-OMSE.pdf"), post=dev.off())
-plotLM("OMSE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-OMSE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-OMSE.pdf"), post=dev.off())
-plotLM("MBRE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-MBRE.pdf"), post=dev.off())
-plotLM("MBRE","Gene","all", type="l", plotG=-(1:8), main ="GPD-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-MBRE.pdf"), post=dev.off())
-plotLM("MBRE","GE","all", type="l", plotG=-(1:8), main ="GEV-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-MBRE.pdf"), post=dev.off())
-plotLM("MBRE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-MBRE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-MBRE.pdf"), post=dev.off())
-plotLM("RMXE","Gam","all", type="l", plotG=-(1:8), main ="Gamma-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("Gamma-RMXE.pdf"), post=dev.off())
-plotLM("RMXE","Gene","all", type="l", plotG=-(1:8), main ="GPD-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("GPD-RMXE.pdf"), post=dev.off())
-plotLM("RMXE","GE","all", type="l", plotG=-(1:8), main ="GEV-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("GEV-RMXE.pdf"), post=dev.off())
-plotLM("RMXE","Wei","all", type="l", plotG=-(1:8), main ="Weibull-RMXE", xlab=expression(xi),ylab="LM", pre=pdf("Weibull-RMXE.pdf"), post=dev.off())
+plotLM("MBRE","GE","all", sm = TRUE, df = 10, gridR = -(1:15))
+plotLM("MBRE","GE","all", sm = TRUE, df = 4, gridR = -(1:15))
+plotLM("OMSE","Gamma","all", plotG=-(1:8), pre=pdf("Gamma-OMSE.pdf"), post=dev.off())
+plotLM("OMSE","Gener","all", plotG=-(1:8), pre=pdf("GPD-OMSE.pdf"), post=dev.off())
+plotLM("OMSE","GEV","all", plotG=-(1:8), pre=pdf("GEV-OMSE.pdf"), post=dev.off())
+plotLM("OMSE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-OMSE.pdf"), post=dev.off())
+plotLM("MBRE","Gam","all", plotG=-(1:8), pre=pdf("Gamma-MBRE.pdf"), post=dev.off())
+plotLM("MBRE","Gene","all", plotG=-(1:8), pre=pdf("GPD-MBRE.pdf"), post=dev.off())
+plotLM("MBRE","GE","all", plotG=-(1:8), pre=pdf("GEV-MBRE.pdf"), post=dev.off())
+plotLM("MBRE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-MBRE.pdf"), post=dev.off())
+plotLM("RMXE","Gam","all", plotG=-(1:8), pre=pdf("Gamma-RMXE.pdf"), post=dev.off())
+plotLM("RMXE","Gene","all", plotG=-(1:8), pre=pdf("GPD-RMXE.pdf"), post=dev.off())
+plotLM("RMXE","GE","all", plotG=-(1:8), pre=pdf("GEV-RMXE.pdf"), post=dev.off())
+plotLM("RMXE","Wei","all", plotG=-(1:8), pre=pdf("Weibull-RMXE.pdf"), post=dev.off())
}
More information about the Robast-commits
mailing list