1 /*****************************************************************************
2 FILE : $Source: /projects/higgs1/SNNS/CVS/SNNS/tools/sources/ic_snns.c,v $
3 SHORTNAME : ic_snns
4 SNNS VERSION : 4.2
5
6 PURPOSE : Intermediate Code (IC) functions for the SNNS batch
7 interpreter:
8 function calls to the SNNS-Kernel function interface
9
10 NOTES : Abbreviations: ST: symbol table
11 IC: intermediate code
12
13 AUTHOR : Jens Wieland
14 DATE :
15
16 CHANGED BY :
17 RCS VERSION : $Revision: 1.30 $
18 LAST CHANGE : $Date: 1998/07/08 11:13:57 $
19
20 Copyright (c) 1990-1995 SNNS Group, IPVR, Univ. Stuttgart, FRG
21 Copyright (c) 1996-1998 SNNS Group, WSI, Univ. Tuebingen, FRG
22
23 ******************************************************************************/
24 #include <config.h>
25
26 /* Pointers to the IC SNNS functions defined below are inserted in the
27 IC Table and executed during intermediate code interpretation (run())
28 */
29
30
31 #include <stdio.h>
32 #include <stdlib.h>
33 #include <string.h>
34 #ifdef HAVE_UNISTD_H
35 #include <unistd.h> /* for unlink() */
36 #endif
37 #include <time.h>
38
39 #include "symtab.h" /* for arglist_type */
40 #include "glob_typ.h" /* SNNS-Kernel: Global Datatypes and Constants */
41 #include "ext_typ.h" /* SNNS MasPar Kernel: Datatypes and Constants for
42 Internal Usage (for FUNCTION_NAME_MAX_LEN) */
43 #include "cc_mac.h" /* macros for cascade correlation */
44
45 #include "ic_snns.ph"
46 #include "batchman.h" /* for file pointer to log file */
47 #include "ictab.h" /* File required by following includefile */
48 #include "error.h" /* errors and warnings */
49
50 #include "kr_ui.h" /* SNNS-Kernel: User Interface Function Prototypes */
51 #include "kr_typ.h" /* SNNS-Kernel: Datatypes and Constants for Internal
52 Usage. File required by following includefile */
53 #include "kr_newpattern.h" /* SNNS-Kernel: new pattern handling functions */
54 #include "prun_f.h" /* SNNS-Kernel: pruning functions and constants */
55
56
57
58 /*****************************************************************************
59 Functions for pattern table handling
60 Purpose: enable xgui-lookalike patternset handling
61
62 ******************************************************************************/
63
64 /*****************************************************************************
65 FUNCTION : enter_patName
66
67 PURPOSE : enters pattern name (as ST pointer) in the pattern table
68 RETURNS :
69 NOTES :
70
71 UPDATE :
72 ******************************************************************************/
enter_patName(St_ptr_type name)73 void enter_patName(St_ptr_type name)
74 {
75 pat_tab[pat_sets_loaded++] = name;
76 }
77
78
79 /*****************************************************************************
80 FUNCTION : lookup_patName
81
82 PURPOSE : looks up the filename of a pattern in the pattern table
83 RETURNS : SNNS patset number, -1 if not found
84 NOTES :
85
86 UPDATE :
87 ******************************************************************************/
lookup_patName(St_ptr_type pat)88 int lookup_patName(St_ptr_type pat)
89 {
90 Val_type val, tmp_val;
91 Data_type type;
92 int i;
93
94 /* search for pattern name in patterntable: */
95 for (i=0; i<pat_sets_loaded; i++)
96 {
97 /* compare name searched with pattern table entries: */
98 st_get_val_type(pat, &type, &val);
99 st_get_val_type(pat_tab[i], &type, &tmp_val);
100 if (strcmp(val.string_val, tmp_val.string_val) == 0)
101 return i;
102 }
103 err_prt("Pattern file not yet loaded");
104 return -1;
105 }
106
107
108 /*****************************************************************************
109 FUNCTION : lookup_patNumber
110
111 PURPOSE : looks up the SNNS pattern number of a pattern in the
112 pattern table
113 RETURNS : ST entry of pattern name
114 NOTES :
115
116 UPDATE :
117 ******************************************************************************/
lookup_patNumber(int pat)118 St_ptr_type lookup_patNumber(int pat)
119 {
120 return pat_tab[pat];
121 }
122
123
124 /*****************************************************************************
125 FUNCTION : del_patName
126
127 PURPOSE : deletes a pattern set entry from the pattern table
128 RETURNS :
129 NOTES :
130
131 UPDATE :
132 ******************************************************************************/
del_patName(int pat_no)133 void del_patName(int pat_no)
134 {
135 int i;
136
137 for (i=pat_no; i<NO_OF_PAT_SETS - 1; i++)
138 pat_tab[i] = pat_tab[i+1];
139
140 if (curr_patSet == pat_no)
141 curr_patSet = 0;
142 else
143 if (curr_patSet > pat_no)
144 curr_patSet--;
145
146 pat_sets_loaded--;
147 }
148
149
150 /*****************************************************************************
151 other internal functions
152
153 ******************************************************************************/
154
155 /*****************************************************************************
156 FUNCTION : print_parameters
157
158 PURPOSE : prints number elements from array to the logfile
159 RETURNS :
160 NOTES :
161
162 UPDATE :
163 ******************************************************************************/
print_parameters(const float * array,int number)164 void print_parameters(const float *array, int number)
165 {
166 int j;
167
168 if (!number) return;
169
170 fprintf(log_file, "# Parameters are: ");
171 for (j=0; j<number; j++) fprintf(log_file, "%g ", array[j]);
172 fprintf(log_file, "\n");
173 fflush(log_file);
174 }
175
176
177 /*****************************************************************************
178 FUNCTION : defSubpattern
179
180 PURPOSE : defines subpattern shifting scheme
181 writes the 4 subpattern parameter arrays in the kernel
182 arrays are initialized if not previously set by the
183 user with the setSubPattern() function
184 RETURNS :
185 NOTES :
186
187 UPDATE :
188 ******************************************************************************/
defSubpattern(void)189 void defSubpattern(void)
190 {
191 krui_err kr_err;
192 int i;
193
194 /* initialize the 4 subpattern parameter arrays, if not already done: */
195 if(! init_subPat_flag)
196 {
197 for(i=0; i<MAX_NO_OF_VAR_DIM; i++)
198 {
199 spIsize[i] = 0; spIstep[i] = 0;
200 spOsize[i] = 0; spOstep[i] = 0;
201 }
202 init_subPat_flag = TRUE;
203 }
204
205 kr_err = krui_DefTrainSubPat(spIsize, spOsize, spIstep, spOstep, NULL);
206 kernel_error(kr_err);
207 }
208
209
210 /*****************************************************************************
211 FUNCTION : trainFFNet
212
213 PURPOSE : trains a net using a subordinate learning function
214 RETURNS : summed squared error
215 NOTES : function taken from snnsbat.c with minor changes
216
217 UPDATE :
218 ******************************************************************************/
trainFFNet(int cycles)219 float trainFFNet(int cycles)
220 {
221 krui_err kr_err;
222 float *return_values;
223 int NoOfOutParams;
224
225 int cycle = 0;
226
227 defSubpattern();
228
229 while ((cycle < cycles) &&
230 ((cycle && (return_values [0] > min_error_to_stop)) || !cycle))
231 {
232 kr_err = krui_learnAllPatternsFF(learn_param_array, noOfLearnInP,
233 &return_values, &NoOfOutParams);
234 kernel_error(kr_err);
235
236 cycle++;
237 }
238
239 return (return_values[0]);
240 }
241
242
243
244 /*****************************************************************************
245 Functions that can be called from the user program
246 'arguments' refers to function arguments in the user program,
247 here pointed to by the argument pointer list
248
249 ******************************************************************************/
250
251 /*****************************************************************************
252 FUNCTION : setInitFunc
253
254 PURPOSE : sets the initialization function and its parameters,
255 if arguments are supplied
256 RETURNS :
257 NOTES : init function name is mandatory
258
259 UPDATE :
260 ******************************************************************************/
setInitFunc(arglist_type * arglist)261 void setInitFunc(arglist_type *arglist)
262 {
263 krui_err kr_err;
264 Val_type val;
265 Data_type type;
266 int i;
267
268 if (arglist == ARG_NULL)
269 err_prt(ERR_ALOAE);
270
271 /* get first parameter, should be an valid init function name: */
272 st_get_val_type(arglist->arg_ptr, &type, &val);
273 chck_type(STRING, type);
274 if (! krui_isFunction(val.string_val, INIT_FUNC))
275 err_prt("Unknown init function name");
276 strcpy(init_fct, val.string_val);
277
278 /* advance argument list pointer: */
279 arglist = arglist->next;
280
281 /* initialize init parameter array: */
282 for(i=0; i<NO_OF_INIT_PARAMS; i++) {
283 if(i == 0)
284 init_param_array[i] = 1.0;
285 else if(i == 1)
286 init_param_array[i] = -1.0;
287 else
288 init_param_array[i] = 0.0;
289 }
290
291
292 /* overwrite parameter array with supplied parameters: */
293 i = 0;
294 while ( (i < NO_OF_INIT_PARAMS) && arglist != ARG_NULL)
295 {
296 st_get_val_type(arglist->arg_ptr, &type, &val);
297 if(type == REAL)
298 init_param_array[i] = val.real_val;
299 else if(type == INT)
300 init_param_array[i] = (double)val.int_val;
301 else
302 err_prt("Real or INT value argument expected");
303 arglist = arglist->next;
304 i++;
305 }
306
307 /* set number of actual init parameters: */
308 noOfInitParams = i;
309
310 kr_err = krui_setInitialisationFunc(init_fct);
311 kernel_error(kr_err);
312
313 if(!message_flag)
314 {
315 fprintf(log_file, "# Init function is now %s\n", init_fct);
316 print_parameters(init_param_array, noOfInitParams);
317 fflush(log_file);
318 }
319
320 if (arglist != ARG_NULL)
321 warn_prt(WRN_FMATE);
322
323 /* to enable to warn the user, set an init flag: */
324 init_net_flag = TRUE;
325 }
326
327
328 /*****************************************************************************
329 FUNCTION : setLearnFunc
330
331 PURPOSE : sets the learning function and its parameters,
332 if arguments are supplied
333 RETURNS :
334 NOTES : learning function name is mandatory
335
336 UPDATE :
337 ******************************************************************************/
setLearnFunc(arglist_type * arglist)338 void setLearnFunc(arglist_type *arglist)
339 {
340 krui_err kr_err;
341 Val_type val;
342 Data_type type;
343 int i;
344
345 if (arglist == ARG_NULL)
346 err_prt(ERR_ALOAE);
347
348 /* get first parameter, should be a learning function name: */
349 st_get_val_type(arglist->arg_ptr, &type, &val);
350 chck_type(STRING, type);
351 if (! krui_isFunction(val.string_val, LEARN_FUNC))
352 err_prt("Unknown learning function name");
353 strcpy(learn_fct, val.string_val);
354
355 /* advance argument list pointer: */
356 arglist = arglist->next;
357
358 /* initialize learn parameter array: */
359 learn_param_array[0] = 0.2;
360 for(i=1; i<NO_OF_LEARN_PARAMS; i++) learn_param_array[i] = 0.0;
361
362 /* overwrite parameter array with supplied parameters: */
363 i = 0;
364 while ((i<NO_OF_LEARN_PARAMS) && arglist != ARG_NULL)
365 {
366 st_get_val_type(arglist->arg_ptr, &type, &val);
367 if(type == REAL)
368 learn_param_array[i] = val.real_val;
369 else if(type == INT)
370 learn_param_array[i] = (double)val.int_val;
371 else
372 err_prt("Real or INT value argument expected");
373 arglist = arglist->next;
374 i++;
375 }
376
377 /* set number of actual learn parameters; at least 1: */
378 noOfLearnInP = (i==0) ? 1 : i;
379
380 kr_err = krui_setLearnFunc(learn_fct);
381 kernel_error(kr_err);
382
383 if(!message_flag)
384 {
385 fprintf(log_file,"# Learning function is now %s\n", learn_fct);
386 print_parameters(learn_param_array, noOfLearnInP);
387 fflush(log_file);
388 }
389
390 if (arglist != ARG_NULL)
391 warn_prt(WRN_FMATE);
392
393 /* the learn_param_array[] should be initialized at least once
394 before calling the trainNet-function;
395 remember here that this is now done: */
396 init_learn_flag = TRUE;
397 }
398
399
400 /*****************************************************************************
401 FUNCTION : setUpdateFunc
402
403 PURPOSE : sets the update function and its parameters,
404 if arguments are supplied
405 RETURNS :
406 NOTES : update function name is mandatory
407
408 UPDATE :
409 ******************************************************************************/
setUpdateFunc(arglist_type * arglist)410 void setUpdateFunc(arglist_type *arglist)
411 {
412 krui_err kr_err;
413 Val_type val;
414 Data_type type;
415 int i;
416
417 if (arglist == ARG_NULL)
418 err_prt(ERR_ALOAE);
419
420 /* get first parameter, should be an update function name: */
421 st_get_val_type(arglist->arg_ptr, &type, &val);
422 chck_type(STRING, type);
423 if (! krui_isFunction(val.string_val, UPDATE_FUNC))
424 err_prt("Unknown update function name");
425 strcpy(update_fct, val.string_val);
426
427 /* advance argument list pointer: */
428 arglist = arglist->next;
429
430 /* initialize update parameter array: */
431 for(i=0; i<NO_OF_UPDATE_PARAMS; i++) update_param_array[i] = 0.0;
432
433 /* overwrite parameter array with supplied parameters: */
434 i = 0;
435 while ((i < NO_OF_UPDATE_PARAMS) && arglist != ARG_NULL)
436 {
437 st_get_val_type(arglist->arg_ptr, &type, &val);
438 st_get_val_type(arglist->arg_ptr, &type, &val);
439 if(type == REAL)
440 update_param_array[i] = val.real_val;
441 else if(type == INT)
442 update_param_array[i] = (double)val.int_val;
443 else
444 err_prt("Real or INT value argument expected");
445 arglist = arglist->next;
446 i++;
447 }
448
449 /* set number of actual update parameters: */
450 noOfUpdateParam = i;
451
452 kr_err = krui_setUpdateFunc(update_fct);
453 kernel_error(kr_err);
454
455 if(!message_flag)
456 {
457 fprintf(log_file,"# Update function is now %s\n", update_fct);
458 print_parameters(update_param_array, noOfUpdateParam);
459 fflush(log_file);
460 }
461
462 if (arglist != ARG_NULL)
463 warn_prt(WRN_FMATE);
464
465 /* remember, update_param_array is now initialized: */
466 init_update_flag = TRUE;
467 }
468
469
470 /*****************************************************************************
471 FUNCTION : setPruningFunc
472
473 PURPOSE : sets the pruning functions and their parameters,
474 if arguments are supplied
475 RETURNS :
476 NOTES : pruning and subordinate learning function names are mandatory
477
478 UPDATE :
479 ******************************************************************************/
setPruningFunc(arglist_type * arglist)480 void setPruningFunc(arglist_type *arglist)
481 {
482 krui_err kr_err;
483 Val_type val;
484 Data_type type;
485
486 /* initialize pruning parameters: */
487 max_error_incr = pr_maxErrorInc,
488 accepted_error = pr_acceptedError,
489 /* min_error_to_stop = pr_minError,*/
490 init_matrix_value = pr_obs_initParameter;
491
492 first_train_cyc = pr_trainCycles,
493 retrain_cyc = pr_retrainCycles;
494
495 recreate = pr_recreate,
496 input_pruning = pr_inputPruning,
497 hidden_pruning = pr_hiddenPruning;
498
499 /* get mandatory parameter: pruning function */
500 if (arglist == ARG_NULL)
501 err_prt("Missing pruning function name");
502
503 st_get_val_type(arglist->arg_ptr, &type, &val);
504 chck_type(STRING, type);
505 if (! krui_isFunction(val.string_val, PRUNING_FUNC))
506 err_prt("Unknown pruning function name");
507 strcpy(pruning_fct, val.string_val);
508 arglist = arglist->next;
509
510 kr_err = krui_setPrunFunc(pruning_fct);
511 kernel_error(kr_err);
512
513 /* get mandatory parameter: subordinate learning function */
514 if (arglist == ARG_NULL)
515 err_prt("Missing subordinate learning function name");
516
517 st_get_val_type(arglist->arg_ptr, &type, &val);
518 chck_type(STRING, type);
519 if (! krui_isFunction(val.string_val, LEARN_FUNC))
520 err_prt("Unknown learning function name");
521 strcpy(sublearn_fct, val.string_val);
522 arglist = arglist->next;
523
524 kr_err = krui_setFFLearnFunc(sublearn_fct);
525 kernel_error(kr_err);
526
527 if(!message_flag)
528 {
529 fprintf(log_file, "# Pruning function is now %s\n", pruning_fct);
530 fprintf(log_file, "# Subordinate learning function is now %s\n",
531 sublearn_fct);
532 if (arglist != ARG_NULL) fprintf(log_file, "# Parameters are: ");
533 fflush(log_file);
534 }
535
536 /* get further parameters, if supplied, and overwrite the
537 corresponding defaults: */
538
539 /* get parameter: maximum error increase */
540 if (arglist != ARG_NULL)
541 {
542 st_get_val_type(arglist->arg_ptr, &type, &val);
543 if(type == REAL)
544 max_error_incr = val.real_val;
545 else if(type == INT)
546 max_error_incr = (double)val.int_val;
547 else
548 err_prt("Real or INT value argument expected");
549 if(!message_flag) {
550 fprintf(log_file, "%g ", max_error_incr);
551 fflush(log_file);
552 }
553 arglist = arglist->next;
554 }
555
556 /* get parameter: accepted error */
557 if (arglist != ARG_NULL)
558 {
559 st_get_val_type(arglist->arg_ptr, &type, &val);
560 if(type == REAL)
561 accepted_error = val.real_val;
562 else if(type == INT)
563 accepted_error = (double)val.int_val;
564 else
565 err_prt("Real or INT value argument expected");
566 if(!message_flag) {
567 fprintf(log_file, "%g ", accepted_error);
568 fflush(log_file);
569 }
570 arglist = arglist->next;
571 }
572
573 /* get parameter: recreate flag */
574 if (arglist != ARG_NULL)
575 {
576 st_get_val_type(arglist->arg_ptr, &type, &val);
577 chck_type(BOOL, type);
578 recreate = val.bool_val;
579 if(!message_flag) {
580 fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
581 fflush(log_file);
582 }
583 arglist = arglist->next;
584 }
585
586 /* get parameter: first train cycles */
587 if (arglist != ARG_NULL)
588 {
589 st_get_val_type(arglist->arg_ptr, &type, &val);
590 if(type == INT)
591 first_train_cyc = val.int_val;
592 else if(type == REAL)
593 first_train_cyc = (int)val.real_val;
594 else
595 err_prt("Integer value argument expected");
596 if(!message_flag) {
597 fprintf(log_file, "%d ", first_train_cyc);
598 fflush(log_file);
599 }
600 arglist = arglist->next;
601 }
602
603 /* get parameter: retrain cycles */
604 if (arglist != ARG_NULL)
605 {
606 st_get_val_type(arglist->arg_ptr, &type, &val);
607 if(type == INT)
608 retrain_cyc = val.int_val;
609 else if(type == REAL)
610 retrain_cyc = (int)val.real_val;
611 else
612 err_prt("Integer value argument expected");
613 if(!message_flag) {
614 fprintf(log_file, "%d ", retrain_cyc);
615 fflush(log_file);
616 }
617 arglist = arglist->next;
618 }
619
620 /* get parameter: min error to stop*/
621 if (arglist != ARG_NULL)
622 {
623 st_get_val_type(arglist->arg_ptr, &type, &val);
624 if(type == REAL)
625 min_error_to_stop = val.real_val;
626 else if(type == INT)
627 min_error_to_stop = (double)val.int_val;
628 else
629 err_prt("Real or INT value argument expected");
630 if(!message_flag) {
631 fprintf(log_file, "%g ", min_error_to_stop);
632 fflush(log_file);
633 }
634 arglist = arglist->next;
635 }
636
637 /* get parameter: matrix init value */
638 if (arglist != ARG_NULL)
639 {
640 st_get_val_type(arglist->arg_ptr, &type, &val);
641 if(type == REAL)
642 init_matrix_value = val.real_val;
643 else if(type == INT)
644 init_matrix_value = (double)val.int_val;
645 else
646 err_prt("Real or INT value argument expected");
647 if(!message_flag) {
648 fprintf(log_file, "%g ", init_matrix_value);
649 fflush(log_file);
650 }
651 arglist = arglist->next;
652 }
653
654 /* get parameter: input pruning flag */
655 if (arglist != ARG_NULL)
656 {
657 st_get_val_type(arglist->arg_ptr, &type, &val);
658 chck_type(BOOL, type);
659 input_pruning = val.bool_val;
660 if(!message_flag) {
661 fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
662 fflush(log_file);
663 }
664 arglist = arglist->next;
665 }
666
667 /* get parameter: hidden pruning flag */
668 if (arglist != ARG_NULL)
669 {
670 st_get_val_type(arglist->arg_ptr, &type, &val);
671 chck_type(BOOL, type);
672 hidden_pruning = val.bool_val;
673 if(!message_flag) {
674 fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
675 fflush(log_file);
676 }
677 arglist = arglist->next;
678 }
679
680 if (!message_flag)
681 {
682 fprintf(log_file, "\n");
683 fflush(log_file);
684 }
685
686 /* update pruning parameters (may have been changed): */
687 pr_obs_setInitParameter((double)init_matrix_value);
688 pr_setInputPruning((int)input_pruning);
689 pr_setHiddenPruning((int)hidden_pruning);
690
691 if (arglist != ARG_NULL)
692 warn_prt(WRN_FMATE);
693 }
694
695
696 /*****************************************************************************
697 FUNCTION : setRemapFunc
698
699 PURPOSE : sets the pattern remapping function and its parameters,
700 if arguments are supplied
701 RETURNS :
702 NOTES : remap function name is mandatory
703
704 UPDATE :
705 ******************************************************************************/
setRemapFunc(arglist_type * arglist)706 void setRemapFunc(arglist_type *arglist)
707 {
708 krui_err kr_err;
709 Val_type val;
710 Data_type type;
711 int i;
712
713 if (arglist == ARG_NULL)
714 err_prt(ERR_ALOAE);
715
716 /* get first parameter, should be an remap function name: */
717 st_get_val_type(arglist->arg_ptr, &type, &val);
718 chck_type(STRING, type);
719 if (! krui_isFunction(val.string_val, REMAP_FUNC))
720 err_prt("Unknown remap function name");
721 strcpy(remap_fct, val.string_val);
722
723 /* advance argument list pointer: */
724 arglist = arglist->next;
725
726 /* initialize remap parameter array: */
727 for(i=0; i<NO_OF_REMAP_PARAMS; i++) remap_param_array[i] = 0.0;
728
729 /* overwrite parameter array with supplied parameters: */
730 i = 0;
731 while ((i < NO_OF_REMAP_PARAMS) && arglist != ARG_NULL)
732 {
733 st_get_val_type(arglist->arg_ptr, &type, &val);
734 st_get_val_type(arglist->arg_ptr, &type, &val);
735 if(type == REAL)
736 remap_param_array[i] = val.real_val;
737 else if(type == INT)
738 remap_param_array[i] = (double)val.int_val;
739 else
740 err_prt("Real or INT value argument expected");
741 arglist = arglist->next;
742 i++;
743 }
744
745 /* set number of actual remap parameters: */
746 noOfRemapParam = i;
747
748 kr_err = krui_setRemapFunc(remap_fct,remap_param_array);
749 kernel_error(kr_err);
750
751 if(!message_flag)
752 {
753 fprintf(log_file,"# Remap function is now %s\n", remap_fct);
754 print_parameters(remap_param_array, noOfRemapParam);
755 fflush(log_file);
756 }
757
758 if (arglist != ARG_NULL)
759 warn_prt(WRN_FMATE);
760
761 /* remember, remap_param_array is now initialized: */
762 init_remap_flag = TRUE;
763 }
764
765
766 /*****************************************************************************
767 FUNCTION : setSubPattern
768
769 PURPOSE : sets the subpattern handling parameters
770
771 RETURNS :
772 NOTES : kernel call is performed in defSubpattern()
773
774 UPDATE :
775 ******************************************************************************/
setSubPattern(arglist_type * arglist)776 void setSubPattern(arglist_type *arglist)
777 {
778 Val_type val;
779 Data_type type;
780 int i;
781
782 if (arglist == ARG_NULL)
783 err_prt("At least four arguments expected");
784
785 /* initialize the 4 subpattern parameter arrays: */
786 for(i=0; i<MAX_NO_OF_VAR_DIM; i++)
787 {
788 spIsize[i] = 0; spIstep[i] = 0;
789 spOsize[i] = 0; spOstep[i] = 0;
790 }
791
792 if(!message_flag)
793 {
794 fprintf(log_file, "# Subpattern shifting scheme (re)defined\n");
795 fprintf(log_file, "# Parameters are: ");
796 fflush(log_file);
797 }
798
799 /* overwrite parameter arrays with supplied parameters: */
800 i = 0;
801 while ( (i < MAX_NO_OF_VAR_DIM) && arglist != ARG_NULL)
802 {
803 /* get subpatternIsize: */
804 if (arglist == ARG_NULL) /* no more arguments in list? */
805 err_prt(ERR_NOAMM); /* print an error */
806 st_get_val_type(arglist->arg_ptr, &type, &val);
807 if(type == INT)
808 spIsize[i] = val.int_val;
809 else if(type == REAL)
810 spIsize[i] = (int)val.real_val;
811 else
812 err_prt("Integer value argument expected");
813 if(!message_flag) {
814 fprintf(log_file, "%d ", spIsize[i]);
815 fflush(log_file);
816 }
817 arglist = arglist->next; /* advance argument list pointer */
818
819 /* get subpatternIstep: */
820 if (arglist == ARG_NULL)
821 err_prt(ERR_NOAMM);
822 st_get_val_type(arglist->arg_ptr, &type, &val);
823 if(type == INT)
824 spIstep[i] = val.int_val;
825 else if(type == REAL)
826 spIstep[i] = (int)val.real_val;
827 else
828 err_prt("Integer value argument expected");
829 if(!message_flag) {
830 fprintf(log_file, "%d ", spIstep[i]);
831 fflush(log_file);
832 }
833 arglist = arglist->next;
834
835 /* get subpatternOsize: */
836 if (arglist == ARG_NULL)
837 err_prt(ERR_NOAMM);
838 st_get_val_type(arglist->arg_ptr, &type, &val);
839 if(type == INT)
840 spOsize[i] = val.int_val;
841 else if(type == REAL)
842 spOsize[i] = (int)val.real_val;
843 else
844 err_prt("Integer value argument expected");
845 if(!message_flag) {
846 fprintf(log_file, "%d ", spOsize[i]);
847 fflush(log_file);
848 }
849 arglist = arglist->next;
850
851 /* and, last not least, get subpatternOstep: */
852 if (arglist == ARG_NULL)
853 err_prt(ERR_NOAMM);
854 st_get_val_type(arglist->arg_ptr, &type, &val);
855 if(type == INT)
856 spOstep[i] = val.int_val;
857 else if(type == REAL)
858 spOstep[i] = (int)val.real_val;
859 else
860 err_prt("Integer value argument expected");
861 if(!message_flag) {
862 fprintf(log_file, "%d ", spOstep[i]);
863 fflush(log_file);
864 }
865 arglist = arglist->next;
866
867 i++;
868
869 /* oops, so far so good; but this was only one dimension! */
870 }
871
872 if (arglist != ARG_NULL)
873 err_prt(ERR_NOAMM);
874
875 /* notify defSubpattern() that the user program has set the params: */
876 init_subPat_flag = TRUE;
877
878 /* kernel call is performed in defSubpattern() */
879
880 if(!message_flag)
881 {
882 fprintf(log_file, "\n");
883 fflush(log_file);
884 }
885 }
886
887
888 /*****************************************************************************
889 FUNCTION : setShuffle
890
891 PURPOSE : sets the pattern shuffling mode for ordinary patterns
892 RETURNS :
893 NOTES :
894
895 UPDATE :
896 ******************************************************************************/
setShuffle(arglist_type * arglist)897 void setShuffle(arglist_type *arglist)
898 {
899 krui_err kr_err;
900 Val_type val;
901 Data_type type;
902
903 if (arglist == ARG_NULL)
904 err_prt(ERR_ATOFE);
905
906 st_get_val_type(arglist->arg_ptr, &type, &val);
907 chck_type(BOOL, type);
908
909 kr_err = krui_shufflePatterns((bool)val.bool_val);
910 /* formal type cast; SNNS and Batchman boolean types are compatible */
911 kernel_error(kr_err);
912
913 if(!message_flag)
914 {
915 fprintf(log_file,"# Pattern shuffling %sabled\n",
916 (val.bool_val) ? "en" : "dis");
917 fflush(log_file);
918 }
919
920 if (arglist->next != ARG_NULL)
921 warn_prt(WRN_FMATE);
922 }
923
924
925 /*****************************************************************************
926 FUNCTION : setSubShuffle
927
928 PURPOSE : sets the pattern shuffling mode for subpatterns
929 RETURNS :
930 NOTES :
931
932 UPDATE :
933 ******************************************************************************/
setSubShuffle(arglist_type * arglist)934 void setSubShuffle(arglist_type *arglist)
935 {
936 krui_err kr_err;
937 Val_type val;
938 Data_type type;
939
940 if (arglist == ARG_NULL)
941 err_prt(ERR_ATOFE);
942
943 st_get_val_type(arglist->arg_ptr, &type, &val);
944 chck_type(BOOL, type);
945
946 kr_err = krui_shuffleSubPatterns((bool)val.bool_val);
947 /* formal type cast; SNNS and Batchman boolean types are compatible */
948 kernel_error(kr_err);
949
950 if(!message_flag)
951 {
952 fprintf(log_file,"# Subpattern shuffling %sabled\n",
953 (val.bool_val) ? "en" : "dis");
954 fflush(log_file);
955 }
956
957 if (arglist->next != ARG_NULL)
958 warn_prt(WRN_FMATE);
959 }
960
961
962 /*****************************************************************************
963 FUNCTION : setClassDistrib
964
965 PURPOSE : sets the distribution of the classes in the pattern file
966 to the values given as parameters.
967 RETURNS :
968 NOTES : first parameter (bool) switches redistribution on or off
969 Also sets the value of PAT
970
971 UPDATE :
972 ******************************************************************************/
setClassDistrib(arglist_type * arglist)973 void setClassDistrib(arglist_type *arglist)
974 {
975 krui_err kr_err;
976 Val_type val;
977 Data_type type;
978 int i,j;
979 bool onOff;
980 pattern_set_info patt_info;
981 pattern_descriptor descrip;
982 char s_onOff[5];
983 float *outarray;
984
985 if (arglist == ARG_NULL)
986 err_prt(ERR_ALOAE);
987
988 /* get first parameter*/
989 st_get_val_type(arglist->arg_ptr, &type, &val);
990 chck_type(BOOL, type);
991 onOff = (bool)val.bool_val;
992 kr_err = krui_useClassDistribution(onOff);
993 kernel_error(kr_err);
994
995 /* advance argument list pointer: */
996 arglist = arglist->next;
997
998 /* get pattern information */
999 kr_err = krui_GetPatInfo(&patt_info, &descrip);
1000 kernel_error(kr_err);
1001
1002 /* initialize class distribution array: */
1003 distrib_array = (unsigned int *)realloc(distrib_array,
1004 patt_info.classes*sizeof(unsigned int));
1005 for(i=0; i<patt_info.classes; i++)
1006 distrib_array[i] = *patt_info.class_redistribution++;
1007
1008 /* overwrite distribution with supplied values: */
1009 i = 0;
1010 while ((i < patt_info.classes) && arglist != ARG_NULL)
1011 {
1012 st_get_val_type(arglist->arg_ptr, &type, &val);
1013 if(type == REAL)
1014 distrib_array[i] = (int) val.real_val;
1015 else if(type == INT)
1016 distrib_array[i] = val.int_val;
1017 else
1018 err_prt("Real or INT value argument expected");
1019 arglist = arglist->next;
1020 i++;
1021 }
1022
1023 kr_err = krui_setClassDistribution(distrib_array);
1024 kernel_error(kr_err);
1025
1026 if(!message_flag)
1027 {
1028 outarray = (float *)malloc(i*sizeof(float));
1029 for(j=0;j<i;j++)outarray[j] = (float)distrib_array[j];
1030 sprintf(s_onOff,"%s",(onOff)?" ON":" OFF");
1031 fprintf(log_file,"# Class distribution is now %s\n", s_onOff);
1032 print_parameters( outarray, i);
1033 fflush(log_file);
1034 }
1035
1036 if (arglist != ARG_NULL)
1037 warn_prt(WRN_FMATE);
1038
1039 /* update built-in variable: */
1040 val.int_val = krui_getNoOfPatterns();
1041 type = INT;
1042 st_set_val_type(st_lookup("PAT"), type, val);
1043 }
1044
1045
1046 /*****************************************************************************
1047 FUNCTION : setParallelMode
1048
1049 PURPOSE : switches to the parallel kernel if argument is TRUE and back
1050 if argument is FALSE
1051 RETURNS :
1052 NOTES :
1053
1054 UPDATE :
1055 ******************************************************************************/
setParallelMode(arglist_type * arglist)1056 void setParallelMode(arglist_type *arglist)
1057 {
1058 krui_err kr_err;
1059 Val_type val;
1060 Data_type type;
1061
1062 if (arglist == ARG_NULL)
1063 err_prt(ERR_ATOFE);
1064
1065 st_get_val_type(arglist->arg_ptr, &type, &val);
1066 chck_type(BOOL, type);
1067
1068 kr_err = krui_setSpecialNetworkType(
1069 (val.bool_val==TRUE) ? NET_TYPE_FF1 : NET_TYPE_GENERAL);
1070
1071 kernel_error(kr_err);
1072
1073 if(!message_flag)
1074 {
1075 fprintf(log_file,"# Parallel Mode %sabled\n",
1076 (val.bool_val) ? "en" : "dis");
1077 fflush(log_file);
1078 }
1079
1080 if (arglist->next != ARG_NULL)
1081 warn_prt(WRN_FMATE);
1082 }
1083
1084
1085 /*****************************************************************************
1086 FUNCTION : setCascadeParams
1087
1088 PURPOSE : sets the parameters of the cascade correlation algorithms
1089 RETURNS :
1090 NOTES :
1091
1092 UPDATE :
1093 ******************************************************************************/
setCascadeParams(arglist_type * arglist)1094 void setCascadeParams(arglist_type *arglist)
1095 {
1096 Val_type val;
1097 Data_type type;
1098 int i;
1099
1100 /* initialization of learn_param_array: */
1101
1102 /* XGUI Cascade subwindow 'Global Parameters' entries: */
1103 learn_param_array[6] = MAX_PIXEL_ERROR;
1104 learn_param_array[7] = QUICKPROP; /* QUICKPROP = Quickprop
1105 BACKPROP = Backprop
1106 RPROP = Rprop */
1107 learn_param_array[8] = ON;
1108 learn_param_array[17] = OFF;
1109 learn_param_array[20] = SBC; /* SBC AIC CMSEP */
1110
1111
1112 /* XGUI Cascade subwindow 'Candidate Parameters' entries: */
1113 learn_param_array[9] = MIN_COVARIANCE_CHANGE;
1114 learn_param_array[10] = SPECIAL_PATIENCE;
1115 learn_param_array[11] = MAX_NO_OF_COVARIANCE_UPDATE_CYCLES;
1116 learn_param_array[12] = MAX_SPECIAL_UNIT_NO;
1117 learn_param_array[13] = SYM_SIGMOID; /* ASYM_SIGMOID = Act_Logistic
1118 SYM_SIGMOID=Act_LogSym
1119 TANH = Act_TanH
1120 RANDOM = Act_Random */
1121
1122
1123 /* XGUI Cascade subwindow 'Output Parameters' entries: */
1124 learn_param_array[14] = MIN_ERROR_CHANGE;
1125 learn_param_array[15] = OUT_PATIENCE;
1126 learn_param_array[16] = MAX_NO_OF_ERROR_UPDATE_CYCLES;
1127
1128
1129 /* unused: */
1130 learn_param_array[18] = 0;
1131 learn_param_array[19] = 0;
1132
1133
1134 /* reading parameters, if supplied:*/
1135
1136 if ((!message_flag) && (arglist != ARG_NULL))
1137 {
1138 fprintf(log_file, "# Cascade Correlation\n");
1139 fprintf(log_file, "# Parameters are: ");
1140 fflush(log_file);
1141 }
1142
1143 /* XGUI Cascade subwindow 'Global Parameters' entries: */
1144
1145 /* get parameter: max outp. unit error */
1146 if (arglist != ARG_NULL)
1147 {
1148 st_get_val_type(arglist->arg_ptr, &type, &val);
1149 if(type == REAL)
1150 learn_param_array[6] = val.real_val;
1151 else if(type == INT)
1152 learn_param_array[6] = (double)val.int_val;
1153 else
1154 err_prt("Real or INT value argument expected");
1155 if(!message_flag) {
1156 fprintf(log_file, "%g ", learn_param_array[6]);
1157 fflush(log_file);
1158 }
1159 arglist = arglist->next;
1160 }
1161
1162 /* get parameter: learning function */
1163 if (arglist != ARG_NULL)
1164 {
1165 st_get_val_type(arglist->arg_ptr, &type, &val);
1166 chck_type(STRING, type);
1167 if (strcmp(val.string_val, "Quickprop") == 0)
1168 learn_param_array[7] = QUICKPROP;
1169 else
1170 if (strcmp(val.string_val, "Backprop") == 0)
1171 learn_param_array[7] = BACKPROP;
1172 else
1173 if (strcmp(val.string_val, "Rprop") == 0)
1174 learn_param_array[7] = RPROP;
1175 else
1176 err_prt("Invalid learning function name");
1177
1178 if(!message_flag) {
1179 fprintf(log_file, "%s ", val.string_val);
1180 fflush(log_file);
1181 }
1182 arglist = arglist->next;
1183 }
1184
1185 /* get parameter: print covar. and error */
1186 if (arglist != ARG_NULL)
1187 {
1188 st_get_val_type(arglist->arg_ptr, &type, &val);
1189 chck_type(BOOL, type);
1190 learn_param_array[8] = (val.bool_val) ? ON : OFF;
1191 if(!message_flag) {
1192 fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
1193 fflush(log_file);
1194 }
1195 arglist = arglist->next;
1196 }
1197
1198 /* get parameter: prune new hidden unit */
1199 if (arglist != ARG_NULL)
1200 {
1201 st_get_val_type(arglist->arg_ptr, &type, &val);
1202 chck_type(BOOL, type);
1203 learn_param_array[17] = (val.bool_val) ? ON : OFF;
1204 if(!message_flag) {
1205 fprintf(log_file, "%s ", val.bool_val ? "TRUE" : "FALSE");
1206 fflush(log_file);
1207 }
1208 arglist = arglist->next;
1209 }
1210
1211 /* get parameter: minimize */ /* SBC AIC CMSEP */
1212 if (arglist != ARG_NULL)
1213 {
1214 st_get_val_type(arglist->arg_ptr, &type, &val);
1215 chck_type(STRING, type);
1216 if (strcmp(val.string_val, "SBC") == 0)
1217 learn_param_array[20] = SBC;
1218 else
1219 if (strcmp(val.string_val, "AIC") == 0)
1220 learn_param_array[20] = AIC;
1221 else
1222 if (strcmp(val.string_val, "CMSEP") == 0)
1223 learn_param_array[20] = CMSEP;
1224 else
1225 err_prt("Invalid minimization function name");
1226
1227 if(!message_flag) {
1228 fprintf(log_file, "%s ", val.string_val);
1229 fflush(log_file);
1230 }
1231
1232 arglist = arglist->next;
1233 }
1234
1235 /* XGUI Cascade subwindow 'Candidate Parameters' entries: */
1236
1237 /* get parameter: min. covar. change */
1238 if (arglist != ARG_NULL)
1239 {
1240 st_get_val_type(arglist->arg_ptr, &type, &val);
1241 if(type == REAL)
1242 learn_param_array[9] = val.real_val;
1243 else if(type == INT)
1244 learn_param_array[9] = (double)val.int_val;
1245 else
1246 err_prt("Real or INT value argument expected");
1247 if(!message_flag) {
1248 fprintf(log_file, "%g ", learn_param_array[9]);
1249 fflush(log_file);
1250 }
1251 arglist = arglist->next;
1252 }
1253
1254 /* get parameter: cand. patience */
1255 /* get parameter: max no of covar. updates */
1256 /* get parameter: max no of candidate units */
1257 for(i=10; i<=12; i++){
1258 if (arglist != ARG_NULL){
1259 st_get_val_type(arglist->arg_ptr, &type, &val);
1260 if(type == INT)
1261 learn_param_array[i] = val.int_val;
1262 else if(type == REAL)
1263 learn_param_array[i] = (int)val.real_val;
1264 else
1265 err_prt("Integer value argument expected");
1266 if(!message_flag) {
1267 fprintf(log_file, "%d ", learn_param_array[i]);
1268 fflush(log_file);
1269 }
1270 arglist = arglist->next;
1271 }
1272 }
1273
1274 /* get parameter: activation function */
1275 if (arglist != ARG_NULL)
1276 {
1277 st_get_val_type(arglist->arg_ptr, &type, &val);
1278 chck_type(STRING, type);
1279 if (strcmp(val.string_val, "Act_Logistic") == 0)
1280 learn_param_array[13] = ASYM_SIGMOID;
1281 else
1282 if (strcmp(val.string_val, "Act_LogSym") == 0)
1283 learn_param_array[13] = SYM_SIGMOID;
1284 else
1285 if (strcmp(val.string_val, "Act_TanH") == 0)
1286 learn_param_array[13] = TANH;
1287 else
1288 if (strcmp(val.string_val, "Act_Random") == 0)
1289 learn_param_array[13] = RANDOM;
1290 else
1291 err_prt("Invalid activation function name");
1292
1293 if(!message_flag) {
1294 fprintf(log_file, "%s ", val.string_val);
1295 fflush(log_file);
1296 }
1297
1298 arglist = arglist->next;
1299 }
1300
1301
1302 /* XGUI Cascade subwindow 'Output Parameters' entries: */
1303
1304 /* get parameter: error change */
1305 if (arglist != ARG_NULL)
1306 {
1307 st_get_val_type(arglist->arg_ptr, &type, &val);
1308 if(type == REAL)
1309 learn_param_array[14] = val.real_val;
1310 else if(type == INT)
1311 learn_param_array[14] = (double)val.int_val;
1312 else
1313 err_prt("Real or INT value argument expected");
1314 if(!message_flag) {
1315 fprintf(log_file, "%g ", learn_param_array[14]);
1316 fflush(log_file);
1317 }
1318 arglist = arglist->next;
1319 }
1320
1321 /* get parameter: output patience */
1322 /* get parameter: max no of epochs */
1323 for(i=15; i<=16; i++){
1324 if (arglist != ARG_NULL){
1325 st_get_val_type(arglist->arg_ptr, &type, &val);
1326 if(type == INT)
1327 learn_param_array[i] = val.int_val;
1328 else if(type == REAL)
1329 learn_param_array[i] = (int)val.real_val;
1330 else
1331 err_prt("Integer value argument expected");
1332 if(!message_flag) {
1333 fprintf(log_file, "%d ", learn_param_array[i]);
1334 fflush(log_file);
1335 }
1336 arglist = arglist->next;
1337 }
1338 }
1339
1340 if (!message_flag)
1341 {
1342 fprintf(log_file, "\n");
1343 fflush(log_file);
1344 }
1345
1346 if (arglist != ARG_NULL)
1347 warn_prt(WRN_FMATE);
1348 }
1349
1350
1351 /*****************************************************************************
1352 FUNCTION : initNet
1353
1354 PURPOSE : initializes the network
1355 RETURNS :
1356 NOTES : resets the value of CYCLES
1357
1358 UPDATE :
1359 ******************************************************************************/
initNet(arglist_type * arglist)1360 void initNet(arglist_type *arglist)
1361 {
1362 krui_err kr_err;
1363 Val_type val;
1364 Data_type type;
1365 int i;
1366
1367 if (! init_net_flag)
1368 warn_prt("Init function and params not specified; using defaults");
1369
1370 if (arglist != ARG_NULL)
1371 warn_prt(WRN_NFAE);
1372
1373 /* initialize init parameter array: */
1374 if (! init_net_flag)
1375 {
1376 for(i=0; i<NO_OF_INIT_PARAMS; i++)
1377 {
1378 if(i == 0)
1379 init_param_array[i] = 1.0;
1380 else if(i == 1)
1381 init_param_array[i] = -1.0;
1382 else
1383 init_param_array[i] = 0.0;
1384 }
1385 init_net_flag = TRUE;
1386 }
1387
1388 kr_err = krui_initializeNet(init_param_array, noOfInitParams);
1389 kernel_error(kr_err);
1390
1391 if(!message_flag)
1392 {
1393 fprintf(log_file,"# Net initialized\n");
1394 fflush(log_file);
1395 }
1396
1397 /* update built-in variable: */
1398 val.int_val = 0;
1399 type = INT;
1400 st_set_val_type(st_lookup("CYCLES"), type, val);
1401 }
1402
1403
1404 /*****************************************************************************
1405 FUNCTION : resetNet
1406
1407 PURPOSE : resets the network to its initial configuration
1408 RETURNS :
1409 NOTES : resets the value of CYCLES
1410
1411 UPDATE :
1412 ******************************************************************************/
resetNet(arglist_type * arglist)1413 void resetNet(arglist_type *arglist)
1414 {
1415 Val_type val;
1416 Data_type type;
1417
1418 krui_resetNet();
1419
1420 if(!message_flag)
1421 {
1422 fprintf(log_file,"# Net has been reset\n");
1423 fflush(log_file);
1424 }
1425
1426 /* update built-in variable: */
1427 val.int_val = 0;
1428 type = INT;
1429 st_set_val_type(st_lookup("CYCLES"), type, val);
1430 }
1431
1432
1433 /*****************************************************************************
1434 FUNCTION : loadNet
1435
1436 PURPOSE : loads a network file
1437 Parameter: network file
1438 RETURNS :
1439 NOTES : resets the value of CYCLES
1440
1441 UPDATE :
1442 ******************************************************************************/
loadNet(arglist_type * arglist)1443 void loadNet(arglist_type *arglist)
1444 {
1445 krui_err kr_err;
1446 Val_type val;
1447 Data_type type;
1448
1449 if (arglist == ARG_NULL)
1450 err_prt("Missing network filename");
1451
1452 st_get_val_type(arglist->arg_ptr, &type, &val);
1453 chck_type(STRING, type);
1454
1455 kr_err = krui_loadNet(val.string_val, &netname);
1456 kernel_error(kr_err);
1457
1458 if(!message_flag)
1459 {
1460 fprintf(log_file,"# Net %s loaded\n", val.string_val);
1461 fflush(log_file);
1462 }
1463
1464 if (arglist->next != ARG_NULL)
1465 warn_prt(WRN_FMATE);
1466
1467 /* update built-in variable: */
1468 val.int_val = 0;
1469 type = INT;
1470 st_set_val_type(st_lookup("CYCLES"), type, val);
1471
1472 init_net_flag = FALSE; /* maybe the user wants a new init function? */
1473 }
1474
1475
1476 /*****************************************************************************
1477 FUNCTION : saveNet
1478
1479 PURPOSE : saves a network
1480 Parameter: network file name
1481 RETURNS :
1482 NOTES :
1483
1484 UPDATE :
1485 ******************************************************************************/
saveNet(arglist_type * arglist)1486 void saveNet(arglist_type *arglist)
1487 {
1488 krui_err kr_err;
1489 Val_type val;
1490 Data_type type;
1491
1492 if (arglist == ARG_NULL)
1493 err_prt("Missing network filename");
1494
1495 st_get_val_type(arglist->arg_ptr, &type, &val);
1496 chck_type(STRING, type);
1497
1498 kr_err = krui_saveNet(val.string_val, netname);
1499 kernel_error(kr_err);
1500
1501 if(!message_flag)
1502 {
1503 fprintf(log_file,"# Network file %s written\n", val.string_val);
1504 fflush(log_file);
1505 }
1506
1507 if (arglist->next != ARG_NULL)
1508 warn_prt(WRN_FMATE);
1509 }
1510
1511
1512 /*****************************************************************************
1513 FUNCTION : saveResult
1514
1515 PURPOSE : saves a result file
1516 1st parameter: result file name
1517 optional parameters: start pattern, end pattern,
1518 include input, include output
1519 file mode: create | append
1520 RETURNS :
1521 NOTES :
1522
1523 UPDATE :
1524 ******************************************************************************/
saveResult(arglist_type * arglist)1525 void saveResult(arglist_type *arglist)
1526 {
1527 krui_err kr_err;
1528 Val_type val;
1529 Data_type type;
1530 int i;
1531 char *filename;
1532 bool create = TRUE,
1533 incl_inp = TRUE,
1534 incl_out = FALSE;
1535 int start_pat = 1,
1536 end_pat;
1537
1538 end_pat = krui_getNoOfPatterns();
1539
1540 if (arglist == ARG_NULL)
1541 err_prt("Missing result filename");
1542
1543 /* get parameters: filename */
1544 st_get_val_type(arglist->arg_ptr, &type, &val);
1545 chck_type(STRING, type);
1546 filename = val.string_val;
1547 arglist = arglist->next;
1548
1549 /* start- & endpattern numbers: */
1550 if (arglist != ARG_NULL)
1551 {
1552 st_get_val_type(arglist->arg_ptr, &type, &val);
1553 if(type == INT)
1554 start_pat = val.int_val;
1555 else if(type == REAL)
1556 start_pat = (int)val.real_val;
1557 else
1558 err_prt("Integer value argument expected");
1559 arglist = arglist->next;
1560 }
1561
1562 if (arglist != ARG_NULL)
1563 {
1564 st_get_val_type(arglist->arg_ptr, &type, &val);
1565 if(type == INT)
1566 end_pat = val.int_val;
1567 else if(type == REAL)
1568 end_pat = (int)val.real_val;
1569 else
1570 err_prt("Integer value argument expected");
1571 arglist = arglist->next;
1572 }
1573
1574 /* include-input, include-output flags: */
1575 if (arglist != ARG_NULL)
1576 {
1577 st_get_val_type(arglist->arg_ptr, &type, &val);
1578 chck_type(BOOL, type);
1579 incl_inp = val.bool_val;
1580 arglist = arglist->next;
1581 }
1582
1583 if (arglist != ARG_NULL)
1584 {
1585 st_get_val_type(arglist->arg_ptr, &type, &val);
1586 chck_type(BOOL, type);
1587 incl_out = val.bool_val;
1588 arglist = arglist->next;
1589 }
1590
1591 /* file mode: create | append: */
1592 if (arglist != ARG_NULL)
1593 {
1594 st_get_val_type(arglist->arg_ptr, &type, &val);
1595 chck_type(STRING, type);
1596 if (strcmp(val.string_val, "append") == 0)
1597 create = FALSE;
1598 else
1599 if (strcmp(val.string_val, "create") != 0)
1600 warn_prt
1601 ("Either \"create\" or \"append\" as file mode expected; using create");
1602 arglist = arglist->next;
1603 }
1604
1605 /* define subpattern shifting scheme: */
1606 defSubpattern();
1607
1608 /* initialize update parameter array if not already done: */
1609 if (! init_update_flag)
1610 {
1611 for(i=0; i<NO_OF_UPDATE_PARAMS; i++) update_param_array[i] = 0.0;
1612 init_update_flag = TRUE;
1613 }
1614
1615 kr_err = krui_saveResultParam(filename, create,
1616 start_pat, end_pat,
1617 incl_inp, incl_out,
1618 update_param_array,
1619 noOfUpdateParam);
1620 kernel_error(kr_err);
1621
1622 if(!message_flag)
1623 {
1624 fprintf(log_file,"# Result file %s written\n", filename);
1625 fflush(log_file);
1626 }
1627
1628 if (arglist != ARG_NULL)
1629 warn_prt(WRN_FMATE);
1630 }
1631
1632
1633 /*****************************************************************************
1634 FUNCTION : trainNet
1635
1636 PURPOSE : trains the network one cycle with the current patternset
1637 Parameters: none
1638 RETURNS :
1639 NOTES : sets the values of SSE, MSE, SSEPU, CYCLES
1640
1641 UPDATE :
1642 ******************************************************************************/
trainNet(arglist_type * arglist)1643 void trainNet(arglist_type *arglist)
1644 {
1645 krui_err kr_err;
1646 Val_type val;
1647 Data_type type;
1648 float *return_values;
1649 int NoOfOutParams;
1650 int i;
1651
1652 if (arglist != ARG_NULL)
1653 warn_prt(WRN_NFAE);
1654
1655 /* initialize learn parameter array if not already done: */
1656 if (! init_learn_flag)
1657 {
1658 learn_param_array[0] = 0.2;
1659 for(i=1; i<NO_OF_LEARN_PARAMS; i++) learn_param_array[i] = 0.0;
1660 init_learn_flag = TRUE;
1661 }
1662
1663 /* define subpattern shifting scheme: */
1664 defSubpattern();
1665
1666 kr_err =
1667 krui_learnAllPatterns(learn_param_array,
1668 NO_OF_LEARN_PARAMS,
1669 &return_values, &NoOfOutParams);
1670 kernel_error(kr_err);
1671
1672 /* update built-in variables: errors and training cycles*/
1673 val.real_val = return_values[0];
1674 type = REAL;
1675 st_set_val_type(st_lookup("SSE"), type, val);
1676
1677 val.real_val = return_values[0] / krui_getTotalNoOfSubPatterns();
1678 type = REAL;
1679 st_set_val_type(st_lookup("MSE"), type, val);
1680
1681 /* set built-in variable SSEPU only if output units are present: */
1682 if (krui_getNoOfOutputUnits() != 0){
1683 val.real_val = return_values[0] / krui_getNoOfOutputUnits();
1684 type = REAL;
1685 }else
1686 type = UNKNOWN;
1687
1688 st_set_val_type(st_lookup("SSEPU"), type, val);
1689
1690 /* increment the value of CYCLES: */
1691 st_get_val_type(st_lookup("CYCLES"), &type, &val);
1692 val.int_val++;
1693 st_set_val_type(st_lookup("CYCLES"), type, val);
1694 }
1695
1696
1697 /*****************************************************************************
1698 FUNCTION : testNet
1699
1700 PURPOSE : tests the network with the current patternset
1701 Parameters: none
1702 RETURNS :
1703 NOTES : sets the values of SSE, MSE, SSEPU
1704
1705 UPDATE :
1706 ******************************************************************************/
testNet(arglist_type * arglist)1707 void testNet(arglist_type *arglist)
1708 {
1709 krui_err kr_err;
1710 Val_type val;
1711 Data_type type;
1712 float *return_values;
1713 int NoOfOutParams;
1714
1715 if (arglist != ARG_NULL)
1716 warn_prt(WRN_NFAE);
1717
1718 /* define subpattern shifting scheme: */
1719 defSubpattern();
1720
1721 kr_err =
1722 krui_testAllPatterns(learn_param_array,
1723 NO_OF_LEARN_PARAMS,
1724 &return_values, &NoOfOutParams);
1725 kernel_error(kr_err);
1726
1727 /* update built-in variables: errors and training cycles*/
1728 val.real_val = return_values[0];
1729 type = REAL;
1730 st_set_val_type(st_lookup("SSE"), type, val);
1731
1732 val.real_val = return_values[0] / krui_getTotalNoOfSubPatterns();
1733 type = REAL;
1734 st_set_val_type(st_lookup("MSE"), type, val);
1735
1736 /* set built-in variable SSEPU only if output units are present: */
1737 if (krui_getNoOfOutputUnits() != 0){
1738 val.real_val = return_values[0] / krui_getNoOfOutputUnits();
1739 type = REAL;
1740 }else
1741 type = UNKNOWN;
1742
1743 st_set_val_type(st_lookup("SSEPU"), type, val);
1744 }
1745
1746
1747
1748 /*****************************************************************************
1749 FUNCTION : pruneNet
1750
1751 PURPOSE : prune the net using the pruning parameters
1752 RETURNS :
1753 NOTES : function taken from snnsbat.c with minor changes
1754
1755 UPDATE :
1756 ******************************************************************************/
pruneNet(arglist_type * arglist)1757 void pruneNet(arglist_type *arglist)
1758 {
1759 krui_err kr_err;
1760 char *tmp_file1;
1761 float first_error,
1762 max_error,
1763 net_error;
1764
1765 first_error = trainFFNet(first_train_cyc);
1766 max_error = first_error * (1 + max_error_incr / 100);
1767 if (max_error < accepted_error) max_error = accepted_error;
1768
1769 if (recreate)
1770 if ((tmp_file1 = tempnam("./", "batch")) == NULL)
1771 err_prt("Cannot create temporary file");
1772
1773 do
1774 {
1775 if (recreate)
1776 {
1777 kr_err = krui_saveNet(tmp_file1, netname);
1778 kernel_error(kr_err);
1779 }
1780
1781 kr_err = pr_callPrunFunc(PR_ALL_PATTERNS);
1782 kernel_error(kr_err);
1783
1784 kr_err = pr_calcMeanDeviation (PR_ALL_PATTERNS, &net_error);
1785 kernel_error(kr_err);
1786
1787 if (net_error > min_error_to_stop)
1788 net_error = trainFFNet(retrain_cyc);
1789 }
1790 while (net_error <= max_error);
1791
1792 if (recreate)
1793 {
1794 krui_loadNet(tmp_file1, &netname);
1795 kernel_error(kr_err);
1796 }
1797 unlink(tmp_file1);
1798 }
1799
1800 /*****************************************************************************
1801 FUNCTION : pruneTrainNet
1802 PURPOSE : pruning: Train one Cycle with pruning-function
1803 RETURNS :
1804 NOTES : function taken pruneNet with minor changes
1805 sets the values of SSE, MSE, SSEPU, CYCLES
1806 UPDATE :
1807 ******************************************************************************/
pruneTrainNet(arglist_type * arglist)1808 void pruneTrainNet(arglist_type *arglist)
1809 {
1810 Val_type val;
1811 Data_type type;
1812 float net_error;
1813
1814
1815 net_error = trainFFNet(1);
1816
1817 val.real_val = net_error;
1818 type = REAL;
1819 st_set_val_type(st_lookup("SSE"), type, val);
1820
1821 val.real_val = net_error / krui_getNoOfPatterns();
1822 type = REAL;
1823 st_set_val_type(st_lookup("MSE"), type, val);
1824
1825 /* set built-in variable SSEPU only if output units are present: */
1826 if (krui_getNoOfOutputUnits() != 0)
1827 {
1828 val.real_val = net_error / krui_getNoOfOutputUnits();
1829 type = REAL;
1830 }
1831 else
1832 type = UNKNOWN;
1833
1834 st_set_val_type(st_lookup("SSEPU"), type, val);
1835
1836 /* increment the value of CYCLES: */
1837 st_get_val_type(st_lookup("CYCLES"), &type, &val);
1838 val.int_val++;
1839 st_set_val_type(st_lookup("CYCLES"), type, val);
1840 }
1841
1842 /*****************************************************************************
1843 FUNCTION : pruneNetNow
1844
1845 PURPOSE : pruning: prune Net and calc error of new net
1846 RETURNS :
1847 NOTES : function taken pruneNet with minor changes
1848 sets the values of SSE, MSE, SSEPU
1849 UPDATE :
1850 ******************************************************************************/
pruneNetNow(arglist_type * arglist)1851 void pruneNetNow(arglist_type *arglist)
1852 {
1853 krui_err kr_err;
1854 Val_type val;
1855 Data_type type;
1856 float net_error;
1857
1858 kr_err = pr_callPrunFunc(PR_ALL_PATTERNS);
1859 kernel_error(kr_err);
1860
1861 kr_err = pr_calcMeanDeviation (PR_ALL_PATTERNS, &net_error);
1862 kernel_error(kr_err);
1863
1864 val.real_val = net_error;
1865 type = REAL;
1866 st_set_val_type(st_lookup("SSE"), type, val);
1867
1868 val.real_val = net_error / krui_getNoOfPatterns();
1869 type = REAL;
1870 st_set_val_type(st_lookup("MSE"), type, val);
1871
1872 /* set built-in variable SSEPU only if output units are present: */
1873 if (krui_getNoOfOutputUnits() != 0)
1874 {
1875 val.real_val = net_error / krui_getNoOfOutputUnits();
1876 type = REAL;
1877 }
1878 else
1879 type = UNKNOWN;
1880
1881 st_set_val_type(st_lookup("SSEPU"), type, val);
1882
1883 }
1884
1885
1886
1887 /*****************************************************************************
1888 FUNCTION : setActFunc
1889
1890 PURPOSE : sets the Activation Funtion for all Units or Units with
1891 a define type
1892 RETURNS :
1893 NOTES : call: setActFunc(<Type>, <new Activation Funktion Name>)
1894 with: Type=0 for all Units and
1895 Type=1... (see kernel/sources/glob_typ.h section
1896 Topological Unit Types near line 261)
1897
1898 UPDATE : 31.03.1998 by Thomas Rausch
1899 ******************************************************************************/
setActFunc(arglist_type * arglist)1900 void setActFunc(arglist_type *arglist)
1901 {
1902 Val_type val;
1903 Data_type type;
1904 int i, unit_type;
1905
1906 /* reading parameters: */
1907
1908 /* get parameter 1: Unittype for changing activation function */
1909 if (arglist != ARG_NULL) {
1910 st_get_val_type(arglist->arg_ptr, &type, &val);
1911 if(type == INT)
1912 unit_type = val.int_val;
1913 else if(type == REAL)
1914 unit_type = (int)val.real_val;
1915 else
1916 err_prt("Integer value argument expected");
1917 arglist = arglist->next;
1918 }
1919
1920 /* get parameter 2: New Activation Function Name */
1921 if (arglist == ARG_NULL) {
1922 err_prt("Not enough parameters!\n");
1923 return;
1924 }
1925
1926 /* check for valid function name */
1927 st_get_val_type(arglist->arg_ptr, &type, &val);
1928 chck_type(STRING, type);
1929 if( !krui_isFunction(val.string_val, ACT_FUNC) ) {
1930 if (message_flag) {
1931 fprintf(log_file, "# Unknown activation function name %s", val.string_val);
1932 fflush(log_file);
1933 }
1934 err_prt("Unknown activation function name");
1935 return;
1936 }
1937
1938 /* set the new function */
1939 strcpy(init_fct, val.string_val);
1940 for (i=1; i<=krui_getNoOfUnits(); i++) {
1941 if ((krui_getUnitTType(i)==unit_type) || (unit_type==0))
1942 krui_setUnitActFunc(i, init_fct);
1943 }
1944
1945 /* make a note in the log file */
1946 if (message_flag) {
1947 if (unit_type==0)
1948 fprintf(log_file,"# Activation function for all Units is now %s\n", init_fct);
1949 else {
1950 fprintf(log_file, "# Activation function for all Units with Type ");
1951
1952 switch (unit_type) {
1953 case INPUT:
1954 fprintf(log_file, "INPUT");
1955 break;
1956 case OUTPUT:
1957 fprintf(log_file, "OUTPUT");
1958 break;
1959 case HIDDEN:
1960 fprintf(log_file, "HIDDEN");
1961 break;
1962 case DUAL:
1963 fprintf(log_file, "DUAL");
1964 break;
1965 case SPECIAL:
1966 fprintf(log_file, "SPECIAL");
1967 break;
1968 case SPECIAL_I:
1969 fprintf(log_file, "SPECIAL_I");
1970 break;
1971 case SPECIAL_O:
1972 fprintf(log_file, "SPECIAL_O");
1973 break;
1974 case SPECIAL_H:
1975 fprintf(log_file, "SPECIAL_H");
1976 break;
1977 case SPECIAL_D:
1978 fprintf(log_file, "SPECIAL_D");
1979 break;
1980 case SPECIAL_X:
1981 fprintf(log_file, "SPECIAL_X");
1982 break;
1983 case N_SPECIAL_X:
1984 fprintf(log_file, "N_SPECIAL_X");
1985 break;
1986 default:
1987 fprintf(log_file, "%i", unit_type);
1988 };
1989 fprintf(log_file, " is now %s\n", init_fct);
1990 }
1991 fflush(log_file);
1992 }
1993
1994 /* is arg list empty? */
1995 if (arglist->next != ARG_NULL)
1996 warn_prt(WRN_FMATE);
1997 }
1998
1999
2000
2001 /*****************************************************************************
2002 FUNCTION : delCandUnits
2003
2004 PURPOSE : Cascade Correlation: deletes the candidate units
2005 RETURNS :
2006 NOTES :
2007
2008 UPDATE :
2009 ******************************************************************************/
delCandUnits(arglist_type * arglist)2010 void delCandUnits(arglist_type *arglist)
2011 {
2012 if(!message_flag)
2013 {
2014 fprintf(log_file,"# Old call to delCandUnits ignored\n");
2015 fflush(log_file);
2016 }
2017 }
2018
2019
2020
2021 /*****************************************************************************
2022 FUNCTION : loadPattern
2023
2024 PURPOSE : loads a pattern file
2025 Parameter: pattern file name
2026 RETURNS :
2027 NOTES : sets the value of PAT
2028
2029 UPDATE :
2030 ******************************************************************************/
loadPattern(arglist_type * arglist)2031 void loadPattern(arglist_type *arglist)
2032 {
2033 krui_err kr_err;
2034 Val_type val;
2035 Data_type type;
2036
2037 if (arglist == ARG_NULL)
2038 err_prt(ERR_MPF);
2039
2040 /* get pattern name: */
2041 st_get_val_type(arglist->arg_ptr, &type, &val);
2042 chck_type(STRING, type);
2043
2044 kr_err = krui_loadNewPatterns(val.string_val, &curr_patSet);
2045 kernel_error(kr_err);
2046 enter_patName(arglist->arg_ptr);
2047
2048 if(!message_flag)
2049 {
2050 fprintf(log_file,"# Patternset %s loaded; %d patternset(s) in memory\n",
2051 val.string_val, pat_sets_loaded);
2052 fflush(log_file);
2053 }
2054
2055 if (arglist->next != ARG_NULL)
2056 warn_prt(WRN_FMATE);
2057
2058 /* update built-in variable: */
2059 val.int_val = krui_getNoOfPatterns();
2060 type = INT;
2061 st_set_val_type(st_lookup("PAT"), type, val);
2062 }
2063
2064
2065 /*****************************************************************************
2066 FUNCTION : setPattern
2067
2068 PURPOSE : makes the named patternset the current
2069 Parameter: pattern file name
2070 RETURNS :
2071 NOTES : sets the value of PAT
2072
2073 UPDATE :
2074 ******************************************************************************/
setPattern(arglist_type * arglist)2075 void setPattern(arglist_type *arglist)
2076 {
2077 krui_err kr_err;
2078 Val_type val;
2079 Data_type type;
2080
2081 if (arglist == ARG_NULL)
2082 err_prt("Missing pattern filename");
2083
2084 /* get pattern name: */
2085 st_get_val_type(arglist->arg_ptr, &type, &val);
2086 chck_type(STRING, type);
2087
2088 curr_patSet = lookup_patName(arglist->arg_ptr);
2089 kr_err = kr_npui_setCurrPatSet(curr_patSet);
2090 kernel_error(kr_err);
2091
2092 if(!message_flag)
2093 {
2094 fprintf(log_file,"# Patternset is now %s\n", val.string_val);
2095 fflush(log_file);
2096 }
2097
2098 if (arglist->next != ARG_NULL)
2099 warn_prt(WRN_FMATE);
2100
2101 /* update built-in variable: */
2102 val.int_val = krui_getNoOfPatterns();
2103 type = INT;
2104 st_set_val_type(st_lookup("PAT"), type, val);
2105 }
2106
2107
2108 /*****************************************************************************
2109 FUNCTION : delPattern
2110
2111 PURPOSE : deletes the named patternset
2112 Parameter: pattern file name
2113 RETURNS :
2114 NOTES : resets the value of PAT
2115
2116 UPDATE :
2117 ******************************************************************************/
delPattern(arglist_type * arglist)2118 void delPattern(arglist_type *arglist)
2119 {
2120 krui_err kr_err;
2121 Val_type val;
2122 Data_type type;
2123
2124 if (arglist == ARG_NULL)
2125 err_prt(ERR_MPF);
2126
2127 /* get pattern name: */
2128 st_get_val_type(arglist->arg_ptr, &type, &val);
2129 chck_type(STRING, type);
2130
2131 kr_err = kr_npui_deletePatSet(lookup_patName(arglist->arg_ptr));
2132 kernel_error(kr_err);
2133
2134 del_patName(lookup_patName(arglist->arg_ptr));
2135
2136 if(!message_flag)
2137 {
2138 fprintf(log_file,"# Patternset %s deleted; %d patternset(s) in memory\n",
2139 val.string_val, pat_sets_loaded);
2140 fflush(log_file);
2141 }
2142
2143 if (pat_sets_loaded != 0){
2144 /* if current patset is deleted, make patset 0 the current one: */
2145 kr_err = kr_npui_setCurrPatSet(curr_patSet);
2146 kernel_error(kr_err);
2147
2148 /* lookup name of patset and display it: */
2149 st_get_val_type(lookup_patNumber(curr_patSet), &type, &val);
2150
2151 if(!message_flag)
2152 {
2153 fprintf(log_file, "# Patternset is now %s\n", val.string_val);
2154 fflush(log_file);
2155 }
2156 val.int_val = krui_getNoOfPatterns();
2157 }
2158 else{
2159 val.int_val = 0;
2160 if(!message_flag)
2161 {
2162 fprintf(log_file, "# No Patternset actually loaded.\n");
2163 fflush(log_file);
2164 }
2165 }
2166
2167 if (arglist->next != ARG_NULL)
2168 warn_prt(WRN_FMATE);
2169
2170 /* update built-in variable: */
2171 type = INT;
2172 st_set_val_type(st_lookup("PAT"), type, val);
2173 }
2174
2175 /*****************************************************************************
2176 FUNCTION : setSeed
2177
2178 PURPOSE : sets the seed for the pseudo random generator
2179 Parameter: (optional) seed_value
2180 RETURNS :
2181 NOTES :
2182
2183 UPDATE :
2184 ******************************************************************************/
setSeed(arglist_type * arglist)2185 void setSeed(arglist_type *arglist)
2186 {
2187 Val_type val;
2188 Data_type type;
2189 long int seed;
2190
2191 if (arglist == ARG_NULL)
2192 seed = time(NULL);
2193 else{
2194 /* get seed value */
2195 st_get_val_type(arglist->arg_ptr, &type, &val);
2196 if(type == INT)
2197 seed = val.int_val;
2198 else if(type == REAL)
2199 seed = (int)val.real_val;
2200 else
2201 err_prt("Integer value argument expected");
2202 if (arglist->next != ARG_NULL)
2203 warn_prt(WRN_FMATE);
2204 }
2205
2206 krui_setSeedNo(seed);
2207
2208 return;
2209 }
2210
2211 /*****************************************************************************
2212 FUNCTION : jogWeights
2213
2214 PURPOSE : adds (multiplies) noise to the link weights
2215 Parameter: minus, plus noise boundary
2216 RETURNS :
2217 NOTES :
2218
2219 UPDATE :
2220 ******************************************************************************/
jogWeights(arglist_type * arglist)2221 void jogWeights(arglist_type *arglist)
2222 {
2223
2224 Val_type val;
2225 Data_type type;
2226
2227 float jog_minus, jog_plus;
2228
2229 jog_minus = -0.001;
2230 jog_plus = 0.001;
2231
2232 if (arglist != ARG_NULL)
2233 {
2234 st_get_val_type(arglist->arg_ptr, &type, &val);
2235 chck_type(REAL, type);
2236 jog_minus = val.real_val;
2237 arglist = arglist->next;
2238 }
2239
2240 if (arglist != ARG_NULL)
2241 {
2242 st_get_val_type(arglist->arg_ptr, &type, &val);
2243 chck_type(REAL, type);
2244 jog_plus = val.real_val;
2245 arglist = arglist->next;
2246 }
2247
2248 krui_jogWeights(jog_minus, jog_plus);
2249
2250 if(!message_flag)
2251 {
2252 fprintf(log_file,"# weights jogged\n");
2253 fflush(log_file);
2254 }
2255
2256 if (arglist != ARG_NULL)
2257 warn_prt(WRN_FMATE);
2258 }
2259
2260 /*****************************************************************************
2261 FUNCTION : jogCorrWeights
2262
2263 PURPOSE : adds (multiplies) noise to the link weights of correlated hiddens
2264 Parameter: minus, plus noise boundary
2265 RETURNS :
2266 NOTES :
2267
2268 UPDATE :
2269 ******************************************************************************/
jogCorrWeights(arglist_type * arglist)2270 void jogCorrWeights(arglist_type *arglist)
2271 {
2272
2273 krui_err kr_err;
2274 Val_type val;
2275 Data_type type;
2276
2277 float jog_minus, jog_plus, jog_correlation;
2278
2279 jog_minus = -0.001;
2280 jog_plus = 0.001;
2281 jog_correlation = 0.98;
2282
2283 if (arglist != ARG_NULL)
2284 {
2285 st_get_val_type(arglist->arg_ptr, &type, &val);
2286 chck_type(REAL, type);
2287 jog_minus = val.real_val;
2288 arglist = arglist->next;
2289 }
2290
2291 if (arglist != ARG_NULL)
2292 {
2293 st_get_val_type(arglist->arg_ptr, &type, &val);
2294 chck_type(REAL, type);
2295 jog_plus = val.real_val;
2296 arglist = arglist->next;
2297 }
2298
2299 if (arglist != ARG_NULL)
2300 {
2301 st_get_val_type(arglist->arg_ptr, &type, &val);
2302 chck_type(REAL, type);
2303 jog_correlation = val.real_val;
2304 arglist = arglist->next;
2305 }
2306
2307 kr_err = krui_jogCorrWeights(jog_minus, jog_plus, jog_correlation);
2308 kernel_error(kr_err);
2309
2310 if(!message_flag)
2311 {
2312 fprintf(log_file,"# weights of correlated hiddens jogged\n");
2313 fflush(log_file);
2314 }
2315
2316 if (arglist != ARG_NULL)
2317 warn_prt(WRN_FMATE);
2318 }
2319