size=: 5 NB. count of control systems in
this network
wco=: |: wci=: 1-~2* ? 0 $~ 2# size NB. weighting coefficients,
input and output
ko=: 1
dt=: 0.0002
ps=: size # 0
oe=: size # 0
vs=: 1-~2* ? size # 0
rs=: 1-~2* ? size # 0
As usual, the executable program is attached with its extension changed to
.txt. Change it back to .exe to run the program.
Every time you click on Sine or Cosine or change the number of systems, a
new matrix of random input weights is generated, and the output matrix is
set to the transpose of the input matrix. For some matrices, convergence
will be slow and the values of the outputs and environmental variables will
be very large. These are the matrices whose determinants approach zero,
indicating that no solution exists. The chances of a truly unsolvable system
are very close to zero (a state of pure conflict). However, as that state is
approached, outputs oppose each other more and more, so if the control
systems have limits on the amount of output they can generate, control will
be lost for relatively mild degrees of conflict.
Note that many hundreds of iterations are needed to reach final convergence,
since each iteration represents only a small interval of time. If you can
make the J program loop some number of times each time you initiate a
calculation, you may get a better test of how the program is working.
Note also that while the perceptual signals will approach the reference
signals, the outputs and environmental variables will not show any orderly
relationships. It occurs to me that this demonstration may be the final
disproof of the principle of behaviorism, because the regularities in these
collections of control systems are not detectable through observing their
behavior -- their outputs.
best,
Bill P.
==============================================================================
unit MultiControlUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin;
type
TMultiControl = class(TForm)
Panel1: TPanel;
SinePat: TButton;
CosinePat: TButton;
SetNumPts: TSpinEdit;
Label2: TLabel;
StartStop: TButton;
Button1: TButton;
Label1: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure StartStopClick(Sender: TObject);
procedure SinePatClick(Sender: TObject);
procedure CosinePatClick(Sender: TObject);
procedure SetNumPtsChange(Sender: TObject);
procedure CreateMulti(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure idleloop(Sender: TObject; var Done: boolean);
end;
var
MultiControl: TMultiControl;
implementation
{$R *.dfm}
const maxmax = 501;
type coefftype = array[1..maxmax, 1..maxmax] of double;
vectortype = array[1..maxmax] of double;
var qi, p, e, o, r: vectortype;
inputCoeffs,w: coefftype;
oldr, oldp, oldq, oldo: array[1..maxmax] of integer;
x, maxy, maxx, stage: integer;
dt,ko: double;
ersq: double;
niter,maxmatrix: integer;
pause: boolean;
{v2 = M*v1 premultiply vector by square matrix}
procedure MV(var M:coefftype; var v1, v2: vectortype);
var i,j: integer;
begin
for i := 1 to maxmatrix do
begin
v2[i] := 0.0;
for j := 1 to maxmatrix do
v2[i] := v2[i] + M[i,j]*v1[j]
end;
end;
{ C = A - B Vector subtract}
procedure VS(var A,B,C: vectortype);
var i: integer;
begin
for i := 1 to maxmatrix do
C[i] := A[i] - B[i];
end;
{ C = A + B vector add}
procedure VA(var A,B,C: vectortype);
var i: integer;
begin
for i := 1 to maxmatrix do
C[i] := A[i] + B[i];
end;
{B = k*int(A) vector integrate}
procedure VI(var a,b: vectortype; k: double);
var i: integer;
begin
for i := 1 to maxmatrix do
b[i] := b[i] + k*a[i]*dt;
end;
{ CONTROL LOOPS IMPLEMENTED AS (SQUARE) MATRIX OPERATIONS}
procedure controlloops;
begin
MV(inputCoeffs,qi, p); { p = coeffs*qi}
VS(r,p,e); { e = r - p}
VI(e,o,ko); { o = o + ko * integral(e) * dt}
MV(w,o,qi); { qi = w * o}
end;
{$J+}
procedure showvariables;
var i,j,y: integer;
s: double;
begin
s := (maxx - 15)/(maxmatrix - 1); // SET X SCALE FOR PLOTTING
y := multicontrol.clientheight - round(ersq/2);
if niter >= 5000 div maxmatrix then
with multicontrol, canvas do
begin
font.color := clRed;
textout(10,clientheight-15,'RMS ERROR'); // REFRESH LEGEND
end;
if (niter mod 500) = 0 then // PLOT EVERY 500TH ITERATION
with multicontrol,canvas do
begin
color := clSilver;
pen.color := RGB(0,180,255);
font.Color := clRed;
ellipse(5+x - 2,y - 2,5+x + 2,y + 2);
x := x + 1;
if x >= clientwidth - 30 then x := 0;
if ((niter mod 15000) = 0) or (niter = 1) then
begin
fillrect(rect(x + 5,y,x + 105,y + 15));
textout(x+5,y - 14,floattostrf(ersq/5,fffixed,5,0));
end;
end;
if (niter mod 150) = 0 then
for i := 1 to maxmatrix do
with multicontrol,canvas do
begin
j := round(s*(i-1)) + 3;
pen.Color := clSilver;
brush.Color := clSilver;
ellipse(j-5,maxy div 2 - oldr[i] - 5,j+5,maxy div 2 - oldr[i] + 5);
ellipse(j-3,maxy div 2 - oldp[i] - 3,j+3,maxy div 2 - oldp[i] + 3);
ellipse(j-3,maxy div 2 - oldq[i] - 3,j+3,maxy div 2 - oldq[i] + 3);
ellipse(j-3,maxy div 2 - oldo[i] - 3,j+3,maxy div 2 - oldo[i] + 3);
oldr[i] := round(r[i] /5.0);
oldp[i] := round(p[i] /5.0);
oldq[i] := round(qi[i] /5.0);
oldo[i] := round(o[i]/5.0);
pen.color := clAqua;
brush.color := clAqua;
ellipse(j-5,maxy div 2 - oldr[i] - 5,j+5,maxy div 2 - oldr[i] + 5);
pen.color := RGB(250,0,0);
brush.color := RGB(250,0,0);
ellipse(j-3,maxy div 2 - oldp[i] - 3,j+3,maxy div 2 - oldp[i] + 3);
pen.Color := clYellow;
brush.color := clYellow;
ellipse(j-3,maxy div 2 - oldq[i] - 3,j+3,maxy div 2 - oldq[i] + 3);
pen.Color := clBlack;
brush.color := clBlack;
ellipse(j-3,maxy div 2 - oldo[i] - 3,j+3,maxy div 2 - oldo[i] + 3);
brush.Color := clSilver;
end;
end;
procedure initmatrix;
var i,j: integer;
sumsqr: double;
begin
sumsqr := 0.0;
for i := 1 to maxmatrix do
for j := 1 to maxmatrix do // LOAD RANDOM INPUT COEFFICIENTS, -1 TO 1
begin
inputCoeffs[i,j] := 1.98*(random - 0.5);
sumsqr := sumsqr + sqr(inputCoeffs[i,j]);
end;
sumsqr := sqrt(sumsqr);
for i := 1 to maxmatrix do
for j := 1 to maxmatrix do
begin
inputCoeffs[i,j] := 100.0*inputcoeffs[i,j]/sumsqr; // NORMALIZE TO 100
w[j,i] := inputCoeffs[i,j] {W = transpose(inputCoeffs)}
end;
dt := 0.0002;
ko := 1;
end;
procedure initprogram;
begin
randomize; // keep random function from repeating
with multicontrol do // MULTICONTROL IS NAME OF FORM
begin
maxmatrix := setnumpts.value; // SET BY SPINNER 0N SCREEN
initmatrix;
maxy := clientheight;
maxx := clientwidth;
stage := 0;
end;
niter := 0;
end;
procedure iterate;
var i: integer;
begin
if pause then exit;
case stage of
1: with multicontrol,canvas do
begin
initprogram;
brush.color := clSilver;
StartStop.font.Color := clRED;
StartStop.caption := 'STOP';
niter := 0;
stage := 2;
end;
2: begin
controlloops;
ersq := 0.0;
for i := 1 to maxmatrix do ersq := ersq + sqr(e[i]);
ersq := sqrt(ersq/maxmatrix);
showvariables;
inc(niter);
end;
end;
end;
// ITERATE ON NEXT IDLE CYCLE
procedure TMulticontrol.idleloop(Sender: TObject; var Done: boolean);
begin
done := false;
iterate;
end;
procedure TMultiControl.StartStopClick(Sender: TObject); // STOP PROGRAM
begin
application.terminate;
end;
procedure TMultiControl.SinePatClick(Sender: TObject); // SET REFERENCE
LEVELS
var i: integer;
begin
initmatrix;
for i := 1 to maxmatrix do
r[i] := 1000*sin(i*2*pi/maxmatrix);
with multicontrol, canvas do
fillrect(rect(0,50,clientwidth,clientheight));
x := 0;
end;
procedure TMultiControl.CosinePatClick(Sender: TObject);// SET REFERENCE
LEVELS
var i: integer;
begin
initmatrix;
for i := 1 to maxmatrix do
r[i] := -1000*cos(i*2*pi/maxmatrix);
with multicontrol, canvas do
fillrect(rect(0,50,clientwidth,clientheight));
x := 0;
end;
procedure TMultiControl.SetNumPtsChange(Sender: TObject);// SET NUM POINTS
begin
initprogram;
with multicontrol, canvas do
fillrect(rect(0,0,clientwidth,clientheight)); //; clear screen
x := 0;
stage := 1;
randomize;
end;
procedure TMultiControl.CreateMulti(Sender: TObject);
var i: integer;
begin
application.onIdle := idleloop; // set up call when idle begins
maxmatrix := setnumpts.value; // SET BY SPINNER 0N SCREEN
for i := 1 to maxmatrix do
r[i] := 2000*(random - 0.5); // start with random ref signals
stage := 1;
end;
procedure TMultiControl.Button1Click(Sender: TObject); // PAUSE BUTTON
begin
pause := not pause;
if pause then button1.caption := 'CONTINUE'
ELSE BUTTON1.Caption := 'PAUSE';
end;
end.
No virus found in this outgoing message.
Checked by AVG - http://www.avg.com
Version: 8.0.173 / Virus Database: 270.8.1/1731 - Release Date: 10/17/2008
7:01 PM