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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jan 28 00:38:10 CET 2009


Author: ruckdeschel
Date: 2009-01-28 00:38:09 +0100 (Wed, 28 Jan 2009)
New Revision: 383

Modified:
   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/distr/chm/plot-methods.html
   branches/distr-2.1/pkg/distr/man/plot-methods.Rd
   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:
+realized suggestions by A. Unwin, Augsburg;
 plot for L2paramFamilies may be restricted to selected subplots;

+small buglets in plot-methods.R and plot-methods_LebDec.R (moved setting of owarn/oldPar outside)
+also named parameters are used in axis annotation if available.

Modified: branches/distr-2.1/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-01-27 23:38:09 UTC (rev 383)
@@ -15,7 +15,7 @@
      xc <- match.call(call = sys.call(sys.parent(1)))$x
      ### manipulating the ... - argument
      dots <- match.call(call = sys.call(sys.parent(1)), 
-                      expand.dots = FALSE)$"..."
+                        expand.dots = FALSE)$"..."
 
       to.draw <- 1:3
       names(to.draw) <- c("d","p","q")
@@ -181,8 +181,8 @@
              }
           }
 
+     o.warn <- getOption("warn"); options(warn = -1)
      if(1%in%to.draw){
-         o.warn <- getOption("warn"); options(warn = -1)
          on.exit(options(warn=o.warn))
          do.call(plot, c(list(x = grid, dxg, type = "l", 
              ylim = ylim1,  ylab = "d(x)", xlab = "x", log = logpd), 

Modified: branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R	2009-01-27 23:38:09 UTC (rev 383)
@@ -284,8 +284,8 @@
          pxv <- p(x)(xv)
      }
 
+     o.warn <- getOption("warn"); options(warn = -1)
      if(1 %in% to.draw){
-        o.warn <- getOption("warn"); options(warn = -1)
         on.exit(options(warn=o.warn))
         do.call(plot, c(list(x = grid, pxg, type = "l",
              ylim = ylim, ylab = "p(q)", xlab = "q", log = logpd),

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

Modified: branches/distr-2.1/pkg/distr/chm/plot-methods.html
===================================================================
--- branches/distr-2.1/pkg/distr/chm/plot-methods.html	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distr/chm/plot-methods.html	2009-01-27 23:38:09 UTC (rev 383)
@@ -120,7 +120,7 @@
 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>.</td></tr>
 <tr valign="top"><td><code>inner</code></td>
 <td>
-logical: panels for density/probability function -
+logical: do panels for density/probability function -
 cdf - quantile function have their own titles? or <br>
 list which is filled to length 3  (resp. 8 for class 
 <code>UnivarLebDecDistribution</code>) if necessary
@@ -333,6 +333,26 @@
 mymix &lt;- UnivarLebDecDistribution(acPart = wg, discretePart = Binom(4,.4),
          acWeight = 0.4)
 plot(mymix)         
+#
+## selection of subpanels for plotting
+N &lt;- Norm()
+par(mfrow=c(1,2))
+plot(N, mfColRow = FALSE, to.draw.arg=c("d","q"))
+plot(N, mfColRow = FALSE, to.draw.arg=c(2,3))
+par(mfrow=c(1,1))
+
+wg &lt;- flat.mix(UnivarMixingDistribution(Unif(0,1),Unif(4,5),
+               withSimplify=FALSE))
+myLC &lt;- UnivarLebDecDistribution(discretePart=Binom(3,.3), acPart = wg,
+          discreteWeight=.2)
+layout(matrix(c(rep(1,6),2,2,3,3,4,4,5,5,5,6,6,6), 
+              nrow=3, byrow=TRUE))
+plot(myLC,mfColRow = FALSE,
+     to.draw.arg=c("p","d.c","p.c","q.c", "p.d","q.d"))
+
+P &lt;- Pois(2)
+plot(as(P,"UnivarLebDecDistribution"),mfColRow = FALSE,to.draw.arg=c("d.d"))
+
 </pre>
 
 <script Language="JScript">

Modified: branches/distr-2.1/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.1/pkg/distr/man/plot-methods.Rd	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distr/man/plot-methods.Rd	2009-01-27 23:38:09 UTC (rev 383)
@@ -69,7 +69,7 @@
                distributions}
   \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: panels for density/probability function -
+  \item{inner}{logical: do panels for density/probability function -
                         cdf - quantile function have their own titles? or \cr
                list which is filled to length 3  (resp. 8 for class 
                \code{UnivarLebDecDistribution}) if necessary

Modified: branches/distr-2.1/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distrMod/R/AllPlot.R	2009-01-27 23:38:09 UTC (rev 383)
@@ -11,12 +11,34 @@
              main = FALSE, inner = TRUE, sub = FALSE, 
              col.inner = par("col.main"), cex.inner = 0.8, 
              bmar = par("mar")[1], tmar = par("mar")[3], ...,
-             mfColRow = TRUE){
+             mfColRow = TRUE, to.draw.arg = NULL){
 
         xc <- match.call(call = sys.call(sys.parent(1)))$x
         dots <- match.call(call = sys.call(sys.parent(1)), 
                        expand.dots = FALSE)$"..."
         
+        dots$to.draw.arg <- NULL
+        trafO <- trafo(x at param)
+        dims <- nrow(trafO)
+        dimm <- length(x at param)
+        
+        to.draw <- 1:(3+dims)
+        dimnms  <- c(rownames(trafO))
+        if(is.null(dimnms))
+           dimnms <- paste("dim",1:dims,sep="")
+        names(to.draw) <- c("d","p","q", dimnms)
+        if(!mfColRow && ! is.null(to.draw.arg)){
+            if(is.character(to.draw.arg)) 
+                 to.draw <- pmatch(to.draw.arg, names(to.draw))
+            else if(is.numeric(to.draw.arg)) 
+                 to.draw <- to.draw.arg
+        }
+        l2dpl <- to.draw[to.draw > 3]
+        dims0 <- length(l2dpl)
+        nrows <- trunc(sqrt(dims0))
+        ncols <- ceiling(dims0/nrows)
+
+        
         if(!is.logical(inner)){
           if(!is.list(inner))
               inner <- as.list(inner)
@@ -55,8 +77,8 @@
             }
         }
 
-        dims <- length(x at param)
-        L2deriv <- as(diag(dims) %*% x at L2deriv, "EuclRandVariable")
+        
+        L2deriv <- as(diag(dimm) %*% x at L2deriv, "EuclRandVariable")
 
         mainL <- FALSE
         subL <- FALSE
@@ -98,48 +120,69 @@
      }
 
      if(is.logical(innerL)){
-        innerT <- paste(gettextf("Component "), 1:dims,
+        tnm  <- c(rownames(trafO))
+        tnms <- if(is.null(tnm)) paste(1:dims) else 
+                                 paste("'", tnm, "'", sep = "") 
+        mnm <- names(x at param@main)
+        mnms <- if(is.null(mnm)) NULL else paste("'", mnm, "' = ", sep = "") 
+        mss  <- paste(mnms, round(x at param@main, 3), collapse=", ",sep="")
+        innerT <- paste(gettextf("Component "),  tnms, 
                         gettextf(" of L_2 derivative\nof"),
                         name(x)[1],
-                        gettextf("\nwith main parameter ("),
-                        paste(round(x at param@main, 3), collapse = ", "),")")
-        if(!is.null(x at param@nuisance))
+                        gettextf("\nwith main parameter ("), mss,")")
+        if(!is.null(x at param@nuisance)){
+            nnm <- names(x at param@nuisance)
+            nnms <- if(is.null(nnm)) NULL else paste("'", nnm, "' = ", sep = "") 
             innerT <- paste(innerT,
                         gettextf("\nand nuisance parameter ("),
-                        paste(round(x at param@nuisance, 3), collapse = ", "),
+                        paste(nnms,round(x at param@nuisance, 3), collapse = ", "),
                         ")",
                         sep=""  )
-        if(!is.null(x at param@fixed))
+        }
+        if(!is.null(x at param@fixed)){
+            fnm <- names(x at param@fixed)
+            fnms <- if(is.null(fnm)) NULL else paste("'", fnm, "' = ", sep = "") 
             innerT <- paste(innerT,
                         gettextf("\nand fixed known parameter ("),
-                        paste(round(x at param@fixed, 3), collapse = ", "),
+                        paste(fnms, round(x at param@fixed, 3), collapse = ", "),
                         ")",
                         sep=""  )
+        }
      }else{
         innerT <- lapply(inner, .mpresubs)
+        if(dims0<dims){
+           innerT0 <- innerT
+           for(i in 1:dims0) innerT[to.draw[i]] <- innerT0[i]          
+        }
      }
 
+
         dotsT <- dots
         dotsT["main"] <- NULL
         dotsT["cex.main"] <- NULL
         dotsT["col.main"] <- NULL
         dotsT["line"] <- NULL
 
-     do.call(plot, c(list(e1,withSweave = withSweave, 
+        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))       
-     
+             dots, mfColRow=mfColRow)
+           lis0$to.draw.arg  <- todrw 
+           do.call(plot, args=lis0)            
+        }
         o.warn <- options("warn")
         options(warn = -1)
         on.exit(options(warn=o.warn))
         opar <- par()
         on.exit(par(opar))
+        
         if (!withSweave)
              devNew()
-        nrows <- trunc(sqrt(dims))
-        ncols <- ceiling(dims/nrows)
         
+        parArgs <- NULL
         if(mfColRow)
            parArgs <- list(mfrow = c(nrows, ncols))
 
@@ -147,18 +190,19 @@
         parArgs <- c(parArgs,list(mar = c(bmar,omar[2],tmar,omar[4])))
        
      do.call(par,args=parArgs)
-        for(i in 1:dims){
-            do.call(plot, args=c(list(x=x.vec, y=sapply(x.vec, L2deriv at Map[[i]]),
+        for(i in 1:dims0){
+            indi <- l2dpl[i]-3
+            do.call(plot, args=c(list(x=x.vec, y=sapply(x.vec, L2deriv at Map[[indi]]),
                                  type = plty, lty = lty,
                                  xlab = "x",
                                  ylab = expression(paste(L[2], " derivative"))),
                                  dots))
             if(is(e1, "DiscreteDistribution")){
                 x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
-                do.call(lines, args=c(list(x.vec1, sapply(x.vec1, L2deriv at Map[[i]]),
+                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[i]), dotsT, line = lineT,
+            do.call(title, args = c(list(main = innerT[indi]), dotsT, line = lineT,
                     cex.main = cex.inner, col.main = col.inner))
         }
 

Modified: branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html
===================================================================
--- branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distrMod/chm/L2ParamFamily-class.html	2009-01-27 23:38:09 UTC (rev 383)
@@ -169,9 +169,65 @@
 
 
 <dt>plot</dt><dd><code>signature(x = "L2ParamFamily")</code>: 
-plot of <code>distribution</code> and <code>L2deriv</code>. </dd>
+plot of <code>distribution</code> and <code>L2deriv</code>. More precisely,
+this method has arguments
+<code>
+      plot(x, withSweave = getdistrOption("withSweave"), 
+             main = FALSE, inner = TRUE, sub = FALSE, 
+             col.inner = par("col.main"), cex.inner = 0.8, 
+             bmar = par("mar")[1], tmar = par("mar")[3], ...,
+             mfColRow = TRUE, to.draw.arg = NULL)
+      </code> where <ul>
+<dt>x</dt><dd>object of class <code>"L2ParamFamily"</code></dd>
+<dt>withSweave</dt><dd>logical: if <code>TRUE</code> (for working with <CODE>Sweave</CODE>) 
+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 
+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>
+<dt>tmar</dt><dd>top margin &ndash; useful for non-standard main title sizes</dd>
+<dt>bmar</dt><dd>bottom margin &ndash; useful for non-standard sub title sizes</dd>
+<dt>cex.inner</dt><dd>magnification to be used for inner titles relative
+to the current setting of <code>cex</code>; as in 
+<code><a onclick="findlink('stats', 'par.html')" style="text-decoration: underline; color: blue; cursor: hand">par</a></code></dd>
+<dt>col.inner</dt><dd>character or integer code; color for the inner title</dd>              
+<dt>mfColRow</dt><dd>shall default partition in panels be used &mdash; 
+defaults to <code>TRUE</code></dd>
+<dt>to.draw.arg</dt><dd>if <code>mfColRow==FALSE</code>, either <code>NULL</code> (default; 
+everything is plotted) or a vector of either integers 
+(the indices of the subplots to be drawn) or characters 
+&mdash; the names of the subplots to be drawn: these
+names are to be chosen among 
+<code>c("d","p","q", dimnms)</code> where <code>dimnms</code> is
+either the row names of the trafo matrix 
+<code>rownames(trafo(x at param))</code> or if the last expression
+is <code>NULL</code> a vector <code>"dim&lt;dimnr&gt;"</code>, 
+<code>dimnr</code> running through the number of rows of the 
+trafo matrix.
+</dd>
+<dt>...</dt><dd>addtional arguments for <code>plot</code> &mdash; see 
+<code><a onclick="findlink('stats', 'plot.html')" style="text-decoration: underline; color: blue; cursor: hand">plot</a></code>, 
+<code><a onclick="findlink('stats', 'plot.default.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.default</a></code>, 
+<code><a onclick="findlink('stats', 'plot.stepfun.html')" style="text-decoration: underline; color: blue; cursor: hand">plot.stepfun</a></code> </dd>
 
+<p>
+</ul> 
+</dd>
 
+
 <dt>modifyModel</dt><dd><code>signature(model = "L2ParamFamily", param = "ParamFamParameter")</code>:
 moves the L2-parametric Family <code>model</code> to parameter <code>param</code> </dd>
 </dl>
@@ -207,10 +263,25 @@
 <pre>
 F1 &lt;- new("L2ParamFamily")
 plot(F1)
+
+## selection of subpanels for plotting
+F2 &lt;- L2LocationScaleFamily()
+layout(matrix(c(1,2,3,3), nrow=2, byrow=TRUE))
+plot(F2,mfColRow = FALSE,
+     to.draw.arg=c("p","q","loc"))
 </pre>
 
+<script Language="JScript">
+function findlink(pkg, fn) {
+var Y, link;
+Y = location.href.lastIndexOf("\\") + 1;
+link = location.href.substring(0, Y);
+link = link + "../../" + pkg + "/chtml/" + pkg + ".chm::/" + fn;
+location.href = link;
+}
+</script>
 
 
-<hr><div align="center">[Package <em>distrMod</em> version 2.0.2 <a href="00Index.html">Index]</a></div>
+<hr><div align="center">[Package <em>distrMod</em> version 2.1 <a href="00Index.html">Index</a>]</div>
 
 </body></html>

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-01-26 15:39:41 UTC (rev 382)
+++ branches/distr-2.1/pkg/distrMod/man/L2ParamFamily-class.Rd	2009-01-27 23:38:09 UTC (rev 383)
@@ -140,8 +140,63 @@
       expectation of \code{fun} under the distribution of \code{object}. }
 
     \item{plot}{\code{signature(x = "L2ParamFamily")}: 
-      plot of \code{distribution} and \code{L2deriv}. }
+      plot of \code{distribution} and \code{L2deriv}. More precisely,
+      this method has arguments
+      \code{
+      plot(x, withSweave = getdistrOption("withSweave"), 
+             main = FALSE, inner = TRUE, sub = FALSE, 
+             col.inner = par("col.main"), cex.inner = 0.8, 
+             bmar = par("mar")[1], tmar = par("mar")[3], ...,
+             mfColRow = TRUE, to.draw.arg = NULL)
+      } where \itemize{
+        \item{x}{object of class \code{"L2ParamFamily"}}
+        \item{withSweave}{logical: if \code{TRUE} (for working with \command{Sweave}) 
+                          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 
+               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}}.}
+        \item{tmar}{top margin -- useful for non-standard main title sizes}
+        \item{bmar}{bottom margin -- useful for non-standard sub title sizes}
+        \item{cex.inner}{magnification to be used for inner titles relative
+          to the current setting of \code{cex}; as in 
+          \code{\link[stats]{par}}}
+       \item{col.inner}{character or integer code; color for the inner title}              
+       \item{mfColRow}{shall default partition in panels be used --- 
+                       defaults to \code{TRUE}}
+       \item{to.draw.arg}{if \code{mfColRow==FALSE}, either \code{NULL} (default; 
+                          everything is plotted) or a vector of either integers 
+                         (the indices of the subplots to be drawn) or characters 
+                         --- the names of the subplots to be drawn: these
+                         names are to be chosen among 
+                         \code{c("d","p","q", dimnms)} where \code{dimnms} is
+                         either the row names of the trafo matrix 
+                         \code{rownames(trafo(x at param))} or if the last expression
+                         is \code{NULL} a vector \code{"dim<dimnr>"}, 
+                         \code{dimnr} running through the number of rows of the 
+                         trafo matrix.
+                         }
+       \item{\dots}{addtional arguments for \code{plot} --- see 
+               \code{\link[stats]{plot}}, 
+               \code{\link[stats]{plot.default}}, 
+               \code{\link[stats]{plot.stepfun}} }
 
+      } 
+      }
+
     \item{modifyModel}{\code{signature(model = "L2ParamFamily", param = "ParamFamParameter")}:
       moves the L2-parametric Family \code{model} to parameter \code{param} }
   }
@@ -159,6 +214,12 @@
 \examples{
 F1 <- new("L2ParamFamily")
 plot(F1)
+
+## selection of subpanels for plotting
+F2 <- L2LocationScaleFamily()
+layout(matrix(c(1,2,3,3), nrow=2, byrow=TRUE))
+plot(F2,mfColRow = FALSE,
+     to.draw.arg=c("p","q","loc"))
 }
 \concept{parametric family}
 \keyword{classes}



More information about the Distr-commits mailing list