/*****************************************************************************
FILE : $Source: /projects/higgs1/SNNS/CVS/SNNS/tools/sources/ic_snns.c,v $
SHORTNAME : ic_snns
SNNS VERSION : 4.2
PURPOSE : Intermediate Code (IC) functions for the SNNS batch
interpreter:
function calls to the SNNS-Kernel function interface
NOTES : Abbreviations: ST: symbol table
IC: intermediate code
AUTHOR : Jens Wieland
DATE :
CHANGED BY :
RCS VERSION : $Revision: 1.30 $
LAST CHANGE : $Date: 1998/07/08 11:13:57 $
Copyright (c) 1990-1995 SNNS Group, IPVR, Univ. Stuttgart, FRG
Copyright (c) 1996-1998 SNNS Group, WSI, Univ. Tuebingen, FRG
******************************************************************************/
#include <config.h>
/* Pointers to the IC SNNS functions defined below are inserted in the
IC Table and executed during intermediate code interpretation (run())
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h> /* for unlink() */
#endif
#include <time.h>
#include "symtab.h" /* for arglist_type */
#include "glob_typ.h" /* SNNS-Kernel: Global Datatypes and Constants */
#include "ext_typ.h" /* SNNS MasPar Kernel: Datatypes and Constants for
Internal Usage (for FUNCTION_NAME_MAX_LEN) */
#include "cc_mac.h" /* macros for cascade correlation */
#include "ic_snns.ph"
#include "batchman.h" /* for file pointer to log file */
#include "ictab.h" /* File required by following includefile */
#include "error.h" /* errors and warnings */
#include "kr_ui.h" /* SNNS-Kernel: User Interface Function Prototypes */
#include "kr_typ.h" /* SNNS-Kernel: Datatypes and Constants for Internal
Usage. File required by following includefile */
#include "kr_newpattern.h" /* SNNS-Kernel: new pattern handling functions */
#include "prun_f.h" /* SNNS-Kernel: pruning functions and constants */
/*****************************************************************************
Functions for pattern table handling
Purpose: enable xgui-lookalike patternset handling
******************************************************************************/
/*****************************************************************************
FUNCTION : enter_patName
PURPOSE : enters pattern name (as ST pointer) in the pattern table
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void enter_patName(St_ptr_type name)
{
pat_tab[pat_sets_loaded++] = name;
}
/*****************************************************************************
FUNCTION : lookup_patName
PURPOSE : looks up the filename of a pattern in the pattern table
RETURNS : SNNS patset number, -1 if not found
NOTES :
UPDATE :
******************************************************************************/
int lookup_patName(St_ptr_type pat)
{
Val_type val, tmp_val;
Data_type type;
int i;
/* search for pattern name in patterntable: */
for (i=0; i<pat_sets_loaded; i++)
{
/* compare name searched with pattern table entries: */
st_get_val_type(pat, &type, &val);
st_get_val_type(pat_tab[i], &type, &tmp_val);
if (strcmp(val.string_val, tmp_val.string_val) == 0)
return i;
}
err_prt("Pattern file not yet loaded");
return -1;
}
/*****************************************************************************
FUNCTION : lookup_patNumber
PURPOSE : looks up the SNNS pattern number of a pattern in the
pattern table
RETURNS : ST entry of pattern name
NOTES :
UPDATE :
******************************************************************************/
St_ptr_type lookup_patNumber(int pat)
{
return pat_tab[pat];
}
/*****************************************************************************
FUNCTION : del_patName
PURPOSE : deletes a pattern set entry from the pattern table
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void del_patName(int pat_no)
{
int i;
for (i=pat_no; i<NO_OF_PAT_SETS - 1; i++)
pat_tab[i] = pat_tab[i+1];
if (curr_patSet == pat_no)
curr_patSet = 0;
else
if (curr_patSet > pat_no)
curr_patSet--;
pat_sets_loaded--;
}
/*****************************************************************************
other internal functions
******************************************************************************/
/*****************************************************************************
FUNCTION : print_parameters
PURPOSE : prints number elements from array to the logfile
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void print_parameters(const float *array, int number)
{
int j;
if (!number) return;
fprintf(log_file, "# Parameters are: ");
for (j=0; j<number; j++) fprintf(log_file, "%g ", array[j]);
fprintf(log_file, "\n");
fflush(log_file);
}
/*****************************************************************************
FUNCTION : defSubpattern
PURPOSE : defines subpattern shifting scheme
writes the 4 subpattern parameter arrays in the kernel
arrays are initialized if not previously set by the
user with the setSubPattern() function
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void defSubpattern(void)
{
krui_err kr_err;
int i;
/* initialize the 4 subpattern parameter arrays, if not already done: */
if(! init_subPat_flag)
{
for(i=0; i<MAX_NO_OF_VAR_DIM; i++)
{
spIsize[i] = 0; spIstep[i] = 0;
spOsize[i] = 0; spOstep[i] = 0;
}
init_subPat_flag = TRUE;
}
kr_err = krui_DefTrainSubPat(spIsize, spOsize, spIstep, spOstep, NULL);
kernel_error(kr_err);
}
/*****************************************************************************
FUNCTION : trainFFNet
PURPOSE : trains a net using a subordinate learning function
RETURNS : summed squared error
NOTES : function taken from snnsbat.c with minor changes
UPDATE :
******************************************************************************/
float trainFFNet(int cycles)
{
krui_err kr_err;
float *return_values;
int NoOfOutParams;
int cycle = 0;
defSubpattern();
while ((cycle < cycles) &&
((cycle && (return_values [0] > min_error_to_stop)) || !cycle))
{
kr_err = krui_learnAllPatternsFF(learn_param_array, noOfLearnInP,
&return_values, &NoOfOutParams);
kernel_error(kr_err);
cycle++;
}
return (return_values[0]);
}
/*****************************************************************************
Functions that can be called from the user program
'arguments' refers to function arguments in the user program,
here pointed to by the argument pointer list
******************************************************************************/
/*****************************************************************************
FUNCTION : setInitFunc
PURPOSE : sets the initialization function and its parameters,
if arguments are supplied
RETURNS :
NOTES : init function name is mandatory
UPDATE :
******************************************************************************/
void setInitFunc(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
if (arglist == ARG_NULL)
err_prt(ERR_ALOAE);
/* get first parameter, should be an valid init function name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, INIT_FUNC))
err_prt("Unknown init function name");
strcpy(init_fct, val.string_val);
/* advance argument list pointer: */
arglist = arglist->next;
/* initialize init parameter array: */
for(i=0; i<NO_OF_INIT_PARAMS; i++) {
if(i == 0)
init_param_array[i] = 1.0;
else if(i == 1)
init_param_array[i] = -1.0;
else
init_param_array[i] = 0.0;
}
/* overwrite parameter array with supplied parameters: */
i = 0;
while ( (i < NO_OF_INIT_PARAMS) && arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
init_param_array[i] = val.real_val;
else if(type == INT)
init_param_array[i] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
arglist = arglist->next;
i++;
}
/* set number of actual init parameters: */
noOfInitParams = i;
kr_err = krui_setInitialisationFunc(init_fct);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file, "# Init function is now %s\n", init_fct);
print_parameters(init_param_array, noOfInitParams);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
/* to enable to warn the user, set an init flag: */
init_net_flag = TRUE;
}
/*****************************************************************************
FUNCTION : setLearnFunc
PURPOSE : sets the learning function and its parameters,
if arguments are supplied
RETURNS :
NOTES : learning function name is mandatory
UPDATE :
******************************************************************************/
void setLearnFunc(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
if (arglist == ARG_NULL)
err_prt(ERR_ALOAE);
/* get first parameter, should be a learning function name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, LEARN_FUNC))
err_prt("Unknown learning function name");
strcpy(learn_fct, val.string_val);
/* advance argument list pointer: */
arglist = arglist->next;
/* initialize learn parameter array: */
learn_param_array[0] = 0.2;
for(i=1; i<NO_OF_LEARN_PARAMS; i++) learn_param_array[i] = 0.0;
/* overwrite parameter array with supplied parameters: */
i = 0;
while ((i<NO_OF_LEARN_PARAMS) && arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
learn_param_array[i] = val.real_val;
else if(type == INT)
learn_param_array[i] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
arglist = arglist->next;
i++;
}
/* set number of actual learn parameters; at least 1: */
noOfLearnInP = (i==0) ? 1 : i;
kr_err = krui_setLearnFunc(learn_fct);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Learning function is now %s\n", learn_fct);
print_parameters(learn_param_array, noOfLearnInP);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
/* the learn_param_array[] should be initialized at least once
before calling the trainNet-function;
remember here that this is now done: */
init_learn_flag = TRUE;
}
/*****************************************************************************
FUNCTION : setUpdateFunc
PURPOSE : sets the update function and its parameters,
if arguments are supplied
RETURNS :
NOTES : update function name is mandatory
UPDATE :
******************************************************************************/
void setUpdateFunc(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
if (arglist == ARG_NULL)
err_prt(ERR_ALOAE);
/* get first parameter, should be an update function name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, UPDATE_FUNC))
err_prt("Unknown update function name");
strcpy(update_fct, val.string_val);
/* advance argument list pointer: */
arglist = arglist->next;
/* initialize update parameter array: */
for(i=0; i<NO_OF_UPDATE_PARAMS; i++) update_param_array[i] = 0.0;
/* overwrite parameter array with supplied parameters: */
i = 0;
while ((i < NO_OF_UPDATE_PARAMS) && arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
update_param_array[i] = val.real_val;
else if(type == INT)
update_param_array[i] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
arglist = arglist->next;
i++;
}
/* set number of actual update parameters: */
noOfUpdateParam = i;
kr_err = krui_setUpdateFunc(update_fct);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Update function is now %s\n", update_fct);
print_parameters(update_param_array, noOfUpdateParam);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
/* remember, update_param_array is now initialized: */
init_update_flag = TRUE;
}
/*****************************************************************************
FUNCTION : setPruningFunc
PURPOSE : sets the pruning functions and their parameters,
if arguments are supplied
RETURNS :
NOTES : pruning and subordinate learning function names are mandatory
UPDATE :
******************************************************************************/
void setPruningFunc(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
/* initialize pruning parameters: */
max_error_incr = pr_maxErrorInc,
accepted_error = pr_acceptedError,
/* min_error_to_stop = pr_minError,*/
init_matrix_value = pr_obs_initParameter;
first_train_cyc = pr_trainCycles,
retrain_cyc = pr_retrainCycles;
recreate = pr_recreate,
input_pruning = pr_inputPruning,
hidden_pruning = pr_hiddenPruning;
/* get mandatory parameter: pruning function */
if (arglist == ARG_NULL)
err_prt("Missing pruning function name");
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, PRUNING_FUNC))
err_prt("Unknown pruning function name");
strcpy(pruning_fct, val.string_val);
arglist = arglist->next;
kr_err = krui_setPrunFunc(pruning_fct);
kernel_error(kr_err);
/* get mandatory parameter: subordinate learning function */
if (arglist == ARG_NULL)
err_prt("Missing subordinate learning function name");
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, LEARN_FUNC))
err_prt("Unknown learning function name");
strcpy(sublearn_fct, val.string_val);
arglist = arglist->next;
kr_err = krui_setFFLearnFunc(sublearn_fct);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file, "# Pruning function is now %s\n", pruning_fct);
fprintf(log_file, "# Subordinate learning function is now %s\n",
sublearn_fct);
if (arglist != ARG_NULL) fprintf(log_file, "# Parameters are: ");
fflush(log_file);
}
/* get further parameters, if supplied, and overwrite the
corresponding defaults: */
/* get parameter: maximum error increase */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
max_error_incr = val.real_val;
else if(type == INT)
max_error_incr = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", max_error_incr);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: accepted error */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
accepted_error = val.real_val;
else if(type == INT)
accepted_error = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", accepted_error);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: recreate flag */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
recreate = val.bool_val;
if(!message_flag) {
fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: first train cycles */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
first_train_cyc = val.int_val;
else if(type == REAL)
first_train_cyc = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", first_train_cyc);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: retrain cycles */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
retrain_cyc = val.int_val;
else if(type == REAL)
retrain_cyc = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", retrain_cyc);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: min error to stop*/
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
min_error_to_stop = val.real_val;
else if(type == INT)
min_error_to_stop = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", min_error_to_stop);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: matrix init value */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
init_matrix_value = val.real_val;
else if(type == INT)
init_matrix_value = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", init_matrix_value);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: input pruning flag */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
input_pruning = val.bool_val;
if(!message_flag) {
fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: hidden pruning flag */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
hidden_pruning = val.bool_val;
if(!message_flag) {
fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
fflush(log_file);
}
arglist = arglist->next;
}
if (!message_flag)
{
fprintf(log_file, "\n");
fflush(log_file);
}
/* update pruning parameters (may have been changed): */
pr_obs_setInitParameter((double)init_matrix_value);
pr_setInputPruning((int)input_pruning);
pr_setHiddenPruning((int)hidden_pruning);
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : setRemapFunc
PURPOSE : sets the pattern remapping function and its parameters,
if arguments are supplied
RETURNS :
NOTES : remap function name is mandatory
UPDATE :
******************************************************************************/
void setRemapFunc(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
if (arglist == ARG_NULL)
err_prt(ERR_ALOAE);
/* get first parameter, should be an remap function name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (! krui_isFunction(val.string_val, REMAP_FUNC))
err_prt("Unknown remap function name");
strcpy(remap_fct, val.string_val);
/* advance argument list pointer: */
arglist = arglist->next;
/* initialize remap parameter array: */
for(i=0; i<NO_OF_REMAP_PARAMS; i++) remap_param_array[i] = 0.0;
/* overwrite parameter array with supplied parameters: */
i = 0;
while ((i < NO_OF_REMAP_PARAMS) && arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
remap_param_array[i] = val.real_val;
else if(type == INT)
remap_param_array[i] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
arglist = arglist->next;
i++;
}
/* set number of actual remap parameters: */
noOfRemapParam = i;
kr_err = krui_setRemapFunc(remap_fct,remap_param_array);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Remap function is now %s\n", remap_fct);
print_parameters(remap_param_array, noOfRemapParam);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
/* remember, remap_param_array is now initialized: */
init_remap_flag = TRUE;
}
/*****************************************************************************
FUNCTION : setSubPattern
PURPOSE : sets the subpattern handling parameters
RETURNS :
NOTES : kernel call is performed in defSubpattern()
UPDATE :
******************************************************************************/
void setSubPattern(arglist_type *arglist)
{
Val_type val;
Data_type type;
int i;
if (arglist == ARG_NULL)
err_prt("At least four arguments expected");
/* initialize the 4 subpattern parameter arrays: */
for(i=0; i<MAX_NO_OF_VAR_DIM; i++)
{
spIsize[i] = 0; spIstep[i] = 0;
spOsize[i] = 0; spOstep[i] = 0;
}
if(!message_flag)
{
fprintf(log_file, "# Subpattern shifting scheme (re)defined\n");
fprintf(log_file, "# Parameters are: ");
fflush(log_file);
}
/* overwrite parameter arrays with supplied parameters: */
i = 0;
while ( (i < MAX_NO_OF_VAR_DIM) && arglist != ARG_NULL)
{
/* get subpatternIsize: */
if (arglist == ARG_NULL) /* no more arguments in list? */
err_prt(ERR_NOAMM); /* print an error */
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
spIsize[i] = val.int_val;
else if(type == REAL)
spIsize[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", spIsize[i]);
fflush(log_file);
}
arglist = arglist->next; /* advance argument list pointer */
/* get subpatternIstep: */
if (arglist == ARG_NULL)
err_prt(ERR_NOAMM);
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
spIstep[i] = val.int_val;
else if(type == REAL)
spIstep[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", spIstep[i]);
fflush(log_file);
}
arglist = arglist->next;
/* get subpatternOsize: */
if (arglist == ARG_NULL)
err_prt(ERR_NOAMM);
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
spOsize[i] = val.int_val;
else if(type == REAL)
spOsize[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", spOsize[i]);
fflush(log_file);
}
arglist = arglist->next;
/* and, last not least, get subpatternOstep: */
if (arglist == ARG_NULL)
err_prt(ERR_NOAMM);
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
spOstep[i] = val.int_val;
else if(type == REAL)
spOstep[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", spOstep[i]);
fflush(log_file);
}
arglist = arglist->next;
i++;
/* oops, so far so good; but this was only one dimension! */
}
if (arglist != ARG_NULL)
err_prt(ERR_NOAMM);
/* notify defSubpattern() that the user program has set the params: */
init_subPat_flag = TRUE;
/* kernel call is performed in defSubpattern() */
if(!message_flag)
{
fprintf(log_file, "\n");
fflush(log_file);
}
}
/*****************************************************************************
FUNCTION : setShuffle
PURPOSE : sets the pattern shuffling mode for ordinary patterns
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void setShuffle(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt(ERR_ATOFE);
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
kr_err = krui_shufflePatterns((bool)val.bool_val);
/* formal type cast; SNNS and Batchman boolean types are compatible */
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Pattern shuffling %sabled\n",
(val.bool_val) ? "en" : "dis");
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : setSubShuffle
PURPOSE : sets the pattern shuffling mode for subpatterns
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void setSubShuffle(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt(ERR_ATOFE);
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
kr_err = krui_shuffleSubPatterns((bool)val.bool_val);
/* formal type cast; SNNS and Batchman boolean types are compatible */
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Subpattern shuffling %sabled\n",
(val.bool_val) ? "en" : "dis");
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : setClassDistrib
PURPOSE : sets the distribution of the classes in the pattern file
to the values given as parameters.
RETURNS :
NOTES : first parameter (bool) switches redistribution on or off
Also sets the value of PAT
UPDATE :
******************************************************************************/
void setClassDistrib(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i,j;
bool onOff;
pattern_set_info patt_info;
pattern_descriptor descrip;
char s_onOff[5];
float *outarray;
if (arglist == ARG_NULL)
err_prt(ERR_ALOAE);
/* get first parameter*/
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
onOff = (bool)val.bool_val;
kr_err = krui_useClassDistribution(onOff);
kernel_error(kr_err);
/* advance argument list pointer: */
arglist = arglist->next;
/* get pattern information */
kr_err = krui_GetPatInfo(&patt_info, &descrip);
kernel_error(kr_err);
/* initialize class distribution array: */
distrib_array = (unsigned int *)realloc(distrib_array,
patt_info.classes*sizeof(unsigned int));
for(i=0; i<patt_info.classes; i++)
distrib_array[i] = *patt_info.class_redistribution++;
/* overwrite distribution with supplied values: */
i = 0;
while ((i < patt_info.classes) && arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
distrib_array[i] = (int) val.real_val;
else if(type == INT)
distrib_array[i] = val.int_val;
else
err_prt("Real or INT value argument expected");
arglist = arglist->next;
i++;
}
kr_err = krui_setClassDistribution(distrib_array);
kernel_error(kr_err);
if(!message_flag)
{
outarray = (float *)malloc(i*sizeof(float));
for(j=0;j<i;j++)outarray[j] = (float)distrib_array[j];
sprintf(s_onOff,"%s",(onOff)?" ON":" OFF");
fprintf(log_file,"# Class distribution is now %s\n", s_onOff);
print_parameters( outarray, i);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
/* update built-in variable: */
val.int_val = krui_getNoOfPatterns();
type = INT;
st_set_val_type(st_lookup("PAT"), type, val);
}
/*****************************************************************************
FUNCTION : setParallelMode
PURPOSE : switches to the parallel kernel if argument is TRUE and back
if argument is FALSE
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void setParallelMode(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt(ERR_ATOFE);
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
kr_err = krui_setSpecialNetworkType(
(val.bool_val==TRUE) ? NET_TYPE_FF1 : NET_TYPE_GENERAL);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Parallel Mode %sabled\n",
(val.bool_val) ? "en" : "dis");
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : setCascadeParams
PURPOSE : sets the parameters of the cascade correlation algorithms
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void setCascadeParams(arglist_type *arglist)
{
Val_type val;
Data_type type;
int i;
/* initialization of learn_param_array: */
/* XGUI Cascade subwindow 'Global Parameters' entries: */
learn_param_array[6] = MAX_PIXEL_ERROR;
learn_param_array[7] = QUICKPROP; /* QUICKPROP = Quickprop
BACKPROP = Backprop
RPROP = Rprop */
learn_param_array[8] = ON;
learn_param_array[17] = OFF;
learn_param_array[20] = SBC; /* SBC AIC CMSEP */
/* XGUI Cascade subwindow 'Candidate Parameters' entries: */
learn_param_array[9] = MIN_COVARIANCE_CHANGE;
learn_param_array[10] = SPECIAL_PATIENCE;
learn_param_array[11] = MAX_NO_OF_COVARIANCE_UPDATE_CYCLES;
learn_param_array[12] = MAX_SPECIAL_UNIT_NO;
learn_param_array[13] = SYM_SIGMOID; /* ASYM_SIGMOID = Act_Logistic
SYM_SIGMOID=Act_LogSym
TANH = Act_TanH
RANDOM = Act_Random */
/* XGUI Cascade subwindow 'Output Parameters' entries: */
learn_param_array[14] = MIN_ERROR_CHANGE;
learn_param_array[15] = OUT_PATIENCE;
learn_param_array[16] = MAX_NO_OF_ERROR_UPDATE_CYCLES;
/* unused: */
learn_param_array[18] = 0;
learn_param_array[19] = 0;
/* reading parameters, if supplied:*/
if ((!message_flag) && (arglist != ARG_NULL))
{
fprintf(log_file, "# Cascade Correlation\n");
fprintf(log_file, "# Parameters are: ");
fflush(log_file);
}
/* XGUI Cascade subwindow 'Global Parameters' entries: */
/* get parameter: max outp. unit error */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
learn_param_array[6] = val.real_val;
else if(type == INT)
learn_param_array[6] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", learn_param_array[6]);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: learning function */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (strcmp(val.string_val, "Quickprop") == 0)
learn_param_array[7] = QUICKPROP;
else
if (strcmp(val.string_val, "Backprop") == 0)
learn_param_array[7] = BACKPROP;
else
if (strcmp(val.string_val, "Rprop") == 0)
learn_param_array[7] = RPROP;
else
err_prt("Invalid learning function name");
if(!message_flag) {
fprintf(log_file, "%s ", val.string_val);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: print covar. and error */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
learn_param_array[8] = (val.bool_val) ? ON : OFF;
if(!message_flag) {
fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: prune new hidden unit */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
learn_param_array[17] = (val.bool_val) ? ON : OFF;
if(!message_flag) {
fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: minimize */ /* SBC AIC CMSEP */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (strcmp(val.string_val, "SBC") == 0)
learn_param_array[20] = SBC;
else
if (strcmp(val.string_val, "AIC") == 0)
learn_param_array[20] = AIC;
else
if (strcmp(val.string_val, "CMSEP") == 0)
learn_param_array[20] = CMSEP;
else
err_prt("Invalid minimization function name");
if(!message_flag) {
fprintf(log_file, "%s ", val.string_val);
fflush(log_file);
}
arglist = arglist->next;
}
/* XGUI Cascade subwindow 'Candidate Parameters' entries: */
/* get parameter: min. covar. change */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
learn_param_array[9] = val.real_val;
else if(type == INT)
learn_param_array[9] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", learn_param_array[9]);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: cand. patience */
/* get parameter: max no of covar. updates */
/* get parameter: max no of candidate units */
for(i=10; i<=12; i++){
if (arglist != ARG_NULL){
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
learn_param_array[i] = val.int_val;
else if(type == REAL)
learn_param_array[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", learn_param_array[i]);
fflush(log_file);
}
arglist = arglist->next;
}
}
/* get parameter: activation function */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (strcmp(val.string_val, "Act_Logistic") == 0)
learn_param_array[13] = ASYM_SIGMOID;
else
if (strcmp(val.string_val, "Act_LogSym") == 0)
learn_param_array[13] = SYM_SIGMOID;
else
if (strcmp(val.string_val, "Act_TanH") == 0)
learn_param_array[13] = TANH;
else
if (strcmp(val.string_val, "Act_Random") == 0)
learn_param_array[13] = RANDOM;
else
err_prt("Invalid activation function name");
if(!message_flag) {
fprintf(log_file, "%s ", val.string_val);
fflush(log_file);
}
arglist = arglist->next;
}
/* XGUI Cascade subwindow 'Output Parameters' entries: */
/* get parameter: error change */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == REAL)
learn_param_array[14] = val.real_val;
else if(type == INT)
learn_param_array[14] = (double)val.int_val;
else
err_prt("Real or INT value argument expected");
if(!message_flag) {
fprintf(log_file, "%g ", learn_param_array[14]);
fflush(log_file);
}
arglist = arglist->next;
}
/* get parameter: output patience */
/* get parameter: max no of epochs */
for(i=15; i<=16; i++){
if (arglist != ARG_NULL){
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
learn_param_array[i] = val.int_val;
else if(type == REAL)
learn_param_array[i] = (int)val.real_val;
else
err_prt("Integer value argument expected");
if(!message_flag) {
fprintf(log_file, "%d ", learn_param_array[i]);
fflush(log_file);
}
arglist = arglist->next;
}
}
if (!message_flag)
{
fprintf(log_file, "\n");
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : initNet
PURPOSE : initializes the network
RETURNS :
NOTES : resets the value of CYCLES
UPDATE :
******************************************************************************/
void initNet(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
if (! init_net_flag)
warn_prt("Init function and params not specified; using defaults");
if (arglist != ARG_NULL)
warn_prt(WRN_NFAE);
/* initialize init parameter array: */
if (! init_net_flag)
{
for(i=0; i<NO_OF_INIT_PARAMS; i++)
{
if(i == 0)
init_param_array[i] = 1.0;
else if(i == 1)
init_param_array[i] = -1.0;
else
init_param_array[i] = 0.0;
}
init_net_flag = TRUE;
}
kr_err = krui_initializeNet(init_param_array, noOfInitParams);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Net initialized\n");
fflush(log_file);
}
/* update built-in variable: */
val.int_val = 0;
type = INT;
st_set_val_type(st_lookup("CYCLES"), type, val);
}
/*****************************************************************************
FUNCTION : resetNet
PURPOSE : resets the network to its initial configuration
RETURNS :
NOTES : resets the value of CYCLES
UPDATE :
******************************************************************************/
void resetNet(arglist_type *arglist)
{
Val_type val;
Data_type type;
krui_resetNet();
if(!message_flag)
{
fprintf(log_file,"# Net has been reset\n");
fflush(log_file);
}
/* update built-in variable: */
val.int_val = 0;
type = INT;
st_set_val_type(st_lookup("CYCLES"), type, val);
}
/*****************************************************************************
FUNCTION : loadNet
PURPOSE : loads a network file
Parameter: network file
RETURNS :
NOTES : resets the value of CYCLES
UPDATE :
******************************************************************************/
void loadNet(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt("Missing network filename");
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
kr_err = krui_loadNet(val.string_val, &netname);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Net %s loaded\n", val.string_val);
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
/* update built-in variable: */
val.int_val = 0;
type = INT;
st_set_val_type(st_lookup("CYCLES"), type, val);
init_net_flag = FALSE; /* maybe the user wants a new init function? */
}
/*****************************************************************************
FUNCTION : saveNet
PURPOSE : saves a network
Parameter: network file name
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void saveNet(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt("Missing network filename");
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
kr_err = krui_saveNet(val.string_val, netname);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Network file %s written\n", val.string_val);
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : saveResult
PURPOSE : saves a result file
1st parameter: result file name
optional parameters: start pattern, end pattern,
include input, include output
file mode: create | append
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void saveResult(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
int i;
char *filename;
bool create = TRUE,
incl_inp = TRUE,
incl_out = FALSE;
int start_pat = 1,
end_pat;
end_pat = krui_getNoOfPatterns();
if (arglist == ARG_NULL)
err_prt("Missing result filename");
/* get parameters: filename */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
filename = val.string_val;
arglist = arglist->next;
/* start- & endpattern numbers: */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
start_pat = val.int_val;
else if(type == REAL)
start_pat = (int)val.real_val;
else
err_prt("Integer value argument expected");
arglist = arglist->next;
}
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
end_pat = val.int_val;
else if(type == REAL)
end_pat = (int)val.real_val;
else
err_prt("Integer value argument expected");
arglist = arglist->next;
}
/* include-input, include-output flags: */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
incl_inp = val.bool_val;
arglist = arglist->next;
}
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(BOOL, type);
incl_out = val.bool_val;
arglist = arglist->next;
}
/* file mode: create | append: */
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if (strcmp(val.string_val, "append") == 0)
create = FALSE;
else
if (strcmp(val.string_val, "create") != 0)
warn_prt
("Either \"create\" or \"append\" as file mode expected; using create");
arglist = arglist->next;
}
/* define subpattern shifting scheme: */
defSubpattern();
/* initialize update parameter array if not already done: */
if (! init_update_flag)
{
for(i=0; i<NO_OF_UPDATE_PARAMS; i++) update_param_array[i] = 0.0;
init_update_flag = TRUE;
}
kr_err = krui_saveResultParam(filename, create,
start_pat, end_pat,
incl_inp, incl_out,
update_param_array,
noOfUpdateParam);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Result file %s written\n", filename);
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : trainNet
PURPOSE : trains the network one cycle with the current patternset
Parameters: none
RETURNS :
NOTES : sets the values of SSE, MSE, SSEPU, CYCLES
UPDATE :
******************************************************************************/
void trainNet(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
float *return_values;
int NoOfOutParams;
int i;
if (arglist != ARG_NULL)
warn_prt(WRN_NFAE);
/* initialize learn parameter array if not already done: */
if (! init_learn_flag)
{
learn_param_array[0] = 0.2;
for(i=1; i<NO_OF_LEARN_PARAMS; i++) learn_param_array[i] = 0.0;
init_learn_flag = TRUE;
}
/* define subpattern shifting scheme: */
defSubpattern();
kr_err =
krui_learnAllPatterns(learn_param_array,
NO_OF_LEARN_PARAMS,
&return_values, &NoOfOutParams);
kernel_error(kr_err);
/* update built-in variables: errors and training cycles*/
val.real_val = return_values[0];
type = REAL;
st_set_val_type(st_lookup("SSE"), type, val);
val.real_val = return_values[0] / krui_getTotalNoOfSubPatterns();
type = REAL;
st_set_val_type(st_lookup("MSE"), type, val);
/* set built-in variable SSEPU only if output units are present: */
if (krui_getNoOfOutputUnits() != 0){
val.real_val = return_values[0] / krui_getNoOfOutputUnits();
type = REAL;
}else
type = UNKNOWN;
st_set_val_type(st_lookup("SSEPU"), type, val);
/* increment the value of CYCLES: */
st_get_val_type(st_lookup("CYCLES"), &type, &val);
val.int_val++;
st_set_val_type(st_lookup("CYCLES"), type, val);
}
/*****************************************************************************
FUNCTION : testNet
PURPOSE : tests the network with the current patternset
Parameters: none
RETURNS :
NOTES : sets the values of SSE, MSE, SSEPU
UPDATE :
******************************************************************************/
void testNet(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
float *return_values;
int NoOfOutParams;
if (arglist != ARG_NULL)
warn_prt(WRN_NFAE);
/* define subpattern shifting scheme: */
defSubpattern();
kr_err =
krui_testAllPatterns(learn_param_array,
NO_OF_LEARN_PARAMS,
&return_values, &NoOfOutParams);
kernel_error(kr_err);
/* update built-in variables: errors and training cycles*/
val.real_val = return_values[0];
type = REAL;
st_set_val_type(st_lookup("SSE"), type, val);
val.real_val = return_values[0] / krui_getTotalNoOfSubPatterns();
type = REAL;
st_set_val_type(st_lookup("MSE"), type, val);
/* set built-in variable SSEPU only if output units are present: */
if (krui_getNoOfOutputUnits() != 0){
val.real_val = return_values[0] / krui_getNoOfOutputUnits();
type = REAL;
}else
type = UNKNOWN;
st_set_val_type(st_lookup("SSEPU"), type, val);
}
/*****************************************************************************
FUNCTION : pruneNet
PURPOSE : prune the net using the pruning parameters
RETURNS :
NOTES : function taken from snnsbat.c with minor changes
UPDATE :
******************************************************************************/
void pruneNet(arglist_type *arglist)
{
krui_err kr_err;
char *tmp_file1;
float first_error,
max_error,
net_error;
first_error = trainFFNet(first_train_cyc);
max_error = first_error * (1 + max_error_incr / 100);
if (max_error < accepted_error) max_error = accepted_error;
if (recreate)
if ((tmp_file1 = tempnam("./", "batch")) == NULL)
err_prt("Cannot create temporary file");
do
{
if (recreate)
{
kr_err = krui_saveNet(tmp_file1, netname);
kernel_error(kr_err);
}
kr_err = pr_callPrunFunc(PR_ALL_PATTERNS);
kernel_error(kr_err);
kr_err = pr_calcMeanDeviation (PR_ALL_PATTERNS, &net_error);
kernel_error(kr_err);
if (net_error > min_error_to_stop)
net_error = trainFFNet(retrain_cyc);
}
while (net_error <= max_error);
if (recreate)
{
krui_loadNet(tmp_file1, &netname);
kernel_error(kr_err);
}
unlink(tmp_file1);
}
/*****************************************************************************
FUNCTION : pruneTrainNet
PURPOSE : pruning: Train one Cycle with pruning-function
RETURNS :
NOTES : function taken pruneNet with minor changes
sets the values of SSE, MSE, SSEPU, CYCLES
UPDATE :
******************************************************************************/
void pruneTrainNet(arglist_type *arglist)
{
Val_type val;
Data_type type;
float net_error;
net_error = trainFFNet(1);
val.real_val = net_error;
type = REAL;
st_set_val_type(st_lookup("SSE"), type, val);
val.real_val = net_error / krui_getNoOfPatterns();
type = REAL;
st_set_val_type(st_lookup("MSE"), type, val);
/* set built-in variable SSEPU only if output units are present: */
if (krui_getNoOfOutputUnits() != 0)
{
val.real_val = net_error / krui_getNoOfOutputUnits();
type = REAL;
}
else
type = UNKNOWN;
st_set_val_type(st_lookup("SSEPU"), type, val);
/* increment the value of CYCLES: */
st_get_val_type(st_lookup("CYCLES"), &type, &val);
val.int_val++;
st_set_val_type(st_lookup("CYCLES"), type, val);
}
/*****************************************************************************
FUNCTION : pruneNetNow
PURPOSE : pruning: prune Net and calc error of new net
RETURNS :
NOTES : function taken pruneNet with minor changes
sets the values of SSE, MSE, SSEPU
UPDATE :
******************************************************************************/
void pruneNetNow(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
float net_error;
kr_err = pr_callPrunFunc(PR_ALL_PATTERNS);
kernel_error(kr_err);
kr_err = pr_calcMeanDeviation (PR_ALL_PATTERNS, &net_error);
kernel_error(kr_err);
val.real_val = net_error;
type = REAL;
st_set_val_type(st_lookup("SSE"), type, val);
val.real_val = net_error / krui_getNoOfPatterns();
type = REAL;
st_set_val_type(st_lookup("MSE"), type, val);
/* set built-in variable SSEPU only if output units are present: */
if (krui_getNoOfOutputUnits() != 0)
{
val.real_val = net_error / krui_getNoOfOutputUnits();
type = REAL;
}
else
type = UNKNOWN;
st_set_val_type(st_lookup("SSEPU"), type, val);
}
/*****************************************************************************
FUNCTION : setActFunc
PURPOSE : sets the Activation Funtion for all Units or Units with
a define type
RETURNS :
NOTES : call: setActFunc(<Type>, <new Activation Funktion Name>)
with: Type=0 for all Units and
Type=1... (see kernel/sources/glob_typ.h section
Topological Unit Types near line 261)
UPDATE : 31.03.1998 by Thomas Rausch
******************************************************************************/
void setActFunc(arglist_type *arglist)
{
Val_type val;
Data_type type;
int i, unit_type;
/* reading parameters: */
/* get parameter 1: Unittype for changing activation function */
if (arglist != ARG_NULL) {
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
unit_type = val.int_val;
else if(type == REAL)
unit_type = (int)val.real_val;
else
err_prt("Integer value argument expected");
arglist = arglist->next;
}
/* get parameter 2: New Activation Function Name */
if (arglist == ARG_NULL) {
err_prt("Not enough parameters!\n");
return;
}
/* check for valid function name */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
if( !krui_isFunction(val.string_val, ACT_FUNC) ) {
if (message_flag) {
fprintf(log_file, "# Unknown activation function name %s", val.string_val);
fflush(log_file);
}
err_prt("Unknown activation function name");
return;
}
/* set the new function */
strcpy(init_fct, val.string_val);
for (i=1; i<=krui_getNoOfUnits(); i++) {
if ((krui_getUnitTType(i)==unit_type) || (unit_type==0))
krui_setUnitActFunc(i, init_fct);
}
/* make a note in the log file */
if (message_flag) {
if (unit_type==0)
fprintf(log_file,"# Activation function for all Units is now %s\n", init_fct);
else {
fprintf(log_file, "# Activation function for all Units with Type ");
switch (unit_type) {
case INPUT:
fprintf(log_file, "INPUT");
break;
case OUTPUT:
fprintf(log_file, "OUTPUT");
break;
case HIDDEN:
fprintf(log_file, "HIDDEN");
break;
case DUAL:
fprintf(log_file, "DUAL");
break;
case SPECIAL:
fprintf(log_file, "SPECIAL");
break;
case SPECIAL_I:
fprintf(log_file, "SPECIAL_I");
break;
case SPECIAL_O:
fprintf(log_file, "SPECIAL_O");
break;
case SPECIAL_H:
fprintf(log_file, "SPECIAL_H");
break;
case SPECIAL_D:
fprintf(log_file, "SPECIAL_D");
break;
case SPECIAL_X:
fprintf(log_file, "SPECIAL_X");
break;
case N_SPECIAL_X:
fprintf(log_file, "N_SPECIAL_X");
break;
default:
fprintf(log_file, "%i", unit_type);
};
fprintf(log_file, " is now %s\n", init_fct);
}
fflush(log_file);
}
/* is arg list empty? */
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : delCandUnits
PURPOSE : Cascade Correlation: deletes the candidate units
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void delCandUnits(arglist_type *arglist)
{
if(!message_flag)
{
fprintf(log_file,"# Old call to delCandUnits ignored\n");
fflush(log_file);
}
}
/*****************************************************************************
FUNCTION : loadPattern
PURPOSE : loads a pattern file
Parameter: pattern file name
RETURNS :
NOTES : sets the value of PAT
UPDATE :
******************************************************************************/
void loadPattern(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt(ERR_MPF);
/* get pattern name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
kr_err = krui_loadNewPatterns(val.string_val, &curr_patSet);
kernel_error(kr_err);
enter_patName(arglist->arg_ptr);
if(!message_flag)
{
fprintf(log_file,"# Patternset %s loaded; %d patternset(s) in memory\n",
val.string_val, pat_sets_loaded);
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
/* update built-in variable: */
val.int_val = krui_getNoOfPatterns();
type = INT;
st_set_val_type(st_lookup("PAT"), type, val);
}
/*****************************************************************************
FUNCTION : setPattern
PURPOSE : makes the named patternset the current
Parameter: pattern file name
RETURNS :
NOTES : sets the value of PAT
UPDATE :
******************************************************************************/
void setPattern(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt("Missing pattern filename");
/* get pattern name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
curr_patSet = lookup_patName(arglist->arg_ptr);
kr_err = kr_npui_setCurrPatSet(curr_patSet);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# Patternset is now %s\n", val.string_val);
fflush(log_file);
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
/* update built-in variable: */
val.int_val = krui_getNoOfPatterns();
type = INT;
st_set_val_type(st_lookup("PAT"), type, val);
}
/*****************************************************************************
FUNCTION : delPattern
PURPOSE : deletes the named patternset
Parameter: pattern file name
RETURNS :
NOTES : resets the value of PAT
UPDATE :
******************************************************************************/
void delPattern(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
if (arglist == ARG_NULL)
err_prt(ERR_MPF);
/* get pattern name: */
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(STRING, type);
kr_err = kr_npui_deletePatSet(lookup_patName(arglist->arg_ptr));
kernel_error(kr_err);
del_patName(lookup_patName(arglist->arg_ptr));
if(!message_flag)
{
fprintf(log_file,"# Patternset %s deleted; %d patternset(s) in memory\n",
val.string_val, pat_sets_loaded);
fflush(log_file);
}
if (pat_sets_loaded != 0){
/* if current patset is deleted, make patset 0 the current one: */
kr_err = kr_npui_setCurrPatSet(curr_patSet);
kernel_error(kr_err);
/* lookup name of patset and display it: */
st_get_val_type(lookup_patNumber(curr_patSet), &type, &val);
if(!message_flag)
{
fprintf(log_file, "# Patternset is now %s\n", val.string_val);
fflush(log_file);
}
val.int_val = krui_getNoOfPatterns();
}
else{
val.int_val = 0;
if(!message_flag)
{
fprintf(log_file, "# No Patternset actually loaded.\n");
fflush(log_file);
}
}
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
/* update built-in variable: */
type = INT;
st_set_val_type(st_lookup("PAT"), type, val);
}
/*****************************************************************************
FUNCTION : setSeed
PURPOSE : sets the seed for the pseudo random generator
Parameter: (optional) seed_value
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void setSeed(arglist_type *arglist)
{
Val_type val;
Data_type type;
long int seed;
if (arglist == ARG_NULL)
seed = time(NULL);
else{
/* get seed value */
st_get_val_type(arglist->arg_ptr, &type, &val);
if(type == INT)
seed = val.int_val;
else if(type == REAL)
seed = (int)val.real_val;
else
err_prt("Integer value argument expected");
if (arglist->next != ARG_NULL)
warn_prt(WRN_FMATE);
}
krui_setSeedNo(seed);
return;
}
/*****************************************************************************
FUNCTION : jogWeights
PURPOSE : adds (multiplies) noise to the link weights
Parameter: minus, plus noise boundary
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void jogWeights(arglist_type *arglist)
{
Val_type val;
Data_type type;
float jog_minus, jog_plus;
jog_minus = -0.001;
jog_plus = 0.001;
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(REAL, type);
jog_minus = val.real_val;
arglist = arglist->next;
}
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(REAL, type);
jog_plus = val.real_val;
arglist = arglist->next;
}
krui_jogWeights(jog_minus, jog_plus);
if(!message_flag)
{
fprintf(log_file,"# weights jogged\n");
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
}
/*****************************************************************************
FUNCTION : jogCorrWeights
PURPOSE : adds (multiplies) noise to the link weights of correlated hiddens
Parameter: minus, plus noise boundary
RETURNS :
NOTES :
UPDATE :
******************************************************************************/
void jogCorrWeights(arglist_type *arglist)
{
krui_err kr_err;
Val_type val;
Data_type type;
float jog_minus, jog_plus, jog_correlation;
jog_minus = -0.001;
jog_plus = 0.001;
jog_correlation = 0.98;
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(REAL, type);
jog_minus = val.real_val;
arglist = arglist->next;
}
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(REAL, type);
jog_plus = val.real_val;
arglist = arglist->next;
}
if (arglist != ARG_NULL)
{
st_get_val_type(arglist->arg_ptr, &type, &val);
chck_type(REAL, type);
jog_correlation = val.real_val;
arglist = arglist->next;
}
kr_err = krui_jogCorrWeights(jog_minus, jog_plus, jog_correlation);
kernel_error(kr_err);
if(!message_flag)
{
fprintf(log_file,"# weights of correlated hiddens jogged\n");
fflush(log_file);
}
if (arglist != ARG_NULL)
warn_prt(WRN_FMATE);
}
syntax highlighted by Code2HTML, v. 0.9.1