[Distr-commits] r400 - in branches/distr-2.1/pkg: distr/R distr/chm distrMod/R distrMod/chm distrMod/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Feb 17 18:19:25 CET 2009


Author: ruckdeschel
Date: 2009-02-17 18:19:25 +0100 (Tue, 17 Feb 2009)
New Revision: 400

Modified:
   branches/distr-2.1/pkg/distr/R/internalUtils.R
   branches/distr-2.1/pkg/distr/R/plot-methods.R
   branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
   branches/distr-2.1/pkg/distr/chm/Distr.chm
   branches/distr-2.1/pkg/distrMod/R/AllPlot.R
   branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html
   branches/distr-2.1/pkg/distrMod/chm/distrMod.chm
   branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd
Log:
+ yet another improvement of .multm (now sets density for discrete distributions for non-support arguments actively to 0)
+ fixed bug in plot-methods for argument "inner" under use of to.draw.arg argument 

Modified: branches/distr-2.1/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/internalUtils.R	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distr/R/internalUtils.R	2009-02-17 17:19:25 UTC (rev 400)
@@ -460,7 +460,7 @@
                              on.exit(options(warn=o.warn))
                              #
                              x0 <- .setEqual(q / e2C, support(object))
-                             d0 <- object at d(x = x0)
+                             d0 <- object at d(x = x0)*(x0 %in% support(object))
                              #
                              options(warn = o.warn)
                              if (!lower.tail) d0 <- -d0

Modified: branches/distr-2.1/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-02-17 17:19:25 UTC (rev 400)
@@ -140,9 +140,11 @@
                    .mpresubs(gettextf("Quantile function of %%C%%Q")) else ""
                           ### double  %% as % is special for gettextf
      }else{
-        inner.d <- .mpresubs(inner[[1]])
-        inner.p <- .mpresubs(inner[[2]])
-        inner.q <- .mpresubs(inner[[3]])
+        iL <- 1:length(to.draw)
+
+        inner.d <- if(1%in%to.draw) .mpresubs(inner[[min(iL[to.draw==1])]]) else NULL
+        inner.p <- if(2%in%to.draw) .mpresubs(inner[[min(iL[to.draw==2])]]) else NULL
+        inner.q <- if(3%in%to.draw) .mpresubs(inner[[min(iL[to.draw==3])]]) else NULL
      }
 
      lower <- getLow(x, eps = getdistrOption("TruncQuantile")*2)
@@ -434,9 +436,11 @@
                    .mpresubs(gettextf("Quantile function of %%C%%Q")) else ""
                           ### double  %% as % is special for gettextf
      }else{
-        inner.d <- .mpresubs(inner[[1]])
-        inner.p <- .mpresubs(inner[[2]])
-        inner.q <- .mpresubs(inner[[3]])
+        iL <- 1:length(to.draw)
+
+        inner.d <- if(1%in%to.draw) .mpresubs(inner[[min(iL[to.draw==1])]]) else NULL
+        inner.p <- if(2%in%to.draw) .mpresubs(inner[[min(iL[to.draw==2])]]) else NULL
+        inner.q <- if(3%in%to.draw) .mpresubs(inner[[min(iL[to.draw==3])]]) else NULL
      }
                               
       lower <- min(support(x))

Modified: branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R	2009-02-17 17:19:25 UTC (rev 400)
@@ -254,8 +254,10 @@
                    .mpresubs(gettextf("Quantile function of %%C%%Q")) else ""
                           ### double  %% as % is special for gettextf
      }else{
-        inner.p <- .mpresubs(inner[[1]])
-        inner.q <- .mpresubs(inner[[2]])
+        iL <- 1:length(to.draw[to.draw<=2])
+
+        inner.p <- if(1%in%to.draw) .mpresubs(inner[[min(iL[to.draw==1])]]) else NULL
+        inner.q <- if(2%in%to.draw) .mpresubs(inner[[min(iL[to.draw==2])]]) else NULL
      }
 
 

Modified: branches/distr-2.1/pkg/distr/chm/Distr.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.1/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-02-17 17:19:25 UTC (rev 400)
@@ -41,12 +41,16 @@
         
         if(!is.logical(inner)){
           if(!is.list(inner))
-              inner <- as.list(inner)
+              inner <-  as.list(inner)
             #stop("Argument 'inner' must either be 'logical' or a 'list'")
-           inner <- distr:::.fillList(inner,4)          
-           innerD <- inner[1:3]
-           innerL <- inner[4] 
-        }else{innerD <- innerL <- inner}
+          innerLog <- TRUE  
+          iL <- length(to.draw[to.draw <= 3])+length(l2dpl)
+          iLD <- (1:iL)[to.draw <= 3]
+          iLL <- (1:iL)[to.draw > 3]
+          inner <- distr:::.fillList(inner,iL)          
+          innerD <- if(length(iLD)) inner[iLD] else NULL
+          innerL <- if(length(iLL)) inner[iLL] else NULL
+        }else{innerLog <- innerD <- innerL <- inner}
         
         if(!is.null(dots[["lty"]]))  dots["lty"] <- NULL
         if(!is.null(dots[["type"]])) dots["type"] <- NULL
@@ -171,12 +175,10 @@
                         ")",
                         sep=""  )
         }
+        innerT <- if(length(l2dpl)) innerT[l2dpl-3] else NULL
      }else{
-        innerT <- lapply(inner, .mpresubs)
-        if(dims0<dims){
-           innerT0 <- innerT
-           for(i in 1:dims0) innerT[to.draw[i]] <- innerT0[i]          
-        }
+        innerT <- lapply(innerL, .mpresubs)
+        innerD <- lapply(innerD, .mpresubs)
      }
 
 
