[chronojump] Pass massBody, massExtra to graph.R. Needs testing



commit b8254b8d41aadfbd70473073932c9e9a9b391794
Author: Xavier de Blas <xaviblas gmail com>
Date:   Fri Jan 31 20:45:03 2014 +0100

    Pass massBody, massExtra to graph.R. Needs testing

 encoder/graph.R    |  235 ++++++++++++++++++++++++++++++---------------------
 src/constants.cs   |    7 ++-
 src/encoder.cs     |   19 +++--
 src/gui/encoder.cs |   98 ++++++++++++++--------
 4 files changed, 219 insertions(+), 140 deletions(-)
---
diff --git a/encoder/graph.R b/encoder/graph.R
index 1645059..5f51e90 100644
--- a/encoder/graph.R
+++ b/encoder/graph.R
@@ -15,7 +15,7 @@
 #   along with this program; if not, write to the Free Software
 #    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 # 
-#   Copyright (C) 2004-2012   Xavier de Blas <xaviblas gmail com> 
+#   Copyright (C) 2004-2014   Xavier de Blas <xaviblas gmail com> 
 # 
 
 #TODO: current BUGS
@@ -101,7 +101,7 @@ cols=c(colSpeed,colForce,colPower); lty=rep(1,3)
 #way A. passing options to a file
 getOptionsFromFile <- function(optionsFile) {
        optionsCon <- file(optionsFile, 'r')
-       options=readLines(optionsCon,n=22)
+       options=readLines(optionsCon,n=23)
        close(optionsCon)
        return (options)
 }
@@ -122,8 +122,8 @@ print(options)
 
 OutputData2 = options[4] #currently used to display processing feedback
 SpecialData = options[5]
-OperatingSystem=options[22]
-
+OperatingSystem=options[23]
+EncoderConfiguration = ""
 
 write("(1/5) Starting R", OutputData2)
 
@@ -515,7 +515,7 @@ return (propulsiveEnd)
 #eccon="c" one time each curve
 #eccon="ec" one time each curve
 #eccon="ecS" means ecSeparated. two times each curve: one for "e", one for "c"
-kinematicsF <- function(displacement, mass, smoothingOneEC, smoothingOneC, g, eccon, isPropulsive) {
+kinematicsF <- function(displacement, massBody, massExtra, smoothingOneEC, smoothingOneC, g, eccon, 
isPropulsive) {
 
        smoothing = 0
        if(eccon == "c" || eccon == "e")
@@ -564,6 +564,9 @@ print("WARNING ECS\n\n\n\n\n")
                }
        }
 
+       #TODO: pass demult and angle
+       mass = getMassByEncoderConfiguration(massBody, massExtra, 1, 90)
+
 #      force <- mass*accel$y
 #      if(isJump)
                force <- mass*(accel$y+g)       #g:9.81 (used when movement is against gravity)
@@ -586,7 +589,7 @@ print("WARNING ECS\n\n\n\n\n")
                return(list(speedy=speed$y, accely=accel$y, force=force, power=power, mass=mass))
 }
 
