program Simplex;
uses crt;
const
AllocX=30; {reserverer hukommelse til x s=F8jer (antal variab=
le)}
AllocY=10; {reserverer hukommelse til y r=E6kker (antal ligni=
nger)}
KropX=22; {antal s=F8jler i kroppen, som bruges i Simplex-be=
regningen}
KropY=3; {antal r=E6kker i kroppen, ------------- do ------=
---------}
M=32000; {fungerer som "uendeligt"/meget stort tal}
vname:array[0..allocx] of string=
('--',' a',' b',' c',' d',' e',' f',' g',' h',' i',' j',' k',' l',' m',' =
n',' o',' p','s1','s2','s3','a1'
,'a2','a3','--','--','--','--','--','--','--','--');
Type
RaekkeType=array[1..allocx] of real;
SoejleType=array[1..allocy] of real;
Kroptype=array[1..allocx,1..allocy] of real;
var
basis:array[1..allocy] of integer;{basis variablene}
quantity:soejletype; {kvantitet}
c:kroptype; {Krop+enhedsprofit+enhedspris+CZ-r=E6kk=
en}
Incoming,Outgoing:integer; {Inkomne- og udg=E5ende-variabel}
pivot:real; {Pivot element}
cj,zj,cz:raekketype; {Unitprofit,unitlosses,CZ}
procedure InitVar;
const
Preunitprofit:raekketype=(-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,=
-1,0,0,0,-m,-m,-m,0,0,0,0,0,0,0,0);
var
i,j:integer;
procedure skm(row,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x1=
7,x18,x19,x20,
x21,x22,x23,x24,x25,x26,x27,x28,x29,x30:integer);
begin
c[1,row]:=x1; c[2,row]:=x2; c[3,row]:=x3; c[4,row]:=x4; c[5,row]:=
=x5;
c[6,row]:=x6; c[7,row]:=x7; c[8,row]:=x8; c[9,row]:=x9; c[10,row]=
:=x10;
c[11,row]:=x11; c[12,row]:=x12; c[13,row]:=x13; c[14,row]:=x14; c=
[15,row]:=x15;
c[16,row]:=x16; c[17,row]:=x17; c[18,row]:=x18; c[19,row]:=x19; c=
[20,row]:=x20;
c[21,row]:=x21; c[22,row]:=x22; c[23,row]:=x23; c[24,row]:=x24; c=
[25,row]:=x25;
c[26,row]:=x26; c[27,row]:=x27; c[28,row]:=x28; c[29,row]:=x29; c=
[30,row]:=x30;
end;
begin
skm(1, 2,1,1,1,1,0,0,0,0,0,0,0,3,2,2,1,-1,0,0,1,0,0,0,0,0,0,0,0,0,0);
skm(2, 10,8,12,16,20,30,6,10,14,18,22,26,0,2,6,4,0,-1,0,0,1,0,0,0,0,0,0,0=
,0,0);
skm(3, 0,3,2,1,0,0,6,5,4,3,2,1,0,2,1,4,0,0,-1,0,0,1,0,0,0,0,0,0,0,0);
skm(4, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
skm(5, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
for i:=1 to allocy do basis[i]:=0;
basis[1]:=20; basis[2]:=21; basis[3]:=22;
{Cj} j:=4; for i:=1 to kropx do cj[i]:=preunitprofit[i];
{ZJ} j:=5; for i:=1 to kropx do zj[i]:=0;
{CZ} j:=6; for i:=1 to kropx do cz[i]:=0;
Incoming:=0; Outgoing:=0;
for i:=1 to allocy do quantity[i]:=0;
quantity[1]:=1500; quantity[2]:=750; quantity[3]:=400;
pivot:=0;
end;
procedure ShowTab;
var
i,j:integer;
maxt:integer; {maksimale tekst som kan st=E5 p=E5 en linie}
begin
writeln('+----------------------------------Tableau----------------------=
--------------+');
write('| Basis Quantity ');
maxt:=kropx; if maxt>8 then maxt:=8;
for i:=1 to maxt do write(vname[i],' '); gotoxy(79,wherey); writeln=
('|');
writeln('+---------------------------------------------------------------=
--------------+');
for j:=1 to kropy do begin
write('| ',vname[basis[j]],' ',quantity[j]:6:1,' ');
maxt:=kropx; if maxt>8 then maxt:=8;
for i:=1 to maxt do write(' ',c[i,j]:3:1,' '); gotoxy(79,wherey); w=
riteln('|');
end;
writeln('+---------------------------------------------------------------=
--------------+');
write('| Unit Profit ');
maxt:=kropx; if maxt>8 then maxt:=8; for i:=1 to maxt do write(cj[i=
]:5:1,' '); gotoxy(79,wherey); writeln('|');
write('| Unit Losses ');
maxt:=kropx; if maxt>8 then maxt:=8; for i:=1 to maxt do write(zj[i=
]:5:1,' '); gotoxy(79,wherey); writeln('|');
write('| Cj-Zj ');
maxt:=kropx; if maxt>8 then maxt:=8; for i:=1 to maxt do write(cz[i=
]:5:1,' '); gotoxy(79,wherey); writeln('|');
writeln('+---------------------------------------------------------------=
--------------+');
end;
function TestOptimal:boolean;
var
i:integer;
optimal:boolean;
begin
optimal:=true;
for i:=1 to kropx do if cz[i]>0 then optimal:=false;
TestOptimal:=optimal;
end;
function FindIncomingVar:integer;
var
i,num:integer;
min:real;
begin
min:=0; num:=0;
{finder kun en mulig, der kan faktisk eksistere flere}
for i:=1 to kropx do begin
if (cz[i]>min) and (cz[i]>0) then begin min:=cz[i]; num:=i; end;
end;
FindIncomingVar:=num;
end;
function FindOutgoingVar:integer;
var
ratio:array[1..kropy] of real;
j,num:integer;
min:real;
begin
for j:=1 to kropy do begin
if c[incoming,j]=0 then ratio[j]:=m else
ratio[j]:=quantity[j]/c[incoming,j];
end;
min:=M; num:=0;
for j:=1 to kropy do begin
if (ratio[j]=0) then begin min:=ratio[j]; num:=
=j; end;
end;
FindOutgoingVar:=num;
end;
function FindPivot:real;
begin
findpivot:=c[incoming,outgoing];
end;
procedure CalcZRow;
var
i,j:integer;
sum:real;
begin
for i:=1 to kropx do begin
sum:=0;
for j:=1 to kropy do sum:=sum+cj[basis[j]]*c[i,j];
zj[i]:=sum;
end;
end;
procedure CalcCZRow;
var i:integer;
begin
for i:=1 to kropx do cz[i]:=cj[i]-zj[i];
end;
function RundNed(x:real):real;
{Finder det mindste hele tal af en reel v=E6rdi. Bruges da man ikke kan lav=
e
fx. 3,5 enheder, man kan kun 3}
begin
RundNed:=trunc(x);
end;
procedure ChangeBasis;
begin
basis[outgoing]:=incoming;
end;
procedure TransformOutgoingRow;
var
i:integer;
begin
for i:=1 to kropx do c[i,outgoing]:=c[i,outgoing]/pivot;
quantity[outgoing]:=quantity[outgoing]/pivot; {kvantitet rundes ikke ne=
d, dvs. der bruges reelle tal}
ChangeBasis; {brug funktionen RundNed, h=
vis der skal bruges hele tal}
end;
procedure TransOtherRows;
{other= andre end outgoing row}
var
i,j:integer;
k:real; {koefficint som bruges til at danne tra=
nsformations-r=E6kke}
trans:array[1..kropx] of real; {transformationsr=E6kke}
transq:real; {transformations-konstant, til kvantitet}
begin
for j:=1 to kropy do begin
if j<>outgoing then begin {transformerer kun andre end udeg=E5ende r=E6=
kker}
k:=c[incoming,j]; {k findes i sk=E6ringen mellem den aktuelle=
r=E6kke og den indkomne s=F8jle}
transq:=quantity[outgoing]*k; {transformationskonstant =
som bruges til trans. af kvantiten}
for i:=1 to kropx do trans[i]:=c[i,outgoing]*k; {transformationsr=
=E6kken dannes}
for i:=1 to kropx do c[i,j]:=c[i,j]-trans[i]; {aktuelle r=E6kke=
transformeres med trans. r=E6kken}
quantity[j]:=quantity[j]-transq; {kvantiteten i a=
ktuelle r=E6kke transformeres med transq}
end;
end;
end;
procedure ImproveSolution;
begin
Incoming:=FindIncomingVar;
Outgoing:=FindOutgoingVar;
Pivot:=FindPivot;
TransformOutgoingRow;
TransOtherRows;
CalcZRow;
CalcCZRow;
end;
procedure MakeInitSolution;
{ Finder den initialiserende l=F8sning}
begin
CalcZRow;
CalcCZRow;
end;
procedure ShowVar;
var
i:integer;
begin
writeln('+----------------------------------Solution---------------------=
--------------+');
for i:=1 to 3 do begin
write('| ',vname[basis[i]],'= ',quantity[i]:6:3);
gotoxy(79,wherey); writeln('|');
end;
writeln('+---------------------------------------------------------------=
--------------+');
end;
procedure Solve;
var
optimal:boolean;
begin
MakeInitSolution;
ShowTab;
Optimal:=TestOptimal;
While not Optimal do begin
ImproveSolution;
{showtab; repeat until keypressed; readkey;}
Optimal:=TestOptimal;
end;
{find evt. andre optimale l=F8sninger}
{ShowTab;}
ShowVar;
end;
begin
clrscr;
InitVar;
Solve;
repeat until keypressed;
end.
(
geocities.com/~franzglaser)