[chronojump] faster encoder:extrema in graph.R, do not call EMD

[Xavier de Blas <xaviblas src gnome org>]

commit 4b82ba333c88443f2fe243ebf4409eea89a15868
Author: Xavier de Blas <xaviblas gmail com>
Date:   Tue Feb 11 00:43:18 2014 +0100

    faster encoder:extrema in graph.R, do not call EMD

 encoder/graph.R |   77 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 76 insertions(+), 1 deletions(-)
---
diff --git a/encoder/graph.R b/encoder/graph.R
index f7b50dc..9f19842 100644
--- a/encoder/graph.R
+++ b/encoder/graph.R
@@ -108,6 +108,81 @@ EncoderConfiguration = ""
 
 write("(1/5) Starting R", OutputData2)
 
+#extrema function is part of EMD package
+#It's included here to save time, because 'library("EMD")' is quite time consuming
+extrema <- function(y, ndata = length(y), ndatam1 = ndata - 1) {
+
+       minindex <- maxindex <- NULL; nextreme <- 0; cross <- NULL; ncross <- 0 
+
+       z1 <- sign(diff(y))
+       index1 <- seq(1, ndatam1)[z1 != 0]; z1 <- z1[z1 != 0]  
+
+       if (!(is.null(index1) || all(z1==1) || all(z1==-1))) {
+
+               index1 <- index1[c(z1[-length(z1)] != z1[-1], FALSE)] + 1 
+               z1 <- z1[c(z1[-length(z1)] != z1[-1], FALSE)]  
+
+               nextreme <- length(index1)
+
+               if(nextreme >= 2)
+                       for(i in 1:(nextreme-1)) {
+                               tmpindex <- index1[i]:(index1[i+1]-1)
+                               if(z1[i] > 0) {
+                                       tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
+                                       maxindex <- rbind(maxindex, c(min(tmpindex), max(tmpindex)))
+                               } else {
+                                       tmpindex <- tmpindex[y[index1[i]] == y[tmpindex]]
+                                       minindex <- rbind(minindex, c(min(tmpindex), max(tmpindex)))
+                               }     
+                       } 
+
+               tmpindex <- index1[nextreme]:ndatam1  
+               if(z1[nextreme] > 0) {
+                       tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
+                       maxindex <- rbind(maxindex, c(min(tmpindex), max(tmpindex)))
+               } else {
+                       tmpindex <- tmpindex[y[index1[nextreme]] == y[tmpindex]]
+                       minindex <- rbind(minindex, c(min(tmpindex), max(tmpindex)))
+               }  
+
+               ### Finding the index of zero crossing  
+
+               if (!(all(sign(y) >= 0) || all(sign(y) <= 0) || all(sign(y) == 0))) {
+                       index1 <- c(1, index1)
+                       for (i in 1:nextreme) {
+                               if (y[index1[i]] == 0) {
+                                       tmp <- c(index1[i]:index1[i+1])[y[index1[i]:index1[i+1]] == 0]
+                                       cross <- rbind(cross, c(min(tmp), max(tmp)))                 
+                               } else
+                                       if (y[index1[i]] * y[index1[i+1]] < 0) {
+                                               tmp <- min(c(index1[i]:index1[i+1])[y[index1[i]] * 
y[index1[i]:index1[i+1]] <= 0])
+                                               if (y[tmp] == 0) {
+                                                       tmp <- c(tmp:index1[i+1])[y[tmp:index1[i+1]] == 0]
+                                                       cross <- rbind(cross, c(min(tmp), max(tmp))) 
+                                               } else 
+                                                       cross <- rbind(cross, c(tmp-1, tmp)) 
+                                       }
+                       }
+                       #if (y[ndata] == 0) {
+                       #    tmp <- c(index1[nextreme+1]:ndata)[y[index1[nextreme+1]:ndata] == 0]
+                       #    cross <- rbind(cross, c(min(tmp), max(tmp)))         
+                       #} else
+                       if (any(y[index1[nextreme+1]] * y[index1[nextreme+1]:ndata] <= 0)) {
+                               tmp <- min(c(index1[nextreme+1]:ndata)[y[index1[nextreme+1]] * 
y[index1[nextreme+1]:ndata] <= 0])
+                               if (y[tmp] == 0) {
+                                       tmp <- c(tmp:ndata)[y[tmp:ndata] == 0]
+                                       cross <- rbind(cross, c(min(tmp), max(tmp))) 
+                               } else
+                                       cross <- rbind(cross, c(tmp-1, tmp))
+                       }
+                       ncross <- nrow(cross)        
+               }
+       } 
+
+       list(minindex=minindex, maxindex=maxindex, nextreme=nextreme, cross=cross, ncross=ncross)
+}    
+
+
 
 findCurves <- function(displacement, eccon, min_height, draw, title) {
        position=cumsum(displacement)
@@ -1769,7 +1844,7 @@ quitIfNoData <- function(n, curves, outputData1) {
 }
 
 loadLibraries <- function(os) {
-       library("EMD")
+       #library("EMD")
        #library("sfsmisc")
        if(os=="Windows")
                library("Cairo")