Pipeline::Pipeline()
{
setTraceFlag(false);
}
SEXP rfsrcReadMatrix(SEXP traceFlag,
SEXP fName,
SEXP rowType,
SEXP rowCnt,
SEXP tokenDelim,
SEXP colHeader,
SEXP rowHeader) {
FILE *fopen();
FILE *fPtr;
char *_fName;
SEXP _sexp_rowType ;
char **_rowType;
uint _rowCnt;
char *_tokenDelim;
char _colHeadF;
char _rowHeadF;
SmartBuffer *sb;
uint p, i;
uint rowCntActual;
uint colCntActual;
uint sbSizeActual;
char flag;
setTraceFlag(INTEGER(traceFlag)[0], 0);
_fName = (char*) CHAR(STRING_ELT(AS_CHARACTER(fName), 0));
_sexp_rowType = rowType;
_rowCnt = INTEGER(rowCnt)[0];
_tokenDelim = (char*) CHAR(STRING_ELT(AS_CHARACTER(tokenDelim), 0));
_colHeadF = (INTEGER(colHeader)[0] != 0) ? TRUE : FALSE;
_rowHeadF = (INTEGER(rowHeader)[0] != 0) ? TRUE : FALSE;
_rowType = (char**) new_vvector(1, _rowCnt, NRUTIL_CPTR);
for (p = 1; p <= _rowCnt; p++) {
_rowType[p] = (char*) CHAR(STRING_ELT(AS_CHARACTER(_sexp_rowType), p-1));
if ((strcmp(_rowType[p], "X") != 0) &&
(strcmp(_rowType[p], "C") != 0) &&
(strcmp(_rowType[p], "c") != 0) &&
(strcmp(_rowType[p], "I") != 0) &&
(strcmp(_rowType[p], "R") != 0)) {
Rprintf("\nRF-SRC: *** ERROR *** ");
Rprintf("\nRF-SRC: Invalid predictor type: [%10d] = %2s", p, _rowType[p]);
Rprintf("\nRF-SRC: Type must be 'C', 'c', 'I', or 'R'.");
Rprintf("\nRF-SRC: Please Contact Technical Support.");
error("\nRF-SRC: The application will now exit.\n");
}
}
fPtr = fopen(_fName, "r");
sb = parseLineSB(fPtr, *_tokenDelim, 0);
colCntActual = _rowHeadF ? (sb -> tokenCnt - 1) : (sb -> tokenCnt);
rowCntActual = 0;
if (_colHeadF) {
freeSB(sb);
sb = parseLineSB(fPtr, *_tokenDelim, 0);
sbSizeActual = sb -> size;
freeSB(sb);
}
else {
sbSizeActual = sb -> size;
freeSB(sb);
}
++rowCntActual;
flag = TRUE;
while (flag) {
sb = parseLineSB(fPtr, *_tokenDelim, sbSizeActual);
if (sb -> tokenCnt == 0) {
flag = FALSE;
freeSB(sb);
}
else {
++rowCntActual;
freeSB(sb);
}
}
if (rowCntActual != _rowCnt) {
Rprintf("\nRF-SRC: *** ERROR *** ");
Rprintf("\nRF-SRC: Inconsistent Predictor Count.");
Rprintf("\nRF-SRC: (encountered, expected) = (%10d, %10d)", rowCntActual, _rowCnt);
Rprintf("\nRF-SRC: Please Contact Technical Support.");
error("\nRF-SRC: The application will now exit.\n");
}
fclose(fPtr);
if (_colHeadF) {
fPtr = fopen(_fName, "r");
sb = parseLineSB(fPtr, *_tokenDelim, sbSizeActual);
freeSB(sb);
}
char **dataMatrix = cmatrix(1, colCntActual, 1, rowCntActual);
for (p=1; p <= rowCntActual; p++) {
sb = parseLineSB(fPtr, *_tokenDelim, sbSizeActual);
if (_rowHeadF) {
}
for (i = 1; i <= colCntActual; i++) {
dataMatrix[i][p] = (char) strtol(sb -> token, NULL, 10);
}
freeSB(sb);
}
free_cmatrix(dataMatrix, 1, colCntActual, 1, rowCntActual);
return R_NilValue;
}
