home *** CD-ROM | disk | FTP | other *** search
/ Game Killer / Game_Killer.bin / 265.HITRFFIC.INC < prev    next >
Text File  |  1991-07-08  |  4KB  |  149 lines
  1. procedure HighTraffic;
  2. { compute those high traffic areas }
  3. var
  4.   weights : array [1..MaxSector] of integer;
  5.   counts  : array [1..MaxSector] of real;
  6.   s1, s2  : sector;
  7.   log, d  : boolean;
  8.   f       : text;
  9.   i       : integer;
  10.  
  11. procedure UniformProbs;
  12. { Assign all sectors to weight 1 }
  13. var
  14.   s : sector;
  15. begin
  16.   for s := 1 to MaxSector do
  17.     weights[s] := 1;
  18. end; {Uniform probabilities}
  19.  
  20. procedure PortProbs;
  21. { assign probabilities based upon sector type.  Empty sectors get nothing.
  22. Space dock gets 50, terra 20, the other ports based upon port type. }
  23. var
  24.   s : sector;
  25. begin
  26.   for s := 1 to maxSector do
  27.     case space.sectors[s].portType of
  28.       NotAPort   : weights[s] := 0;
  29.       0, 7       : weights[s] := 1;
  30.       1, 6       : weights[s] := 2;
  31.       2, 3, 4, 5 : weights[s] := 4;
  32.       Class0     : weights[s] :=10;
  33.     end; {case}
  34.   weights[1] := 20;
  35.   if space.dock <> 0 then
  36.     weights[ space.dock ] := 50;
  37. end; {port probs}
  38.  
  39. procedure AssignWeights;
  40. var
  41.   ch : char;
  42. begin
  43.   write('Port-heavy probabilities, (1) or uniform probabilities (2)?');
  44.   readln( ch );
  45.   case ch of
  46.     '1' : PortProbs;
  47.   else
  48.           UniformProbs;
  49.   end; {case}
  50. end; {Assign the "weights" table}
  51.  
  52. procedure InitCounts;
  53. var
  54.   s : sector;
  55. begin
  56.   for s := 1 to maxSector do
  57.     counts[s] := 0.0;
  58. end; {Initialize all counts to zero}
  59.  
  60. procedure DisplayCounts( short, disk : boolean; var diskfile : text);
  61. const
  62.   header = ' sctr prob sctr prob sctr prob sctr prob';
  63.  
  64. var
  65.   highestsector, linecount : integer;
  66.   s : sector;
  67.   highestval : real;
  68.   quit : boolean;
  69. begin
  70.   linecount := 0;
  71.   quit := false;
  72.   if short then
  73.     writeln( header, header );
  74.   if short and disk then
  75.     writeln(diskfile, header, header );
  76.   repeat
  77.     highestval := 0;
  78.     for s := 1 to maxSector do
  79.       if counts[s] > highestval then
  80.         begin
  81.           highestval := counts[s];
  82.           highestsector := s;
  83.         end; {if}
  84.     if highestval > 0 then
  85.       if short then
  86.         begin
  87.           write(highestsector:4,  ' ', highestval :5:0);
  88.           if disk then
  89.             write(diskfile, highestsector : 4,' ', highestval : 5:0);
  90.         end {if}
  91.       else
  92.         DisplaySector( highestsector, ' prb:', round( highestval/100),
  93.                        disk, diskfile);
  94.     counts[ highestsector ] := 0;
  95.     linecount := linecount + 1;
  96.     if linecount mod 8 = 0 then
  97.       if disk then
  98.         writeln( diskfile );
  99.     if (linecount mod 160 = 0) and not disk then
  100.       begin
  101.         writeln;
  102.         quit := not prompt('more?');
  103.       end; {if}
  104.   until (highestval = 0) or quit;
  105.   writeln;
  106.   if disk then
  107.     writeln( diskfile );
  108. end;
  109.  
  110. procedure BackTrack( fromSector, toSector : sector );
  111. begin
  112.   counts[ fromSector ] := counts[ fromSector ] + weights[ fromSector ]
  113.                                                + weights[ toSector ];
  114.   if fromSector <> toSector then
  115.     BackTrack( distances[ fromSector ].s , toSector );
  116. end;
  117.  
  118. begin {HighTraffic}
  119.   writeln('Warning: this computation will take a fairly long time.');
  120.   if prompt('Try some other time? ') then
  121.     exit;
  122.   AssignWeights;
  123.   InitCounts;
  124.   log := prompt( 'Log to disk? ');
  125.   d   := prompt('Short report? ');
  126.   if log then
  127.     begin
  128.       assign( f, GetNewFileName('File name for report?  ', 'traffic.txt') );
  129.       rewrite( f );
  130.     end;
  131.   for s1 := 1 to maxSector do
  132.     begin
  133.       if space.sectors[s1].number <> unexplored then
  134.         begin
  135. { Do a shortest path search, finding spots for all sectors.  Mark parent.
  136.   Now for each explored sector, just trace back toward s1. }
  137.           write( s1, ' ');
  138.           TwoWayDistances( s1, distances, false, true );
  139.           for s2 := 1 to MaxSector do
  140.             if (space.sectors[s2].number <> unexplored)
  141.                 and (distances[s2].d <> maxint) then
  142.               BackTrack( s2, s1);
  143.         end; {explored}
  144.     end; {for s1}
  145.   DisplayCounts( d, log, f);
  146.   if log then
  147.     close( f );
  148. end;
  149.