[Robast-commits] r1013 - branches/robast-1.1/pkg/RobExtremes/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2018-07-20 20:50:51 +0200 (Fri, 20 Jul 2018)
New Revision: 1013

Modified:
   branches/robast-1.1/pkg/RobExtremes/R/Pareto.R
   branches/robast-1.1/pkg/RobExtremes/R/ParetoFamily.R
   branches/robast-1.1/pkg/RobExtremes/R/getStartICPareto.R
Log:
[RobExtremes] branch 1.1 yet some bugfixes in R Code... 

Modified: branches/robast-1.1/pkg/RobExtremes/R/Pareto.R
===================================================================
--- branches/robast-1.1/pkg/RobExtremes/R/Pareto.R	2018-07-20 18:48:55 UTC (rev 1012)
+++ branches/robast-1.1/pkg/RobExtremes/R/Pareto.R	2018-07-20 18:50:51 UTC (rev 1013)
@@ -58,3 +58,13 @@
 setMethod("Min<-", "Pareto", function(object, value) 
            new("Pareto", shape = shape(object), Min = value))
 
+setMethod("*", c("Pareto","numeric"),
+          function(e1, e2){
+            if (length(e2)>1) stop("length of operator must be 1")
+            if (isTRUE(all.equal(e2,0)))
+                return(new("Dirac", location = 0, .withArith = TRUE))
+            Pareto <- new("Pareto", Min=Min(e1)* abs(e2),
+                                 shape=shape(e1))
+            if(e2<0) Pareto <- (-1)*as(Pareto,"AbscontDistribution")
+            return(Pareto)
+          })

Modified: branches/robast-1.1/pkg/RobExtremes/R/ParetoFamily.R
===================================================================
--- branches/robast-1.1/pkg/RobExtremes/R/ParetoFamily.R	2018-07-20 18:48:55 UTC (rev 1012)
+++ branches/robast-1.1/pkg/RobExtremes/R/ParetoFamily.R	2018-07-20 18:50:51 UTC (rev 1013)
@@ -8,13 +8,12 @@
 ## methods
 setMethod("validParameter",signature(object="ParetoFamily"),
            function(object, param, tol =.Machine$double.eps){
-             if (is(param, "ParamFamParameter")) 
+             if (is(param, "ParamFamParameter"))
                  param <- main(param)
-             if (!all(is.finite(param))) 
+             if (!all(is.finite(param)))
                  return(FALSE)
-             if(object at param@withPosRestr)
-                 if (any(param[1] <= tol))
-                     return(FALSE)
+             if (any(param[1] <= tol))
+                 return(FALSE)
              return(TRUE)
            })
 
@@ -64,7 +63,8 @@
         if(any(x < tr))
                stop("some data smaller than 'Min' ")
         names(e0) <- NULL
-        return(e0)
+        erange <- e0*c(1/10,10)
+        return(erange)
     }
 
 
@@ -86,7 +86,7 @@
 
         Lambda <- function(x) {
             y <- x*0
-            ind <- (x > Min) #
+            ind <- (x > Min0) #
             y[ind] <- 1/k + log(Min0/x[ind])
             return(y)
         }

Modified: branches/robast-1.1/pkg/RobExtremes/R/getStartICPareto.R
===================================================================
--- branches/robast-1.1/pkg/RobExtremes/R/getStartICPareto.R	2018-07-20 18:48:55 UTC (rev 1012)
+++ branches/robast-1.1/pkg/RobExtremes/R/getStartICPareto.R	2018-07-20 18:50:51 UTC (rev 1013)
@@ -21,24 +21,25 @@
    ## the respective LMs have been computed ahead of time
    ## and stored in sysdata.rda of this package
    ## the code for this computation is in AddMaterial/getLMPareto.R
+   .PLM <- getFromNamespace(".ParetoLM", ns = "RobExtremes")
    if(type==".MBRE"){
-         b  <- xi*.ParetoLM$MBR["b"]
-         a  <- xi*.ParetoLM$MBR["a"]
-         aw <-    .ParetoLM$MBR["aw"]
-         A  <- xi*.ParetoLM$MBR["A"]
-         Aw <- xi*.ParetoLM$MBR["Aw"]
+         b  <- xi*.PLM$MBR["b"]
+         a  <- xi*.PLM$MBR["a"]
+         aw <- 1/xi*.PLM$MBR["aw"]
+         A  <- matrix(xi^2*.PLM$MBR["A"],1,1)
+         Aw <- matrix(xi^2*.PLM$MBR["Aw"],1,1)
    }else{if(type==".RMXE"){
-         b  <- xi*.ParetoLM$RMX["b"]
-         a  <- xi*.ParetoLM$RMX["a"]
-         aw <-    .ParetoLM$RMX["aw"]
-         A  <- xi*.ParetoLM$RMX["A"]
-         Aw <- xi*.ParetoLM$RMX["Aw"]
+         b  <- xi*.PLM$RMX["b"]
+         a  <- xi*.PLM$RMX["a"]
+         aw <- 1/xi*.PLM$RMX["aw"]
+         A  <- matrix(xi^2*.PLM$RMX["A"],1,1)
+         Aw <- matrix(xi^2*.PLM$RMX["Aw"],1,1)
       }else{if(type==".OMSE"){
-         b  <- xi*.ParetoLM$OMS["b"]
-         a  <- xi*.ParetoLM$OMS["a"]
-         aw <-    .ParetoLM$OMS["aw"]
-         A  <- xi*.ParetoLM$OMS["A"]
-         Aw <- xi*.ParetoLM$OMS["Aw"]
+         b  <- xi*.PLM$OMS["b"]
+         a  <- xi*.PLM$OMS["a"]
+         aw <- 1/xi*.PLM$OMS["aw"]
+         A  <- matrix(xi^2*.PLM$OMS["A"],1,1)
+         Aw <- matrix(xi^2*.PLM$OMS["Aw"],1,1)
          }
       }
    }