caasi@sdsu.UUCP (Richard Caasi) (09/02/87)
{=======================================================================
The first program (ToPrem1) is being reposted to add some missing lines
in the ReadInput procedure. This is one of the simulation programs for
Topology-Preserving Maps written in Turbo Pascal. Sorry for any
inconvenience.
=======================================================================}
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 ;
lettery : if ((abs (X[0] - 0.5) <= 1/8) and (X[1] >= 4/8)) or
((X[1] >= 21/64 - 21/16 * abs (X[0] - 0.5)) and
(X[1] <= 21/32 - 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) ; } {uncomment for color screens}
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.