uses
crt;
type
tarray = array[1..4] of integer;
tmatrix = array[1..20] of tarray;
var
a: tmatrix;
i, j: integer;
function f(var a: tarray): integer;
begin
f := a[1] + 2 * a[2] + 3 * a[3] + 4 * a[4] - 30;
end;
procedure scresh(var a: tmatrix);
var
i, j, count, j1, j2: integer;
begin
count := random(20) + 1;
for i := 1 to count do
begin
j1 := random(20) + 1;
repeat
j2 := random(20) + 1;
until j1 <> j2;
for j := 1 to 4 do
a[j1, j] := abs((a[j1, j] - a[j2, j]) div 2) + 1;
end;
end;
procedure mutac(var a: tmatrix);
var
i, j, count, j1: integer;
begin
count := random(20) + 1;
for i := 1 to count do
begin
j1 := random(20) + 1;
for j := 1 to 4 do
a[j1, j] := abs(a[j1, j] + random(10) - 5) + 1;
end;
end;
procedure selec(var a: tmatrix);
var
i, j: integer;
b: tarray;
begin
for i := 1 to 19 do
for j := i + 1 to 20 do
if abs(f(a)) > abs(f(a[j])) then
begin
b := a;
a := a[j];
a[j] := b;
end;
end;
begin
randomize;
for i := 1 to 20 do
for j := 1 to 4 do
a[i, j] := random(100) + 1;
writeln('Search...');
repeat
scresh(a);
mutac(a);
selec(a);
writeln(a[1, 1], ' ', a[1, 2], ' ', a[1, 3], ' ', a[1, 4], ' f=', f(a[1]));
until abs(f(a[1])) = 0;
writeln('----------------');
writeln('Answer: a=', a[1, 1], '; b=', a[1, 2], '; c=', a[1, 3], '; d=', a[1, 4]);
readln;
end.
