Unit VolumeBlockMinAndMax;

{ TVolumeBlockMinAndMax converts volume bars into a series of upward and
  downward lines.  Sometimes it can be slow to show a change in direction
  because it needs at least one whole volume bar going in the opposite
  direction of the current trend before it makes an announcement.

  This class wakes the listener every time the underlying volume bars
  data node wakes it.  The turning points may or may not have changed.
  One update may contain zero, one, or more additions to the list of
  turning points.

  If the volume blocks data node resets, this data node will also reset,
  presenting a list of 0 turning points.  Except for that case, the list
  of turning points can only grow.  The existing points won't change or
  go away.
}

Interface

  Uses
    DataNodes, NormalVolumeBreakBars, VolumeWeightedData,
    Classes;

  Type
    TVBMMDirection = (vbdUnknown, vbdUp, vbdDown, vbdPossibleUp, vbdPossibleDown);
    TVBMMDirectionExternal = vbdUnknown..vbdDown;
    TVBMMOrientation = (vboHigh, vboLow);
    TVBMMTurningPoints = Array Of
      Record
        Price : Double;
        Index : Integer;
        Orientation : TVBMMOrientation
      End;

    TVolumeBlockMinAndMaxAccumulator =
      Class(TObject)
      Private
        FBlockCount : Integer;
        FInitialDirection : TVBMMDirectionExternal;
        FCurrentDirection : TVBMMDirection;
        FRecentBlocks : Array Of
          Record
            Block : TVolumeBlock;
            Index : Integer
          End;
        FTurningPoints : TVBMMTurningPoints;
        Function GetCurrentDirection : TVBMMDirectionExternal;
      Public
        Property BlockCount : Integer Read FBlockCount;
        Property InitialDirection : TVBMMDirectionExternal Read FInitialDirection;
        Property CurrentDirection : TVBMMDirectionExternal Read GetCurrentDirection;
        Property TurningPoints : TVBMMTurningPoints Read FTurningPoints;
        Procedure AddBlock(Block : TVolumeBlock);
      End;

    TVolumeBlockMinAndMax =
      Class(TDataNodeWithStringKey)
      Private
        BarData : TNormalVolumeBreakBars;
        FSymbol : String;
        HighsAndLows : TVolumeBlockMinAndMaxAccumulator;
        Procedure NewBarData;
        Procedure Init;
        Constructor Create(Symbol : String);
        Function GetAllBlocks : TVolumeBlocks;
        Function GetTurningPoints : TVBMMTurningPoints;
      Protected
        Class Function CreateNew(Data : String) : TDataNodeWithStringKey; Override;
      Public
        Class Procedure Find(Symbol : String;
                             OnChange : TThreadMethod;
                             Out Node : TVolumeBlockMinAndMax;
                             Out Link : TDataNodeLink);
        Property AllBlocks : TVolumeBlocks Read GetAllBlocks;
        Property TurningPoints : TVBMMTurningPoints Read GetTurningPoints;
        Destructor Destroy; Override;
      End;