@@ -186,15 +188,15 @@
         dotsT["col.main"] <- NULL
         dotsT["line"] <- NULL
 
-        distrpl <- (1:3)%in%to.draw
+        distrpl <- (1:3) %in% to.draw
         todrw <- as.numeric((1:3)[distrpl])
         if(any(distrpl)){
-           lis0 <- c(list(e1,withSweave = withSweave, 
-             main = main, inner = innerD, sub = sub, 
-             col.inner = col.inner, cex.inner = 1.5*cex.inner),
-             dots, mfColRow=mfColRow)
+           lis0 <- c(list(e1, withSweave = withSweave, 
+                          main = main, inner = innerD, sub = sub, 
+                          col.inner = col.inner, cex.inner = 1.5*cex.inner),
+                     dots, mfColRow = mfColRow)
            lis0$to.draw.arg  <- todrw 
-           do.call(plot, args=lis0)            
+           do.call(plot, args = lis0)            
         }
         o.warn <- options("warn")
         options(warn = -1)
@@ -227,8 +229,10 @@
                 do.call(lines, args=c(list(x.vec1, sapply(x.vec1, L2deriv at Map[[indi]]),
                               lty = "dotted"),dots))
             }
-            do.call(title, args = c(list(main = innerT[indi]), dotsT, line = lineT,
-                    cex.main = cex.inner, col.main = col.inner))
+            if(innerLog)
+               do.call(title, args = c(list(main = innerT[i]), dotsT, 
+                       line = lineT, cex.main = cex.inner, 
+                       col.main = col.inner))
         }
 
         if(!hasArg(cex.main)) cex.main <- par("cex.main") else cex.main <- dots$"cex.main"

Modified: branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html
===================================================================
--- branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-02-17 17:19:25 UTC (rev 400)
@@ -183,18 +183,11 @@
 no extra device is opened and height/width are not set</dd>
 <dt>main</dt><dd>logical: is a main title to be used? or <br>
 just as argument <code>main</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>.</dd>
-<dt>inner</dt><dd>logical: do panels for density/probability function -
-cdf - quantile function have their own titles? or <br>
-list which is filled to length 4  if necessary
-(possibly using recycling rules):  titles for 
-density/probability function - cdf - quantile function 
-and L2-derivative (each of the same form as argument 
-<code>main</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>)</dd> 
 <dt>inner</dt><dd>logical: do panels have their own titles? or <br>
-character vector of / cast to length <code>3+</code>'number of plotted 
-dimensions'; if argument <code>to.draw.arg</code> is used, this refers to 
-a vector of length <code>length(to.draw.arg)</code>, the 
-actually plotted dimensions. For further information, see also 
+character vector of / cast to length 'number of plotted 
+panels' with the corresponding panel titles. For further 
+information, see also 
+<code><a onclick="findlink('distr', 'plot-methods.html')" style="text-decoration: underline; color: blue; cursor: hand">plot</a></code> and the 
 description of argument <code>main</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>.</dd> 
 <dt>sub</dt><dd>logical: is a sub-title to be used? or <br>
 just as argument <code>sub</code> in <code><a onclick="findlink('graphics', 'plotdefault.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>.</dd>
@@ -275,6 +268,8 @@
 layout(matrix(c(1,2,3,3), nrow=2, byrow=TRUE))
 plot(F2,mfColRow = FALSE,
      to.draw.arg=c("p","q","loc"))
+plot(F2,mfColRow = FALSE, inner=list("empirical cdf","pseudo-inverse",
+     "L2-deriv, loc.part"), to.draw.arg=c("p","q","loc"))
 </pre>
 
 <script Language="JScript">

Modified: branches/distr-2.1/pkg/distrMod/chm/distrMod.chm
===================================================================
(Binary files differ)

Modified: branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd
===================================================================
--- branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd	2009-02-16 17:39:13 UTC (rev 399)
+++ branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd	2009-02-17 17:19:25 UTC (rev 400)
@@ -154,18 +154,11 @@
                           no extra device is opened and height/width are not set}
         \item{main}{logical: is a main title to be used? or \cr
                     just as argument \code{main} in \code{\link{plot.default}}.}
-        \item{inner}{logical: do panels for density/probability function -
-                        cdf - quantile function have their own titles? or \cr
-                        list which is filled to length 4  if necessary
-                       (possibly using recycling rules):  titles for 
-                        density/probability function - cdf - quantile function 
-                        and L2-derivative (each of the same form as argument 
-               \code{main} in \code{\link{plot.default}})} 
         \item{inner}{logical: do panels have their own titles? or \cr
-               character vector of / cast to length \code{3+}'number of plotted 
-               dimensions'; if argument \code{to.draw.arg} is used, this refers to 
-               a vector of length \code{length(to.draw.arg)}, the 
-               actually plotted dimensions. For further information, see also 
+               character vector of / cast to length 'number of plotted 
+               panels' with the corresponding panel titles. For further 
+               information, see also 
+               \code{\link[distr:plot-methods]{plot}} and the 
                description of argument \code{main} in \code{\link{plot.default}}.} 
         \item{sub}{logical: is a sub-title to be used? or \cr
                    just as argument \code{sub} in \code{\link{plot.default}}.}
@@ -227,6 +220,8 @@
 layout(matrix(c(1,2,3,3), nrow=2, byrow=TRUE))
 plot(F2,mfColRow = FALSE,
      to.draw.arg=c("p","q","loc"))
+plot(F2,mfColRow = FALSE, inner=list("empirical cdf","pseudo-inverse",
+     "L2-deriv, loc.part"), to.draw.arg=c("p","q","loc"))
 }
 \concept{parametric family}
 \keyword{classes}



More information about the Distr-commits mailing list