%!PS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% This is a postscript implementation of the classic
%%% Back-Propagation learning algorithm. As postscript
%%% comments must start at the beginning of a line,
%%% inline comments will be limited for readability,
%%% but I will attempt to highlight meaningful blocks
%%% wherever possible.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% GLOBAL NETWORK CONSTANTS AND PARAMETERS:
%%%
%%% L 		is the number of layers in the network
%%% N		is the number of neurons per layer
%%% C		is the learning constant
%%% ITER	is the number of training iterations
%%% e		is the mathematical constant 'e'
%%%
%%% iarr	contains input values for each neuron (2d)
%%% oarr	contains output values for each neuron (2d)
%%% darr	contains delta values for each neuron (2d)
%%% warr	contains weights for earch neuron (3d)
%%% tiarr	contains test case input vectors (2d)
%%% toarr	contains test case output vectors (1d)
%%%
%%% title	the title of the results printout
%%%
%%% additionally, we define convenience functions for
%%% generating random numbers, accessing and modifying
%%% 2d and 3d arrays and our sigmoid function.
%%%
%%% finally, we initialize all our arrays, filling
%%% iarr, oarr, and darr with zeroes and filling
%%% our weight array with random numbers.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/L		3 def
/N		2 def
/C		.5 def
/ITER	200 def
/e 		2.7183 def

/iarr	L array def
/oarr	L array def
/darr	L array def
/warr	L array def

/tiarr	[[0 0][1 0][0 1][1 1]] def
/toarr	[0 1 1 0] def

/title (XOR Function) def

% random number generation
80651 srand
/randreal {rand 2 31 exp div} def

% utility nested array accessor/mutators
/get2 {exch get exch get} def
/put2 {exch get 3 1 roll exch put} def
/get3 {exch get exch get exch get} def
/put3 {exch get exch get 3 1 roll exch put} def

% sigmoid function
/g {
	/q exch def e q exp e -1 q mul exp
	2 copy sub 3 1 roll add div
} def

% sigmoid derivative
/gprime {
	/q exch def 4 e 2 q mul exp
	e -2 q mul exp 1 add add div
} def

% threshold function
/threshold {
	.5 ge {1} {0} ifelse
} def

% create subarrays for i, o, d and w
0 1 L 1 sub {iarr exch N 1 add array put} for
0 1 L 1 sub {oarr exch N 1 add array put} for
0 1 L 1 sub {darr exch N 1 add array put} for
0 1 L 1 sub {warr exch N 1 add array put} for

% initialize arrays for i, o, and d (fill with 0)
0 1 L 1 sub {
	/q exch def
	0 1 N {
		/r exch def
		0 r q iarr put2
		0 r q oarr put2
		0 r q darr put2
	} for
} for

% create final subarray for w
0 1 L 1 sub {
	/q exch def
	0 1 N {
		/r exch def
		N 1 add array r q warr put2
	} for
} for

% initialize final subarray for w (fill with random weights)
0 1 L 1 sub {
	/q exch def
	0 1 N {
		/r exch def
		0 1 N {
			/s exch def
			randreal s r q warr put3
		} for
	} for
} for

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% GRAPHICS-RELATED INITIALIZATION AND UTILITIES
%%%
%%% These functions make it easy to convert various
%%% primitive types to strings, concatenate them
%%% together, and control a "cursor" as if we were
%%% printing to a console.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/lm 30 def
/tm 750 def
/bm 40 def
/textheight 16 def
/cursor tm def
/Courier findfont textheight scalefont setfont

% A routine for converting mixed types into strings
/tostr {
	dup type /stringtype eq not {10 string cvs} if
} def
% A string concatenation function
/concat {
	tostr exch tostr exch 2 copy length exch
	length add string dup dup 4 3 roll 4 index
	length exch putinterval 3 1 roll exch
	0 exch putinterval
} def
% Print a line to the "console"
/println {
	lm cursor moveto show stroke
	/cursor cursor textheight sub def
} def
% Print a list of items on the stack to the "console"
/printlst {
	1 sub {concat} repeat println
} def

/width 300 def
/height 300 def

/xmin 0 def
/xmax 1 def
/ymin 0 def
/ymax 1 def
/step .1 def

