Program exchange;
  {$I Standard}  {$R+}

{ *******************************************************************
 ** SIMULATION OF FOUR COMMODITIES PASSED THROUGH A LINEAR SYSTEM **
 *******************************************************************
 ** VARIABLE DESCRIPTIONS **
 ***************************
   POP[i,j]=POPULATION FOR EACH VILLAGE FOR EACH YEAR
   VILL(j]= ARRAY CONTAINING NAMES OF VILLAGES IN THE SYSTEM
   PERCENT OF POPULATION ProdUCING EACH COMMODITY IN VILLAGE OF ORIGIN
     LABRAX=PERCENT OF POPULATION ProdUCING AXES (ABUNA)
     LABRSA=PERCENT OF POPULATION ProdUCING SALT (WILIMAN)
     LABRSH=PERCENT OF POPULATION ProdUCING SHELLS(ABUNA)
     LABRFE=PERCENT OF POPULATION ProdUCING FEATHERS(WILIMAN)
   QUANTITY OF EACH COMMODITY ProdUCED BY EACH ProdUCING MEMBER OF
     VILLAGE OF ORIGIN PER YEAR
     ProdAX[i]=UNITS OF AXES/ProdUCER/YEAR (ABUNA)
     ProdSA[i]=UNITS OF SALT/ProdUCER/YEAR (WILIMAN)
     ProdSH[i]=UNITS OF SHELLS/ProdUCER/YEAR (ABUNA)
     ProdFE[i]=UNITS OF FEATHERS/ProdUCER/YEAR (WILIMAN)
   QUANTITY OF EACH COMMODITY EXPORTED BY EACH VILLAGE
     EXPAX(j]=AMOUNT OF AXES EXPORTED
     EXPSA(j]=AMOUNT OF SALT EXPORTED
     EXPSH(j]=AMOUNT OF SALT EXPORTED
     EXPFE(j]=AMOUNT OF FEATHERS EXPORTED
   NEED OF EACH VILLAGE FOR VITAL COMMODITIES
     NEEDAX(j]=NEED OF EACH VILLAGE FOR AXES
     NEEDSA(j]=NEED OF EACH VILLAGE FOR SALT
   ACCESSMENT OF ProdUCING VILLAGES OF YEAR'S EXCHANGE
     ACESAX=ACCESSMENT OF AXE ProdUCERS OF THE YEAR'S EXCHANGE
     ACESSA=ACCESSMENT OF THE SALT ProdUCERS OF THE YEAR'S EXCHANGE
   XCHNGE(L)=EXCHANGE RATIOS BETWEEN TWO VILLAGES:
     AXES EXPORTED TO SALT RECEIVED}
     
{ ******************
  ** DECLARATIONS **
  ******************}
const years=60;
      villages=8;
      graphsize=10;

type  c_array=array[1..villages] of string[8];

const VILL: c_array=('ABUNA','LOGATA','DLOKA','FALMATIK',
        'WANDUT','DOLOMAL','WIDABUT','WILAMAN');

type  R_years_x_villages=array[1..years+1,1..villages] of real;
      graphstr=string[graphsize];
      lablstr=string[20];
      
var   POP: array[1..years,1..villages] of integer;
      ProdAX,ProdSA,ProdSH,ProdFE: array[1..years+1] of real;
      ACESAX,ACESSA: array[1..years] of real;
      EXPAX,EXPSA,NEEDAX,NEEDSA, {only years used}
      EXPSH,EXPFE,
      XCHNGE: R_years_x_villages; {only villages-1 used}
      LABRAX,LABRSA,LABRSH,LABRFE,maxval: real;
      POINT: array[1..years,1..villages] of string[10];
      i,j,k,L: integer;
      dsk: text;
      filenam: pathtype;

{output Procedures}

procedure heading2(lab: lablstr; sp1,sp2,nv1,nv2: integer);
var i: integer;
begin
  for i:=1 to 3 do writeln(dsk);
  writeln(dsk,' ':35,lab);
  write(dsk,' ':sp1);
  for i:=1 to nv1 do write(dsk,VILL[i]:8,' ':sp2);
  writeln(dsk);
  if nv2>0 then begin
    write(dsk,' ':sp1);
    for i:=2 to nv2 do write(dsk,vill[i]:8,' ':sp2);
    writeln(dsk);
  end;
end;

