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]<min) and (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.