[Distr-commits] r581 - branches/distr-2.2/pkg pkg/distrMod/R

[noreply at r-forge.r-project.org]

Author: ruckdeschel
Date: 2009-09-10 02:44:57 +0200 (Thu, 10 Sep 2009)
New Revision: 581

Modified:
   branches/distr-2.2/pkg/qqplot.R
   pkg/distrMod/R/sqrt.R
Log:
yet some corrections in qqplot.R and some embarrassing error in sqrt for posdef matrices

Modified: branches/distr-2.2/pkg/qqplot.R
===================================================================
--- branches/distr-2.2/pkg/qqplot.R	2009-09-10 00:12:13 UTC (rev 580)
+++ branches/distr-2.2/pkg/qqplot.R	2009-09-10 00:44:57 UTC (rev 581)
@@ -94,7 +94,7 @@
     mcl$withLab <- mcl$lab.pts <- mcl$which.lbs <- NULL
     mcl$which.Order <- mcl$order.traf  <- NULL
     mcl$col.pch <- mcl$cex.pch  <- NULL
-    mcl$col.lbl <- mcl$cex.lbl  <- NULL
+    mcl$col.lbl <- mcl$cex.lbl  <- mcl$adj.lbl <- NULL
 mcl}
 
 .labelprep <- function(x,y,lab.pts,which.lbs,which.Order,order.traf){
@@ -192,7 +192,8 @@
              cex.pch = par("cex"),## magnification factor for the plotted symbols
              col.pch = par("col"),## color for the plotted symbols
              cex.lbl = par("cex"),## magnification factor for the plotted observation labels
-             col.lbl = par("col") ## color for the plotted observation labels
+             col.lbl = par("col"),## color for the plotted observation labels
+             adj.lbl = NULL       ## adj parameter for the plotted observation labels
     ){ ## return value as in stats::qqplot
 
     mc <- match.call(call = sys.call(sys.parent(1)))
@@ -218,7 +219,7 @@
     if(withLab&& plot.it){
       lbprep <- .labelprep(x,yc,lab.pts,which.lbs,which.Order,order.traf)
        text(x = lbprep$x0, y = lbprep$y0, labels = lbprep$lab,
-            cex = cex.lbl, col = col.lbl)
+            cex = cex.lbl, col = col.lbl, adj = adj.lbl)
     }
 
     if(withIdLine&& plot.it){
@@ -322,9 +323,9 @@
     mcl$y <- y at center
 
     L2D <- L2deriv(y at center)
-    FI <- FisherInfo(y at center)
-    L2Dx <- sapply(x, function(x) evalRandVar(L2D,x)[[1]])
-    scx <-  solve(sqrt(FI),L2Dx)
+    FI <- PosSemDefSymmMatrix(FisherInfo(y at center))
+    L2Dx <- sapply(x, function(z) evalRandVar(L2D,z)[[1]])
+    scx <-  solve(sqrt(FI),matrix(L2Dx,ncol=length(x)))
     xD <- fct(distance)(scx)
     x.cex <- 3/(1+log(1+xD))
     mcl$cex.pch <- x.cex

Modified: pkg/distrMod/R/sqrt.R
===================================================================
--- pkg/distrMod/R/sqrt.R	2009-09-10 00:12:13 UTC (rev 580)
+++ pkg/distrMod/R/sqrt.R	2009-09-10 00:44:57 UTC (rev 581)
@@ -1,6 +1,6 @@
 setMethod("sqrt", signature(x = "PosSemDefSymmMatrix"), function(x){
             er <- eigen(x)
             d <- sqrt(er$values)
-            return(er$vectors %*% diag(d) %*% t(er$vectors))
+            return(er$vectors %*% diag(d,nrow=length(d)) %*% t(er$vectors))
 })