[chronojump] Better scientific notation on encoder cross variables functions



commit c8d1bacb9df07ea814b8ee2ad5ee5bd4a2588059
Author: Xavier de Blas <xaviblas gmail com>
Date:   Fri Jul 11 14:59:32 2014 +0200

    Better scientific notation on encoder cross variables functions

 encoder/graph.R |   46 +++++++++++++++++++++++++++++++++++++++++-----
 1 files changed, 41 insertions(+), 5 deletions(-)
---
diff --git a/encoder/graph.R b/encoder/graph.R
index 1a20cc3..7245579 100644
--- a/encoder/graph.R
+++ b/encoder/graph.R
@@ -1463,7 +1463,8 @@ plotSign <- function (num) {
 }
 
 getModelPValueWithStars <- function(model) {
-       p.value = round(getModelPValue(model),6)
+       #p.value = round(getModelPValue(model),6)
+       p.value = getModelPValue(model)
        
        #don't plot stars if p.value is nan because there's too few data
        if(is.nan(p.value))
@@ -1478,7 +1479,7 @@ getModelPValueWithStars <- function(model) {
                stars = "*"
        else if(p.value <= 0.01)
                stars = "."
-       return(paste(p.value, " ", stars, sep=""))
+       return(paste(round.scientific(p.value), " ", stars, sep=""))
 }
 #http://r.789695.n4.nabble.com/extract-the-p-value-tp3933973p3934011.html
 getModelPValue <- function(model) {
@@ -1487,6 +1488,41 @@ getModelPValue <- function(model) {
        pf(s$fstatistic[1L], s$fstatistic[2L], s$fstatistic[3L], lower.tail = FALSE)
 }
 
+#R returns zero on rounding if the exponent is bigger than the decimals of rounding. Eg:
+#> round(0.0002,3)
+#[1] 0
+#> round(0.0002,4)
+#[1] 2e-04
+#> round(-0.0002,3)
+#[1] 0
+#> round(-0.0002,4)
+#[1] -2e-04
+round.scientific <- function(x) {
+       print(c("at round.scientic",x))
+       if(x == 0)
+               return(0)
+
+       negative = FALSE
+       #the floor(log(10(x)) returns NaN if it's negative
+       if(x < 0) {
+               negative = TRUE
+               x = x * -1
+       }
+
+       
#http://r.789695.n4.nabble.com/Built-in-function-for-extracting-mantissa-and-exponent-of-a-numeric-td4670116.html
+       e <- floor(log10(x))
+       m <- x/10^e
+
+       if(negative)
+               m = m * -1
+
+       dec = 2
+       if(e == 0)
+               return(round(m,dec))
+       else
+               return(paste(round(m,dec),"e",e,sep=""))
+}
+
 #http://stackoverflow.com/a/6234664
 #see if two labels overlap
 stroverlap <- function(x1,y1,s1, x2,y2,s2) {
@@ -1680,9 +1716,9 @@ paintCrossVariables <- function (paf, varX, varY, option, isAlone, title, single
 
                                mtext(paste(
                                            varYut, " = ", 
-                                           round(coef.a,4), " * ", varXplot, "^2 ", plotSign(coef.b), " ",  
-                                           round(coef.b,4), " * ", varXplot, " ", plotSign(coef.c), " ", 
-                                           round(coef.c,4), sep=""), side=3, line=1, at=functionAt, 
adj=functionAdj, cex = .9)
+                                           round.scientific(coef.a), " * ", varXplot, "^2 ", 
plotSign(coef.b), " ",  
+                                           round.scientific(coef.b), " * ", varXplot, " ", plotSign(coef.c), 
" ", 
+                                           round.scientific(coef.c), sep=""), side=3, line=1, at=functionAt, 
adj=functionAdj, cex = .9)
                                mtext(paste(
                                            "R² = ", round(summary(fit)$r.squared,4),
                                            "; R² (adjusted) = ", round(summary(fit)$adj.r.squared,4),


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]