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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jan 26 16:39:41 CET 2009


Author: ruckdeschel
Date: 2009-01-26 16:39:41 +0100 (Mon, 26 Jan 2009)
New Revision: 382

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/0distr-package.html
   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
Log:
realized suggestions by A. Unwin, Augsburg;

plot for distributions may be restricted to selected subplots.

Modified: branches/distr-2.1/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-01-26 11:58:37 UTC (rev 381)
+++ branches/distr-2.1/pkg/distr/R/plot-methods.R	2009-01-26 15:39:41 UTC (rev 382)
@@ -9,13 +9,25 @@
             cex.sub = par("cex.sub"), col.points = par("col"), 
             col.vert = par("col"), col.main = par("col.main"), 
             col.inner = par("col.main"), col.sub = par("col.sub"), 
-            cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE){
+            cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE,
+            to.draw.arg = NULL){
 
      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)$"..."
 
+      to.draw <- 1:3
+      names(to.draw) <- c("d","p","q")
+      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
+      }
+      l.draw <- length(to.draw)
+
+     
      dots$col.hor <- NULL
 
      dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
@@ -29,7 +41,7 @@
          {if(!is.list(inner))
               inner <- as.list(inner)
             #stop("Argument 'inner' must either be 'logical' or a 'list'")
-          inner <- .fillList(inner,3)          
+          inner <- .fillList(inner,l.draw)          
          }
      cex <- if (hasArg(cex)) dots$cex else 1
 
@@ -169,30 +181,32 @@
              }
           }
 
-     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), 
-         dots.without.pch))
-     options(warn = o.warn)
-
-     title(main = inner.d, line = lineT, cex.main = cex.inner,
-           col.main = col.inner)
-
-
-     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), 
+             dots.without.pch))
+         options(warn = o.warn)
+     
+         title(main = inner.d, line = lineT, cex.main = cex.inner,
+               col.main = col.inner)
+     
+     
+         options(warn = -1)
+     }
      if(is.finite(q(x)(0))) {grid <- c(q(x)(0),grid); pxg <- c(0,pxg)}
      if(is.finite(q(x)(1))) {grid <- c(grid,q(x)(1)); pxg <- c(pxg,1)}
 
-     do.call(plot, c(list(x = grid, pxg, type = "l", 
-          ylim = ylim2, ylab = "p(q)", xlab = "q", log = logpd), 
-          dots.without.pch))
-     options(warn = o.warn)
-
-     title(main = inner.p, line = lineT, cex.main = cex.inner,
-           col.main = col.inner)
-
+     if(2%in%to.draw){
+        do.call(plot, c(list(x = grid, pxg, type = "l", 
+             ylim = ylim2, ylab = "p(q)", xlab = "q", log = logpd), 
+             dots.without.pch))
+        options(warn = o.warn)
+      
+        title(main = inner.p, line = lineT, cex.main = cex.inner,
+              col.main = col.inner)
+     }
      ### quantiles
 
      ### fix finite support bounds
@@ -223,36 +237,37 @@
         xo <- grid
      }
      
