[chronojump] Created scripts-util.R for common functions in r-scripts
- From: Xavier Padullés <xpadulles src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [chronojump] Created scripts-util.R for common functions in r-scripts
- Date: Tue, 17 Apr 2018 13:43:25 +0000 (UTC)
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]