[Robast-commits] r418 - branches/robast-0.8/pkg/RandVar/R

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

Author: ruckdeschel
Date: 2010-09-03 03:46:48 +0200 (Fri, 03 Sep 2010)
New Revision: 418

Modified:
   branches/robast-0.8/pkg/RandVar/R/util.R
Log:
implemented Nataliyas Quantile trick for RandVar (util).

Modified: branches/robast-0.8/pkg/RandVar/R/util.R
===================================================================
--- branches/robast-0.8/pkg/RandVar/R/util.R	2010-09-02 22:42:52 UTC (rev 417)
+++ branches/robast-0.8/pkg/RandVar/R/util.R	2010-09-03 01:46:48 UTC (rev 418)
@@ -1,4 +1,3 @@
-## small util if imageDistr fails
 .getImageDistr <- function(f, distr){ 
     if (is(distr, "DiscreteDistribution"))
         return(DiscreteDistribution(prob=d(distr)(support(distr)), supp=f(support(distr))))
@@ -7,9 +6,18 @@
             xr <- r(distr)(n) 
             f(xr) 
         }
-        if(length(unique(rl(10000)))!=10000)
-           return(AbscontDistribution(r = rl, .withArith = TRUE, .withSim = TRUE))
-        else
-           return(UnivarLebDecDistribution(r = rl))
+
+        n <- 10^getdistrOption("RtoDPQ.e")+1
+        u <- seq(0,1,length=n+1); u <- (u[1:n]+u[2:(n+1)])/2
+        y <- f(q(distr)(u))
+    
+        if(length(unique(c(rl(10000),y)))==10000+length(y)){
+           DPQnew <- RtoDPQ(r=rl, y=y)
+           return(AbscontDistribution(r = rl, d = DPQnew$d, p = DPQnew$p, 
+                                      q = DPQnew$q, .withArith = TRUE, 
+                                      .withSim = TRUE))
+        
+        }else
+           return(UnivarLebDecDistribution(r = rl, y = y))
     }
 }
\ No newline at end of file