[chronojump] Created scripts-util.R for common functions in r-scripts



commit 940a2c956ee918906ff17837f180203b34937639
Author: Xavier Padullés <x padulles gmail com>
Date:   Tue Apr 17 15:41:27 2018 +0200

    Created scripts-util.R for common functions in r-scripts

 r-scripts/Makefile.am             |    4 +-
 r-scripts/maximumIsometricForce.R |   81 ++++--------------------------------
 r-scripts/scripts-util.R          |   35 ++++++++++++++++
 r-scripts/sprintEncoder.R         |   21 +---------
 r-scripts/sprintUtil.R            |   16 +-------
 5 files changed, 49 insertions(+), 108 deletions(-)
---
diff --git a/r-scripts/Makefile.am b/r-scripts/Makefile.am
index 5527809..3997742 100644
--- a/r-scripts/Makefile.am
+++ b/r-scripts/Makefile.am
@@ -3,4 +3,6 @@ rscriptsdir = @datadir@/@PACKAGE@/r-scripts
 dist_rscripts_DATA = maximumIsometricForce.R \
                     sprintUtil.R \
                     sprintPhotocells.R \
-                    sprintRadar.R
+                    sprintRadar.R \
+                    sprintEncoder.R \
+                    scripts-util.R
diff --git a/r-scripts/maximumIsometricForce.R b/r-scripts/maximumIsometricForce.R
index 3dbe17a..21261ed 100644
--- a/r-scripts/maximumIsometricForce.R
+++ b/r-scripts/maximumIsometricForce.R
@@ -21,24 +21,6 @@
 
 #Rscript path_to/maximumIsometricForce.R path_tmp
 
-prepareGraph <- function(os, pngFile, width, height)
-{
-        if(os == "Windows"){
-                library("Cairo")
-                Cairo(width, height, file = pngFile, type="png", bg="white")
-        }
-        else
-                png(pngFile, width=width, height=height)
-        #pdf(file = "/tmp/maxIsomForce.pdf", width=width, height=height)
-}
-
-#Ends the graph
-
-endGraph <- function()
-{
-        dev.off()
-}
-
 #Read each non commented line of the Roptions file
 
 assignOptions <- function(options)
@@ -83,6 +65,8 @@ options <- scan(optionsFile, comment.char="#", what=character(), sep="\n")
 op <- assignOptions(options)
 print(op)
 
+source("/usr/local/share/chronojump/r-scripts/scripts-util.R") #TODO: Read spcriptPath from Roptions.txt
+
 
 #Fits the data to the model f = fmax*(1 - exp(-K*t))
 #Important! It fits the data with the axes moved to initf and startTime. The real maximum force is fmax + 
