nmelone/GoldenCheetah
1
0
Fork 0
mirror of https://github.com/GoldenCheetah/GoldenCheetah.git synced 2026-02-15 08:59:55 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
bd367e607a4dcc935edafcaea00d142916242c97
GoldenCheetah/src/R/RTool.cpp
Alejandro Martinez bd367e607a Add planned/expected PMC to R/Python APIs 
Part 2 of #4652
2025-07-11 16:06:48 -03:00

4250 lines
144 KiB
C++
Raw Blame History

/*
* Copyright (c) 2016 Mark Liversedge (liversedge@gmail.com)
*
* This program is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 2 of the License, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
* more details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc., 51
* Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "RTool.h"
#include "RGraphicsDevice.h"
#include "GcUpgrade.h"
#include "RideCache.h"
#include "RideItem.h"
#include "IntervalItem.h"
#include "RideFile.h"
#include "RideFileCache.h"
#include "Colors.h"
#include "RideMetric.h"
#include "RideMetadata.h"
#include "PMCData.h"
#include "WPrime.h"
#include "Season.h"
#include "Seasons.h"
#include "DataFilter.h"
#include "Specification.h"
#include "Zones.h"
#include "HrZones.h"
#include "PaceZones.h"
#include "GenericChart.h"
#include "Perspective.h"
#include "SpecialFields.h"
#ifdef __GNUC__
#pragma GCC diagnostic ignored "-Wcast-function-type" // shut gcc up
#endif
// Structure used to register routines has changed in v3.4 of R
//
// there is no way to support older versions without declaring our
// own versions of these structures. The R code maintainers don't
// consider legacy support, so we have to do this hack
//
// reduced number of members from v3.4 onwards
typedef struct {
const char *name;
DL_FUNC fun;
int numArgs;
R_NativePrimitiveArgType *types;
} R_CMethodDef34;
// prior to v3.4 they used this structure
typedef struct {
const char *name;
DL_FUNC fun;
int numArgs;
R_NativePrimitiveArgType *types;
enum { R_ARG_IN, R_ARG_OUT, R_IRRELEVANT } *styles; // deprecated in 3.4
} R_CMethodDef33;
RTool::RTool()
{
// setup the R runtime elements
failed = false;
starting = true;
canvas = NULL;
perspective = NULL;
chart = NULL;
context = NULL;
// if we bail we need to explain why, its in here
QString dialogtext;
try {
// yikes, self referenced during construction (!)
rtool = this;
// set default width and height
width = height = 500;
// initialise
R = new REmbed();
// failed to load
if (R->loaded == false) {
failed=true;
return;
}
// capture all output and input to our methods
#ifndef WIN32
ptr_R_Suicide = &RTool::R_Suicide;
ptr_R_ShowMessage = &RTool::R_ShowMessage;
ptr_R_ReadConsole = &RTool::R_ReadConsole;
ptr_R_WriteConsole = &RTool::R_WriteConsole;
ptr_R_WriteConsoleEx = &RTool::R_WriteConsoleEx;
ptr_R_ResetConsole = &RTool::R_ResetConsole;
ptr_R_FlushConsole = &RTool::R_FlushConsole;
ptr_R_ClearerrConsole = &RTool::R_ClearerrConsole;
ptr_R_ProcessEvents = &RTool::R_ProcessEvents;
ptr_R_Busy = &RTool::R_Busy;
// turn off stderr io
R_Outputfile = NULL;
R_Consolefile = NULL;
#endif
// IMPORTANT: **** REMEMBER TO CHANGE BOTH WHEN ADDING NEW ROUTINES ****
//
// setup when embedding v3.4 or higher
R_CMethodDef34 cMethods34[] = {
{ "GC.display", (DL_FUNC) &RGraphicsDevice::GCdisplay, 0,0 },
{ "GC.page", (DL_FUNC) &RTool::pageSize, 0,0 },
{ "GC.size", (DL_FUNC) &RTool::windowSize, 0,0 },
{ "GC.athlete", (DL_FUNC) &RTool::athlete, 0,0 },
{ "GC.athlete.zones", (DL_FUNC) &RTool::zones, 0,0 },
{ "GC.intervalType", (DL_FUNC) &RTool::intervalType, 0,0 },
{ "GC.activities", (DL_FUNC) &RTool::activities, 0,0 },
{ "GC.activity", (DL_FUNC) &RTool::activity, 0,0 },
{ "GC.activity.metrics", (DL_FUNC) &RTool::activityMetrics, 0,0 },
{ "GC.activity.meanmax", (DL_FUNC) &RTool::activityMeanmax, 0,0 },
{ "GC.activity.wbal", (DL_FUNC) &RTool::activityWBal, 0,0 },
{ "GC.activity.xdata", (DL_FUNC) &RTool::activityXData, 0,0 },
{ "GC.activity.intervals", (DL_FUNC) &RTool::activityIntervals, 0,0 },
{ "GC.season", (DL_FUNC) &RTool::season, 0,0 },
{ "GC.season.metrics", (DL_FUNC) &RTool::metrics, 0,0 },
{ "GC.season.intervals", (DL_FUNC) &RTool::seasonIntervals, 0,0 },
{ "GC.season.pmc", (DL_FUNC) &RTool::pmc, 0,0 },
{ "GC.season.meanmax", (DL_FUNC) &RTool::seasonMeanmax, 0,0 },
{ "GC.season.peaks", (DL_FUNC) &RTool::seasonPeaks, 0,0 },
{ "GC.season.measures", (DL_FUNC) &RTool::measures, 0,0 },
{ "GC.chart.set", (DL_FUNC) &RTool::setChart, 0,0 },
{ "GC.chart.addCurve", (DL_FUNC) &RTool::addCurve, 0,0 },
{ "GC.chart.configureAxis", (DL_FUNC) &RTool::configureAxis, 0,0 },
{ "GC.chart.annotate", (DL_FUNC) &RTool::annotate, 0,0 },
{ NULL, NULL, 0,0 }
};
// setup when embedding prior to 3.4
R_CMethodDef33 cMethods33[] = {
{ "GC.display", (DL_FUNC) &RGraphicsDevice::GCdisplay, 0,0,0 },
{ "GC.page", (DL_FUNC) &RTool::pageSize, 0,0,0 },
{ "GC.size", (DL_FUNC) &RTool::windowSize, 0,0,0 },
{ "GC.athlete", (DL_FUNC) &RTool::athlete, 0,0,0 },
{ "GC.athlete.zones", (DL_FUNC) &RTool::zones, 0,0,0 },
{ "GC.intervalType", (DL_FUNC) &RTool::intervalType, 0,0,0 },
{ "GC.activities", (DL_FUNC) &RTool::activities, 0,0,0 },
{ "GC.activity", (DL_FUNC) &RTool::activity, 0,0,0 },
{ "GC.activity.metrics", (DL_FUNC) &RTool::activityMetrics, 0,0,0 },
{ "GC.activity.meanmax", (DL_FUNC) &RTool::activityMeanmax, 0,0,0 },
{ "GC.activity.wbal", (DL_FUNC) &RTool::activityWBal, 0,0,0 },
{ "GC.activity.xdata", (DL_FUNC) &RTool::activityXData, 0,0,0 },
{ "GC.activity.intervals", (DL_FUNC) &RTool::activityIntervals, 0,0,0 },
{ "GC.season", (DL_FUNC) &RTool::season, 0,0,0 },
{ "GC.season.metrics", (DL_FUNC) &RTool::metrics, 0,0,0 },
{ "GC.season.intervals", (DL_FUNC) &RTool::seasonIntervals, 0,0,0 },
{ "GC.season.pmc", (DL_FUNC) &RTool::pmc, 0,0,0 },
{ "GC.season.meanmax", (DL_FUNC) &RTool::seasonMeanmax, 0,0,0 },
{ "GC.season.peaks", (DL_FUNC) &RTool::seasonPeaks, 0,0,0 },
{ "GC.season.measures", (DL_FUNC) &RTool::measures, 0,0,0 },
{ "GC.chart.set", (DL_FUNC) &RTool::setChart, 0,0,0 },
{ "GC.chart.addCurve", (DL_FUNC) &RTool::addCurve, 0,0,0 },
{ "GC.chart.configureAxis", (DL_FUNC) &RTool::configureAxis, 0,0,0 },
{ "GC.chart.annotate", (DL_FUNC) &RTool::annotate, 0,0,0 },
{ NULL, NULL, 0,0,0 }
};
R_CallMethodDef callMethods[] = {
{ "GC.display", (DL_FUNC) &RGraphicsDevice::GCdisplay, 0 },
{ "GC.page", (DL_FUNC) &RTool::pageSize, 2 },
{ "GC.size", (DL_FUNC) &RTool::windowSize, 0 },
// athlete
{ "GC.athlete", (DL_FUNC) &RTool::athlete, 0 },
{ "GC.athlete.zones", (DL_FUNC) &RTool::zones, 2 },
// intervals
{ "GC.intervalType", (DL_FUNC) &RTool::intervalType, 1 },
// if activity is passed compare=TRUE it returns a list of rides
// currently in the compare pane if compare is enabled or
// just a 1 item list with the current ride
{ "GC.activities", (DL_FUNC) &RTool::activities, 1 },
{ "GC.activity", (DL_FUNC) &RTool::activity, 4 },
{ "GC.activity.metrics", (DL_FUNC) &RTool::activityMetrics, 1 },
{ "GC.activity.meanmax", (DL_FUNC) &RTool::activityMeanmax, 1 },
{ "GC.activity.wbal", (DL_FUNC) &RTool::activityWBal, 1 },
// name="", compare=FALSE
{ "GC.activity.xdata", (DL_FUNC) &RTool::activityXData, 2 },
// type=any, datetime=0
{ "GC.activity.intervals", (DL_FUNC) &RTool::activityIntervals, 2 },
// all=FALSE, compare=FALSE
{ "GC.season", (DL_FUNC) &RTool::season, 2 },
{ "GC.season.metrics", (DL_FUNC) &RTool::metrics, 3 },
// type=any, compare=FALSE
{ "GC.season.intervals", (DL_FUNC) &RTool::seasonIntervals, 2 },
{ "GC.season.meanmax", (DL_FUNC) &RTool::seasonMeanmax, 3 },
{ "GC.season.peaks", (DL_FUNC) &RTool::seasonPeaks, 5 },
// return a data.frame of pmc series (all=FALSE, metric="BikeStress", type="Actual")
{ "GC.season.pmc", (DL_FUNC) &RTool::pmc, 3 },
// return a data.frame of measure fields (all=FALSE, group="Body")
{ "GC.season.measures", (DL_FUNC) &RTool::measures, 2 },
{ "GC.chart.set", (DL_FUNC) &RTool::setChart, 6 },
{ "GC.chart.addCurve", (DL_FUNC) &RTool::addCurve, 17 },
{ "GC.chart.configureAxis", (DL_FUNC) &RTool::configureAxis, 10 },
{ "GC.chart.annotate", (DL_FUNC) &RTool::annotate, 4 },
{ NULL, NULL, 0 }
};
// dynamically loading now, so the version may not be
// the same as the version we built with.
// get version just loaded from shared lib
R->parseEvalNT("print(R.version.string)");
QStringList strings = rtool->messages;
if (strings.count() == 3) {
QRegExp exp("^.*([0-9]+\\.[0-9]+\\.[0-9]+).*$");
if (exp.exactMatch(strings[1])) version = exp.cap(1);
else version = strings[1];
}
QStringList nums = version.split(".");
int majorN = nums[0].toInt();
int minorN = nums[1].toInt();
// now check version compatibility against what we built with
double majorB=QString(R_MAJOR).toDouble();
double minorB=QString(R_MINOR).toDouble();
if (majorB > 3 || (majorB == 3 && minorB > 3)) {
// if we're built with 3.4 or higher we need 3.4 or higher
if (majorN < 3 || (majorN == 3 && minorN < 4)) {
// we have an older version so no go
failed=true;
dialogtext = QObject::tr("The version of R installed is too old. You must have R version 3.4 or higher.\n");
goto fail;
}
} else {
// if we're build with <3.4 don't support 3.4 or higher
if (majorN >3 || (majorN == 3 && minorN > 3)) {
// we have an older version so no go
failed=true;
dialogtext = QObject::tr("The version of R installed is too new. You must have R version 3.3 or older.\n");
goto fail;
}
}
// should be safe to setup the graphics device now
dev = new RGraphicsDevice();
// set them up
DllInfo *info = R_getEmbeddingDllInfo();
// future proof, 3.4 or higher use new structure, 3.3 anything lower uses older structure
if (majorN > 3 || (majorN == 3 && minorN > 3)) R_registerRoutines(info, (const R_CMethodDef*)(cMethods34), callMethods, NULL, NULL);
else R_registerRoutines(info, (const R_CMethodDef*)(cMethods33), callMethods, NULL, NULL);
// what version are we running?
#ifdef GC_WANT_ALLDEBUG
fprintf(stderr,"R loaded. [Compiled=%s.%s, Loaded=%d.%d, Loaded DeviceEngine=%d]\n", R_MAJOR, R_MINOR, majorN, minorN, GC_R_GE_getVersion());
#endif
rtool->messages.clear();
// load the dynamix library and create function wrapper
// we should put this into a source file (.R)
R->parseEvalNT(QString("options(\"repos\"=\"%3\")\n"
// graphics device
"GC.display <- function() { .Call(\"GC.display\") }\n"
"GC.page <- function(width=0, height=0) { .Call(\"GC.page\", width, height) }\n"
"GC.size <- function() { .Call(\"GC.size\") }\n"
// athlete
"GC.athlete <- function() { .Call(\"GC.athlete\") }\n"
"GC.athlete.zones <- function(date=0, sport=\"\") { .Call(\"GC.athlete.zones\", date, sport) }\n"
// intervals
"GC.intervalType <- function(type=1) { .Call(\"GC.intervalType\", type) }\n"
// activity
"GC.activities <- function(filter=\"\") { .Call(\"GC.activities\", filter) }\n"
"GC.activity <- function(activity=0, compare=FALSE, split=0, join=\"repeat\") { .Call(\"GC.activity\", activity, compare, split, join) }\n"
"GC.activity.metrics <- function(compare=FALSE) { .Call(\"GC.activity.metrics\", compare) }\n"
"GC.activity.meanmax <- function(compare=FALSE) { .Call(\"GC.activity.meanmax\", compare) }\n"
"GC.activity.wbal <- function(compare=FALSE) { .Call(\"GC.activity.wbal\", compare) }\n"
"GC.activity.xdata <- function(name=\"\", compare=FALSE) { .Call(\"GC.activity.xdata\", name, compare) }\n"
"GC.activity.intervals <- function(type=NULL, activity=0) { .Call(\"GC.activity.intervals\", type, activity) }\n"
// season
"GC.season <- function(all=FALSE, compare=FALSE) { .Call(\"GC.season\", all, compare) }\n"
"GC.season.metrics <- function(all=FALSE, filter=\"\", compare=FALSE) { .Call(\"GC.season.metrics\", all, filter, compare) }\n"
"GC.season.intervals <- function(type=NULL, compare=FALSE) { .Call(\"GC.season.intervals\", type, compare) }\n"
"GC.season.pmc <- function(all=FALSE, metric=\"BikeStress\", type=\"Actual\") { .Call(\"GC.season.pmc\", all, metric, type) }\n"
"GC.season.measures <- function(all=FALSE, group=\"Body\") { .Call(\"GC.season.measures\", all, group) }\n"
"GC.season.meanmax <- function(all=FALSE, filter=\"\", compare=FALSE) { .Call(\"GC.season.meanmax\", all, filter, compare) }\n"
// find peaks does a few validation checks on the R side
"GC.season.peaks <- function(all=FALSE, filter=\"\", compare=FALSE, series, duration) {\n"
" if (missing(series)) stop(\"series must be specified.\")\n"
" if (missing(duration)) stop(\"duration must be specified.\")\n"
" if (!is.numeric(duration)) stop(\"duration must be numeric.\")\n"
" .Call(\"GC.season.peaks\", all, filter, compare, series, duration)"
"}\n"
// these 2 added for backward compatibility, may be deprecated
"GC.metrics <- function(all=FALSE, filter=\"\", compare=FALSE) { .Call(\"GC.season.metrics\", all, filter, compare) }\n"
"GC.pmc <- function(all=FALSE, metric=\"BikeStress\", type=\"Actual\") { .Call(\"GC.season.pmc\", all, metric, type) }\n"
// charts
"GC.setChart <- function(title=\"\", type=1, animate=FALSE, legpos=2, stack=FALSE, orientation=2) { .Call(\"GC.chart.set\", title, type, animate, legpos ,stack, orientation)}\n"
"GC.addCurve <- function(name=\"curve\", xseries=c(), yseries=c(), fseries=c(), xname=\"xaxis\", yname=\"yaxis\", min=-1, max=-1, labels=c(), colors=c(), line=1,symbol=1,size=2,color=\"red\",opacity=100,opengl=TRUE, legend=TRUE, datalabels=FALSE, fill=FALSE) { .Call(\"GC.chart.addCurve\", name, xseries, yseries, fseries, xname, yname, labels, colors, line, symbol, size, color, opacity, opengl, legend, datalabels, fill)}\n"
"GC.setAxis <- function(name=\"xaxis\",visible=TRUE, align=-1, min=-1, max=-1, type=0, labelcolor=\"\", color=\"\", log=FALSE, categories=c()) { .Call(\"GC.chart.configureAxis\", name, visible, align, min, max, type, labelcolor,color,log,categories)}\n"
"GC.annotate <- function(type=\"label\", series=\"curve\", strings=c()) { .Call(\"GC.chart.annotate\", type, series, strings, FALSE)}\n"
// constants
"GC.HORIZONTAL<-1\n"
"GC.VERTICAL<-2\n"
"GC.ALIGN.TOP<-2\n"
"GC.ALIGN.BOTTOM<-0\n"
"GC.ALIGN.LEFT<-1\n"
"GC.ALIGN.RIGHT<-3\n"
"GC.ALIGN.NONE<-4\n"
"GC.LINE.NONE<-0\n"
"GC.LINE.SOLID<-1\n"
"GC.LINE.DASH<-2\n"
"GC.LINE.DOT<-3\n"
"GC.LINE.DASHDOT<-4\n"
"GC.SYMBOL.NONE<-0\n"
"GC.SYMBOL.CIRCLE<-1\n"
"GC.SYMBOL.RECTANGLE<-2\n"
"GC.CHART.LINE<-1\n"
"GC.CHART.SCATTER<-2\n"
"GC.CHART.BAR<-3\n"
"GC.CHART.PIE<-4\n"
"GC.AXIS.CONTINUOUS<-0\n"
"GC.AXIS.DATE<-1\n"
"GC.AXIS.TIME<-2\n"
"GC.AXIS.CATEGORY<-3\n"
// version and build
"GC.version <- function() { return(\"%1\") }\n"
"GC.build <- function() { return(%2) }\n"
"par.default <- par()\n"
)
.arg(VERSION_STRING)
.arg(VERSION_LATEST)
.arg("https://cloud.r-project.org/"));
rtool->messages.clear();
configChanged();
} catch(std::exception& ex) {
qDebug()<<"Parse error:" << ex.what();
failed = true;
} catch(...) {
failed = true;
}
fail:
if (failed) {
// ack, disable R runtime now and in the future
qDebug() << "R Embed failed to start, RConsole disabled.";
appsettings->setValue(GC_EMBED_R, false);
version = "none";
R = NULL;
// end embedding
// Don't bug the user, most of them don't care
//QMessageBox warn(QMessageBox::Information, QObject::tr("R version Incompatible"),
// dialogtext + QObject::tr("\nR has been disabled in preferences"));
//warn.exec();
}
starting = false;
}
void
RTool::R_ProcessEvents()
{
QApplication::processEvents();
}
void
RTool::cancel()
{
// gets called when we need to stop a long running script
rtool->cancelled = true;
#ifdef WIN32
UserBreak = true;
#else
R_interrupts_pending = 1;
#endif
}
void
RTool::configChanged()
{
// wait until loaded
if (starting || failed) return;
// update global R appearances
QString parCommand=QString("par(par.default)\n"
"par(bg=\"%1\", "
" col=\"%2\", "
" fg=\"%2\", "
" col.main=\"%2\", "
" col.sub=\"%3\", "
" col.lab=\"%3\", "
" col.axis=\"%3\")\n"
"par.gc <- par()\n"
).arg(GColor(CPLOTBACKGROUND).name())
.arg(GCColor::invertColor(GColor(CPLOTBACKGROUND)).name())
.arg(GColor(CPLOTMARKER).name());
// fire and forget, don't care if it fails or not !!
rtool->R->parseEvalNT(parCommand);
}
SEXP
RTool::athlete()
{
if (rtool == NULL || rtool->context == NULL) return Rf_allocVector(INTSXP, 0);
// name, home, dob, height, weight, gender
SEXP ans, names;
PROTECT(ans=Rf_allocVector(VECSXP, 6));
PROTECT(names=Rf_allocVector(STRSXP, 6));
// next and nextS
SEXP item;
int next=0;
// NAME
PROTECT(item=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(item, 0, Rf_mkChar(rtool->context->athlete->cyclist.toLatin1().constData()));
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("name"));
UNPROTECT(1);
// HOME
PROTECT(item=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(item, 0, Rf_mkChar(rtool->context->athlete->home->root().absolutePath().toLatin1().constData()));
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("home"));
UNPROTECT(1);
// DOB
PROTECT(item=Rf_allocVector(INTSXP, 1));
QDate d1970(1970,01,01);
INTEGER(item)[0] = d1970.daysTo(appsettings->cvalue(rtool->context->athlete->cyclist, GC_DOB).toDate());
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(item,dclas);
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("dob"));
UNPROTECT(2);
// WEIGHT
PROTECT(item=Rf_allocVector(REALSXP, 1));
REAL(item)[0] = appsettings->cvalue(rtool->context->athlete->cyclist, GC_WEIGHT).toDouble();
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("weight"));
UNPROTECT(1);
// HEIGHT
PROTECT(item=Rf_allocVector(REALSXP, 1));
REAL(item)[0] = appsettings->cvalue(rtool->context->athlete->cyclist, GC_HEIGHT).toDouble();
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("height"));
UNPROTECT(1);
// GENDER
int isfemale = appsettings->cvalue(rtool->context->athlete->cyclist, GC_SEX).toInt();
PROTECT(item=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(item, 0, isfemale ? Rf_mkChar("female") : Rf_mkChar("male"));
SET_VECTOR_ELT(ans, next, item);
SET_STRING_ELT(names, next++, Rf_mkChar("gender"));
UNPROTECT(1);
// set the names
Rf_namesgets(ans, names);
// ans + names
UNPROTECT(2);
return ans;
}
// one entry per sport per date for hr/power/pace
class gcZoneConfig {
public:
gcZoneConfig(QString sport) : sport(sport), date(QDate(01,01,01)), cp(0), wprime(0), pmax(0), aetp(0), ftp(0),lthr(0),aethr(0),rhr(0),hrmax(0),cv(0),aetv(0) {}
bool operator<(gcZoneConfig rhs) const { return date < rhs.date; }
QString sport;
QDate date;
QList<int> zoneslow;
QList<int> hrzoneslow;
QList<double> pacezoneslow;
int cp, wprime, pmax,aetp,ftp,lthr,aethr,rhr,hrmax;
double cv, aetv;
};
SEXP
RTool::zones(SEXP pDate, SEXP pSport)
{
// return a dataframe with
// date, sport, cp, w', pmax, aetp, ftp, lthr, aethr, rhr, hrmax, cv, aetv, zoneslow, hrzoneslow, pacezoneslow, zonescolor
// need non-null context
if (!rtool || !rtool->context) return Rf_allocVector(INTSXP, 0);
// COLLECT ALL THE CONFIG TOGETHER
QList<gcZoneConfig> config;
// for a specific date?
QDate d1970(1970,01,01);
PROTECT(pDate=Rf_coerceVector(pDate,INTSXP));
if (INTEGER(pDate)[0] != 0) {
// get settings for...
QDate forDate=d1970.addDays(INTEGER(pDate)[0]);
// Look for the range in Power, HR and Pace zones for each sport
foreach (QString sp, GlobalContext::context()->rideMetadata->sports()) {
// Power Zones
if (rtool->context->athlete->zones(sp)) {
// run through the power zones
int range=rtool->context->athlete->zones(sp)->whichRange(forDate);
if (range >= 0) {
gcZoneConfig c(sp);
c.date = forDate;
c.cp = rtool->context->athlete->zones(sp)->getCP(range);
c.wprime = rtool->context->athlete->zones(sp)->getWprime(range);
c.pmax = rtool->context->athlete->zones(sp)->getPmax(range);
c.aetp = rtool->context->athlete->zones(sp)->getAeT(range);
c.ftp = rtool->context->athlete->zones(sp)->getFTP(range);
c.zoneslow = rtool->context->athlete->zones(sp)->getZoneLows(range);
config << c;
}
}
// HR Zones
if (rtool->context->athlete->hrZones(sp)) {
int range=rtool->context->athlete->hrZones(sp)->whichRange(forDate);
if (range >= 0) {
gcZoneConfig c(sp);
c.date = forDate;
c.lthr = rtool->context->athlete->hrZones(sp)->getLT(range);
c.aethr = rtool->context->athlete->hrZones(sp)->getAeT(range);
c.rhr = rtool->context->athlete->hrZones(sp)->getRestHr(range);
c.hrmax = rtool->context->athlete->hrZones(sp)->getMaxHr(range);
c.hrzoneslow = rtool->context->athlete->hrZones(sp)->getZoneLows(range);
config << c;
}
}
// Pace Zones
if ((sp == "Run" || sp == "Swim") && rtool->context->athlete->paceZones(sp=="Swim")) {
int range=rtool->context->athlete->paceZones(sp=="Swim")->whichRange(forDate);
if (range >= 0) {
gcZoneConfig c(sp);
c.date = forDate;
c.cv = rtool->context->athlete->paceZones(sp=="Swim")->getCV(range);
c.aetv = rtool->context->athlete->paceZones(sp=="Swim")->getAeT(range);
c.pacezoneslow = rtool->context->athlete->paceZones(sp=="Swim")->getZoneLows(range);
config << c;
}
}
}
} else {
// Look for the ranges in Power, HR and Pace zones for each sport
foreach (QString sp, GlobalContext::context()->rideMetadata->sports()) {
// Power Zones
if (rtool->context->athlete->zones(sp)) {
for (int range=0; range < rtool->context->athlete->zones(sp)->getRangeSize(); range++) {
// run through the power zones
gcZoneConfig c(sp);
c.date = rtool->context->athlete->zones(sp)->getStartDate(range);
c.cp = rtool->context->athlete->zones(sp)->getCP(range);
c.wprime = rtool->context->athlete->zones(sp)->getWprime(range);
c.pmax = rtool->context->athlete->zones(sp)->getPmax(range);
c.aetp = rtool->context->athlete->zones(sp)->getAeT(range);
c.ftp = rtool->context->athlete->zones(sp)->getFTP(range);
c.zoneslow = rtool->context->athlete->zones(sp)->getZoneLows(range);
config << c;
}
}
// HR Zones
if (rtool->context->athlete->hrZones(sp)) {
for (int range=0; range < rtool->context->athlete->hrZones(sp)->getRangeSize(); range++) {
gcZoneConfig c(sp);
c.date = rtool->context->athlete->hrZones(sp)->getStartDate(range);
c.lthr = rtool->context->athlete->hrZones(sp)->getLT(range);
c.aethr = rtool->context->athlete->hrZones(sp)->getAeT(range);
c.rhr = rtool->context->athlete->hrZones(sp)->getRestHr(range);
c.hrmax = rtool->context->athlete->hrZones(sp)->getMaxHr(range);
c.hrzoneslow = rtool->context->athlete->hrZones(sp)->getZoneLows(range);
config << c;
}
}
// Pace Zones
if ((sp == "Run" || sp == "Swim") && rtool->context->athlete->paceZones(sp=="Swim")) {
for (int range=0; range < rtool->context->athlete->paceZones(sp=="Swim")->getRangeSize(); range++) {
gcZoneConfig c(sp);
c.date = rtool->context->athlete->paceZones(sp=="Swim")->getStartDate(range);
c.cv = rtool->context->athlete->paceZones(sp=="Swim")->getCV(range);
c.aetv = rtool->context->athlete->paceZones(sp=="Swim")->getAeT(range);
c.pacezoneslow = rtool->context->athlete->paceZones(sp=="Swim")->getZoneLows(range);
config << c;
}
}
}
}
// pDate
UNPROTECT(1);
// no config ?
if (config.count() == 0) return Rf_allocVector(INTSXP, 0);
// COMPRESS CONFIG TOGETHER BY SPORT
// filter sport?
PROTECT(pSport=Rf_coerceVector(pSport, STRSXP));
QString want(CHAR(STRING_ELT(pSport,0)));
UNPROTECT(1);
// compress here
QList<gcZoneConfig> compressed;
std::sort(config.begin(),config.end());
foreach (QString sp, GlobalContext::context()->rideMetadata->sports()) {
// will have date zero
gcZoneConfig last(sp);
foreach(gcZoneConfig x, config) {
if (x.sport == sp && (want=="" || QString::compare(want, sp, Qt::CaseInsensitive)==0)) {
// new date so save what we have collected
if (x.date > last.date) {
if (last.date > QDate(01,01,01)) compressed << last;
last.date = x.date;
}
// merge new values
if (x.date == last.date) {
// merge with prior
if (x.cp) last.cp = x.cp;
if (x.wprime) last.wprime = x.wprime;
if (x.pmax) last.pmax = x.pmax;
if (x.aetp) last.aetp = x.aetp;
if (x.ftp) last.ftp = x.ftp;
if (x.lthr) last.lthr = x.lthr;
if (x.aethr) last.aethr = x.aethr;
if (x.rhr) last.rhr = x.rhr;
if (x.hrmax) last.hrmax = x.hrmax;
if (x.cv) last.cv = x.cv;
if (x.aetv) last.aetv = x.aetv;
if (x.zoneslow.length()) last.zoneslow = x.zoneslow;
if (x.hrzoneslow.length()) last.hrzoneslow = x.hrzoneslow;
if (x.pacezoneslow.length()) last.pacezoneslow = x.pacezoneslow;
}
}
}
if (last.date > QDate(01,01,01)) compressed << last;
}
// now use the new compressed ones
config = compressed;
std::sort(config.begin(),config.end());
int size = config.count();
// CREATE A DATAFRAME OF CONFIG
SEXP ans;
PROTECT(ans = Rf_allocVector(VECSXP, 17));
// 17 columns, size rows
SEXP date;
SEXP sport;
SEXP cp, wprime, pmax,aetp,ftp,lthr,aethr,rhr,hrmax,cv,aetv, zoneslow, hrzoneslow, pacezoneslow, zonescolor;
SEXP rownames;
PROTECT(date=Rf_allocVector(INTSXP, size));
PROTECT(sport=Rf_allocVector(STRSXP, size));
PROTECT(cp=Rf_allocVector(INTSXP, size));
PROTECT(wprime=Rf_allocVector(INTSXP, size));
PROTECT(pmax=Rf_allocVector(INTSXP, size));
PROTECT(aetp=Rf_allocVector(INTSXP, size));
PROTECT(ftp=Rf_allocVector(INTSXP, size));
PROTECT(lthr=Rf_allocVector(INTSXP, size));
PROTECT(aethr=Rf_allocVector(INTSXP, size));
PROTECT(rhr=Rf_allocVector(INTSXP, size));
PROTECT(hrmax=Rf_allocVector(INTSXP, size));
PROTECT(cv=Rf_allocVector(REALSXP, size));
PROTECT(aetv=Rf_allocVector(REALSXP, size));
PROTECT(zoneslow=Rf_allocVector(VECSXP, size));
PROTECT(hrzoneslow=Rf_allocVector(VECSXP, size));
PROTECT(pacezoneslow=Rf_allocVector(VECSXP, size));
PROTECT(zonescolor=Rf_allocVector(VECSXP, size));
PROTECT(rownames=Rf_allocVector(STRSXP, size));
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
int index=0;
foreach(gcZoneConfig x, config) {
// update the arrays
INTEGER(date)[index] = d1970.daysTo(x.date);
SET_STRING_ELT(sport, index, Rf_mkChar(x.sport.toLatin1().constData()));
SET_STRING_ELT(rownames, index, Rf_mkChar(QString("%1").arg(index+1).toLatin1().constData()));
INTEGER(cp)[index] = x.cp;
INTEGER(wprime)[index] = x.wprime;
INTEGER(pmax)[index] = x.pmax;
INTEGER(aetp)[index] = x.aetp;
INTEGER(ftp)[index] = x.ftp;
INTEGER(lthr)[index] = x.lthr;
INTEGER(aethr)[index] = x.aethr;
INTEGER(rhr)[index] = x.rhr;
INTEGER(hrmax)[index] = x.hrmax;
REAL(cv)[index] = x.cv;
REAL(aetv)[index] = x.aetv;
SEXP lows, hrlows, pacelows, colors;
PROTECT(lows=Rf_allocVector(INTSXP, x.zoneslow.length()));
PROTECT(hrlows=Rf_allocVector(INTSXP, x.hrzoneslow.length()));
PROTECT(pacelows=Rf_allocVector(REALSXP, x.pacezoneslow.length()));
PROTECT(colors=Rf_allocVector(STRSXP, x.zoneslow.length()));
int indexlow=0;
foreach(int low, x.zoneslow) {
INTEGER(lows)[indexlow] = low;
SET_STRING_ELT(colors, indexlow, Rf_mkChar(zoneColor(indexlow, x.zoneslow.length()).name().toLatin1().constData()));
indexlow++;
}
indexlow=0;
foreach(int low, x.hrzoneslow) {
INTEGER(hrlows)[indexlow] = low;
indexlow++;
}
indexlow=0;
foreach(double low, x.pacezoneslow) {
REAL(pacelows)[indexlow] = low;
indexlow++;
}
SET_VECTOR_ELT(zoneslow, index, lows);
SET_VECTOR_ELT(hrzoneslow, index, hrlows);
SET_VECTOR_ELT(pacezoneslow, index, pacelows);
SET_VECTOR_ELT(zonescolor, index, colors);
UNPROTECT(4);
index++;
}
// add to frame
SET_VECTOR_ELT(ans, 0, date);
SET_VECTOR_ELT(ans, 1, sport);
SET_VECTOR_ELT(ans, 2, cp);
SET_VECTOR_ELT(ans, 3, wprime);
SET_VECTOR_ELT(ans, 4, pmax);
SET_VECTOR_ELT(ans, 5, aetp);
SET_VECTOR_ELT(ans, 6, ftp);
SET_VECTOR_ELT(ans, 7, lthr);
SET_VECTOR_ELT(ans, 8, aethr);
SET_VECTOR_ELT(ans, 9, rhr);
SET_VECTOR_ELT(ans, 10, hrmax);
SET_VECTOR_ELT(ans, 11, cv);
SET_VECTOR_ELT(ans, 12, aetv);
SET_VECTOR_ELT(ans, 13, zoneslow);
SET_VECTOR_ELT(ans, 14, hrzoneslow);
SET_VECTOR_ELT(ans, 15, pacezoneslow);
SET_VECTOR_ELT(ans, 16, zonescolor);
// turn into a data.frame, name class etc
SEXP names;
PROTECT(names = Rf_allocVector(STRSXP, 17));
SET_STRING_ELT(names, 0, Rf_mkChar("date"));
SET_STRING_ELT(names, 1, Rf_mkChar("sport"));
SET_STRING_ELT(names, 2, Rf_mkChar("cp"));
SET_STRING_ELT(names, 3, Rf_mkChar("wprime"));
SET_STRING_ELT(names, 4, Rf_mkChar("pmax"));
SET_STRING_ELT(names, 5, Rf_mkChar("aetp"));
SET_STRING_ELT(names, 6, Rf_mkChar("ftp"));
SET_STRING_ELT(names, 7, Rf_mkChar("lthr"));
SET_STRING_ELT(names, 8, Rf_mkChar("aethr"));
SET_STRING_ELT(names, 9, Rf_mkChar("rhr"));
SET_STRING_ELT(names, 10, Rf_mkChar("hrmax"));
SET_STRING_ELT(names, 11, Rf_mkChar("cv"));
SET_STRING_ELT(names, 12, Rf_mkChar("aetv"));
SET_STRING_ELT(names, 13, Rf_mkChar("zoneslow"));
SET_STRING_ELT(names, 14, Rf_mkChar("hrzoneslow"));
SET_STRING_ELT(names, 15, Rf_mkChar("pacezoneslow"));
SET_STRING_ELT(names, 16, Rf_mkChar("zonescolor"));
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
UNPROTECT(21);
// fail
return ans;
}
SEXP
RTool::pageSize(SEXP width, SEXP height)
{
width = Rf_coerceVector(width, INTSXP);
rtool->width = INTEGER(width)[0];
height = Rf_coerceVector(height, INTSXP);
rtool->height = INTEGER(height)[0];
// fail
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::windowSize()
{
// return a vector of width, height
SEXP ans;
PROTECT(ans = Rf_allocVector(INTSXP, 2));
INTEGER(ans)[0] = rtool->chart ? rtool->chart->geometry().width() : 500;
INTEGER(ans)[1] = rtool->chart ? rtool->chart->geometry().height() : 500;
UNPROTECT(1);
return ans;
}
SEXP
RTool::activities(SEXP filter)
{
SEXP dates=NULL;
SEXP clas;
if (rtool->context && rtool->context->athlete && rtool->context->athlete->rideCache) {
// filters
// apply any global filters
Specification specification;
FilterSet fs;
fs.addFilter(rtool->context->isfiltered, rtool->context->filters);
fs.addFilter(rtool->context->ishomefiltered, rtool->context->homeFilters);
// did call contain any filters?
PROTECT(filter=Rf_coerceVector(filter, STRSXP));
for(int i=0; i<Rf_length(filter); i++) {
// if not empty write a filter
QString f(CHAR(STRING_ELT(filter,i)));
if (f != "") {
DataFilter dataFilter(rtool->canvas, rtool->context);
QStringList files;
dataFilter.parseFilter(rtool->context, f, &files);
fs.addFilter(true, files);
}
}
specification.setFilterSet(fs);
UNPROTECT(1);
// how many pass?
int count=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
// apply filters
if (!specification.pass(item)) continue;
count++;
}
// allocate space for a vector of dates
PROTECT(dates=Rf_allocVector(REALSXP, count));
// fill with values for date and class
int i=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
// apply filters
if (!specification.pass(item)) continue;
// add to the list
REAL(dates)[i++] = item->dateTime.toUTC().toSecsSinceEpoch();
}
// POSIXct class
PROTECT(clas=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(dates,clas);
// we use "UTC" for all timezone
Rf_setAttrib(dates, Rf_install("tzone"), Rf_mkString("UTC"));
UNPROTECT(2);
}
return dates;
}
SEXP
RTool::dfForRideItem(const RideItem *ri)
{
RideItem *item = const_cast<RideItem*>(ri);
const RideMetricFactory &factory = RideMetricFactory::instance();
int rides = rtool->context->athlete->rideCache->count();
int metrics = factory.metricCount();
// count the number of meta fields to add
int meta = 0;
if (rtool->context) {
// count active fields
foreach(FieldDefinition def, GlobalContext::context()->rideMetadata->getFields()) {
if (def.name != "" && def.tab != "" &&
!SpecialFields::getInstance().isMetric(def.name))
meta++;
}
}
// just this ride !
rides = 1;
// get a listAllocated
SEXP ans;
SEXP names; // column names
SEXP rownames; // row names (numeric)
// +3 is for date and datetime and color
PROTECT(ans=Rf_allocVector(VECSXP, metrics+meta+3));
PROTECT(names = Rf_allocVector(STRSXP, metrics+meta+3));
// we have to give a name to each row
PROTECT(rownames = Rf_allocVector(STRSXP, rides));
for(int i=0; i<rides; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// next name, nextS is next metric
int next=0;
// DATE
SEXP date;
PROTECT(date=Rf_allocVector(INTSXP, rides));
QDate d1970(1970,01,01);
INTEGER(date)[0] = d1970.daysTo(item->dateTime.date());
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, date);
SET_STRING_ELT(names, next++, Rf_mkChar("date"));
// TIME
SEXP time;
PROTECT(time=Rf_allocVector(REALSXP, rides));
REAL(time)[0] = item->dateTime.toUTC().toSecsSinceEpoch();
// POSIXct class
SEXP clas;
PROTECT(clas=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(time,clas);
// we use "UTC" for all timezone
Rf_setAttrib(time, Rf_install("tzone"), Rf_mkString("UTC"));
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, time);
SET_STRING_ELT(names, next++, Rf_mkChar("time"));
// time + clas, but not ans!
UNPROTECT(4);
//
// METRICS
//
for(int i=0; i<factory.metricCount();i++) {
// set a vector
SEXP m;
PROTECT(m=Rf_allocVector(REALSXP, rides));
QString symbol = factory.metricName(i);
const RideMetric *metric = factory.rideMetric(symbol);
QString name = SpecialFields::getInstance().internalName(factory.rideMetric(symbol)->name());
name = name.replace(" ","_");
name = name.replace("'","_");
bool useMetricUnits = GlobalContext::context()->useMetricUnits;
REAL(m)[0] = item->metrics()[i] * (useMetricUnits ? 1.0f : metric->conversion()) + (useMetricUnits ? 0.0f : metric->conversionSum());
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(name.toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
//
// META
//
foreach(FieldDefinition field, GlobalContext::context()->rideMetadata->getFields()) {
// don't add incomplete meta definitions or metric override fields
if (field.name == "" || field.tab == "" ||
SpecialFields::getInstance().isMetric(field.name)) continue;
// Create a string vector
SEXP m;
PROTECT(m=Rf_allocVector(STRSXP, rides));
SET_STRING_ELT(m, 0, Rf_mkChar(item->getText(field.name, "").toLatin1().constData()));
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(field.name.replace(" ","_").toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
// add Color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, rides));
// apply item color, remembering that 1,1,1 means use default (reverse in this case)
if (item->color == QColor(1,1,1,1)) {
// use the inverted color, not plot marker as that hideous
QColor col =GCColor::invertColor(GColor(CPLOTBACKGROUND));
// white is jarring on a dark background!
if (col==QColor(Qt::white)) col=QColor(127,127,127);
SET_STRING_ELT(color, 0, Rf_mkChar(col.name().toLatin1().constData()));
} else
SET_STRING_ELT(color, 0, Rf_mkChar(item->color.name().toLatin1().constData()));
// add to the list and name it
SET_VECTOR_ELT(ans, next, color);
SET_STRING_ELT(names, next, Rf_mkChar("color"));
next++;
UNPROTECT(1);
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
// ans + names
UNPROTECT(3);
// return it
return ans;
}
SEXP
RTool::dfForDateRange(bool all, DateRange range, SEXP filter)
{
const RideMetricFactory &factory = RideMetricFactory::instance();
int rides = rtool->context->athlete->rideCache->count();
int metrics = factory.metricCount();
// count the number of meta fields to add
int meta = 0;
if (rtool->context) {
// count active fields
foreach(FieldDefinition def, GlobalContext::context()->rideMetadata->getFields()) {
if (def.name != "" && def.tab != "" &&
!SpecialFields::getInstance().isMetric(def.name))
meta++;
}
}
// how many rides to return if we're limiting to the
// currently selected date range ?
// apply any global filters
Specification specification;
FilterSet fs;
fs.addFilter(rtool->context->isfiltered, rtool->context->filters);
fs.addFilter(rtool->context->ishomefiltered, rtool->context->homeFilters);
fs.addFilter(rtool->perspective->isFiltered(), rtool->perspective->filterlist(range));
specification.setFilterSet(fs);
// did call contain any filters?
PROTECT(filter=Rf_coerceVector(filter, STRSXP));
for(int i=0; i<Rf_length(filter); i++) {
// if not empty write a filter
QString f(CHAR(STRING_ELT(filter,i)));
if (f != "") {
DataFilter dataFilter(rtool->canvas, rtool->context);
QStringList files;
dataFilter.parseFilter(rtool->context, f, &files);
fs.addFilter(true, files);
}
}
specification.setFilterSet(fs);
UNPROTECT(1);
// we need to count rides that are in range...
rides = 0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (all || range.pass(ride->dateTime.date())) rides++;
}
// get a listAllocated
SEXP ans;
SEXP names; // column names
SEXP rownames; // row names (numeric)
// +3 is for date and datetime and color
PROTECT(ans=Rf_allocVector(VECSXP, metrics+meta+3));
PROTECT(names = Rf_allocVector(STRSXP, metrics+meta+3));
// we have to give a name to each row
PROTECT(rownames = Rf_allocVector(STRSXP, rides));
for(int i=0; i<rides; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// next name
int next=0;
// DATE
SEXP date;
PROTECT(date=Rf_allocVector(INTSXP, rides));
int k=0;
QDate d1970(1970,01,01);
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (all || range.pass(ride->dateTime.date()))
INTEGER(date)[k++] = d1970.daysTo(ride->dateTime.date());
}
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, date);
SET_STRING_ELT(names, next++, Rf_mkChar("date"));
// TIME
SEXP time;
PROTECT(time=Rf_allocVector(REALSXP, rides));
// fill with values for date and class if its one we need to return
k=0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (all || range.pass(ride->dateTime.date()))
REAL(time)[k++] = ride->dateTime.toUTC().toSecsSinceEpoch();
}
// POSIXct class
SEXP clas;
PROTECT(clas=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(time,clas);
// we use "UTC" for all timezone
Rf_setAttrib(time, Rf_install("tzone"), Rf_mkString("UTC"));
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, time);
SET_STRING_ELT(names, next++, Rf_mkChar("time"));
// time + clas, but not ans!
UNPROTECT(4);
//
// METRICS
//
for(int i=0; i<factory.metricCount();i++) {
// set a vector
SEXP m;
PROTECT(m=Rf_allocVector(REALSXP, rides));
QString symbol = factory.metricName(i);
const RideMetric *metric = factory.rideMetric(symbol);
QString name = SpecialFields::getInstance().internalName(factory.rideMetric(symbol)->name());
name = name.replace(" ","_");
name = name.replace("'","_");
bool useMetricUnits = GlobalContext::context()->useMetricUnits;
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(item)) continue;
if (all || range.pass(item->dateTime.date())) {
REAL(m)[index++] = item->metrics()[i] * (useMetricUnits ? 1.0f : metric->conversion())
+ (useMetricUnits ? 0.0f : metric->conversionSum());
}
}
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(name.toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
//
// META
//
foreach(FieldDefinition field, GlobalContext::context()->rideMetadata->getFields()) {
// don't add incomplete meta definitions or metric override fields
if (field.name == "" || field.tab == "" ||
SpecialFields::getInstance().isMetric(field.name)) continue;
// Create a string vector
SEXP m;
PROTECT(m=Rf_allocVector(STRSXP, rides));
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(item)) continue;
if (all || range.pass(item->dateTime.date())) {
SET_STRING_ELT(m, index++, Rf_mkChar(item->getText(field.name, "").toLatin1().constData()));
}
}
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(field.name.replace(" ","_").toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
// add Color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, rides));
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(item)) continue;
if (all || range.pass(item->dateTime.date())) {
// apply item color, remembering that 1,1,1 means use default (reverse in this case)
if (item->color == QColor(1,1,1,1)) {
// use the inverted color, not plot marker as that hideous
QColor col =GCColor::invertColor(GColor(CPLOTBACKGROUND));
// white is jarring on a dark background!
if (col==QColor(Qt::white)) col=QColor(127,127,127);
SET_STRING_ELT(color, index++, Rf_mkChar(col.name().toLatin1().constData()));
} else
SET_STRING_ELT(color, index++, Rf_mkChar(item->color.name().toLatin1().constData()));
}
}
// add to the list and name it
SET_VECTOR_ELT(ans, next, color);
SET_STRING_ELT(names, next, Rf_mkChar("color"));
next++;
UNPROTECT(1);
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
// ans + names
UNPROTECT(3);
// return it
return ans;
}
SEXP
RTool::dfForDateRangeIntervals(DateRange range, QStringList types)
{
const RideMetricFactory &factory = RideMetricFactory::instance();
int intervals = 0;
int metrics = factory.metricCount();
// how many rides to return if we're limiting to the
// currently selected date range ?
// apply any global filters
Specification specification;
FilterSet fs;
fs.addFilter(rtool->context->isfiltered, rtool->context->filters);
fs.addFilter(rtool->context->ishomefiltered, rtool->context->homeFilters);
fs.addFilter(rtool->perspective->isFiltered(), rtool->perspective->filterlist(range));
specification.setFilterSet(fs);
// we need to count intervals that are in range...
intervals = 0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (!range.pass(ride->dateTime.date())) continue;
if (types.isEmpty()) intervals += ride->intervals().count();
else {
foreach(IntervalItem *item, ride->intervals())
if (types.contains(RideFileInterval::typeDescription(item->type)))
intervals++;
}
}
// get a listAllocated
SEXP ans;
SEXP names; // column names
SEXP rownames; // row names (numeric)
// +5 is for date and datetime, name, type and color
PROTECT(ans=Rf_allocVector(VECSXP, metrics+5));
PROTECT(names = Rf_allocVector(STRSXP, metrics+5));
// we have to give a name to each row
PROTECT(rownames = Rf_allocVector(STRSXP, intervals));
for(int i=0; i<intervals; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// next name
int next=0;
// DATE
SEXP date;
PROTECT(date=Rf_allocVector(INTSXP, intervals));
int k=0;
QDate d1970(1970,01,01);
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (range.pass(ride->dateTime.date())) {
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
INTEGER(date)[k++] = d1970.daysTo(ride->dateTime.date());
}
}
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, date);
SET_STRING_ELT(names, next++, Rf_mkChar("date"));
// TIME
SEXP time;
PROTECT(time=Rf_allocVector(REALSXP, intervals));
// fill with values for date and class if its one we need to return
k=0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (range.pass(ride->dateTime.date())) {
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
REAL(time)[k++] = ride->dateTime.toUTC().toSecsSinceEpoch() + item->start; // time offsets by time of interval
}
}
// POSIXct class
SEXP clas;
PROTECT(clas=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(time,clas);
// we use "UTC" for all timezone
Rf_setAttrib(time, Rf_install("tzone"), Rf_mkString("UTC"));
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, time);
SET_STRING_ELT(names, next++, Rf_mkChar("time"));
// NAME
SEXP intervalnames;
PROTECT(intervalnames = Rf_allocVector(STRSXP, intervals));
k=0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (range.pass(ride->dateTime.date())) {
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
SET_STRING_ELT(intervalnames, k++, Rf_mkChar(item->name.toLatin1().constData()));
}
}
// add to the list and give a columnname
SET_VECTOR_ELT(ans, next, intervalnames);
SET_STRING_ELT(names, next, Rf_mkChar("name"));
next++;
// TYPE
SEXP intervaltypes;
PROTECT(intervaltypes = Rf_allocVector(STRSXP, intervals));
k=0;
foreach(RideItem *ride, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(ride)) continue;
if (range.pass(ride->dateTime.date())) {
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
SET_STRING_ELT(intervaltypes, k++, Rf_mkChar(RideFileInterval::typeDescription(item->type).toLatin1().constData()));
}
}
SET_VECTOR_ELT(ans, next, intervaltypes);
SET_STRING_ELT(names, next, Rf_mkChar("type"));
next++;
// time + clas + name + type, but not ans!
UNPROTECT(6);
//
// METRICS
//
for(int i=0; i<factory.metricCount();i++) {
// set a vector
SEXP m;
PROTECT(m=Rf_allocVector(REALSXP, intervals));
QString symbol = factory.metricName(i);
const RideMetric *metric = factory.rideMetric(symbol);
QString name = SpecialFields::getInstance().internalName(factory.rideMetric(symbol)->name());
name = name.replace(" ","_");
name = name.replace("'","_");
bool useMetricUnits = GlobalContext::context()->useMetricUnits;
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(item)) continue;
if (range.pass(item->dateTime.date())) {
foreach(IntervalItem *interval, item->intervals()) {
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(interval->type)))
REAL(m)[index++] = interval->metrics()[i] * (useMetricUnits ? 1.0f : metric->conversion())
+ (useMetricUnits ? 0.0f : metric->conversionSum());
}
}
}
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(name.toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
// add Color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, intervals));
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
if (!specification.pass(item)) continue;
if (!range.pass(item->dateTime.date())) continue;
foreach(IntervalItem *interval, item->intervals()) {
if (!types.isEmpty() && !types.contains(RideFileInterval::typeDescription(interval->type))) continue;
// apply item color, remembering that 1,1,1 means use default (reverse in this case)
if (interval->color == QColor(1,1,1,1)) {
// use the inverted color, not plot marker as that hideous
QColor col =GCColor::invertColor(GColor(CPLOTBACKGROUND));
// white is jarring on a dark background!
if (col==QColor(Qt::white)) col=QColor(127,127,127);
SET_STRING_ELT(color, index++, Rf_mkChar(col.name().toLatin1().constData()));
} else
SET_STRING_ELT(color, index++, Rf_mkChar(interval->color.name().toLatin1().constData()));
}
}
// add to the list and name it
SET_VECTOR_ELT(ans, next, color);
SET_STRING_ELT(names, next, Rf_mkChar("color"));
next++;
UNPROTECT(1);
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
// ans + names
UNPROTECT(3);
// return it
return ans;
}
// returns a data frame of season info
SEXP
RTool::season(SEXP pAll, SEXP pCompare)
{
// p1 - all=TRUE|FALSE - return all metrics or just within
// the currently selected date range
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
// p2 - all=TRUE|FALSE - return list of compares (or current if not active)
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// data frame for season: color, name, start, end
// XXX TODO type needs adding, but we need to unpick the
// phase/season object model first, will do later
SEXP df;
PROTECT(df=Rf_allocVector(VECSXP, 4));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 4));
SET_STRING_ELT(names, 0, Rf_mkChar("name"));
SET_STRING_ELT(names, 1, Rf_mkChar("start"));
SET_STRING_ELT(names, 2, Rf_mkChar("end"));
SET_STRING_ELT(names, 3, Rf_mkChar("color"));
// worklist of date ranges to return
// XXX TODO use a Season worklist one the phase/season
// object model is fixed
QList<DateRange> worklist;
if (compare) {
// return a list, even if just one
if (rtool->context->isCompareDateRanges) {
foreach(CompareDateRange p, rtool->context->compareDateRanges)
worklist << DateRange(p.start, p.end, p.name, p.color);
} else {
// if compare not active just return current selection
worklist << rtool->context->currentDateRange();
}
} else if (all) {
// list all seasons
foreach(Season season, rtool->context->athlete->seasons->seasons) {
worklist << DateRange(season.getStart(), season.getEnd(), season.getName(), QColor(127,127,127));
}
} else {
// just the currently selected season please
worklist << rtool->context->currentDateRange();
}
SEXP rownames, start, end, name, color;
PROTECT(start=Rf_allocVector(INTSXP, worklist.count()));
PROTECT(end=Rf_allocVector(INTSXP, worklist.count()));
PROTECT(name=Rf_allocVector(STRSXP, worklist.count()));
PROTECT(color=Rf_allocVector(STRSXP, worklist.count()));
PROTECT(rownames = Rf_allocVector(STRSXP, worklist.count()));
int index=0;
QDate d1970(1970,1,1);
foreach(DateRange p, worklist){
INTEGER(start) [index] = d1970.daysTo(p.from);
INTEGER(end) [index] = d1970.daysTo(p.to);
SET_STRING_ELT(name, index, Rf_mkChar(p.name.toLatin1().constData()));
SET_STRING_ELT(color, index, Rf_mkChar(p.color.name().toLatin1().constData()));
QString rownumber=QString("%1").arg(index+1);
SET_STRING_ELT(rownames, index, Rf_mkChar(rownumber.toLatin1().constData()));
index++;
}
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(start,dclas);
Rf_classgets(end,dclas);
SET_VECTOR_ELT(df, 0, name);
SET_VECTOR_ELT(df, 1, start);
SET_VECTOR_ELT(df, 2, end);
SET_VECTOR_ELT(df, 3, color);
// list into a data.frame
Rf_namesgets(df, names);
Rf_setAttrib(df, R_RowNamesSymbol, rownames);
Rf_setAttrib(df, R_ClassSymbol, Rf_mkString("data.frame"));
UNPROTECT(8); // df + names
// fail
return df;
}
SEXP
RTool::seasonIntervals(SEXP pTypes, SEXP pCompare)
{
// p1 - type of intervals to get (vector of strings)
// p2 - compare mode (true or false)
pTypes = Rf_coerceVector(pTypes, STRSXP);
QStringList types;
for(int i=0; i<Rf_length(pTypes); i++)
types << QString(CHAR(STRING_ELT(pTypes,i)));
//pType = Rf_coerceVector(pAll, LGLSXP);
//bool all = LOGICAL(pAll)[0];
// p2 - all=TRUE|FALSE - return list of compares (or current if not active)
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// want a list of compares not a dataframe
if (compare && rtool->context) {
// only return compares if its actually active
if (rtool->context->isCompareDateRanges) {
// how many to return?
int count=0;
foreach(CompareDateRange p, rtool->context->compareDateRanges) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int index=0;
// a named list with data.frame 'intervals' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("intervals"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareDateRange p, rtool->context->compareDateRanges) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForDateRangeIntervals(DateRange(p.start, p.end), types);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, index++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else { // compare isn't active...
// otherwise return the current metrics in a compare list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("intervals"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of metrics and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the metrics
DateRange range = rtool->context->currentDateRange();
SEXP df = rtool->dfForDateRangeIntervals(range, types);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (rtool->context && rtool->context->athlete && rtool->context->athlete->rideCache) {
// just a datafram of metrics
DateRange range = rtool->context->currentDateRange();
return rtool->dfForDateRangeIntervals(range, types);
}
// fail
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::intervalType(SEXP type)
{
type = Rf_coerceVector(type, INTSXP);
QString typeDesc = RideFileInterval::typeDescription(static_cast<RideFileInterval::IntervalType>(INTEGER(type)[0]));
SEXP ans;
PROTECT(ans=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(ans, 0, Rf_mkChar(typeDesc.toLatin1().constData()));
UNPROTECT(1);
return ans;
}
SEXP
RTool::activityIntervals(SEXP pTypes, SEXP datetime)
{
// p1 - type of intervals to get (vector of strings)
// p2 - activity (datetime)
pTypes = Rf_coerceVector(pTypes, STRSXP);
QStringList types;
for(int i=0; i<Rf_length(pTypes); i++)
types << QString(CHAR(STRING_ELT(pTypes,i)));
// get an activity to process
RideItem* ride;
QList<RideItem*>activities = rtool->activitiesFor(datetime);
if (activities.count()) ride = activities[0];
else ride = const_cast<RideItem*>(rtool->context->currentRideItem());
// if no current ride or more than one activity requested, nothing to return
if (ride == NULL || activities.count() > 1) return Rf_allocVector(INTSXP, 0);
const RideMetricFactory &factory = RideMetricFactory::instance();
int intervals = 0;
int metrics = factory.metricCount();
// we need to count intervals that are in range...
if (types.isEmpty()) intervals = ride->intervals().count();
else {
foreach(IntervalItem *item, ride->intervals())
if (types.contains(RideFileInterval::typeDescription(item->type)))
intervals++;
}
// get a listAllocated
SEXP ans;
SEXP names; // column names
SEXP rownames; // row names (numeric)
// +6 is for start and stop, name, type, color and selected
PROTECT(ans=Rf_allocVector(VECSXP, metrics+6));
PROTECT(names = Rf_allocVector(STRSXP, metrics+6));
// we have to give a name to each row
PROTECT(rownames = Rf_allocVector(STRSXP, intervals));
for(int i=0; i<intervals; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// next name
int next=0;
// START
SEXP start;
PROTECT(start=Rf_allocVector(REALSXP, intervals));
int k=0;
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
REAL(start)[k++] = item->start;
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, start);
SET_STRING_ELT(names, next++, Rf_mkChar("start"));
// STOP
SEXP stop;
PROTECT(stop=Rf_allocVector(REALSXP, intervals));
k=0;
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
REAL(stop)[k++] = item->stop;
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, stop);
SET_STRING_ELT(names, next++, Rf_mkChar("stop"));
// NAME
SEXP intervalnames;
PROTECT(intervalnames = Rf_allocVector(STRSXP, intervals));
k=0;
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
SET_STRING_ELT(intervalnames, k++, Rf_mkChar(item->name.toLatin1().constData()));
// add to the list and give a columnname
SET_VECTOR_ELT(ans, next, intervalnames);
SET_STRING_ELT(names, next, Rf_mkChar("name"));
next++;
// TYPE
SEXP intervaltypes;
PROTECT(intervaltypes = Rf_allocVector(STRSXP, intervals));
k=0;
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
SET_STRING_ELT(intervaltypes, k++, Rf_mkChar(RideFileInterval::typeDescription(item->type).toLatin1().constData()));
SET_VECTOR_ELT(ans, next, intervaltypes);
SET_STRING_ELT(names, next, Rf_mkChar("type"));
next++;
// SELECTED
SEXP selected;
PROTECT(selected=Rf_allocVector(LGLSXP, intervals));
k=0;
foreach(IntervalItem *item, ride->intervals())
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(item->type)))
LOGICAL(selected)[k++] = item->selected;
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, selected);
SET_STRING_ELT(names, next++, Rf_mkChar("selected"));
// start + stop + name + type + selected, but not ans!
UNPROTECT(5);
//
// METRICS
//
for(int i=0; i<factory.metricCount();i++) {
// set a vector
SEXP m;
PROTECT(m=Rf_allocVector(REALSXP, intervals));
QString symbol = factory.metricName(i);
const RideMetric *metric = factory.rideMetric(symbol);
QString name = SpecialFields::getInstance().internalName(factory.rideMetric(symbol)->name());
name = name.replace(" ","_");
name = name.replace("'","_");
bool useMetricUnits = GlobalContext::context()->useMetricUnits;
int index=0;
foreach(IntervalItem *interval, ride->intervals()) {
if (types.isEmpty() || types.contains(RideFileInterval::typeDescription(interval->type)))
REAL(m)[index++] = interval->metrics()[i] * (useMetricUnits ? 1.0f : metric->conversion())
+ (useMetricUnits ? 0.0f : metric->conversionSum());
}
// add to the list
SET_VECTOR_ELT(ans, next, m);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(name.toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
}
// add Color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, intervals));
int index=0;
foreach(IntervalItem *interval, ride->intervals()) {
if (!types.isEmpty() && !types.contains(RideFileInterval::typeDescription(interval->type))) continue;
// apply item color, remembering that 1,1,1 means use default (reverse in this case)
if (interval->color == QColor(1,1,1,1)) {
// use the inverted color, not plot marker as that hideous
QColor col =GCColor::invertColor(GColor(CPLOTBACKGROUND));
// white is jarring on a dark background!
if (col==QColor(Qt::white)) col=QColor(127,127,127);
SET_STRING_ELT(color, index++, Rf_mkChar(col.name().toLatin1().constData()));
} else
SET_STRING_ELT(color, index++, Rf_mkChar(interval->color.name().toLatin1().constData()));
}
// add to the list and name it
SET_VECTOR_ELT(ans, next, color);
SET_STRING_ELT(names, next, Rf_mkChar("color"));
next++;
UNPROTECT(1);
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
// ans + names
UNPROTECT(3);
// return it
return ans;
}
SEXP
RTool::metrics(SEXP pAll, SEXP pFilter, SEXP pCompare)
{
// p1 - all=TRUE|FALSE - return all metrics or just within
// the currently selected date range
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
// p2 - all=TRUE|FALSE - return list of compares (or current if not active)
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// want a list of compares not a dataframe
if (compare && rtool->context) {
// only return compares if its actually active
if (rtool->context->isCompareDateRanges) {
// how many to return?
int count=0;
foreach(CompareDateRange p, rtool->context->compareDateRanges) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int index=0;
// a named list with data.frame 'metrics' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("metrics"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareDateRange p, rtool->context->compareDateRanges) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForDateRange(all, DateRange(p.start, p.end), pFilter);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, index++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else { // compare isn't active...
// otherwise return the current metrics in a compare list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("metrics"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of metrics and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the metrics
DateRange range = rtool->context->currentDateRange();
SEXP df = rtool->dfForDateRange(all, range, pFilter);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (rtool->context && rtool->context->athlete && rtool->context->athlete->rideCache) {
// just a datafram of metrics
DateRange range = rtool->context->currentDateRange();
return rtool->dfForDateRange(all, range, pFilter);
}
// fail
return Rf_allocVector(INTSXP, 0);
}
QList<SEXP>
RTool::dfForActivity(RideFile *f, int split, QString join)
{
// return a data frame for the ride passed
QList<SEXP> returning;
// how many series?
int seriescount=0;
for(int i=0; i<static_cast<int>(RideFile::none); i++) {
RideFile::SeriesType series = static_cast<RideFile::SeriesType>(i);
if (i > 15 && !f->isDataPresent(series)) continue;
seriescount++;
}
// add xdata to the series count
QMapIterator<QString, XDataSeries *> it(f->xdata());
it.toFront();
while(it.hasNext()) {
it.next();
seriescount += it.value()->valuename.count();
}
// if we have any series we will continue and add a 'time' series
if (seriescount) seriescount++;
else return returning;
// start at first sample in ride
int index=0;
int pcount=0;
while(index < f->dataPoints().count()) {
// we return a list of series vectors
SEXP ans = PROTECT(Rf_allocVector(VECSXP, seriescount));
pcount++;
// we collect the names as we go
SEXP names = PROTECT(Rf_allocVector(STRSXP, seriescount)); // names attribute (column names)
int next=0;
pcount++;
//
// We might need to split...
//
// do we stop at the end, or mid-ride ?
int stop = f->dataPoints().count();
if (split) {
for(int i=index+1; i<f->dataPoints().count(); i++) {
if (i && (f->dataPoints()[i]->secs - f->dataPoints()[i-1]->secs) > double(split)) {
stop = i;
goto outer;
}
}
}
outer:
int points = stop - index;
// TIME
// add in actual time in POSIXct format
SEXP time = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
// fill with values for date and class
for(int k=0; k<points; k++) REAL(time)[k] = f->startTime().addSecs(f->dataPoints()[index+k]->secs).toUTC().toSecsSinceEpoch();
// POSIXct class
SEXP clas = PROTECT(Rf_allocVector(STRSXP, 2));
pcount++;
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(time,clas);
// we use "UTC" for all timezone
Rf_setAttrib(time, Rf_install("tzone"), Rf_mkString("UTC"));
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, time);
SET_STRING_ELT(names, next++, Rf_mkChar("time"));
// PRESENT SERIES
for(int s=0; s < static_cast<int>(RideFile::none); s++) {
// what series we working with?
RideFile::SeriesType series = static_cast<RideFile::SeriesType>(s);
// lets not add lots of NA for the more obscure data series
if (s > 15 && !f->isDataPresent(series)) continue;
// set a vector
SEXP vector = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
for(int j=index; j<stop; j++) {
if (f->isDataPresent(series)) {
if (f->dataPoints()[j]->value(series) == 0 && (series == RideFile::lat || series == RideFile::lon))
REAL(vector)[j-index] = NA_REAL;
else
REAL(vector)[j-index] = f->dataPoints()[j]->value(series);
} else {
REAL(vector)[j-index] = NA_REAL;
}
}
// add to the list
SET_VECTOR_ELT(ans, next, vector);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(f->seriesName(series, true).toLatin1().constData()));
next++;
}
// XDATA SERIES
RideFile::XDataJoin xjoin;
xjoin = RideFile::REPEAT;
QStringList xdataValidSymbols;
xdataValidSymbols << "sparse" << "repeat" << "interpolate" << "resample";
int xx = xdataValidSymbols.indexOf(join, Qt::CaseInsensitive);
switch(xx) {
case 0: xjoin = RideFile::SPARSE; break;
default:
case 1: xjoin = RideFile::REPEAT; break;
case 2: xjoin = RideFile::INTERPOLATE; break;
case 3: xjoin = RideFile::RESAMPLE; break;
}
it.toFront(); // reused from above
while(it.hasNext()) {
it.next();
if (it.value()->valuename.count() == 0) continue;
// add a series for every one
foreach(QString series, it.value()->valuename) {
// set a vector
SEXP vector = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
int idx=0;
for(int j=index; j<stop; j++) {
RideFilePoint *p = f->dataPoints()[j];
double val = f->xdataValue(p, idx, it.value()->name, series, xjoin);
REAL(vector)[j-index] = (val == RideFile::NA) ? NA_REAL : val;
}
// add to the list
SET_VECTOR_ELT(ans, next, vector);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(QString("%1_%2").arg(it.value()->name).arg(series.replace(" ","_")).toLatin1().constData()));
next++;
}
}
// add rownames
SEXP rownames = PROTECT(Rf_allocVector(STRSXP, points));
pcount++;
for(int i=0; i<points; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_namesgets(ans, names);
// jump to where we got
index = stop;
returning << ans;
}
UNPROTECT(pcount);
// return a valid result
return returning;
}
QList<RideItem *>
RTool::activitiesFor(SEXP datetime)
{
QList<RideItem*> returning;
PROTECT(datetime=Rf_coerceVector(datetime, INTSXP));
for(int i=0; i<Rf_length(datetime); i++) {
long dt = INTEGER(datetime)[i];
if (dt==0) continue;
// we need to find this one !
QDateTime asdt = QDateTime::fromSecsSinceEpoch(dt);
foreach(RideItem*item, rtool->context->athlete->rideCache->rides()) {
if (item->dateTime.toUTC() == asdt.toUTC()) {
returning << const_cast<RideItem*>(item);
break;
}
}
}
UNPROTECT(1);
// return a list of activities to process
return returning;
}
SEXP
RTool::activity(SEXP datetime, SEXP pCompare, SEXP pSplit, SEXP pJoin)
{
// p1 - compare=TRUE|FALSE - return list of compare rides if active, or just current
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
pJoin = Rf_coerceVector(pJoin, STRSXP);
QString join(CHAR(STRING_ELT(pJoin,0)));
// get a list of activitie to return - user specified ALWAYS gets a list
// even if they only provided a single date to process
bool userlist = false;
QList<RideItem*>activities = rtool->activitiesFor(datetime);
if (activities.count()) userlist=true; // use compare mode code to create a list of rides
// p3 split in seconds, 0=means no split
pSplit = Rf_coerceVector(pSplit, INTSXP);
int split = INTEGER(pSplit)[0];
// user requested specific activities?
if (userlist) {
// we collect a list to return, appending as we go, rather
// than pre-allocating, since we decide to split and may
// get multiple responses
QList<SEXP> f;
// create a data.frame for each and add to list
foreach(RideItem *item, activities) {
// we DO NOT use R_CheckUserInterrupt since it longjmps
// and leaves quite a mess behind. We check ourselves
// if a cancel was requested we honour it
QApplication::processEvents();
if (rtool->cancelled) break;
// we open, if it wasn't open we also close
// to make sure we don't exhause memory
bool close = (item->isOpen() == false);
foreach(SEXP df, rtool->dfForActivity(item->ride(), split, join)) f<<df;
if (close) item->close();
}
// now create an R list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, f.count()));
for(int index=0; index < f.count(); index++) SET_VECTOR_ELT(list, index, f[index]);
// we have to give a name to each row
SEXP rownames;
PROTECT(rownames = Rf_allocVector(STRSXP, f.count()));
for(int i=0; i<f.count(); i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
//XXX Do not create a dataframe of dataframes, R doesn't like these
//XXX Rf_setAttrib(list, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(list, R_RowNamesSymbol, rownames);
Rf_namesgets(list, rownames);
UNPROTECT(3); // list and names and rownames
return list;
} else if ((split || compare) && rtool->context) { // split or compare will generate a list
if (compare && rtool->context->isCompareIntervals) {
// how many to return?
int count=0;
foreach(CompareInterval p, rtool->context->compareIntervals) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
QList<SEXP> f;
// a named list with data.frame 'activity' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareInterval p, rtool->context->compareIntervals) {
if (p.isChecked()) {
foreach(SEXP df, rtool->dfForActivity(p.rideItem->ride(), split, join)) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
f << namedlist;
UNPROTECT(2);
}
}
}
// now create an R list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, f.count()));
for(int index=0; index < f.count(); index++) SET_VECTOR_ELT(list, index, f[index]);
UNPROTECT(2); // list and names
return list;
} else if (rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// just return a list of one ride
// cool we can return a list of intervals to compare
QList<SEXP> files;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// add the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
f->recalculateDerivedSeries();
foreach(SEXP df, rtool->dfForActivity(f, split, join)) {
// named list of activity and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
files << namedlist;
UNPROTECT(2);
}
// now create an R list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, files.count()));
for(int index=0; index < files.count(); index++) SET_VECTOR_ELT(list, index, files[index]);
UNPROTECT(2);
return list;
}
} else if (!split && !compare) { // not compare, so just return a dataframe
// access via global as this is a static function
if(rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// get the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
f->recalculateDerivedSeries();
// get as a data frame
QList<SEXP> returning = rtool->dfForActivity(f, 0, join);
if (returning.count()) return returning[0];
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::dfForActivityMeanmax(const RideItem *i)
{
return dfForRideFileCache(const_cast<RideItem*>(i)->fileCache());
}
SEXP
RTool::dfForDateRangeMeanmax(bool all, DateRange range, SEXP filter)
{
// construct the date range and then get a ridefilecache
if (all) range = DateRange(QDate(1900,01,01), QDate(2100,01,01));
// did call contain any filters?
QStringList filelist;
bool filt=false;
PROTECT(filter=Rf_coerceVector(filter, STRSXP));
for(int i=0; i<Rf_length(filter); i++) {
// if not empty write a filter
QString f(CHAR(STRING_ELT(filter,i)));
if (f != "") {
DataFilter dataFilter(rtool->canvas, rtool->context);
QStringList files;
dataFilter.parseFilter(rtool->context, f, &files);
filelist << files;
filt=true;
}
}
UNPROTECT(1);
// apply perspective filter if trends view and filtered
if (rtool->perspective && rtool->perspective->type() == VIEW_TRENDS && rtool->perspective->isFiltered()) {
filt = true;
filelist << rtool->perspective->filterlist(DateRange(range));
}
// RideFileCache for a date range with our filters (if any)
RideFileCache cache(rtool->context, range.from, range.to, filt, filelist, true, NULL);
return dfForRideFileCache(&cache);
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::dfForRideFileCache(RideFileCache *cache)
{
// how many series and how big are they?
unsigned int seriescount=0, size=0;
// get the meanmax array
if (cache != NULL) {
// how many points in the ridefilecache and how many series to return
foreach(RideFile::SeriesType series, cache->meanMaxList()) {
QVector <double> values = cache->meanMaxArray(series);
if (values.count()) {
if (static_cast<unsigned int>(values.count()) > size) size = values.count();
seriescount++;
}
if (series==RideFile::watts) {
seriescount++; // add powerdate
}
}
} else {
// fail
return Rf_allocVector(INTSXP, 0);
}
// we return a list of series vectors
SEXP ans;
PROTECT(ans = Rf_allocVector(VECSXP, seriescount));
// we collect the names as we go
SEXP names;
PROTECT(names = Rf_allocVector(STRSXP, seriescount)); // names attribute (column names)
int next=0;
//
// Now we need to add vectors to the ans list...
//
foreach(RideFile::SeriesType series, cache->meanMaxList()) {
QVector <double> values = cache->meanMaxArray(series);
// don't add empty ones
if (values.count()==0) continue;
// set a vector
SEXP vector;
PROTECT(vector=Rf_allocVector(REALSXP, values.count()));
// will have different sizes e.g. when a daterange
// since longest ride with e.g. power may be different
// to longest ride with heartrate
for(int j=0; j<values.count(); j++) REAL(vector)[j] = values[j];
// add to the list
SET_VECTOR_ELT(ans, next, vector);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar(RideFile::seriesName(series, true).toLatin1().constData()));
next++;
// vector
UNPROTECT(1);
// if is power add the dates
if(series == RideFile::watts) {
QDate d1970(1970,01,01);
// dates
QVector<QDate> dates = cache->meanMaxDates(series);
SEXP vector;
PROTECT(vector=Rf_allocVector(INTSXP, values.count()));
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(vector,dclas);
// will have different sizes e.g. when a daterange
// since longest ride with e.g. power may be different
// to longest ride with heartrate
for(int j=0; j<values.count(); j++) INTEGER(vector)[j] = d1970.daysTo(dates[j]);
// add to the list
SET_VECTOR_ELT(ans, next, vector);
// give it a name
SET_STRING_ELT(names, next, Rf_mkChar("power_date"));
next++;
// vector
UNPROTECT(2);
}
}
// add rownames
SEXP rownames;
PROTECT(rownames = Rf_allocVector(STRSXP, size));
for(unsigned int i=0; i<size; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
//Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_namesgets(ans, names);
// ans + names + rownames
UNPROTECT(3);
// return a valid result
return ans;
}
SEXP
RTool::seasonPeaks(SEXP pAll, SEXP pFilter, SEXP pCompare, SEXP pSeries, SEXP pDuration)
{
// check parameters !
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// lets get a Map of names to series
QMap<QString, RideFile::SeriesType> snames;
foreach(RideFile::SeriesType s, RideFileCache::meanMaxList()) {
snames.insert(RideFile::seriesName(s, true), s);
}
// extract as QStrings
QList<RideFile::SeriesType> series;
pSeries = Rf_coerceVector(pSeries, STRSXP);
for(int i=0; i <Rf_length(pSeries); i++) {
QString name = CHAR(STRING_ELT(pSeries, i));
RideFile::SeriesType stype;
if ((stype=snames.value(name, RideFile::none)) == RideFile::none) {
Rf_error("Invalid mean maximal series passed to GC.season.peaks.");
return Rf_allocVector(INTSXP, 0);
} else {
series << stype;
}
}
// extract as integers
QList<int>durations;
pDuration = Rf_coerceVector(pDuration, REALSXP);
for(int i=0; i<Rf_length(pDuration); i++) {
durations << REAL(pDuration)[i];
}
// want a list of compares not a dataframe
if (compare && rtool->context) {
// only return compares if its actually active
if (rtool->context->isCompareDateRanges) {
// how many to return?
int count=0;
foreach(CompareDateRange p, rtool->context->compareDateRanges) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int index=0;
// a named list with data.frame 'metrics' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("peaks"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareDateRange p, rtool->context->compareDateRanges) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForDateRangePeaks(all, DateRange(p.start, p.end), pFilter, series, durations);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, index++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else { // compare isn't active...
// otherwise return the current metrics in a compare list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("peaks"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of metrics and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the metrics
DateRange range = rtool->context->currentDateRange();
SEXP df = rtool->dfForDateRangePeaks(all, range, pFilter, series, durations);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (rtool->context && rtool->context->athlete && rtool->context->athlete->rideCache) {
// just a datafram of metrics
DateRange range = rtool->context->currentDateRange();
return rtool->dfForDateRangePeaks(all, range, pFilter, series, durations);
}
// fail
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::dfForDateRangePeaks(bool all, DateRange range, SEXP filter, QList<RideFile::SeriesType> series, QList<int> durations)
{
// so how many vectors in the frame ? +1 is the datetime of the peak
int listsize=series.count() * durations.count() + 1;
SEXP df;
PROTECT(df=Rf_allocVector(VECSXP, listsize));
int dfindex=0;
// and each one needs a name
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, listsize));
SET_STRING_ELT(names, 0, Rf_mkChar("time"));
int next=1;
// how many rides ?
Specification specification;
FilterSet fs;
fs.addFilter(rtool->context->isfiltered, rtool->context->filters);
fs.addFilter(rtool->context->ishomefiltered, rtool->context->homeFilters);
fs.addFilter(rtool->perspective->isFiltered(), rtool->perspective->filterlist(range));
specification.setFilterSet(fs);
// did call contain any filters?
PROTECT(filter=Rf_coerceVector(filter, STRSXP));
for(int i=0; i<Rf_length(filter); i++) {
// if not empty write a filter
QString f(CHAR(STRING_ELT(filter,i)));
if (f != "") {
DataFilter dataFilter(rtool->canvas, rtool->context);
QStringList files;
dataFilter.parseFilter(rtool->context, f, &files);
fs.addFilter(true, files);
}
}
specification.setFilterSet(fs);
UNPROTECT(1);
// how many pass?
int size=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
// apply filters
if (!specification.pass(item)) continue;
// do we want this one ?
if (all || range.pass(item->dateTime.date())) size++;
}
// dates first
SEXP dates;
PROTECT(dates=Rf_allocVector(REALSXP, size));
// fill with values for date and class
int i=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
// apply filters
if (!specification.pass(item)) continue;
if (all || range.pass(item->dateTime.date())) {
REAL(dates)[i++] = item->dateTime.toUTC().toSecsSinceEpoch();
}
}
// POSIXct class
SEXP clas;
PROTECT(clas=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(dates,clas);
Rf_setAttrib(dates, Rf_install("tzone"), Rf_mkString("UTC"));
SET_VECTOR_ELT(df, dfindex++, dates);
foreach(RideFile::SeriesType pseries, series) {
foreach(int pduration, durations) {
// create a vector
SEXP vector;
PROTECT(vector=Rf_allocVector(REALSXP, size));
// give it a name
QString name = QString("peak_%1_%2").arg(RideFile::seriesName(pseries, true)).arg(pduration);
SET_STRING_ELT(names, next++, Rf_mkChar(name.toLatin1().constData()));
// fill with values
// get the value for the series and duration requested, although this is called
int index=0;
foreach(RideItem *item, rtool->context->athlete->rideCache->rides()) {
// apply filters
if (!specification.pass(item)) continue;
// do we want this one ?
if (all || range.pass(item->dateTime.date())) {
// for each series/duration independently its pretty quick since it lseeks to
// the actual value, so /should't/ be too expensive.........
REAL(vector)[index++] = RideFileCache::best(item->context, item->fileName, pseries, pduration);
}
}
// add named vector to the list
SET_VECTOR_ELT(df, dfindex++, vector);
UNPROTECT(1);
}
}
// set names + data.frame
SEXP rownames;
PROTECT(rownames = Rf_allocVector(STRSXP, size));
for(int i=0; i<size; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(df, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(df, R_RowNamesSymbol, rownames);
Rf_namesgets(df, names);
// df + names + dates + clas + rownames
UNPROTECT(5);
return df;
}
SEXP
RTool::seasonMeanmax(SEXP pAll, SEXP pFilter, SEXP pCompare)
{
// p1 - all=TRUE|FALSE - return all metrics or just within
// the currently selected date range
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
// p2 - all=TRUE|FALSE - return list of compares (or current if not active)
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// want a list of compares not a dataframe
if (compare && rtool->context) {
// only return compares if its actually active
if (rtool->context->isCompareDateRanges) {
// how many to return?
int count=0;
foreach(CompareDateRange p, rtool->context->compareDateRanges) if (p.isChecked()) count++;
// cool we can return a list of meanaxes to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int lindex=0;
// a named list with data.frame 'metrics' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("meanmax"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareDateRange p, rtool->context->compareDateRanges) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForDateRangeMeanmax(all, DateRange(p.start, p.end), pFilter);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, lindex++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else { // compare isn't active...
// otherwise return the current season meanmax in a compare list
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("meanmax"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of metrics and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the meanmaxes
DateRange range = rtool->context->currentDateRange();
SEXP df = rtool->dfForDateRangeMeanmax(all, range, pFilter);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (rtool->context && rtool->context->athlete && rtool->context->athlete->rideCache) {
// just a datafram of meanmax
DateRange range = rtool->context->currentDateRange();
return rtool->dfForDateRangeMeanmax(all, range, pFilter);
}
// fail
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::activityMeanmax(SEXP pCompare)
{
// a dataframe to return
SEXP ans=NULL;
// p1 - compare=TRUE|FALSE - return list of compare rides if active, or just current
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// return a list
if (compare && rtool->context) {
if (rtool->context->isCompareIntervals) {
// how many to return?
int count=0;
foreach(CompareInterval p, rtool->context->compareIntervals) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int lindex=0;
// a named list with data.frame 'activity' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("meanmax"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareInterval p, rtool->context->compareIntervals) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForActivityMeanmax(p.rideItem);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, lindex++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else if(rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// just return a list of one ride
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("meanmax"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of activity and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForActivityMeanmax(rtool->context->currentRideItem());
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (!compare) { // not compare, so just return a dataframe
// access via global as this is a static function
if(rtool->context && rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// get as a data frame
ans = rtool->dfForActivityMeanmax(rtool->context->currentRideItem());
return ans;
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::activityMetrics(SEXP pCompare)
{
// a dataframe to return
SEXP ans=NULL;
// p1 - compare=TRUE|FALSE - return list of compare rides if active, or just current
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// return a list
if (compare && rtool->context) {
if (rtool->context->isCompareIntervals) {
// how many to return?
int count=0;
foreach(CompareInterval p, rtool->context->compareIntervals) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int lindex=0;
// a named list with data.frame 'activity' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("metrics"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareInterval p, rtool->context->compareIntervals) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForRideItem(p.rideItem);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, lindex++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else if(rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// just return a list of one ride
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("metrics"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of activity and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForRideItem(rtool->context->currentRideItem());
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (!compare) { // not compare, so just return a dataframe
// access via global as this is a static function
if(rtool->context && rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// get as a data frame
ans = rtool->dfForRideItem(rtool->context->currentRideItem());
return ans;
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::pmc(SEXP pAll, SEXP pMetric, SEXP pType)
{
// parse parameters
// p1 - all=TRUE|FALSE - return all metrics or just within
// the currently selected date range
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
// p2 - metric="BikeStress" - base stress metric
pMetric = Rf_coerceVector(pMetric, STRSXP);
QString metric (CHAR(STRING_ELT(pMetric,0)));
// p3 - type="Actual" - PMC type: Actual/Planned/Expected
pMetric = Rf_coerceVector(pType, STRSXP);
QString type (CHAR(STRING_ELT(pType,0)));
// return a dataframe with PMC data for all or the current season
// XXX uses the default half-life
if (rtool->context) {
// get the currently selected date range
DateRange range(rtool->context->currentDateRange());
// convert the name to a symbol, if not found just leave as it is
const RideMetricFactory &factory = RideMetricFactory::instance();
for (int i=0; i<factory.metricCount(); i++) {
QString symbol = factory.metricName(i);
QString name = SpecialFields::getInstance().internalName(factory.rideMetric(symbol)->name());
name.replace(" ","_");
if (name == metric) {
metric = symbol;
break;
}
}
// create the data
PMCData pmcData(rtool->context, Specification(), metric);
// how many entries ?
QDate d1970(1970,01,01);
// not unsigned coz date could be configured < 1970 (!)
int from =d1970.daysTo(range.from);
int to =d1970.daysTo(range.to);
unsigned int size = all ? pmcData.days() : (to - from + 1);
// returning a dataframe with
// date, lts, sts, sb, rr
SEXP ans, names;
// date, stress, lts, sts, sb, rr
PROTECT(ans=Rf_allocVector(VECSXP, 6));
// set ther names
PROTECT(names = Rf_allocVector(STRSXP, 6));
SET_STRING_ELT(names, 0, Rf_mkChar("date"));
SET_STRING_ELT(names, 1, Rf_mkChar("stress"));
SET_STRING_ELT(names, 2, Rf_mkChar("lts"));
SET_STRING_ELT(names, 3, Rf_mkChar("sts"));
SET_STRING_ELT(names, 4, Rf_mkChar("sb"));
SET_STRING_ELT(names, 5, Rf_mkChar("rr"));
// DATE - 1 a day from start
SEXP date;
PROTECT(date=Rf_allocVector(INTSXP, size));
unsigned int start = d1970.daysTo(all ? pmcData.start() : range.from);
for(unsigned int k=0; k<size; k++) INTEGER(date)[k] = start + k;
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
// add to the data.frame
SET_VECTOR_ELT(ans, 0, date);
// PMC DATA
SEXP stress, lts, sts, sb, rr;
PROTECT(stress=Rf_allocVector(REALSXP, size));
PROTECT(lts=Rf_allocVector(REALSXP, size));
PROTECT(sts=Rf_allocVector(REALSXP, size));
PROTECT(sb=Rf_allocVector(REALSXP, size));
PROTECT(rr=Rf_allocVector(REALSXP, size));
int index=0;
if (all) {
// just copy
if (type == "Planned") {
for(unsigned int k=0; k<size; k++) REAL(stress)[k] = pmcData.plannedStress()[k];
for(unsigned int k=0; k<size; k++) REAL(lts)[k] = pmcData.plannedLts()[k];
for(unsigned int k=0; k<size; k++) REAL(sts)[k] = pmcData.plannedSts()[k];
for(unsigned int k=0; k<size; k++) REAL(sb)[k] = pmcData.plannedSb()[k];
for(unsigned int k=0; k<size; k++) REAL(rr)[k] = pmcData.plannedRr()[k];
} else if (type == "Expected") {
for(unsigned int k=0; k<size; k++) REAL(stress)[k] = pmcData.expectedStress()[k];
for(unsigned int k=0; k<size; k++) REAL(lts)[k] = pmcData.expectedLts()[k];
for(unsigned int k=0; k<size; k++) REAL(sts)[k] = pmcData.expectedSts()[k];
for(unsigned int k=0; k<size; k++) REAL(sb)[k] = pmcData.expectedSb()[k];
for(unsigned int k=0; k<size; k++) REAL(rr)[k] = pmcData.expectedRr()[k];
} else {
for(unsigned int k=0; k<size; k++) REAL(stress)[k] = pmcData.stress()[k];
for(unsigned int k=0; k<size; k++) REAL(lts)[k] = pmcData.lts()[k];
for(unsigned int k=0; k<size; k++) REAL(sts)[k] = pmcData.sts()[k];
for(unsigned int k=0; k<size; k++) REAL(sb)[k] = pmcData.sb()[k];
for(unsigned int k=0; k<size; k++) REAL(rr)[k] = pmcData.rr()[k];
}
} else {
int day = d1970.daysTo(pmcData.start());
for(int k=0; k < pmcData.days(); k++) {
// day today
if (day >= from && day <= to) {
if (type == "Planned") {
REAL(stress)[index] = pmcData.plannedStress()[k];
REAL(lts)[index] = pmcData.plannedLts()[k];
REAL(sts)[index] = pmcData.plannedSts()[k];
REAL(sb)[index] = pmcData.plannedSb()[k];
REAL(rr)[index] = pmcData.plannedRr()[k];
} else if (type == "Expected") {
REAL(stress)[index] = pmcData.expectedStress()[k];
REAL(lts)[index] = pmcData.expectedLts()[k];
REAL(sts)[index] = pmcData.expectedSts()[k];
REAL(sb)[index] = pmcData.expectedSb()[k];
REAL(rr)[index] = pmcData.expectedRr()[k];
} else {
REAL(stress)[index] = pmcData.stress()[k];
REAL(lts)[index] = pmcData.lts()[k];
REAL(sts)[index] = pmcData.sts()[k];
REAL(sb)[index] = pmcData.sb()[k];
REAL(rr)[index] = pmcData.rr()[k];
}
index++;
}
day++;
}
}
// add to the list
SET_VECTOR_ELT(ans, 1, stress);
SET_VECTOR_ELT(ans, 2, lts);
SET_VECTOR_ELT(ans, 3, sts);
SET_VECTOR_ELT(ans, 4, sb);
SET_VECTOR_ELT(ans, 5, rr);
SEXP rownames;
PROTECT(rownames = Rf_allocVector(STRSXP, size));
for(unsigned int i=0; i<size; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
UNPROTECT(10);
// return it
return ans;
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::measures(SEXP pAll, SEXP pGroup)
{
// parse parameters
// p1 - all=TRUE|FALSE - return all measures or just within
// the currently selected date range
pAll = Rf_coerceVector(pAll, LGLSXP);
bool all = LOGICAL(pAll)[0];
// p2 - group="Body"|"Hrv" - return list of measures for selected group
pGroup = Rf_coerceVector(pGroup, STRSXP);
QString groupSymbol (CHAR(STRING_ELT(pGroup,0)));
// return a dataframe with Measures data for all or the current season
if (rtool->context) {
// get the currently selected date range
DateRange range(rtool->context->currentDateRange());
// convert the group symbol to an index, default to Body=0
int groupIdx = rtool->context->athlete->measures->getGroupSymbols().indexOf(groupSymbol);
if (groupIdx < 0) groupIdx = 0;
// Update range for all
if (all) {
range.from = rtool->context->athlete->measures->getStartDate(groupIdx);
range.to = rtool->context->athlete->measures->getEndDate(groupIdx);
}
// how many entries ?
QDate d1970(1970,01,01);
// not unsigned coz date could be configured < 1970 (!)
int from =d1970.daysTo(range.from);
int to =d1970.daysTo(range.to);
unsigned int size = to - from + 1;
// returning a dataframe with
// date, field1, field2, ...
SEXP ans, names;
QStringList fieldSymbols = rtool->context->athlete->measures->getFieldSymbols(groupIdx);
// date, field1, field2, ...
PROTECT(ans=Rf_allocVector(VECSXP, fieldSymbols.count() + 1));
// set the names
PROTECT(names = Rf_allocVector(STRSXP, fieldSymbols.count() + 1));
SET_STRING_ELT(names, 0, Rf_mkChar("date"));
for (int i=0; i<fieldSymbols.count(); i++)
SET_STRING_ELT(names, i + 1, Rf_mkChar(fieldSymbols[i].toLatin1().constData()));
// DATE - 1 a day from start
SEXP date;
PROTECT(date=Rf_allocVector(INTSXP, size));
unsigned int start = d1970.daysTo(range.from);
for(unsigned int k=0; k<size; k++) INTEGER(date)[k] = start + k;
SEXP dclas;
PROTECT(dclas=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(dclas, 0, Rf_mkChar("Date"));
Rf_classgets(date,dclas);
// add to the data.frame
SET_VECTOR_ELT(ans, 0, date);
// MEASURES DATA
QVector<SEXP> fields(fieldSymbols.count());
for (int i=0; i<fieldSymbols.count(); i++)
PROTECT(fields[i]=Rf_allocVector(REALSXP, size));
int index=0;
int day = from;
for(unsigned int k=0; k < size; k++) {
// day today
if (day >= from && day <= to) {
for (int fieldIdx=0; fieldIdx<fields.count(); fieldIdx++)
REAL(fields[fieldIdx])[index] = rtool->context->athlete->measures->getFieldValue(groupIdx, d1970.addDays(day), fieldIdx);
index++;
}
day++;
}
// add to the list
for (int fieldIdx=0; fieldIdx<fields.count(); fieldIdx++)
SET_VECTOR_ELT(ans, fieldIdx+1, fields[fieldIdx]);
SEXP rownames;
PROTECT(rownames = Rf_allocVector(STRSXP, size));
for(unsigned int i=0; i<size; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_namesgets(ans, names);
UNPROTECT(5 + fieldSymbols.count());
// return it
return ans;
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::activityWBal(SEXP pCompare)
{
SEXP ans=NULL;
// p1 - compare=TRUE|FALSE - return list of compare rides if active, or just current
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// return a list
if (compare && rtool->context) {
if (rtool->context->isCompareIntervals) {
// how many to return?
int count=0;
foreach(CompareInterval p, rtool->context->compareIntervals) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int lindex=0;
// a named list with data.frame 'activity' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareInterval p, rtool->context->compareIntervals) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForActivityWBal(p.rideItem->ride());
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, lindex++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else if(rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// just return a list of one ride
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of activity and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
f->recalculateDerivedSeries();
SEXP df = rtool->dfForActivityWBal(f);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (!compare) { // not compare, so just return a dataframe
// access via global as this is a static function
if(rtool->context && rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// get the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
f->recalculateDerivedSeries();
// get as a data frame
ans = rtool->dfForActivityWBal(f);
return ans;
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::dfForActivityWBal(RideFile*f)
{
// return a data frame with wpbal in 1s samples
if(f && f->wprimeData()) {
// get as a data frame
WPrime *w = f->wprimeData();
if (w && w->ydata().count() >0) {
// construct a vector
SEXP ans;
PROTECT(ans=Rf_allocVector(REALSXP, w->ydata().count()));
// add values
for(int i=0; i<w->ydata().count(); i++) REAL(ans)[i] = w->ydata()[i];
UNPROTECT(1);
return ans;
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::activityXData(SEXP pName, SEXP pCompare)
{
SEXP ans=NULL;
// p1 - compare=TRUE|FALSE - return list of compare rides if active, or just current
pCompare = Rf_coerceVector(pCompare, LGLSXP);
bool compare = LOGICAL(pCompare)[0];
// p2 - name="" - XData series name
pName = Rf_coerceVector(pName, STRSXP);
QString name (CHAR(STRING_ELT(pName,0)));
// return a list
if (compare && rtool->context) {
if (rtool->context->isCompareIntervals) {
// how many to return?
int count=0;
foreach(CompareInterval p, rtool->context->compareIntervals) if (p.isChecked()) count++;
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, count));
int lindex=0;
// a named list with data.frame 'activity' and color 'color'
SEXP namedlist;
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// create a data.frame for each and add to list
foreach(CompareInterval p, rtool->context->compareIntervals) {
if (p.isChecked()) {
// create a named list
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
SEXP df = rtool->dfForActivityXData(p.rideItem->ride(), name);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar(p.color.name().toLatin1().constData()));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, lindex++, namedlist);
UNPROTECT(2);
}
}
UNPROTECT(2); // list and names
return list;
} else if(rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// just return a list of one ride
// cool we can return a list of intervals to compare
SEXP list;
PROTECT(list=Rf_allocVector(VECSXP, 1));
// names
SEXP names;
PROTECT(names=Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(names, 0, Rf_mkChar("activity"));
SET_STRING_ELT(names, 1, Rf_mkChar("color"));
// named list of activity and color
SEXP namedlist;
PROTECT(namedlist=Rf_allocVector(VECSXP, 2));
// add the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
SEXP df = rtool->dfForActivityXData(f, name);
SET_VECTOR_ELT(namedlist, 0, df);
// add the color
SEXP color;
PROTECT(color=Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(color, 0, Rf_mkChar("#FF00FF"));
SET_VECTOR_ELT(namedlist, 1, color);
// name them
Rf_namesgets(namedlist, names);
// add to back and move on
SET_VECTOR_ELT(list, 0, namedlist);
UNPROTECT(4);
return list;
}
} else if (!compare) { // not compare, so just return a dataframe
// access via global as this is a static function
if(rtool->context && rtool->context->currentRideItem() && const_cast<RideItem*>(rtool->context->currentRideItem())->ride()) {
// get the ride
RideFile *f = const_cast<RideItem*>(rtool->context->currentRideItem())->ride();
// get as a data frame
ans = rtool->dfForActivityXData(f, name);
return ans;
}
}
// nothing to return
return Rf_allocVector(INTSXP, 0);
}
SEXP
RTool::dfForActivityXData(RideFile*f, QString name)
{
// When no name is given, return names present as a list
if (name.isEmpty()) {
SEXP names;
PROTECT(names = Rf_allocVector(STRSXP, f->xdata().count()));
int k = 0;
foreach(name, f->xdata().keys()) SET_STRING_ELT(names, k++, Rf_mkChar(name.toLatin1().constData()));
UNPROTECT(1);
return names;
}
// nothing to return if XData series is not present
if (!f->xdata().contains(name)) return Rf_allocVector(INTSXP, 0);
XDataSeries* xds = f->xdata()[name];
// PROTECT count
int pcount = 0;
// how many series?
int seriescount = xds->valuename.count();
// how many data points?
int points = xds->datapoints.count();
// if we have any series we will continue and add 'time' and 'distance' series
if (seriescount) seriescount += 2;
else return Rf_allocVector(INTSXP, 0);
// we return a list of series vectors
SEXP ans = PROTECT(Rf_allocVector(VECSXP, seriescount));
pcount++;
// we collect the names as we go
SEXP names = PROTECT(Rf_allocVector(STRSXP, seriescount)); // names attribute (column names)
pcount++;
int next = 0;
// TIME
// add in actual time in POSIXct format
SEXP time = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
// fill with values for date and class
for(int k=0; k<points; k++) REAL(time)[k] = f->startTime().addSecs(xds->datapoints[k]->secs).toUTC().toSecsSinceEpoch();
// POSIXct class
SEXP clas = PROTECT(Rf_allocVector(STRSXP, 2));
pcount++;
SET_STRING_ELT(clas, 0, Rf_mkChar("POSIXct"));
SET_STRING_ELT(clas, 1, Rf_mkChar("POSIXt"));
Rf_classgets(time,clas);
// we use "UTC" for all timezone
Rf_setAttrib(time, Rf_install("tzone"), Rf_mkString("UTC"));
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, time);
SET_STRING_ELT(names, next++, Rf_mkChar("time"));
// DISTANCE
// set a vector
SEXP distance = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
// fill with values
for(int k=0; k<points; k++) REAL(distance)[k] = xds->datapoints[k]->km;
// add to the data.frame and give it a name
SET_VECTOR_ELT(ans, next, distance);
SET_STRING_ELT(names, next++, Rf_mkChar("distance"));
// add a series for every one
int valueIdx = 0;
foreach(QString series, xds->valuename) {
// set a vector
SEXP vector = PROTECT(Rf_allocVector(REALSXP, points));
pcount++;
int idx = 0;
foreach(XDataPoint* p, xds->datapoints) {
double val = p->number[valueIdx];
REAL(vector)[idx++] = (val == RideFile::NA) ? NA_REAL : val;
}
// add to the list
SET_VECTOR_ELT(ans, next, vector);
// give it a name
SET_STRING_ELT(names, next++, Rf_mkChar(QString("%1_%2").arg(xds->name).arg(series.replace(" ","_")).toLatin1().constData()));
valueIdx++;
}
// add rownames
SEXP rownames = PROTECT(Rf_allocVector(STRSXP, points));
pcount++;
for(int i=0; i<points; i++) {
QString rownumber=QString("%1").arg(i+1);
SET_STRING_ELT(rownames, i, Rf_mkChar(rownumber.toLatin1().constData()));
}
// turn the list into a data frame + set column names
Rf_setAttrib(ans, R_RowNamesSymbol, rownames);
Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
Rf_namesgets(ans, names);
UNPROTECT(pcount);
// return a valid result
return ans;
}
//
// Working with Generic Charts
//
SEXP
RTool::setChart(SEXP title, SEXP type, SEXP animate, SEXP legpos, SEXP stack, SEXP orientation)
{
if (rtool == NULL || rtool->context == NULL || rtool->chart == NULL) return Rf_allocVector(INTSXP, 0);
GenericChartInfo info;
// title
PROTECT(title=Rf_coerceVector(title, STRSXP));
info.title=QString(CHAR(STRING_ELT(title,0)));
UNPROTECT(1);
// type
PROTECT(type=Rf_coerceVector(type,INTSXP));
info.type=INTEGER(type)[0];
UNPROTECT(1);
// animation
animate = Rf_coerceVector(animate, LGLSXP);
info.animate = LOGICAL(animate)[0];
// legend position
PROTECT(legpos=Rf_coerceVector(legpos,INTSXP));
info.legendpos=INTEGER(legpos)[0];
UNPROTECT(1);
// stack
stack = Rf_coerceVector(stack, LGLSXP);
info.stack = LOGICAL(stack)[0];
// type
PROTECT(orientation=Rf_coerceVector(orientation,INTSXP));
info.orientation=INTEGER(orientation)[0];
UNPROTECT(1);
// call generic chart
rtool->chart->chart->initialiseChart(info.title, info.type, info.animate, info.legendpos, info.stack, info.orientation);
// return 0
return Rf_allocVector(INTSXP,0);
}
SEXP
RTool::addCurve(SEXP name, SEXP xseries, SEXP yseries, SEXP fseries, SEXP xname, SEXP yname, SEXP labels, SEXP colors,
SEXP line, SEXP symbol, SEXP size, SEXP color, SEXP opacity, SEXP opengl, SEXP legend, SEXP datalabels, SEXP fill)
{
Q_UNUSED(labels) //XXX todo
Q_UNUSED(colors) //XXX todo
if (rtool == NULL || rtool->context == NULL || rtool->chart == NULL) return Rf_allocVector(INTSXP, 0);
GenericSeriesInfo info;
// name
PROTECT(name=Rf_coerceVector(name, STRSXP));
info.name=QString(CHAR(STRING_ELT(name,0)));
UNPROTECT(1);
// xseries
PROTECT(xseries=Rf_coerceVector(xseries,REALSXP));
long vs=Rf_length(xseries);
info.xseries.resize(vs);
for(int i=0; i<vs; i++) info.xseries[i]=REAL(xseries)[i];
UNPROTECT(1);
// yseries
PROTECT(yseries=Rf_coerceVector(yseries,REALSXP));
vs=Rf_length(yseries);
info.yseries.resize(vs);
for(int i=0; i<vs; i++) info.yseries[i]=REAL(yseries)[i];
UNPROTECT(1);
// fseries
PROTECT(fseries=Rf_coerceVector(fseries,STRSXP));
vs=Rf_length(fseries);
info.fseries.resize(vs);
for(int i=0; i<vs; i++) info.fseries[i] = QString(CHAR(STRING_ELT(fseries,i)));
UNPROTECT(1);
// yname
PROTECT(yname=Rf_coerceVector(yname, STRSXP));
info.yname=QString(CHAR(STRING_ELT(yname,0)));
UNPROTECT(1);
// xname
PROTECT(xname=Rf_coerceVector(xname, STRSXP));
info.xname=QString(CHAR(STRING_ELT(xname,0)));
UNPROTECT(1);
// labels
// XXX todo
// colors
// XXX todo
// line
PROTECT(line=Rf_coerceVector(line,INTSXP));
info.line=INTEGER(line)[0];
UNPROTECT(1);
// symbol
PROTECT(symbol=Rf_coerceVector(symbol,INTSXP));
info.symbol=INTEGER(symbol)[0];
UNPROTECT(1);
// size
PROTECT(size=Rf_coerceVector(size,REALSXP));
info.size=REAL(size)[0];
UNPROTECT(1);
// color
PROTECT(color=Rf_coerceVector(color, STRSXP));
info.color=QString(CHAR(STRING_ELT(color,0)));
UNPROTECT(1);
// opacity
PROTECT(opacity=Rf_coerceVector(opacity,INTSXP));
info.opacity=INTEGER(opacity)[0];
UNPROTECT(1);
// opengl
opengl = Rf_coerceVector(opengl, LGLSXP);
info.opengl = LOGICAL(opengl)[0];
// legend
legend = Rf_coerceVector(legend, LGLSXP);
info.legend = LOGICAL(legend)[0];
// legend
datalabels = Rf_coerceVector(datalabels, LGLSXP);
info.datalabels = LOGICAL(datalabels)[0];
// fill
fill = Rf_coerceVector(fill, LGLSXP);
info.fill = LOGICAL(fill)[0];
// add to chart
rtool->chart->chart->addCurve(info.name, info.xseries, info.yseries, info.fseries, info.xname, info.yname, info.labels, info.colors, info.line,
info.symbol, info.size, info.color, info.opacity, info.opengl, info.legend, info.datalabels, info.fill, info.aggregateby, info.annotations);
// return 0
return Rf_allocVector(INTSXP,0);
}
SEXP
RTool::configureAxis(SEXP name, SEXP visible, SEXP align, SEXP min, SEXP max,
SEXP type, SEXP labelcolor, SEXP axiscolor, SEXP log, SEXP categories)
{
Q_UNUSED(align) // we always pass -1 for now
Q_UNUSED(categories) // XXX TODO
if (rtool == NULL || rtool->context == NULL || rtool->chart == NULL) return Rf_allocVector(INTSXP, 0);
GenericAxisInfo info;
// name
PROTECT(name=Rf_coerceVector(name, STRSXP));
info.name=QString(CHAR(STRING_ELT(name,0)));
UNPROTECT(1);
// visible
visible = Rf_coerceVector(visible, LGLSXP);
info.visible = LOGICAL(visible)[0];
// align- ignore !
// min
PROTECT(min=Rf_coerceVector(min,REALSXP));
info.minx=REAL(min)[0];
UNPROTECT(1);
// max
PROTECT(max=Rf_coerceVector(max,REALSXP));
info.maxx=REAL(max)[0];
UNPROTECT(1);
// type
PROTECT(type=Rf_coerceVector(type,INTSXP));
info.type=static_cast<GenericAxisInfo::AxisInfoType>(INTEGER(type)[0]);
UNPROTECT(1);
// labelcolor string
PROTECT(labelcolor=Rf_coerceVector(labelcolor, STRSXP));
info.labelcolor=QString(CHAR(STRING_ELT(labelcolor,0)));
UNPROTECT(1);
// color string
PROTECT(axiscolor=Rf_coerceVector(axiscolor, STRSXP));
info.axiscolor=QString(CHAR(STRING_ELT(axiscolor,0)));
UNPROTECT(1);
// log scale
log = Rf_coerceVector(log, LGLSXP);
info.log = LOGICAL(log)[0];
// categories
//XXX todo
// add to chart -- XXX need to think on how to set axis colors -- or if we even should allow it
rtool->chart->chart->configureAxis(info.name, info.visible, -1 /*info.align*/, info.minx, info.maxx, info.type, "" /*info.labelcolor.name()*/, ""/*info.axiscolor.name()*/, info.log, info.categories);
// return 0
return Rf_allocVector(INTSXP,0);
}
SEXP
RTool::annotate(SEXP type, SEXP p1, SEXP p2, SEXP p3)
{
if (rtool == NULL || rtool->context == NULL || rtool->chart == NULL) return Rf_allocVector(INTSXP, 0);
// type
PROTECT(type=Rf_coerceVector(type, STRSXP));
QString atype=QString(CHAR(STRING_ELT(type,0)));
UNPROTECT(1);
if (atype == "label") {
Q_UNUSED(p3);
// p1 is the series name
PROTECT(p1=Rf_coerceVector(p1, STRSXP));
QString series=QString(CHAR(STRING_ELT(p1,0)));
UNPROTECT(1);
// p2 is a list of strings
PROTECT(p2=Rf_coerceVector(p2, STRSXP));
QStringList list;
for(int i=0; i<Rf_length(p2); i++) {
// if not empty write a filter
QString f(CHAR(STRING_ELT(p2,i)));
list << f;
}
UNPROTECT(1);
// XXX todo fix up or deprecate ???? if (list.count() > 0) rtool->chart->chart->annotateLabel(series, list);
}
// return 0
return Rf_allocVector(INTSXP,0);
}
Reference in New Issue View Git Blame Copy Permalink