-     options(warn = -1)
-     do.call(plot, c(list(x = po, xo, type = "n", 
-          xlim = ylim, ylim = xlim, ylab = "q(p)", xlab = "p", 
-          log = logq), dots.without.pch))
-     options(warn = o.warn)
-
+     if(3%in%to.draw){
+        options(warn = -1)
+        do.call(plot, c(list(x = po, xo, type = "n", 
+             xlim = ylim, ylim = xlim, ylab = "q(p)", xlab = "p", 
+             log = logq), dots.without.pch))
+        options(warn = o.warn)
+    
+        
+        title(main = inner.q, line = lineT, cex.main = cex.inner,
+              col.main = col.inner)
+        
+        options(warn = -1)
+            lines(po,xo, ...)
+        if (verticals && !is.null(gaps(x))){
+            pu <- rep(pu1,3)
+            xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
+            o <- order(pu)
+            dots.without.pch0 <- dots.without.pch
+            dots.without.pch0$col <- NULL
+            do.call(lines, c(list(pu[o], xu[o], 
+                    col = col.vert), dots.without.pch0))    
+        }
+        options(warn = o.warn)
      
-     title(main = inner.q, line = lineT, cex.main = cex.inner,
-           col.main = col.inner)
-     
-     options(warn = -1)
-         lines(po,xo, ...)
-     if (verticals && !is.null(gaps(x))){
-         pu <- rep(pu1,3)
-         xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
-         o <- order(pu)
-         dots.without.pch0 <- dots.without.pch
-         dots.without.pch0$col <- NULL
-         do.call(lines, c(list(pu[o], xu[o], 
-                 col = col.vert), dots.without.pch0))    
-     }
-     options(warn = o.warn)
-
-     
-     if(!is.null(gaps(x)) && do.points){
-        do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a, 
-                cex = cex.points, col = col.points), dots.for.points) )
-        do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
-                cex = cex.points, col = col.points), dots.for.points) )
-     }   
+        if(!is.null(gaps(x)) && do.points){
+           do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a, 
+                   cex = cex.points, col = col.points), dots.for.points) )
+           do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
+                   cex = cex.points, col = col.points), dots.for.points) )
+        }
+     }      
      if (mainL)
          mtext(text = main, side = 3, cex = cex.main, adj = .5, 
                outer = TRUE, padj = 1.4, col = col.main)                            
@@ -275,12 +290,25 @@
              col.hor = par("col"), col.vert = par("col"), 
              col.main = par("col.main"), col.inner = par("col.main"), 
              col.sub = par("col.sub"),  cex.points = 2.0, 
-             pch.u = 21, pch.a = 16, mfColRow = TRUE){
+             pch.u = 21, pch.a = 16, mfColRow = TRUE,
+             to.draw.arg = NULL){
 
       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)$"..."
+
+      to.draw <- 1:3
+      names(to.draw) <- c("d","p","q")
+      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
+      }
+      l.draw <- length(to.draw)
+
+
       dots$ngrid <- NULL
 
       dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
@@ -296,7 +324,7 @@
          {if(!is.list(inner))
               inner <- as.list(inner)
             #stop("Argument 'inner' must either be 'logical' or a 'list'")
-          inner <- .fillList(inner,3)          
+          inner <- .fillList(inner,l.draw)          
          }
 
      cex <- if (hasArg(cex)) dots$cex else 1
@@ -445,6 +473,7 @@
        o.warn <- getOption("warn")
        options(warn = -1)
        on.exit(options(warn=o.warn))
+     if(1%in%to.draw){
        do.call(plot, c(list(x = supp, dx, type = "h", pch = pch.a,
             ylim = ylim1, xlim=xlim, ylab = "d(x)", xlab = "x", 
             log = logpd), dots.without.pch))
@@ -459,12 +488,13 @@
                   cex = cex.points, col = col.points), dots.for.points))
        
        options(warn = -1)
+       }
+     ngrid <- length(supp)
 
-       ngrid <- length(supp)
+     supp1 <- if(ngrid>1) supp else c(-max(1,abs(supp))*.08,0)+supp
+     psupp1 <- c(0,p(x)(supp1))
 