-powerBars <- function(eccon, kinematics) {
+pafGenerate <- function(eccon, kinematics, massBody, massExtra) {
        #print("speed$y")
        #print(kinematics$speedy)
 
@@ -615,24 +618,30 @@ powerBars <- function(eccon, kinematics) {
 
 
        #here paf is generated
-       #mass is not used by powerBars, but used by Kg/W (loadVSPower)
-       #meanForce and maxForce are not used by powerBars, but used by F/S (forceVSSpeed)
-       return(data.frame(meanSpeed, maxSpeed, maxSpeedT, meanPower,peakPower,peakPowerT,pp_ppt,
-                         kinematics$mass,meanForce,maxForce))
+       #mass is not used by pafGenerate, but used by Kg/W (loadVSPower)
+       #meanForce and maxForce are not used by pafGenerate, but used by F/S (forceVSSpeed)
+       return(data.frame(
+                         meanSpeed, maxSpeed, maxSpeedT,
+                         meanPower, peakPower, peakPowerT, pp_ppt,
+                         meanForce, maxForce,
+                         kinematics$mass, massBody, massExtra)) #kinematics$mass is Load
 }
 
-kinematicRanges <- 
function(singleFile,displacement,curves,mass,smoothingsEC,smoothingOneC,g,eccon,isPropulsive) {
+kinematicRanges <- 
function(singleFile,displacement,curves,massBody,massExtra,smoothingsEC,smoothingOneC,g,eccon,isPropulsive) {
        n=length(curves[,1])
        maxSpeedy=0; maxAccely=0; maxForce=0; maxPower=0
        myEccon = eccon
        for(i in 1:n) { 
-               myMass = mass
+               myMassBody = massBody
+               myMassExtra = massExtra
                #mySmoothingOne = smoothingOne
                if(! singleFile) {
-                       myMass = curves[i,5]
-                       myEccon = curves[i,7]
+                       myMassBody = curves[i,5]
+                       myMassExtra = curves[i,6]
+                       myEccon = curves[i,8]
                }
-               
kn=kinematicsF(displacement[curves[i,1]:curves[i,2]],myMass,smoothingsEC[i],smoothingOneC,g,myEccon,isPropulsive)
+               kn=kinematicsF(displacement[curves[i,1]:curves[i,2]],myMassBody,myMassExtra,
+                              smoothingsEC[i],smoothingOneC,g,myEccon,isPropulsive)
                if(max(abs(kn$speedy)) > maxSpeedy)
                        maxSpeedy = max(abs(kn$speedy))
                if(max(abs(kn$accely)) > maxAccely)
@@ -651,7 +660,8 @@ kinematicRanges <- function(singleFile,displacement,curves,mass,smoothingsEC,smo
 
 
 paint <- function(displacement, eccon, xmin, xmax, yrange, knRanges, superpose, highlight,
-       startX, startH, smoothingOneEC, smoothingOneC, mass, title, subtitle, draw, showLabels, marShrink, 
showAxes, legend,
+       startX, startH, smoothingOneEC, smoothingOneC, massBody, massExtra, 
+       title, subtitle, draw, showLabels, marShrink, showAxes, legend,
        Analysis, isPropulsive, inertialType, exercisePercentBodyWeight,
         showSpeed, showAccel, showForce, showPower     
        ) {
@@ -932,6 +942,9 @@ paint <- function(displacement, eccon, xmin, xmax, yrange, knRanges, superpose,
                #mtext(text=paste("max accel:",round(max(accel$y),3)),side=3,at=which(accel$y == 
max(accel$y)),cex=.8,col=cols[1],line=2)
        }
 
+       #TODO: pass demult and angle
+       mass = getMassByEncoderConfiguration(massBody, massExtra, 1, 90)
+
 #print(c(knRanges$accely, max(accel$y), min(accel$y)))
 #      force <- mass*accel$y
 #      if(isJump)
@@ -1166,7 +1179,7 @@ textBox <- function(x,y,text,frontCol,bgCol,xpad=.1,ypad=1){
 } 
 
 
-paintPowerPeakPowerBars <- function(singleFile, title, paf, myEccons, Eccon, height, n, showTTPP, showRange) 
{
+paintPowerPeakPowerBars <- function(singleFile, title, paf, Eccon, height, n, showTTPP, showRange) {
        pafColors=c("tomato1","tomato4",topo.colors(10)[3])
        myNums = rownames(paf)
        height = abs(height/10)
@@ -1308,14 +1321,20 @@ findPosInPaf <- function(var, option) {
                pos = 1
        else if(var == "Power")
                pos = 4
-       else if(var == "Load") #or Mass
-               pos = 8
        else if(var == "Force")
-               pos = 9
+               pos = 8
+       else if(var == "Load") #MassDisplaced
+               pos = 10
+       else if(var == "MassBody")
+               pos = 11
+       else if(var == "MassExtra")
+               pos = 12
+       
        if( ( var == "Speed" || var == "Power" || var == "Force") & option == "max")
                pos=pos+1
        if( ( var == "Speed" || var == "Power") & option == "time")
                pos=pos+2
+
        return(pos)
 }
 
@@ -1601,11 +1620,11 @@ find.yrange <- function(singleFile, displacement, curves) {
        return (c(y.min,y.max))
 }
 
-#-------------------- encoderConfiguration conversions --------------------------
+#-------------------- EncoderConfiguration conversions --------------------------
 
 #in signals and curves, need to do conversions (invert, inertiaMomentum, diameter)
 #we use 'data' variable because can be position or displacement
-getDisplacement <- function(data, encoderConfiguration, diameter, diameter2) {
+getDisplacement <- function(data, diameter, diameter2) {
        #no change
        #WEIGHTEDMOVPULLEYLINEARONPERSON1, WEIGHTEDMOVPULLEYLINEARONPERSON1INV,
        #WEIGHTEDMOVPULLEYLINEARONPERSON2, WEIGHTEDMOVPULLEYLINEARONPERSON2INV,
@@ -1613,15 +1632,15 @@ getDisplacement <- function(data, encoderConfiguration, diameter, diameter2) {
        #ROTARYFRICTIONSIDE
        #WEIGHTEDMOVPULLEYROTARYFRICTION
 
-       if(encoderConfiguration == "LINEARINVERTED") {
+       if(EncoderConfiguration == "LINEARINVERTED") {
                data = -data
-       else if(encoderConfiguration == "WEIGHTEDMOVPULLEYONLINEARENCODER") {
+       } else if(EncoderConfiguration == "WEIGHTEDMOVPULLEYONLINEARENCODER") {
                #default is: demultiplication = 2. Future maybe this will be a parameter
                data = data *2
-       } else if(encoderConfiguration == "ROTARYFRICTIONAXIS") {
+       } else if(EncoderConfiguration == "ROTARYFRICTIONAXIS") {
                data = data * diameter / diameter2
-       } else if(encoderConfiguration == "ROTARYAXIS" || 
-                 encoderConfiguration == "WEIGHTEDMOVPULLEYROTARYAXIS") {
+       } else if(EncoderConfiguration == "ROTARYAXIS" || 
+                 EncoderConfiguration == "WEIGHTEDMOVPULLEYROTARYAXIS") {
                ticksRotaryEncoder = 200 #our rotary axis encoder send 200 ticks by turn
                #diameter m -> mm
                data = ( data / ticksRotaryEncoder ) * 2 * pi * ( diameter * 1000 / 2 )
@@ -1630,12 +1649,12 @@ getDisplacement <- function(data, encoderConfiguration, diameter, diameter2) {
 }
 
 getSpeed <- function(displacement, smoothing) {
-       #no change depending on encoderConfiguration
+       #no change depending on EncoderConfiguration
        return (smooth.spline( 1:length(displacement), displacement, spar=smoothing))
 }
 
 getAcceleration <- function(speed) {
-       #no change depending on encoderConfiguration
+       #no change depending on EncoderConfiguration
        return (predict( speed, deriv=1 ))
 }
 
@@ -1644,27 +1663,33 @@ getMass <- function(mass, demult, angle) {
        return ( ( mass / demult ) * sin( angle * pi / 180 ) )
 }
 
-#mass extra can be connected to body or connected to a pulley depending on encoderConfiguration
-getDynamics <- function(speed, accel, encoderConfiguration, mass.body, mass.extra, demult, angle) 
+getMassByEncoderConfiguration <- function(mass.body, mass.extra, demult, angle)
 {
        if(
-          encoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON1" ||
-          encoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON1INV" ||
-          encoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON2" ||
-          encoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON2INV" ||
-          encoderConfiguration == "WEIGHTEDMOVPULLEYROTARYFRICTION" ||
-          encoderConfiguration == "WEIGHTEDMOVPULLEYROTARYAXIS" ) 
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON1" ||
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON1INV" ||
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON2" ||
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYLINEARONPERSON2INV" ||
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYROTARYFRICTION" ||
+          EncoderConfiguration == "WEIGHTEDMOVPULLEYROTARYAXIS" ) 
        {
                #angle will be 90 degrees. We assume this.
                #Maybe in the future, person or person and extra weight, 
                #can be with different angle
                mass.extra = getMass(mass.extra, demult, angle)
-       } else if(encoderConfiguration == "LINEARONPLANE") {
+       } else if(EncoderConfiguration == "LINEARONPLANE") {
                mass.body = getMass(mass.body, demult, angle)
                mass.extra = getMass(mass.extra, demult, angle)
        }
                
        mass = mass.body + mass.extra
+       return (mass)
+}
+
+#mass extra can be connected to body or connected to a pulley depending on EncoderConfiguration
+getDynamics <- function(speed, accel, mass.body, mass.extra, demult, angle) 
+{
+       mass = getMassByEncoderConfiguration (mass.body, mass.extra, demult, angle)
 
        force <- mass*(accel+g) #g:9.81 (used when movement is against gravity)
 
@@ -1681,7 +1706,7 @@ getAngleInertial <- function(displacement, diameter) {
 
 #TODO: inertial
 
-#-------------- end of encoderConfiguration conversions -------------------------
+#-------------- end of EncoderConfiguration conversions -------------------------
 
 quitIfNoData <- function(n, curves, outputData1) {
        #if not found curves with this data, plot a "sorry" message and exit
@@ -1710,11 +1735,13 @@ doProcess <- function(options) {
        SpecialData=options[5] #currently used to write 1RM. variable;result (eg. "1RM;82.78")
        MinHeight=as.numeric(options[6])*10 #from cm to mm
        ExercisePercentBodyWeight=as.numeric(options[7])        #was isJump=as.logical(options[6])
-       Mass=as.numeric(options[8])     #TODO: This is displaced mass (can include body weight). Separate 
this in two different values. This affects:
+       #Mass=as.numeric(options[8])    #TODO: This is displaced mass (can include body weight). Separate 
this in two different values. This affects:
        #WEIGHTEDMOVPULLEYLINEARONPERSON1, WEIGHTEDMOVPULLEYLINEARONPERSON1INV,
        #WEIGHTEDMOVPULLEYLINEARONPERSON2, WEIGHTEDMOVPULLEYLINEARONPERSON2INV,
+       MassBody=as.numeric(options[8]) 
+       MassExtra=as.numeric(options[9])        
 
-       Eccon=options[9]
+       Eccon=options[10]
        
        #in Analysis "cross", AnalysisVariables can be "Force;Speed;mean". 1st is Y, 2nd is X. "mean" can 
also be "max"
        #Analysis "cross" can have a double XY plot, AnalysisVariables = "Speed,Power;Load;mean"
@@ -1728,23 +1755,23 @@ doProcess <- function(options) {
        #
        #in Analysis = "1RMAnyExercise"
        #AnalysisVariables = "0.185;method". speed1RM = 0.185m/s
-       Analysis=options[10]    
-       AnalysisVariables=unlist(strsplit(options[11], "\\;"))
+       Analysis=options[11]    
+       AnalysisVariables=unlist(strsplit(options[12], "\\;"))
        
-       AnalysisOptions=options[12]     
+       AnalysisOptions=options[13]     
 
-       encoderConfiguration=           options[13]     
-       inertiaMomentum=        as.numeric(options[14])/10000   #comes in Kg*cm^2 eg: 100; convert it to 
Kg*m^2 eg: 0.010
-       diameter=               as.numeric(options[15]) #in meters, eg: 0.0175
+       EncoderConfiguration=           options[14]     
+       inertiaMomentum=        as.numeric(options[15])/10000   #comes in Kg*cm^2 eg: 100; convert it to 
Kg*m^2 eg: 0.010
+       diameter=               as.numeric(options[16]) #in meters, eg: 0.0175
        diameter2 = 1   #TODO: pass this param
        
-       SmoothingOneC=options[16]
-       Jump=options[17]
-       Width=as.numeric(options[18])
-       Height=as.numeric(options[19])
-       DecimalSeparator=options[20]
-       Title=options[21]
-       OperatingSystem=options[22]     #if this changes, change it also at start of this R file
+       SmoothingOneC=options[17]
+       Jump=options[18]
+       Width=as.numeric(options[19])
+       Height=as.numeric(options[20])
+       DecimalSeparator=options[21]
+       Title=options[22]
+       OperatingSystem=options[23]     #if this changes, change it also at start of this R file
        #IMPORTANT, if this grows, change the readLines value on getOptionsFromFile
 
        print(File)
@@ -1758,7 +1785,7 @@ doProcess <- function(options) {
        #if nothing: "-;-"
        analysisOptionsTemp = unlist(strsplit(AnalysisOptions, "\\;"))
        isPropulsive = (analysisOptionsTemp[1] == "p")
-       inertialType = ""       #TODO: use encoderConfiguration
+       inertialType = ""       #TODO: use EncoderConfiguration
        if(length(analysisOptionsTemp) > 1) {
                inertialType = analysisOptionsTemp[2] #values: "" || "li" || "ri"
        }
@@ -1827,8 +1854,8 @@ doProcess <- function(options) {
                displacement = NULL
                count = 1
                start = NULL; end = NULL; startH = NULL
-               status = NULL; id = NULL; exerciseName = NULL; mass = NULL; smooth = NULL
-               dateTime = NULL; myEccon = NULL; curvesHeight = NULL
+               status = NULL; id = NULL; exerciseName = NULL; massBody = NULL; massExtra = NULL
+               smooth = NULL ; dateTime = NULL; myEccon = NULL; curvesHeight = NULL
                seriesName = NULL; percentBodyWeight = NULL;
 
                newLines=0;
@@ -1848,7 +1875,7 @@ doProcess <- function(options) {
                        #this removes all NAs on a curve
                        dataTempFile  = dataTempFile[!is.na(dataTempFile)]
 
-                       dataTempFile = getDisplacement(dataTempFile, encoderConfiguration, diameter, 
diameter2)
+                       dataTempFile = getDisplacement(dataTempFile, diameter, diameter2)
 
                        dataTempPhase=dataTempFile
                        processTimes = 1
@@ -1877,8 +1904,11 @@ doProcess <- function(options) {
                                end[(i+newLines)] = length(dataTempPhase) + count -1
                                startH[(i+newLines)] = 0
                                exerciseName[(i+newLines)] = as.vector(inputMultiData$exerciseName[i])
-                               mass[(i+newLines)] = inputMultiData$mass[i]
-                               #smooth[(i+newLines)] = inputMultiData$smoothingOne[i] #unused since 1.3.7
+
+                               #mass[(i+newLines)] = inputMultiData$mass[i]
+                               massBody[(i+newLines)] = inputMultiData$massBody[i]
+                               massExtra[(i+newLines)] = inputMultiData$massExtra[i]
+
                                dateTime[(i+newLines)] = as.vector(inputMultiData$dateTime[i])
                                percentBodyWeight[(i+newLines)] = 
as.vector(inputMultiData$percentBodyWeight[i])
 
@@ -1917,11 +1947,11 @@ doProcess <- function(options) {
                #then a column id is created when there's only on row, but it is not created there's more 
than one.
                #solution:
                if(length(id)==1) {
-                       curves = data.frame(start,end,startH,exerciseName,mass,
+                       curves = data.frame(start,end,startH,exerciseName,massBody,massExtra,
                                            dateTime,myEccon,seriesName,percentBodyWeight,
                                            stringsAsFactors=F,row.names=id)
                } else {
-                       curves = data.frame(id,start,end,startH,exerciseName,mass,
+                       curves = data.frame(id,start,end,startH,exerciseName,massBody,massExtra,
                                            dateTime,myEccon,seriesName,percentBodyWeight,
                                            stringsAsFactors=F,row.names=1)
                }
@@ -1941,7 +1971,7 @@ doProcess <- function(options) {
                #this removes all NAs
                displacement  = displacement[!is.na(displacement)]
                        
-               displacement = getDisplacement(displacement, encoderConfiguration, diameter, diameter2)
+               displacement = getDisplacement(displacement, diameter, diameter2)
 
                if(length(displacement)==0) {
                        plot(0,0,type="n",axes=F,xlab="",ylab="")
@@ -2024,20 +2054,22 @@ doProcess <- function(options) {
 
        if(Analysis=="single") {
                if(Jump>0) {
-                       myMass = Mass
+                       myMassBody = MassBody
+                       myMassExtra = MassExtra
                        #mySmoothingOne = SmoothingOne
                        myEccon = Eccon
                        myStart = curves[Jump,1]
                        myEnd = curves[Jump,2]
                        myExPercentBodyWeight = ExercisePercentBodyWeight
                        if(! singleFile) {
-                               myMass = curves[Jump,5]
-                               #mySmoothingOne = curves[Jump,6]
-                               myEccon = curves[Jump,7]
-                               myExPercentBodyWeight = curves[Jump,9]
+                               myMassBody = curves[Jump,5]
+                               myMassExtra = curves[Jump,6]
+                               #mySmoothingOne = curves[Jump,7]
+                               myEccon = curves[Jump,8]
+                               myExPercentBodyWeight = curves[Jump,10]
                        }
                        
-                       myCurveStr = paste("curve=", Jump, ", ", myMass, "Kg", sep="")
+                       myCurveStr = paste("curve=", Jump, ", ", myMassExtra, "Kg", sep="")
                
                        #don't do this, because on inertial machines string will be rolled to machine and not 
connected to the body
                        #if(inertialType == "li") {
@@ -2046,7 +2078,7 @@ doProcess <- function(options) {
                        #}
 
                        paint(displacement, myEccon, myStart, myEnd,"undefined","undefined",FALSE,FALSE,
-                             1,curves[Jump,3],SmoothingsEC[as.numeric(Jump)],SmoothingOneC,myMass,
+                             
1,curves[Jump,3],SmoothingsEC[as.numeric(Jump)],SmoothingOneC,myMassBody,myMassExtra,
                              paste(Title, " ", Analysis, " ", myEccon, " ", myCurveStr, sep=""),
                              "", #subtitle
                              TRUE,     #draw
@@ -2069,29 +2101,31 @@ doProcess <- function(options) {
 
                yrange=find.yrange(singleFile, displacement, curves)
 
-               knRanges=kinematicRanges(singleFile,displacement,curves,Mass,SmoothingsEC,SmoothingOneC,
+               
knRanges=kinematicRanges(singleFile,displacement,curves,MassBody,MassExtra,SmoothingsEC,SmoothingOneC,
                                         g,Eccon,isPropulsive)
 
                for(i in 1:n) {
-                       myMass = Mass
+                       myMassBody = MassBody
+                       myMassExtra = MassExtra
                        #mySmoothingOne = SmoothingOne
                        myEccon = Eccon
                        myExPercentBodyWeight = ExercisePercentBodyWeight
                        if(! singleFile) {
-                               myMass = curves[i,5]
-                               #mySmoothingOne = curves[i,6]
-                               myEccon = curves[i,7]
-                               myExPercentBodyWeight = curves[i,9]
+                               myMassBody = curves[i,5]
+                               myMassExtra = curves[i,6]
+                               #mySmoothingOne = curves[i,7]
+                               myEccon = curves[i,8]
+                               myExPercentBodyWeight = curves[i,10]
                        }
 
                        myTitle = ""
                        if(i == 1)
                                myTitle = paste(Title)
                        
-                       mySubtitle = paste("curve=", rownames(curves)[i], ", ", myMass, "Kg", sep="")
+                       mySubtitle = paste("curve=", rownames(curves)[i], ", ", myMassExtra, "Kg", sep="")
 
                        paint(displacement, myEccon, curves[i,1],curves[i,2],yrange,knRanges,FALSE,FALSE,
-                             1,curves[i,3],SmoothingsEC[i],SmoothingOneC,myMass,myTitle,mySubtitle,
+                             
1,curves[i,3],SmoothingsEC[i],SmoothingOneC,myMassBody,myMassExtra,myTitle,mySubtitle,
                              TRUE,     #draw
                              FALSE,    #showLabels
                              TRUE,     #marShrink
@@ -2158,13 +2192,15 @@ doProcess <- function(options) {
                discardedCurves = NULL
                discardingCurves = FALSE
                for(i in 1:n) { 
-                       myMass = Mass
+                       myMassBody = MassBody
+                       myMassExtra = MassExtra
                        #mySmoothingOne = SmoothingOne
                        myEccon = Eccon
                        if(! singleFile) {
-                               myMass = curves[i,5]
-                               #mySmoothingOne = curves[i,6]
-                               myEccon = curves[i,7]
+                               myMassBody = curves[i,5]
+                               myMassExtra = curves[i,6]
+                               #mySmoothingOne = curves[i,7]
+                               myEccon = curves[i,8]
 
                                #only use concentric data       
                                if( (Analysis == "1RMBadillo2010" || Analysis == "1RMAnyExercise") & myEccon 
== "e") {
@@ -2201,10 +2237,13 @@ doProcess <- function(options) {
                               else
                                       myEcconKn = "e"
                        }
-                       paf=rbind(paf,(powerBars(myEccon,
-                                                kinematicsF(displacement[curves[i,1]:curves[i,2]], 
-                                                            myMass, SmoothingsEC[i],SmoothingOneC, 
-                                                            g, myEcconKn, isPropulsive))))
+                       paf = rbind(paf,(pafGenerate(
+                                                  myEccon,
+                                                  kinematicsF(displacement[curves[i,1]:curves[i,2]], 
+                                                            myMassBody, myMassExtra, 
SmoothingsEC[i],SmoothingOneC, 
+                                                            g, myEcconKn, isPropulsive),
+                                                  myMassBody, myMassExtra
+                                                  )))
                }
 
                #on 1RMBadillo discard curves "e", because paf has this curves discarded
@@ -2221,7 +2260,7 @@ doProcess <- function(options) {
                if(Analysis == "powerBars") {
                        if(! singleFile) 
                                paintPowerPeakPowerBars(singleFile, Title, paf, 
-                                                       curves[,7], Eccon,              #myEccon, Eccon
+                                                       Eccon,                          #Eccon
                                                        curvesHeight,                   #height 
                                                        n, 
                                                        (AnalysisVariables[1] == "TimeToPeakPower"),    #show 
time to pp
@@ -2229,7 +2268,7 @@ doProcess <- function(options) {
                                                        )               
                        else 
                                paintPowerPeakPowerBars(singleFile, Title, paf, 
-                                                       curves[,7], Eccon,                      #myEccon, 
Eccon
+                                                       Eccon,                                  #Eccon
                                                        position[curves[,2]]-curves[,3],        #height
                                                        n, 
                                                        (AnalysisVariables[1] == "TimeToPeakPower"),    #show 
time to pp
@@ -2239,7 +2278,7 @@ doProcess <- function(options) {
                else if(Analysis == "cross") {
                        mySeries = "1"
                        if(! singleFile)
-                               mySeries = curves[,8]
+                               mySeries = curves[,9]
 
                        print("AnalysisVariables:")
                        print(AnalysisVariables[1])
@@ -2267,7 +2306,7 @@ doProcess <- function(options) {
                else if(Analysis == "1RMAnyExercise") {
                        mySeries = "1"
                        if(! singleFile)
-                               mySeries = curves[,8]
+                               mySeries = curves[,9]
 
                        paintCrossVariables(paf, "Load", "Speed", 
                                            "mean", "ALONE", Title,
@@ -2281,25 +2320,27 @@ doProcess <- function(options) {
                
                if(Analysis == "curves" || writeCurves) {
                        if(singleFile)
-                               paf=cbind(
+                               paf = cbind(
                                          "1",                  #seriesName
                                          "exerciseName",
-                                         Mass,
+                                         MassBody,
+                                         MassExtra,
                                          curves[,1],
                                          curves[,2]-curves[,1],position[curves[,2]]-curves[,3],paf)
                        else {
                                if(discardingCurves)
                                        curvesHeight = curvesHeight[-discardedCurves]
 
-                               paf=cbind(
-                                         curves[,8],           #seriesName
+                               paf = cbind(
+                                         curves[,9],           #seriesName
                                          curves[,4],           #exerciseName
-                                         curves[,5],           #mass
+                                         curves[,5],           #massBody
+                                         curves[,6],           #massExtra
                                          curves[,1],           
                                          curves[,2]-curves[,1],curvesHeight,paf)
                        }
 
-                       colnames(paf)=c("series","exercise","mass",
+                       colnames(paf)=c("series","exercise","massBody","massExtra",
                                        "start","width","height",
                                        "meanSpeed","maxSpeed","maxSpeedT",
                                        "meanPower","peakPower","peakPowerT",
@@ -2329,7 +2370,7 @@ doProcess <- function(options) {
                namesNums=paste(namesNums, units)
 
                for(i in 1:curvesNum) { 
-                       kn = kinematicsF (displacement[curves[i,1]:curves[i,2]], Mass, 
+                       kn = kinematicsF (displacement[curves[i,1]:curves[i,2]], MassBody, MassExtra, 
                                          SmoothingsEC[i], SmoothingOneC, g, Eccon, isPropulsive)
 
                        #fill with NAs in order to have the same length
diff --git a/src/constants.cs b/src/constants.cs
index dd568c6..be549a3 100644
--- a/src/constants.cs
+++ b/src/constants.cs
@@ -15,7 +15,7 @@
  *  along with this program; if not, write to the Free Software
  *   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *
- *  Copyright (C) 2004-2012   Xavier de Blas <xaviblas gmail com> 
+ *  Copyright (C) 2004-2014   Xavier de Blas <xaviblas gmail com> 
  */
 
 using System;
@@ -662,4 +662,9 @@ public class Constants
        public enum DoubleContact {
                FIRST, AVERAGE, LAST
        }
+       
+       public enum MassType {
+               BODY, EXTRA, DISPLACED
+       }       
+               
 }
diff --git a/src/encoder.cs b/src/encoder.cs
index 70924e8..c1fea4d 100644
--- a/src/encoder.cs
+++ b/src/encoder.cs
@@ -15,7 +15,7 @@
  *  along with this program; if not, write to the Free Software
  *   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *
- *  Copyright (C) 2004-2012   Xavier de Blas <xaviblas gmail com> 
+ *  Copyright (C) 2004-2014   Xavier de Blas <xaviblas gmail com> 
  */
 
 using System;
@@ -29,6 +29,12 @@ public class EncoderParams
 {
        private int time;
        private string mass; //to pass always as "." to R
+       
+       //graph.R need both to know displacedMass depending on encoderConfiguration
+       //and plot both as entry data in the table of result data
+       private string massBody; //to pass always as "." to R.
+       private string massExtra; //to pass always as "." to R
+       
        private int minHeight;
        private int exercisePercentBodyWeight; //was private bool isJump; (if it's 0 is like "jump")
        private string eccon;
@@ -119,14 +125,15 @@ public class EncoderParams
        }
        
        //to graph.R    
-       public EncoderParams(int minHeight, int exercisePercentBodyWeight, string mass, string eccon, 
-                       string analysis, string analysisVariables, string analysisOptions, 
+       public EncoderParams(int minHeight, int exercisePercentBodyWeight, string massBody, string massExtra, 
+                       string eccon, string analysis, string analysisVariables, string analysisOptions, 
                        string encoderConfigurationName, int inertiaMomentum, double diameter,
                        string smoothCon, int curve, int width, int height, string decimalSeparator)
        {
                this.minHeight = minHeight;
                this.exercisePercentBodyWeight = exercisePercentBodyWeight;
-               this.mass = mass;
+               this.massBody = massBody;
+               this.massExtra = massExtra;
                this.eccon = eccon;
                this.analysis = analysis;
                this.analysisVariables = analysisVariables;
@@ -143,8 +150,8 @@ public class EncoderParams
        
        public string ToString2 (string sep) 
        {
-               return minHeight + sep + exercisePercentBodyWeight + sep + mass + sep + eccon + 
-                       sep + analysis + sep + analysisVariables + sep + analysisOptions + 
+               return minHeight + sep + exercisePercentBodyWeight + sep + massBody + sep + massExtra +
+                       sep + eccon + sep + analysis + sep + analysisVariables + sep + analysisOptions + 
                        sep + encoderConfigurationName + sep + inertiaMomentum.ToString() + sep + 
Util.ConvertToPoint(diameter) +
                        sep + smoothCon + sep + curve + sep + width + sep + height + sep + decimalSeparator;
        }
diff --git a/src/gui/encoder.cs b/src/gui/encoder.cs
index eb0984c..ebeeaaa 100644
--- a/src/gui/encoder.cs
+++ b/src/gui/encoder.cs
@@ -302,12 +302,13 @@ public partial class ChronoJumpWindow
                        peakPowerLowerCondition = repetitiveConditionsWin.EncoderPeakPowerLowerValue;
 
                string exerciseNameShown = UtilGtk.ComboGetActive(combo_encoder_exercise);
-               //capture data
+
+               //capture data (Python)
                EncoderParams ep = new EncoderParams(
                                (int) encoderCaptureOptionsWin.spin_encoder_capture_time.Value, 
                                (int) encoderCaptureOptionsWin.spin_encoder_capture_min_height.Value, 
                                getExercisePercentBodyWeightFromCombo (),
-                               Util.ConvertToPoint(findMassFromCombo(true)),
+                               Util.ConvertToPoint(findMass(Constants.MassType.DISPLACED)),
                                Util.ConvertToPoint(encoderSmoothCon),                  //R decimal: '.'
                                findEccon(true),                                        //force ecS (ecc-conc 
separated)
                                analysisOptions,
@@ -343,7 +344,7 @@ public partial class ChronoJumpWindow
                        UtilEncoder.RunEncoderCapturePython( 
                                        Util.ChangeSpaceAndMinusForUnderscore(currentPerson.Name) + "----" + 
                                        Util.ChangeSpaceAndMinusForUnderscore(exerciseNameShown) + "----(" + 
-                                       Util.ConvertToPoint(findMassFromCombo(true)) + "Kg)",
+                                       Util.ConvertToPoint(findMass(Constants.MassType.DISPLACED)) + "Kg)",
                                        es, chronopicWin.GetEncoderPort());
                        
                        //entry_encoder_signal_comment.Text = "";
@@ -377,7 +378,7 @@ public partial class ChronoJumpWindow
 
        void encoder_change_displaced_weight_and_1RM () {
                //displaced weight
-               spin_encoder_displaced_weight.Value = findMassFromCombo(true);
+               spin_encoder_displaced_weight.Value = findMass(Constants.MassType.DISPLACED);
 
                //1RM
                ArrayList array1RM = SqliteEncoder.Select1RM(
@@ -386,10 +387,10 @@ public partial class ChronoJumpWindow
                if(array1RM.Count > 0)
                        load1RM = ((Encoder1RM) array1RM[0]).load1RM; //take only the first in array (will be 
the last uniqueID)
 
-               if(load1RM == 0 || findMassFromCombo(false) == 0)
+               if(load1RM == 0 || findMass(Constants.MassType.EXTRA) == 0)
                        spin_encoder_1RM_percent.Value = 0;
                else
-                       spin_encoder_1RM_percent.Value = 100 * findMassFromCombo(false) / ( load1RM * 1.0 );
+                       spin_encoder_1RM_percent.Value = 100 * findMass(Constants.MassType.EXTRA) / ( load1RM 
* 1.0 );
        }
 
        void on_button_encoder_1RM_win_clicked (object o, EventArgs args) {
@@ -599,7 +600,7 @@ public partial class ChronoJumpWindow
                                getExerciseIDFromCombo(),       
                                findEccon(true),        //force ecS (ecc-conc separated)
                                UtilGtk.ComboGetActive(combo_encoder_laterality),
-                               Util.ConvertToPoint(findMassFromCombo(false)),  //when save on sql, do not 
include person weight
+                               Util.ConvertToPoint(findMass(Constants.MassType.EXTRA)), //when save on sql, 
do not include person weight
                                "",     //signalOrCurve,
                                "",     //fileSaved,    //to know date do: select substr(name,-23,19) from 
encoder;
                                "",     //path,                 //url
@@ -620,7 +621,8 @@ public partial class ChronoJumpWindow
                EncoderParams ep = new EncoderParams(
                                (int) encoderCaptureOptionsWin.spin_encoder_capture_min_height.Value, 
                                getExercisePercentBodyWeightFromCombo (),
-                               Util.ConvertToPoint(findMassFromCombo(true)),
+                               Util.ConvertToPoint(findMass(Constants.MassType.BODY)),
+                               Util.ConvertToPoint(findMass(Constants.MassType.EXTRA)),
                                findEccon(true),                                        //force ecS (ecc-conc 
separated)
                                analysis,
                                "none",                         //analysisVariables (not needed in create 
curves). Cannot be blank
@@ -647,7 +649,7 @@ public partial class ChronoJumpWindow
                bool result = UtilEncoder.RunEncoderGraph(
                                Util.ChangeSpaceAndMinusForUnderscore(currentPerson.Name) + "-" + 
                                
Util.ChangeSpaceAndMinusForUnderscore(UtilGtk.ComboGetActive(combo_encoder_exercise)) + 
-                               "-(" + Util.ConvertToPoint(findMassFromCombo(true)) + "Kg)",
+                               "-(" + Util.ConvertToPoint(findMass(Constants.MassType.DISPLACED)) + "Kg)",
                                es);
 
                if(result)
@@ -1194,7 +1196,8 @@ public partial class ChronoJumpWindow
                EncoderParams ep = new EncoderParams(
                                lastEncoderSQL.minHeight, 
                                getExercisePercentBodyWeightFromName (lastEncoderSQL.exerciseName),
-                               displacedMass,
+                               Util.ConvertToPoint(findMass(Constants.MassType.BODY)),
+                               Util.ConvertToPoint(findMass(Constants.MassType.EXTRA)),
                                findEccon(false), //do not force ecS (ecc-conc separated) //not taken from 
lastEncoderSQL because there is (true)
                                "exportCSV",
                                "none",                                         //analysisVariables (not 
needed in create curves). Cannot be blank
@@ -1637,7 +1640,7 @@ public partial class ChronoJumpWindow
                bool capturedOk = runEncoderCaptureCsharp( 
                                Util.ChangeSpaceAndMinusForUnderscore(currentPerson.Name) + "----" + 
                                Util.ChangeSpaceAndMinusForUnderscore(exerciseNameShown) + "----(" + 
-                               Util.ConvertToPoint(findMassFromCombo(true)) + "Kg)",
+                               Util.ConvertToPoint(findMass(Constants.MassType.DISPLACED)) + "Kg)",
                                //es, 
                                (int) encoderCaptureOptionsWin.spin_encoder_capture_time.Value, 
                                UtilEncoder.GetEncoderDataTempFileName(),
@@ -1970,7 +1973,7 @@ public partial class ChronoJumpWindow
                        dataFileName = UtilEncoder.GetEncoderGraphInputMulti();
 
 
-                       double bodyMass = Convert.ToDouble(currentPersonSession.Weight);
+                       //double bodyMass = Convert.ToDouble(currentPersonSession.Weight);
 
                        //select curves for this person
                        ArrayList data = new ArrayList();
@@ -2047,7 +2050,8 @@ public partial class ChronoJumpWindow
                        ep = new EncoderParams(
                                        -1, 
                                        -1,             //exercisePercentBodyWeight
-                                       "-1",           //mass
+                                       "-1",           //massBody
+                                       "-1",           //massExtra
                                        myEccon,        //this decides if analysis will be together or 
separated
                                        sendAnalysis,
                                        analysisVariables,
@@ -2065,23 +2069,28 @@ public partial class ChronoJumpWindow
 
                        //create dataFileName
                        TextWriter writer = File.CreateText(dataFileName);
-                       
writer.WriteLine("status,seriesName,exerciseName,mass,smoothingOne,dateTime,fullURL,eccon,percentBodyWeight");
+                       
writer.WriteLine("status,seriesName,exerciseName,massBody,massExtra,smoothingOne,dateTime,fullURL,eccon,percentBodyWeight");
                
                        ArrayList eeArray = SqliteEncoder.SelectEncoderExercises(false, -1, false);
                        EncoderExercise ex = new EncoderExercise();
                                                
 Log.WriteLine("AT ANALYZE");
 
+                       int iteratingPerson = -1;
+                       int iteratingSession = -1;
+                       double iteratingMassBody = -1;
                        int countSeries = 1;
+
                        foreach(EncoderSQL eSQL in data) {
                                foreach(EncoderExercise eeSearch in eeArray)
                                        if(eSQL.exerciseID == eeSearch.uniqueID)
                                                ex = eeSearch;
 
-                               double mass = Convert.ToDouble(eSQL.extraWeight); //TODO: future problem if 
this has '%'
-                               //EncoderExercise ex = (EncoderExercise) 
-                               //      SqliteEncoder.SelectEncoderExercises(true, eSQL.exerciseID, false)[0];
-                               mass += bodyMass * ex.percentBodyWeight / 100.0;
+                               //massBody change if we are comparing different persons or sessions
+                               if(eSQL.personID != iteratingPerson || eSQL.sessionID != iteratingSession) {
+                                       iteratingMassBody = SqlitePersonSession.SelectAttribute(
+                                                       false, eSQL.personID, eSQL.sessionID, 
Constants.Weight);
+                               }
 
                                //seriesName
                                string seriesName = "";
@@ -2124,7 +2133,8 @@ Log.WriteLine(str);
                                }
 
                                writer.WriteLine(eSQL.status + "," + seriesName + "," + ex.name + "," +
-                                               Util.ConvertToPoint(mass).ToString() + "," + 
+                                               Util.ConvertToPoint(iteratingMassBody).ToString() + "," + 
+                                               Util.ConvertToPoint(Convert.ToDouble(eSQL.extraWeight)) + "," 
+
                                                Util.ConvertToPoint(eSQL.smooth) + "," + eSQL.GetDate(true) + 
"," + 
                                                fullURL + "," + 
                                                eSQL.eccon + "," +      //this is the eccon of every curve
@@ -2150,7 +2160,8 @@ Log.WriteLine(str);
                        ep = new EncoderParams(
                                        (int) encoderCaptureOptionsWin.spin_encoder_capture_min_height.Value, 
                                        getExercisePercentBodyWeightFromCombo (),
-                                       Util.ConvertToPoint(findMassFromCombo(true)),
+                                       Util.ConvertToPoint(findMass(Constants.MassType.BODY)),
+                                       Util.ConvertToPoint(findMass(Constants.MassType.EXTRA)),
                                        findEccon(false),               //do not force ecS (ecc-conc 
separated)
                                        sendAnalysis,
                                        analysisVariables, 
@@ -2397,6 +2408,7 @@ Log.WriteLine(str);
                return false;
        }
 
+       /*
        private double findMassFromCombo(bool includePerson) {
                double mass = spin_encoder_extra_weight.Value;
                if(includePerson) {
@@ -2408,6 +2420,18 @@ Log.WriteLine(str);
 
                return mass;
        }
+       */
+
+       //BODY and EXTRA are at EncoderParams and sent to graph.R       
+       private double findMass(Constants.MassType massType) {
+               if(massType == Constants.MassType.BODY)
+                       return currentPersonSession.Weight;
+               else if(massType == Constants.MassType.EXTRA)
+                       return spin_encoder_extra_weight.Value;
+               else //(massType == Constants.MassType.DISPLACED)
+                       return spin_encoder_extra_weight.Value + 
+                               ( currentPersonSession.Weight * getExercisePercentBodyWeightFromCombo() );
+       }
 
        //this is used in 1RM return to substract the weight of the body (if used on exercise)
        private double massWithoutPerson(double massTotal, string exerciseName) {
@@ -2976,11 +3000,12 @@ Log.WriteLine(str);
                                                        cells[0],       //id 
                                                        //cells[1],     //seriesName
                                                        //cells[2],     //exerciseName
-                                                       //cells[3],     //mass
-                                                       cells[4], cells[5], cells[6], 
-                                                       cells[7], cells[8], cells[9], 
-                                                       cells[10], cells[11], cells[12],
-                                                       cells[13]
+                                                       //cells[3],     //massBody
+                                                       //cells[4],     //massExtra
+                                                       cells[5], cells[6], cells[7], 
+                                                       cells[8], cells[9], cells[10], 
+                                                       cells[11], cells[12], cells[13],
+                                                       cells[14]
                                                        ));
 
                        } while(true);
@@ -3082,7 +3107,7 @@ Log.WriteLine(str);
                                        false, -1, currentPerson.UniqueID, currentSession.UniqueID, "curve", 
true);
                } else {        //current signal
                        exerciseName = UtilGtk.ComboGetActive(combo_encoder_exercise);
-                       displacedMass = findMassFromCombo(true);
+                       displacedMass = findMass(Constants.MassType.DISPLACED);
                }
 
                string line;
@@ -3109,7 +3134,7 @@ Log.WriteLine(str);
                                        displacedMass = eSQL.extraWeight;
                                        */
                                        exerciseName = cells[2];
-                                       displacedMass = Convert.ToDouble(cells[3]);
+                                       displacedMass = Convert.ToDouble(cells[4]);
                                }
 
                                encoderAnalyzeCurves.Add (new EncoderCurve (
@@ -3118,10 +3143,10 @@ Log.WriteLine(str);
                                                        exerciseName,
                                                        massWithoutPerson(displacedMass, exerciseName),
                                                        displacedMass,
-                                                       cells[4], cells[5], cells[6], 
-                                                       cells[7], cells[8], cells[9], 
-                                                       cells[10], cells[11], cells[12],
-                                                       cells[13]
+                                                       cells[5], cells[6], cells[7], 
+                                                       cells[8], cells[9], cells[10], 
+                                                       cells[11], cells[12], cells[13],
+                                                       cells[14]
                                                        ));
 
                        } while(true);
@@ -3445,15 +3470,16 @@ Log.WriteLine(str);
        
        private string [] fixDecimals(string [] cells) {
                //start, width, height
-               for(int i=4; i <= 6; i++)
+               for(int i=5; i <= 7; i++)
                        cells[i] = 
Util.TrimDecimals(Convert.ToDouble(Util.ChangeDecimalSeparator(cells[i])),1);
                
                //meanSpeed,maxSpeed,maxSpeedT, meanPower,peakPower,peakPowerT
-               for(int i=7; i <= 12; i++)
+               for(int i=8; i <= 13; i++)
                        cells[i] = 
Util.TrimDecimals(Convert.ToDouble(Util.ChangeDecimalSeparator(cells[i])),3);
                
                //pp/ppt
-               cells[13] = Util.TrimDecimals(Convert.ToDouble(Util.ChangeDecimalSeparator(cells[13])),1); 
+               int pp_ppt = 14;
+               cells[pp_ppt] = 
Util.TrimDecimals(Convert.ToDouble(Util.ChangeDecimalSeparator(cells[pp_ppt])),1); 
                return cells;
        }
        
@@ -3969,7 +3995,7 @@ Log.WriteLine(str);
                        }
                        //end of propulsive stuff
 
-                       NumericVector mass = rengine.CreateNumericVector(new double[] 
{findMassFromCombo(true)});
+                       NumericVector mass = rengine.CreateNumericVector(new double[] 
{findMass(Constants.MassType.DISPLACED)});
                        rengine.SetSymbol("mass", mass);
 
 
@@ -4019,7 +4045,7 @@ Log.WriteLine(str);
                                                "meanPower: {4}\npeakPower: {5}\npeakPowerT: {6}", 
                                                height, meanSpeed, maxSpeed, speedT1, meanPower, peakPower, 
peakPowerT));
                        
-                       encoderCaptureStringR += 
string.Format("\n{0},2,a,3,{1},{2},{3},{4},{5},{6},{7},{8},{9},{10},7",
+                       encoderCaptureStringR += 
string.Format("\n{0},2,a,3,4,{1},{2},{3},{4},{5},{6},{7},{8},{9},{10},7",
                                        ecca.curvesAccepted +1,
                                        ecc.startFrame, ecc.endFrame-ecc.startFrame,
                                        Util.ConvertToPoint(height*10), //cm    



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