// Delphi 6 dynamic targeting procedure based on code posted by Atamur at...
// http://free.prohosting.com/~mmerkulo/dt.pl.html
// Modified to cope with low/zero kill rates

procedure dtcalc(Ships: array of Real;
                 Rates: array of Real;
                 var Kills: array of integer;
                 var Damage: array of Real;
                 var Shots: integer;
                 var ShotsUsed: array of integer);

var
I: integer;
n: integer;
Scale: Real;

leftg,
rightg,
midg,
Precission,
ResultingShots: real;
CountLimit: integer;
ZeroRateDamageBuffer: array of Real;
ZeroRateBuffer: array of Real;

begin

// Test input parameters
if Length(Ships) = 0 then exit;
if Shots <= 0 then exit;

// Check for zero kill rate and compensate
try
SetLength(ZeroRateDamageBuffer,Length(Ships));
SetLength(ZeroRateBuffer,Length(Ships));
for I := Low(Ships) to high(Ships) do
  if Rates[I] = 0 then
    begin
      ZeroRateDamageBuffer[I] := Damage[I];
      Damage[I] := 0;
      ZeroRateBuffer[I] := Rates[I];
      Rates[I] := 1/(Shots+1);  // Set the rate so that there will never...
    end                           // be enough ships to kill one target ship
  else
    begin
      ZeroRateDamageBuffer[I] := 0;
      ZeroRateBuffer[I] := -1;
    end;

// Test for 1st trivial case, ie only 1 type of target ship present
// Return the Kills, Shots left, Damage and exit
if Length(Ships) = 1 then
  begin
  ResultingShots := Ceil((Ships[0]-Damage[0])/rates[0]);
  if ResultingShots <= Shots then    // all targets killed
    begin
    Kills[0] := Ceil(Ships[0]);
    ShotsUsed[0] := Ceil(resultingshots);
    Damage[0] := 0;
    Shots := Shots - ShotsUsed[0];
    end
  else                               // not all targets killed
    begin
    if ZeroRateBuffer[0] = 0
      then Damage[0] := ZeroRateDamageBuffer[0]
      else Damage[0] := Damage[0] + (Shots*Rates[0]);
    Kills[0] := Floor(Damage[0]);
    Damage[0] := Damage[0] - Kills[0];
    ShotsUsed[0] := Shots;
    Shots := 0;
    end;
  exit;
  end;

ResultingShots := 0;

// Test for 2nd trivial case, ie all target ships killed
// Return the Kills, Shots left, Damage and exit
for I := Low(Ships) to high(Ships) do
  begin
  ResultingShots := ResultingShots + ((Ships[I]-Damage[I])/rates[I]);
  Kills[I] := Ceil(Ships[I]);
  ShotsUsed[I] := Round((Ships[I]-Damage[I])/rates[I])
  end;
if ResultingShots <= Shots then      // all targets killed
  begin
  Shots := Shots - Ceil(resultingshots);
  exit;
  end;

// Calculate Min Rate scaling
n := 0;
for I := Low(Ships) to high(Ships) do
  begin
  if rates[I] < rates[n] then n := I;
  end;
Scale := rates[n];

// Set up the Bisection loop
leftg := 0;
rightg := 1;
Precission := 0.000001;
CountLimit := 50;

// Bisect, Estimate g, and test Resulting Shots against Shots available
repeat
  midg := (leftg+rightg)/2;
  ResultingShots := 0;
  for I := Low(Ships) to high(Ships) do
    begin
    ResultingShots := ResultingShots + ((Ships[I]-Damage[I])*(1-power(midg,rates[I]/Scale))/rates[I]);
    end;

  // Set new boundaries depending on value of ResultingShots
  if ResultingShots > Shots
    then leftg := midg
    else rightg := midg;

  // If the loop counter has dropped to zero then exit with error
  CountLimit := CountLimit - 1;
  if CountLimit = 0 then
    begin
    ShowMessage('Loop counter Bailout exceeded !');
    // Exit Bisection loop, calculate kills based
    // on current value of midg
    Break;
    end;

// Keep looping until the ...
// precision is less than the resulting tolerance    OR  the resolution is less than half a shot
until (Shots*Precission > Abs(ResultingShots-Shots)) or (Round(ResultingShots) = (Shots));

// convergence achieved...
// so calculate the kills and exit the loop
for I := Low(Ships) to high(Ships) do
  begin
  ShotsUsed[I] := Round((Ships[I]-Damage[I])*(1-power(midg,rates[I]/Scale))/rates[I]);
  if ZeroRateBuffer[I] = 0
    then Damage[I] := ZeroRateDamageBuffer[I]
    else Damage[I] := Damage[I] + (ShotsUsed[I]*rates[I]);
  Kills[I] := Floor(Damage[I]);
  Damage[I] := Damage[I] - Kills[I];
  end;

Shots := 0;

// Clean up the dynamic arrays
finally
ZeroRateDamageBuffer := nil;
ZeroRateBuffer := nil;
end;

end;   // dtCalc