diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj
index d3265b9..8d82b57 100644
--- a/AuraTrader/AuraTrader.dproj
+++ b/AuraTrader/AuraTrader.dproj
@@ -4,7 +4,7 @@
20.3
FMX
True
- Debug
+ Release
Win64
AuraTrader
3
diff --git a/AuraTrader/MainForm.fmx b/AuraTrader/MainForm.fmx
index e21a5d2..6cdaca8 100644
--- a/AuraTrader/MainForm.fmx
+++ b/AuraTrader/MainForm.fmx
@@ -166,6 +166,8 @@ object Form1: TForm1
StyleLookup = ''
TabOrder = 0
Text = 'Modules'
+ ExplicitSize.cx = 66.00000000000000000
+ ExplicitSize.cy = 26.00000000000000000
object TreeView: TTreeView
Align = Client
Size.Width = 169.00000000000000000
diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas
index 28c4117..0342aac 100644
--- a/AuraTrader/MainForm.pas
+++ b/AuraTrader/MainForm.pas
@@ -130,10 +130,6 @@ begin
tab.Text := ws.Caption;
tab.Tag := NativeInt(ws);
- var tabBtn := TSpeedButton.Create(Self);
- tabBtn.Parent := tab;
- tabBtn.Align := TAlignLayout.Right;
-
var scrollbox := TVertScrollBox.Create(Self);
scrollbox.Parent := tab;
scrollbox.Align := TAlignLayout.Client;
@@ -152,8 +148,6 @@ end;
procedure TForm1.TreeViewDblClick(Sender: TObject);
begin
- var addnew := false;
-
var sel := TreeView.Selected as TTreeViewItem;
var parent := sel.ParentItem;
@@ -372,14 +366,14 @@ begin
nil,
function: TState
begin
- var Prices := TDataSeries.CreateWriteable(width);
+ var Prices := TDataSeries.CreateDataSeries(width);
Result :=
FServer.ProcessData(
Symbol,
FTerminate.Signal,
procedure(const Values: TArray>; const Terminated: TState)
begin
- Prices.Add(Values);
+ Prices := Prices.Add(Values);
currLog.Value := Prices.TotalCount.ToString;
var PathData := TPathData.Create;
diff --git a/AuraTrader/TestChartControl.pas b/AuraTrader/TestChartControl.pas
index b7cae58..5110e99 100644
--- a/AuraTrader/TestChartControl.pas
+++ b/AuraTrader/TestChartControl.pas
@@ -10,30 +10,28 @@ uses
System.Variants,
System.Generics.Collections,
System.Math,
- System.UIConsts, // For AlphaColors
+ System.UIConsts,
+ System.TimeSpan,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Objects,
- Myc.Trade.DataPoint;
+ Myc.Signals,
+ Myc.Futures,
+ Myc.Trade.DataPoint,
+ Myc.Signals.FMX;
type
- // Declared for testing, will be moved to external unit
- TOhlcItem = record
- Open, High, Low, Close: Double;
- end;
-
- // Custom high-precision point type using Double.
TPointD = record
public
X: Double;
Y: Double;
constructor Create(AX, AY: Double);
+ procedure Offset(DX, DY: Double);
end;
- // Custom high-precision rectangle type using Double.
TRectD = record
private
function GetHeight: Double;
@@ -42,13 +40,22 @@ type
Left, Top, Right, Bottom: Double;
constructor Create(const ALeft, ATop, ARight, ABottom: Double); overload;
constructor Create(const ATopLeft, ABottomRight: TPointD); overload;
+ procedure Offset(DX, DY: Double);
+ procedure ExpandBy(const pt: TPointD);
property Width: Double read GetWidth;
property Height: Double read GetHeight;
end;
+ TRangeD = record
+ A: Double;
+ B: Double;
+ public
+ constructor Create(const AA, AB: Double);
+ end;
+
+ TChartZoomMode = (czmXY, czmXOnly);
TChart = class; // Forward declaration
- // Abstract base class for a single series in a chart.
TChartSeries = class abstract(TCollectionItem)
private
FColor: TAlphaColor;
@@ -59,65 +66,58 @@ type
function GetChart: TChart;
public
constructor Create(Collection: TCollection); override;
- // Calculates the bounding box for this series.
- procedure GetBounds(var MinPoint, MaxPoint: TPointD); virtual; abstract;
- // Draws the series on the canvas.
+ function GetBounds: TFuture; virtual; abstract;
+ function GetYBoundsForXRange(const XRange: TRangeD): TFuture; virtual; abstract;
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); virtual; abstract;
published
property Color: TAlphaColor read FColor write SetColor;
property Thickness: Single read FThickness write SetThickness;
end;
- // Generic, abstract adapter to connect a TDataSeries to a TChart.
TChartSeriesAdapter = class abstract(TChartSeries)
private
- FDataSeries: TDataSeries;
+ FDataSeries: TFuture>;
protected
- procedure SetDataSeries(const Value: TDataSeries); virtual;
- // Converts a data point from the source series to a high-precision visual point for the chart.
- // May not be applicable for all series types (e.g., OHLC).
+ procedure SetDataSeries(const Value: TFuture>); virtual;
function DataToPoint(const DataPoint: TDataPoint): TPointD; virtual; abstract;
public
constructor Create(Collection: TCollection); override;
- property DataSeries: TDataSeries read FDataSeries write SetDataSeries;
+ property DataSeries: TFuture> read FDataSeries write SetDataSeries;
end;
- TDataSourceField = (dsfAsk, dsfBid);
-
- // Concrete series implementation for displaying TDataSeries.
- TChartAskBidSeries = class(TChartSeriesAdapter)
+ // A generic series to plot a TDataSeries
+ TChartLineSeries = class(TChartSeriesAdapter)
private
- FDataSourceField: TDataSourceField;
- FCachedPoints: TArray;
- FCacheValid: Boolean;
- procedure SetDataSourceField(const Value: TDataSourceField);
- procedure EnsureCacheIsValid;
+ FBounds: TFuture;
protected
- procedure SetDataSeries(const Value: TDataSeries); override;
- function DataToPoint(const DataPoint: TDataPoint): TPointD; override;
+ procedure SetDataSeries(const Value: TFuture>); override;
+ function DataToPoint(const DataPoint: TDataPoint): TPointD; override;
public
constructor Create(Collection: TCollection); override;
- procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
+ function GetBounds: TFuture; override;
+ function GetYBoundsForXRange(const XRange: TRangeD): TFuture; override;
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
- published
- property DataSourceField: TDataSourceField read FDataSourceField write SetDataSourceField;
end;
- // Concrete series implementation for displaying TDataSeries as candlesticks.
TChartOhlcSeries = class(TChartSeriesAdapter)
private
FUpColor: TAlphaColor;
FDownColor: TAlphaColor;
+ FCandleWidth: Double;
+ FTimeInterval: TFuture;
+ FBounds: TFuture;
protected
- // This function is not used for OHLC drawing but must be implemented.
+ procedure SetDataSeries(const Value: TFuture>); override;
function DataToPoint(const DataPoint: TDataPoint): TPointD; override;
public
constructor Create(Collection: TCollection); override;
- procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
+ function GetBounds: TFuture; override;
+ function GetYBoundsForXRange(const XRange: TRangeD): TFuture; override;
procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
published
property UpColor: TAlphaColor read FUpColor write FUpColor;
property DownColor: TAlphaColor read FDownColor write FDownColor;
+ property CandleWidth: Double read FCandleWidth write FCandleWidth;
end;
TChartSeriesCollection = class(TCollection)
@@ -134,26 +134,40 @@ type
property Items[Index: Integer]: TChartSeries read GetItem write SetItem; default;
end;
- // A control for displaying charts.
TChart = class(TControl)
private
FSeries: TChartSeriesCollection;
FAxisColor: TAlphaColor;
FGridColor: TAlphaColor;
FPadding: Single;
+ FDataBounds: TFuture;
+ FYRange: TFuture;
+ FDataView: TRectD;
+ FBoundsValid: Boolean;
+ FIsPanning: Boolean;
+ FPanStartPoint: TPointF;
+ FZoomMode: TChartZoomMode;
procedure SetSeries(const Value: TChartSeriesCollection);
procedure SetAxisColor(const Value: TAlphaColor);
procedure SetGridColor(const Value: TAlphaColor);
procedure SetPadding(const Value: Single);
+ procedure RecalcDataBounds;
protected
procedure Paint; override;
- procedure RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
procedure DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
procedure DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure DblClick; override;
+ procedure InvalidateDataBounds;
+ procedure InvalidateYRange;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
- procedure Repaint;
+ procedure BeforeDestruction; override;
+ procedure ResetView;
published
property Align;
property Anchors;
@@ -161,6 +175,7 @@ type
property AxisColor: TAlphaColor read FAxisColor write SetAxisColor;
property GridColor: TAlphaColor read FGridColor write SetGridColor;
property Padding: Single read FPadding write SetPadding;
+ property ZoomMode: TChartZoomMode read FZoomMode write FZoomMode;
end;
TTestChartForm = class(TForm)
@@ -185,6 +200,12 @@ begin
Y := AY;
end;
+procedure TPointD.Offset(DX, DY: Double);
+begin
+ X := X + DX;
+ Y := Y + DY;
+end;
+
{ TRectD }
constructor TRectD.Create(const ALeft, ATop, ARight, ABottom: Double);
@@ -203,6 +224,26 @@ begin
Bottom := ABottomRight.Y;
end;
+procedure TRectD.ExpandBy(const pt: TPointD);
+begin
+ if pt.X < Left then
+ Left := pt.X;
+ if pt.X > Right then
+ Right := pt.X;
+ if pt.Y < Top then
+ Top := pt.Y;
+ if pt.Y > Bottom then
+ Bottom := pt.Y;
+end;
+
+procedure TRectD.Offset(DX, DY: Double);
+begin
+ Left := Left + DX;
+ Right := Right + DX;
+ Top := Top + DY;
+ Bottom := Bottom + DY;
+end;
+
function TRectD.GetHeight: Double;
begin
Result := Bottom - Top;
@@ -218,7 +259,7 @@ end;
constructor TChartSeries.Create(Collection: TCollection);
begin
inherited Create(Collection);
- FColor := TAlphaColors.Black; // Default color for wicks in OHLC
+ FColor := TAlphaColors.Black;
FThickness := 1;
end;
@@ -252,124 +293,123 @@ end;
constructor TChartSeriesAdapter.Create(Collection: TCollection);
begin
inherited Create(Collection);
- FDataSeries := TDataSeries.Null;
end;
-procedure TChartSeriesAdapter.SetDataSeries(const Value: TDataSeries);
+procedure TChartSeriesAdapter.SetDataSeries(const Value: TFuture>);
begin
FDataSeries := Value;
if Assigned(Collection) then
Changed(False);
end;
-{ TChartAskBidSeries }
+{ TChartLineSeries }
-constructor TChartAskBidSeries.Create(Collection: TCollection);
+constructor TChartLineSeries.Create(Collection: TCollection);
begin
inherited Create(Collection);
- Self.Color := TAlphaColors.Blue; // Override default for line charts
- Self.Thickness := 2;
- FDataSourceField := dsfAsk;
- FCacheValid := False;
+ Self.Color := TAlphaColors.Green;
+ Self.Thickness := 1;
end;
-procedure TChartAskBidSeries.EnsureCacheIsValid;
-var
- i: Int64;
- pointCount: Int64;
+procedure TChartLineSeries.SetDataSeries(const Value: TFuture>);
begin
- if FCacheValid then
- Exit;
- pointCount := DataSeries.Count;
- SetLength(FCachedPoints, pointCount);
- if (pointCount > 0) then
- begin
- for i := 0 to pointCount - 1 do
- begin
- FCachedPoints[i] := DataToPoint(DataSeries[pointCount - 1 - i]);
- end;
- end;
- FCacheValid := True;
+ // Future -> Future
+ FBounds :=
+ Value.Chain(
+ function(const Data: TDataSeries): TRectD
+ begin
+ if Data.Count = 0 then
+ Exit(TRectD.Create(0, 0, 0, 0));
+
+ Result := TRectD.Create(Data[0].Time, Data[0].Data, Data[0].Time, Data[0].Data);
+ for var i := 1 to Data.Count - 1 do
+ Result.ExpandBy(TPointD.Create(Data[i].Time, Data[i].Data));
+ end
+ );
+
+ inherited SetDataSeries(Value);
end;
-procedure TChartAskBidSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
-var
- pt: TPointD;
- isFirst: Boolean;
+function TChartLineSeries.DataToPoint(const DataPoint: TDataPoint): TPointD;
begin
- EnsureCacheIsValid;
- if (Length(FCachedPoints) = 0) then
- Exit;
- isFirst := (MinPoint.X = MaxPoint.X) and (MinPoint.Y = MaxPoint.Y);
- if isFirst then
- begin
- MinPoint := FCachedPoints[0];
- MaxPoint := FCachedPoints[0];
- end;
- for pt in FCachedPoints do
- begin
- MinPoint.X := Min(MinPoint.X, pt.X);
- MinPoint.Y := Min(MinPoint.Y, pt.Y);
- MaxPoint.X := Max(MaxPoint.X, pt.X);
- MaxPoint.Y := Max(MaxPoint.Y, pt.Y);
- end;
+ Result.X := DataPoint.Time;
+ Result.Y := DataPoint.Data;
end;
-procedure TChartAskBidSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
+function TChartLineSeries.GetBounds: TFuture;
+begin
+ Result := FBounds;
+end;
+
+function TChartLineSeries.GetYBoundsForXRange(const XRange: TRangeD): TFuture;
+begin
+ Result :=
+ DataSeries.Chain(
+ function(const Data: TDataSeries): TRangeD
+ begin
+ Result.A := Infinity;
+ Result.B := NegInfinity;
+
+ var n := Data.IndexOf(XRange.A);
+ for var i := n to Data.Count - 1 do
+ begin
+ var dp := Data[i];
+ var pt := TPointD.Create(dp.Time, dp.Data);
+ // if (pt.X >= XRange.A) and (pt.X <= XRange.B) then
+ // begin
+ // Result.A := System.Math.Min(Result.A, pt.Y);
+ // Result.B := System.Math.Max(Result.B, pt.Y);
+ // end;
+ if pt.X > XRange.B then
+ break;
+ Result.A := System.Math.Min(Result.A, pt.Y);
+ Result.B := System.Math.Max(Result.B, pt.Y);
+ end;
+ if IsInfinite(Result.A) then
+ begin
+ Result.A := 0;
+ Result.B := -1;
+ end;
+ end
+ );
+end;
+
+procedure TChartLineSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
var
scaleX, scaleY: Double;
- pt1, pt2: TPointD;
transformedPt1, transformedPt2: TPointF;
j: Integer;
begin
- EnsureCacheIsValid;
- if Length(FCachedPoints) < 2 then
+ if not DataSeries.Done.IsSet then
+ exit;
+ var points := DataSeries.Value;
+
+ if points.Count < 2 then
Exit;
+
if (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
Exit;
+
scaleX := ACanvasRect.Width / ADataRect.Width;
scaleY := ACanvasRect.Height / ADataRect.Height;
+
ACanvas.Stroke.Kind := TBrushKind.Solid;
ACanvas.Stroke.Color := Self.Color;
ACanvas.Stroke.Thickness := Self.Thickness;
- pt1 := FCachedPoints[0];
- for j := 1 to High(FCachedPoints) do
+
+ var dp1 := points[0];
+ var dp2 := dp1;
+ for j := 1 to points.Count - 1 do
begin
- pt2 := FCachedPoints[j];
- transformedPt1.X := ACanvasRect.Left + (pt1.X - ADataRect.Left) * scaleX;
- transformedPt1.Y := ACanvasRect.Bottom - (pt1.Y - ADataRect.Top) * scaleY;
- transformedPt2.X := ACanvasRect.Left + (pt2.X - ADataRect.Left) * scaleX;
- transformedPt2.Y := ACanvasRect.Bottom - (pt2.Y - ADataRect.Top) * scaleY;
+ dp2 := points[j];
+
+ transformedPt1.X := ACanvasRect.Left + (dp1.Time - ADataRect.Left) * scaleX;
+ transformedPt1.Y := ACanvasRect.Bottom - (dp1.Data - ADataRect.Top) * scaleY;
+ transformedPt2.X := ACanvasRect.Left + (dp2.Time - ADataRect.Left) * scaleX;
+ transformedPt2.Y := ACanvasRect.Bottom - (dp2.Data - ADataRect.Top) * scaleY;
+
ACanvas.DrawLine(transformedPt1, transformedPt2, 1);
- pt1 := pt2;
- end;
-end;
-
-procedure TChartAskBidSeries.SetDataSeries(const Value: TDataSeries);
-begin
- inherited SetDataSeries(Value);
- FCacheValid := False;
-end;
-
-function TChartAskBidSeries.DataToPoint(const DataPoint: TDataPoint): TPointD;
-begin
- Result.X := DataPoint.Time;
- case FDataSourceField of
- dsfAsk: Result.Y := DataPoint.Data.Ask;
- dsfBid: Result.Y := DataPoint.Data.Bid;
- else
- Result.Y := 0;
- end;
-end;
-
-procedure TChartAskBidSeries.SetDataSourceField(const Value: TDataSourceField);
-begin
- if (FDataSourceField <> Value) then
- begin
- FDataSourceField := Value;
- FCacheValid := False;
- if Assigned(Collection) then
- Changed(False);
+ dp1 := dp2;
end;
end;
@@ -380,43 +420,102 @@ begin
inherited Create(Collection);
FUpColor := TAlphaColors.Green;
FDownColor := TAlphaColors.Red;
+ FCandleWidth := 0.8;
+ FTimeInterval := TFuture.Construct(1.0);
+end;
+
+procedure TChartOhlcSeries.SetDataSeries(const Value: TFuture>);
+begin
+ FTimeInterval :=
+ Value.Chain(
+ function(const DataSeries: TDataSeries): Double
+ var
+ i: Int64;
+ diff: Double;
+ begin
+ Result := 1.0;
+ if DataSeries.Count < 2 then
+ Exit;
+
+ Result := MaxDouble;
+ for i := 0 to DataSeries.Count - 2 do
+ begin
+ diff := Abs(DataSeries[i].Time - DataSeries[i + 1].Time);
+ if (diff > 1E-9) and (diff < Result) then
+ Result := diff;
+ end;
+
+ if (Result = MaxDouble) then
+ Result := 1.0;
+ end
+ );
+
+ FBounds :=
+ Value.Chain(
+ function(const DataSeries: TDataSeries): TRectD
+ var
+ i: Int64;
+ begin
+ if (DataSeries.Count = 0) then
+ Exit(TRectD.Create(0, 0, 0, 0));
+
+ Result := TRectD.Create(DataSeries[0].Time, DataSeries[0].Data.High, DataSeries[0].Time, DataSeries[0].Data.Low);
+ for i := 0 to DataSeries.Count - 1 do
+ begin
+ Result.ExpandBy(TPointD.Create(DataSeries[i].Time, DataSeries[i].Data.High));
+ Result.ExpandBy(TPointD.Create(DataSeries[i].Time, DataSeries[i].Data.Low));
+ end;
+ end
+ );
+
+ inherited SetDataSeries(Value);
end;
function TChartOhlcSeries.DataToPoint(const DataPoint: TDataPoint): TPointD;
begin
- // Not used for OHLC series drawing, but must be implemented for the abstract parent.
Result.X := DataPoint.Time;
Result.Y := DataPoint.Data.Close;
end;
-procedure TChartOhlcSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
-var
- isFirst: Boolean;
- i: Int64;
- dataPoint: TDataPoint;
+function TChartOhlcSeries.GetBounds: TFuture;
begin
- if (DataSeries.Count = 0) then
- Exit;
- isFirst := (MinPoint.X > MaxPoint.X); // A more robust check for an uninitialized state
- for i := 0 to DataSeries.Count - 1 do
- begin
- dataPoint := DataSeries[i];
- if isFirst then
- begin
- MinPoint.X := dataPoint.Time;
- MaxPoint.X := dataPoint.Time;
- MinPoint.Y := dataPoint.Data.Low;
- MaxPoint.Y := dataPoint.Data.High;
- isFirst := False;
- end
- else
- begin
- MinPoint.X := Min(MinPoint.X, dataPoint.Time);
- MaxPoint.X := Max(MaxPoint.X, dataPoint.Time);
- MinPoint.Y := Min(MinPoint.Y, dataPoint.Data.Low);
- MaxPoint.Y := Max(MaxPoint.Y, dataPoint.Data.High);
- end;
- end;
+ Result := FBounds;
+end;
+
+function TChartOhlcSeries.GetYBoundsForXRange(const XRange: TRangeD): TFuture;
+begin
+ Result :=
+ DataSeries.Chain(
+ function(const Data: TDataSeries): TRangeD
+ var
+ i: Int64;
+ dataPoint: TDataPoint;
+ begin
+ Result.A := Infinity;
+ Result.B := NegInfinity;
+
+ var n := Data.IndexOf(XRange.A);
+
+ if n >= 0 then
+ for i := 1 to Data.Count - 2 do
+ begin
+ dataPoint := Data[i];
+ var t := Double(dataPoint.Time);
+ var t2 := Double(Data[i + 1].Time);
+
+ if ((t >= XRange.A) and (t <= XRange.B)) or ((t2 >= XRange.A) and (t2 <= XRange.B)) then
+ begin
+ Result.A := System.Math.Min(Result.A, dataPoint.Data.Low);
+ Result.B := System.Math.Max(Result.B, dataPoint.Data.High);
+ end;
+ end;
+ if IsInfinite(Result.A) then
+ begin
+ Result.A := 0;
+ Result.B := -1;
+ end;
+ end
+ );
end;
procedure TChartOhlcSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
@@ -424,19 +523,33 @@ var
scaleX, scaleY: Double;
i: Int64;
dataPoint: TDataPoint;
- x_center, candleWidth: Single;
+ x_center, pixelCandleWidth, pixelCandleIntervalWidth: Single;
y_high, y_low, y_open, y_close: Single;
body: TRectF;
+ data: TDataSeries;
+ timeInterval: Double;
begin
- if (DataSeries.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
+ if (not DataSeries.Done.IsSet) or (not FTimeInterval.Done.IsSet) then
+ exit;
+ data := DataSeries.Value;
+ timeInterval := FTimeInterval.Value;
+
+ if (data.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
Exit;
+
scaleX := ACanvasRect.Width / ADataRect.Width;
scaleY := ACanvasRect.Height / ADataRect.Height;
- candleWidth := Max(3.0, (ACanvasRect.Width / DataSeries.Count) * 0.8);
- for i := 0 to DataSeries.Count - 1 do
+ pixelCandleIntervalWidth := timeInterval * scaleX;
+ pixelCandleWidth := System.Math.Max(1.0, FCandleWidth * pixelCandleIntervalWidth);
+
+ for i := data.Count - 1 downto 0 do
begin
- dataPoint := DataSeries[i];
+ dataPoint := data[i];
+
+ if ((dataPoint.Time + timeInterval) < ADataRect.Left) or ((dataPoint.Time - timeInterval) > ADataRect.Right) then
+ continue;
+
x_center := ACanvasRect.Left + (dataPoint.Time - ADataRect.Left) * scaleX;
y_high := ACanvasRect.Bottom - (dataPoint.Data.High - ADataRect.Top) * scaleY;
y_low := ACanvasRect.Bottom - (dataPoint.Data.Low - ADataRect.Top) * scaleY;
@@ -452,7 +565,7 @@ begin
else
ACanvas.Fill.Color := FDownColor;
- body := TRectF.Create(x_center - candleWidth / 2, y_open, x_center + candleWidth / 2, y_close);
+ body := TRectF.Create(x_center - pixelCandleWidth / 2, y_open, x_center + pixelCandleWidth / 2, y_close);
NormalizeRect(body);
ACanvas.FillRect(body, 0, 0, [], 1.0);
end;
@@ -485,7 +598,7 @@ procedure TChartSeriesCollection.Update(Item: TCollectionItem);
begin
inherited;
if Assigned(FOwner) then
- FOwner.Repaint;
+ FOwner.InvalidateDataBounds;
end;
{ TChart }
@@ -497,6 +610,12 @@ begin
FAxisColor := TAlphaColors.Black;
FGridColor := TAlphaColors.Lightgray;
FPadding := 30;
+ FIsPanning := False;
+ FBoundsValid := False;
+ FZoomMode := TChartZoomMode.czmXOnly;
+ // Initialize futures with default empty values
+ FDataBounds := TFuture.Construct(TRectD.Create(0, 0, 0, 0));
+ FDataView := TRectD.Create(0, 0, 0, 0);
end;
destructor TChart.Destroy;
@@ -505,53 +624,248 @@ begin
inherited Destroy;
end;
+procedure TChart.BeforeDestruction;
+begin
+ FYRange.WaitFor;
+ FDataBounds.WaitFor;
+ inherited;
+end;
+
+procedure TChart.InvalidateDataBounds;
+begin
+ if FBoundsValid then
+ InvalidateYRange;
+ FBoundsValid := False;
+
+ Repaint;
+end;
+
+procedure TChart.ResetView;
+begin
+ if not FBoundsValid then
+ RecalcDataBounds;
+
+ // The view is reset to the full data bounds.
+ FDataView := FDataBounds.WaitFor;
+ InvalidateYRange;
+
+ Repaint;
+end;
+
+procedure TChart.DblClick;
+begin
+ inherited;
+ ResetView;
+end;
+
+procedure TChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ if Button = TMouseButton.mbLeft then
+ begin
+ FIsPanning := True;
+ FPanStartPoint := TPointF.Create(X, Y);
+ Cursor := crHandPoint;
+ end;
+end;
+
+procedure TChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ if FIsPanning and (Button = TMouseButton.mbLeft) then
+ begin
+ FIsPanning := False;
+ Cursor := crDefault;
+ end;
+end;
+
+procedure TChart.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ canvasRect: TRectF;
+ currentPoint, delta: TPointF;
+ dataPerPixelX, dataPerPixelY: Double;
+ dataShift: TPointD;
+begin
+ inherited;
+ if not FIsPanning then
+ Exit;
+
+ canvasRect := Self.LocalRect;
+ canvasRect.Inflate(-FPadding, -FPadding);
+
+ if (canvasRect.Width < 1) or (canvasRect.Height < 1) or (FDataView.Width <= 0) or (FDataView.Height <= 0) then
+ Exit;
+
+ currentPoint := TPointF.Create(X, Y);
+ delta := TPointF.Create(currentPoint.X - FPanStartPoint.X, currentPoint.Y - FPanStartPoint.Y);
+
+ if (delta.X = 0) and (delta.Y = 0) then
+ Exit;
+
+ dataPerPixelX := FDataView.Width / canvasRect.Width;
+ dataPerPixelY := FDataView.Height / canvasRect.Height;
+ dataShift.X := delta.X * dataPerPixelX;
+ dataShift.Y := -delta.Y * dataPerPixelY;
+
+ FDataView.Offset(-dataShift.X, -dataShift.Y);
+ FPanStartPoint := currentPoint;
+
+ InvalidateYRange;
+ Repaint;
+end;
+
+procedure TChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+var
+ zoomFactor: Double;
+ canvasRect: TRectF;
+ mouseScreenPos: TPointF;
+ focalPoint: TPointD;
+ newWidth, newHeight: Double;
+ leftRatio, topRatio: Double;
+begin
+ inherited;
+ if WheelDelta = 0 then
+ Exit;
+
+ canvasRect := Self.LocalRect;
+ canvasRect.Inflate(-FPadding, -FPadding);
+ if (canvasRect.Width < 1) or (canvasRect.Height < 1) or (FDataView.Width <= 0) then
+ Exit;
+
+ if WheelDelta > 0 then
+ zoomFactor := 1 / 1.25
+ else
+ zoomFactor := 1.25;
+
+ mouseScreenPos := Self.ScreenToLocal(Screen.MousePos);
+ if not PtInRect(canvasRect, mouseScreenPos) then
+ Exit;
+
+ leftRatio := (mouseScreenPos.X - canvasRect.Left) / canvasRect.Width;
+ focalPoint.X := FDataView.Left + FDataView.Width * leftRatio;
+ newWidth := FDataView.Width * zoomFactor;
+ FDataView.Left := focalPoint.X - newWidth * leftRatio;
+ FDataView.Right := FDataView.Left + newWidth;
+
+ case FZoomMode of
+ czmXY:
+ begin
+ if (FDataView.Height <= 0) then
+ Exit;
+ topRatio := (canvasRect.Bottom - mouseScreenPos.Y) / canvasRect.Height;
+ focalPoint.Y := FDataView.Top + FDataView.Height * topRatio;
+ newHeight := FDataView.Height * zoomFactor;
+ FDataView.Top := focalPoint.Y - newHeight * topRatio;
+ FDataView.Bottom := FDataView.Top + newHeight;
+ end;
+ czmXOnly:
+ begin
+ // The scaling is done, now we chain the auto-scaling for the Y-axis.
+ // We create a new future for the view and then call AutoScaleY.
+ if FYRange.Done.IsSet then
+ if FYRange.Value.A <= FYRange.Value.B then
+ begin
+ FDataView.Top := FYRange.Value.A;
+ FDataView.Bottom := FYRange.Value.B;
+ end;
+ InvalidateYRange;
+ Repaint;
+ Handled := True;
+ Exit; // Exit because AutoScaleY will trigger its own repaint.
+ end;
+ end;
+
+ // For czmXY, we update the view future directly.
+ Repaint;
+ Handled := True;
+end;
+
procedure TChart.Paint;
var
- minPt, maxPt: TPointD;
- dataRect: TRectD;
canvasRect: TRectF;
series: TCollectionItem;
- hasData: Boolean;
begin
inherited;
Canvas.Fill.Color := TAlphaColors.White;
Canvas.FillRect(LocalRect, 1);
- if (FSeries.Count = 0) then
+
+ if not FBoundsValid then
+ begin
+ RecalcDataBounds;
+ ResetView;
+ end;
+
+ if FSeries.Count = 0 then
Exit;
- RecalcDataBounds(minPt, maxPt);
- hasData := (minPt.X < maxPt.X) and (minPt.Y < maxPt.Y);
-
- if not hasData then
+ if (FDataView.Width <= 0) or (FDataView.Height <= 0) then
Exit;
- dataRect := TRectD.Create(minPt, maxPt);
canvasRect := Self.LocalRect;
canvasRect.Inflate(-FPadding, -FPadding);
-
if (canvasRect.Width < 1) or (canvasRect.Height < 1) then
Exit;
- DrawGrid(Canvas, dataRect, canvasRect);
- DrawAxes(Canvas, dataRect, canvasRect);
+ DrawGrid(Canvas, FDataView, canvasRect);
+ DrawAxes(Canvas, FDataView, canvasRect);
for series in FSeries do
begin
- (series as TChartSeries).Draw(Canvas, dataRect, canvasRect);
+ (series as TChartSeries).Draw(Canvas, FDataView, canvasRect);
end;
end;
-procedure TChart.RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
+procedure TChart.RecalcDataBounds;
var
series: TCollectionItem;
+ boundFutures: TList>;
begin
- MinPoint := TPointD.Create(Infinity, Infinity);
- MaxPoint := TPointD.Create(NegInfinity, NegInfinity);
+ boundFutures := TList>.Create;
+ try
+ for series in FSeries do
+ boundFutures.Add((series as TChartSeries).GetBounds);
- for series in FSeries do
- begin
- (series as TChartSeries).GetBounds(MinPoint, MaxPoint);
+ FDataBounds :=
+ TFuture
+ .FromArray(boundFutures.ToArray)
+ .Chain(
+ function(const Rects: TArray): TRectD
+ var
+ minPt, maxPt: TPointD;
+ begin
+ if Length(Rects) = 0 then
+ Exit(TRectD.Create(0, 0, 0, 0));
+
+ minPt := TPointD.Create(Infinity, Infinity);
+ maxPt := TPointD.Create(NegInfinity, NegInfinity);
+
+ for var rect in Rects do
+ begin
+ minPt.X := System.Math.Min(minPt.X, rect.Left);
+ minPt.Y := System.Math.Min(minPt.Y, rect.Top);
+ maxPt.X := System.Math.Max(maxPt.X, rect.Right);
+ maxPt.Y := System.Math.Max(maxPt.Y, rect.Bottom);
+ end;
+
+ if IsInfinite(minPt.X) then
+ Exit(TRectD.Create(0, 0, 0, 0));
+
+ if (minPt.X = maxPt.X) then
+ begin
+ maxPt.X := minPt.X + 1;
+ end;
+ if (minPt.Y = maxPt.Y) then
+ begin
+ maxPt.Y := minPt.Y + 1;
+ minPt.Y := minPt.Y - 1;
+ end;
+ Result := TRectD.Create(minPt.X, minPt.Y, maxPt.X, maxPt.Y);
+ end);
+ finally
+ boundFutures.Free;
end;
+
+ FBoundsValid := True;
end;
procedure TChart.DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
@@ -587,9 +901,53 @@ begin
ACanvas.Stroke.Dash := TStrokeDash.Solid;
end;
+procedure TChart.InvalidateYRange;
+var
+ Arr: TArray>;
+begin
+ SetLength(Arr, FSeries.Count);
+ for var i := 0 to High(Arr) do
+ Arr[i] := (FSeries[i] as TChartSeries).GetYBoundsForXRange(TRangeD.Create(FDataView.Left, FDataView.Right));
+
+ var yBounds := TFuture.FromArray(Arr);
+
+ FYRange :=
+ yBounds.Chain(
+ function(const Ranges: TArray): TRangeD
+ var
+ yRange: Double;
+ begin
+ Result.A := Infinity;
+ Result.B := NegInfinity;
+ for var range in Ranges do
+ if range.A <= range.B then
+ begin
+ Result.A := System.Math.Min(Result.A, range.A);
+ Result.B := System.Math.Max(Result.B, range.B);
+ end;
+
+ if IsInfinite(Result.A) then
+ begin
+ // No data in view, use previous view's Y-range or default
+ Result.A := 0;
+ Result.B := -1;
+ exit;
+ end;
+
+ yRange := Result.B - Result.A;
+ if yRange = 0 then
+ yRange := Abs(Result.A * 0.1);
+
+ Result.A := Result.A - yRange * 0.05;
+ Result.B := Result.B + yRange * 0.05;
+ end
+ );
+end;
+
procedure TChart.SetSeries(const Value: TChartSeriesCollection);
begin
FSeries.Assign(Value);
+ InvalidateDataBounds;
end;
procedure TChart.SetAxisColor(const Value: TAlphaColor);
@@ -619,80 +977,83 @@ begin
end;
end;
-procedure TChart.Repaint;
-begin
- inherited;
-end;
-
{ TTestChartForm }
procedure TTestChartForm.FormCreate(Sender: TObject);
var
- ohlcSeries: TChartOhlcSeries;
- askSeries, bidSeries: TChartAskBidSeries;
- i: Integer;
- ohlcData: TDataSeries;
- askBidData: TDataSeries;
- ohlcDataPoints: array of TDataPoint;
- askBidDataPoints: array of TDataPoint;
- startTime: TDateTime;
- lastClose, o, h, l, c: Double;
- ohlcItem: TOhlcItem;
-const
- NUM_POINTS = 50;
+ askSeries, bidSeries: TChartLineSeries;
+ ohlc: TChartOhlcSeries;
+ askBidSeries: TFuture>;
+ askData, bidData: TFuture>;
begin
FChart := TChart.Create(Self);
FChart.Parent := Self;
FChart.Align := TAlignLayout.Client;
- // 1. Create OHLC Data
- ohlcData := TDataSeries.CreateWriteable(NUM_POINTS);
- askBidData := TDataSeries.CreateWriteable(NUM_POINTS);
- startTime := Now;
- SetLength(ohlcDataPoints, NUM_POINTS);
- SetLength(askBidDataPoints, NUM_POINTS);
+ askBidSeries :=
+ TFuture>.Construct(
+ function: TDataSeries
+ var
+ askBidDataPointList: TArray>;
+ lastPrice: Double;
+ currentTime: TDateTime;
+ i: Integer;
+ const
+ cnt = 200000;
+ begin
+ SetLength(askBidDataPointList, cnt);
+ lastPrice := 100.0;
+ currentTime := Now;
+ for i := 0 to cnt - 1 do
+ begin
+ lastPrice := lastPrice + (Random - 0.495) * 0.1;
+ currentTime := currentTime + TTimeSpan.FromMilliseconds(500 + (Random(500) - 250));
+ askBidDataPointList[i] :=
+ TDataPoint.Create(currentTime, TAskBidItem.Create(lastPrice, lastPrice * 0.9998));
+ end;
+ Result := TDataSeries.CreateDataSeries(cnt, askBidDataPointList);
+ end
+ );
- lastClose := 100;
- for i := 0 to NUM_POINTS - 1 do
- begin
- o := lastClose + (Random - 0.5) * 2;
- h := o + Random * 3;
- l := o - Random * 3;
- c := l + Random * (h - l);
- lastClose := c;
+ askData :=
+ askBidSeries.Chain>(
+ function(const AskBid: TDataSeries): TDataSeries
+ begin
+ Result := AskBid.Convert(function(const Val: TDataPoint): Double begin Result := Val.Data.Ask end);
+ end
+ );
- ohlcItem.Open := o;
- ohlcItem.High := h;
- ohlcItem.Low := l;
- ohlcItem.Close := c;
- ohlcDataPoints[i] := TDataPoint.Create(startTime + i, ohlcItem);
+ bidData :=
+ askBidSeries.Chain>(
+ function(const AskBid: TDataSeries): TDataSeries
+ begin
+ Result := AskBid.Convert(function(const Val: TDataPoint): Double begin Result := Val.Data.Bid end);
+ end
+ );
- // Derive Ask/Bid data from OHLC close price
- askBidDataPoints[i] :=
- TDataPoint.Create(
- startTime + i,
- TAskBidItem.Create(c, c * 0.995) // Ask = Close, Bid = Close - 0.5% spread
- );
- end;
- ohlcData.Add(ohlcDataPoints);
- askBidData.Add(askBidDataPoints);
-
- // 2. Create and add OHLC Series
- ohlcSeries := TChartOhlcSeries.Create(FChart.Series);
- ohlcSeries.DataSeries := ohlcData;
-
- // 3. Create and add Ask/Bid Line Series
- askSeries := TChartAskBidSeries.Create(FChart.Series);
- askSeries.DataSeries := askBidData;
- askSeries.DataSourceField := dsfAsk;
+ askSeries := TChartLineSeries.Create(FChart.Series);
+ askSeries.DataSeries := askData;
askSeries.Color := TAlphaColors.Blue;
- askSeries.Thickness := 2;
+ askSeries.Thickness := 1;
- bidSeries := TChartAskBidSeries.Create(FChart.Series);
- bidSeries.DataSeries := askBidData;
- bidSeries.DataSourceField := dsfBid;
- bidSeries.Color := TAlphaColors.Orange;
- bidSeries.Thickness := 2;
+ bidSeries := TChartLineSeries.Create(FChart.Series);
+ bidSeries.DataSeries := bidData;
+ bidSeries.Color := TAlphaColors.Red;
+ bidSeries.Thickness := 1;
+
+ ohlc := TChartOhlcSeries.Create(FChart.Series);
+ ohlc.DataSeries :=
+ askData.Chain>(
+ function(const Data: TDataSeries): TDataSeries begin Result := Data.ToOhlc(TTimeSpan.FromMinutes(15)); end
+ );
+ ohlc.Color := TAlphaColors.Black;
+ ohlc.Thickness := 1;
+end;
+
+constructor TRangeD.Create(const AA, AB: Double);
+begin
+ A := AA;
+ B := AB;
end;
end.
diff --git a/Src/Myc.Aura.Module.pas b/Src/Myc.Aura.Module.pas
index 0c7935f..7382a20 100644
--- a/Src/Myc.Aura.Module.pas
+++ b/Src/Myc.Aura.Module.pas
@@ -413,21 +413,17 @@ type
private
FName: TWriteable;
function GetName: TWriteable;
- procedure Serialize(const Write: TJsonWriter);
+ procedure Serialize(const Write: TJsonWriter); virtual;
public
constructor Create(const AName: string);
end;
// Generic implementation for a collection of child nodes.
- TMycAuraNode = class(TInterfacedObject, IAuraNode)
+ TMycAuraNode = class(TMycAuraObject, IAuraNode)
private
- FName: TWriteable;
- function GetName: TWriteable;
protected
function GetCaption: string; virtual;
- procedure Serialize(const Write: TJsonWriter);
- public
- constructor Create(const AName: string);
+ procedure Serialize(const Write: TJsonWriter); override;
end;
// Generic implementation for a collection of child nodes.
@@ -502,23 +498,11 @@ end;
{ TMycAuraNode }
-constructor TMycAuraNode.Create(const AName: string);
-begin
- inherited Create;
- FName := TWriteable.CreateWriteable;
- FName.Value := AName;
-end;
-
function TMycAuraNode.GetCaption: string;
begin
Result := FName.Value;
end;
-function TMycAuraNode.GetName: TWriteable;
-begin
- Result := FName;
-end;
-
procedure TMycAuraNode.Serialize(const Write: TJsonWriter);
begin
Write.WriteStartObject;
diff --git a/Src/Myc.Core.Futures.pas b/Src/Myc.Core.Futures.pas
index 143c77e..f059085 100644
--- a/Src/Myc.Core.Futures.pas
+++ b/Src/Myc.Core.Futures.pas
@@ -18,9 +18,13 @@ type
end;
TMycNullFuture = class(TMycFuture)
+ private
+ FValue: T;
protected
function GetValue: T; override;
function GetDone: TState; override;
+ public
+ constructor Create(const AValue: T);
end;
TMycGateFuncFuture = class(TMycFuture)
@@ -56,6 +60,12 @@ begin
Assert(GetDone.IsSet, 'Trying to destroy an unfinished future');
end;
+constructor TMycNullFuture.Create(const AValue: T);
+begin
+ inherited Create;
+ FValue := AValue;
+end;
+
{ TMycNullFuture }
function TMycNullFuture.GetDone: TState;
@@ -65,7 +75,7 @@ end;
function TMycNullFuture.GetValue: T;
begin
- Result := Default(T);
+ Result := FValue;
end;
{ TMycGateFuncFuture }
diff --git a/Src/Myc.Futures.pas b/Src/Myc.Futures.pas
index b86f3b4..ab1f736 100644
--- a/Src/Myc.Futures.pas
+++ b/Src/Myc.Futures.pas
@@ -45,6 +45,7 @@ type
class function Construct(const Proc: TFunc): TFuture; overload; static;
class function Construct(const Gate: TState; const Proc: TFunc): TFuture; overload; static;
+ class function Construct(const ConstVal: T): TFuture; overload; static;
class property Null: IFuture read FNull;
@@ -55,10 +56,17 @@ type
function Chain(const Proc: TProcConst): TState; overload;
function WaitFor: T;
+ class function WhenAll(const Futures: TArray; const Func: TFuncConst, S>): TFuture; static; experimental;
+
property Done: TState.IState read GetDone;
property Value: T read GetValue;
end;
+ TFuture = record
+ public
+ class function FromArray(const Arr: TArray>): TFuture>; static;
+ end;
+
IObjectRef = interface
function GetObj: T;
function Pop: T;
@@ -89,7 +97,7 @@ end;
class constructor TFuture.CreateClass;
begin
- FNull := TMycNullFuture.Create;
+ FNull := TMycNullFuture.Create(Default(T));
end;
function TFuture.Chain(const Proc: TProcConst): TState;
@@ -121,6 +129,11 @@ begin
Result := TMycGateFuncFuture.Create(TaskManager, Gate, Proc);
end;
+class function TFuture.Construct(const ConstVal: T): TFuture;
+begin
+ Result := TMycNullFuture.Create(ConstVal);
+end;
+
function TFuture.GetDone: TState.IState;
begin
Result := FFuture.Done;
@@ -143,6 +156,29 @@ begin
Result := FFuture.Value;
end;
+class function TFuture.WhenAll(const Futures: TArray; const Func: TFuncConst, S>): TFuture;
+var
+ DoneStates: TArray;
+begin
+ SetLength(DoneStates, Length(Futures));
+ for var i := 0 to High(DoneStates) do
+ DoneStates[i] := Futures[i].Done;
+ var cFutures := Futures;
+ Result :=
+ TFuture.Construct(
+ TState.All(DoneStates),
+ function: S
+ var
+ Vals: TArray;
+ begin
+ SetLength(Vals, Length(cFutures));
+ for var i := 0 to High(Vals) do
+ Vals[i] := Futures[i].Value;
+ Result := Func(Vals);
+ end
+ );
+end;
+
class operator TFuture.Implicit(const A: IFuture): TFuture;
begin
Result.Create(A);
@@ -181,4 +217,25 @@ begin
FreeAndNil(FObj);
end;
+class function TFuture.FromArray(const Arr: TArray>): TFuture>;
+var
+ DoneStates: TArray;
+begin
+ var cFutures := Arr;
+ SetLength(DoneStates, Length(cFutures));
+ for var i := 0 to High(DoneStates) do
+ DoneStates[i] := cFutures[i].Done;
+
+ Result :=
+ TFuture>.Construct(
+ TState.All(DoneStates),
+ function: TArray
+ begin
+ SetLength(Result, Length(cFutures));
+ for var i := 0 to High(Result) do
+ Result[i] := cFutures[i].Value;
+ end
+ );
+end;
+
end.
diff --git a/Src/Myc.Test.Trade.DataPoint.pas b/Src/Myc.Test.Trade.DataPoint.pas
index 6dc76c8..a4a94f4 100644
--- a/Src/Myc.Test.Trade.DataPoint.pas
+++ b/Src/Myc.Test.Trade.DataPoint.pas
@@ -9,12 +9,11 @@ uses
Myc.Trade.DataPoint;
type
-
[TestFixture]
- TTestDataArray = class(TObject)
+ TTestDataSeries = class(TObject)
private
- FArray: TDataSeries;
- procedure SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 0);
+ FSeries: TDataSeries;
+ procedure SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 10);
public
[Setup]
procedure Setup;
@@ -32,15 +31,6 @@ type
[Test]
procedure TestGetItemsIndexing;
- // Tests for MaxLookback
- [Test]
- procedure TestCountIsCappedByMaxLookback_NoTrim;
- [Test]
- procedure TestCountIsCappedByMaxLookback_WithTrim;
- [Test]
- [IgnoreMemoryLeaks]
- procedure TestLoopIsSafeWithMaxLookback;
-
// Tests for bulk Add
[Test]
procedure TestBulkAddIncreasesCount;
@@ -61,19 +51,7 @@ type
[Test]
procedure TestTotalCountIgnoresTrimming;
[Test]
- procedure TestTotalCountResetsOnClear;
- end;
-
- [TestFixture]
- TTestDataSeries = class(TObject)
- private
- FSeries: TDataSeries;
- procedure SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 0);
- public
- [Setup]
- procedure Setup;
- [Teardown]
- procedure Teardown;
+ procedure TestTotalCountResetsOnRecreate;
// Tests for IndexOf
[Test]
@@ -94,48 +72,65 @@ type
procedure TestIndexOfSingleItemSeries;
[Test]
procedure TestIndexOfRespectsMaxLookback;
+ [Test]
+ procedure TestIndexOfWithTrimmedData;
- // Tests for Copy
+ // Tests for Copy (Immutability)
[Test]
procedure TestCopyHasSameContent;
[Test]
procedure TestCopyIsImmutableAfterOriginalChanges;
[Test]
procedure TestCopyRespectsMaxLookback;
+
+ // Tests for Lookback
+ [Test]
+ procedure TestCountIsCappedByMaxLookback_NoTrim;
+ [Test]
+ procedure TestCountIsCappedByMaxLookback_WithTrim;
+ [Test]
+ [IgnoreMemoryLeaks]
+ procedure TestLoopIsSafeWithMaxLookback;
+ [Test]
+ procedure TestDataAndTimePropertiesRespectLookback;
+ [Test]
+ procedure TestLookbackZero;
+ [Test]
+ procedure TestLookbackOne;
end;
implementation
-{ TTestDataArray }
+{ TTestDataSeries }
-procedure TTestDataArray.Setup;
+procedure TTestDataSeries.Setup;
begin
- FArray := TDataSeries.CreateWriteable(0);
+ FSeries := TDataSeries.CreateDataSeries(1);
end;
-procedure TTestDataArray.Teardown;
+procedure TTestDataSeries.Teardown;
begin
- FArray := nil;
+ FSeries := Default(TDataSeries);
end;
-procedure TTestDataArray.SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 0);
+procedure TTestDataSeries.SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 10);
var
i: Integer;
DataPoint: TDataPoint;
baseTime: TDateTime;
begin
- FArray := TDataSeries.CreateWriteable(MaxLookBack);
+ FSeries := TDataSeries.CreateDataSeries(MaxLookBack);
baseTime := EncodeDate(2020, 7, 7);
// Add data points with increasing timestamps.
for i := 0 to ItemCount - 1 do
begin
DataPoint := TDataPoint.Create(baseTime + i, TAskBidItem.Create(i * 1.0, i * 1.0 + 0.1));
- FArray.Add(DataPoint);
+ FSeries := FSeries.Add([DataPoint], 0, 1);
end;
end;
-procedure TTestDataArray.TestSetupSeriesWithDataVerification;
+procedure TTestDataSeries.TestSetupSeriesWithDataVerification;
var
i: Integer;
baseTime, expectedTime: TDateTime;
@@ -144,38 +139,39 @@ begin
SetupSeriesWithData;
baseTime := EncodeDate(2020, 7, 7);
- Assert.AreEqual(Int64(10), FArray.Count, 'Setup should create exactly 10 items');
+ Assert.AreEqual(Int64(10), FSeries.Count, 'Setup should create exactly 10 items');
// Check all items to ensure correct reverse chronological order.
- for i := 0 to FArray.Count - 1 do
+ for i := 0 to FSeries.Count - 1 do
begin
expectedTime := baseTime + (9 - i);
expectedAsk := Single(9 - i);
- Assert.AreEqual(expectedTime, FArray[i].Time, 'Item at logical index should have correct reversed timestamp');
- Assert.AreEqual(expectedAsk, FArray[i].Data.Ask, 'Item at logical index should have correct reversed data');
+ Assert.AreEqual(expectedTime, FSeries[i].Time, 'Item at logical index should have correct reversed timestamp');
+ Assert.AreEqual(expectedAsk, FSeries[i].Data.Ask, 'Item at logical index should have correct reversed data');
end;
end;
-procedure TTestDataArray.TestAddAndCount;
+procedure TTestDataSeries.TestAddAndCount;
var
DataPoint: TDataPoint;
newTime: TDateTime;
begin
- SetupSeriesWithData;
+ SetupSeriesWithData(10, 11);
newTime := EncodeDate(2020, 7, 17);
- Assert.AreEqual(Int64(10), FArray.Count, 'Initial count should be 10');
+ Assert.AreEqual(Int64(10), FSeries.Count, 'Initial count should be 10');
DataPoint := TDataPoint.Create(newTime, TAskBidItem.Create(100.0, 100.1));
- FArray.Add(DataPoint);
+ FSeries := FSeries.Add([DataPoint], 0, 1);
- Assert.AreEqual(Int64(11), FArray.Count, 'Count should be 11 after adding one more');
- Assert.AreEqual(newTime, FArray.Items[0].Time, 'Newest item should be at index 0');
+ Assert.AreEqual(Int64(11), FSeries.Count, 'Count should be 11 after adding one more');
+ Assert.AreEqual(newTime, FSeries.Items[0].Time, 'Newest item should be at index 0');
end;
-procedure TTestDataArray.TestAddOrderAssertion;
+procedure TTestDataSeries.TestAddOrderAssertion;
var
olderTime: TDateTime;
+ DataPoint: TDataPoint;
begin
SetupSeriesWithData; // Newest item is at 2020-07-16
olderTime := EncodeDate(2020, 7, 15);
@@ -183,15 +179,15 @@ begin
Assert.WillRaise(
procedure
begin
- var DataPoint := TDataPoint.Create(olderTime, TAskBidItem.Create(0.0, 0.0));
- FArray.Add(DataPoint);
+ DataPoint := TDataPoint.Create(olderTime, TAskBidItem.Create(0.0, 0.0));
+ FSeries.Add([DataPoint], 0, 1);
end,
EAssertionFailed,
'Adding item with older timestamp should raise an assert error'
);
end;
-procedure TTestDataArray.TestGetItemsIndexing;
+procedure TTestDataSeries.TestGetItemsIndexing;
var
i: Integer;
expectedTime: TDateTime;
@@ -203,68 +199,22 @@ begin
for i := 0 to 9 do
begin
expectedTime := baseTime + (9 - i);
- Assert.AreEqual(expectedTime, FArray.Items[i].Time, 'Item at logical index should have reversed chronological time');
- Assert.AreEqual(Single(9 - i), FArray.Items[i].Data.Ask, 'Item data at logical index should match reversed insertion order');
+ Assert.AreEqual(expectedTime, FSeries.Items[i].Time, 'Item at logical index should have reversed chronological time');
+ Assert.AreEqual(Single(9 - i), FSeries.Items[i].Data.Ask, 'Item data at logical index should match reversed insertion order');
end;
end;
-procedure TTestDataArray.TestCountIsCappedByMaxLookback_NoTrim;
-begin
- SetupSeriesWithData(500, 400); // Less than one chunk
+//--------------------------------------------------------------------------------------------------
+// Tests for bulk Add
+//--------------------------------------------------------------------------------------------------
- // The public Count must now be the MaxLookback value, even though
- // no chunk was freed and FCount is still 500 internally.
- Assert.AreEqual(Int64(400), FArray.Count, 'Public count should be capped by MaxLookback even if no chunk is freed');
-end;
-
-procedure TTestDataArray.TestCountIsCappedByMaxLookback_WithTrim;
-const
- ITEMS_TO_ADD = 2000;
- LOOKBACK_LIMIT = 900;
-begin
- SetupSeriesWithData(ITEMS_TO_ADD, LOOKBACK_LIMIT);
-
- // Internally, FCount will be 976 after one chunk is freed.
- // The public Count should still be capped at the lookback limit.
- Assert.AreEqual(Int64(LOOKBACK_LIMIT), FArray.Count, 'Public count should be capped by MaxLookback after trimming');
-end;
-
-procedure TTestDataArray.TestLoopIsSafeWithMaxLookback;
-var
- dummy: TDataPoint;
-begin
- SetupSeriesWithData(500, 400);
- Assert.AreEqual(Int64(400), FArray.Count, 'Pre-condition: Count must be capped at 400');
-
- // This test proves that a standard loop based on the public Count is safe
- // and will not access an invalid index.
- Assert.WillNotRaise(
- procedure
- begin
- for var i := 0 to FArray.Count - 1 do
- begin
- dummy := FArray[i];
- end;
- end,
- nil,
- 'Looping up to the public Count should not raise an exception'
- );
-
- // Also test the assert when going one item beyond the public count
- Assert.WillRaise(
- procedure begin dummy := FArray[400]; end,
- EAssertionFailed,
- 'Accessing index at the limit of MaxLookback should raise an exception'
- );
-end;
-
-procedure TTestDataArray.TestBulkAddIncreasesCount;
+procedure TTestDataSeries.TestBulkAddIncreasesCount;
var
newData: TArray>;
baseTime, newTime: TDateTime;
i: Integer;
begin
- SetupSeriesWithData(10);
+ SetupSeriesWithData(10, 15);
baseTime := EncodeDate(2020, 7, 7);
SetLength(newData, 5);
@@ -274,13 +224,13 @@ begin
newData[i] := TDataPoint.Create(newTime, TAskBidItem.Create(i, i));
end;
- FArray.Add(newData);
+ FSeries := FSeries.Add(newData, 0, Length(newData));
- Assert.AreEqual(Int64(15), FArray.Count, 'Count should be increased by the number of items in the bulk add');
- Assert.AreEqual(baseTime + 10 + High(newData), FArray[0].Time, 'Newest item should be the last item from the added array');
+ Assert.AreEqual(Int64(15), FSeries.Count, 'Count should be increased by the number of items in the bulk add');
+ Assert.AreEqual(baseTime + 10 + High(newData), FSeries[0].Time, 'Newest item should be the last item from the added array');
end;
-procedure TTestDataArray.TestBulkAddChronologicalAssertion_Internal;
+procedure TTestDataSeries.TestBulkAddChronologicalAssertion_Internal;
var
newData: TArray>;
begin
@@ -290,13 +240,13 @@ begin
newData[1] := TDataPoint.Create(Now, TAskBidItem.Create(2, 2)); // Not sorted
Assert.WillRaise(
- procedure begin FArray.Add(newData); end,
+ procedure begin FSeries.Add(newData, 0, Length(newData)); end,
EAssertionFailed,
'Bulk Add should fail if the input array is not chronologically sorted'
);
end;
-procedure TTestDataArray.TestBulkAddChronologicalAssertion_External;
+procedure TTestDataSeries.TestBulkAddChronologicalAssertion_External;
var
newData: TArray>;
olderTime: TDateTime;
@@ -308,13 +258,13 @@ begin
newData[0] := TDataPoint.Create(olderTime, TAskBidItem.Create(1, 1));
Assert.WillRaise(
- procedure begin FArray.Add(newData); end,
+ procedure begin FSeries.Add(newData, 0, Length(newData)); end,
EAssertionFailed,
'Bulk Add should fail if its first item is older than the series last item'
);
end;
-procedure TTestDataArray.TestBulkAddSpanningMultipleChunks;
+procedure TTestDataSeries.TestBulkAddSpanningMultipleChunks;
const
CHUNK_SIZE = 1024;
var
@@ -322,8 +272,8 @@ var
lastTimeBeforeAdd, firstNewTime, lastNewTime: TDateTime;
i: Integer;
begin
- SetupSeriesWithData(CHUNK_SIZE - 4); // Almost fill the first chunk
- lastTimeBeforeAdd := FArray[0].Time;
+ SetupSeriesWithData(CHUNK_SIZE - 4, CHUNK_SIZE + 8); // Almost fill the first chunk
+ lastTimeBeforeAdd := FSeries[0].Time;
SetLength(newData, 8); // Add 8 items, which will span the chunk boundary
for i := 0 to High(newData) do
@@ -334,20 +284,20 @@ begin
firstNewTime := newData[0].Time;
lastNewTime := newData[High(newData)].Time;
- FArray.Add(newData);
- Assert.AreEqual(Int64(CHUNK_SIZE + 4), FArray.Count, 'Count should be correct after spanning a chunk');
- Assert.AreEqual(lastNewTime, FArray[0].Time, 'Newest item should be correct');
- Assert.AreEqual(firstNewTime, FArray[7].Time, 'Oldest of the new items should be at the correct logical index');
+ FSeries := FSeries.Add(newData, 0, Length(newData));
+ Assert.AreEqual(Int64(CHUNK_SIZE + 4), FSeries.Count, 'Count should be correct after spanning a chunk');
+ Assert.AreEqual(lastNewTime, FSeries[0].Time, 'Newest item should be correct');
+ Assert.AreEqual(firstNewTime, FSeries[7].Time, 'Oldest of the new items should be at the correct logical index');
end;
-procedure TTestDataArray.TestBulkAddWithMaxLookback;
+procedure TTestDataSeries.TestBulkAddWithMaxLookback;
var
newData: TArray>;
i: Integer;
baseTime: TDateTime;
begin
SetupSeriesWithData(400, 500);
- baseTime := FArray[0].Time;
+ baseTime := FSeries[0].Time;
SetLength(newData, 200);
for i := 0 to High(newData) do
@@ -355,157 +305,65 @@ begin
newData[i] := TDataPoint.Create(baseTime + 1 + i, TAskBidItem.Create(i, i));
end;
- FArray.Add(newData);
+ FSeries := FSeries.Add(newData, 0, Length(newData));
// Total items would be 600, but MaxLookback is 500.
- // Trim does not free chunks (100 to remove < 1024).
// The public Count must be capped at 500.
- Assert.AreEqual(Int64(500), FArray.Count, 'Count should be capped by MaxLookback after bulk add');
+ Assert.AreEqual(Int64(500), FSeries.Count, 'Count should be capped by MaxLookback after bulk add');
end;
-procedure TTestDataArray.TestTotalCountIncrementsCorrectly;
+//--------------------------------------------------------------------------------------------------
+// Tests for TotalCount
+//--------------------------------------------------------------------------------------------------
+
+procedure TTestDataSeries.TestTotalCountIncrementsCorrectly;
var
newData: TArray>;
i: Integer;
+ DataPoint: TDataPoint;
begin
- Assert.AreEqual(Int64(0), FArray.TotalCount, 'TotalCount should be 0 on creation');
+ Assert.AreEqual(Int64(0), FSeries.TotalCount, 'TotalCount should be 0 on creation');
// Test single add
- FArray.Add(TDataPoint.Create(Now, TAskBidItem.Create(1, 1)));
- Assert.AreEqual(Int64(1), FArray.TotalCount, 'TotalCount should be 1 after single add');
+ DataPoint := TDataPoint.Create(Now, TAskBidItem.Create(1, 1));
+ FSeries := FSeries.Add([DataPoint], 0, 1);
+ Assert.AreEqual(Int64(1), FSeries.TotalCount, 'TotalCount should be 1 after single add');
// Test bulk add
SetLength(newData, 10);
for i := 0 to High(newData) do
newData[i] := TDataPoint.Create(Now + 1 + i, TAskBidItem.Create(i, i));
- FArray.Add(newData);
- Assert.AreEqual(Int64(11), FArray.TotalCount, 'TotalCount should be 11 after bulk add');
+ FSeries := FSeries.Add(newData, 0, Length(newData));
+ Assert.AreEqual(Int64(11), FSeries.TotalCount, 'TotalCount should be 11 after bulk add');
end;
-procedure TTestDataArray.TestTotalCountIgnoresTrimming;
+procedure TTestDataSeries.TestTotalCountIgnoresTrimming;
begin
// Create series with a lookback that will cause trimming
SetupSeriesWithData(20, 10);
// The visible count is capped by MaxLookback
- Assert.AreEqual(Int64(10), FArray.Count, 'Count should be capped by MaxLookback');
+ Assert.AreEqual(Int64(10), FSeries.Count, 'Count should be capped by MaxLookback');
// The total count should reflect all items that were ever added
- Assert.AreEqual(Int64(20), FArray.TotalCount, 'TotalCount must not be affected by trimming');
+ Assert.AreEqual(Int64(20), FSeries.TotalCount, 'TotalCount must not be affected by trimming');
end;
-procedure TTestDataArray.TestTotalCountResetsOnClear;
+procedure TTestDataSeries.TestTotalCountResetsOnRecreate;
begin
SetupSeriesWithData(15);
- Assert.IsTrue(FArray.TotalCount > 0, 'Pre-condition: TotalCount should be greater than 0');
+ Assert.IsTrue(FSeries.TotalCount > 0, 'Pre-condition: TotalCount should be greater than 0');
- FArray.Clear;
+ // Re-create the series to clear it
+ FSeries := TDataSeries.CreateDataSeries(0);
- Assert.AreEqual(Int64(0), FArray.TotalCount, 'TotalCount should be 0 after Clear');
- Assert.AreEqual(Int64(0), FArray.Count, 'Count should be 0 after Clear');
+ Assert.AreEqual(Int64(0), FSeries.TotalCount, 'TotalCount should be 0 after re-creation');
+ Assert.AreEqual(Int64(0), FSeries.Count, 'Count should be 0 after re-creation');
end;
-{ TTestDataSeries }
-
-procedure TTestDataSeries.Setup;
-begin
- FSeries := TDataSeries.CreateWriteable(0);
-end;
-
-procedure TTestDataSeries.Teardown;
-begin
- FSeries := Default(TDataSeries);
-end;
-
-procedure TTestDataSeries.SetupSeriesWithData(ItemCount: Integer = 10; MaxLookBack: Int64 = 0);
-var
- i: Integer;
- DataPoint: TDataPoint;
- baseTime: TDateTime;
-begin
- FSeries := TDataSeries.CreateWriteable(MaxLookBack);
- baseTime := EncodeDate(2020, 7, 7);
-
- // Add data points with increasing timestamps.
- for i := 0 to ItemCount - 1 do
- begin
- DataPoint := TDataPoint.Create(baseTime + i, TAskBidItem.Create(i * 1.0, i * 1.0 + 0.1));
- FSeries.Add(DataPoint);
- end;
-end;
-
-procedure TTestDataSeries.TestCopyHasSameContent;
-var
- copy: TDataSeries;
- i: Integer;
-begin
- SetupSeriesWithData(15);
-
- copy := FSeries.Immutable;
-
- Assert.AreEqual(FSeries.Count, copy.Count, 'Copy must have the same count as the original');
- Assert.AreEqual(FSeries.TotalCount, copy.TotalCount, 'Copy must have the same total count as the original');
-
- for i := 0 to FSeries.Count - 1 do
- begin
- Assert.AreEqual(FSeries[i].Time, copy[i].Time, 'Copied item timestamp must match original');
- Assert.AreEqual(FSeries[i].Data.Ask, copy[i].Data.Ask, 'Copied item data must match original');
- end;
-end;
-
-procedure TTestDataSeries.TestCopyIsImmutableAfterOriginalChanges;
-var
- copy: TDataSeries;
- originalCount, originalTotalCount: Int64;
- newPoint: TDataPoint;
- lastTime: TDateTime;
-begin
- SetupSeriesWithData(10);
-
- // Create the copy
- copy := FSeries.Immutable;
- originalCount := copy.Count;
- originalTotalCount := copy.TotalCount;
-
- // Modify the original series
- lastTime := FSeries[0].Time;
- newPoint := TDataPoint.Create(lastTime + 1, TAskBidItem.Create(99, 99.1));
- FSeries.Add(newPoint);
-
- Assert.AreEqual(Int64(11), FSeries.Count, 'Original array count should have increased');
-
- // Verify the copy remains unchanged
- Assert.AreEqual(originalCount, copy.Count, 'Copy count must not change after original is modified');
- Assert.AreEqual(originalTotalCount, copy.TotalCount, 'Copy total count must not change after original is modified');
- Assert.AreNotEqual(FSeries[0].Time, copy[0].Time, 'Newest item in copy should not be the new item from original');
-end;
-
-procedure TTestDataSeries.TestCopyRespectsMaxLookback;
-var
- copy: TDataSeries;
- newPoint: TDataPoint;
- lastTime: TDateTime;
-begin
- SetupSeriesWithData(20, 15); // 20 items total, but series count is capped at 15
-
- Assert.AreEqual(Int64(15), FSeries.Count, 'Pre-condition: Series count should be capped by MaxLookback');
- Assert.AreEqual(Int64(20), FSeries.TotalCount, 'Pre-condition: Series total count should be 20');
-
- copy := FSeries.Immutable;
-
- // Verify the copy reflects the MaxLookback state
- Assert.AreEqual(Int64(15), copy.Count, 'Copy count should be the MaxLookback value of the original');
- Assert.AreEqual(Int64(20), copy.TotalCount, 'Copy total count should be the total items added to the original');
-
- // Modify original
- lastTime := FSeries[0].Time;
- newPoint := TDataPoint.Create(lastTime + 1, TAskBidItem.Create(99, 99.1));
- FSeries.Add(newPoint);
-
- // Verify the copy is still unchanged
- Assert.AreEqual(Int64(15), copy.Count, 'Copy count must remain unchanged after original is modified');
- Assert.AreEqual(Int64(20), copy.TotalCount, 'Copy total count must remain unchanged after original is modified');
-end;
+//--------------------------------------------------------------------------------------------------
+// Tests for IndexOf
+//--------------------------------------------------------------------------------------------------
procedure TTestDataSeries.TestIndexOfExistingTimeStamp;
var
@@ -513,14 +371,10 @@ var
expectedIndex: Int64;
begin
SetupSeriesWithData;
- ATimeStamp := EncodeDate(2020, 7, 7); // Oldest item
- expectedIndex := 9;
+ ATimeStamp := EncodeDate(2020, 7, 7) + 9; // Newest item
+ expectedIndex := 0;
- Assert.AreEqual(
- expectedIndex,
- FSeries.IndexOf(ATimeStamp),
- 'IndexOf for the oldest existing item timestamp should return its correct index'
- );
+ Assert.AreEqual(expectedIndex, FSeries.IndexOf(ATimeStamp), 'IndexOf for the newest existing item timestamp should return 0');
end;
procedure TTestDataSeries.TestIndexOfNonExistingBetween;
@@ -529,8 +383,11 @@ var
expectedIndex: Int64;
begin
SetupSeriesWithData;
- ATimeStamp := EncodeDate(2020, 7, 7) + 0.5; // 12:00 on the day of the oldest item
- expectedIndex := Int64(9); // Should find the item from 00:00
+ // Time is between item 8 (2020-07-15) and 9 (2020-07-16)
+ ATimeStamp := EncodeDate(2020, 7, 15) + 0.5;
+ // Should return the index of the preceding item, which is the one at 2020-07-15.
+ // Its logical index is 1 (0 is newest at 2020-07-16)
+ expectedIndex := Int64(1);
Assert.AreEqual(
expectedIndex,
@@ -602,7 +459,7 @@ begin
// Use default setup, but add one item
testTime := EncodeDate(2025, 1, 1);
DataPoint := TDataPoint.Create(testTime, TAskBidItem.Create(1.0, 2.0));
- FSeries.Add(DataPoint);
+ FSeries := FSeries.Add([DataPoint], 0, 1);
Assert.AreEqual(Int64(1), FSeries.Count);
Assert.AreEqual(Int64(0), FSeries.IndexOf(testTime), 'IndexOf for exact single item should be 0');
@@ -620,19 +477,282 @@ begin
Assert.AreEqual(Int64(400), FSeries.Count, 'Pre-condition: Count must be 400');
// The oldest *physically present* item has a timestamp of baseTime+0.
- // This item is at logical index 499, which is outside the MaxLookback range.
+ // This item is outside the MaxLookback range.
// IndexOf must not find it.
searchTime := baseTime; // Time of oldest physical item.
Assert.AreEqual(Int64(-1), FSeries.IndexOf(searchTime), 'IndexOf should not find items outside the MaxLookback range');
// The oldest *logically valid* item is at index 399.
- // Its physical index is 500 - 399 - 1 = 100.
+ // This item corresponds to the 100th item added (i=100), since 500-400=100 items are trimmed from the start.
// Its timestamp is baseTime + 100.
searchTime := baseTime + 100;
Assert.AreEqual(Int64(399), FSeries.IndexOf(searchTime), 'IndexOf should find the oldest valid item at the edge of MaxLookback');
end;
+procedure TTestDataSeries.TestIndexOfWithTrimmedData;
+var
+ baseTime, searchTime: TDateTime;
+begin
+ SetupSeriesWithData(500, 400); // Oldest visible item has time baseTime+100
+ baseTime := EncodeDate(2020, 7, 7);
+
+ // Search for an exact timestamp that was trimmed
+ searchTime := baseTime + 50; // Added, but now outside the lookback window
+ Assert.AreEqual(Int64(-1), FSeries.IndexOf(searchTime), 'IndexOf should not find an exact timestamp that has been trimmed');
+
+ // Search for a non-exact timestamp in the trimmed range
+ searchTime := baseTime + 99.5; // This would resolve to item 99, which is trimmed.
+ Assert.AreEqual(Int64(-1), FSeries.IndexOf(searchTime), 'IndexOf should return -1 when the preceding item is trimmed');
+
+ // Search for a non-exact timestamp that should resolve to the oldest visible item
+ searchTime := baseTime + 100.5; // This should resolve to item 100 (logical index 399)
+ Assert.AreEqual(
+ Int64(399),
+ FSeries.IndexOf(searchTime),
+ 'IndexOf should find the oldest visible item when searching just after its timestamp'
+ );
+end;
+
+//--------------------------------------------------------------------------------------------------
+// Tests for Copy (Immutability)
+//--------------------------------------------------------------------------------------------------
+
+procedure TTestDataSeries.TestCopyHasSameContent;
+var
+ copy: TDataSeries;
+ i: Integer;
+begin
+ SetupSeriesWithData(15);
+
+ copy := FSeries;
+
+ Assert.AreEqual(FSeries.Count, copy.Count, 'Copy must have the same count as the original');
+ Assert.AreEqual(FSeries.TotalCount, copy.TotalCount, 'Copy must have the same total count as the original');
+
+ for i := 0 to FSeries.Count - 1 do
+ begin
+ Assert.AreEqual(FSeries[i].Time, copy[i].Time, 'Copied item timestamp must match original');
+ Assert.AreEqual(FSeries[i].Data.Ask, copy[i].Data.Ask, 'Copied item data must match original');
+ end;
+end;
+
+procedure TTestDataSeries.TestCopyIsImmutableAfterOriginalChanges;
+var
+ copy: TDataSeries;
+ originalCount, originalTotalCount: Int64;
+ newPoint: TDataPoint;
+ lastTime: TDateTime;
+begin
+ SetupSeriesWithData(10, 11);
+
+ // Create the copy
+ copy := FSeries;
+ originalCount := copy.Count;
+ originalTotalCount := copy.TotalCount;
+
+ // Modify the original series by creating a new one
+ lastTime := FSeries[0].Time;
+ newPoint := TDataPoint.Create(lastTime + 1, TAskBidItem.Create(99, 99.1));
+ FSeries := FSeries.Add([newPoint], 0, 1);
+
+ Assert.AreEqual(Int64(11), FSeries.Count, 'Original series count should have increased');
+
+ // Verify the copy remains unchanged
+ Assert.AreEqual(originalCount, copy.Count, 'Copy count must not change after original is modified');
+ Assert.AreEqual(originalTotalCount, copy.TotalCount, 'Copy total count must not change after original is modified');
+ Assert.AreNotEqual(FSeries[0].Time, copy[0].Time, 'Newest item in copy should not be the new item from original');
+end;
+
+procedure TTestDataSeries.TestCopyRespectsMaxLookback;
+var
+ copy: TDataSeries;
+ newPoint: TDataPoint;
+ lastTime: TDateTime;
+begin
+ SetupSeriesWithData(20, 15); // 20 items total, but series count is capped at 15
+
+ Assert.AreEqual(Int64(15), FSeries.Count, 'Pre-condition: Series count should be capped by MaxLookback');
+ Assert.AreEqual(Int64(20), FSeries.TotalCount, 'Pre-condition: Series total count should be 20');
+
+ copy := FSeries;
+
+ // Verify the copy reflects the MaxLookback state
+ Assert.AreEqual(Int64(15), copy.Count, 'Copy count should be the MaxLookback value of the original');
+ Assert.AreEqual(Int64(20), copy.TotalCount, 'Copy total count should be the total items added to the original');
+
+ // Modify original
+ lastTime := FSeries[0].Time;
+ newPoint := TDataPoint.Create(lastTime + 1, TAskBidItem.Create(99, 99.1));
+ FSeries := FSeries.Add([newPoint], 0, 1);
+
+ // Verify the copy is still unchanged
+ Assert.AreEqual(Int64(15), copy.Count, 'Copy count must remain unchanged after original is modified');
+ Assert.AreEqual(Int64(20), copy.TotalCount, 'Copy total count must remain unchanged after original is modified');
+end;
+
+//--------------------------------------------------------------------------------------------------
+// Tests for Lookback
+//--------------------------------------------------------------------------------------------------
+
+procedure TTestDataSeries.TestCountIsCappedByMaxLookback_NoTrim;
+begin
+ SetupSeriesWithData(500, 400); // Less than one chunk
+
+ // The public Count must now be the MaxLookback value, even though
+ // no chunk was freed and FCount is still 500 internally.
+ Assert.AreEqual(Int64(400), FSeries.Count, 'Public count should be capped by MaxLookback even if no chunk is freed');
+end;
+
+procedure TTestDataSeries.TestCountIsCappedByMaxLookback_WithTrim;
+const
+ ITEMS_TO_ADD = 2000;
+ LOOKBACK_LIMIT = 900;
+begin
+ SetupSeriesWithData(ITEMS_TO_ADD, LOOKBACK_LIMIT);
+
+ // Internally, the item count will be trimmed.
+ // The public Count should be capped at the lookback limit.
+ Assert.AreEqual(Int64(LOOKBACK_LIMIT), FSeries.Count, 'Public count should be capped by MaxLookback after trimming');
+end;
+
+procedure TTestDataSeries.TestLoopIsSafeWithMaxLookback;
+var
+ dummy: TDataPoint;
+begin
+ SetupSeriesWithData(500, 400);
+ Assert.AreEqual(Int64(400), FSeries.Count, 'Pre-condition: Count must be capped at 400');
+
+ // This test proves that a standard loop based on the public Count is safe
+ // and will not access an invalid index.
+ Assert.WillNotRaise(
+ procedure
+ begin
+ for var i := 0 to FSeries.Count - 1 do
+ begin
+ dummy := FSeries[i];
+ end;
+ end,
+ EAssertionFailed, // Using EAssertionFailed here to catch potential internal range checks
+ 'Looping up to the public Count should not raise an exception'
+ );
+
+ // Also test the assert when going one item beyond the public count
+ Assert.WillRaise(
+ procedure begin dummy := FSeries[400]; end,
+ EAssertionFailed,
+ 'Accessing index at the limit of MaxLookback should raise an exception'
+ );
+end;
+
+procedure TTestDataSeries.TestDataAndTimePropertiesRespectLookback;
+var
+ baseTime: TDateTime;
+ expectedOldestTime: TDateTime;
+ expectedOldestAsk: Single;
+ expectedNewestTime: TDateTime;
+ expectedNewestAsk: Single;
+begin
+ SetupSeriesWithData(20, 15); // Add 20 items, lookback 15.
+ // Visible items are those originally at index 5 through 19.
+ baseTime := EncodeDate(2020, 7, 7);
+
+ // Newest item in series is from i=19. Time = baseTime + 19. Logical index = 0.
+ expectedNewestTime := baseTime + 19;
+ expectedNewestAsk := 19.0;
+ // Oldest visible item is from i=5. Time = baseTime + 5. Logical index = 14.
+ expectedOldestTime := baseTime + 5;
+ expectedOldestAsk := 5.0;
+
+ Assert.AreEqual(Int64(15), FSeries.Count, 'Pre-condition: Count must be 15');
+
+ // Check Data and Time properties at the boundaries
+ Assert.AreEqual(expectedNewestTime, FSeries.Time[0], 'Time[0] should be the newest visible item''s time');
+ Assert.AreEqual(expectedNewestAsk, FSeries.Data[0].Ask, 'Data[0] should be the newest visible item''s data');
+
+ Assert.AreEqual(expectedOldestTime, FSeries.Time[14], 'Time[Count-1] should be the oldest visible item''s time');
+ Assert.AreEqual(expectedOldestAsk, FSeries.Data[14].Ask, 'Data[Count-1] should be the oldest visible item''s data');
+
+ // Check access will fail beyond the lookback-limited count
+ Assert.WillRaise(
+ procedure begin var dummy := FSeries.Data[15]; end,
+ EAssertionFailed,
+ 'Accessing Data property beyond public count should fail'
+ );
+ Assert.WillRaise(
+ procedure begin var dummy := FSeries.Time[15]; end,
+ EAssertionFailed,
+ 'Accessing Time property beyond public count should fail'
+ );
+end;
+
+procedure TTestDataSeries.TestLookbackZero;
+var
+ DataPoint: TDataPoint;
+begin
+ FSeries := TDataSeries.CreateDataSeries(0);
+ Assert.AreEqual(Int64(0), FSeries.Lookback, 'Lookback should be 0');
+ Assert.AreEqual(Int64(0), FSeries.Count, 'Count on new series should be 0');
+ Assert.AreEqual(Int64(0), FSeries.TotalCount, 'TotalCount on new series should be 0');
+
+ // Add an item
+ DataPoint := TDataPoint.Create(Now, TAskBidItem.Create(1, 1.1));
+ FSeries := FSeries.Add([DataPoint], 0, 1);
+
+ // Count should still be 0, but TotalCount should be 1
+ Assert.AreEqual(Int64(0), FSeries.Count, 'Count must remain 0 when Lookback is 0');
+ Assert.AreEqual(Int64(1), FSeries.TotalCount, 'TotalCount should increment even with Lookback 0');
+
+ // Accessing any item should fail
+ Assert.WillRaise(
+ procedure begin var dummy := FSeries[0]; end,
+ EAssertionFailed,
+ 'Accessing item[0] on a series with Lookback=0 should raise an error'
+ );
+
+ // IndexOf should also find nothing
+ Assert.AreEqual(Int64(-1), FSeries.IndexOf(Now), 'IndexOf on a series with Lookback=0 should return -1');
+end;
+
+procedure TTestDataSeries.TestLookbackOne;
+var
+ DataPoint1, DataPoint2, DataPoint3: TDataPoint;
+ time1, time2, time3: TDateTime;
+begin
+ FSeries := TDataSeries.CreateDataSeries(1);
+ Assert.AreEqual(Int64(1), FSeries.Lookback, 'Lookback should be 1');
+
+ // Add first item
+ time1 := Now;
+ DataPoint1 := TDataPoint.Create(time1, TAskBidItem.Create(1, 1.1));
+ FSeries := FSeries.Add([DataPoint1], 0, 1);
+ Assert.AreEqual(Int64(1), FSeries.Count, 'Count should be 1 after one add');
+ Assert.AreEqual(Int64(1), FSeries.TotalCount, 'TotalCount should be 1');
+ Assert.AreEqual(time1, FSeries[0].Time, 'The first item should be at index 0');
+
+ // Add second item
+ time2 := time1 + EncodeTime(0, 0, 1, 0);
+ DataPoint2 := TDataPoint.Create(time2, TAskBidItem.Create(2, 2.1));
+ FSeries := FSeries.Add([DataPoint2], 0, 1);
+ Assert.AreEqual(Int64(1), FSeries.Count, 'Count must be capped at 1');
+ Assert.AreEqual(Int64(2), FSeries.TotalCount, 'TotalCount should be 2');
+ Assert.AreEqual(time2, FSeries[0].Time, 'The newest item should now be at index 0');
+
+ // Add third item
+ time3 := time2 + EncodeTime(0, 0, 1, 0);
+ DataPoint3 := TDataPoint.Create(time3, TAskBidItem.Create(3, 3.1));
+ FSeries := FSeries.Add([DataPoint3], 0, 1);
+ Assert.AreEqual(Int64(1), FSeries.Count, 'Count must still be capped at 1');
+ Assert.AreEqual(Int64(3), FSeries.TotalCount, 'TotalCount should be 3');
+ Assert.AreEqual(time3, FSeries[0].Time, 'The third item should now be at index 0');
+
+ // Accessing index 1 should fail
+ Assert.WillRaise(
+ procedure begin var dummy := FSeries[1]; end,
+ EAssertionFailed,
+ 'Accessing item[1] on a series with Lookback=1 should raise an error'
+ );
+end;
+
initialization
- TDUnitX.RegisterTestFixture(TTestDataArray);
TDUnitX.RegisterTestFixture(TTestDataSeries);
end.
diff --git a/Src/Myc.Trade.Core.DataPoint.pas b/Src/Myc.Trade.Core.DataPoint.pas
index 0c590ae..0ed1ab6 100644
--- a/Src/Myc.Trade.Core.DataPoint.pas
+++ b/Src/Myc.Trade.Core.DataPoint.pas
@@ -3,11 +3,13 @@ unit Myc.Trade.Core.DataPoint;
interface
uses
+ System.Generics.Collections,
+ System.TimeSpan,
Myc.Trade.DataPoint;
type
- // The implementation class for IDataSeries.
- TDataArray = class(TInterfacedObject, IDataSeries, IDataSeriesWriter)
+ TMycDataArray = record
+ private
const
ChunkSize = 1024;
type
@@ -15,26 +17,34 @@ type
private
FChunks: TArray;
FCount: Int64;
- FLookback: Int64;
- FTotalCount: Int64;
function LogicalToPhysicalIndex(LogicalIndex: Int64): Int64; inline;
- function IsIndexInLimits(LogicalIndex: Int64): Boolean;
- procedure Trim;
+ function GetItems(Idx: Int64): TDataPoint; inline;
+ public
+ constructor Create(const AChunks: TArray; ACount: Int64);
+ function Add(const Data: array of TDataPoint; First, Count, Lookback: Int64): TMycDataArray;
+ class function CreateEmpty: TMycDataArray; static;
+ // Helper to create a data array from a raw TArray.
+ class function CreateFromArray(const AData: TArray>; First, Count: Integer): TMycDataArray; static;
+ property Count: Int64 read FCount;
+ property Items[Idx: Int64]: TDataPoint read GetItems; default;
+ end;
- // IDataSeries implementation
+ // The implementation class for IDataSeries.
+ TMycDataSeries = class(TInterfacedObject, IDataSeries)
+ private
+ FData: TMycDataArray;
+ FLookback: Int64;
+ FTotalCount: Int64;
function GetCount: Int64;
function GetItems(Idx: Int64): TDataPoint;
function GetLookback: Int64;
function GetTotalCount: Int64;
- function GetWriter: IDataSeriesWriter;
public
- constructor Create(ALookback: Int64);
- procedure Add(const Data: TDataPoint); overload;
- procedure Add(const Data: array of TDataPoint; NumToAdd: Integer = -1); overload;
- procedure Clear;
- function Immutable: IDataSeries;
- property Lookback: Int64 read GetLookback;
+ constructor Create(ALookback: Int64; const AData: TMycDataArray; ATotalCount: Int64);
+ destructor Destroy; override;
+ function Add(const Data: TArray>; First, Count: Integer): IDataSeries;
+ class function CreateDataSeries(Lookback: Int64; const AData: TMycDataArray; ATotalCount: Int64): IDataSeries; static;
end;
// Null object implementation for IDataSeries
@@ -43,217 +53,247 @@ type
class var
FNull: IDataSeries;
private
- class constructor CreateClass;
- function GetWriter: IDataSeriesWriter;
- public
+ FTotalCount: Int64;
function GetCount: Int64;
function GetItems(Idx: Int64): TDataPoint