/xstep width xmax xmin sub abs div step mul def
/ystep height ymax ymin sub abs div step mul def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% FEED-FORWARD
%%%
%%% loadexample loads a set of example inputs, and
%%% sets any remaining input neurons with a bias value
%%%
%%% forward feeds forward through the network,
%%% calculating input values based on weighted inputs
%%% and then producing outputs by running these
%%% values through a sigmoid function.
%%%
%%% test is a convenience wrapper taking two inputs
%%% and producing the output value of our network.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/loadexample {
	/q exch def
	0 1 tiarr 0 get length 1 sub {
		/x exch def
		x q tiarr get2 x 0 oarr put2
	} for
	tiarr 0 get length 1 N {
		/x exch def
		-1 x 0 oarr put2
	} for
} def

/forward {
	1 1 L 1 sub {
		/x exch def
		0 1 N 1 sub {
			/y exch def
			0 y x iarr put2
			0 1 N {
				/z exch def
				z y x warr get3
				z x 1 sub oarr get2 mul
				y x iarr get2 add
				y x iarr put2
			} for
			y x iarr get2 g y x oarr put2
		} for
		-1 N x oarr put2
	} for
} def

/test {
	0 1 N {
		/x exch def
		-1 x 0 oarr put2
	} for
	1 0 oarr put2
	0 0 oarr put2
	forward
	0 L 1 sub iarr get2
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% BACK-PROPAGATION
%%%
%%% First, backprop calculates the output error based
%%% on a provided example index. Unused outputs are
%%% initialized as having 0 error for uniformity
%%% (Outputs with 0 error will not modify any weights)
%%%
%%% Then we step backwards layer by layer, adjusting
%%% weights to account for each neuron's
%%% "responsibility" for a given error.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/backprop {
	/q exch def
	toarr q get
	0 L 1 sub oarr get2 sub
	0 L 1 sub iarr get2 gprime mul
	0 L 1 sub darr put2
	1 1 N 1 sub {
		/x exch def
		0 x L 1 sub darr put2
	} for
	L 2 sub -1 0 {
		/x exch def
		0 1 N {
			/y exch def
			/sum 0 def
			0 1 N  {
				/z exch def
				y z x 1 add warr get3
				z x 1 add darr get2 mul
				sum add /sum exch def
			} for
			y x iarr get2 gprime sum mul
			y x darr put2
			0 1 N {
				/z exch def
				y x oarr get2
				z x 1 add darr get2 mul
				C mul y z x 1 add warr get3 add
				y z x 1 add warr put3
			} for
		} for
	} for
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% MAIN
%%%
%%% Train the neural network by loading examples,
%%% feeding forward, back propagating and repeating.
%%%
%%% Then, test each example and print out the results.
%%%
%%% Finally, produce a graphical representation of
%%% the produced network's function.
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

lm tm moveto

% train network
ITER {
	0 1 tiarr length 1 sub {
		/example exch def
		example loadexample forward
		example backprop
	} for
} repeat

% print results
title println
(-----------------------------) println
0 1 tiarr length 1 sub {
	/example exch def

	example (: { )
	0 1 tiarr 0 get length 1 sub {
		/x exch def
		x example tiarr get2 tostr
		( ) concat
	} for
	(} -> { )
	example loadexample forward
	0 L 1 sub iarr get2 threshold tostr
	( }, should be { ) concat concat
	toarr example get tostr
	( }) concat concat
	tiarr 0 get length 3 add printlst
} for

% graph output
/posx lm 30 add def
/posy cursor height sub def
1 setlinewidth
ymin step ymax {
	/curry exch def
	xmin step xmax {
		/currx exch def
		currx curry test /output exch def
		output 0 lt {/output 0 def} if
		output 1 gt {/output 1 def} if
		output threshold
		0 eq {1 0 0 setrgbcolor} {0 0 1 setrgbcolor} ifelse
		newpath
			posx posy moveto
			xstep 0 rlineto
			0 -1 ystep mul rlineto
			closepath
		fill
		1 output sub 0 output setrgbcolor
		newpath
			posx posy moveto
			0 -1 ystep mul rlineto
			xstep 0 rlineto
			closepath
		fill
		/posx posx xstep add def
	} for
	/posx lm 30 add def
	/posy posy ystep add def
} for
0 0 0 setrgbcolor
lm cursor 30 sub textheight sub moveto ymax tostr show
lm cursor 30 sub height sub moveto ymin tostr show
lm cursor 30 sub height 2 div sub moveto (Y) show
lm 30 add cursor 50 sub height sub textheight sub moveto xmin tostr show
lm 30 add width add cursor 50 sub height sub textheight sub moveto xmax tostr show
lm 30 add width 2 div add cursor 50 sub height sub textheight sub moveto (X) show

showpage