caasi@sdsu.UUCP (Richard Caasi) (09/02/87)
{========================================================================= The following two Turbo Pascal programs were written by Teuvo Kohonen from Finland and were distributed at the First International Conference on Neural Networks in San Diego, June 1987. =========================================================================} program ToPreM1 (output) ; { Demonstration program of Topology Preserving Mappings: linear topology, input and weight vectors two-dimensional Copyright (c) Teuvo Kohonen, June 1987 } const iMax = 35 ; {number of units minus one in the array} jMax = 1 ; {two-dimensional input and weight vectors} A0 = 0.3 ; {initializing value for the forgetting constant} G = 0.2 ; {adjusting parameter for the width of the initial value for the weights} type DensityFunctions = (Square, triangle, cross, lettera, letterk, lettery) ; {area options where input vectors will be uniformly distributed} var Tk : integer ; {number of time instances or steps elapsed since the beginning of the process} A : real ; {the alpha function a=a(Tk) is A piecewise linearly decreasing function of Tk} T1 : integer ; {T1 is the end of the initial time interval during which a(Tk) decreases linearly ; thereafter A new greater T1 value is set to define the next interval etc.} t : integer ; {the number of time instances elapsed since the beginning of the interval described above} T2 : integer ; {defines the interval for graphic display update, selected small in the beginning but becomes larger in each linear segment} A1, A2 : real ; {the forgetting constant A1 keeps track of a(t) in A linear segment, A2 is always 1-A1} W0 : 0..iMax ; {initializing value for the kernel width} w : 0..iMax ; {defines the topological neighborhood which is selected wide in the beginning (with W0) and then it is let to shrink with time Tk} H1, h, V1, V : 0..iMax ; {indices for the kernel units} i : 0..iMax ; j : 0..jMax ; {indices for vectors defined below} M : array [0..iMax,0..jMax] of real ; {vector of input weights (memory)} X : array [0..jMax] of real ; {vector of input signals} N : array [0..iMax] of real ; {0.5*Squared norms of M-vectors used in the short-cut computation of the best-matching unit selection} Y : array [0..iMax] of real ; {vector of output signals} C : 0..iMax ; {index of best-matching unit} MinY : real ; {MinY = y[c]} DensityFunction : DensityFunctions ; {input vector density function} procedure askDensityFunction ; {asks input vector density function} var d : char ; begin {ask input vector density function} writeln ('Topology Preserving Mappings:') ; writeln ('-linear topology') ; writeln ('-input and weight vectors two-dimensional') ; writeln ; writeln ('Select density function') ; DensityFunction := Square ; writeln ('square s') ; writeln ('triangle t') ; writeln ('cross c') ; writeln ('letter A a') ; writeln ('letter K k') ; write ('letter Y y:') ; readln (d) ; writeln ; case d of 's' : DensityFunction := Square ; 't' : DensityFunction := triangle ; 'c' : DensityFunction := cross ; 'a' : DensityFunction := lettera ; 'k' : DensityFunction := letterk ; 'y' : DensityFunction := lettery ; end ; end ; {askDensityFunction} procedure ReadInput ; {reads the vector of input signals} var inside : boolean ; begin repeat {impose uniform density within the framed area} inside := false ; x[0] := random ; x[1] := random ; case DensityFunction of Square : inside := true ; triangle : if x[1] >= 2*abs(x[0] - 0.5) then inside := true ; cross : if (abs (x[0] - 0.5) <= 1/4) or (abs (x[1] - 0.5) <= 1/4) then inside := true ; lettera : if ((x[1] - 5/16 <= 11/4 * abs (x[0] - 0.5)) and (x[1] + 3/8 >= 11/4*abs(x[0] - 0.5))) or ((x[1] >= 7/16) and (x[1] <= 11/16) and (x[1] - 5/16 >= 11/4*abs (x[0] - 0.5))) then inside := true ; letterk : if (x[0] <= 2/8) or ((x[0] - 4/8 <= abs (x[1] - 0.5)) and (x[1] >= 4/8)) or ((x[1] >= 21/64 - 21/16*abs(x[0]-0.5))) then inside := true ; end ; until inside ; end ; {ReadInput} function max (x, Y : integer) : integer ; begin {returns the maximum of the two integers} if X >= Y then max := x else max := Y ; end ; {max} function min (x, Y : integer) : integer ; begin {returns the minimum of the two integers} if X <= Y then min := x else min := Y ; end ; {min} procedure DrawDistribution ; {draws the distribution of weight vectors: linear array} const cl = white ; xw = 320 ; yw = 160 ; var x, y, xo, yo : integer ; procedure DrawLine (i : integer) ; begin {draw A line connecting two weight vectors} xo := X ; X := round ((xw div 2) * (m[i,0] + m[i+1,0])) ; yo := Y ; Y := round ((yw div 2) * (m[i,1] + m[i+1,1])) ; draw (xo, yo, x, y, cl) ; draw (x-1, y-1, x+1, y-1, cl) ; draw (x-1, y, x+1, y, cl) ; draw (x-1, y+1, x+1, y+1, cl) ; end ; {DrawLine} begin {DrawDistribution} hires ; { graphbackground (black) ; } case DensityFunction of {draw the corresponding frame} Square : begin draw (159, 19, 481, 19, cl) ; draw (481, 19, 481, 181, cl) ; draw (481, 181, 159, 181, cl) ; draw (159, 181, 159, 19, cl) ; end ; triangle : begin draw (159, 181, 481, 181, cl) ; draw (159, 181, 320, 20, cl) ; draw (481, 181, 320, 20, cl) ; end ; cross : begin draw (159, 80, 280, 80, cl) ; draw (280, 80, 280, 19, cl) ; draw (280, 19, 360, 19, cl) ; draw (360, 19, 360, 80, cl) ; draw (360, 80, 481, 80, cl) ; draw (481, 80, 481, 120, cl) ; draw (481, 120, 360, 120, cl) ; draw (360, 120, 360, 181, cl) ; draw (360, 181, 280, 181, cl) ; draw (280, 181, 280, 120, cl) ; draw (280, 120, 159, 120, cl) ; draw (159, 120, 159, 80, cl) ; end ; lettera : begin draw (159, 181, 280, 19, cl) ; draw (280, 19, 360, 19, cl) ; draw (360, 19, 481, 181, cl) ; draw (481, 181, 400, 181, cl) ; draw (400, 181, 369, 130, cl) ; draw (345, 90, 320, 50, cl) ; draw (320, 50, 295, 90, cl) ; draw (271, 130, 240, 181, cl) ; draw (240, 181, 159, 181, cl) ; draw (271, 130, 369, 130, cl) ; draw (295, 90, 345, 90, cl) ; end ; letterk : begin draw (159, 19, 159, 181, cl) ; draw (240, 100, 400, 19, cl) ; draw (240, 100, 400, 181, cl) ; draw (320, 100, 481, 19, cl) ; draw (320, 100, 481, 181, cl) ; draw (159, 19, 240, 19, cl) ; draw (400, 19, 481, 19, cl) ; draw (159, 181, 240, 181, cl) ; draw (400, 181, 481, 181, cl) ; end ; lettery : begin draw (159, 19, 280, 100, cl) ; draw (280, 100, 280, 181, cl) ; draw (280, 181, 360, 181, cl) ; draw (360, 181, 360, 100, cl) ; draw (360, 100, 481, 19, cl) ; draw (481, 19, 400, 19, cl) ; draw (400, 19, 320, 75, cl) ; draw (320, 75, 240, 19, cl) ; draw (240, 19, 159, 19, cl) ; end ; end ; graphwindow (160, 20, 480, 180) ; write ('Step ') ; write (Tk) ; write (' Alpha ') ; write (A1:1:3) ; X := round (xw * M [0,0]) ; Y := round (yw * M [0,1]) ; {initialize coordinates} for i := 0 to iMax - 1 do {draw distribution: linear array} DrawLine (i) ; end ; {DrawDistribution} begin {ToPreM1} askDensityFunction ; randomize ; {initialize forgetting constant, kernel width and step counters} A := A0 ; A1 := A ; W0 := iMax div 4 ; T1 := 100 ; T2 := 5 ; t := 0 ; Tk := 0 ; {*** initialize the vector of input weights M[i] with random and compute 0.5 * the Squared norm of M[i] to be used in the computation of the best-matching unit selection***} for i := 0 to iMax do begin N [i] := 0 ; for j := 0 to jMax do begin {adjust the width of the initial values for weights} M [i, j] := (0.5 - g/2.0) + g*random ; N [i] := N [i] + M [i, j] * M [i, j] ; end ; N [i] := N [i] / 2.0 ; {N is 0.5 * Squared norm of M} end ; {memory vector initialization} DrawDistribution ; {draw the initial distribution of weight vectors} repeat for t := 1 to T1 do begin Tk := Tk + 1 ; ReadInput ; {*** the best-matching unit selection ***} MinY := N [0] ; {initializing value for the best-matching unit} for i := 0 to iMax do begin {use Euclidean distance} Y [i] := N [i] ; for j := 0 to jMax do Y [i] := Y [i] - M [i, j] * X [j] ; if Y [i] <= MinY then begin {update best-matching unit and index} MinY := Y [i] ; C := i ; end ; end ; {best-matching unit selection} A1 := A * (1 - t/T1) ; A2 := 1 - A1 ; w := trunc (W0 * (1 - t/T1)) + 1 ; {update kernel width} {*** update the vector of input weights M [i] inside the kernel = LEARNING and compute 0.5 * the Squared norm of M [i] for the best matching unit selection ***} for i := max (0, c-w) to min (iMax, c+w) do begin N [i] := 0 ; for j := 0 to jMax do begin M [i, j] := A1 * X [j] + A2 * M [i, j] ; N [i] := N [i] + M [i, j] * M [i, j] ; end ; N [i] := N [i] / 2.0 ; {N is 0.5 * the Squared norm of M} end ; {memory vector update} if t mod T2 = 0 then DrawDistribution ; end ; A := 0.2 * A ; W0 := 0 ; T1 := 5 * T1 ; T2 := 4 * T2 ; {values for the next linear segment} until A = 0 ; { the process ends with A = 0} end. {================== CUT HERE TO SEPARATE THE TWO PROGRAMS ================} program ToPreM2 (output) ; { Demonstration program of Topology Preserving Mappings: array topology two-dimensional, input and weight vectors two-dimensional Copyright (c) Teuvo Kohonen, June 1987 } const iMax = 63 ; {number of units minus one in the array} jMax = 1 ; {two-dimensional input and weight vectors} side = 8 ; {side of array is square of iMax + 1} A0 = 0.3 ; {initializing value for the forgetting constant} G = 0.2 ; {adjusting parameter for the width of the initial value for the weights} type DensityFunctions = (Square, triangle, cross) ; {area options where input vectors will be uniformly distributed} var Tk : integer ; {number of time instances or steps elapsed since the beginning of the process} A : real ; {the alpha function a=a(Tk) is A piecewise linearly decreasing function of Tk} T1 : integer ; {T1 is the end of the initial time interval during which a(Tk) decreases linearly ; thereafter A new greater T1 value is set to define the next interval etc.} t : integer ; {the number of time instances elapsed since the beginning of the interval described above} T2 : integer ; {defines the interval for graphic display update, selected small in the beginning but becomes larger in each linear segment} A1, A2 : real ; {the forgetting constant A1 keeps track of a(t) in A linear segment, A2 is always 1-A1} W0 : 0..side ; {initializing value for the kernel width} w : 0..side ; {defines the topological neighborhood which is selected wide in the beginning (with W0) and then it is let to shrink with time Tk} H1, h, V1, V : 0..side ; {indices for the kernel units} i : 0..iMax ; j : 0..jMax ; {indices for vectors defined below} M : array [0..iMax,0..jMax] of real ; {vector of input weights (memory)} X : array [0..jMax] of real ; {vector of input signals} N : array [0..iMax] of real ; {0.5*Squared norms of M-vectors used in the short-cut computation of the best-matching unit selection} Y : array [0..iMax] of real ; {vector of output signals} C : 0..iMax ; {index of best-matching unit} MinY : real ; {MinY = y[c]} DensityFunction : DensityFunctions ; {input vector density function} procedure askDensityFunction ; {asks input vector density function} var d : char ; begin {ask input vector density function} writeln ('Topology Preserving Mappings:') ; writeln ('-array topology two-dimensional') ; writeln ('-input and weight vectors two-dimensional') ; writeln ; writeln ('Select density function') ; DensityFunction := Square ; writeln ('square s') ; writeln ('triangle t') ; write ('cross c') ; readln (d) ; writeln ; case d of 's' : DensityFunction := Square ; 't' : DensityFunction := triangle ; 'c' : DensityFunction := cross ; end ; end ; {askDensityFunction} procedure ReadInput ; {reads the vector of input signals} var inside : boolean ; begin repeat {impose uniform density within the framed area} inside := false ; x [0] := random ; x [1] := random ; case DensityFunction of Square : inside := true ; triangle : if x[1] >= 2*abs(x[0] - 0.5) then inside := true ; cross : if (abs (x[0] - 0.5) <= 1/4) or (abs (x[1] - 0.5) <= 1/4) then inside := true ; end ; until inside ; end ; {ReadInput} function max (x, Y : integer) : integer ; begin {returns the maximum of the two integers} if X >= Y then max := x else max := Y ; end ; {max} function min (x, Y : integer) : integer ; begin {returns the minimum of the two integers} if X <= Y then min := x else min := Y ; end ; {min} procedure DrawDistribution ; {draws the distribution of weight vectors: linear array} const cl = white ; xw = 320 ; yw = 160 ; var x1, x2, y1, y2 : integer ; procedure DrawLine (var x, y : integer ; i, e : integer) ; var xo, yo : integer; begin {draw A line connecting two weight vectors} xo := X ; X := round ((xw div 2) * (m[i,0] + m[i+e,0])) ; yo := Y ; Y := round ((yw div 2) * (m[i,1] + m[i+e,1])) ; draw (xo, yo, x, y, cl) ; end ; {DrawLine} begin {DrawDistribution} hires ; { graphbackground (black) ; } case DensityFunction of {draw the corresponding frame} Square : begin draw (159, 19, 481, 19, cl) ; draw (481, 19, 481, 181, cl) ; draw (481, 181, 159, 181, cl) ; draw (159, 181, 159, 19, cl) ; end ; triangle : begin draw (159, 181, 481, 181, cl) ; draw (159, 181, 320, 20, cl) ; draw (481, 181, 320, 20, cl) ; end ; cross : begin draw (159, 95, 310, 19, cl) ; draw (310, 95, 310, 19, cl) ; draw (310, 19, 330, 19, cl) ; draw (330, 19, 330, 95, cl) ; draw (330, 95, 481, 95, cl) ; draw (481, 95, 481, 105, cl) ; draw (481, 105, 330, 105, cl) ; draw (330, 105, 330, 181, cl) ; draw (330, 181, 310, 181, cl) ; draw (310, 181, 310, 105, cl) ; draw (310, 105, 159, 105, cl) ; draw (159, 105, 159, 95, cl) ; end ; end ; graphwindow (160, 20, 480, 180) ; write ('Step ') ; write (Tk) ; write (' Alpha ') ; write (A1:1:3) ; for h := 0 to side-1 do begin {horizontal} X1 := round (xw * M [h,0]) ; Y1 := round (yw * M [h,1]) ; {initialize coordinates} X2 := round (xw * M [side * H,0]) ; Y2 := round (yw * M [side * H,1]) ; drawline (x1, y1, h, side) ; drawline (x2, y2, side * h, 1) ; for V := 1 to side-2 do begin {vertical} drawline (x1, y1, side * v + h,0) ; drawline (x1, y1, side * v + h,side) ; drawline (x2, y2, side * h + v,0) ; drawline (x2, y2, side * h + v,1) ; end ; drawline (x1, y1, side * (side-1) + h,0) ; drawline (x2, y2, side * h + side - 1,0) ; end ; end ; {DrawDistribution} begin {ToPreM1} askDensityFunction ; randomize ; {initialize forgetting constant, kernel width and step counters} A := A0 ; A1 := A ; W0 := side div 2 ; T1 := 1000 ; T2 := 10 ; t := 0 ; Tk := 0 ; {*** initialize the vector of input weights M[i] with random and compute 0.5 * the Squared norm of M[i] to be used in the computation of the best-matching unit selection***} for i := 0 to iMax do begin N [i] := 0 ; for j := 0 to jMax do begin {adjust the width of the initial values for weights} M [i, j] := (0.5 - g/2.0) + g*random ; N [i] := N [i] + M [i, j] * M [i, j] ; end ; N [i] := N [i] / 2.0 ; {N is 0.5 * Squared norm of M} end ; {memory vector initialization} DrawDistribution ; {draw the initial distribution of weight vectors} repeat for t := 1 to T1 do begin Tk := Tk + 1 ; ReadInput ; {*** the best-matching unit selection ***} MinY := N [0] ; {initializing value for the best-matching unit} for i := 0 to iMax do begin {use Euclidean distance} Y [i] := N [i] ; for j := 0 to jMax do Y [i] := Y [i] - M [i, j] * X [j] ; if Y [i] <= MinY then begin {update best-matching unit and index} MinY := Y [i] ; C := i ; end ; end ; {best-matching unit selection} A1 := A * (1 - t/T1) ; A2 := 1 - A1 ; H1 := C mod side ; V1 := C div side ; w := trunc (W0 * (1 - t/T1)) + 1 ; {update kernel width} {*** update the vector of input weights M [i] inside the kernel = LEARNING and compute 0.5 * the Squared norm of M [i] for the best matching unit selection ***} for h := max (0,h1-w) to min (side-1,h1+w) do for V := max (0,V1-W) to min (side-1,V1+W) do begin i := side * V + H ; N [i] := 0 ; for j := 0 to jMax do begin M [i,j] := A1 * X [j] + A2 * M [i,j] ; N [i] := N [i] + M [i,j] * M [i,j] ; end ; N [i] := N [i] / 2.0 ; {N is 0.5 * the squared norm of M} end ; {memory vector update} if t mod T2 = 0 then DrawDistribution ; end ; A := 0.2 * A ; W0 := 0 ; T1 := 5 * T1 ; T2 := 5 * T2 ; {values for the next linear segment} until A = 0 ; { the process ends with A = 0} end.