-       supp1 <- if(ngrid>1) supp else c(-max(1,abs(supp))*.08,0)+supp
-       psupp1 <- c(0,p(x)(supp1))
-
+     if(2%in%to.draw){
        do.call(plot, c(list(x = stepfun(x = supp1, y = psupp1), 
                      main = "", verticals = verticals, 
                      do.points = FALSE, 
@@ -494,8 +524,9 @@
           do.call(points, c(list(x = supp, 
                   y = c(0,p(x)(supp[-length(supp)])), pch = pch.u, 
                   cex = cex.points, col = col.points), dots.for.points))
-       
-       
+     }  
+
+     if(3%in%to.draw){
        options(warn = -1)
        do.call(plot, c(list(x = stepfun(c(0,p(x)(supp)), 
                             c(NA,supp,NA), right = TRUE), 
@@ -532,13 +563,13 @@
            do.call(lines, c(list(x = rep(p(x)(supp[1]),2), y = c(supp[1],supp[2]),  
                   col = col.vert), dots.without.pch0))
           }
-                             
+       }                      
        
-       if (mainL)
+     if (mainL)
            mtext(text = main, side = 3, cex = cex.main, adj = .5, 
                  outer = TRUE, padj = 1.4, col = col.main)                            
        
-       if (subL)
+     if (subL)
            mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
                  outer = TRUE, line = -1.6, col = col.sub)                            
    return(invisible())

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 11:58:37 UTC (rev 381)
+++ branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R	2009-01-26 15:39:41 UTC (rev 382)
@@ -11,7 +11,7 @@
              col.hor = par("col"), col.vert = par("col"),
              col.main = par("col.main"), col.inner = par("col.main"),
              col.sub = par("col.sub"),  cex.points = 2.0,
-             pch.u = 21, pch.a = 16, mfColRow = TRUE){
+             pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL){
 
       mc <- as.list(match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1])
       do.call(getMethod("plot",
@@ -30,7 +30,7 @@
              col.hor = par("col"), col.vert = par("col"),
              col.main = par("col.main"), col.inner = par("col.main"),
              col.sub = par("col.sub"),  cex.points = 2.0,
-             pch.u = 21, pch.a = 16, mfColRow = TRUE){
+             pch.u = 21, pch.a = 16, mfColRow = TRUE, to.draw.arg = NULL){
 
       mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1]
       xc <- mc$x
@@ -42,12 +42,23 @@
                                            y = "missing"))
       plotC <- getMethod("plot", signature(x = "AbscontDistribution", 
                                            y = "missing"))
+
+      to.draw <- 1:8
+      names(to.draw) <- c("p","q","d.c","p.c","q.c","d.d","p.d","q.d")
+      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
+      }
+      l.draw <- length(to.draw)
       
       if(!is(x, "UnivarLebDecDistribution")) 
           x <- .ULC.cast(x)
 
       if(is(x,"DiscreteDistribution")){
          mcl <- as.list(mc)
+         mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )] 
          mcl$ngrid <- NULL
             if(!is.logical(inner)){
                 if(length(inner)!=3)
@@ -61,6 +72,7 @@
       if(is(x,"AbscontDistribution")){
          mcl <- as.list(mc)
          mcl$col.hor <- NULL
+         mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )] 
             if(!is.logical(inner)){
                 if(length(inner)!=3)
                    {inner <- .fillList(inner, 8)
@@ -75,6 +87,7 @@
          x <- x at mixDistr[[2]]
          mcl <- as.list(mc)
          mcl$x <- x
+         mcl$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )] 
          mcl$ngrid <- NULL
             if(!is.logical(inner)){
                 if(length(inner)!=3)
@@ -89,6 +102,7 @@
          x <- x at mixDistr[[1]]
          mcl <- as.list(mc)
          mcl$x <- x
+         mcl$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )] 
          mcl$col.hor <- NULL
             if(!is.logical(inner)){
                 if(length(inner)!=3)
@@ -100,8 +114,6 @@
         }
 
 
-
-
       dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty","ngrid")]
       if (length(dots.for.points) == 0 ) dots.for.points <- NULL
 
@@ -116,7 +128,7 @@
          {if(!is.list(inner))
               inner <- as.list(inner)
             #stop("Argument 'inner' must either be 'logical' or a 'list'")
-          inner <- .fillList(inner,8)          
+          inner <- .fillList(inner,l.draw)          
          }
      cex <- if (hasArg(cex)) dots$cex else 1
 
@@ -272,29 +284,30 @@
          pxv <- p(x)(xv)
      }
 
