[Distr-commits] r697 - branches/distr-2.4/pkg/distr/R branches/distr-2.4/pkg/distrMod/R branches/distr-2.4/pkg/distrSim/R branches/distr-2.4/pkg/distrTEst/R branches/distr-2.4/pkg/distrTeach/R pkg/distr/R pkg/distrMod/R pkg/distrSim/R pkg/distrTEst/R pkg/distrTeach/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 2 18:37:15 CET 2010


Author: ruckdeschel
Date: 2010-12-02 18:37:15 +0100 (Thu, 02 Dec 2010)
New Revision: 697

Added:
   branches/distr-2.4/pkg/distrTEst/R/Utility0.R
   pkg/distrTEst/R/Utility0.R
Removed:
   branches/distr-2.4/pkg/distrTEst/R/Utility.r
   pkg/distrTEst/R/Utility.r
Modified:
   branches/distr-2.4/pkg/distr/R/internalUtils.R
   branches/distr-2.4/pkg/distr/R/plot-methods.R
   branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R
   branches/distr-2.4/pkg/distrMod/R/AllPlot.R
   branches/distr-2.4/pkg/distrSim/R/plot-methods.R
   branches/distr-2.4/pkg/distrTEst/R/AllClasses.R
   branches/distr-2.4/pkg/distrTEst/R/plot-methods.R
   branches/distr-2.4/pkg/distrTeach/R/illustCLT.R
   branches/distr-2.4/pkg/distrTeach/R/illustLLN.R
   pkg/distr/R/internalUtils.R
   pkg/distr/R/plot-methods.R
   pkg/distr/R/plot-methods_LebDec.R
   pkg/distrMod/R/AllPlot.R
   pkg/distrSim/R/plot-methods.R
   pkg/distrTEst/R/AllClasses.R
   pkg/distrTEst/R/plot-methods.R
   pkg/distrTeach/R/illustCLT.R
   pkg/distrTeach/R/illustLLN.R
Log:
+ canceled assignments of type omar$cin <- NULL
+ renaming schedule I for Utility.R in distrTEst
+ some coercings to logical forced (seen in tests), e.g. AllClasses.R in distrTEst

