{$MODE OBJFPC} { -*- delphi -*- }
{$INCLUDE settings.inc}
unit schedule;

interface

uses
   genericutils, stringutils, binaryheap,
   isdnumbers, time, plasticarrays;

type
   generic TRateScheduleDefaultUtils<T> = record // works if T is an ordinal
      class function Multiply(Multiplicand: T; Multiplier: Int64): T; static; inline;
      class function Add(A, B: T): T; static; inline;
   end;
   
   // stack: 64 bits (pointer to dynamic array)
   // heap: variable, typically 16 bytes per entry
   // defaults to zero
   generic TRateSchedule<T, Utils> = record
   public
      type
         TEntry = record
            TimeOrigin: Int32; // TODO: probably needs to be a TMillisecondsDuration because otherwise you can't advance a schedule more than an hour of real time
            Period: Cardinal;
            Delta: T;
         end;
      var
         FData: array of TEntry;
      function GetIsEmpty(): Boolean; inline;
      function GetCount(): Cardinal; inline;
   private
      procedure InternalMerge(var Result, Other: TRateSchedule);
   public
      procedure Reset(); inline;
      class function FromRate(Rate: specialize TRawRate<T>): TRateSchedule; static;
      function Clone(): TRateSchedule; // copies array
      function Evaluate(Duration: TMillisecondsDuration): T;
      procedure Advance(Duration: TMillisecondsDuration);
      function Merge(Other: TRateSchedule): TRateSchedule; inline;
      property IsEmpty: Boolean read GetIsEmpty;
      property Count: Cardinal read GetCount;
   end;

   generic function ConvertSchedule<T, TU, R, RU, Mapper>(Source: specialize TRateSchedule<T, TU>; const Parameters: Mapper): specialize TRateSchedule<R, RU>;
   // Mapper = record
   //    class function Convert(OldValue: T; const Parameters: Mapper): R; static; inline;
   // end;

type
   generic TRateScheduleBuilder<T, Utils> = record
   private
      type
         TSchedule = specialize TRateSchedule<T, Utils>;
         TEntry = TSchedule.TEntry;
         TEntryUtils = specialize IncomparableUtils<TEntry>;
      var
         FData: specialize PlasticArray<TEntry, TEntryUtils>;
   public
      procedure Init(TargetSize: Cardinal);
      procedure Add(TimeOrigin: TMillisecondsDuration; Period: TMillisecondsDuration; Delta: T);
      function Compile(): TSchedule;
   end;

implementation

uses
   sysutils, intutils;

class function TRateScheduleDefaultUtils.Multiply(Multiplicand: T; Multiplier: Int64): T;
begin
   Result := Multiplicand * Multiplier; // $R-
end;

class function TRateScheduleDefaultUtils.Add(A, B: T): T;
begin
   Result := A + B; // $R-
end;


procedure TRateSchedule.Reset();
begin
   SetLength(FData, 0);
end;

class function TRateSchedule.FromRate(Rate: specialize TRawRate<T>): TRateSchedule;
begin
   if (Rate.IsNotExactZero) then
   begin
      Assert(Rate.AsPeriod.AsInt64 <= High(Cardinal), 'too slow for schedule');
      Assert(Rate.AsPeriod.AsInt64 >= Low(Cardinal), 'negative rates not supported');
      SetLength(Result.FData, 1); // {BOGUS Warning: Function result variable of a managed type does not seem to be initialized}
      Result.FData[0].TimeOrigin := 0;
      Result.FData[0].Period := Rate.AsPeriod.AsInt64; // $R-
      Result.FData[0].Delta := T.One;
   end
   else
      Result.Reset();
end;

function TRateSchedule.Clone(): TRateSchedule;
begin
   Result.FData := FData;
   SetLength(Result.FData, Length(Result.FData)); // force ref-count to 1, copying if necessary
end;
   
function TRateSchedule.Evaluate(Duration: TMillisecondsDuration): T;
var
   Entry: TEntry;
begin
   Result := Default(T);
   for Entry in FData do
   begin
      if (Duration >= TMillisecondsDuration.FromMilliseconds(Entry.TimeOrigin + Entry.Period)) then
         Result := Utils.Add(Result, Utils.Multiply(Entry.Delta, (Duration - TMillisecondsDuration.FromMilliseconds(Entry.TimeOrigin)) div TMillisecondsDuration.FromMilliseconds(Entry.Period)));
   end;