-     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),
-          dots.without.pch))
-     options(warn = o.warn)
-
-     pxg.d <- p(x)(supp)
-     pxg.d0 <- p(x)(supp-del)
-     if(do.points){
-        do.call(points, c(list(x = supp, y = pxg.d, pch = pch.a,
-                  cex = cex.points, col = col.points), dots.for.points))
-        do.call(points, c(list(x = supp-del, y = pxg.d0, pch = pch.u,
-                  cex = cex.points, col = col.points), dots.for.points))
+     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),
+             dots.without.pch))
+        options(warn = o.warn)
+   
+        pxg.d <- p(x)(supp)
+        pxg.d0 <- p(x)(supp-del)
+        if(do.points){
+           do.call(points, c(list(x = supp, y = pxg.d, pch = pch.a,
+                     cex = cex.points, col = col.points), dots.for.points))
+           do.call(points, c(list(x = supp-del, y = pxg.d0, pch = pch.u,
+                     cex = cex.points, col = col.points), dots.for.points))
+        }
+        if(verticals){
+            do.call(lines, c(list(x = xv, y = pxv, col = col.vert),
+                    dots.v))
+        }
+   
+        title(main = inner.p, line = lineT, cex.main = cex.inner,
+              col.main = col.inner)
      }
-     if(verticals){
-         do.call(lines, c(list(x = xv, y = pxv, col = col.vert),
-                 dots.v))
-     }
-
-     title(main = inner.p, line = lineT, cex.main = cex.inner,
-           col.main = col.inner)
-
      ### quantiles
 
      ### fix finite support bounds
@@ -330,67 +343,70 @@
         xo <- grid
      }
 
-     options(warn = -1)
-     do.call(plot, c(list(x = po, xo, type = "n",
-          xlim = ylim, ylim = xlim, ylab = "q(p)", xlab = "p",
-          log = logq), dots.without.pch), envir = parent.frame(2))
-     options(warn = o.warn)
+     if(2 %in% to.draw){
+        options(warn = -1)
+        do.call(plot, c(list(x = po, xo, type = "n",
+             xlim = ylim, ylim = xlim, ylab = "q(p)", xlab = "p",
+             log = logq), dots.without.pch), envir = parent.frame(2))
+        options(warn = o.warn)
+   
+   
+        title(main = inner.q, line = lineT, cex.main = cex.inner,
+              col.main = col.inner)
+   
+        options(warn = -1)
+        do.call(lines, c(list(x=po, y=xo), dots.for.lines))
+   #    if (verticals && !is.null(gaps(x))){
+   #         do.call(lines, c(list(rep(pu1,2), c(gaps(x)[,1],gaps(x)[,2]),
+   #                 col = col.vert), dots.without.pch))
+   #     }
+        options(warn = o.warn)
+   
+   
+        if (verticals && !is.null(gaps(x))){
+                pu <- rep(pu1,3)
+                xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
+                o <- order(pu)
+                do.call(lines, c(list(pu[o], xu[o],
+                        col = col.vert), dots.v))
+         }
+        if(!is.null(gaps(x)) && do.points){
+            do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a,
+                    cex = cex.points, col = col.points), dots.for.points) )
+            do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
+                    cex = cex.points, col = col.points), dots.for.points) )
+       
+        }
 