Implementation

  ////////////////////////////////////////////////////////////////////////
  // TVolumeBlockMinAndMaxAccumulator
  ////////////////////////////////////////////////////////////////////////

  Function TVolumeBlockMinAndMaxAccumulator.GetCurrentDirection : TVBMMDirectionExternal;
    Const
      Reportable : Array[TVBMMDirection] Of TVBMMDirectionExternal
        = (vbdUnknown, vbdUp, vbdDown, vbdDown, vbdUp);
    Begin
      Result := Reportable[FCurrentDirection]
    End;

  Procedure TVolumeBlockMinAndMaxAccumulator.AddBlock(Block : TVolumeBlock);
    Procedure AddRecentBlock;
      Var
        RecentBlockIndex : Integer;
      Begin
        RecentBlockIndex := Length(FRecentBlocks);
        If (RecentBlockIndex = 0)
           Or (Block.High <> FRecentBlocks[Pred(RecentBlockIndex)].Block.High)
           Or (Block.Low <> FRecentBlocks[Pred(RecentBlockIndex)].Block.Low) Then
          Begin
            SetLength(FRecentBlocks, Succ(RecentBlockIndex));
            FRecentBlocks[RecentBlockIndex].Block := Block;
            FRecentBlocks[RecentBlockIndex].Index := BlockCount
          End
      End;
    Procedure SetRecentBlock;
      Begin
        SetLength(FRecentBlocks, 1);
        FRecentBlocks[0].Block := Block;
        FRecentBlocks[0].Index := BlockCount
      End;
    Procedure AddTurningPoint(RecentBlockIndex : Integer;
                              Orientation : TVBMMOrientation);
      Var
        OldLength : Integer;
      Begin
        OldLength := Length(FTurningPoints);
        SetLength(FTurningPoints, Succ(OldLength));
        If Orientation = vboHigh Then
          FTurningPoints[OldLength].Price := FRecentBlocks[RecentBlockIndex].Block.High
        Else
          FTurningPoints[OldLength].Price := FRecentBlocks[RecentBlockIndex].Block.Low;
        FTurningPoints[OldLength].Index := FRecentBlocks[RecentBlockIndex].Index;
        FTurningPoints[OldLength].Orientation := Orientation
      End;
    Var
      PreviousBlockIndex : Integer;
    Begin
      Case FCurrentDirection Of
        vbdUnknown :
          Begin
            For PreviousBlockIndex := Pred(Length(FRecentBlocks)) DownTo 0 Do
              If (Block.High > FRecentBlocks[PreviousBlockIndex].Block.High)
                 And (Block.Low > FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                Begin
                  FInitialDirection := vbdUp;
                  Break
                End
              Else If (Block.High < FRecentBlocks[PreviousBlockIndex].Block.High)
                      And (Block.Low < FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                Begin
                  FInitialDirection := vbdDown;
                  Break
                End;
            If FInitialDirection = vbdUnknown Then
              AddRecentBlock
            Else
              Begin
                FCurrentDirection := FInitialDirection;
                SetRecentBlock
              End
          End;
        vbdUp :
          Begin
            Assert(Length(FRecentBlocks) = 1);
            If Block.High >= FRecentBlocks[0].Block.High Then
              SetRecentBlock
            Else If Block.Low < FRecentBlocks[0].Block.Low Then
              Begin
                AddTurningPoint(0, vboHigh);
                FCurrentDirection := vbdDown;
                SetRecentBlock
              End
            Else
              Begin
                FCurrentDirection := vbdPossibleDown;
                AddRecentBlock
              End
          End;
        vbdDown :
          Begin
            Assert(Length(FRecentBlocks) = 1);
            If Block.Low <= FRecentBlocks[0].Block.Low Then
              SetRecentBlock
            Else If Block.High > FRecentBlocks[0].Block.High Then
              Begin
                AddTurningPoint(0, vboLow);
                FCurrentDirection := vbdUp;
                SetRecentBlock
              End
            Else
              Begin
                FCurrentDirection := vbdPossibleUp;
                AddRecentBlock
              End
          End;
        vbdPossibleDown :
          Begin
            Assert(Length(FRecentBlocks) >= 1);
            If Block.High >= FRecentBlocks[0].Block.High Then
              Begin
                FCurrentDirection := vbdUp;
                SetRecentBlock
              End
            Else
              For PreviousBlockIndex := Pred(Length(FRecentBlocks)) DownTo 0 Do
                If (Block.High > FRecentBlocks[PreviousBlockIndex].Block.High)
                   And (Block.Low > FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                  Begin
                    AddTurningPoint(0, vboHigh);
                    AddTurningPoint(0, vboLow);
                    FCurrentDirection := vbdUp;
                    SetRecentBlock;
                    Break
                  End
                Else If (Block.High < FRecentBlocks[PreviousBlockIndex].Block.High)
                        And (Block.Low < FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                  Begin
                    AddTurningPoint(0, vboHigh);
                    FCurrentDirection := vbdDown;
                    SetRecentBlock;
                    Break
                  End;
            If FCurrentDirection In [vbdPossibleUp, vbdPossibleDown] Then
              AddRecentBlock
            Else
              SetRecentBlock
          End;
        vbdPossibleUp :
          Begin
            Assert(Length(FRecentBlocks) >= 1);
            If Block.Low <= FRecentBlocks[0].Block.Low Then
              Begin
                FCurrentDirection := vbdDown;
                SetRecentBlock
              End
            Else
              For PreviousBlockIndex := Pred(Length(FRecentBlocks)) DownTo 0 Do
                If (Block.High < FRecentBlocks[PreviousBlockIndex].Block.High)
                   And (Block.Low < FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                  Begin
                    AddTurningPoint(0, vboLow);
                    AddTurningPoint(0, vboHigh);
                    FCurrentDirection := vbdDown;
                    SetRecentBlock;
                    Break
                  End
                Else If (Block.High > FRecentBlocks[PreviousBlockIndex].Block.High)
                        And (Block.Low > FRecentBlocks[PreviousBlockIndex].Block.Low) Then
                  Begin
                    AddTurningPoint(0, vboLow);
                    FCurrentDirection := vbdUp;
                    SetRecentBlock;
                    Break
                  End;
            If FCurrentDirection In [vbdPossibleUp, vbdPossibleDown] Then
              AddRecentBlock
            Else
              SetRecentBlock
          End;
      End;
      Inc(FBlockCount)
    End;

  ////////////////////////////////////////////////////////////////////////
  // TVolumeBlockMinAndMax
  ////////////////////////////////////////////////////////////////////////

  Function TVolumeBlockMinAndMax.GetAllBlocks : TVolumeBlocks;
    Begin
      If Assigned(BarData) Then
        Result := BarData.GetBlocks
      Else
        SetLength(Result, 0)
    End;

  Function TVolumeBlockMinAndMax.GetTurningPoints : TVBMMTurningPoints;
    Begin
      If Assigned(HighsAndLows) Then
        Result := HighsAndLows.TurningPoints
      Else
        SetLength(Result,0)
    End;

  Procedure TVolumeBlockMinAndMax.NewBarData;
    Var
      Blocks : TVolumeBlocks;
    Begin
      Blocks := BarData.GetBlocks;
      If Length(Blocks) = 0 Then
        Begin
          HighsAndLows.Free;
          HighsAndLows := Nil
        End
      Else
        Begin
          If Not Assigned(HighsAndLows) Then
            HighsAndLows := TVolumeBlockMinAndMaxAccumulator.Create;
          While HighsAndLows.BlockCount < Length(Blocks) Do
            HighsAndLows.AddBlock(Blocks[HighsAndLows.BlockCount])
        End;
      NotifyListeners
    End;

  Destructor TVolumeBlockMinAndMax.Destroy;
    Begin
      HighsAndLows.Free;
      Inherited
    End;

  Procedure TVolumeBlockMinAndMax.Init;
    Var
      Link : TDataNodeLink;
    Begin
      TNormalVolumeBreakBars.Find(FSymbol, NewBarData, BarData, Link);
      AddAutoLink(Link);
      NewBarData;
      Link.SetReceiveInput(True)
    End;

  Constructor TVolumeBlockMinAndMax.Create(Symbol : String);
    Begin
      FSymbol := Symbol;
      Inherited Create;
      DoInCorrectThread(Init)
    End;

  Class Function TVolumeBlockMinAndMax.CreateNew(Data : String) : TDataNodeWithStringKey;
    Begin
      Result := Create(Data)
    End;

  Class Procedure TVolumeBlockMinAndMax.Find(Symbol : String;
                                OnChange : TThreadMethod;
                                Out Node : TVolumeBlockMinAndMax;
                                Out Link : TDataNodeLink);
    Var
      TempNode : TDataNodeWithStringKey;
    Begin
      FindCommon(TVolumeBlockMinAndMax, Symbol, OnChange, TempNode, Link);
      Node := TempNode As TVolumeBlockMinAndMax
    End;



End.