[Distr-commits] r582 - branches/distr-2.2/pkg

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Sep 10 02:51:21 CEST 2009


Author: ruckdeschel
Date: 2009-09-10 02:51:21 +0200 (Thu, 10 Sep 2009)
New Revision: 582

Modified:
   branches/distr-2.2/pkg/qqplot.R
Log:
and yet some corrections...

Modified: branches/distr-2.2/pkg/qqplot.R
===================================================================
--- branches/distr-2.2/pkg/qqplot.R	2009-09-10 00:44:57 UTC (rev 581)
+++ branches/distr-2.2/pkg/qqplot.R	2009-09-10 00:51:21 UTC (rev 582)
@@ -3,6 +3,7 @@
 # yet to be documented and ranged into distr, distrMod, RobAStBase
 ################################################################
 
+### to be written into the respective MASKING files....
 
 ## into distr
 if(!isGeneric("qqplot"))
@@ -23,6 +24,7 @@
 ## into distr
 
 ## helpers
+
 .q2kolmogorov <- function(alpha,n,exact=(n<100)){ ## Kolmogorovstat
  if(exact){
  fct <- function(p0){
@@ -59,7 +61,8 @@
    pbinom(q = pmin(n*p1.bi+t*sqrt(n),n+1), size = n, prob = p1.bi) -
    pbinom(q = pmax(n*p1.bi-t*sqrt(n),-1), size = n, prob = p1.bi)-alpha
   }
-  sapply(p, function(p2) uniroot(fct, lower=0, upper=sqrt(n)+1,p1.bi=p2,tol=1e-9)$root)
+  sapply(p, function(p2) uniroot(fct, lower=0, upper=sqrt(n)+1,
+         p1.bi = p2, tol = 1e-9)$root)
 }
 
 .confqq <- function(x,D,alpha,col.pCI,lty.pCI,lwd.pCI,col.sCI,lty.sCI,lwd.sCI,
@@ -97,6 +100,7 @@
     mcl$col.lbl <- mcl$cex.lbl  <- mcl$adj.lbl <- NULL
 mcl}
 
+## helper into distrMod
 .labelprep <- function(x,y,lab.pts,which.lbs,which.Order,order.traf){
       n <- length(x)
       xys <- cbind(x,y[rank(x)])
@@ -118,6 +122,7 @@
       return(list(x0=x0,y0=y0,lab=lab.pts))
 }
 
+## into distr:
 setMethod("qqplot", signature(x = "UnivariateDistribution",
                               y = "UnivariateDistribution"), function(x, y,
                               n = 30, withIdLine = TRUE, withConf = TRUE,
@@ -240,18 +245,7 @@
                               y = "ProbFamily"), function(x, y,
                               n = length(x), withIdLine = TRUE, withConf = TRUE,
     plot.it = TRUE, xlab = deparse(substitute(x)),
-    ylab = deparse(substitute(y)), ...,
-    withLab = TRUE, lab.pts = NULL,
-    which.lbs = NULL, which.Order = NULL, order.traf = NULL,
-    col.IdL = "red", lty.IdL = 2, lwd.IdL = 2,
-    alpha.CI = .95, exact.sCI = (n<100),
-    col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2,
-    col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2,
-    cex.pch=par("cex"), col.pch = par("col"),
-    cex.lbl = par("cex"), col.lbl = par("col"),
-    cex.pch=par("cex"), col.pch = par("col"),
-    cex.lbl = par("cex"), col.lbl = par("col")
-    ){
+    ylab = deparse(substitute(y)), ...){
 
     mc <- match.call(call = sys.call(sys.parent(1)))
     if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
@@ -273,16 +267,7 @@
                               y = "RobModel"), function(x, y,
                               n = length(x), withIdLine = TRUE, withConf = TRUE,
     plot.it = TRUE, xlab = deparse(substitute(x)),
-    ylab = deparse(substitute(y)), ...,
-    withLab = TRUE, lab.pts = NULL,
-    which.lbs = NULL, which.Order = NULL, order.traf = NULL,
-    col.IdL = "red", lty.IdL = 2, lwd.IdL = 2,
-    alpha.CI = .95, exact.sCI = (n<100),
-    col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2,
-    col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2,
-    col.pch = par("col"),
-    cex.lbl = par("cex"), col.lbl = par("col"),
-    distance = NormType()){
+    ylab = deparse(substitute(y)), ..., distance = NormType()){
 
     mc <- match.call(call = sys.call(sys.parent(1)))
     if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
@@ -304,16 +289,7 @@
                               y = "InfRobModel"), function(x, y,
                               n = length(x), withIdLine = TRUE, withConf = TRUE,
     plot.it = TRUE, xlab = deparse(substitute(x)),
-    ylab = deparse(substitute(y)), ...,
-    withLab = TRUE, lab.pts = NULL,
-    which.lbs = NULL, which.Order = NULL, order.traf = NULL,
-    col.IdL = "red", lty.IdL = 2, lwd.IdL = 2,
-    alpha.CI = .95, exact.sCI = (n<100),
-    col.pCI = "orange", lty.pCI = 3, lwd.pCI = 2,
-    col.sCI = "tomato2", lty.sCI = 4, lwd.sCI = 2,
-    col.pch = par("col"),
-    cex.lbl = par("cex"), col.lbl = par("col"),
-    distance = NormType()){
+    ylab = deparse(substitute(y)), ...){
 
     mc <- match.call(call = sys.call(sys.parent(1)))
     if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))



More information about the Distr-commits mailing list