procedure writegraph(a:r_years_x_villages; r,c: integer; labl: lablstr);
var max: real;

  function maximum(a:R_years_x_villages;r,c: integer): real;
  var m: real;
  begin
    m:=0;
    for i:=1 to r do for j:=1 to c do if a[i,j]>m then m:=a[i,j];
    maximum:=m;
  end;
  
  function graph(v,maxv: real): graphstr;
  var s: graphstr;  i: integer;
  begin
    s:=' ';  for i:=2 to graphsize do s:=s+' ';
    i:=1+round(v/maxv*(graphsize-1));
    if v>0 then s[i]:='+' else s[1]:='o';
    graph:=s;
  end;

begin
  max:=maximum(a,r,c);
  if c=villages then heading2(labl,5,2,villages,0)
  else heading2(labl,5,2,villages-1,villages);
  writeln(dsk,'YEAR');
  for i:=1 to years do begin
    write(dsk,i:3,' |');
    for j:=1 to villages do write(dsk,graph(a[i,j],max),'|');
    writeln(dsk);
  end;
end;

  
{*****************************************
 ** READ INPUT AND INITIALIZE VARIABLES **
 *****************************************}

    begin

{ ** READ FILE OF POPULATION}
      filenam:='EXCHANGE.POP';
      readfile('Village Population by Year',dsk,filenam);
      for i:=1 to years do for j:=1 to villages do read(dsk,POP[I,J]);
      close(dsk);
      
{ ** SET INITIAL Production VALUES FOR ALL COMMODITIES }
      for i:=1 to years+1 do begin {hmm}
        ProdAX[i]:=5.0;  ProdSA[i]:=150.0;   ProdSH[i]:=20.0;   ProdFE[i]:=10.0;
        for j:=1 to villages do begin
          XCHNGE[i,j]:=0.0; EXPAX[i,j]:=0; EXPSA[I,j]:=0;
        end;        
      end;

{ ** SET INITIAL Production PARTICIPANT PERCENTAGE }
      LABRAX:=0.09;   LABRSA:=0.10;    LABRSH:=0.15;    LABRFE:=0.17;

{ ** INITIALIZE SHELL AND FEATHER ARRAYS FOR ALTERNATE ASSESSMENT
  ** INCLUDING REGULATORY GOODS RECEIVED THE PREVIOUS YEAR }
      EXPSH[1,1]:=(ProdSH[1]*(POP[1,1]*LABRSH))/2;
      EXPFE[1,villages]:=(ProdFE[1]*(POP[1,villages]*LABRFE))/2;
      for J:=2 to villages do begin
        EXPSH[1,J]:=EXPSH[1,J-1]/2;
        EXPFE[1,villages+1-J]:=EXPFE[1,villages+2-J]/2;
      end;
{ *************************************
  ** RUN EXCHANGE CYCLE FOR years YEARS **
  ************************************* }
      for I:=1 to years do begin

{ ** COMPUTE CONSUMPTION VALUES OF AXES AND SALT FOR EACH TOWN;}
        for J:=1 to 8 do begin
          NEEDAX[i,j]:=POP[i,j]*0.05;
          NEEDSA[i,j]:=POP[i,j]*1.6;
        end;
      
{ ** COMPUTE EXPORT VALUES FOR COMMODITIES FOR VILLAGE OF ORIGIN; }
        EXPAX[I,1]:=ProdAX[i]*(POP[I,1]*LABRAX)-NEEDAX[I,1];
        EXPSA[I,villages]:=ProdSA[i]*(POP[I,villages]*LABRSA)-NEEDSA[I,villages];
        EXPSH[I+1,1]:=(ProdSH[i]*(POP[I,1]*LABRSH))/2;
        EXPFE[I+1,villages]:=(ProdFE[i]*(POP[I,villages]*LABRFE))/2;

{ ** COMPUTE EXPORT VALUES OF EACH COMMODITY FOR EACH VILLAGE }
        for J:=2 to villages do begin
          EXPAX[i,j]:=EXPAX[i,J-1]-NEEDAX[i,j];
          EXPSA[i,villages+1-j]:=EXPSA[i,villages+2-j]-
            NEEDSA[i,villages+1-j];
          EXPSH[i+1,j]:=EXPSH[i+1,J-1]/2;
          EXPFE[i+1,villages+1-j]:=EXPFE[i+1,villages+2-j]/2;
       end;

{ ** COMPUTE EXCHANGE RATIOS }
        for J:=1 to villages-1 do begin
          IF (EXPSA[i,J+1] > 0.0) and (EXPAX[i,j] > 0)
             then XCHNGE[i,j]:=EXPAX[i,j]/EXPSA[i,J+1]
          else XCHNGE[i,j]:=0.000000; {only calculate if both + KK}
        end;
      