Modified: branches/distr-2.4/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/internalUtils.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distr/R/internalUtils.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -134,7 +134,7 @@
 if (length(inCx) > 1) {
    inCx <- paste(inCx, c(rep(",", length(inCx)-1), ""),
                  sep = "", collapse = "\"\\n\",")
-   if ( any(c(lapply(inp,is.language))) | logic )
+   if ( any(as.logical(c(lapply(inp,is.language)))) | logic )
       inCx <- paste("expression(paste(", gsub("\\\\n"," ", inCx), "))", sep ="")
    else
       inCx <- paste("paste(",inCx,")", sep ="")
@@ -612,7 +612,6 @@
 #x0 <- x00[idx]               ### maximal x's
 #y0 <- y00[idx]
 #f1 <- approxfun(x = x0, y = y0, yleft = y0[1], yright = y0[length(y0)])
-
 yleft <- yleft[1]
 yright <- yright[1]
 
@@ -622,8 +621,8 @@
 
 l0 <- length(unique(x[!.isEqual01(x)]))
 if(l0 > 1){
-   yl <- if(is.finite(yleft)) yleft  else y[1]
-   yr <- if(is.finite(yright)) yright else y[length(y)]
+   yl <- if(!is.na(yleft) && is.finite(yleft))  yleft  else y[1]
+   yr <- if(!is.na(yright)&& is.finite(yright)) yright else y[length(y)]
 
    f1 <- approxfun(x = x, y = y, yleft = yl, yright = yr)
 }else{ 

Modified: branches/distr-2.4/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distr/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -68,7 +68,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+#     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) on.exit(par(omar, no.readonly = TRUE))
      
      mainL <- FALSE
@@ -368,7 +368,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+ #    omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) on.exit(par(omar, no.readonly = TRUE))
      
      mainL <- FALSE

Modified: branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distr/R/plot-methods_LebDec.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -155,7 +155,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+ #    omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) (on.exit(par(omar, no.readonly = TRUE)))
      
      mainL <- FALSE

Modified: branches/distr-2.4/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.4/pkg/distrMod/R/AllPlot.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrMod/R/AllPlot.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -211,7 +211,7 @@
         options(warn = -1)
         on.exit(options(warn=o.warn))
         opar <- par(no.readonly = TRUE)
-        opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+   #     opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
         on.exit(par(opar, no.readonly = TRUE))
         
         if (!withSweave)

Modified: branches/distr-2.4/pkg/distrSim/R/plot-methods.R
===================================================================
--- branches/distr-2.4/pkg/distrSim/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrSim/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -40,7 +40,7 @@
 #            get(getOption("device"))()
 
             opar <- par(no.readonly = TRUE)
-            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+#            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
             on.exit(par(opar))
 
             o.warn <- getOption("warn")

Modified: branches/distr-2.4/pkg/distrTEst/R/AllClasses.R
===================================================================
--- branches/distr-2.4/pkg/distrTEst/R/AllClasses.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrTEst/R/AllClasses.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -51,50 +51,50 @@
                            ncol = 2, byrow = TRUE)
            if(!all( apply(dimes, 2, function(x) all(x == x[1]))))
               stop("the result slots of all list elements have to be of the same dimension")
-           if(!all(lapply(object at Elist,
+           if(!all(as.logical(lapply(object at Elist,
                    function(x)
                       identical(x at call.ev$object,
                                object at Elist[[1]]@call.ev$object)
                          )
-                   )
+                   ))
              )
               stop("the call slots of all list elements have to have the same object[=Data]-argument")
            if((is(object at Elist[[1]]@Data,"Simulation"))||
               (is(object at Elist[[1]]@Data,"Contsimulation")))
-              {if(!all(lapply(object at Elist,
+              {if(!all(as.logical(lapply(object at Elist,
                               function(x) identical(x at Data@seed,
                                                     object at Elist[[1]]@Data at seed)
-                              )))
+                              ))))
                    stop("the seeds of the Data slots of all list elements have to coincide")
                if(is(object at Elist[[1]]@Data,"Contsimulation"))
-                   {if(!all(lapply(object at Elist,
+                   {if(!all(as.logical(lapply(object at Elist,
                               function(x) identical(
                                 body(x at Data@distribution.id at p),
                                 body(object at Elist[[1]]@Data at distribution.id@p)))
                             )
-                       )
+                       ))
                         stop("the ideal distribution of the Data slots of all list elements have to coincide")
-                    if(!all(lapply(object at Elist,
+                    if(!all(as.logical(lapply(object at Elist,
                                function(x) identical(
                                  body(x at Data@distribution.c at p),
                                  body(object at Elist[[1]]@Data at distribution.c@p)))
                            )
-                      )
+                      ))
                         stop("the contaminating distribution of the Data slots of all list elements have to coincide")
                     }
                else
-                    if(!all(lapply(object at Elist,
+                    if(!all(as.logical(lapply(object at Elist,
                                function(x) identical(
                                  body(x at Data@distribution at p),
-                                 body(object at Elist[[1]]@Data at distribution@p)))))
+                                 body(object at Elist[[1]]@Data at distribution@p))))))
                         stop("the distribution of the Data slots of all list elements have to coincide")
 
            }else{
-               if(!all(lapply(object at Elist,
+               if(!all(as.logical(lapply(object at Elist,
                           function(x) identical(
                             x at Data,object at Elist[[1]]@Data))
                        )
-                 )
+                 ))
                    stop("the Data slots of all list elements have to coincide")
            }
          }

Deleted: branches/distr-2.4/pkg/distrTEst/R/Utility.r
===================================================================
--- branches/distr-2.4/pkg/distrTEst/R/Utility.r	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrTEst/R/Utility.r	2010-12-02 17:37:15 UTC (rev 697)
@@ -1,30 +0,0 @@
-.convert.result.format<-function(x, resname="res"){
-  if(is.list(x))
-     {rdim <- length(x)
-      cnames <- names(x[[1]])
-      if(is.null(cnames))
-          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
-      else
-          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
-      x <- data.frame(matrix(unlist(x),nrow=rdim, byrow=TRUE))
-      colnames(x) <- cnames
-     }
-  else if(is.matrix(x))
-     {x <- t(x)
-      cdim <- ncol(x)
-      cnames <- colnames(x)
-      if(is.null(cnames))
-          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
-      else
-          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
-      x <- data.frame(x)
-      colnames(x) <- cnames
-     }
-  else if (!is.data.frame(x))
-     {x <- data.frame(x)
-      names(x) <- abbreviate(resname)
-     }
-  return(x)
-}
-
-

Copied: branches/distr-2.4/pkg/distrTEst/R/Utility0.R (from rev 694, branches/distr-2.4/pkg/distrTEst/R/Utility.r)
===================================================================
--- branches/distr-2.4/pkg/distrTEst/R/Utility0.R	                        (rev 0)
+++ branches/distr-2.4/pkg/distrTEst/R/Utility0.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -0,0 +1,30 @@
+.convert.result.format<-function(x, resname="res"){
+  if(is.list(x))
+     {rdim <- length(x)
+      cnames <- names(x[[1]])
+      if(is.null(cnames))
+          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
+      else
+          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
+      x <- data.frame(matrix(unlist(x),nrow=rdim, byrow=TRUE))
+      colnames(x) <- cnames
+     }
+  else if(is.matrix(x))
+     {x <- t(x)
+      cdim <- ncol(x)
+      cnames <- colnames(x)
+      if(is.null(cnames))
+          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
+      else
+          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
+      x <- data.frame(x)
+      colnames(x) <- cnames
+     }
+  else if (!is.data.frame(x))
+     {x <- data.frame(x)
+      names(x) <- abbreviate(resname)
+     }
+  return(x)
+}
+
+

Modified: branches/distr-2.4/pkg/distrTEst/R/plot-methods.R
===================================================================
--- branches/distr-2.4/pkg/distrTEst/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrTEst/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -116,7 +116,7 @@
         options("warn" = o.warn) }
 
   opar <- par(no.readonly = TRUE)
-  opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+  # opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
   on.exit(par(opar))
   par(mfrow=c(resdim0,1))
 

Modified: branches/distr-2.4/pkg/distrTeach/R/illustCLT.R
===================================================================
--- branches/distr-2.4/pkg/distrTeach/R/illustCLT.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrTeach/R/illustCLT.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -46,7 +46,7 @@
                 dTn <- d(Tn)(supp)
                 ymax <- max(1/sqrt(2*pi), dTn)
                 opar <- par(no.readonly = TRUE)
-                opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+    #            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
                 on.exit(par(opar))
                 dw <- min(diff(supp)) 
                 facD <- min(dw*2,1)

Modified: branches/distr-2.4/pkg/distrTeach/R/illustLLN.R
===================================================================
--- branches/distr-2.4/pkg/distrTeach/R/illustLLN.R	2010-12-02 15:55:52 UTC (rev 696)
+++ branches/distr-2.4/pkg/distrTeach/R/illustLLN.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -71,7 +71,7 @@
   da <- matrix(NA,m,length(n))
   
   omar <- par(no.readonly = TRUE)
-  omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+#  omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
   on.exit(par(omar))
      ## getting the parameter
 

Modified: pkg/distr/R/internalUtils.R
===================================================================
--- pkg/distr/R/internalUtils.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distr/R/internalUtils.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -134,7 +134,7 @@
 if (length(inCx) > 1) {
    inCx <- paste(inCx, c(rep(",", length(inCx)-1), ""),
                  sep = "", collapse = "\"\\n\",")
-   if ( any(c(lapply(inp,is.language))) | logic )
+   if ( any(as.logical(c(lapply(inp,is.language)))) | logic )
       inCx <- paste("expression(paste(", gsub("\\\\n"," ", inCx), "))", sep ="")
    else
       inCx <- paste("paste(",inCx,")", sep ="")

Modified: pkg/distr/R/plot-methods.R
===================================================================
--- pkg/distr/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distr/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -68,7 +68,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+#     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) on.exit(par(omar, no.readonly = TRUE))
      
      mainL <- FALSE
@@ -368,7 +368,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+ #    omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) on.exit(par(omar, no.readonly = TRUE))
      
      mainL <- FALSE

Modified: pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- pkg/distr/R/plot-methods_LebDec.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distr/R/plot-methods_LebDec.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -155,7 +155,7 @@
            devNew(width = width, height = height)
            }
      omar <- par("mar", no.readonly = TRUE)
-     omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+ #    omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
      if(mfColRow) (on.exit(par(omar, no.readonly = TRUE)))
      
      mainL <- FALSE

Modified: pkg/distrMod/R/AllPlot.R
===================================================================
--- pkg/distrMod/R/AllPlot.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrMod/R/AllPlot.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -211,7 +211,7 @@
         options(warn = -1)
         on.exit(options(warn=o.warn))
         opar <- par(no.readonly = TRUE)
-        opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+   #     opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
         on.exit(par(opar, no.readonly = TRUE))
         
         if (!withSweave)

Modified: pkg/distrSim/R/plot-methods.R
===================================================================
--- pkg/distrSim/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrSim/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -40,7 +40,7 @@
 #            get(getOption("device"))()
 
             opar <- par(no.readonly = TRUE)
-            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+#            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
             on.exit(par(opar))
 
             o.warn <- getOption("warn")

Modified: pkg/distrTEst/R/AllClasses.R
===================================================================
--- pkg/distrTEst/R/AllClasses.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrTEst/R/AllClasses.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -51,50 +51,50 @@
                            ncol = 2, byrow = TRUE)
            if(!all( apply(dimes, 2, function(x) all(x == x[1]))))
               stop("the result slots of all list elements have to be of the same dimension")
-           if(!all(lapply(object at Elist,
+           if(!all(as.logical(lapply(object at Elist,
                    function(x)
                       identical(x at call.ev$object,
                                object at Elist[[1]]@call.ev$object)
                          )
-                   )
+                   ))
              )
               stop("the call slots of all list elements have to have the same object[=Data]-argument")
            if((is(object at Elist[[1]]@Data,"Simulation"))||
               (is(object at Elist[[1]]@Data,"Contsimulation")))
-              {if(!all(lapply(object at Elist,
+              {if(!all(as.logical(lapply(object at Elist,
                               function(x) identical(x at Data@seed,
                                                     object at Elist[[1]]@Data at seed)
-                              )))
+                              ))))
                    stop("the seeds of the Data slots of all list elements have to coincide")
                if(is(object at Elist[[1]]@Data,"Contsimulation"))
-                   {if(!all(lapply(object at Elist,
+                   {if(!all(as.logical(lapply(object at Elist,
                               function(x) identical(
                                 body(x at Data@distribution.id at p),
                                 body(object at Elist[[1]]@Data at distribution.id@p)))
                             )
-                       )
+                       ))
                         stop("the ideal distribution of the Data slots of all list elements have to coincide")
-                    if(!all(lapply(object at Elist,
+                    if(!all(as.logical(lapply(object at Elist,
                                function(x) identical(
                                  body(x at Data@distribution.c at p),
                                  body(object at Elist[[1]]@Data at distribution.c@p)))
                            )
-                      )
+                      ))
                         stop("the contaminating distribution of the Data slots of all list elements have to coincide")
                     }
                else
-                    if(!all(lapply(object at Elist,
+                    if(!all(as.logical(lapply(object at Elist,
                                function(x) identical(
                                  body(x at Data@distribution at p),
-                                 body(object at Elist[[1]]@Data at distribution@p)))))
+                                 body(object at Elist[[1]]@Data at distribution@p))))))
                         stop("the distribution of the Data slots of all list elements have to coincide")
 
            }else{
-               if(!all(lapply(object at Elist,
+               if(!all(as.logical(lapply(object at Elist,
                           function(x) identical(
                             x at Data,object at Elist[[1]]@Data))
                        )
-                 )
+                 ))
                    stop("the Data slots of all list elements have to coincide")
            }
          }

Deleted: pkg/distrTEst/R/Utility.r
===================================================================
--- pkg/distrTEst/R/Utility.r	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrTEst/R/Utility.r	2010-12-02 17:37:15 UTC (rev 697)
@@ -1,30 +0,0 @@
-.convert.result.format<-function(x, resname="res"){
-  if(is.list(x))
-     {rdim <- length(x)
-      cnames <- names(x[[1]])
-      if(is.null(cnames))
-          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
-      else
-          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
-      x <- data.frame(matrix(unlist(x),nrow=rdim, byrow=TRUE))
-      colnames(x) <- cnames
-     }
-  else if(is.matrix(x))
-     {x <- t(x)
-      cdim <- ncol(x)
-      cnames <- colnames(x)
-      if(is.null(cnames))
-          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
-      else
-          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
-      x <- data.frame(x)
-      colnames(x) <- cnames
-     }
-  else if (!is.data.frame(x))
-     {x <- data.frame(x)
-      names(x) <- abbreviate(resname)
-     }
-  return(x)
-}
-
-

Copied: pkg/distrTEst/R/Utility0.R (from rev 694, pkg/distrTEst/R/Utility.r)
===================================================================
--- pkg/distrTEst/R/Utility0.R	                        (rev 0)
+++ pkg/distrTEst/R/Utility0.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -0,0 +1,30 @@
+.convert.result.format<-function(x, resname="res"){
+  if(is.list(x))
+     {rdim <- length(x)
+      cnames <- names(x[[1]])
+      if(is.null(cnames))
+          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
+      else
+          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
+      x <- data.frame(matrix(unlist(x),nrow=rdim, byrow=TRUE))
+      colnames(x) <- cnames
+     }
+  else if(is.matrix(x))
+     {x <- t(x)
+      cdim <- ncol(x)
+      cnames <- colnames(x)
+      if(is.null(cnames))
+          cnames <- paste(abbreviate(resname),1:cdim,sep=".")
+      else
+          cnames <- paste(abbreviate(resname),abbreviate(names(x[[1]])),sep=".")
+      x <- data.frame(x)
+      colnames(x) <- cnames
+     }
+  else if (!is.data.frame(x))
+     {x <- data.frame(x)
+      names(x) <- abbreviate(resname)
+     }
+  return(x)
+}
+
+

Modified: pkg/distrTEst/R/plot-methods.R
===================================================================
--- pkg/distrTEst/R/plot-methods.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrTEst/R/plot-methods.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -116,7 +116,7 @@
         options("warn" = o.warn) }
 
   opar <- par(no.readonly = TRUE)
-  opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+  # opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
   on.exit(par(opar))
   par(mfrow=c(resdim0,1))
 

Modified: pkg/distrTeach/R/illustCLT.R
===================================================================
--- pkg/distrTeach/R/illustCLT.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrTeach/R/illustCLT.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -46,7 +46,7 @@
                 dTn <- d(Tn)(supp)
                 ymax <- max(1/sqrt(2*pi), dTn)
                 opar <- par(no.readonly = TRUE)
-                opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
+    #            opar$cin <- opar$cra <- opar$csi <- opar$cxy <-  opar$din <- NULL
                 on.exit(par(opar))
                 dw <- min(diff(supp)) 
                 facD <- min(dw*2,1)

Modified: pkg/distrTeach/R/illustLLN.R
===================================================================
--- pkg/distrTeach/R/illustLLN.R	2010-12-02 15:55:52 UTC (rev 696)
+++ pkg/distrTeach/R/illustLLN.R	2010-12-02 17:37:15 UTC (rev 697)
@@ -71,7 +71,7 @@
   da <- matrix(NA,m,length(n))
   
   omar <- par(no.readonly = TRUE)
-  omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
+#  omar$cin <- omar$cra <- omar$csi <- omar$cxy <-  omar$din <- NULL
   on.exit(par(omar))
      ## getting the parameter
 



More information about the Distr-commits mailing list