-
-     title(main = inner.q, line = lineT, cex.main = cex.inner,
-           col.main = col.inner)
-
-     options(warn = -1)
-     do.call(lines, c(list(x=po, y=xo), dots.for.lines))
-#    if (verticals && !is.null(gaps(x))){
-#         do.call(lines, c(list(rep(pu1,2), c(gaps(x)[,1],gaps(x)[,2]),
-#                 col = col.vert), dots.without.pch))
-#     }
-     options(warn = o.warn)
-
-
-     if (verticals && !is.null(gaps(x))){
-             pu <- rep(pu1,3)
-             xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
-             o <- order(pu)
-             do.call(lines, c(list(pu[o], xu[o],
-                     col = col.vert), dots.v))
-     }
-     if(!is.null(gaps(x)) && do.points){
-        do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a,
-                cex = cex.points, col = col.points), dots.for.points) )
-        do.call(points, c(list(x = pu1, y = gaps(x)[,2], pch = pch.u,
-                cex = cex.points, col = col.points), dots.for.points) )
-
-     }
-
-     if(do.points){
-        if(is.finite(q(x)(0))) 
-           do.call(points, c(list(x = 0, y = q(x)(0), pch = pch.u,
-                cex = cex.points, col = col.points), dots.for.points) )
-        if(is.finite(q(x)(1))) 
-           do.call(points, c(list(x = 1, y = q(x)(1), pch = pch.a,
-                cex = cex.points, col = col.points), dots.for.points) )
-     }
-     if (mainL)
-         mtext(text = main, side = 3, cex = cex.main, adj = .5,
-               outer = TRUE, padj = 1.4, col = col.main)
-
-     if (subL)
-         mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
-               outer = TRUE, line = -1.6, col = col.sub)
-               
-     mc.ac <- mc
-     if(!is.logical(inner)) 
-         mc.ac$inner <- lapply(inner[3:5], function(x) 
-                               if(is.character(x))
-                                  as.character(eval(.mpresubs(x)))
-                               else .mpresubs(x)) 
+        if(do.points){
+           if(is.finite(q(x)(0))) 
+              do.call(points, c(list(x = 0, y = q(x)(0), pch = pch.u,
+                   cex = cex.points, col = col.points), dots.for.points) )
+           if(is.finite(q(x)(1))) 
+              do.call(points, c(list(x = 1, y = q(x)(1), pch = pch.a,
+                   cex = cex.points, col = col.points), dots.for.points) )
+        }
+        if (mainL)
+            mtext(text = main, side = 3, cex = cex.main, adj = .5,
+                  outer = TRUE, padj = 1.4, col = col.main)
+   
+        if (subL)
+            mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
+                  outer = TRUE, line = -1.6, col = col.sub)
+                  
+        }
+    mc.ac <- mc
+    if(!is.logical(inner)) 
+       mc.ac$inner <- lapply(inner[3:5], function(x) 
+                             if(is.character(x))
+                                as.character(eval(.mpresubs(x)))
+                             else .mpresubs(x)) 
      mc.ac$mfColRow <- FALSE
      mc.ac$main <- FALSE
      mc.ac$sub <- FALSE
      mc.ac$x <- NULL 
      mc.ac$withSweave <- TRUE 
+     mc.ac$to.draw.arg <- (1:3)[( (3:5) %in%to.draw )] 
      if(is.null(mc.ac$cex.inner))  mc.ac$cex.inner <- 0.9
      do.call(plotC, c(list(acPart(x)),mc.ac), envir = parent.frame(2))
 
@@ -406,6 +422,7 @@
      mc.di$x <- NULL
      mc.di$ngrid <- NULL
      mc.di$withSweave <- TRUE 
+     mc.di$to.draw.arg <- (1:3)[( (6:8) %in%to.draw )]
      if(is.null(mc.di$cex.inner))  mc.di$cex.inner <- 0.9
      do.call(plotD, c(list(discretePart(x)),mc.di), envir = parent.frame(2))
      return(invisible())

Modified: branches/distr-2.1/pkg/distr/chm/0distr-package.html
===================================================================
--- branches/distr-2.1/pkg/distr/chm/0distr-package.html	2009-01-26 11:58:37 UTC (rev 381)
+++ branches/distr-2.1/pkg/distr/chm/0distr-package.html	2009-01-26 15:39:41 UTC (rev 382)
@@ -160,6 +160,7 @@
 |&gt;|&gt;"UnivarMixingDistribution"
 |&gt;|&gt;|&gt;"UnivarLebDecDistribution"
 |&gt;|&gt;|&gt;|&gt;"AffLinUnivarLebDecDistribution"