{ ** COMPUTE ASSESSMENT VALUES FOR AX ProdUCERS AND ADJUST Production }
        IF EXPSA[i,2]>0.0 then 
          ACESAX[i]:=1+((EXPFE[i+1,1]-EXPFE[i,1])/EXPSH[i,1])
        else ACESAX[i]:=EXPFE[i+1,1]/EXPFE[i,1];
{ ** COMPUTE ALTERNATIVE ASSESSMENT VALUE IN CASE OF FAILURE OF SALT }
{ ** ProdUCER TO ProdUCE ENOUGH SALT TO SUPPORT THE SYSTEM }
        LABRAX:=LABRAX*ACESAX[i];

{ ** COMPUTE ASSESSMENT VALUE FOR SALT ProdUCERS AND ADJUST Production }
        IF EXPAX[i,7]>0.0 then
          ACESSA[i]:=1+((EXPSH[i+1,villages]-
            EXPSH[i,villages])/EXPFE[i,villages])
        else ACESSA[i]:=EXPSH[i+1,villages]/EXPSH[i,villages];
{ ** COMPUTE ALTERNATIVE ASSESSMENT VALUE IN THE CASE OF FAILURE OF }
{ ** AXE ProdUCERS TO ProdUCE ENOUGH AXES TO SUPPORT THE SYSTEM }
        LABRSA:=LABRSA*ACESSA[i];
      end;
      
{ ********************************************************** }
{ ** OUTPUT RESULTS OF SIMULATED EXCHANGE FOR years YEARS ** }
{ ********************************************************** }
  
{ ** PRINT TABLE OF VILLAGE POPULATIONS }
      filenam:='EXCHANGE.LST';
      writefile('Output Listing',dsk,filenam);
      if readbool('List Populations','F') then begin
        heading2('POPULATION',4,1,villages,0);
        writeln(dsk,'Year');
        for I:=1 to years do begin
          write(dsk,i:4);
          for j:=1 to villages do write(dsk,pop[i,j]:8,' ');
          writeln(dsk);
        end;
      end;

{ ** PRINT TABLE OF Production, EXPORTS, AND ASSESSMENT }
      for i:=1 to 3 do writeln(dsk);
      writeln(dsk,' ':35,'EXPORTS ');
      for i:=1 to years do begin
        if (i mod 10)=1 then begin
          for j:=1 to 3 do writeln(dsk);
          write(dsk,' ':11);
          for j:=1 to villages do write(dsk,VILL[j]:8,' ');
          writeln(dsk,'ASSESS':8);
        end;
        writeln(dsk,'YEAR ',I:2);
        write(dsk,' AXES ',LABRAX:4:2,' ');
        for j:=1 to villages do write(dsk,EXPAX[i,j]:8:1,' ');
        writeln(dsk,ACESAX[i]:8:2);
        write(dsk,' SALT ',LABRSA:4:2,' ');
        for j:=1 to villages do write(dsk,EXPSA[i,j]:8:1,' ');
        writeln(dsk,ACESSA[i]:8:2);
        write(dsk,' SHEL ',LABRSH:4:2,' ');
        for j:=1 to villages do write(dsk,EXPSH[i+1,j]:8:1,' ');
        writeln(dsk);
        write(dsk,' FEAT ',LABRFE:4:2,' ');
        for j:=1 to villages do write(dsk,EXPFE[i+1,j]:8:1,' ');
        writeln(dsk);
      end;

{ ** PRINT TABLE OF EXCHANGE RATIOS }
      heading2('EXCHANGE RATIOS',4,1,villages-1,villages);
      writeln(dsk,'YEAR');
      for I:=1 to years do begin
        write(dsk,i:4);
        for j:=1 to villages-1 do write(dsk,XCHNGE[i,j]:8:2,' ');
        writeln(dsk);
      end;

{ ** CALL SUBROUTINE GRAPH TO GRAPH AXE Production }
      writegraph(EXPAX,years,villages,'AXE EXPORTS');
{ ** CALL SUBROUTINE GRAPH TO GRAPH SALT ProdUCUCTION }
      writegraph(EXPSA,years,villages,'SALT EXPORTS');
{ ** CALL SUBROUTINE GRAPH TO GRAPH EXCHANGE RATIOS }
      writegraph(XCHNGE,years,villages-1,'EXCHANGE RATIOS');
      close(dsk);
    end.