home *** CD-ROM | disk | FTP | other *** search
-
- :- module exec.
-
- /*
- This is the main part of the BNET neural network, implemented in
- Arity Prolog. However, some of the I/O uses Instant Recall's Prolog
- Tools. If you don't have these tools, here is how you can run this
- program:
-
- 1. Define trace_message either to trivially succeed, or so that
- when its first argument succeeds, it writes out its last two
- aarguments.
-
- 2. Define getglobal / 2 and setglobal / 2 to set and get the
- values of a global variable.
-
- 3. Comment out init_log_file and close_log_file.
-
- 4. Change the log_xxx predicates to simply xxx (e.g. log_write to write).
- */
-
-
-
- :- extrn trace_message / 3 : far.
- :- extrn getglobal / 2 : far .
- :- extrn setglobal / 2 : far .
- :- extrn net_trace / 1 : interp .
- :- extrn number_data_items / 1 : interp .
- :- extrn learning_rate / 1 : interp .
- :- extrn neuron_change / 3 : interp .
- :- extrn input / 3 : interp.
- :- extrn output / 3 : interp.
- :- extrn state / 6 : interp.
- :- extrn state / 5 : interp.
- :- extrn net_trace / 0 : interp.
- :- extrn neuron_change / 4 : interp.
- :- extrn neuron / 3 : interp.
- :- extrn init_log_file / 0:far.
- :- extrn close_log_file / 0 : far.
- :- extrn log_put / 1 : far.
- :- extrn log_nl / 0 : far.
- :- extrn log_tab / 1 : far.
- :- extrn log_write / 1 : far.
-
- :- visible write_out_net_hlpr / 1.
-
- :- public main_hlpr / 0 : far.
-
- main_hlpr :-
- signon,
- init_log_file,
- reconsult( $net.cfg$),
- get_net,
- !,
- run_net,
- close_log_file .
-
- signon :-
- MESSAGE = $
-
-
- BAYSEAN OR OF ANDS NETWORK
-
- (C) Copyright 1989 by Instant Recall
- All rights reserved.
-
- Instant Recall
- P.O. Box 30134
- Bethesda, Md. 20814
- (301) 530-0898
-
- Under the licence granted by Instant Recall you can
- use this program non-commercially provided you
- leave the copyright notice in all unchanged copies
- of the program. This program may not be used
- commercially except by written permission of
- Instant Recall.
-
-
- >> I agree to these conditions for use of the program ( y or n) :$,
- cls,
- log_write( MESSAGE),
- get0_noecho( C ),
- log_put( C ),
- ( C == `y ; C == `Y ),
- log_nl.
- get_net :-
- write($Name of net : $),
- flush,
- read_string( 100, X),
- reconsult( X ),
- nl.
-
-
- get_cycles( CYCLES ) :-
- write($Number of cycles : $),
- flush,
- read_string( 100, X),
- int_text( CYCLES, X ),
- nl.
-
- run_net :-
- get_cycles( CYCLES ),
- trace_message( net_trace,
- $e run_net$,
- $$ ),
- set_network_clock( 0 ),
- repeat,
- get_network_clock( TIME ),
- cycle1( TIME ),
- increment_network_clock( TIME1),
- TIME1 = CYCLES,
- save_net( CYCLES ).
-
-
- %%%%%%%%%%%%%%% cycle1 - run net at time T %%%%%%%%%%%%%%%%%%%%%%%%%%%
-
- cycle1( TIME ) :-
- trace_message( net_trace,
- $e cycle1, TIME =$,
- TIME ),
- clean_up( TIME ),
- find_data_key( TIME, KEY ),
- trace_message( net_trace,
- $...KEY =$,
- KEY ),
- run1( TIME, KEY ),
- report_performance( TIME, KEY ) ,
- adjust( TIME, KEY ).
-
- report_performance( TIME, KEY ) :-
- log_write( $Errors at time $),
- log_write( TIME ),
- log_write( $ : $),
- call( state( neuron,
- or ,
- NEURON_NUMBER,
- TIME,
- ACTIVATION ) ),
- call( output( KEY, NEURON_NUMBER, DESIRED )),
- ERROR is DESIRED - ACTIVATION,
- log_write( NEURON_NUMBER ),
- log_tab(1),
- log_write( ERROR ),
- log_nl,
- fail.
- report_performance( _ , _ ) :- !.
-
-
- net_output_error.
-
-
- save_net( TIME ) :-
- write($Net save file: $),
- flush,
- read_string( 12 , X),
- write_out_net_hlpr( TIME ) ,
- stdout( X, write_out_net_hlpr( TIME ) ).
-
- write_out_net_hlpr( TIME ) :-
- listing( number_data_items ),
- listing( input ),
- listing( output ),
- listing( neuron ),
- write_out_edges( TIME ) .
-
- write_out_edges( TIME ) :-
- call( state( edge,
- KIND,
- INPUT_NEURON ,
- OUTPUT_NEURON,
- TIME,
- ACTIVATION)),
- writeq( state( edge,
- KIND,
- INPUT_NEURON ,
- OUTPUT_NEURON,
- 0 ,
- ACTIVATION)),
- put(`.),
- nl,
- fail.
- write_out_edges( _ ) :- !.
-
-
-
- :- mode increment_network_clock( - ).
-
- increment_network_clock( TIME ) :-
- getglobal( time, TIME0),
- !,
- TIME is TIME0 +1,
- setglobal( time, TIME ).
-
- increment_network_clock( 0 ) :-
- setglobal( time, 0 ).
-
- set_network_clock( TIME ) :-
- setglobal( time, TIME ).
-
- get_network_clock( TIME ) :-
- getglobal( time, TIME ).
-
- run1( TIME , KEY ) :-
- trace_message( net_trace,
- $e run1, TIME = $,
- TIME ),
- input_neuron_activations( TIME, KEY ),
- !,
- not_neuron_activations( TIME , KEY ),
- !,
- and_neuron_activations( TIME , KEY ),
- !,
- or_neuron_activations( TIME , KEY ),
- trace_message( net_trace,
- $x run1, TIME = $,
- TIME ),
- trace_net_edges( TIME ),
- !,
- trace_net_activations( TIME ).
-
- trace_net_activations( TIME ) :-
- call( cycle_trace),
- log_write( $Activations at $),
- log_write( TIME ),
- log_nl,
- call( state( neuron,
- _ ,
- NEURON_NUMBER,
- TIME,
- ACTIVATION)),
- log_write( NEURON_NUMBER ),
- log_tab(1),
- log_write( ACTIVATION ),
- log_nl,
- fail.
- trace_net_activations( _ ) :- !.
-
- trace_net_edges( TIME ) :-
- call( cycle_trace),
- log_write( $Edges at $),
- log_write( TIME ),
- log_nl,
- call( state( edge ,
- _ ,
- INPUT_NUMBER,
- OUTPUT_NUMBER,
- TIME,
- ACTIVATION)),
- log_write( INPUT_NUMBER ),
- log_tab(1),
- log_write( OUTPUT_NUMBER ),
- log_tab(1),
- log_write( ACTIVATION ),
- log_nl,
- fail.
- trace_net_edges( _ ) :- !.
-
-
- adjust( TIME , KEY ) :-
- trace_message( net_trace,
- $e adjust1, TIME = $,
- TIME ),
- adjust_or_edges( TIME , KEY ),
- !,
- adjust_and_edges( TIME , KEY ),
- trace_message( net_trace,
- $x adjust1, TIME = $,
- TIME ).
-
-
- clean_up( TIME ) :-
- TIME2 is TIME - 2,
- retractall( neuron_change( _, % KIND,
- TIME2,
- _ , % INPUT_NEURON,
- _ /* TOTAL_CHANGE */ )),
- retractall( state( edge ,
- _, % type
- _ , % INPUT_NEURON,
- _ , % OUTPUT_NEURON,
- TIME2,
- _ /* NEW */ ) ),
- retractall( state( neuron,
- _, % type
- _ , % number ,
- TIME2,
- _ /* NEW */ ) ).
-
- find_data_key( TIME, KEY ) :-
- call( number_data_items( MOD ) ),
- KEY is TIME mod MOD .
-
-
-
- %%%%%%%%%%%%%%% compute activations of neurons %%%%%%%%%%%%%%%%%%%%%%%
-
- input_neuron_activations( TIME, KEY ) :-
- call( input( KEY, NEURON_NUMBER, ACTIVATION) ),
- asserta( state( neuron,
- input ,
- NEURON_NUMBER,
- TIME,
- ACTIVATION)),
- fail.
- input_neuron_activations( _ , _ ).
-
- not_neuron_activations( TIME , KEY ) :-
- trace_message( not_trace,
- $e not_neuron_activations, args = $,
- [ TIME , KEY ] ),
- call( neuron( not( NEURON_NUMBER2 ) , NEURON_NUMBER , _ )),
- trace_message( not_trace,
- $...NEURON_NUMBER = $,
- NEURON_NUMBER ),
- call( input( KEY, NEURON_NUMBER2, ACTIVATION) ),
- ACTIVATION2 is 1 - ACTIVATION ,
- trace_message( not_trace,
- $...ACTIVATION2 = $,
- ACTIVATION2 ),
- asserta( state( neuron,
- input ,
- NEURON_NUMBER,
- TIME,
- ACTIVATION2) ),
- fail.
- not_neuron_activations( _ , _ ) :- !.
-
- get_current_neuron_data( KIND, TIME , NUMBER, ACTIVATION ) :-
- TIME > 0,
- TIME0 is TIME - 1,
- call( state( neuron,
- KIND ,
- NUMBER,
- TIME0 ,
- ACTIVATION ) ).
-
- get_current_neuron_data( KIND, _ , NUMBER, ACTIVATION ) :-
- call( neuron( KIND , NUMBER , _ )),
- ( KIND == and,
- ACTIVATION = 0
- ;
- KIND == or,
- ACTIVATION = 1
- ).
-
- and_neuron_activations( TIME , KEY ) :-
- trace_message( and_trace,
- $e and_neuron_activations, TIME = $,
- TIME ),
- get_current_neuron_data( and, TIME , NUMBER, ACTIVATION ),
- trace_message( and_trace,
- $...current activation : $,
- [ NUMBER, ACTIVATION ] ),
- and_neuron_activation( TIME,
- KEY,
- NUMBER,
- ACTIVATION,
- NEW_ACTIVATION ),
- trace_message( and_trace,
- $...new activation : $,
- [ NUMBER, NEW_ACTIVATION ] ),
- fail.
- and_neuron_activations( _ , _ ) :- !.
-
- or_neuron_activations( TIME , KEY ) :-
- trace_message( or_trace,
- $e or_neuron_activations, TIME = $,
- TIME ),
- get_current_neuron_data( or , TIME , NUMBER, ACTIVATION ),
- or_neuron_activation( TIME,
- KEY,
- NUMBER,
- ACTIVATION,
- _ /* NEW_ACTIVATION */ ),
- fail.
- or_neuron_activations( _ , _ ) :- !.
-
-
- and_neuron_activation( TIME,
- _ , % KEY,
- NUMBER,
- _ , % ACTIVATION,
- _ /* NEW_ACTIVATION */ ) :-
- trace_message( and_trace,
- $e and_neuron_activation, NUMBER = $,
- NUMBER ),
- setglobal( temp_and, 1 ),
- call( state( neuron,
- input,
- INPUT_NUMBER,
- TIME,
- INPUT_ACTIVATION ) ),
- trace_message( and_trace,
- $.....INPUT_ACTIVATION = $,
- INPUT_ACTIVATION ),
- call( state( edge ,
- and ,
- INPUT_NUMBER ,
- NUMBER ,
- TIME ,
- EDGE_ACTIVATION ) ) ,
- trace_message( and_trace,
- $.....EDGE_ACTIVATION = $,
- EDGE_ACTIVATION ),
- and_contribution( INPUT_ACTIVATION, EDGE_ACTIVATION, CONTRIBUTION ),
- trace_message( and_trace,
- $.....CONTRIBUTION = $,
- CONTRIBUTION ),
- getglobal( temp_and, SO_FAR ),
- NEW_SO_FAR is SO_FAR * CONTRIBUTION,
- trace_message( and_trace,
- $.....NEW_SO_FAR = $,
- NEW_SO_FAR ),
- setglobal( temp_and, NEW_SO_FAR ),
- fail.
-
- and_neuron_activation( TIME,
- _ , % KEY,
- NUMBER,
- _ , % ACTIVATION,
- NEW_ACTIVATION ) :-
- getglobal( temp_and, NEW_ACTIVATION ),
- retractall( state( neuron, _ , NUMBER, TIME, _ )),
- asserta( state( neuron,
- and ,
- NUMBER,
- TIME,
- NEW_ACTIVATION ) ),
- !.
-
- and_contribution( _ , %INPUT_ACTIVATION,
- EDGE_ACTIVATION,
- CONTRIBUTION ) :-
- EDGE_ACTIVATION ==0,
- CONTRIBUTION = 1,
- !.
- and_contribution( INPUT_ACTIVATION, EDGE_ACTIVATION, CONTRIBUTION ) :-
- power( INPUT_ACTIVATION, EDGE_ACTIVATION, CONTRIBUTION ) .
-
- power( A, B , C ) :-
- A > 0,
- C is exp( ln( A ) * B ),
- !.
- power( _, _ , 0 ) :- !.
-
- or_neuron_activation( TIME,
- _ , % KEY,
- NUMBER,
- _ , % ACTIVATION,
- _ /* NEW_ACTIVATION */ ) :-
- trace_message( or_trace,
- $e or_neuron_activation, NUMBER = $,
- NUMBER ),
- setglobal( temp_or , 0 ),
- call( state( neuron,
- and ,
- INPUT_NUMBER,
- TIME,
- INPUT_ACTIVATION ) ),
- trace_message( or_trace,
- $.....INPUT_ACTIVATION = $,
- INPUT_ACTIVATION ),
- call( state( edge ,
- or ,
- INPUT_NUMBER ,
- NUMBER ,
- TIME ,
- EDGE_ACTIVATION ) ) ,
- trace_message( or_trace,
- $.....EDGE_ACTIVATION = $,
- EDGE_ACTIVATION ),
- getglobal( temp_or , SO_FAR ),
- CONTRIBUTION is EDGE_ACTIVATION
- * INPUT_ACTIVATION
- * ( 1 - SO_FAR ) ,
- trace_message( or_trace,
- $.....CONTRIBUTION = $,
- CONTRIBUTION ),
- NEW_SO_FAR is SO_FAR + CONTRIBUTION ,
- trace_message( or_trace,
- $.....NEW_SO_FAR = $,
- NEW_SO_FAR ),
- setglobal( temp_or , NEW_SO_FAR ),
- fail.
-
- or_neuron_activation( TIME,
- _ , % KEY,
- NUMBER,
- _ , % ACTIVATION,
- NEW_ACTIVATION ) :-
- getglobal( temp_or , NEW_ACTIVATION ),
- retractall( state( neuron, _ , NUMBER, TIME, _ )),
- asserta( state( neuron,
- or ,
- NUMBER,
- TIME,
- NEW_ACTIVATION ) ).
-
-
-
- %%%%%%%%%%%%%%% adjust edge weights %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-
-
- adjust_or_edges( TIME , KEY ) :-
- trace_message( or_learn_trace,
- $e adjust_or_edges, TIME = $,
- TIME ),
- retract( state( edge ,
- or,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ),
- adjust_or_hlpr( KEY,
- state( edge ,
- or,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ) ,
- fail.
- adjust_or_edges( _ , _ ) :- !.
-
- adjust_or_hlpr( KEY,
- state( edge ,
- or,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ) :-
- trace_message( or_learn_trace,
- $...updating $,
- [ INPUT_NEURON, OUTPUT_NEURON ] ),
- call( output( KEY,
- OUTPUT_NEURON,
- DESIRED_OUTPUT )) ,
- !,
- trace_message( or_learn_trace,
- $...DESIRED_OUTPUT = $,
- DESIRED_OUTPUT ),
- call( state( neuron,
- or ,
- OUTPUT_NEURON,
- TIME,
- OUTPUT_ACTIVATION) ),
- !,
- trace_message( or_learn_trace,
- $...OUTPUT_ACTIVATION = $,
- OUTPUT_ACTIVATION ),
- TIME1 is TIME + 1,
- call( state( neuron,
- and ,
- INPUT_NEURON,
- TIME,
- INPUT_ACTIVATION) ),
- !,
- trace_message( or_learn_trace,
- $... INPUT_ACTIVATION = $,
- INPUT_ACTIVATION ),
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- % Edges to output layer, Desired > actual %
- % NEW := CURRENT %
- % +( 1 - CURRENT ) * ( DESIRED - ACTUAL ) * LAYER_2_OUTPUT %
- % Edges to output layer, Desired < actual %
- % NEW := CURRENT %
- % - CURRENT * ( ACTUAL - DESIRED ) * LAYER_2_OUTPUT %
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- ( DESIRED_OUTPUT > OUTPUT_ACTIVATION ,
- NEW is EDGE_ACTIVATION
- +( 1 - EDGE_ACTIVATION )
- * ( DESIRED_OUTPUT - OUTPUT_ACTIVATION )
- * INPUT_ACTIVATION
- ;
- DESIRED_OUTPUT < OUTPUT_ACTIVATION ,
- NEW is EDGE_ACTIVATION
- - EDGE_ACTIVATION
- * ( OUTPUT_ACTIVATION - DESIRED_OUTPUT )
- * INPUT_ACTIVATION
- ;
- DESIRED_OUTPUT == OUTPUT_ACTIVATION ,
- NEW is EDGE_ACTIVATION
- ),
- !,
- trace_message( or_learn_trace,
- $... NEW = $,
- NEW ),
- !,
- CHANGE is NEW - EDGE_ACTIVATION ,
- trace_message( or_learn_trace,
- $... CHANGE = $,
- CHANGE ),
- !,
- weighted_average( EDGE_ACTIVATION ,
- NEW,
- NEW_EDGE_ACTIVATION),
- trace_message( or_learn_trace,
- $... NEW_EDGE_ACTIVATION = $,
- NEW_EDGE_ACTIVATION ),
- retractall( state( edge,
- or,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- _ ) ),
- !,
- TIME1 is TIME + 1,
- assertz( state( edge ,
- or,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME1,
- NEW_EDGE_ACTIVATION ) ),
- % now add component to change in input neuron
- INPUT_NEURON_CHANGE is EDGE_ACTIVATION
- * ( DESIRED_OUTPUT - OUTPUT_ACTIVATION ) ,
- !,
- update_input_neuron_change( and,
- TIME,
- INPUT_NEURON,
- INPUT_NEURON_CHANGE ).
-
- update_input_neuron_change( KIND,
- TIME,
- INPUT_NEURON,
- INPUT_NEURON_CHANGE ) :-
- ( retract( neuron_change( KIND,
- TIME,
- INPUT_NEURON,
- SOFAR )),
- !
- ;
- SOFAR = 0
- ),
- TOTAL_CHANGE is SOFAR + INPUT_NEURON_CHANGE,
- asserta( neuron_change( KIND,
- TIME,
- INPUT_NEURON,
- TOTAL_CHANGE )).
-
-
-
- adjust_and_edges( TIME , _ ) :-
- trace_message( and_learn_trace,
- $e adjust_or_edges, TIME = $,
- TIME ),
- retract( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ),
- adjust_and_hlpr( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ) ,
- fail.
- adjust_and_edges( _ , _ ) :- !.
-
- adjust_and_hlpr( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ) :-
- call( backprop_to_and_edges( off )),
- TIME1 is TIME + 1,
- asserta( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME1,
- EDGE_ACTIVATION ) ) .
-
- adjust_and_hlpr( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- EDGE_ACTIVATION ) ) :-
- call( backprop_to_and_edges( on )),
- trace_message( and_learn_trace,
- $...updating $,
- [ INPUT_NEURON, OUTPUT_NEURON ] ),
- trace_message( and_learn_trace,
- $current EDGE_ACTIVATION = $,
- EDGE_ACTIVATION ),
- call( neuron_change( and ,
- TIME,
- OUTPUT_NEURON,
- TOTAL_CHANGE )),
- !,
- trace_message( and_learn_trace,
- $...output neuron_change = $,
- TOTAL_CHANGE ),
- call( state( neuron,
- input ,
- INPUT_NEURON,
- TIME,
- INPUT_ACTIVATION) ),
- trace_message( and_learn_trace,
- $...INPUT_ACTIVATION = $,
- INPUT_ACTIVATION ),
- !,
- ( TOTAL_CHANGE > 0 ,
- NEW is EDGE_ACTIVATION
- +( 1 - EDGE_ACTIVATION )
- * TOTAL_CHANGE
- * INPUT_ACTIVATION
- ;
- TOTAL_CHANGE < 0 ,
- NEW is EDGE_ACTIVATION
- + EDGE_ACTIVATION
- * TOTAL_CHANGE
- * INPUT_ACTIVATION
- ;
- TOTAL_CHANGE is 0.0,
- NEW is EDGE_ACTIVATION
- ),
- trace_message( and_learn_trace,
- $... NEW = $,
- NEW ),
- CHANGE is NEW - EDGE_ACTIVATION ,
- trace_message( and_learn_trace,
- $... CHANGE = $,
- CHANGE ),
- weighted_average( EDGE_ACTIVATION ,
- NEW,
- NEW_EDGE_ACTIVATION),
- trace_message( and_learn_trace,
- $... NEW_EDGE_ACTIVATION = $,
- NEW_EDGE_ACTIVATION ),
- retractall( state( edge,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME,
- _ ) ),
- !,
- TIME1 is TIME + 1,
- assertz( state( edge ,
- and,
- INPUT_NEURON,
- OUTPUT_NEURON,
- TIME1,
- NEW_EDGE_ACTIVATION ) ).
-
-
- weighted_average( EDGE_ACTIVATION ,
- NEW,
- NEW_EDGE_ACTIVATION) :-
- call( learning_rate( R )),
- NEW_EDGE_ACTIVATION is ( 1 - R ) * EDGE_ACTIVATION
- + R * NEW.
-
-
- /*************************************************************************/
- /********* retractall : retracts all instances of a goal *****************/
- /*************************************************************************/
-
- % mode revised by rk 9-28-89
- :- mode retractall( + ).
-
- retractall( Name / Arity) :-
- integer(Arity),
- !,
- functor(Term, Name, Arity),
- retractall( Term).
- retractall( X) :-
- retract(X),
- fail.
- retractall( _).
-
-
- %%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%