+|&gt;|&gt;|&gt;"CompoundDistribution"
 |&gt;|&gt;"AbscontDistribution"
 |&gt;|&gt;|&gt;"AffLinAbscontDistribution"
 |&gt;|&gt;|&gt;"Arcsine"

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 11:58:37 UTC (rev 381)
+++ branches/distr-2.1/pkg/distr/chm/plot-methods.html	2009-01-26 15:39:41 UTC (rev 382)
@@ -38,7 +38,8 @@
      cex.main = par("cex.main"), cex.inner = 1.2, cex.sub = par("cex.sub"), 
      col.points = par("col"), col.vert = par("col"), col.main = par("col.main"),  
      col.inner = par("col.main"), col.sub = par("col.sub"), cex.points = 2.0, 
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 ## S4 method for signature 'DiscreteDistribution, missing':
 plot(x, width = 10, height = 5.5,
      withSweave = getdistrOption("withSweave"), xlim = NULL, ylim = NULL, verticals = TRUE,
@@ -47,7 +48,8 @@
      cex.main = par("cex.main"), cex.inner = 1.2, cex.sub = par("cex.sub"), 
      col.points = par("col"), col.hor = par("col"), col.vert = par("col"), 
      col.main = par("col.main"), col.inner = par("col.main"), 
-     col.sub = par("col.sub"),  cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     col.sub = par("col.sub"),  cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 ## S4 method for signature 'AffLinUnivarLebDecDistribution,
 ##   missing':
 plot(x, width = 10, 
@@ -57,7 +59,8 @@
      cex.inner = 1.2, cex.sub = par("cex.sub"), col.points = par("col"),
      col.hor = par("col"), col.vert = par("col"), col.main = par("col.main"), 
      col.inner = par("col.main"), col.sub = par("col.sub"),  cex.points = 2.0,
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 ## S4 method for signature 'UnivarLebDecDistribution,
 ##   missing':
 plot(x, width = 10, 
@@ -67,7 +70,8 @@
      cex.inner = 0.9, cex.sub = par("cex.sub"), col.points = par("col"),
      col.hor = par("col"), col.vert = par("col"), col.main = par("col.main"), 
      col.inner = par("col.main"), col.sub = par("col.sub"),  cex.points = 2.0,
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 ## S4 method for signature 'DistrList, missing':
 plot(x, ...)
 ## S4 method for signature 'CompoundDistribution, missing':
@@ -194,6 +198,20 @@
 <tr valign="top"><td><code>mfColRow</code></td>
 <td>
 shall default partition in panels be used &mdash; defaults to <code>TRUE</code></td></tr>
+<tr valign="top"><td><code>to.draw.arg</code></td>
+<td>
+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: in case of an object <code>x</code> of class 
+<code>"DiscreteDistribution"</code> or <code>"AbscontDistribution"</code> <code>c("d","p","q")</code>
+for density, c.d.f. and quantile function; in case of <code>x</code> a proper
+<code>"UnivarLebDecDistribution"</code> (with pos. weights for both discrete and
+abs. continuous part) names are 
+<code>c("p","q","d.c","p.c","q.c","d.d","p.d","q.d")</code>) 
+for c.d.f. and quantile function of the composed distribution and the respective
+three panels for the absolutely continuous and the discrete part, respectively; 
+</td></tr>
 <tr valign="top"><td><code>...</code></td>
 <td>
 addtional arguments for <code>plot</code> &mdash; see 
@@ -328,6 +346,6 @@
 </script>
 
 
-<hr><div align="center">[Package <em>distr</em> version 2.1 <a href="00Index.html">Index]</a></div>
+<hr><div align="center">[Package <em>distr</em> version 2.1 <a href="00Index.html">Index</a>]</div>
 
 </body></html>

Modified: branches/distr-2.1/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.1/pkg/distr/man/plot-methods.Rd	2009-01-26 11:58:37 UTC (rev 381)
+++ branches/distr-2.1/pkg/distr/man/plot-methods.Rd	2009-01-26 15:39:41 UTC (rev 382)
@@ -18,7 +18,8 @@
      cex.main = par("cex.main"), cex.inner = 1.2, cex.sub = par("cex.sub"), 
      col.points = par("col"), col.vert = par("col"), col.main = par("col.main"),  
      col.inner = par("col.main"), col.sub = par("col.sub"), cex.points = 2.0, 
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 \S4method{plot}{DiscreteDistribution,missing}(x, width = 10, height = 5.5,
      withSweave = getdistrOption("withSweave"), xlim = NULL, ylim = NULL, verticals = TRUE,
      do.points = TRUE, main = FALSE, inner = TRUE, sub = FALSE, 
@@ -26,7 +27,8 @@
      cex.main = par("cex.main"), cex.inner = 1.2, cex.sub = par("cex.sub"), 
      col.points = par("col"), col.hor = par("col"), col.vert = par("col"), 
      col.main = par("col.main"), col.inner = par("col.main"), 
-     col.sub = par("col.sub"),  cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     col.sub = par("col.sub"),  cex.points = 2.0, pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 \S4method{plot}{AffLinUnivarLebDecDistribution,missing}(x, width = 10, 
      height = 5.5, withSweave = getdistrOption("withSweave"), xlim = NULL, ylim = NULL, ngrid = 1000,
      verticals = TRUE, do.points = TRUE, main = FALSE, inner = TRUE, sub = FALSE,
@@ -34,7 +36,8 @@
      cex.inner = 1.2, cex.sub = par("cex.sub"), col.points = par("col"),
      col.hor = par("col"), col.vert = par("col"), col.main = par("col.main"), 
      col.inner = par("col.main"), col.sub = par("col.sub"),  cex.points = 2.0,
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 \S4method{plot}{UnivarLebDecDistribution,missing}(x, width = 10, 
      height = 14.5, withSweave = getdistrOption("withSweave"), xlim = NULL, ylim = NULL, ngrid = 1000,
      verticals = TRUE, do.points = TRUE, main = FALSE, inner = TRUE, sub = FALSE,
@@ -42,7 +45,8 @@
      cex.inner = 0.9, cex.sub = par("cex.sub"), col.points = par("col"),
      col.hor = par("col"), col.vert = par("col"), col.main = par("col.main"), 
      col.inner = par("col.main"), col.sub = par("col.sub"),  cex.points = 2.0,
-     pch.u = 21, pch.a = 16, mfColRow = TRUE)
+     pch.u = 21, pch.a = 16, mfColRow = TRUE,
+     to.draw.arg = NULL)
 \S4method{plot}{DistrList,missing}(x, ...)
 \S4method{plot}{CompoundDistribution,missing}(x, ...)
 }
@@ -107,6 +111,18 @@
   \item{pch.a}{character or integer code; plotting characters or symbols for
                attained value; see \code{\link[stats]{points}}}              
   \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: in case of an object \code{x} of class 
+  \code{"DiscreteDistribution"} or \code{"AbscontDistribution"} \code{c("d","p","q")}
+  for density, c.d.f. and quantile function; in case of \code{x} a proper
+  \code{"UnivarLebDecDistribution"} (with pos. weights for both discrete and
+  abs. continuous part) names are 
+  \code{c("p","q","d.c","p.c","q.c","d.d","p.d","q.d")}) 
+  for c.d.f. and quantile function of the composed distribution and the respective
+  three panels for the absolutely continuous and the discrete part, respectively; 
+  }
   \item{\dots}{addtional arguments for \code{plot} --- see 
                \code{\link[stats]{plot}}, 
                \code{\link[stats]{plot.default}}, 
@@ -208,6 +224,26 @@
 mymix <- UnivarLebDecDistribution(acPart = wg, discretePart = Binom(4,.4),
          acWeight = 0.4)
 plot(mymix)         
+#
+## selection of subpanels for plotting
+N <- 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 <- flat.mix(UnivarMixingDistribution(Unif(0,1),Unif(4,5),
+               withSimplify=FALSE))
+myLC <- 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 <- Pois(2)
+plot(as(P,"UnivarLebDecDistribution"),mfColRow = FALSE,to.draw.arg=c("d.d"))
+
 }
 \seealso{\code{\link[stats]{plot}},\code{\link[stats]{plot.default}}, 
          \code{\link[stats]{plot.stepfun}},  \code{\link[stats]{par}}}



More information about the Distr-commits mailing list