void free_uimatrix(unsigned int **v, unsigned long nrl, unsigned long nrh, unsigned long ncl, unsigned long nch) {
for(unsigned long i = nrl; i <= nrh; i++) {
free_uivector(v[i], ncl, nch);
}
free_new_vvector(v, nrl, nrh, NRUTIL_UPTR);
}
void indexx(unsigned int n, double *arr, unsigned int *indx) {
unsigned int i, j, k, l;
unsigned int indxt, itemp, ir;
unsigned int *istack, jstack;
double a;
if (n < 1) nrerror("\n n of zero (0) length in indexx().");
l = 1;
ir = n;
jstack = 0;
istack = uivector(1, NSTACK);
for (j=1; j<=n; j++) indx[j]=j;
for (;;) {
if (ir-l < M) {
for (j = l+1; j <= ir; j++) {
indxt = indx[j];
a = arr[indxt];
for (i=j-1; i>=l; i--) {
if (arr[indx[i]] <= a) break;
indx[i+1] = indx[i];
}
indx[i+1] = indxt;
}
if (jstack == 0) break;
ir = istack[jstack--];
l = istack[jstack--];
}
else {
k = (l+ir) >> 1;
SWAP(indx[k], indx[l+1]);
if (arr[indx[l]] > arr[indx[ir]]) {
SWAP(indx[l], indx[ir])
}
if (arr[indx[l+1]] > arr[indx[ir]]) {
SWAP(indx[l+1], indx[ir])
}
if (arr[indx[l]] > arr[indx[l+1]]) {
SWAP(indx[l], indx[l+1])
}
i = l+1;
j = ir;
indxt = indx[l+1];
a = arr[indxt];
for (;;) {
do i++; while (arr[indx[i]] < a);
do j--; while (arr[indx[j]] > a);
if (j < i) break;
SWAP(indx[i], indx[j])
}
indx[l+1] = indx[j];
indx[j] = indxt;
jstack += 2;
if (jstack > NSTACK) nrerror("NSTACK too small in indexx().");
if (ir-i+1 >= j-l) {
istack[jstack] = ir;
istack[jstack-1] = i;
ir = j-1;
}
else {
istack[jstack] = j-1;
istack[jstack-1] = l;
l = i;
}
}
}
free_uivector(istack, 1, NSTACK);
}
void finalizeVariableImportance(uint mode,
uint rejectedTreeCount,
char **dmRecordBootFlag,
double ***dmvImputation) {
uint obsSize = 0;
uint varCount = 0;
double *statusPtr = NULL;
double *timePtr = NULL;
uint *ensembleDenPtr = NULL;
double concordanceIndex;
int concordancePolarity;
char concordanceImputeFlag;
double *crPerformanceVector;
double ***crVimpMortality;
double value;
uint *denominatorCount;
uint i, j, k, p;
if (!(rejectedTreeCount < _forestSize)) {
Rprintf("\nRSF: *** WARNING *** ");
Rprintf("\nRSF: Insufficient trees for VIMP analysis. \n");
return;
}
if (!(_opt & OPT_VIMP)) {
Rprintf("\nRSF: *** WARNING *** ");
Rprintf("\nRSF: VIMP analysis requested while OPT bit not set. \n");
return;
}
crPerformanceVector = NULL;
crVimpMortality = NULL;
if (_opt & (OPT_POUT_TYPE)) {
concordancePolarity = -1;
}
else {
concordancePolarity = 1;
}
concordanceImputeFlag = FALSE;
switch (mode) {
case RSF_GROW:
obsSize = _observationSize;
varCount = _xSize;
statusPtr = _status;
timePtr = _time;
ensembleDenPtr = _oobEnsembleDen;
if (_mRecordSize > 0) {
concordanceImputeFlag = TRUE;
}
break;
case RSF_PRED:
obsSize = _fobservationSize;
varCount = _xSize;
statusPtr = _fstatus;
timePtr = rsf_ftime;
ensembleDenPtr = _fullEnsembleDen;
if (_fmRecordSize > 0) {
concordanceImputeFlag = TRUE;
}
break;
case RSF_INTR:
obsSize = _fobservationSize;
if (_opt & (~OPT_VIMP) & OPT_VIMP_JOIN) {
varCount = 1;
}
else {
varCount = _intrPredictorSize;
}
statusPtr = _fstatus;
timePtr = rsf_ftime;
ensembleDenPtr = _oobEnsembleDen;
if (_fmRecordSize > 0) {
concordanceImputeFlag = TRUE;
}
break;
default:
Rprintf("\nRSF: *** ERROR *** ");
Rprintf("\nRSF: Unknown case in switch encountered. ");
Rprintf("\nRSF: Please Contact Technical Support.");
error("\nRSF: The application will now exit.\n");
break;
}
if (_opt & OPT_VOUT_TYPE) {
denominatorCount = uivector(1, obsSize);
}
else {
denominatorCount = ensembleDenPtr;
}
if (_eventTypeSize > 1) {
crVimpMortality = dmatrix3(1, varCount, 1, _eventTypeSize, 1, obsSize);
crPerformanceVector = dvector(1, _eventTypeSize);
for (p=1; p <= varCount; p++) {
for (i = 1; i <= obsSize; i++) {
for (j = 1; j <= _eventTypeSize; j++) {
for (k = 1; k <= _sortedTimeInterestSize; k++) {
if(_crVimpEnsemble[p][j][k][i] > 0) {
if (_crVimpPOE[p][j][i] > 0) {
value = _crVimpEnsemble[p][j][k][i] / _crVimpPOE[p][j][i];
value = (value <= 1.0) ? value : 1.0;
_crVimpEnsemble[p][j][k][i] = - log (value);
}
else {
value = _crVimpEnsemble[p][j][k][i] / 1.0;
value = (value <= 1.0) ? value : 1.0;
_crVimpEnsemble[p][j][k][i] = - log (value);
}
}
else {
if (_crVimpPOE[p][j][i] > 0) {
if (k > 1) {
_crVimpEnsemble[p][j][k][i] = _crVimpEnsemble[p][j][k-1][i];
}
else {
_crVimpEnsemble[p][j][k][i] = 0.0;
}
}
else {
_crVimpEnsemble[p][j][k][i] = 1.0;
}
}
}
}
}
}
for (p = 1; p <= varCount; p++) {
for (j = 1; j <= _eventTypeSize; j++) {
for (i = 1; i <= obsSize; i++) {
crVimpMortality[p][j][i] = 0.0;
for (k = 1; k <= _sortedTimeInterestSize; k++) {
crVimpMortality[p][j][i] += _crVimpEnsemble[p][j][k][i];
}
}
}
}
}
if (concordanceImputeFlag == TRUE) {
imputeConcordance(mode,
_forestSize,
dmRecordBootFlag,
dmvImputation,
statusPtr,
timePtr);
}
for (p=1; p <= varCount; p++) {
for (i = 1; i <= obsSize; i++) {
if (_opt & OPT_VOUT_TYPE) {
denominatorCount[i] = ensembleDenPtr[i] - _oobVimpInvalidDen[p][i];
}
if (denominatorCount[i] != 0) {
_vimpMortality[p][i] = _vimpMortality[p][i] / denominatorCount[i];
}
}
concordanceIndex = getConcordanceIndex(concordancePolarity,
obsSize,
statusPtr,
timePtr,
_vimpMortality[p],
denominatorCount);
if (ISNA(concordanceIndex)) {
_importancePtr[1][p] = NA_REAL;
}
else {
_importancePtr[1][p] = 1 - concordanceIndex;
}
if (_eventTypeSize > 1) {
getConditionalPerformance(mode,
concordancePolarity,
obsSize,
statusPtr,
timePtr,
crVimpMortality[p],
denominatorCount,
crPerformanceVector);
for (j=1; j <=_eventTypeSize; j++) {
_importancePtr[1+j][p] = crPerformanceVector[j];
}
}
}
if (_eventTypeSize > 1) {
free_dvector(crPerformanceVector, 1, _eventTypeSize);
free_dmatrix3(crVimpMortality, 1, varCount, 1, _eventTypeSize, 1, obsSize);
}
if (_opt & OPT_VOUT_TYPE) {
free_uivector(denominatorCount, 1, obsSize);
}
}
void getCRPerformance (uint mode,
uint obsSize,
double **responsePtr,
double **conditionalMortality,
uint *ensembleDenPtr,
double *performanceVector) {
uint mRecordSize;
int **mpSign;
uint *mRecordIndex;
uint *meIndividualSize;
uint **eIndividual;
double concordanceIndex;
uint j;
if (!(RF_opt & OPT_COMP_RISK)) {
Rprintf("\nRF-SRC: *** ERROR *** ");
Rprintf("\nRF-SRC: Attempt at conditional performance updates in a non-CR analysis.");
Rprintf("\nRF-SRC: Please Contact Technical Support.");
error("\nRF-SRC: The application will now exit.\n");
}
if (RF_mStatusSize > 0) {
if (mode != RF_PRED) {
mRecordSize = RF_mRecordSize;
mpSign = RF_mpSign;
mRecordIndex = RF_mRecordIndex;
}
else {
mRecordSize = RF_fmRecordSize;
mpSign = RF_fmpSign;
mRecordIndex = RF_fmRecordIndex;
}
meIndividualSize = uivector(1, RF_eventTypeSize);
eIndividual = (uint **) new_vvector(1, RF_eventTypeSize, NRUTIL_UPTR);
for (j = 1; j <= RF_eventTypeSize; j++) {
eIndividual[j] = uivector(1, RF_eIndividualSize[j] + RF_mStatusSize + 1);
}
updateEventTypeSubsets(responsePtr[RF_statusIndex], mRecordSize, mpSign, mRecordIndex, meIndividualSize, eIndividual);
}
else {
meIndividualSize = RF_eIndividualSize;
eIndividual = RF_eIndividualIn;
}
double *subsettedTime = dvector(1, obsSize);
double *subsettedStatus = dvector(1, obsSize);
double *subsettedMortality = dvector(1, obsSize);
uint *subsettedEnsembleDen = uivector(1, obsSize);
for (j = 1; j <= RF_eventTypeSize; j++) {
getConditionalConcordanceArrays(j,
responsePtr[RF_timeIndex],
responsePtr[RF_statusIndex],
conditionalMortality[j],
ensembleDenPtr,
meIndividualSize,
eIndividual,
subsettedTime,
subsettedStatus,
subsettedMortality,
subsettedEnsembleDen);
concordanceIndex = getConcordanceIndex(1,
meIndividualSize[j],
subsettedTime,
subsettedStatus,
subsettedMortality,
subsettedEnsembleDen);
if (ISNA(concordanceIndex)) {
performanceVector[j] = NA_REAL;
}
else {
performanceVector[j] = concordanceIndex;
}
}
if (RF_mStatusSize > 0) {
free_uivector(meIndividualSize, 1, RF_eventTypeSize);
for (j = 1; j <= RF_eventTypeSize; j++) {
free_uivector(eIndividual[j], 1, RF_eIndividualSize[j] + RF_mStatusSize + 1);
}
free_new_vvector(eIndividual, 1, RF_eventTypeSize, NRUTIL_UPTR);
}
free_dvector(subsettedTime, 1, obsSize);
free_dvector(subsettedStatus, 1, obsSize);
free_dvector(subsettedMortality, 1, obsSize);
free_uivector(subsettedEnsembleDen, 1, obsSize);
}
void getVimpPermute(uint mode,
Node *rootPtr,
double **predictorPtr,
uint b,
uint obsSize,
uint varCount,
char selectionFlag) {
Node *terminalNode;
uint permuteObsSize = 0;
uint *indexVIMP;
uint *permuteVIMP;
uint i, j, k, p;
switch (mode) {
case RSF_GROW:
permuteObsSize = _oobSampleSize[b];
break;
case RSF_PRED:
permuteObsSize = _fobservationSize;
break;
case RSF_INTR:
permuteObsSize = _foobSampleSize[b];
break;
default:
Rprintf("\nRSF: *** ERROR *** ");
Rprintf("\nRSF: Unknown case in switch encountered. ");
Rprintf("\nRSF: Please Contact Technical Support.");
error("\nRSF: The application will now exit.\n");
break;
}
indexVIMP = uivector(1, permuteObsSize);
permuteVIMP = uivector(1, permuteObsSize);
k = 0;
for (i=1; i <= obsSize; i++) {
if ((_genericMembershipFlag[_individualIndex[i]] == selectionFlag) || (selectionFlag == ACTIVE)) {
k++;
indexVIMP[k] = i;
}
}
if (k != permuteObsSize) {
Rprintf("\nRSF: *** ERROR *** ");
Rprintf("\nRSF: VIMP candidate selection failed.");
Rprintf("\nRSF: %10d available, %10d selected.", permuteObsSize, k);
Rprintf("\nRSF: Please Contact Technical Support.");
error("\nRSF: The application will now exit.\n");
}
if (!(_opt & (~OPT_VIMP) & OPT_VIMP_JOIN)) {
double *originalVIMP = dvector(1, permuteObsSize);
for (p=1; p <= varCount; p++) {
for (k=1; k<= permuteObsSize; k++) {
originalVIMP[k] = predictorPtr[_predictorIndex[p]][indexVIMP[k]];
}
permute(permuteObsSize, permuteVIMP);
for (k=1; k <= permuteObsSize; k++) {
predictorPtr[_predictorIndex[p]][indexVIMP[k]] = originalVIMP[permuteVIMP[k]];
}
for (i=1; i <= obsSize; i++) {
if ((_genericMembershipFlag[_individualIndex[i]] == selectionFlag) || (selectionFlag == ACTIVE)) {
terminalNode = getProxyMember(rootPtr, predictorPtr, i);
if (!ISNA(terminalNode -> mortality)) {
_vimpMortality[p][i] += terminalNode -> mortality;
if (_eventTypeSize > 1) {
for (j=1; j<= _eventTypeSize; j++) {
_crVimpPOE[p][j][i] += (double) (terminalNode -> poe)[j] / (terminalNode -> eventCount);
for (k=1; k <= _sortedTimeInterestSize; k++) {
_crVimpEnsemble[p][j][k][i] += terminalNode -> subSurvival[j][k];
}
}
}
}
else {
if (_opt & OPT_VOUT_TYPE) {
_oobVimpInvalidDen[p][i] ++;
}
else {
Rprintf("\nRSF: *** ERROR *** ");
Rprintf("\nRSF: NA encountered for mortality in VIMP.");
Rprintf("\nRSF: Please Contact Technical Support.");
error("\nRSF: The application will now exit.\n");
}
}
}
}
for (k=1; k <= permuteObsSize; k++) {
predictorPtr[_predictorIndex[p]][indexVIMP[k]] = originalVIMP[k];
}
}
free_dvector(originalVIMP, 1, permuteObsSize);
}
else {
double **intrOriginalVIMP = dmatrix(1, _intrPredictorSize, 1, permuteObsSize);
for (p=1; p <= _intrPredictorSize; p++) {
for (k=1; k<= permuteObsSize; k++) {
intrOriginalVIMP[p][k] = predictorPtr[_intrPredictor[p]][indexVIMP[k]];
}
permute(permuteObsSize, permuteVIMP);
for (k=1; k <= permuteObsSize; k++) {
predictorPtr[_intrPredictor[p]][indexVIMP[k]] = intrOriginalVIMP[p][permuteVIMP[k]];
}
}
for (i=1; i <= _fobservationSize; i++) {
if ( _bootMembershipFlag[_intrIndividual[i]] == FALSE ) {
terminalNode = getProxyMember(rootPtr, predictorPtr, i);
if (!ISNA(terminalNode -> mortality)) {
_vimpMortality[1][i] += terminalNode -> mortality;
if (_eventTypeSize > 1) {
for (j=1; j<= _eventTypeSize; j++) {
_crVimpPOE[1][j][i] += (double) (terminalNode -> poe)[j] / (terminalNode -> eventCount);
for (k=1; k <= _sortedTimeInterestSize; k++) {
_crVimpEnsemble[1][j][k][i] += terminalNode -> subSurvival[j][k];
}
}
}
}
else {
if (_opt & OPT_VOUT_TYPE) {
_oobVimpInvalidDen[1][i] ++;
}
else {
Rprintf("\nRSF: *** ERROR *** ");
Rprintf("\nRSF: NA encountered for mortality in VIMP.");
Rprintf("\nRSF: Please Contact Technical Support.");
error("\nRSF: The application will now exit.\n");
}
}
}
}
for (p=1; p <= _intrPredictorSize; p++) {
for (k=1; k <= permuteObsSize; k++) {
predictorPtr[_intrPredictor[p]][indexVIMP[k]] = intrOriginalVIMP[p][k];
}
}
free_dmatrix(intrOriginalVIMP, 1, _intrPredictorSize, 1, permuteObsSize);
}
free_uivector(indexVIMP, 1, permuteObsSize);
free_uivector(permuteVIMP, 1, permuteObsSize);
}