initf
@@ -435,10 +419,10 @@ drawDynamicsFromLoadCell <- function(
                                 } else if(RFDoptions$rfdFunction == "RAW")
                                 {
                                         #Slope of the line of the sampled point.
-                                        RFD = getForceAtTime(dynamics$time, dynamics$rfd, time1)
+                                        RFD = interpolateXAtY(dynamics$rfd, dynamics$time, time1)
                                         
                                         #Y coordinate of a point of the line
-                                        force1 = getForceAtTime(dynamics$time, dynamics$f.raw, 
RFDoptions$start)
+                                        force1 = interpolateXAtY(dynamics$f.raw, dynamics$time, 
RFDoptions$start)
                                         
                                         legendText = c(legendText, paste("RFD", RFDoptions$start*1000, " = 
", round(RFD, digits = 1), " N/s", sep = ""))
                                         legendColor = c(legendColor, "black")
@@ -466,8 +450,8 @@ drawDynamicsFromLoadCell <- function(
                                         
                                 } else if(RFDoptions$rfdFunction == "RAW")
                                 {
-                                        force1 = getForceAtTime(dynamics$time, dynamics$f.raw, 
RFDoptions$start)
-                                        force2 = getForceAtTime(dynamics$time, dynamics$f.raw, 
RFDoptions$end)
+                                        force1 = interpolateXAtY(dynamics$f.raw, dynamics$time, 
RFDoptions$start)
+                                        force2 = interpolateXAtY(dynamics$f.raw, dynamics$time, 
RFDoptions$end)
                                         
                                         #Slope of the line
                                         RFD = (force2 - force1) / (time2 - time1)
@@ -496,13 +480,13 @@ drawDynamicsFromLoadCell <- function(
                                         
                                 } else if(RFDoptions$rfdFunction == "RAW")
                                 {
-                                        time1 = getTimeAtForce(dynamics$time, dynamics$f.raw, 
dynamics$fmax.raw * percent / 100)
+                                        time1 = interpolateXAtY(dynamics$time, dynamics$f.raw, 
dynamics$fmax.raw * percent / 100)
                                         
                                         #Slope of the line
-                                        RFD = getForceAtTime(dynamics$time, dynamics$rfd, time1)
+                                        RFD = interpolateXAtY(dynamics$rfd, dynamics$time, time1)
                                         
                                         #Y coordinate of a point of the line
-                                        force1 = getForceAtTime(dynamics$time, dynamics$f.raw, time1)
+                                        force1 = interpolateXAtY(dynamics$f.raw, dynamics$time, time1)
                                         
                                         legendText = c(legendText, paste("RFD", percent, "%", "Fmax", " = ", 
round(RFD, digits = 1), " N/s", sep = ""))
                                         legendColor = c(legendColor, "black")
@@ -732,53 +716,6 @@ readImpulseOptions <- function(optionsStr)
         } 
 }
 
-#Function to get the interpolated force at a given time in seconds)
-#TODO: use interpolateXAtY from scripts-util.R
-getForceAtTime <- function(time, force, desiredTime){
-        #find the closest sample
-        closestSample = which.min(abs(time - desiredTime))
-        
-        if(time[closestSample] - desiredTime >= 0){
-                previousSample = closestSample - 1
-                nextSample = closestSample
-        } else if(time[closestSample] - desiredTime < 0){
-                previousSample = closestSample
-                nextSample = closestSample + 1
-        }
-        print("Samples:")
-        print(paste(previousSample, nextSample))
-        print("Times:")
-        print(paste(time[previousSample], time[nextSample]))
-        print("Forces:")
-        print(paste(force[previousSample], force[nextSample]))
-        
-        #Interpolation between two samples
-        desiredForce = force[previousSample] + ((force[nextSample] - force[previousSample]) / 
(time[nextSample] - time[previousSample]))*(desiredTime - time[previousSample])
-        print("DesiredForce:")
-        print(desiredForce)
-        return(desiredForce)
-}
-
-#Function to get the interpolated time at a given force in N
-#TODO: use interpolateXAtY from scripts-util.R
-getTimeAtForce <- function(time, force, desiredForce){
-        #find the closest sample
-        nextSample = 1
-        while (force[nextSample] < desiredForce){
-                nextSample = nextSample +1
-        }
-        
-        previousSample = nextSample - 1
-        
-        if(force[nextSample] == desiredForce){
-                desiredTime = time[nextSample]
-        } else {
-                desiredTime = time[previousSample] + (desiredForce  - force[previousSample]) * 
(time[nextSample] - time[previousSample]) / (force[nextSample] - force[previousSample])
-        }
-        return(desiredTime)
-}
-
-
 prepareGraph(op$os, pngFile, op$graphWidth, op$graphHeight)
 dynamics = getDynamicsFromLoadCellFile(dataFile, op$averageLength, op$percentChange)
 drawDynamicsFromLoadCell(dynamics, op$vlineT0, op$vline50fmax.raw, op$vline50fmax.fitted, 
op$hline50fmax.raw, op$hline50fmax.fitted,
diff --git a/r-scripts/scripts-util.R b/r-scripts/scripts-util.R
new file mode 100644
index 0000000..cdde2ac
--- /dev/null
+++ b/r-scripts/scripts-util.R
@@ -0,0 +1,35 @@
+#Function to get the interpolated x at a given y
+interpolateXAtY <- function(X, Y, desiredY){
+        #find the closest sample
+        nextSample = 1
+        while (Y[nextSample] < desiredY){
+                nextSample = nextSample +1
+        }
+        
+        previousSample = nextSample - 1
+        
+        if(Y[nextSample] == desiredY){
+                desiredX = X[nextSample]
+        } else {
+                desiredX = X[previousSample] + (desiredY  - Y[previousSample]) * (X[nextSample] - 
X[previousSample]) / (Y[nextSample] - Y[previousSample])
+        }
+        return(desiredX)
+}
+
+prepareGraph <- function(os, pngFile, width, height)
+{
+        if(os == "Windows"){
+                library("Cairo")
+                Cairo(width, height, file = pngFile, type="png", bg="white")
+        }
+        else
+                png(pngFile, width=width, height=height)
+        #pdf(file = "/tmp/maxIsomForce.pdf", width=width, height=height)
+}
+
+#Ends the graph
+
+endGraph <- function()
+{
+        dev.off()
+}
diff --git a/r-scripts/sprintEncoder.R b/r-scripts/sprintEncoder.R
index ea3b4e6..0c7a796 100644
--- a/r-scripts/sprintEncoder.R
+++ b/r-scripts/sprintEncoder.R
@@ -30,6 +30,7 @@ options <- scan(optionsFile, comment.char="#", what=character(), sep="\n")
 #-------------- load sprintUtil.R -------------
 #options[1] is scriptsPath
 source(paste(options[1], "/sprintUtil.R", sep=""))
+source(paste(options[1], "/scripts-util.R", sep=""))
 
 assignOptions <- function(options) {
         return(list(
@@ -105,7 +106,6 @@ drawSprintFromEncoder <- function(sprint, sprintDynamics, title = "Test graph")
         while(lapPosition < sprint$testLength)
         {
                 lapTime = interpolateXAtY(sprint$time, sprint$rawPosition, lapPosition)
-                
                 abline(v = lapTime)
                 abline(h = lapPosition, lty = 3)
                 points(lapTime, lapPosition)
@@ -161,25 +161,6 @@ getTrimmingSamples <- function(totalTime, position, speed, accel, testLength)
         return(list(start = start, end = end ))
 }
 
-#Function to get the interpolated x at a given y
-#TODO: Include this function in scripts-util.R
-interpolateXAtY <- function(X, Y, desiredY){
-        #find the closest sample
-        nextSample = 1
-        while (Y[nextSample] < desiredY){
-                nextSample = nextSample +1
-        }
-        
-        previousSample = nextSample - 1
-        
-        if(Y[nextSample] == desiredY){
-                desiredX = X[nextSample]
-        } else {
-                desiredX = X[previousSample] + (desiredY  - Y[previousSample]) * (X[nextSample] - 
X[previousSample]) / (Y[nextSample] - Y[previousSample])
-        }
-        return(desiredX)
-}
-
 testEncoderCJ <- function(filename, testLength, mass, personHeight, tempC)
 {
         sprint = getSprintFromEncoder(filename, testLength)
diff --git a/r-scripts/sprintUtil.R b/r-scripts/sprintUtil.R
index 2b105d8..a7e1e79 100644
--- a/r-scripts/sprintUtil.R
+++ b/r-scripts/sprintUtil.R
@@ -20,7 +20,7 @@
 
 #This code uses splitTimes: accumulated time (not lap time)
 
-
+source(paste(options[1], "/scripts-util.R", sep=""))
 
 #Calculates all kinematic and dynamic variables using the sprint parameters (K and Vmax) and the conditions 
of the test (Mass and Height of the subject,
 #Temperature in the moment of the test and Velocity of the wind).
@@ -112,17 +112,3 @@ splitTime <- function(Vmax, K, position, tolerance = 0.001, initTime = 1)
 }
 
 
-prepareGraph <- function(os, pngFile, width, height)
-{
-       if(os == "Windows"){
-               library("Cairo")
-               Cairo(width, height, file = pngFile, type="png", bg="white")
-       }
-       else
-               png(pngFile, width=width, height=height)
-}
-
-endGraph <- function()
-{
-       dev.off()
-}


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