(*
 * LANGUAGE    : ANS Forth 
 * PROJECT     : Forth Environments
 * DESCRIPTION : neural net with backpropagation
 * CATEGORY    : Example
 * AUTHOR      : Marcel Hendrix, November 25, 1990
 * LAST CHANGE : October 13, 1991, Marcel Hendrix 
 *)



	   ?DEF Sensors [IF] FORGET Sensors
		      [THEN]




-- ****	Define the layers. ******************************************


2 =: Sensors		-- Dyadic functions
2 =: HiddenUnits	-- set up 1-dimensional I/Hidden/O vectors
2 =: OutputUnits	-- 2 outputs: EXOR and AND


		     INCLUDE backprop.frt

       REVISION -exorand "ÄÄÄ Neural Application XOR+AND  1.01 ÄÄÄ"


-- ****	End of layer defs. ******************************************

			(* Application Level *)

:ABOUT
CR
CR ."     **  LOGIC in Multi-layered Neural-Net  using back-propagation  **"
CR ."                This net implements AND EXOR simultaneously." 
CR
CR ." <l> <s> ADD-PAIR          -- Pattern <l> is primed for linking with <s>."
CR ."                                 <l> î {I=00 I=01 I=11 I=10}"
CR ."                                 <s> î {O=00 O=10 O=01}"
CR ." DRILL                     -- All primed pairs are coded-in."
CR ." NO-CONNECTIONS            -- Forget all associations."
CR ." <l> REACT                 -- Test if <l> <s> pair is reproduced."
CR ." .STATUS                   -- Prints inputs | outputs | targets."
CR ." .WEIGHTS                  -- Prints all weights."
CR ." <z> TO LearningRate       -- LearningRate, oscillates if too large (>1000)."
CR ." <w> TO Retries            -- Retry Rate (normally 3000)."
CR ." Noisy | Clean             -- Select if input is noisy or not."
CR ." <y> TO Noise              -- 1 out of <y> pixels in <l> is corrupted, if Noisy."
CR ." FALSE | TRUE TO ?display  -- See matrices during learning or not."
CR ." DO-IT!                    -- Sets up defaults and learns the patterns."
CR ." .ABOUT -exorand           -- Print this info." CR
CR ." Note: When running,       '+'  and  '-' influence LearningRate,"
CR ."                           '/'  switches between .STATUS and .WEIGHTS,"
CR ."                           'd'  turns display on and off,"
CR ."                           'ESC' breaks." ;

	-- Input patterns

CREATE I=00	0    0  sensor,
CREATE I=01	0    1  sensor,
CREATE I=11	1    1  sensor,
CREATE I=10	1    0  sensor,

	-- Output patterns, px*py
	--      exor and
CREATE O=00	0    0  output,
CREATE O=10	1    0  output,
CREATE O=01	0    1  output,


: doExorAndShow
		CR ." The net is given the bit pattern %"
		/inputs	 1 ?DO	I InputValues .BIT
			  LOOP
		." , so it outputs the string %"
		/outputs 0 ?DO	I ActualOutputs .BIT
			  LOOP  CR ;

: ExorAndShow	['] doExorAndShow IS SHOW-NET ;

: doExorAndGate
		TIMER-RESET
		 NO-CONNECTIONS
		 I=00 O=00 ADD-PAIR		\ Define EXOR/AND function
		 I=01 O=10 ADD-PAIR
		 I=11 O=01 ADD-PAIR
		 I=10 O=10 ADD-PAIR
		 DRILL
		.ELAPSED ;

: ExorAndGate	['] doExorAndGate IS DO-IT! ;

		ExorAndShow ExorAndGate	
		#800 TO LearningRate
		.ABOUT -exorand

			(* End of Application *)