[chronojump] Safer smooth.spline



commit ebff73c24f9b8a6b2f46cb487bbc0e7d773801b6
Author: Xavier de Blas <xaviblas gmail com>
Date:   Sun May 1 17:14:08 2016 +0200

    Safer smooth.spline

 encoder/graphSmoothingEC.R |   15 +++++++++++++--
 encoder/util.R             |   14 ++++++++++++++
 2 files changed, 27 insertions(+), 2 deletions(-)
---
diff --git a/encoder/graphSmoothingEC.R b/encoder/graphSmoothingEC.R
index 9596994..f30bd29 100644
--- a/encoder/graphSmoothingEC.R
+++ b/encoder/graphSmoothingEC.R
@@ -175,7 +175,13 @@ findSmoothingsEC <- function(singleFile, displacement, curves, eccon, smoothingO
                                        next
                                }
 
-                               smodel <- smooth.spline(y,x)
+                               #smodel <- smooth.spline(y,x)
+                               smodel <- smoothSplineSafe(y,x)
+                               if(is.null(smodel)) {
+                                       smoothings[i] = smoothingOneC
+                                       next
+                               }
+
                                smoothingOneEC <- predict(smodel, maxPowerConAtCon)$y
                                write(paste("smoothingOneEC", smoothingOneEC), stderr())
                                        
@@ -228,7 +234,12 @@ findSmoothingsEC <- function(singleFile, displacement, curves, eccon, smoothingO
                                        next
                                }
 
-                               smodel <- smooth.spline(y,x)
+                               #smodel <- smooth.spline(y,x)
+                               smodel <- smoothSplineSafe(y,x)
+                               if(is.null(smodel)) {
+                                       smoothings[i] = smoothingOneEC
+                                       next
+                               }
                                smoothingOneEC <- predict(smodel, maxPowerConAtCon)$y
                                        
                                #6 check if aproximation is OK
diff --git a/encoder/util.R b/encoder/util.R
index ac20346..8b2a3e1 100644
--- a/encoder/util.R
+++ b/encoder/util.R
@@ -307,6 +307,20 @@ getAcceleration <- function(speed) {
        return (predict( speed, deriv=1 ))
 }
 
+smoothSplineSafe <- function(a,b) 
+{
+       out <- tryCatch(
+                       {
+                               smooth.spline(a,b)
+                       },        
+                       error=function(cond) {
+                               message(cond)
+                               return(NULL)
+                       }
+                       )
+       return (out)
+}
+
 #gearedDown is positive, normally 2
 #this is not used on inertial machines
 getMass <- function(mass, gearedDown, angle) {


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