int rr (
int type , // Type of study (SCREEN_RR_? in CONST.H): continuous, tails, discrete)
int npred , // Number of predictors
int *preds , // Their indices are here
int targetvar , // Index of target variable
int nbins_pred , // Number of predictor bins
int nbins_target , // Number of target bins, 0 for 2 sign-based bins
double tail_frac , // Tail fraction
int mcpt_type , // 1=complete, 2=cyclic
int mcpt_reps , // Number of MCPT replications, <=1 for no MCPT
int max_pred // Max number of predictors in optimal subset
)
{
int i, j, k, n, ret_val, ivar, irep, varnum, max_threads, bins_dim ;
int *index, *stepwise_mcpt_count, *solo_mcpt_count, *stepwise_ivar, *original_stepwise_ivar ;
int *pred_bin, *redun_pred_bin, *target_bin, *bin_counts ;
int *work_bin, nkept, best_ivar, *which_preds, *tail_n, *target_bin_ptr ;
double *casework, *sorted, *mutual, *pred_thresholds, *target_thresholds, *target, *work_target ;
double *crit, *relevance, *original_relevance, *current_crits, *sorted_crits, best_crit, dtemp ;
double *pred_bounds, *target_bounds, *pred_marginal, *redun_pred_marginal, *target_marginal ;
double *stepwise_crit, *original_stepwise_crit ;
double sum_relevance, *original_sum_relevance, *sum_redundancy ;
char msg[4096], msg2[4096] ;
casework = NULL ;
mutual = NULL ;
index = NULL ;
pred_thresholds = NULL ;
target_thresholds = NULL ;
pred_bin = NULL ;
redun_pred_bin = NULL ;
redun_pred_marginal = NULL ;
work_bin = NULL ;
target_bin = NULL ;
bin_counts = NULL ;
target = NULL ;
tail_n = NULL ;
if (max_pred > npred) // Watch out for careless user
max_pred = npred ;
ret_val = 0 ;
max_threads = MAX_THREADS ;
/*
Print header
*/
audit ( "" ) ;
audit ( "" ) ;
audit ( "******************************************************************************" ) ;
audit ( "* *" ) ;
audit ( "* Computing relevance minus redundancy for optimal predictor subset *" ) ;
if (type == SCREEN_RR_CONTINUOUS)
audit ( "* Predictors and target are continuous *" ) ;
else if (type == SCREEN_RR_TAILS) {
sprintf_s ( msg, "* %5.3lf predictor tails used *", tail_frac ) ;
audit ( msg ) ;
sprintf_s ( msg, "* %2d target bins *", nbins_target ) ;
audit ( msg ) ;
}
else if (type == SCREEN_RR_DISCRETE) {
sprintf_s ( msg, "* %2d predictor bins *", nbins_pred ) ;
audit ( msg ) ;
sprintf_s ( msg, "* %2d target bins *", nbins_target ) ;
audit ( msg ) ;
}
sprintf_s ( msg, "* %5d predictor candidates *", npred ) ;
audit ( msg ) ;
sprintf_s ( msg, "* %7d best predictors will be printed *", max_pred ) ;
audit ( msg ) ;
if (mcpt_reps > 1) {
if (mcpt_type == 1)
sprintf_s ( msg, "* %5d replications of complete Monte-Carlo Permutation Test *", mcpt_reps ) ;
else if (mcpt_type == 2)
sprintf_s ( msg, "* %5d replications of cyclic Monte-Carlo Permutation Test *", mcpt_reps ) ;
audit ( msg ) ;
}
else {
sprintf_s ( msg, "* No Monte-Carlo Permutation Test *" ) ;
audit ( msg ) ;
}
audit ( "* *" ) ;
audit ( "******************************************************************************" ) ;
/*
Allocate memory needed for all types (CONTINUOUS, TAILS, DISCRETE)
*/
casework = (double *) malloc ( 2 * n_cases * sizeof(double) ) ; // Pred, sorted
sorted = casework + n_cases ;
mutual = (double *) malloc ( 10 * npred * sizeof(double) ) ;
crit = mutual + npred ;
current_crits = crit + npred ;
sorted_crits = current_crits + npred ;
stepwise_crit = sorted_crits + npred ;
original_stepwise_crit = stepwise_crit + npred ;
relevance = original_stepwise_crit + npred ;
original_relevance = relevance + npred ;
sum_redundancy = original_relevance + npred ;
original_sum_relevance = sum_redundancy + npred ;
index = (int *) malloc ( 6 * npred * sizeof(int) ) ;
stepwise_mcpt_count = index + npred ;
solo_mcpt_count = stepwise_mcpt_count + npred ;
which_preds = solo_mcpt_count + npred ;
stepwise_ivar = which_preds + npred ;
original_stepwise_ivar = stepwise_ivar + npred ;
if (casework == NULL || mutual == NULL || index == NULL) {
audit ( "ERROR: Insufficient memory for Relevance minus Redundancy" ) ;
ret_val = ERROR_INSUFFICIENT_MEMORY ;
goto FINISH ;
}
/*
For CONTINUOUS, allocate and save target
*/
if (type == SCREEN_RR_CONTINUOUS) {
target = (double *) malloc ( 2 * n_cases * sizeof(double) ) ;
work_target = target + n_cases ;
if (target == NULL) {
audit ( "ERROR: Insufficient memory for Relevance minus Redundancy" ) ;
ret_val = ERROR_INSUFFICIENT_MEMORY ;
goto FINISH ;
}
for (i=0 ; i<n_cases ; i++) // Extract target from database
target[i] = database[i*n_vars+targetvar] ;
}
/*
For binning types (TAILS, DISCRETE), allocate that memory and compute all bin information
*/
else if (type == SCREEN_RR_TAILS || type == SCREEN_RR_DISCRETE) {
pred_thresholds = (double *) malloc ( 2 * nbins_pred * npred * sizeof(double) ) ; // pred_thresholds, pred_marginal
pred_marginal = pred_thresholds + npred * nbins_pred ; // Not needed for computation but nice to print for user
pred_bin = (int *) malloc ( npred * n_cases * sizeof(int) ) ;
work_bin = (int *) malloc ( n_cases * sizeof(int) ) ;
if (type == SCREEN_RR_TAILS) {
assert ( nbins_pred == 2 ) ;
k = 3 ; // We go trinary for redundancy
}
else
k = nbins_pred ;
if (k >= nbins_target)
bins_dim = k * k ;
else
bins_dim = k * nbins_target ;
bin_counts = (int *) malloc ( max_threads * bins_dim * sizeof(int) ) ;
tail_n = (int *) malloc ( npred * sizeof(int) ) ; // We use tail_n[0] if DISCRETE, so we need it for eitherz
if (type == SCREEN_RR_TAILS) {
target_thresholds = (double *) malloc ( 2 * nbins_target * npred * sizeof(double) ) ; // target_thresholds, target_marginal
target_marginal = target_thresholds + nbins_target * npred ;
target_bin = (int *) malloc ( npred * n_cases * sizeof(int) ) ; // Target bin separate for each predictor
redun_pred_bin = (int *) malloc ( npred * n_cases * sizeof(int) ) ; // Trinary for redundancy calculation
redun_pred_marginal = (double *) malloc ( 3 * npred * sizeof(double) ) ; // Trinary
}
else if (type == SCREEN_RR_DISCRETE) {
target_thresholds = (double *) malloc ( 2 * nbins_target * sizeof(double) ) ; // target_thresholds, target_marginal
target_marginal = target_thresholds + nbins_target ;
target_bin = (int *) malloc ( n_cases * sizeof(int) ) ; // Target bin the same for all predictors
}
if (pred_thresholds == NULL || target_thresholds == NULL ||
pred_bin == NULL || work_bin == NULL || target_bin == NULL || bin_counts == NULL) {
audit ( "ERROR: Insufficient memory for Relevance minus Redundancy" ) ;
ret_val = ERROR_INSUFFICIENT_MEMORY ;
goto FINISH ;
}
/*
Make an initial pass through the data to find predictor thresholds and
permanently save bin indices for predictors and target.
If tails-only, we must save the associated target subset indices, separately for each predictor.
If not tails only, do target when ivar=-1.
*/
for (ivar=-1 ; ivar<npred ; ivar++) {
if (ivar == -1) { // If this is target pass
if (type == SCREEN_RR_TAILS) // But user specified tails only
continue ; // then we process the targets separately for each predictor's subset
}
else
varnum = preds[ivar] ;
if (user_pressed_escape()) {
audit ( "ERROR: User pressed ESCape during RELEVANCE MINUS REDUNDANCY" ) ;
ret_val = ERROR_ESCAPE ;
goto FINISH ;
}
// At this point, one of three things holds:
// Case 1: ivar=-1 (which implies not TAILS): This is the target
// Case 2: ivar>=0, not TAILS: This is a predictor
// Case 3: ivar>=0, TAILS: This is a predictor AND we must save the corresponding target
// ------> Case 1: ivar=-1 (which implies not TAILS): This is the target
if (ivar == -1) {
for (i=0 ; i<n_cases ; i++) // Extract target from database
casework[i] = database[i*n_vars+targetvar] ;
target_bounds = target_thresholds ;
k = nbins_target ;
partition ( n_cases , casework , &k , target_bounds , target_bin ) ;
if (k <nbins_target) {
sprintf_s ( msg, "ERROR: Numerous ties reduced target bins to %d", k ) ;
audit ( msg ) ;
ret_val = ERROR_SYNTAX ;
goto FINISH ;
}
assert ( k == nbins_target ) ;
tail_n[0] = n_cases ; // Later code is simplified if we save this as if TAILS
}
// ------> Case 2: ivar>=0, not TAILS: This is a predictor
else if (ivar >= 0 && type != SCREEN_RR_TAILS) {
for (i=0 ; i<n_cases ; i++) // Extract predictor from database
casework[i] = database[i*n_vars+varnum] ;
pred_bounds = pred_thresholds + ivar * nbins_pred ;
k = nbins_pred ;
partition ( n_cases , casework , &k , pred_bounds , pred_bin+ivar*n_cases ) ;
if (k <nbins_pred) {
sprintf_s ( msg, "ERROR: Numerous ties reduced predictor %s bins to %d", var_names[preds[ivar]], k ) ;
audit ( msg ) ;
ret_val = ERROR_SYNTAX ;
goto FINISH ;
}
assert ( k == nbins_pred ) ;
}
// ------> Case 3: ivar>=0, TAILS: This is a predictor AND we must save the corresponding target
else if (ivar >= 0 && type == SCREEN_RR_TAILS) {
// Compute predictor bounds per tail fraction
for (i=0 ; i<n_cases ; i++) // Extract predictor from database
casework[i] = database[i*n_vars+varnum] ;
qsortd ( 0 , n_cases-1 , casework ) ;
pred_bounds = pred_thresholds + ivar * nbins_pred ;
k = (int) (tail_frac * (n_cases+1)) - 1 ;
if (k < 0)
k = 0 ;
pred_bounds[0] = casework[k] ;
pred_bounds[1] = casework[n_cases-1-k] ;
// Compute and save predictor bin indices; Also save target for soon computing its bounds and indices
n = 0 ;
for (i=0 ; i<n_cases ; i++) {
if (database[i*n_vars+varnum] <= pred_bounds[0]) {
pred_bin[ivar*n_cases+n] = 0 ;
redun_pred_bin[ivar*n_cases+i] = 0 ; // Need this for intra-predictor redundancy
}
else if (database[i*n_vars+varnum] >= pred_bounds[1]) {
pred_bin[ivar*n_cases+n] = 1 ;
redun_pred_bin[ivar*n_cases+i] = 1 ;
}
else {
redun_pred_bin[ivar*n_cases+i] = 2 ;
continue ;
}
casework[n] = database[i*n_vars+targetvar] ;
++n ;
}
tail_n[ivar] = n ;
// Compute the target bounds based on this 'predictor tail' subset of the entire dataset
target_bounds = target_thresholds + ivar * nbins_target ;
k = nbins_target ;
partition ( n , casework , &k , target_bounds , target_bin+ivar*n_cases ) ;
if (k <nbins_target) {
sprintf_s ( msg, "ERROR: Numerous ties reduced target bins to %d", k ) ;
audit ( msg ) ;
ret_val = ERROR_SYNTAX ;
goto FINISH ;
}
}
else
assert ( 1 == 0 ) ;
} // For ivar (reading each variable)
/*
All thresholds (predictor and target) are computed and saved.
The predictor and target bin indices are also saved.
If not TAILS, the saved target bin indices are based on the entire dataset,
and the saved target thresholds are similarly for the entire dataset.
But if TAILS, each predictor candidate will have its own target subset
and thresholds corresponding to that subset.
Print the thresholds for the user's edification
*/
audit ( "" ) ;
audit ( "" ) ;
audit ( "The bounds that define bins are now shown" ) ;
audit ( "" ) ;
if (type == SCREEN_RR_TAILS) {
audit ( "Target bounds are shown (after :) separately for each predictor candidate" ) ;
audit ( "" ) ;
audit ( " Variable Predictor bounds... : Target bounds" ) ;
audit ( "" ) ;
}
else {
audit ( "Target bounds are based on the entire dataset..." ) ;
sprintf_s ( msg , "%12.5lf", target_thresholds[0] ) ;
for (i=1 ; i<nbins_target-1 ; i++) {
sprintf_s ( msg2 , " %12.5lf", target_thresholds[i] ) ;
strcat_s ( msg , msg2 ) ;
}
audit ( msg ) ;
audit ( "" ) ;
audit ( " Variable Bounds..." ) ;
audit ( "" ) ;
}
for (ivar=0 ; ivar<npred ; ivar++) {
pred_bounds = pred_thresholds + ivar * nbins_pred ;
sprintf_s ( msg, "%15s %12.5lf", var_names[preds[ivar]], pred_bounds[0] ) ;
k = (type == SCREEN_RR_TAILS) ? 2 : nbins_pred-1 ;
for (i=1 ; i<k ; i++) {
sprintf_s ( msg2 , " %12.5lf", pred_bounds[i] ) ;
strcat_s ( msg , msg2 ) ;
}
if (type == SCREEN_RR_TAILS) {
target_bounds = target_thresholds + ivar * nbins_target ;
sprintf_s ( msg2 , " : %12.5lf", target_bounds[0] ) ;
strcat_s ( msg , msg2 ) ;
for (i=1 ; i<nbins_target-1 ; i++) {
sprintf_s ( msg2 , " %12.5lf", target_bounds[i] ) ;
strcat_s ( msg , msg2 ) ;
}
} // If TAILS
audit ( msg ) ;
} // For all predictors
/*
Compute marginals
*/
for (ivar=0 ; ivar<npred ; ivar++) {
for (i=0 ; i<nbins_pred ; i++)
pred_marginal[ivar*nbins_pred+i] = 0.0 ;
if (ivar==0 || type == SCREEN_RR_TAILS) {
for (i=0 ; i<nbins_target ; i++)
target_marginal[ivar*nbins_target+i] = 0.0 ;
}
for (i=0 ; i<n_cases ; i++) {
++pred_marginal[ivar*nbins_pred+pred_bin[ivar*n_cases+i]] ;
if (type == SCREEN_UNIVAR_TAILS) {
++target_marginal[ivar*nbins_target+target_bin[ivar*n_cases+i]] ;
if (i == tail_n[ivar]-1)
break ;
}
else if (ivar == 0) // Do target just once
++target_marginal[target_bin[i]] ;
} // For all cases
if (type == SCREEN_RR_TAILS) { // Trinary
for (i=0 ; i<3 ; i++)
redun_pred_marginal[ivar*3+i] = 0.0 ;
for (i=0 ; i<n_cases ; i++)
++redun_pred_marginal[ivar*3+redun_pred_bin[ivar*n_cases+i]] ;
}
}
for (ivar=0 ; ivar<npred ; ivar++) { // Divide counts by number of cases to get marginal
if (type == SCREEN_UNIVAR_TAILS) {
assert ( nbins_pred == 2 ) ;
for (i=0 ; i<nbins_pred ; i++)
pred_marginal[ivar*nbins_pred+i] /= tail_n[ivar] ;
for (i=0 ; i<3 ; i++)
redun_pred_marginal[ivar*3+i] /= n_cases ;
}
else {
for (i=0 ; i<nbins_pred ; i++)
pred_marginal[ivar*nbins_pred+i] /= n_cases ;
}
if (ivar==0 || type == SCREEN_UNIVAR_TAILS) {
for (i=0 ; i<nbins_target ; i++)
target_marginal[ivar*nbins_target+i] /= tail_n[ivar] ;
}
}
/*
Print the marginals for the user's edification
*/
audit ( "" ) ;
audit ( "" ) ;
audit ( "The marginal distributions are now shown." ) ;
audit ( "If the data is continuous, the marginals will be nearly equal." ) ;
audit ( "Widely unequal marginals indicate potentially problematic ties." ) ;
audit ( "" ) ;
if (type == SCREEN_UNIVAR_TAILS) {
audit ( "Target marginals are shown (after :) separately for each predictor candidate" ) ;
audit ( "" ) ;
audit ( " Variable Predictor marginals... : Target marginals" ) ;
audit ( "" ) ;
}
else {
audit ( "Target marginals are based on the entire dataset..." ) ;
sprintf_s ( msg , "%12.5lf", target_marginal[0] ) ;
for (i=1 ; i<nbins_target ; i++) {
sprintf_s ( msg2 , " %12.5lf", target_marginal[i] ) ;
strcat_s ( msg , msg2 ) ;
}
audit ( msg ) ;
audit ( "" ) ;
audit ( " Variable Marginal..." ) ;
audit ( "" ) ;
}
for (ivar=0 ; ivar<npred ; ivar++) {
sprintf_s ( msg, "%15s %12.5lf", var_names[preds[ivar]], pred_marginal[ivar*nbins_pred+0] ) ;
for (i=1 ; i<nbins_pred ; i++) {
sprintf_s ( msg2 , " %12.5lf", pred_marginal[ivar*nbins_pred+i] ) ;
strcat_s ( msg , msg2 ) ;
}
if (type == SCREEN_UNIVAR_TAILS) {
sprintf_s ( msg2 , " : %12.5lf", target_marginal[ivar*nbins_target+0] ) ;
strcat_s ( msg , msg2 ) ;
for (i=1 ; i<nbins_target ; i++) {
sprintf_s ( msg2 , " %12.5lf", target_marginal[ivar*nbins_target+i] ) ;
strcat_s ( msg , msg2 ) ;
}
} // If TAILS
audit ( msg ) ;
} // For all predictors
disallow_menu = 0 ;
mouse_cursor_arrow () ;
end_progbar () ;
} // If binning type (TAILS, DISCRETE)
/*
--------------------------------------------------------------------------------
Outer-most loop does MCPT replications
--------------------------------------------------------------------------------
*/
if (mcpt_reps < 1)
mcpt_reps = 1 ;
for (irep=0 ; irep<mcpt_reps ; irep++) {
/*
Shuffle target if in permutation run (irep>0)
*/
if (irep) { // If doing permuted runs, shuffle
if (mcpt_type == 1) { // Complete
if (type == SCREEN_UNIVAR_CONTINUOUS) {
i = n_cases ; // Number remaining to be shuffled
while (i > 1) { // While at least 2 left to shuffle
j = (int) (unifrand_fast () * i) ;
if (j >= i)
j = i - 1 ;
dtemp = target[--i] ;
target[i] = target[j] ;
target[j] = dtemp ;
}
} // If not using bins
else if (type == SCREEN_UNIVAR_TAILS) { // Each predictor has its own target subset
for (ivar=0 ; ivar<npred ; ivar++) {
target_bin_ptr = target_bin + ivar * n_cases ;
i = tail_n[ivar] ; // Number remaining to be shuffled
while (i > 1) { // While at least 2 left to shuffle
j = (int) (unifrand_fast () * i) ;
if (j >= i)
j = i - 1 ;
k = target_bin_ptr[--i] ;
target_bin_ptr[i] = target_bin_ptr[j] ;
target_bin_ptr[j] = k ;
}
}
} // Else if TAILS
else {
i = n_cases ; // Number remaining to be shuffled
while (i > 1) { // While at least 2 left to shuffle
j = (int) (unifrand_fast () * i) ;
if (j >= i)
j = i - 1 ;
k = target_bin[--i] ;
target_bin[i] = target_bin[j] ;
target_bin[j] = k ;
}
} // Else discrete using entire dataset
} // Type 1, Complete
else if (mcpt_type == 2) { // Cyclic
if (type == SCREEN_UNIVAR_CONTINUOUS) {
j = (int) (unifrand_fast () * n_cases) ;
if (j >= n_cases)
j = n_cases - 1 ;
for (i=0 ; i<n_cases ; i++)
casework[i] = target[(i+j)%n_cases] ;
for (i=0 ; i<n_cases ; i++)
target[i] = casework[i] ;
} // If continuous
else if (type == SCREEN_UNIVAR_TAILS) { // Each predictor has its own target subset
for (ivar=0 ; ivar<npred ; ivar++) {
target_bin_ptr = target_bin + ivar * n_cases ;
k = tail_n[ivar] ;
j = (int) (unifrand_fast () * k) ;
if (j >= k)
j = k - 1 ;
for (i=0 ; i<k ; i++)
work_bin[i] = target_bin_ptr[(i+j)%k] ;
for (i=0 ; i<k ; i++)
target_bin_ptr[i] = work_bin[i] ;
}
} // Else if TAILS
else {
j = (int) (unifrand_fast () * n_cases) ;
if (j >= n_cases)
j = n_cases - 1 ;
for (i=0 ; i<n_cases ; i++)
work_bin[i] = target_bin[(i+j)%n_cases] ;
for (i=0 ; i<n_cases ; i++)
target_bin[i] = work_bin[i] ;
} // Else discrete using entire dataset
} // Type 2, Cyclic
} // If in permutation run (irep > 0)
/*
-----------------------------------------------------------------------------------
First step: Compute and save criterion for all individual candidates
-----------------------------------------------------------------------------------
*/
for (i=0 ; i<npred ; i++) // We'll test all candidates
which_preds[i] = i ;
if (type == SCREEN_RR_TAILS)
ret_val = rr_threaded ( type , database , n_vars , preds , NULL ,
mcpt_reps , max_threads , n_cases , tail_n , npred , which_preds ,
nbins_pred , pred_bin , pred_marginal ,
nbins_target , target_bin , target_marginal ,
crit , bins_dim , bin_counts ) ;
else
ret_val = rr_threaded ( type , database , n_vars , preds , target ,
mcpt_reps , max_threads , n_cases , NULL , npred , which_preds ,
nbins_pred , pred_bin , pred_marginal ,
nbins_target , target_bin , target_marginal ,
crit , bins_dim , bin_counts ) ;
if (user_pressed_escape() && ret_val == 0)
ret_val = ERROR_ESCAPE ;
if (ret_val) {
audit ( "ERROR: User pressed ESCape during RELEVANCE MINUS REDUNDANCY" ) ;
goto FINISH ;
}
/*
The individual mutual information for each predictor has been computed and saved in crit.
Update 'best' information for this replication.
Print a sorted table if this is the first replication. Else update MCPT count.
*/
for (ivar=0 ; ivar<npred ; ivar++) {
relevance[ivar] = crit[ivar] ; // Will need this for Step 2, addition of more predictors
if (ivar == 0 || crit[ivar] > best_crit) {
best_crit = crit[ivar] ;
best_ivar = ivar ;
}
}
stepwise_crit[0] = best_crit ; // Criterion for first var is largest MI
stepwise_ivar[0] = best_ivar ; // It's this candidate
sum_relevance = best_crit ;
if (irep == 0) { // Original, unpermuted data
original_stepwise_crit[0] = best_crit ; // Criterion for first var is largest MI
original_stepwise_ivar[0] = best_ivar ; // It's this candidate
original_sum_relevance[0] = sum_relevance ;
stepwise_mcpt_count[0] = 1 ; // Initialize cumulative MCPT
// We need original_relevance for printing final table. Other crits are just for this table.
for (ivar=0 ; ivar<npred ; ivar++) {
index[ivar] = ivar ;
original_relevance[ivar] = sorted_crits[ivar] = current_crits[ivar] = crit[ivar] ;
solo_mcpt_count[ivar] = 1 ; // Initialize solo MCPT
}
qsortdsi ( 0 , npred-1 , sorted_crits , index ) ;
audit ( "" ) ;
audit ( "" ) ;
sprintf_s ( msg, "Initial candidates, in order of decreasing mutual information with %s", var_names[targetvar] ) ;
audit ( msg ) ;
audit ( "" ) ;
audit ( " Variable MI" ) ;
audit ( "" ) ;
for (i=npred-1 ; i>=0 ; i--) {
k = index[i] ;
sprintf_s ( msg, "%15s %12.4lf",
var_names[preds[k]], current_crits[k] ) ;
audit ( msg ) ;
}
} // If irep=0 (original, unpermuted run)
else { // Count for MCPT
if (sum_relevance >= original_sum_relevance[0])
++stepwise_mcpt_count[0] ;
for (ivar=0 ; ivar<npred ; ivar++) {
if (relevance[ivar] >= original_relevance[ivar])
++solo_mcpt_count[ivar] ;
}
} // Permuted
/*
-----------------------------------------------------------------------------------
Second step: Iterate to add more candidates
Note that redundancy of a candidate can change as predictors are added.
This is because the kept set is increasing, so sum_redundancy changes.
-----------------------------------------------------------------------------------
*/
for (i=0 ; i<npred ; i++)
sum_redundancy[i] = 0.0 ; // sum_redundancy[i] is the total redundancy of candidate i with kept set
for (nkept=1 ; nkept<max_pred ; nkept++) { // Main outermost loop
/*
Print candidates kept so far (if in unpermuted rep)
*/
if (irep == 0) { // Original, unpermuted
audit ( "" ) ;
audit ( "" ) ;
audit ( "Predictors so far Relevance Redundancy Criterion" ) ;
audit ( "" ) ;
for (i=0 ; i<nkept ; i++) {
k = stepwise_ivar[i] ;
// Cannot print sum_redundancy/nkept here because sum froze but nkept keeps increasing
sprintf_s ( msg, "%15s %12.4lf %12.4lf %12.4lf",
var_names[preds[k]], relevance[k], relevance[k] - stepwise_crit[i], stepwise_crit[i] ) ;
audit ( msg ) ;
}
}
/*
Build in which_preds the candidates not yet selected
*/
k = 0 ; // Candidate vector is all except those already kept
for (i=0 ; i<npred ; i++) {
for (j=0 ; j<nkept ; j++) {
if (stepwise_ivar[j] == i)
break ;
}
if (j == nkept)
which_preds[k++] = i ;
}
assert ( k == npred - nkept ) ;
/*
Compute the MI of the most recently added predictor with each remaining candidate
*/
if (user_pressed_escape()) {
ret_val = ERROR_ESCAPE ;
audit ( "ERROR: User pressed ESCape or other serious error during RELEVANCE MINUS REDUNDANCY" ) ;
goto FINISH ;
}
k = stepwise_ivar[nkept-1] ; // Index in preds of most recently added candidate
if (type == SCREEN_RR_TAILS) // redun_pred_? is trinary
ret_val = rr_threaded ( type , database , n_vars , preds , NULL ,
mcpt_reps , max_threads , n_cases , NULL , npred-nkept , which_preds ,
3 , redun_pred_bin , redun_pred_marginal ,
3 , redun_pred_bin+k*n_cases , redun_pred_marginal+k*3 ,
crit , bins_dim , bin_counts ) ;
else {
if (type == SCREEN_RR_CONTINUOUS) {
for (i=0 ; i<n_cases ; i++)
casework[i] = database[i*n_vars+preds[k]] ;
}
ret_val = rr_threaded ( type , database , n_vars , preds , casework ,
mcpt_reps , max_threads , n_cases , NULL , npred-nkept , which_preds ,
nbins_pred , pred_bin , pred_marginal ,
nbins_pred , pred_bin+k*n_cases , pred_marginal+k*nbins_pred ,
crit , bins_dim , bin_counts ) ;
}
if (user_pressed_escape() && ret_val == 0)
ret_val = ERROR_ESCAPE ;
if (ret_val) {
audit ( "ERROR: User pressed ESCape or other serious error during RELEVANCE MINUS REDUNDANCY" ) ;
goto FINISH ;
}
/*
The redundancy of each remaining candidate with the most recently added predictor is now in crit.
Cumulate the sum of redundancy.
Then compute the criteria, sorting and printing if this is the unpermuted replication.
*/
for (i=0 ; i<npred-nkept ; i++) {
k = which_preds[i] ; // Index in preds of this candidate
sum_redundancy[k] += crit[i] ;
index[i] = k ;
sorted_crits[i] = current_crits[i] = relevance[k] - sum_redundancy[k] / nkept ;
if (i == 0 || current_crits[i] > best_crit) {
best_crit = current_crits[i] ;
best_ivar = k ;
}
}
stepwise_crit[nkept] = best_crit ;
stepwise_ivar[nkept] = best_ivar ;
sum_relevance += relevance[best_ivar] ;
if (irep == 0) { // Original, unpermuted
original_stepwise_crit[nkept] = best_crit ;
original_stepwise_ivar[nkept] = best_ivar ;
original_sum_relevance[nkept] = sum_relevance ;
stepwise_mcpt_count[nkept] = 1 ;
qsortdsi ( 0 , npred-nkept-1 , sorted_crits , index ) ;
audit ( "" ) ;
audit ( "" ) ;
audit ( "Additional candidates, in order of decreasing relevance minus redundancy" ) ;
audit ( "" ) ;
audit ( " Variable Relevance Redundancy Criterion" ) ;
audit ( "" ) ;
for (i=npred-nkept-1 ; i>=0 ; i--) {
k = index[i] ;
sprintf_s ( msg, "%15s %12.4lf %12.4lf %12.4lf",
var_names[preds[k]], relevance[k], sum_redundancy[k] / nkept,
relevance[k] - sum_redundancy[k] / nkept ) ;
audit ( msg ) ;
}
} // If irep=0 (original, unpermuted run)
else { // Count for MCPT
if (sum_relevance >= original_sum_relevance[nkept])
++stepwise_mcpt_count[nkept] ;
} // Permuted
} // Second step (for nkept): Iterate to add predictors to kept set
} // For all MCPT replications
/*
--------------------------------------------------------------------------------
All computation is finished. Print.
--------------------------------------------------------------------------------
*/
audit ( "" ) ;
audit ( "" ) ;
/*
Print final list of candidates and p-values
*/
audit ( "" ) ;
audit ( "" ) ;
sprintf_s ( msg, "----------> Final results predicting %s <----------", var_names[targetvar] ) ;
audit ( msg ) ;
audit ( "" ) ;
if (mcpt_reps > 1)
audit ( "Final predictors Relevance Redundancy Criterion Solo pval Group pval" ) ;
else
audit ( "Final predictors Relevance Redundancy Criterion" ) ;
audit ( "" ) ;
for (i=0 ; i<nkept ; i++) {
// Cannot print sum_redundancy/nkept here because sum froze but nkept keeps increasing
k = original_stepwise_ivar[i] ;
if (mcpt_reps > 1)
sprintf_s ( msg, "%15s %12.4lf %12.4lf %12.4lf %8.3lf %8.3lf",
var_names[preds[k]], original_relevance[k], original_relevance[k] - original_stepwise_crit[i], original_stepwise_crit[i],
(double) solo_mcpt_count[k] / (double) mcpt_reps,
(double) stepwise_mcpt_count[i] / (double) mcpt_reps ) ;
else
sprintf_s ( msg, "%15s %12.4lf %12.4lf %12.4lf",
var_names[preds[k]], original_relevance[k], original_relevance[k] - original_stepwise_crit[i], original_stepwise_crit[i] ) ;
audit ( msg ) ;
}
/*
Finished. Clean up and exit.
*/
FINISH:
if (casework != NULL)
free ( casework ) ;
if (mutual != NULL)
free ( mutual ) ;
if (index != NULL)
free ( index ) ;
if (pred_thresholds != NULL)
free ( pred_thresholds ) ;
if (target_thresholds != NULL)
free ( target_thresholds ) ;
if (pred_bin != NULL)
free ( pred_bin ) ;
if (redun_pred_bin != NULL)
free ( redun_pred_bin ) ;
if (redun_pred_marginal != NULL)
free ( redun_pred_marginal ) ;
if (work_bin != NULL)
free ( work_bin ) ;
if (target_bin != NULL)
free ( target_bin ) ;
if (bin_counts != NULL)
free ( bin_counts ) ;
if (target != NULL)
free ( target ) ;
if (tail_n != NULL)
free ( tail_n ) ;
return ret_val ;
}
double dermin (
int maxits , // Iteration limit
double critlim , // Quit if crit drops this low
double tol , // Convergence tolerance
double (*criter) (double * , int , double * , double * ) , // Criterion func
int n , // Number of variables
double *x , // In/out of independent variable
double ystart , // Input of starting function value
double *base , // Work vector n long
double *direc , // Work vector n long
double *g , // Work vector n long
double *h , // Work vector n long
double *deriv2 , // Work vector n long
int progress // Print progress?
)
{
int i, iter, user_quit, convergence_counter, poor_cj_counter ;
double fval, fbest, high, scale, t1, t2, t3, y1, y2, y3, dlen, dot1, dot2 ;
double prev_best, toler, gam, improvement ;
char msg[400] ;
/*
Initialize for the local univariate criterion which may be called by
'glob_min' and 'brentmin' to minimize along the search direction.
*/
local_x = x ;
local_base = base ;
local_direc = direc ;
local_n = n ;
local_criter = criter ;
/*
Initialize that the user has not pressed ESCape.
Evaluate the function and, more importantly, its derivatives, at the
starting point. This call to criter puts the gradient into direc, but
we flip its sign to get the downhill search direction.
Also initialize the CJ algorithm by putting that vector in g and h.
*/
user_quit = 0 ;
fbest = criter ( x , 1 , direc , deriv2 ) ;
prev_best = 1.e30 ;
for (i=0 ; i<n ; i++)
direc[i] = -direc[i] ;
memcpy ( g , direc , n * sizeof(double) ) ;
memcpy ( h , direc , n * sizeof(double) ) ;
#if DEBUG
printf ( "\nDERMIN starting error = %lf", fbest ) ;
#endif
if (fbest < 0.0) { // If user pressed ESCape during criter call
fbest = ystart ;
user_quit = 1 ;
goto FINISH ;
}
/*
Main loop. For safety we impose a limit on iterations.
There are two counters that have somewhat similar purposes.
The first, convergence_counter, counts how many times an iteration
failed to reduce the function value to the user's tolerance level.
We require failure several times in a row before termination.
The second, poor_cj_counter, has a (generally) higher threshold.
It keeps track of poor improvement, and imposes successively small
limits on gamma, thus forcing the algorithm back to steepest
descent if CJ is doing poorly.
*/
convergence_counter = 0 ;
poor_cj_counter = 0 ;
iter = 0 ;
for (;;) {
if ((maxits > 0) && (iter++ >= maxits))
break ;
if (fbest < critlim) // Do we satisfy user yet?
break ;
/*
Convergence check
*/
if (prev_best <= 1.0) // If the function is small
toler = tol ; // Work on absolutes
else // But if it is large
toler = tol * prev_best ; // Keep things relative
if ((prev_best - fbest) <= toler) { // If little improvement
if (++convergence_counter >= 3) // Then count how many
break ; // And quit if too many
}
else // But a good iteration
convergence_counter = 0 ; // Resets this counter
/*
Does the user want to quit?
*/
if ((user_quit = user_pressed_escape ()) != 0)
break ;
/*
Here we do a few quick things for housekeeping.
We save the base for the linear search in 'base', which lets us
parameterize from t=0.
We find the greatest second derivative. This makes an excellent
scaling factor for the search direction so that the initial global
search for a trio containing the minimum is fast. Because this is so
stable, we use it to bound the generally better but unstable Newton scale.
We also compute the length of the search vector and its dot product with
the gradient vector, as well as the directional second derivative.
That lets us use a sort of Newton's method to help us scale the
initial global search to be as fast as possible. In the ideal case,
the 't' parameter will be exactly equal to 'scale', the center point
of the call to glob_min.
*/
dot1 = dot2 = dlen = 0.0 ; // For finding directional derivs
high = 1.e-4 ; // For scaling glob_min
for (i=0 ; i<n ; i++) {
base[i] = x[i] ; // We step out from here
if (deriv2[i] > high) // Keep track of second derivatives
high = deriv2[i] ; // For linear search via glob_min
dot1 += direc[i] * g[i] ; // Directional first derivative (neg)
dot2 += direc[i] * direc[i] * deriv2[i] ; // and second
dlen += direc[i] * direc[i] ; // Length of search vector
}
dlen = sqrt ( dlen ) ; // Actual length
#if DEBUG
printf ( "\n(x d1 d2) d1=%lf d2=%lf len=%lf rat=%lf h=%lf:",
dot1, dot2, dlen, dot1 / dot2, 1.5 / high ) ;
#endif
#if DEBUG > 1
for (i=0 ; i<n ; i++)
printf ( "( %lf %lf %lf)", x[i], direc[i], deriv2[i] ) ;
#endif
/*
The search direction is in 'direc' and the maximum second derivative
is in 'high'. That stable value makes a good approximate scaling factor.
The ideal Newton scaling factor is numerically unstable.
So compute the Newton ideal, then bound it to be near the less ideal
but far more stable maximum second derivative.
Pass the first function value, corresponding to t=0, to the routine
in *y2 and flag this by using a negative npts.
*/
scale = dot1 / dot2 ; // Newton's ideal but unstable scale
high = 1.5 / high ; // Less ideal but more stable heuristic
if (high < 1.e-4) // Subjectively keep it realistic
high = 1.e-4 ;
if (scale < 0.0) // This is truly pathological
scale = high ; // So stick with old reliable
else if (scale < 0.1 * high) // Bound the Newton scale
scale = 0.1 * high ; // To be close to the stable scale
else if (scale > 10.0 * high) // Bound it both above and below
scale = 10.0 * high ;
y2 = prev_best = fbest ;
#if DEBUG
printf ( "\nStarting GLOBAL " ) ;
#endif
user_quit = glob_min ( 0.0 , 2.0 * scale , -3 , 0 , critlim ,
univar_crit , &t1 , &y1 , &t2 , &y2 , &t3 , &y3 , progress) ;
#if DEBUG
printf ( "\nGLOBAL t=%lf f=%lf", t2 / scale , y2 ) ;
#endif
if (user_quit || (y2 < critlim)) { // ESCape or good enough already?
if (y2 < fbest) { // If global caused improvement
for (i=0 ; i<n ; i++) // Implement that improvement
x[i] = base[i] + t2 * direc[i] ;
fbest = y2 ;
}
else { // Else revert to starting point
for (i=0 ; i<n ; i++)
x[i] = base[i] ;
}
break ;
}
/*
We just used a crude global strategy to find three points that
bracket the minimum. Refine using Brent's method.
If we are possibly near the end, as indicated by the convergence_counter
being nonzero, then try extra hard.
*/
if (convergence_counter)
fbest = brentmin ( 20 , critlim , tol , 1.e-7 ,
univar_crit , &t1 , &t2 , &t3 , y2 , progress ) ;
else
fbest = brentmin ( 10 , critlim , 10.0 * tol , 1.e-5 ,
univar_crit , &t1 , &t2 , &t3 , y2 , progress ) ;
#if DEBUG
printf ( "\nBRENT t=%lf f=%lf", t2 / scale , fbest ) ;
#endif
/*
We just completed the global and refined search.
Update the current point to reflect the minimum obtained.
Then evaluate the error and its derivatives there. (The linear optimizers
only evaluated the error, not its derivatives.)
If the user pressed ESCape during dermin, fbest will be returned
negative.
*/
for (i=0 ; i<n ; i++)
x[i] = base[i] + t2 * direc[i] ;
if (fbest < 0.0) { // If user pressed ESCape
fbest = -fbest ;
user_quit = 1 ;
break ;
}
improvement = (prev_best - fbest) / prev_best ;
#if DEBUG
printf ( "\nDIREC improvement = %lf %%",
100. * improvement ) ;
#endif
#if DEBUG > 1
printf ( "\a..." ) ;
getch () ;
#endif
if (fbest < critlim) // Do we satisfy user yet?
break ;
fval = criter ( x , 1 , direc , deriv2 ) ; // Need derivs now
for (i=0 ; i<n ; i++) // Flip sign to get
direc[i] = -direc[i] ; // negative gradient
if (fval < 0.0) { // If user pressed ESCape
user_quit = 1 ;
break ;
}
sprintf ( msg , "scale=%lf f=%le dlen=%le improvement=%lf%%",
t2 / scale , fval, dlen, 100.0 * improvement ) ;
if (progress)
write_progress ( msg ) ;
else
write_non_progress ( msg ) ;
#if DEBUG
printf ( "\nf=%lf at (", fval ) ;
#endif
#if DEBUG > 1
for (i=0 ; i<n ; i++)
printf ( " %lf", x[i] ) ;
printf ( ")...\a" ) ;
getch () ;
#endif
gam = gamma ( n , g , direc ) ;
#if DEBUG
dlen = 0.0 ;
for (i=0 ; i<n ; i++)
dlen += direc[i] * direc[i] ;
printf ( "\nGamma = %lf with grad len = %lf", gam, sqrt(dlen) ) ;
#endif
if (gam < 0.0)
gam = 0.0 ;
if (gam > 10.0) // limit gamma
gam = 10.0 ;
if (improvement < 0.001) // Count how many times we
++poor_cj_counter ; // got poor improvement
else // in a row
poor_cj_counter = 0 ;
if (poor_cj_counter >= 2) { // If several times
if (gam > 1.0) // limit gamma
gam = 1.0 ;
}
if (poor_cj_counter >= 6) { // If too many times
poor_cj_counter = 0 ; // set gamma to 0
gam = 0.0 ; // to use steepest descent (gradient)
#if DEBUG
printf ( "\nSetting Gamma=0" ) ;
#endif
}
find_new_dir ( n , gam , g , h , direc ) ; // Compute search direction
} // Main loop
FINISH:
if (user_quit)
return -fbest ;
else
return fbest ;
}
static int rr_threaded (
int type , // Type of study (SCREEN_RR_? in CONST.H): continuous, tails, discrete)
double *database , // Full database (this and next two lines used for continuous methods only)
int n_vars , // Number of columns in database
int *preds , // Predictor database indexes indices
double *target , // Target variable, used for CONTINUOUS only
int mcpt_reps , // Only for knowing whether to update progress bar
int max_threads , // Maximum number of threads to use
int ncases , // Number of cases, used only for Xbin if tail_n used
int *tail_n , // If non-NULL, npred vector of n for each predictor candidate, selected by Xindex
int nX , // Number of predictor candidates in Xindex below
int *Xindex , // nX indices of predictors in preds, X_bin and X_marginal
int nbins_X , // Number of predictor bins
int *X_bin , // Ncases vector of predictor bin indices, npred of them, selected by Xindex
double *X_marginal , // Predictor marginals, npred sets of nbins_X each, selected by Xindex
int nbins_Y , // Number of target bins
int *Y_bin , // Ncases vector of target bin indices (Set for each predictor if tail_n)
double *Y_marginal , // Target marginal, ntarget of them (Set for each predictor if tail_n)
double *crit , // Output of all criteria, npred of them
int bins_dim , // nbins_X * max(nbins_X,nbins_Y)
int *bin_counts // Work area max_threads*bins_dim long
)
{
int i, k, ret_val, ix, ipred, ithread, n_threads, empty_slot ;
char msg[4096] ;
RR_PARAMS rr_params[MAX_THREADS] ;
MutualInformationAdaptive *mi_adapt[MAX_THREADS] ;
HANDLE threads[MAX_THREADS] ;
/*
Initialize those thread parameters which are constant for all threads.
Each thread will have its own private bin_count matrix for working storage.
If the user specified 'continuous' then we need to allocate a
MutualInformationAdaptive object for use by each thread.
This object is dependent on the target,
so we must allocate AFTER the target is shuffled.
*/
if (type == SCREEN_RR_CONTINUOUS) {
for (ithread=0 ; ithread<max_threads ; ithread++) {
rr_params[ithread].type = type ;
rr_params[ithread].database = database ;
rr_params[ithread].n_vars = n_vars ;
if (ithread == 0)
mi_adapt[ithread] = new MutualInformationAdaptive ( ncases , target , 1 , 6.0 , NULL , NULL ) ;
else
mi_adapt[ithread] = new MutualInformationAdaptive ( ncases , target , 1 , 6.0 ,
mi_adapt[0]->y , mi_adapt[0]->y_tied ) ;
if (! mi_adapt[ithread]->ok || mi_adapt[ithread] == NULL) {
for (i=0 ; i<=ithread ; i++) {
if (mi_adapt[i] != NULL)
delete mi_adapt[i] ;
}
audit ( "ERROR: Insufficient memory for continuous mutual information" ) ;
return ERROR_INSUFFICIENT_MEMORY ;
}
rr_params[ithread].mi_adapt = mi_adapt[ithread] ;
}
}
else {
for (ithread=0 ; ithread<max_threads ; ithread++) {
rr_params[ithread].type = type ;
rr_params[ithread].ncases = n_cases ; // Will be changed below if tail_n used
rr_params[ithread].nbins_X = nbins_X ;
rr_params[ithread].nbins_Y = nbins_Y ;
rr_params[ithread].Y_bin = Y_bin ; // Will be changed below if tail_n used
rr_params[ithread].Y_marginal = Y_marginal ; // Ditto
rr_params[ithread].bin_counts = bin_counts + ithread * bins_dim ;
} // For all threads, initializing constant stuff
}
/*
Do it
*/
n_threads = 0 ; // Counts threads that are active
for (i=0 ; i<max_threads ; i++)
threads[i] = NULL ;
ix = 0 ; // Will count predictors tested
ipred = Xindex[ix] ; // Get its index in Xbin and Xmarginal
empty_slot = -1 ; // After full, will identify the thread that just completed
for (;;) { // Main thread loop processes all predictors
/*
Handle user ESCape
*/
if (escape_key_pressed || user_pressed_escape ()) {
for (i=0, k=0 ; i<max_threads ; i++) {
if (threads[i] != NULL)
threads[k++] = threads[i] ;
}
ret_val = WaitForMultipleObjects ( n_threads , threads , TRUE , 50000 ) ;
for (i=0 ; i<n_threads ; i++)
CloseHandle ( threads[i] ) ;
if (type == SCREEN_RR_CONTINUOUS) {
for (ithread=0 ; ithread<max_threads ; ithread++)
delete mi_adapt[ithread] ;
}
return ERROR_ESCAPE ;
}
/*
Start a new thread if we still have work to do
*/
if (ix < nX) { // If there are still some to do
if (empty_slot < 0) // Negative while we are initially filling the queue
k = n_threads ;
else
k = empty_slot ;
if (tail_n != NULL) {
rr_params[k].ncases = tail_n[ipred] ;
rr_params[k].Y_bin = Y_bin + ipred * ncases ;
rr_params[k].Y_marginal = Y_marginal + ipred * nbins_Y ;
}
rr_params[k].ix = ix ; // Needed for placing final result
if (type == SCREEN_RR_CONTINUOUS)
rr_params[k].varnum = preds[ipred] ;
else {
rr_params[k].X_bin = X_bin+ipred*ncases ;
rr_params[k].X_marginal = X_marginal+ipred*nbins_X ;
}
threads[k] = (HANDLE) _beginthreadex ( NULL , 0 , mutinf_threaded , &rr_params[k] , 0 , NULL ) ;
if (threads[k] == NULL) {
audit ( "Internal ERROR: bad thread creation in RR" ) ;
for (i=0 ; i<n_threads ; i++) {
if (threads[i] != NULL)
CloseHandle ( threads[i] ) ;
}
return ERROR_INSUFFICIENT_MEMORY ;
}
++n_threads ;
++ix ;
ipred = Xindex[ix] ; // Get its index in Xbin and Xmarginal and perhaps tail_n
} // if (ix < nX)
if (n_threads == 0) // Are we done?
break ;
/*
Handle full suite of threads running and more threads to add as soon as some are done.
Wait for just one thread to finish.
*/
if (n_threads == max_threads && ix < nX) {
ret_val = WaitForMultipleObjects ( n_threads , threads , FALSE , 500000 ) ;
if (ret_val == WAIT_TIMEOUT || ret_val == WAIT_FAILED || ret_val < 0 || ret_val >= n_threads) {
sprintf_s ( msg, "INTERNAL ERROR!!! Thread wait failed (%d) in RR", ret_val ) ;
audit ( msg ) ;
return ERROR_INSUFFICIENT_MEMORY ;
}
crit[rr_params[ret_val].ix] = rr_params[ret_val].crit ;
if (mcpt_reps == 1) {
sprintf_s ( msg , "Predictor %d of %d", ix+1, nX ) ;
title_progbar ( msg ) ;
setpos_progbar ( (double) (ix+1) / (double) nX ) ;
}
empty_slot = ret_val ;
CloseHandle ( threads[empty_slot] ) ;
threads[empty_slot] = NULL ;
--n_threads ;
}
/*
Handle all work has been started and now we are just waiting for threads to finish
*/
else if (ix == nX) {
ret_val = WaitForMultipleObjects ( n_threads , threads , TRUE , 500000 ) ;
if (ret_val == WAIT_TIMEOUT || ret_val == WAIT_FAILED || ret_val < 0 || ret_val >= n_threads) {
sprintf_s ( msg, "INTERNAL ERROR!!! Thread wait failed (%d) in RR.CPP", ret_val ) ;
audit ( msg ) ;
return ERROR_INSUFFICIENT_MEMORY ;
}
for (i=0 ; i<n_threads ; i++) {
crit[rr_params[i].ix] = rr_params[i].crit ;
CloseHandle ( threads[i] ) ;
}
break ;
}
} // Endless loop which threads computation of criterion for all predictors
if (type == SCREEN_RR_CONTINUOUS) {
for (ithread=0 ; ithread<max_threads ; ithread++)
delete mi_adapt[ithread] ;
}
return 0 ;
}
double lev_marq (
int maxits , // Iteration limit
double critlim , // Quit if crit drops this low
double tol , // Convergence tolerance
double (*criter) (double * , double * , double * ) , // Criterion func
int nvars , // Number of variables
double *x , // In/out of independent variable
SingularValueDecomp *sptr , // Work object
double *grad , // Work vector n long
double *delta , // Work vector n long
double *hessian , // Work vector n*n long
int progress // Print progress?
)
{
int i, iter, bad_cnt, trivial_cnt, reset_ab ;
double error, maxgrad, lambda ;
double prev_err, improvement ;
char msg[84] ;
int prog_cnt=0 ;
/*
Compute the error, hessian, and error gradient at the starting point.
*/
error = criter ( x , hessian , grad ) ;
prev_err = error ; // Will be 'previous iteration' error
reset_ab = 1 ; // Flag to use most recent good hessian and grad
/*
Every time an iteration results in increased error, increment bad_cnt
so that remedial action or total escape can be taken.
Do a similar thing for improvements that are tiny via trivial_cnt.
*/
bad_cnt = 0 ; // Counts bad iterations for restart or exit
trivial_cnt = 0 ; // Counts trivial improvements for restart or exit
/*
Initialize lambda to slightly exceed the largest magnitude diagonal
of the Hessian.
*/
lambda = 0.0 ;
for (i=0 ; i<nvars ; i++) {
if (hessian[i*nvars+i] > lambda)
lambda = hessian[i*nvars+i] ;
}
lambda += 1.e-20 ;
/*
Main iteration loop is here
*/
iter = 0 ;
for (;;) { // Each iter is an epoch
#if DEBUG
printf ( "\nLM iter %d lambda=%lf err=%lf", iter, lambda, error ) ;
#endif
if ((maxits > 0) && (iter++ >= maxits))
break ;
/*
Check current error against user's max. Abort if user pressed ESCape
*/
if (user_pressed_escape()) { // Was a key pressed?
prev_err = -prev_err ; // Flags user that ESCape was pressed
break ;
}
if (error <= critlim) // If our error is within user's limit
break ; // then we are done!
if (error <= tol) // Good in case converging to zero
break ;
if (reset_ab) { // Revert to latest good Hessian and gradient?
memcpy ( sptr->a , hessian , nvars * nvars * sizeof(double) ) ;
memcpy ( sptr->b , grad , nvars * sizeof(double) ) ;
}
/*
Add lambda times the unit diagonal matrix to the Hessian.
Solve the linear system for the correction, add that correction to the
current point, and compute the error, Hessian, and gradient there.
*/
for (i=0 ; i<nvars ; i++) // Shift diagonal for stability
sptr->a[i*nvars+i] += lambda ;
sptr->svdcmp () ; // Singular value decomposition
sptr->backsub ( 1.e-8 , delta ) ; // Back substitution solves system
for (i=0 ; i<nvars ; i++)
x[i] += delta[i] ;
error = criter ( x , sptr->a , sptr->b ) ;
#if DEBUG
printf ( " new=%lf", error ) ;
#if DEBUG > 3
printf ( "\n(Dhess grad): " ) ;
for (i=0 ; i<nvars ; i++)
printf ( " (%lf %lf)", sptr->a[i*nvars+i], sptr->b[i] ) ;
#endif
#endif
if (prev_err < 1.0)
improvement = prev_err - error ;
else
improvement = (prev_err - error) / prev_err ;
if (improvement > 0.0) {
#if DEBUG
printf ( " GOOD = %lf%%", 100.0 * improvement ) ;
#endif
/*
This correction resulted in improvement. If only a trivial amount,
check the gradient (relative to the error). If also small, quit.
Otherwise count these trivial improvements. If there were a few,
the Hessian may be bad, so retreat toward steepest descent. If there
were a lot, give up.
*/
prev_err = error ; // Keep best error here
if (improvement < tol) {
maxgrad = 0.0 ;
for (i=0 ; i<nvars ; i++) {
if (fabs ( sptr->b[i] ) > maxgrad)
maxgrad = fabs ( sptr->b[i] ) ;
}
if (error > 1.0)
maxgrad /= error ;
#if DEBUG
printf ( " Triv=%d mg=%lf", trivial_cnt, maxgrad ) ;
#endif
if (maxgrad <= tol)
break ;
if (trivial_cnt++ == 4) {
for (i=0 ; i<nvars ; i++) {
if (hessian[i*nvars+i] > lambda)
lambda = hessian[i*nvars+i] ;
}
}
else if (trivial_cnt == 10) // Normal escape from loop
break ;
}
else
trivial_cnt = 0 ; // Reset counter whenever good improvement
/*
Since this step was good, update everything: the Hessian, the gradient,
and the 'previous iteration' error. Zero reset_ab so that we do not
waste time copying the Hessian and gradient into sptr, as they are
already there. Cut lambda so that we approach Newton's method.
*/
memcpy ( hessian , sptr->a , nvars * nvars * sizeof(double) ) ;
memcpy ( grad , sptr->b , nvars * sizeof(double) ) ;
reset_ab = 0 ;
bad_cnt = 0 ;
lambda *= 0.5 ;
}
else {
#if DEBUG
printf ( " BAD=%d", bad_cnt ) ;
#endif
/*
This step caused an increase in error, so undo the step and set reset_ab
to cause the previous Hessian and gradient to be used. Increase lambda
to revert closer to steepest descent (slower but more stable).
If we had several bad iterations in a row, the Hessian may be bad, so
increase lambda per the diagonal. In the very unlikely event that a lot
of bad iterations happened in a row, quit. This should be very rare.
*/
for (i=0 ; i<nvars ; i++)
x[i] -= delta[i] ;
reset_ab = 1 ; // Fetch old Hessian and gradient
lambda *= 2.0 ; // Less Newton
if (bad_cnt++ == 4) { // If several bad in a row
for (i=0 ; i<nvars ; i++) { // Make sure very un-Newton
if (hessian[i*nvars+i] > lambda)
lambda = hessian[i*nvars+i] ;
}
}
if (bad_cnt == 10) // Pathological escape from loop
break ; // Should almost never happen
}
/*
Diagnostic code
*/
if (++prog_cnt >= 1000 / nvars) {
prog_cnt = 0 ;
sprintf ( msg , " LM error = %lf lambda = %lf", prev_err, lambda ) ;
if (progress)
write_progress ( msg ) ;
else
write_non_progress ( msg ) ;
}
} // This is the end of the main iteration loop
#if DEBUG
printf ( "\n\aLM Done=%lf Press space...", error ) ;
while (kbhit())
getch() ;
getch() ;
#endif
return prev_err ; // This is the best error
}
int net_pred (
int n_inputs , // Number of input variables
int npred , // Number of cases to generate
Network *net , // Use this network
MiscParams *misc , // Mainly for generated signal names
int n_inputs_outputs , // Length of next array
InputOutput **in_out , // Input/output signal list
int *nsigs , // Number of signals currently existing
Signal ***signals // This is them
)
{
int i, j, k, n, ivar, nvars, casenum, lag, lead, user_quit ;
int *in_length, startpos ;
double **outputs, **inlist, *dptr, *in_vector, *inptr ;
char msg[84] ;
Signal **sptr, *sigptr ;
InputOutput *ioptr ;
/*
This array will be used to flag input sources. In the case that
a signal is an input only, its entry will be NULL. But if a user
is using an input as an output also, the output pointer will go here.
*/
MEMTEXT ( "NET_PRED: inlist" ) ;
inlist = (double **) MALLOC ( n_inputs_outputs * sizeof(double*) ) ;
if (inlist == NULL)
return -1 ;
/*
This is used for the network's input vector
*/
MEMTEXT ( "NET_PRED: in_vector" ) ;
in_vector = (double *) MALLOC ( n_inputs * sizeof(double) ) ;
if (in_vector == NULL) {
FREE ( inlist ) ;
return -1 ;
}
/*
Allocate memory for the signals that will be predicted.
Count how many of these signals have names not already in use.
Allocate additional memory for their pointers.
*/
nvars = misc->names->nreal ; // This many signals predicted
MEMTEXT ( "NET_PRED: outputs, signal arrays" ) ;
outputs = (double **) MALLOC ( nvars * sizeof(double *) ) ;
in_length = (int *) MALLOC ( nvars * sizeof(int) ) ;
if ((outputs == NULL) || (in_length == NULL)) {
FREE ( inlist ) ;
FREE ( in_vector ) ;
if (outputs != NULL)
FREE ( outputs ) ;
if (in_length != NULL)
FREE ( in_length ) ;
return -1 ;
}
for (i=0 ; i<nvars ; i++) { // For each predicted signal
in_length[i] = 0 ; // Length of common input (if any)
outputs[i] = (double *) MALLOC ( npred * sizeof(double) ) ; // Goes here
if (outputs[i] == NULL) {
for (j=0 ; j<i ; j++)
FREE ( outputs[j] ) ;
FREE ( outputs ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
FREE ( in_length ) ;
return -1 ;
}
for (j=0 ; j<npred ; j++) // Initialize this output signal
(outputs[i])[j] = 0.0 ; // To prevent NAN problems
}
if (*nsigs) { // If signals already exist
ivar = *nsigs ; // This many signals so far
sptr = *signals ; // Array of pointers to them
for (i=0 ; i<misc->names->n ; i++) { // Check every new name
if (! misc->names->len[i]) // Some may be NULL
continue ; // Obviously skip them
for (j=*nsigs-1 ; j>=0 ; j--) { // Check every existing signal
if (! strcmp ( misc->names->start[i] , sptr[j]->name )) // There?
break ; // If found, quit looking
}
if (j < 0) // Means not there
++ivar ; // So count this new entry
}
sptr = (Signal **) REALLOC ( sptr , ivar * sizeof(Signal *) ) ;
}
else
sptr = (Signal **) MALLOC ( nvars * sizeof(Signal *) ) ;
if (sptr == NULL) {
for (i=0 ; i<nvars ; i++)
FREE ( outputs[i] ) ;
FREE ( outputs ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
FREE ( in_length ) ;
return 1 ;
}
*signals = sptr ;
/*
Some users may want to predict signals that also serve as input.
This necessitates a little preparation. Run through the input signals.
For each that is also an output, flag that fact by storing its output
pointer. Otherwise store a NULL.
Also, store the length of the input signal in in_length and copy that
input signal to the output. When that output is computed, we will not
allow overwriting of input values. So that we can avoid computing
outputs that will not be used, keep track of the minimum starting
position.
Finally, note that this whole section is meaningless in CLASSIFICATION mode.
Nevertheless, we still want inlist to be all NULL, so put the test here.
*/
startpos = npred ; // Avoids overwriting inputs
for (i=0 ; i<n_inputs_outputs ; i++) {
inlist[i] = NULL ; // Assume this is not recursive
if (net->output_mode == OUTMOD_CLASSIFICATION) // In CLASSIFICATION mode
continue ; // The rest is meaningless
ioptr = in_out[i] ;
if (! ioptr->is_input) // If this is an output list entry
continue ; // Ignore it
sigptr = (*signals)[ioptr->which] ; // This input signal
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
if (! strcmp ( misc->names->start[j] , sigptr->name )) { // This one?
inlist[i] = outputs[ivar] ; // This input is here among outputs
n = (npred < sigptr->n) ? npred : sigptr->n ; // Copy input to out
in_length[ivar] = n ; // Will protect the inputs here
memcpy ( outputs[ivar] , sigptr->sig , n * sizeof(double) ) ;
if ((n - net->leads[j]) < startpos) // Must protect this many
startpos = n - net->leads[j] ; // But start soon enough for all
break ;
}
++ivar ; // Keep track of output location
}
}
/*
We are almost done computing startpos, the place to start processing.
It is possible that the above computation produced a negative value.
Also, if there is even one output that is not recursive, we must start
right at the beginning.
*/
for (i=0 ; i<nvars ; i++) { // For every output variable
if (in_length[i] == 0) // If it is not also an input
startpos = 0 ; // We must catch it from the start
}
if (startpos < 0)
startpos = 0 ;
/*
At last we can generate the signals
*/
make_progress_window ( "Network prediction" ) ;
user_quit = 0 ;
for (casenum=startpos ; casenum<npred ; casenum++) {// Start late as possible
#if DEBUG
printf ( "\ncasenum=%2d", casenum ) ;
#endif
inptr = in_vector ; // Will build input vector here
for (i=0 ; i<n_inputs_outputs ; i++) { // Pass through all inputs
ioptr = in_out[i] ; // Signal and lags here
if (! ioptr->is_input) // If this is not an input
continue ; // Skip it
if (inlist[i] != NULL) { // If this input is also an output
dptr = inlist[i] ; // Get its address
n = npred - 1 ; // Last of this input
#if DEBUG
printf ( "\n REC%d n=%d", i, n ) ;
#endif
}
else { // Else we must get the signal
sigptr = (*signals)[ioptr->which] ; // This is the signal
dptr = sigptr->sig ; // Get the data
n = sigptr->n - 1 ; // Last of this input
#if DEBUG
printf ( "\n INP%d n=%d", i, n ) ;
#endif
}
for (lag=ioptr->minlag ; lag<=ioptr->maxlag ; lag++) {
j = casenum - lag ; // Get this sample in signal
if (j < 0) // If it is before start
*inptr++ = dptr[0] ; // Use the first sample
else if (j > n) // If beyond the last
*inptr++ = dptr[n] ; // Use the last
else // But under normal conditions
*inptr++ = dptr[j] ; // Use this lagged value
#if DEBUG
printf ( " (%d=%.2lf)", j, *(inptr-1) ) ;
#endif
}
}
net->trial ( in_vector ) ; // Evaluate network for input
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
if (j >= net->n_outputs) // Careless user may give too
break ; // many names, so check
if (net->output_mode == OUTMOD_CLASSIFICATION) // In CLASSIFICATION mode
lead = 0 ; // Lead is always zero
else // In MAPPING mode
lead = net->leads[j] ; // Lead was recorded when trained
k = casenum + lead ; // It goes in this time slot
#if DEBUG
printf ( " (j=%d iv=%d k=%d out=%.2lf", j, ivar, k, net->out[j] ) ; /*!!!!!!*/
#endif
if ((k < npred) && (k >= in_length[ivar])) // Not past end, protect in
(outputs[ivar])[k] = net->out[j] ; // Output this variable
#if DEBUG
else
printf ( " X" ) ;
#endif
++ivar ;
}
if (user_pressed_escape ()) {
user_quit = 1 ;
break ;
}
#if DEBUG > 2
getch () ;
#endif
if (! ((casenum-startpos) % (1 + (npred-startpos) / 10))) {
sprintf ( msg , "%.2lf percent complete",
100.0 * (casenum-startpos) / (npred-startpos) ) ;
write_non_progress ( msg ) ;
}
} // For all npred cases
#if DEBUG > 1
getch () ;
#endif
/*
The final step is to create a new signal for each output.
If a signal of the same name exists, just replace the data.
*/
destroy_progress_window () ;
ivar = 0 ;
for (i=0 ; i<misc->names->n ; i++) { // Check all names
if (! misc->names->len[i]) // Some may be NULL
continue ; // Obviously skip them
for (j=*nsigs-1 ; j>=0 ; j--) { // Search existing signals for same name
if (! strcmp ( misc->names->start[i] , sptr[j]->name )) // There?
break ; // Yes, so quit looking
}
if (j < 0) { // Means new, unique name
j = *nsigs ; // Tack it onto end of signal array
++*nsigs ; // And count it
MEMTEXT ( "NET_PRED: new Signal" ) ;
sptr[j] = new Signal ( misc->names->start[i] , npred , outputs[ivar] ) ;
if ((sptr[j] == NULL) || ! sptr[j]->n) {
if (sptr[j] != NULL) {
delete sptr[j] ; // This frees the signal
sptr[j] = NULL ;
}
else
FREE ( outputs[ivar] ) ; // Manually free it
for (j=ivar+1 ; j<nvars ; j++) // Free the rest
FREE ( outputs[j] ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
FREE ( in_length ) ;
return -1 ;
}
}
else { // This output signal already exists
MEMTEXT ( "NET_PRED: replace signal" ) ;
if (in_length[ivar]) // Is it a recursive input?
sptr[j]->replace ( npred , in_length[ivar] , outputs[ivar] ) ;
else { // Also protect signals in OUTPUT list
n = 0 ; // If not there, will protect 0 cases
for (k=0 ; k<n_inputs_outputs ; k++) {
ioptr = in_out[k] ;
if ((! ioptr->is_input) && (ioptr->which == j)) { // There?
n = sptr[j]->n ;
break ;
}
}
sptr[j]->replace ( npred , n , outputs[ivar] ) ;
}
}
++ivar ;
} // For all names
MEMTEXT ( "NET_PRED: outputs, inlist, in_vector, in_length" ) ;
FREE ( outputs ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
FREE ( in_length ) ;
return user_quit ;
}
int LayerNet::ssg_core (
TrainingSet *tptr , // Training set to use
struct LearnParams *lptr , // User's general learning parameters
LayerNet *avgnet , // Work area used to keep average weights
LayerNet *bestnet , // And the best so far
double *work1 , // Gradient work vector
double *work2 , // Ditto
double *grad , // Ditto
double *avg_grad , // Ditto
int n_grad // Length of above vectors
)
{
int ntemps, niters, setback, reg, nvars, user_quit ;
int i, iter, itemp, n_good, n_bad, use_grad ;
char msg[80] ;
double tempmult, temp, fval, bestfval, starttemp, stoptemp, fquit ;
double avg_func, new_fac, gradlen, grad_weight, weight_used ;
enum RandomDensity density ;
SingularValueDecomp *sptr ;
struct AnnealParams *aptr ; // User's annealing parameters
aptr = lptr->ap ;
ntemps = aptr->temps0 ;
niters = aptr->iters0 ;
setback = aptr->setback0 ;
starttemp = aptr->start0 ;
stoptemp = aptr->stop0 ;
if (aptr->random0 == ANNEAL_GAUSSIAN)
density = NormalDensity ;
else if (aptr->random0 == ANNEAL_CAUCHY)
density = CauchyDensity ;
if (! (ntemps * niters))
return 0 ;
/*
Initialize other local parameters. Note that there is no sense using
regression if there are no hidden layers.
*/
use_grad = (grad != NULL) ;
fquit = lptr->quit_err ;
reg = nhid1 ;
/*
Allocate the singular value decomposition object for REGRESS.
Also allocate a work area for REGRESS to preserve matrix.
*/
if (reg) { // False if no hidden layers
if (nhid2 == 0) // One hidden layer
nvars = nhid1_n ;
else // Two hidden layers
nvars = nhid2_n ;
i = (model == NETMOD_COMPLEX) ? 2 * tptr->ntrain : tptr->ntrain ;
if (i < nvars) {
warning_message ( "Too few training sets for regression." ) ;
reg = 0 ;
}
else {
MEMTEXT ( "SSG: new SingularValueDecomp" ) ;
sptr = new SingularValueDecomp ( i , nvars , 1 ) ;
if ((sptr == NULL) || ! sptr->ok) {
memory_message (
"for SS(G) with regression. Using total randomization.");
if (sptr != NULL)
delete sptr ;
reg = 0 ;
}
}
}
/*
For the basic algorithm, we will keep the current 'average' network
weight set in avgnet. This will be the moving center about which the
perturbation is done.
Although not directly related to the algorithm itself, we keep track
of the best network ever found in bestnet. That is what the user
will get at the end.
*/
copy_weights ( bestnet , this ) ; // Current weights are best so far
copy_weights ( avgnet , this ) ; // Center of perturbation
bestfval = trial_error ( tptr ) ;
/*
If this is being used to initialize the weights, make sure that they are
not identically zero. Do this by setting bestfval huge so that
SOMETHING is accepted later.
*/
if (nhid1) {
i = nhid1 * nin_n ;
while (i--) {
if (fabs(hid1_coefs[i]) > 1.e-10)
break ;
}
if (i < 0)
bestfval = 1.e30 ;
}
/*
Initialize by cumulating a bunch of points
*/
normal_message ( "Initializing..." ) ;
avg_func = 0.0 ; // Mean function around center
if (use_grad) {
for (i=0 ; i<n_grad ; i++) // Zero the mean gradient
avg_grad[i] = 0.0 ;
}
for (iter=0 ; iter<niters ; iter++) { // Initializing iterations
perturb ( avgnet , this , starttemp , reg , density ) ; // Move point
if (reg) // If using regression, estimate
fval = regress ( tptr , sptr ) ; // out weights now, ignore fval
if (use_grad) // Also need gradient?
fval = gradient ( tptr , work1 , work2 , grad ) ; // fval redundant
else if (! reg) // If reg we got fval from regress
fval = trial_error ( tptr ) ;
avg_func += fval ; // Cumulate mean function
if (use_grad) { // Also need gradient?
for (i=0 ; i<n_grad ; i++) // Cumulate mean gradient
avg_grad[i] += grad[i] ;
}
if (fval < bestfval) { // If this iteration improved
bestfval = fval ; // then update the best so far
copy_weights ( bestnet , this ) ; // Keep the network
if (bestfval <= fquit) // If we reached the user's
goto FINISH ; // limit, we can quit
}
if ((user_quit = user_pressed_escape ()) != 0)
goto FINISH ;
} // Loop: for all initial iters
avg_func /= niters ; // Mean of all points around avgnet
new_fac = 1.0 / niters ; // Weight of each point
sprintf ( msg , " avg=%.6lf best=%.6lf", avg_func, bestfval ) ;
progress_message ( msg ) ;
if (use_grad) { // Also need gradient?
gradlen = 0.0 ; // Will cumulate grad length
for (i=0 ; i<n_grad ; i++) { // Find gradient mean and length
avg_grad[i] /= niters ;
gradlen += avg_grad[i] * avg_grad[i] ;
}
gradlen = sqrt ( gradlen ) ;
grad_weight = 0.5 ;
}
/*
This is the temperature reduction loop and the iteration within
temperature loop.
*/
temp = starttemp ;
tempmult = exp( log( stoptemp / starttemp ) / (ntemps-1)) ;
user_quit = 0 ; // Flags user pressed ESCape
for (itemp=0 ; itemp<ntemps ; itemp++) { // Temp reduction loop
n_good = n_bad = 0 ; // Counts better and worse
sprintf ( msg , "Temp=%.3lf ", temp ) ;
normal_message ( msg ) ;
for (iter=0 ; iter<niters ; iter++) { // Iters per temp loop
if ((n_bad >= 10) &&
((double) n_good / (double) (n_good+n_bad) < 0.15))
break ;
perturb ( avgnet , this , temp ,
reg , density ) ; // Randomly perturb about center
if (use_grad) // Bias per gradient?
weight_used = shift ( grad , this , grad_weight , reg ) ;
if (reg) { // If using regression, estimate
fval = regress ( tptr , sptr ) ; // out weights now
if ((user_quit = user_pressed_escape ()) != 0)
break ;
if (fval >= avg_func) { // If this would raise mean
++n_bad ; // Count this bad point for user
continue ; // Skip it and try again
}
}
if (use_grad) // Need gradient, fval redundant
fval = gradient ( tptr , work1 , work2 , grad ) ;
else if (! reg) // If reg we got fval from regress
fval = trial_error ( tptr ) ;
if ((user_quit = user_pressed_escape ()) != 0)
break ;
if (fval >= avg_func) { // If this would raise mean
++n_bad ; // Count this bad point for user
continue ; // Skip it and try again
}
++n_good ;
if (fval < bestfval) { // If this iteration improved
bestfval = fval ; // then update the best so far
copy_weights ( bestnet , this ) ; // Keep the network
if (bestfval <= fquit) // If we reached the user's
break ; // limit, we can quit
iter -= setback ; // It often pays to keep going
if (iter < 0) // at this temperature if we
iter = 0 ; // are still improving
}
adjust ( avgnet , this , reg , new_fac ) ; // Move center slightly
avg_func = new_fac * fval + (1.0 - new_fac) * avg_func ;
if (use_grad) {
grad_weight = new_fac * weight_used + (1.0 - new_fac) * grad_weight ;
for (i=0 ; i<n_grad ; i++) // Adjust mean gradient
avg_grad[i] = new_fac * grad[i] + (1.0 - new_fac) * avg_grad[i] ;
}
} // Loop: for all iters at a temp
/*
Iters within temp loop now complete
*/
sprintf ( msg , " %.3lf%% improved avg=%.5lf best=%.5lf",
100.0 * n_good / (double) (n_good+n_bad), avg_func, bestfval ) ;
progress_message ( msg ) ;
if (use_grad) {
gradlen = 0.0 ; // Will cumulate grad length
for (i=0 ; i<n_grad ; i++) // Find gradient length
gradlen += avg_grad[i] * avg_grad[i] ;
gradlen = sqrt ( gradlen ) ;
sprintf ( msg , " grad=%.5lf", gradlen ) ;
progress_message ( msg ) ;
}
if (bestfval <= fquit) // If we reached the user's
break ; // limit, we can quit
if (user_quit)
break ;
temp *= tempmult ; // Reduce temp for next pass
} // through this temperature loop
/*
The trials left this weight set and neterr in random condition.
Make them equal to the best, which will be the original
if we never improved.
*/
FINISH:
copy_weights ( this , bestnet ) ; // Return best weights in this net
neterr = bestfval ; // Trials destroyed weights, err
if (reg) {
MEMTEXT ( "SSG: delete SingularValueDecomp" ) ;
delete sptr ;
}
if (user_quit)
return 1 ;
else
return 0 ;
}
int net_conf (
int n_inputs , // Number of input variables
int npred , // Number of future predictions
Network *net , // Use this network
MiscParams *misc , // Mainly for signal names
int n_inputs_outputs , // Length of next array
InputOutput **in_out , // Input/output signal list
int nsigs , // Number of signals currently existing
Signal **signals , // This is them
int n_conf_comps , // Length of next array
ConfComp *conf_comps , // Confidence compensations
double *excess , // Returns 5% excess tail area
double *toler // Returns double tail area tolerance
)
{
int i, j, k, ivar, nvars, casenum, lag, lead, maxlag, maxlead, minlead ;
int startpos, ncases, shortest, offset, user_quit, endcase ;
double **outputs, **inlist, *in_vector, *inptr ;
char msg[84] ;
Signal *sigptr ;
InputOutput *ioptr ;
NPconf *npconf ;
/*
The number of cases that go into this process is such that no extensions
past the start or end are needed (except as they naturally occur in
partially recursive prediction). Compute the number of fully valid
cases that can be used for this test. See Figure 8.2 for an illustration
of how this formula is derived. The first fully valid test case is
offset from the start by maxlag+maxlead.
These limits are computed in three steps. The INPUT LIST determines
the max lag and the shortest signal. The NAMES list also determines
the shortest signal. The network determines the min and max lags.
For each starting position, we will work with npred predicted outputs.
These have a dual use. They are initialized to the true values so that
they are the reference for errors. Then the true values are replaced
by the predictions for recursive use as inputs.
*/
maxlag = maxlead = 0 ;
shortest = minlead = MAXPOSNUM ;
for (i=0 ; i<n_inputs_outputs ; i++) { // Pass through all inputs/outputs
ioptr = in_out[i] ;
if (! ioptr->is_input) // Outputs are ignored
continue ;
sigptr = signals[ioptr->which] ;
if (sigptr->n < shortest) // Find the shortest signal length
shortest = sigptr->n ;
if (ioptr->maxlag > maxlag)
maxlag = ioptr->maxlag ;
}
for (j=0 ; j<net->n_outputs ; j++) {
lead = net->leads[j] ; // Lead was recorded when trained
if (lead > maxlead) // Find the max output lead
maxlead = lead ;
if (lead < minlead) // And the min
minlead = lead ;
}
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
for (i=0 ; i<nsigs ; i++) { // Find this signal
sigptr = signals[i] ;
if (! strcmp ( misc->names->start[j] , sigptr->name )) {
if (sigptr->n < shortest) // Find the shortest signal length
shortest = sigptr->n ;
break ;
}
}
}
offset = maxlag + maxlead ; // First fully valid test is here
ncases = shortest - offset - npred + 1 ; // Number of fully valid tests
nvars = misc->names->nreal ; // This many signals predicted
if ((ncases < 20) || ((int) (0.5 * (1.0 - misc->conf_prob) * ncases) < 1))
return 2 ;
npconf = new NPconf ( nvars , npred , ncases , misc->conf_prob ,
n_conf_comps , conf_comps ) ;
if ((npconf == NULL) || ! npconf->ok) {
if (npconf != NULL)
delete npconf ;
return -1 ;
}
/*
Initialize the NPconf object by telling it which signals correspond to
which outputs.
*/
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
for (i=0 ; i<nsigs ; i++) { // Find this signal
sigptr = signals[i] ;
if (! strcmp ( misc->names->start[j] , sigptr->name )) {
if (npconf->sig_init ( ivar , i , sigptr )) { // Init NPconf object
delete npconf ;
return -1 ;
}
break ;
}
}
++ivar ; // Keep track of output location
}
/*
This array will be used to flag input sources. In the case that a
signal is an input only, its entry will be NULL. But if the user
is using an input as an output also, the output pointer will go here.
*/
MEMTEXT ( "NET_CONF: inlist, in_vector, outputs" ) ;
inlist = (double **) MALLOC ( n_inputs_outputs * sizeof(double*) ) ;
if (inlist == NULL) {
delete npconf ;
return -1 ;
}
/*
This is used for the network's input vector
*/
in_vector = (double *) MALLOC ( n_inputs * sizeof(double) ) ;
if (in_vector == NULL) {
FREE ( inlist ) ;
delete npconf ;
return -1 ;
}
/*
Allocate memory for the signals that will be predicted.
For each startpos, we keep npred predictions.
*/
outputs = (double **) MALLOC ( nvars * sizeof(double *) ) ;
if (outputs == NULL) {
FREE ( inlist ) ;
FREE ( in_vector ) ;
delete npconf ;
return -1 ;
}
for (i=0 ; i<nvars ; i++) { // For each predicted signal
outputs[i] = (double *) MALLOC ( npred * sizeof(double) ) ;
if (outputs[i] == NULL) {
for (j=0 ; j<i ; j++)
FREE ( outputs[j] ) ;
FREE ( outputs ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
delete npconf ;
return -1 ;
}
}
/*
We often want to predict (recursively) signals that also serve as input.
This necessitates a little preparation. Run through the input signals.
For each that is also an output, flag that fact by storing its output
pointer. Otherwise store a NULL as a flag to get the actual signal.
*/
for (i=0 ; i<n_inputs_outputs ; i++) { // Check all inputs
inlist[i] = NULL ; // Assume this is not recursive
ioptr = in_out[i] ; // All of these should be inputs
if (! ioptr->is_input) // If this is an output list entry
continue ; // Ignore it, as it is meaningless
sigptr = signals[ioptr->which] ; // This is the input signal
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
if (! strcmp ( misc->names->start[j] , sigptr->name )) { // This one?
inlist[i] = outputs[ivar] ; // This input is here among outputs
break ; // So flag its recusive nature
} // No need to keep looking
++ivar ; // Keep track of output location
}
}
/*
This is the main outer loop.
Each 'outputs' vector (npred long) starts at 'startpos'.
For each new starting position, the first step is to set the recursive
output vectors to their true values. As the predictions are done, these
will be the reference for keeping track of the errors. Also, the true
values will be overwritten with the predicted values for subsequent
recursive use as inputs. It is assumed that correct values are known
up to (but not including) startpos. Everything from startpos onward
is a prediction.
*/
make_progress_window ( "Network confidence" ) ;
user_quit = 0 ;
for (startpos=offset ; startpos<ncases+offset ; startpos++) {
if (! ((startpos-offset) % (1 + ncases / 10))) {
sprintf ( msg , "%.2lf percent complete",
100.0 * (startpos-offset) / ncases ) ;
write_non_progress ( msg ) ;
}
#if DEBUG
printf ( "\n\nSTARTPOS=%d", startpos ) ;
#endif
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
for (i=0 ; i<nsigs ; i++) { // Find this signal so we can
sigptr = signals[i] ; // Copy it into output vector
if (! strcmp ( misc->names->start[j] , sigptr->name )) {
#if DEBUG
printf ( " (%s=%d)", sigptr->name, ivar ) ;
#endif
memcpy ( outputs[ivar] , sigptr->sig+startpos ,
npred * sizeof(double) ) ;
break ; // We copy npred cases starting
} // at startpos, the first
} // 'unknown' output
++ivar ; // Keep track of output location
}
/*
We are ready to do the predictions. Everything before startpos is known.
Start predicting at startpos-maxlead so we bag the longest lead.
Go as far as we need to get the last of the npred predictions for the
signal with the shortest lead.
*/
endcase = startpos + npred - minlead ;
for (casenum=startpos-maxlead ; casenum<endcase ; casenum++) { // Predicts
#if DEBUG
printf ( "\ncasenum=%d", casenum ) ;
#endif
inptr = in_vector ; // Will build input vector here
for (i=0 ; i<n_inputs_outputs ; i++) { // Pass through all inputs
ioptr = in_out[i] ; // Signal and lags here
if (! ioptr->is_input) // If this is not an input
continue ; // Skip it (irrelevant)
for (lag=ioptr->minlag ; lag<=ioptr->maxlag ; lag++) {
k = casenum - lag ; // This ordinal case
if (k < startpos) // If still in known cases
*inptr++ = (signals[ioptr->which])->sig[k] ; // Use true value
else if (inlist[i] != NULL) // Beyond. If recursive
*inptr++ = (inlist[i])[k-startpos] ; // Use this prediction
else // Rare. Dup final point.
*inptr++ = (signals[ioptr->which])->sig[startpos-1] ;
#if DEBUG
if (k < startpos) // If still in known cases
printf ( " in%d=%.3lf", k, (signals[ioptr->which])->sig[k] ) ;
else if (inlist[i] != NULL) // Beyond. If recursive
printf ( " rec%d=%.3lf", k, (inlist[i])[k-startpos] ) ;
else // Rare. Dup final point.
printf ( " dup%d=%.3lf", k, (signals[ioptr->which])->sig[startpos-1] ) ;
#endif
}
}
net->trial ( in_vector ) ; // Evaluate network for input
#if DEBUG > 1
printf ( "\nIN: " ) ;
for (i=0 ; i<net->n_inputs ; i++)
printf ( " %lf", in_vector[i] ) ;
printf ( "\nOT: " ) ;
for (i=0 ; i<net->n_outputs ; i++)
printf ( " %lf", net->out[i] ) ;
#endif
ivar = 0 ; // Locates this signal in outputs
for (j=0 ; j<misc->names->n ; j++) { // Check every output name
if (! misc->names->len[j]) // Some may be NULL
continue ; // Obviously skip them
if (j >= net->n_outputs) // Careless user may give too
break ; // many names, so check
lead = net->leads[j] ; // Lead was recorded when trained
k = casenum - startpos + lead ; // It goes in this time slot
#if DEBUG
printf ( " k=%d", k ) ;
#endif
if ((k >= 0) && (k < npred)) { // In the window of npred tests?
#if DEBUG
printf ( " (%.4lf %.4lf)", (outputs[ivar])[k], net->out[j] ) ;
#endif
npconf->insert ( ivar , k , (outputs[ivar])[k] , net->out[j] ) ;
(outputs[ivar])[k] = net->out[j] ; // Keep this prediction
}
++ivar ;
} // For all outputs
if (user_pressed_escape ()) {
user_quit = 1 ;
break ;
}
} // For all npred cases
npconf->eval ( startpos , offset ) ;
if (user_quit)
break ;
} // For all startpos starting positions
if (user_quit)
*excess = *toler = 0.0 ;
else
npconf->conf ( excess , toler ) ;
destroy_progress_window () ;
MEMTEXT ( "NET_CONF: outputs, inlist, in_vector, free npconf" ) ;
for (i=0 ; i<nvars ; i++)
FREE ( outputs[i] ) ;
FREE ( outputs ) ;
FREE ( inlist ) ;
FREE ( in_vector ) ;
delete npconf ;
return user_quit ;
}
int glob_min (
double low , // Lower limit for search
double high , // Upper limit
int npts , // Number of points to try
int log_space , // Space by log?
double critlim , // Quit global if crit drops this low
int (*criter) (double , double *) , // Criterion function
double *x1 ,
double *y1 , // Lower X value and function there
double *x2 ,
double *y2 , // Middle (best)
double *x3 ,
double *y3 // And upper
)
{
int i, ibest, turned_up, know_first_point, user_quit ;
double x, y, rate, previous ;
user_quit = 0 ;
if (npts < 0) {
npts = -npts ;
know_first_point = 1 ;
}
else
know_first_point = 0 ;
if (log_space)
rate = exp ( log (high / low) / (npts - 1) ) ;
else
rate = (high - low) / (npts - 1) ;
x = low ;
previous = 0.0 ; // Avoids "use before set" compiler warnings
ibest = -1 ; // For proper critlim escape
turned_up = 0 ; // Must know if function increased after min
for (i=0 ; i<npts ; i++) {
if (i || ! know_first_point)
user_quit = criter ( x , &y ) ;
else
y = *y2 ;
if ((i == 0) || (y < *y2)) { // Keep track of best here
ibest = i ;
*x2 = x ;
*y2 = y ;
*y1 = previous ; // Function value to its left
turned_up = 0 ; // Flag that min is not yet bounded
}
else if (i == (ibest+1)) { // Didn't improve so this point may
*y3 = y ; // be the right neighbor of the best
turned_up = 1 ; // Flag that min is bounded
}
previous = y ; // Keep track for left neighbor of best
if (! user_quit)
user_quit = user_pressed_escape () ;
if ((user_quit || (*y2 <= critlim)) && (ibest > 0) && turned_up)
break ; // Done if (abort or good enough) and both neighbors found
if (user_quit) // Alas, both neighbors not found
return user_quit ; // Flag that the other 2 pts not there
if (log_space)
x *= rate ;
else
x += rate ;
}
/*
At this point we have a minimum (within low,high) at (x2,y2).
Compute x1 and x3, its neighbors.
We already know y1 and y3 (unless the minimum is at an endpoint!).
*/
if (log_space) {
*x1 = *x2 / rate ;
*x3 = *x2 * rate ;
}
else {
*x1 = *x2 - rate ;
*x3 = *x2 + rate ;
}
/*
Normally we would now be done. However, the careless user may have
given us a bad x range (low,high) for the global search.
If the function was still decreasing at an endpoint, bail out the
user by continuing the search.
*/
if (! turned_up) { // Must extend to the right (larger x)
for (;;) { // Endless loop goes as long as necessary
user_quit = user_pressed_escape () ;
if (! user_quit)
user_quit = criter ( *x3 , y3 ) ;
if (user_quit) // Alas, both neighbors not found
return user_quit ; // Flag that the other 2 pts not there
if (*y3 > *y2) // If function increased we are done
break ;
if ((*y1 == *y2) && (*y2 == *y3)) // Give up if flat
break ;
*x1 = *x2 ; // Shift all points
*y1 = *y2 ;
*x2 = *x3 ;
*y2 = *y3 ;
rate *= 3.0 ; // Step further each time
if (log_space) // And advance to new frontier
*x3 *= rate ;
else
*x3 += rate ;
}
}
else if (ibest == 0) { // Must extend to the left (smaller x)
for (;;) { // Endless loop goes as long as necessary
user_quit = user_pressed_escape () ;
if (! user_quit)
user_quit = criter ( *x1 , y1 ) ;
if (user_quit) // Alas, both neighbors not found
return user_quit ; // Flag that the other 2 pts not there
if (*y1 > *y2) // If function increased we are done
break ;
if ((*y1 == *y2) && (*y2 == *y3)) // Give up if flat
break ;
*x3 = *x2 ; // Shift all points
*y3 = *y2 ;
*x2 = *x1 ;
*y2 = *y1 ;
rate *= 3.0 ; // Step further each time
if (log_space) // And advance to new frontier
*x1 /= rate ;
else
*x1 -= rate ;
}
}
return 0 ;
}