end;

procedure TRateSchedule.Advance(Duration: TMillisecondsDuration);
var
   Index: Cardinal;
begin
   if (Length(FData) > 0) then
   begin
      for Index := Low(FData) to High(FData) do // $R-
      begin
         with (FData[Index]) do
         begin
            if (TimeOrigin + Period >= Duration.AsInt64) then
            begin
               // we didn't even get a single iteration, just shift the time origin
               Dec(TimeOrigin, Duration.AsInt64); // $R-
            end
            else
            begin
               // we had at least one iteration, maybe more, align the time origin with the time due to the next period
               TimeOrigin := -((Duration.AsInt64 - TimeOrigin) mod Period); // $R-
            end;
         end;
      end;
   end;
end;

function TRateSchedule.GetIsEmpty(): Boolean;
begin
   Result := Length(FData) = 0;
end;

function TRateSchedule.GetCount(): Cardinal;
begin
   Result := Length(FData); // $R-
end;

procedure TRateSchedule.InternalMerge(var Result, Other: TRateSchedule);
var
   SourceIndex, TargetIndex: Cardinal;
begin
   SetLength(Result.FData, Length(FData) + Length(Other.FData));
   TargetIndex := Low(Result.FData);
   Assert(Length(FData) > 0);
   for SourceIndex := Low(FData) to High(FData) do // $R-
   begin
      Result.FData[TargetIndex] := FData[SourceIndex];
      Inc(TargetIndex);
   end;
   Assert(Length(Other.FData) > 0);
   for SourceIndex := Low(Other.FData) to High(Other.FData) do // $R-
   begin
      Result.FData[TargetIndex] := Other.FData[SourceIndex];
      Inc(TargetIndex);
   end;
   Assert(TargetIndex = Length(Result.FData));
end;

function TRateSchedule.Merge(Other: TRateSchedule): TRateSchedule;
begin
   if (Length(Other.FData) = 0) then
   begin
      Result.FData := FData;
   end
   else
   if (Length(FData) = 0) then
   begin
      Result.FData := Other.FData;
   end
   else
   begin
      InternalMerge(Result, Other);
   end;
end;

generic function ConvertSchedule<T, TU, R, RU, Mapper>(Source: specialize TRateSchedule<T, TU>; const Parameters: Mapper): specialize TRateSchedule<R, RU>;
var
   Index: Cardinal;
begin
   SetLength(Result.FData, Length(Source.FData)); // {BOGUS Warning: Function result variable of a managed type does not seem to be initialized}
   if (Length(Result.FData) > 0) then
      for Index := Low(Result.FData) to High(Result.FData) do // $R-
      begin
         Result.FData[Index].TimeOrigin := Source.FData[Index].TimeOrigin;
         Result.FData[Index].Period := Source.FData[Index].Period;
         Result.FData[Index].Delta := Mapper.Convert(Source.FData[Index].Delta, Parameters);
      end;
end;

procedure TRateScheduleBuilder.Init(TargetSize: Cardinal);
begin
   FData.Reset();
   FData.Prepare(TargetSize);
end;

procedure TRateScheduleBuilder.Add(TimeOrigin: TMillisecondsDuration; Period: TMillisecondsDuration; Delta: T);
var
   Entry: TEntry;
begin
   Assert(TimeOrigin.AsInt64 >= Low(TEntry.TimeOrigin));
   Assert(TimeOrigin.AsInt64 <= High(TEntry.TimeOrigin));
   Assert(Period.AsInt64 >= Low(TEntry.Period));
   Assert(Period.AsInt64 <= High(TEntry.Period));
   if (FData.IsNotEmpty and (FData.Last.TimeOrigin = TimeOrigin.AsInt64) and (FData.Last.Period = Period.AsInt64)) then
   begin
      Entry := FData.Last;
      Entry.Delta := Utils.Add(Entry.Delta, Delta);
      FData.Last := Entry;
   end
   else
   begin
      Entry.TimeOrigin := TimeOrigin.AsInt64; // $R-
      Entry.Period := Period.AsInt64; // $R-
      Entry.Delta := Delta;
      FData.Push(Entry);
   end;
end;

function TRateScheduleBuilder.Compile(): TSchedule;
begin
   Result.FData := FData.Distill();
end;
      
end.