diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj
index 90ff7f2..0ded5a4 100644
--- a/AuraTrader/AuraTrader.dproj
+++ b/AuraTrader/AuraTrader.dproj
@@ -104,6 +104,7 @@
true
true
true
+ off
false
@@ -119,6 +120,7 @@
RELEASE;$(DCC_Define)
0
0
+ auto
PerMonitorV2
@@ -162,6 +164,12 @@
AuraTrader.dpr
+
+ Embarcadero C++Builder Office 2000 Servers Package
+ Embarcadero C++Builder Office XP Servers Package
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas
index c5cb176..82fcf1a 100644
--- a/AuraTrader/MainForm.pas
+++ b/AuraTrader/MainForm.pas
@@ -50,7 +50,9 @@ uses
System.Actions,
FMX.ActnList,
DynamicFMXControl,
- Myc.FMX.Chart;
+ Myc.FMX.Chart,
+ Myc.Trade.Indicators,
+ Myc.DataRecord;
type
TForm1 = class(TForm)
@@ -108,6 +110,7 @@ type
procedure NewWorkspace;
function CurrLayout: T;
procedure AlignControl(Control: TControl);
+ function CreateStrategy1(Timeframe: TTimeframe): IMycProcessor>;
function CreateStrategy2(Timeframe: TTimeframe): IMycProcessor>;
published
@@ -124,29 +127,24 @@ type
constructor Create(AEquity: Double);
end;
-type
- TStaget1Result = record
- ATR, Hull, SMA, O, H, L, C: Double
- end;
-
var
Form1: TForm1;
implementation
uses
- TestModule,
- Myc.Trade.Indicators,
- Myc.DataRecord;
+ TestModule;
{$R *.fmx}
procedure TForm1.NewWorkspace;
+var
+ tab: TTabItem;
begin
var ws: IAuraWorkspace := TMycAuraWorkspace.Create('New workspace', tmTesting);
FApplication.Workspaces.Insert(-1, ws);
- var tab := TabControl.Add;
+ tab := TabControl.Add;
tab.Text := ws.Caption;
tab.Tag := NativeInt(ws);
@@ -297,7 +295,7 @@ begin
Control.Align := TAlignLayout.Top;
end;
-function TForm1.CreateStrategy2(Timeframe: TTimeframe): IMycProcessor>;
+function TForm1.CreateStrategy1(Timeframe: TTimeframe): IMycProcessor>;
type
TSignal = record
Sig: Double;
@@ -453,6 +451,12 @@ begin
panel.AddDoubleSeries(Signal.Field('Entry').Sender, TAlphaColors.Green, 1);
panel.AddDoubleSeries(Signal.Field('SL').Sender, TAlphaColors.Red, 2);
+ var mean := TConverter, Double>.CreateGeneric(TIndicators.CreateMean());
+
+ TConverter.Join([Hull.Sender, Sma.Sender]).Link(mean);
+
+ panel.AddDoubleSeries(mean.Sender, TAlphaColors.Blue, 5);
+
var pnlChart := TMycChart.Create(Self);
AlignControl(pnlChart);
pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
@@ -460,8 +464,236 @@ begin
pnlChart.SetXAxisCounter(equity.Sender);
+ ////////////
+ var EMAFactory := TEMA.Create;
+
+ var Params := TDataRecord.CreateFrom(EMAFactory.Params);
+ Params.SetValue('Period', 20);
+
+ var indi := EMAFActory.CreateIndicator(Params);
+
+ var EMAConv := TConverter.CreateGeneric(indi);
+
+ var equityEMA :=
+ equity
+ .Chain(TConverter.FieldToRecord(EMAFactory.Input, 'Price'))
+ .Chain(EMAConv)
+ .Chain(TConverter.FieldOfRecord(EMAFactory.Output, 'MA'));
+
+ //////////////
+
panel := pnlChart.AddPanel;
panel.AddDoubleSeries(equity.Sender, TAlphaColors.Blue, 3);
+ panel.AddDoubleSeries(equityEMA.Sender, TAlphaColors.Gray, 2);
+
+ /////
+end;
+
+function TForm1.CreateStrategy2(Timeframe: TTimeframe): IMycProcessor>;
+type
+ TSignal = record
+ Sig: Double;
+ SL: Double;
+ Entry: Double;
+ pnl: Double;
+ end;
+var
+ panel: TMycChart.TPanel;
+begin
+ var ticker := TConverter.CreateIdentity>;
+ Result := ticker;
+
+ var OhlcPoint := ticker.Chain>(TConverter.CreateOhlcAggregation(Timeframe));
+
+ var Ohlc := OhlcPoint.Field('Data');
+
+ var Closes := Ohlc.Field('Close');
+
+ var Hull := Closes.Chain(TIndicators.CreateHMA(250)).MakeParallel;
+ var Sma := Closes.Chain(TIndicators.CreateSMA(200)).MakeParallel;
+
+ var Lowest: Double := Double.MaxValue;
+ var Highest: Double := Double.MinValue;
+
+ var ATR := Ohlc.Chain(TIndicators.CreateATR(50)).MakeParallel;
+
+ // next stage
+
+ var ATREndPoint := TConverter.CreateEndpoint(ATR.Sender, 5);
+ var ATRSeries: TSeries;
+
+ var HullEndPoint := TConverter.CreateEndpoint(Hull.Sender, 5);
+ var HullSeries: TSeries;
+
+ var SmaEndPoint := TConverter.CreateEndpoint(Sma.Sender, 5);
+ var SmaSeries: TSeries;
+
+ var curr: TSignal;
+ curr.SL := Double.NaN;
+ curr.Entry := Double.NaN;
+
+ var lastHull, lastSma: Double;
+
+ var conv :=
+ TConverter.Join(
+ [Ohlc.Field('Low').Sender, Ohlc.Field('High').Sender, Closes.Sender, ATR.Sender, Hull.Sender, Sma.Sender]
+ );
+
+ var Signal :=
+ TConverter, TSignal>.CreateGeneric(
+ function(const Values: TArray): TSignal
+ begin
+ var low := Values[0];
+ var high := Values[1];
+ var close := Values[2];
+ var atr := Values[3];
+ var hull := Values[4];
+ var sma := Values[5];
+
+ if low < Lowest then
+ Lowest := low;
+ if high > Highest then
+ Highest := high;
+
+ Result := curr;
+ Result.Sig := 0;
+ var pnl: double := NaN;
+
+ if (hull < sma) and (lastHull >= lastSma) then
+ begin
+ if curr.Sig > 0 then
+ pnl := close - curr.Entry;
+
+ curr.Sig := -1;
+ curr.SL := Highest;
+ curr.Entry := close;
+ Result := curr;
+ end
+ else if (hull > sma) and (lastHull <= lastSma) then
+ begin
+ if curr.Sig < 0 then
+ pnl := curr.Entry - close;
+
+ curr.Sig := 1;
+ curr.SL := Lowest;
+ curr.Entry := close;
+ Result := curr;
+ end;
+
+ atr := 15 * atr;
+ if curr.Sig > 0 then
+ begin
+ if close > curr.SL then
+ begin
+ if curr.SL < close - atr then
+ curr.SL := close - atr;
+ Result.SL := curr.SL;
+ end;
+
+ if low <= curr.SL then
+ begin
+ pnl := curr.SL - curr.Entry;
+ curr.Sig := 0;
+ Result.Sig := 0;
+ curr.SL := NaN;
+ end;
+ end
+ else if curr.Sig < 0 then
+ begin
+ if close < curr.SL then
+ begin
+ if curr.SL > close + atr then
+ curr.SL := close + atr;
+ Result.SL := curr.SL;
+ end;
+
+ if high >= curr.SL then
+ begin
+ pnl := curr.Entry - curr.SL;
+ curr.Sig := 0;
+ Result.Sig := 0;
+ curr.SL := NaN;
+ end;
+ end;
+
+ if Result.Sig <> 0 then
+ begin
+ Lowest := Double.MaxValue;
+ Highest := Double.MinValue;
+ Result.SL := Double.NaN;
+ Result.Entry := Double.NaN;
+ end;
+
+ Result.pnl := pnl;
+
+ lastHull := hull;
+ lastSma := sma;
+ end
+ );
+
+ conv.Link(Signal);
+
+ var pnl := Signal.Field('pnl');
+
+ var equity: TConverter := TEquitySum.Create(10000);
+ pnl.Sender.Link(equity);
+
+ var Layout := CurrLayout;
+ if Layout = nil then
+ exit;
+
+ var Symbol := SelectedSymbol;
+ if Symbol = '' then
+ exit;
+
+ var chart := TMycChart.Create(Self);
+ AlignControl(chart);
+ chart.Height := Layout.ChildrenRect.Width * 9 / 16;
+ chart.Lookback.Value := 50000;
+
+ chart.SetXAxisSeries(M15, OhlcPoint.Field('Time').Sender);
+
+ panel := chart.AddPanel;
+ panel.AddOhlcSeries(Ohlc.Sender);
+ panel.AddDoubleSeries(Hull.Sender, TAlphaColors.Cornflowerblue, 2);
+ panel.AddDoubleSeries(Sma.Sender, TAlphaColors.Brown, 1.5);
+ panel.AddDoubleSeries(Signal.Field('Entry').Sender, TAlphaColors.Green, 1);
+ panel.AddDoubleSeries(Signal.Field('SL').Sender, TAlphaColors.Red, 2);
+
+ var mean := TConverter, Double>.CreateGeneric(TIndicators.CreateMean());
+
+ TConverter.Join([Hull.Sender, Sma.Sender]).Link(mean);
+
+ panel.AddDoubleSeries(mean.Sender, TAlphaColors.Blue, 5);
+
+ var pnlChart := TMycChart.Create(Self);
+ AlignControl(pnlChart);
+ pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
+ pnlChart.Lookback.Value := 50000;
+
+ pnlChart.SetXAxisCounter(equity.Sender);
+
+ ////////////
+ var EMAFactory := TEMA.Create;
+
+ var Params := TDataRecord.CreateFrom(EMAFactory.Params);
+ Params.SetValue('Period', 20);
+
+ var indi := EMAFActory.CreateIndicator(Params);
+
+ var EMAConv := TConverter.CreateGeneric(indi);
+
+ var equityEMA :=
+ equity
+ .Chain(TConverter.FieldToRecord(EMAFactory.Input, 'Price'))
+ .Chain(EMAConv)
+ .Chain(TConverter.FieldOfRecord(EMAFactory.Output, 'MA'));
+
+ //////////////
+
+ panel := pnlChart.AddPanel;
+ panel.AddDoubleSeries(equity.Sender, TAlphaColors.Blue, 3);
+ panel.AddDoubleSeries(equityEMA.Sender, TAlphaColors.Gray, 2);
/////
end;
diff --git a/Src/Myc.DataRecord.Impl.pas b/Src/Myc.DataRecord.Impl.pas
index 25bc6de..39285ae 100644
--- a/Src/Myc.DataRecord.Impl.pas
+++ b/Src/Myc.DataRecord.Impl.pas
@@ -11,238 +11,69 @@ uses
Myc.DataRecord;
type
- // The builder implementation class, now in the global scope.
- TDataRecordBuilder = class(TInterfacedObject, TDataRecord.TBuilder.IBuilder)
- private
- FStagedValues: TList>;
- public
- constructor Create;
- destructor Destroy; override;
- // IBuilder implementation
- procedure AddField(const Name: String; const Value: TValue); overload;
- procedure SetupRecord(out Layout: TArray; out Buffer: TBytes);
- end;
-
-type
- TField = class(TInterfacedObject, TDataRecord.IField)
- private
- FBuffer: TBytes;
- FFieldLayout: TDataRecord.TFieldLayout;
- protected
- function GetRawRef: Pointer; inline;
- public
- constructor Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
- procedure GetRaw(Dst: Pointer); virtual;
- procedure SetRaw(Src: Pointer); virtual;
- property FieldLayout: TDataRecord.TFieldLayout read FFieldLayout;
- end;
-
-type
- TGenericField = class(TField, TDataRecord.IField)
- public
- function GetValue: T;
- procedure SetValue(const Value: T);
- end;
-
-type
- TIntegerField = class(TGenericField)
- public
- procedure GetRaw(Dst: Pointer); override;
- procedure SetRaw(Src: Pointer); override;
- end;
-
-type
- TSingleField = class(TGenericField)
- public
- procedure GetRaw(Dst: Pointer); override;
- procedure SetRaw(Src: Pointer); override;
- end;
-
-type
- TDoubleField = class(TGenericField)
- public
- procedure GetRaw(Dst: Pointer); override;
- procedure SetRaw(Src: Pointer); override;
- end;
-
-type
- TInt64Field = class(TGenericField)
- public
- procedure GetRaw(Dst: Pointer); override;
- procedure SetRaw(Src: Pointer); override;
- end;
-
-type
- TStringField = class(TGenericField)
- public
- procedure GetRaw(Dst: Pointer); override;
- procedure SetRaw(Src: Pointer); override;
- end;
-
-type
- TFieldLayoutComparer = class(TComparer)
+ TFieldLayoutComparer = class(TComparer)
strict private
class var
- FDefaultComparer: IComparer;
+ FDefaultComparer: IComparer;
class constructor CreateClass;
public
- function Compare(const Left, Right: TDataRecord.TFieldLayout): Integer; override;
- class property DefaultComparer: IComparer read FDefaultComparer;
+ function Compare(const Left, Right: TDataRecord.TField): Integer; override;
+ class property DefaultComparer: IComparer read FDefaultComparer;
end;
implementation
-{ TDataRecordBuilder }
-
-constructor TDataRecordBuilder.Create;
+(*
+procedure TIntegerField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
begin
- inherited;
- FStagedValues := TList>.Create;
+ PInteger(Dst)^ := PInteger(GetRawRef(Buffer))^;
end;
-destructor TDataRecordBuilder.Destroy;
+procedure TIntegerField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
begin
- FStagedValues.Free;
- inherited;
+ PInteger(GetRawRef(Buffer))^ := PInteger(Src)^;
end;
-procedure TDataRecordBuilder.AddField(const Name: String; const Value: TValue);
+procedure TSingleField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
begin
- FStagedValues.Add(TPair.Create(Name, Value));
+ PSingle(Dst)^ := PSingle(GetRawRef(Buffer))^;
end;
-procedure TDataRecordBuilder.SetupRecord(out Layout: TArray; out Buffer: TBytes);
-var
- layoutList: TList;
- pair: TPair;
- field: TDataRecord.TFieldLayout;
+procedure TSingleField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
begin
- layoutList := TList.Create;
- try
- layoutList.Capacity := FStagedValues.Count;
- var ofs: NativeUInt := 0;
- for pair in FStagedValues do
- begin
- field.Name := pair.Key;
- field.Size := pair.Value.DataSize;
- ofs := (ofs + 15) and not 15;
- field.Offset := ofs;
- inc(ofs, field.Size);
- field.TypeInfo := pair.Value.TypeInfo;
- layoutList.Add(field);
- end;
-
- SetLength(Buffer, ofs);
-
- for var i := 0 to layoutList.Count - 1 do
- begin
- var P: PByte := @Buffer[layoutList[i].Offset];
- FStagedValues[i].Value.ExtractRawData(P);
- end;
-
- layoutList.Sort(TFieldLayoutComparer.DefaultComparer);
- Layout := layoutList.ToArray;
- finally
- layoutList.Free;
- end;
- FStagedValues.Clear;
+ PSingle(GetRawRef(Buffer))^ := PSingle(Src)^;
end;
-{ TField and descendants... }
-constructor TField.Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
+procedure TDoubleField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
begin
- inherited Create;
- FBuffer := ABuffer;
- FFieldLayout := AField;
+ PDouble(Dst)^ := PDouble(GetRawRef(Buffer))^;
end;
-procedure TField.GetRaw(Dst: Pointer);
-var
- Val: TValue;
+procedure TDoubleField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
begin
- TValue.MakeWithoutCopy(GetRawRef, FFieldLayout.TypeInfo, val, true);
- val.ExtractRawData(Dst);
+ PDouble(GetRawRef(Buffer))^ := PDouble(Src)^;
end;
-function TField.GetRawRef: Pointer;
+procedure TInt64Field.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
begin
- Result := @FBuffer[FFieldLayout.Offset];
+ PInt64(Dst)^ := PInt64(GetRawRef(Buffer))^;
end;
-procedure TField.SetRaw(Src: Pointer);
-var
- Val: TValue;
+procedure TInt64Field.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
begin
- TValue.MakeWithoutCopy(Src, FFieldLayout.TypeInfo, val, true);
- val.ExtractRawData(GetRawRef);
+ PInt64(GetRawRef(Buffer))^ := PInt64(Src)^;
end;
-{ TGenericField }
-
-function TGenericField.GetValue: T;
-type
- PT = ^T;
+procedure TStringField.GetRaw(const [ref] Buffer: TBytes; Dst: Pointer);
begin
- Result := PT(@FBuffer[FFieldLayout.Offset])^;
+ PString(Dst)^ := PString(GetRawRef(Buffer))^;
end;
-procedure TGenericField.SetValue(const Value: T);
-type
- PT = ^T;
+procedure TStringField.SetRaw(const [ref] Buffer: TBytes; Src: Pointer);
begin
- PT(@FBuffer[FFieldLayout.Offset])^ := Value;
+ PString(GetRawRef(Buffer))^ := PString(Src)^;
end;
-
-procedure TIntegerField.GetRaw(Dst: Pointer);
-begin
- PInteger(Dst)^ := PInteger(GetRawRef)^;
-end;
-
-procedure TIntegerField.SetRaw(Src: Pointer);
-begin
- PInteger(GetRawRef)^ := PInteger(Src)^;
-end;
-
-procedure TSingleField.GetRaw(Dst: Pointer);
-begin
- PSingle(Dst)^ := PSingle(GetRawRef)^;
-end;
-
-procedure TSingleField.SetRaw(Src: Pointer);
-begin
- PSingle(GetRawRef)^ := PSingle(Src)^;
-end;
-
-procedure TDoubleField.GetRaw(Dst: Pointer);
-begin
- PDouble(Dst)^ := PDouble(GetRawRef)^;
-end;
-
-procedure TDoubleField.SetRaw(Src: Pointer);
-begin
- PDouble(GetRawRef)^ := PDouble(Src)^;
-end;
-
-procedure TInt64Field.GetRaw(Dst: Pointer);
-begin
- PInt64(Dst)^ := PInt64(GetRawRef)^;
-end;
-
-procedure TInt64Field.SetRaw(Src: Pointer);
-begin
- PInt64(GetRawRef)^ := PInt64(Src)^;
-end;
-
-procedure TStringField.GetRaw(Dst: Pointer);
-begin
- PString(Dst)^ := PString(GetRawRef)^;
-end;
-
-procedure TStringField.SetRaw(Src: Pointer);
-begin
- PString(GetRawRef)^ := PString(Src)^;
-end;
-
+*)
{ TFieldLayoutComparer }
class constructor TFieldLayoutComparer.CreateClass;
@@ -250,7 +81,7 @@ begin
FDefaultComparer := TFieldLayoutComparer.Create;
end;
-function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TFieldLayout): Integer;
+function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TField): Integer;
begin
Result := TComparer.Default.Compare(Left.Name, Right.Name);
end;
diff --git a/Src/Myc.DataRecord.pas b/Src/Myc.DataRecord.pas
index 5b88950..e7dd3af 100644
--- a/Src/Myc.DataRecord.pas
+++ b/Src/Myc.DataRecord.pas
@@ -4,280 +4,335 @@ interface
uses
System.SysUtils,
+ System.Generics.Collections,
System.Rtti,
System.TypInfo;
type
- // A record that provides field-level access to managed data, stored in a byte buffer.
+ TDataFieldType = (dfFloat, dfInteger, dfString, dfTimestamp);
+
TDataRecord = record
public
type
- IField = interface
- procedure GetRaw(Dst: Pointer);
- procedure SetRaw(Src: Pointer);
- end;
-
- IField = interface(IField)
- {$region 'private'}
- function GetValue: T;
- procedure SetValue(const Value: T);
- {$endregion}
- property Value: T read GetValue write SetValue;
- end;
-
- TFieldLayout = record
- Name: string;
- Offset: Integer;
- Size: Integer;
- TypeInfo: PTypeInfo;
- end;
-
- // The interface helper record that provides the generic AddField method.
- TBuilder = record
- type
- IBuilder = interface
- procedure AddField(const Name: String; const Value: TValue); overload;
- procedure SetupRecord(out Layout: TArray; out Buffer: TBytes);
- end;
-
+ TField = record
private
- FBuilder: IBuilder;
+ FFieldType: TDataFieldType;
+ FName: string;
+ FOffset: Integer;
+ FSize: Integer;
+
+ procedure Write(SrcType: PTypeInfo; const Src; P: Pointer);
+ procedure Read(Src: Pointer; DstType: PTypeInfo; var Dst);
+ procedure Finalize(P: Pointer);
+ property Offset: Integer read FOffset;
+ property Size: Integer read FSize;
+
public
- constructor Create(const ABuilder: IBuilder);
+ constructor Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
- class operator Implicit(const AValue: IBuilder): TBuilder; overload;
- class operator Implicit(const AValue: TBuilder): IBuilder; overload;
+ class function From(const AName: string; Offset: Integer): TField; overload; static;
+ class function From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField; overload; static;
- procedure AddField(const Name: String); overload; inline;
- procedure AddField(const Name: String; const Value: T); overload; inline;
+ property FieldType: TDataFieldType read FFieldType;
+ property Name: string read FName;
+ end;
- function CreateRec: TDataRecord; inline;
+ TLayout = record
+ private
+ FFields: TArray;
+ public
+ constructor Create(const AFields: TArray);
+ class function CreateFrom: TLayout; static;
+ function GetBufferSize: Integer;
+ function IndexOf(const Name: String): Integer;
+ property Fields: TArray read FFields;
end;
private
- FLayout: TArray;
+ FLayout: TLayout;
FBuffer: TBytes;
public
- class operator Initialize(out Dest: TDataRecord);
+ constructor Create(const ALayout: TLayout; const ABuffer: TBytes);
+
+ class function CreateFrom: TDataRecord; overload; static;
+ class function CreateFrom(const Src: T): TDataRecord; overload; static;
+ class function CreateFrom(const Layout: TLayout): TDataRecord; overload; static;
+ procedure CopyFrom(const Src: T);
+
+ procedure SetValue(const Name: String; const Value: T); overload;
+ procedure SetValue(Idx: Integer; const Value); overload;
+
+ function GetValue(const Name: String): T; overload;
+ procedure GetValue(Idx: Integer; out Value); overload;
+
class operator Finalize(var Dest: TDataRecord);
- class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
- class function CreateBuilder: TBuilder; static;
-
- class function CreateFrom(const Rec: T): TDataRecord; static;
- procedure AssignTo(var Rec: T);
- function FitsRecord: Boolean;
-
- function IndexOf(const Name: String): Integer;
- function GetField(const Name: String): IField; overload;
- function GetField(const Name: String): IField; overload;
-
- property Layout: TArray read FLayout;
+ property Layout: TLayout read FLayout;
end;
implementation
uses
System.Classes,
- System.Generics.Collections,
Myc.DataRecord.Impl;
-{ TDataRecord.TBuilder }
-
-constructor TDataRecord.TBuilder.Create(const ABuilder: IBuilder);
+constructor TDataRecord.Create(const ALayout: TLayout; const ABuffer: TBytes);
begin
- FBuilder := ABuilder;
+ FLayout := ALayout;
+ FBuffer := ABuffer;
end;
-procedure TDataRecord.TBuilder.AddField(const Name: String; const Value: T);
+procedure TDataRecord.CopyFrom(const Src: T);
begin
- FBuilder.AddField(Name, TValue.From(Value));
-end;
+ var ctx := TRttiContext.Create;
+ var rttiType := ctx.GetType(TypeInfo(T));
+ var rttiFields := rttiType.GetFields;
+ var fields: TArray;
-procedure TDataRecord.TBuilder.AddField(const Name: String);
-begin
- AddField(Name, Default(T));
-end;
-
-function TDataRecord.TBuilder.CreateRec: TDataRecord;
-begin
- FBuilder.SetupRecord(Result.FLayout, Result.FBuffer);
-end;
-
-class operator TDataRecord.TBuilder.Implicit(const AValue: IBuilder): TBuilder;
-begin
- Result.FBuilder := AValue;
-end;
-
-class operator TDataRecord.TBuilder.Implicit(const AValue: TBuilder): IBuilder;
-begin
- Result := AValue.FBuilder;
-end;
-
-{ TDataRecord }
-
-function TDataRecord.GetField(const Name: String): IField;
-var
- idx: Integer;
-begin
- idx := IndexOf(Name);
- if idx < 0 then
- exit;
- if TypeInfo(T) <> FLayout[idx].TypeInfo then
- exit;
- Result := TGenericField.Create(FBuffer, FLayout[idx]);
-end;
-
-class function TDataRecord.CreateBuilder: TBuilder;
-begin
- // Create the implementation class and wrap it in the helper record.
- Result := TDataRecord.TBuilder.Create(TDataRecordBuilder.Create);
-end;
-
-class function TDataRecord.CreateFrom(const Rec: T): TDataRecord;
-var
- ctx: TRttiContext;
- rttiType: TRttiType;
- builder: TBuilder.IBuilder;
-begin
- // Create a builder to construct the TDataRecord
- builder := CreateBuilder;
-
- // Use RTTI to iterate over the fields of the source record/object
- ctx := TRttiContext.Create;
- rttiType := ctx.GetType(TypeInfo(T));
-
- // Add each field and its value to the builder
- for var field in rttiType.GetFields do
+ for var i := 0 to High(rttiFields) do
begin
- builder.AddField(field.Name, field.GetValue(Pointer(@Rec)));
- end;
+ var rf := rttiFields[i];
+ var idx := FLayout.IndexOf(rf.Name);
- // Create the final TDataRecord from the builder
- builder.SetupRecord(Result.FLayout, Result.FBuffer);
-end;
-
-procedure TDataRecord.AssignTo(var Rec: T);
-var
- ctx: TRttiContext;
- rttiType: TRttiType;
- fieldValue: TValue;
- fieldIndex: Integer;
- layout: TFieldLayout;
-begin
- Assert(FitsRecord);
-
- // Use RTTI to iterate over the fields of the destination record/object
- ctx := TRttiContext.Create;
- rttiType := ctx.GetType(TypeInfo(T));
-
- for var rttiField in rttiType.GetFields do
- begin
- // Find the corresponding field in the TDataRecord by name
- fieldIndex := IndexOf(rttiField.Name);
- if fieldIndex >= 0 then
+ if (idx >= 0) then
begin
- layout := FLayout[fieldIndex];
- // Create a TValue from the data in our buffer
- TValue.Make(@FBuffer[layout.Offset], layout.TypeInfo, fieldValue);
- // Assign the value to the destination record's field
- rttiField.SetValue(Pointer(@Rec), fieldValue);
+ var fld := FLayout.Fields[idx];
+
+ var S: PByte := @Src;
+ inc(S, rf.Offset);
+ var P := @FBuffer[FLayout.Fields[idx].Offset];
+
+ fld.Write(rf.FieldType.Handle, S^, P);
end;
end;
end;
-function TDataRecord.FitsRecord: Boolean;
+class function TDataRecord.CreateFrom(const Layout: TLayout): TDataRecord;
begin
- var ctx := TRttiContext.Create;
- var rttiType := ctx.GetType(TypeInfo(T));
-
- for var rttiField in rttiType.GetFields do
- begin
- // Find the corresponding field in the TDataRecord by name
- var fieldIndex := IndexOf(rttiField.Name);
- if fieldIndex < 0 then
- exit(false);
-
- if rttiField.DataType.Handle <> FLayout[fieldIndex].TypeInfo then
- exit(false);
- end;
- exit(true);
+ var buf: TBytes;
+ SetLength(buf, Layout.GetBufferSize);
+ Result.Create(Layout, buf);
end;
-function TDataRecord.GetField(const Name: String): IField;
-var
- idx: Integer;
+{ TDataRecord }
+
+class function TDataRecord.CreateFrom: TDataRecord;
begin
- idx := IndexOf(Name);
- if idx < 0 then
- exit;
- var typeInfo := FLayout[idx].TypeInfo;
- case typeInfo.Kind of
- tkInteger: Result := TIntegerField.Create(FBuffer, FLayout[idx]);
- tkFloat:
- case GetTypeData(typeInfo).FloatType of
- ftSingle: Result := TSingleField.Create(FBuffer, FLayout[idx]);
- ftDouble: Result := TDoubleField.Create(FBuffer, FLayout[idx]);
- end;
- tkInt64: Result := TInt64Field.Create(FBuffer, FLayout[idx]);
- tkString: Result := TStringField.Create(FBuffer, FLayout[idx]);
- end;
- if not Assigned(Result) then
- Result := TField.Create(FBuffer, FLayout[idx]);
+ Result := CreateFrom(TLayout.CreateFrom);
end;
-function TDataRecord.IndexOf(const Name: String): Integer;
-var
- dummyLayout: TFieldLayout;
+class function TDataRecord.CreateFrom(const Src: T): TDataRecord;
begin
- dummyLayout.Name := Name;
- if not TArray.BinarySearch(FLayout, dummyLayout, Result, TFieldLayoutComparer.DefaultComparer) then
- Result := -1;
+ Result := CreateFrom;
+ Result.CopyFrom(Src);
end;
-class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
+procedure TDataRecord.GetValue(Idx: Integer; out Value);
begin
- Finalize(Dest);
-
- Dest.FLayout := Src.FLayout;
- SetLength(Dest.FBuffer, Length(Src.FBuffer));
- for var i := 0 to High(Dest.FLayout) do
- begin
- Assert(Dest.FLayout[i].Name = Src.Layout[i].Name);
- Assert(Dest.FLayout[i].Offset = Src.Layout[i].Offset);
- Assert(Dest.FLayout[i].Size = Src.Layout[i].Size);
- Assert(Dest.FLayout[i].TypeInfo = Src.Layout[i].TypeInfo);
-
- var ofs := Dest.FLayout[i].Offset;
- var P: PByte := @Dest.FBuffer[ofs];
- var Q: PByte := @Src.FBuffer[ofs];
- var Val: TValue;
- TValue.Make(Q, Dest.FLayout[i].TypeInfo, val);
- val.ExtractRawData(P);
+ var P := @FBuffer[FLayout.Fields[Idx].Offset];
+ case FLayout.Fields[Idx].FieldType of
+ dfFloat: Double(Value) := PDouble(P)^;
+ dfInteger: Int64(Value) := PInt64(Value)^;
+ dfString: String(Value) := PString(Value)^;
+ dfTimestamp: TDateTime(Value) := PDateTime(Value)^;
+ else
+ Assert(false);
end;
end;
-class operator TDataRecord.Initialize(out Dest: TDataRecord);
+procedure TDataRecord.SetValue(Idx: Integer; const Value);
begin
- Dest.FLayout := nil;
- Dest.FBuffer := nil;
+ var P := @FBuffer[FLayout.Fields[Idx].Offset];
+ case FLayout.Fields[Idx].FieldType of
+ dfFloat: PDouble(P)^ := Double(Value);
+ dfInteger: PInt64(P)^ := Int64(Value);
+ dfString: PString(P)^ := String(Value);
+ dfTimestamp: PDateTime(P)^ := TDateTime(Value);
+ else
+ Assert(false);
+ end;
+end;
+
+function TDataRecord.GetValue(const Name: String): T;
+begin
+ var idx := FLayout.IndexOf(Name);
+ if (idx >= 0) then
+ FLayout.Fields[idx].Read(@FBuffer[FLayout.Fields[idx].Offset], TypeInfo(T), Result);
+end;
+
+procedure TDataRecord.SetValue(const Name: String; const Value: T);
+begin
+ var idx := FLayout.IndexOf(Name);
+ if (idx >= 0) then
+ FLayout.Fields[idx].Write(TypeInfo(T), Value, @FBuffer[FLayout.Fields[idx].Offset]);
end;
class operator TDataRecord.Finalize(var Dest: TDataRecord);
begin
- if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
- Exit;
+ for var i := 0 to High(Dest.FLayout.Fields) do
+ Dest.FLayout.Fields[i].Finalize(@Dest.FBuffer[Dest.FLayout.Fields[i].Offset]);
+end;
- for var layout in Dest.FLayout do
- begin
- var P: PByte := @Dest.FBuffer[layout.Offset];
- var Val: TValue;
- // IsMoved has to be false, because we want the local TValue to own the field and destroy it when it looses scope!
- TValue.MakeWithoutCopy(P, layout.TypeInfo, val, false);
+constructor TDataRecord.TField.Create(const AName: string; AFieldType: TDataFieldType; AOffset, ASize: Integer);
+begin
+ FName := AName;
+ FFieldType := AFieldType;
+ FOffset := AOffset;
+ FSize := ASize;
+end;
+
+procedure TDataRecord.TField.Finalize(P: Pointer);
+begin
+ case FFieldType of
+ dfFloat: PDouble(P)^ := 0;
+ dfInteger: PInt64(P)^ := 0;
+ dfString: PString(P)^ := '';
+ dfTimestamp: PDateTime(P)^ := 0;
+ else
+ Assert(false);
end;
- Dest.FLayout := nil;
- Dest.FBuffer := nil;
+end;
+
+procedure TDataRecord.TField.Write(SrcType: PTypeInfo; const Src; P: Pointer);
+begin
+ case FFieldType of
+ dfFloat:
+ begin
+ Assert(SrcType.Kind = tkFloat);
+ case GetTypeData(SrcType).FloatType of
+ ftSingle: PDouble(P)^ := PSingle(@Src)^;
+ ftDouble: PDouble(P)^ := PDouble(@Src)^;
+ else
+ Assert(false);
+ end;
+ end;
+ dfInteger:
+ begin
+ case SrcType.Kind of
+ tkInteger: PInt64(P)^ := PInteger(@Src)^;
+ tkInt64: PInt64(P)^ := PInt64(@Src)^;
+ else
+ Assert(false);
+ end;
+ end;
+ dfString:
+ begin
+ Assert(SrcType.Kind in [tkString, tkLString, tkUString, tkWString]);
+ PString(P)^ := PString(@Src)^;
+ end;
+ dfTimestamp:
+ begin
+ Assert(SrcType.Kind = tkFloat);
+ PDateTime(P)^ := PDateTime(@Src)^;
+ end;
+ else
+ Assert(false);
+ end;
+end;
+
+class function TDataRecord.TField.From(const AName: string; const RttiType: TRttiType; Offset: Integer): TField;
+begin
+ case rttiType.TypeKind of
+ tkInteger, tkInt64: Result.Create(AName, dfInteger, Offset, sizeof(Int64));
+ tkFloat:
+ if (rttiType.Name = 'TDateTime') then
+ Result.Create(AName, dfTimestamp, Offset, sizeof(TDateTime))
+ else
+ Result.Create(AName, dfFloat, Offset, sizeof(Double));
+ tkString, tkWString, tkLString, tkUString: Result.Create(AName, dfString, Offset, sizeof(String));
+ else
+ raise Exception.Create('Type not supported');
+ end;
+end;
+
+class function TDataRecord.TField.From(const AName: string; Offset: Integer): TField;
+begin
+ var ctx := TRttiContext.Create;
+ Result := From(AName, ctx.GetType(TypeInfo(T)), Offset);
+end;
+
+procedure TDataRecord.TField.Read(Src: Pointer; DstType: PTypeInfo; var Dst);
+begin
+ case FFieldType of
+ dfFloat:
+ begin
+ Assert(DstType.Kind = tkFloat);
+ case GetTypeData(DstType).FloatType of
+ ftSingle: PSingle(@Dst)^ := PDouble(Src)^;
+ ftDouble: PDouble(@Dst)^ := PDouble(Src)^;
+ else
+ Assert(false);
+ end;
+ end;
+ dfInteger:
+ begin
+ case DstType.Kind of
+ tkInteger: PInteger(@Dst)^ := PInt64(Src)^;
+ tkInt64: PInt64(@Dst)^ := PInt64(Src)^;
+ else
+ Assert(false);
+ end;
+ end;
+ dfString:
+ begin
+ Assert(DstType.Kind in [tkString, tkLString, tkUString, tkWString]);
+ PString(@Dst)^ := PString(Src)^;
+ end;
+ dfTimestamp:
+ begin
+ Assert(DstType.Kind = tkFloat);
+ PDateTime(@Dst)^ := PDateTime(Src)^;
+ end;
+ else
+ Assert(false);
+ end;
+end;
+
+constructor TDataRecord.TLayout.Create(const AFields: TArray);
+begin
+ FFields := AFields;
+end;
+
+{ TLayout }
+
+class function TDataRecord.TLayout.CreateFrom: TLayout;
+begin
+ var ctx := TRttiContext.Create;
+ var rttiType := ctx.GetType(TypeInfo(T));
+ var rttiFields := rttiType.GetFields;
+ var fields: TArray;
+
+ // Add each field and its value to the builder
+ var ofs := 0;
+ SetLength(fields, Length(rttiFields));
+ for var i := 0 to High(rttiFields) do
+ begin
+ var rf := rttiFields[i];
+ fields[i] := TField.From(rf.Name, rf.FieldType, ofs);
+ inc(ofs, fields[i].Size);
+ ofs := (ofs + 7) and not 7;
+ end;
+
+ Result.Create(fields);
+end;
+
+function TDataRecord.TLayout.GetBufferSize: Integer;
+begin
+ if (Length(FFields) = 0) then
+ exit(0);
+
+ var n := High(FFields);
+ Result := FFields[n].FOffset + FFields[n].Size;
+ Result := (Result + 7) and not 7;
+end;
+
+function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
+begin
+ for var i := 0 to High(FFields) do
+ if (FFields[i].Name = Name) then
+ exit(i);
+ exit(-1);
end;
end.
diff --git a/Src/Myc.Trade.DataPoint.Impl.pas b/Src/Myc.Trade.DataPoint.Impl.pas
index 4aca7c8..f2fa550 100644
--- a/Src/Myc.Trade.DataPoint.Impl.pas
+++ b/Src/Myc.Trade.DataPoint.Impl.pas
@@ -5,6 +5,7 @@ interface
uses
System.SysUtils,
System.SyncObjs,
+ System.Generics.Collections,
Myc.Signals,
Myc.Mutable,
Myc.Core.Notifier,
@@ -147,13 +148,11 @@ type
// A processor implementation that is owned by a controller.
TMycContainedProcessor = class(TContainedObject, IMycProcessor)
- type
- TProc = function(const Value: T): TState of object;
private
- FProc: TProc;
+ FProc: TConstFunc;
function ProcessData(const Value: T): TState;
public
- constructor Create(const Controller: IInterface; const AProc: TProc);
+ constructor Create(const Controller: IInterface; const AProc: TConstFunc);
end;
// Endpoint that collects data into a series.
@@ -216,6 +215,33 @@ type
property Timeframe: TTimeframe read GetTimeframe;
end;
+ // Endpoint that collects data into a series.
+ TMycDataJoin = class(TInterfacedObject, TDataProvider>.IDataProvider)
+ type
+ PItem = ^TItem;
+ TItem = record
+ Next: PItem;
+ Value: T;
+ end;
+
+ private
+ FReceivers: array of record
+ DataProvider: TDataProvider;
+ Processor: TMycContainedProcessor;
+ Tag: TDataProvider.TTag;
+ Queue: TQueue;
+ end;
+
+ FSender: TMycContainedDataProvider>;
+ FLock: TSpinLock;
+ FCount: Integer;
+ function ProcessData(Idx: Integer; const Value: T): TState;
+ public
+ constructor Create(const ADataProviders: TArray>);
+ destructor Destroy; override;
+ property Sender: TMycContainedDataProvider> read FSender implements TDataProvider>.IDataProvider;
+ end;
+
implementation
uses
@@ -401,12 +427,6 @@ begin
var TypeT := Context.GetType(TypeInfo(T));
var Fields := Context.GetType(TypeInfo(S)).GetFields;
- var name := '';
- if AFieldName = 'Time' then
- for var i := 0 to High(Fields) do
- begin
- name := name + ' ' + Fields[i].Name;
- end;
Assert(Assigned(Field), 'Field ' + AFieldName + ' not found');
Assert(Field.FieldType.TypeKind = TypeT.TypeKind, 'Incorrect type');
@@ -444,7 +464,7 @@ end;
{ TMycContainedProcessor }
-constructor TMycContainedProcessor.Create(const Controller: IInterface; const AProc: TProc);
+constructor TMycContainedProcessor.Create(const Controller: IInterface; const AProc: TConstFunc);
begin
inherited Create(Controller);
FProc := AProc;
@@ -803,4 +823,79 @@ begin
end;
end;
+{ TMycDataJoin }
+
+constructor TMycDataJoin.Create(const ADataProviders: TArray>);
+begin
+ inherited Create;
+
+ SetLength(FReceivers, Length(ADataProviders));
+
+ FLock := TSpinLock.Create(false);
+ FCount := Length(FReceivers);
+
+ FSender := TMycContainedDataProvider>.Create(Self);
+
+ var cFunc :=
+ function(Idx: Integer): TConstFunc
+ begin
+ Result := function(const Value: T): TState begin ProcessData(Idx, Value); end
+ end;
+
+ for var i := 0 to High(FReceivers) do
+ with FReceivers[i] do
+ begin
+ Queue := TQueue.Create;
+ DataProvider := ADataProviders[i];
+ Processor := TMycContainedProcessor.Create(Self, cFunc(i));
+ Tag := DataProvider.Link(Processor);
+ end;
+end;
+
+destructor TMycDataJoin.Destroy;
+begin
+ for var i := High(FReceivers) downto 0 do
+ with FReceivers[i] do
+ begin
+ DataProvider.Unlink(FReceivers[i].Tag);
+ Processor.Free;
+ Queue.Free;
+ end;
+
+ FSender.Free;
+ inherited;
+end;
+
+function TMycDataJoin.ProcessData(Idx: Integer; const Value: T): TState;
+begin
+ var Arr: TArray;
+
+ FLock.Enter;
+ try
+ if FReceivers[Idx].Queue.Count = 0 then
+ dec(FCount);
+
+ if FCount = 0 then
+ begin
+ SetLength(Arr, Length(FReceivers));
+ Arr[Idx] := Value;
+ FCount := Length(FReceivers);
+ for var i := 0 to High(FReceivers) do
+ if i <> Idx then
+ begin
+ Arr[i] := FReceivers[i].Queue.Dequeue;
+ if FReceivers[i].Queue.Count > 0 then
+ dec(FCount);
+ end;
+ end
+ else
+ FReceivers[Idx].Queue.Enqueue(Value);
+ finally
+ FLock.Exit;
+ end;
+
+ if Arr <> nil then
+ FSender.Broadcast(Arr);
+end;
+
end.
diff --git a/Src/Myc.Trade.DataPoint.pas b/Src/Myc.Trade.DataPoint.pas
index d4ce1ce..060eb50 100644
--- a/Src/Myc.Trade.DataPoint.pas
+++ b/Src/Myc.Trade.DataPoint.pas
@@ -6,7 +6,8 @@ uses
Myc.Signals,
Myc.Mutable,
Myc.Trade.Types,
- Myc.Trade.DataArray;
+ Myc.Trade.DataArray,
+ Myc.DataRecord;
type
// A generic interface for components that process data of type T.
@@ -119,6 +120,24 @@ type
class function CreateSequence(Count: Integer; const Parent: TDataProvider): TArray>; overload; static;
class function Parallel(Parent: TDataProvider): TConverter; static;
+
+ class function FieldToRecord(const Layout: TDataRecord.TLayout; const Name: String): TConverter; static;
+ class function FieldOfRecord(const Layout: TDataRecord.TLayout; const Name: String): TConverter; static;
+
+ type
+ TRecordMapping = record
+ Layout: TDataRecord.TLayout;
+ Fields: array of record
+ FromField, ToField: String
+ end;
+ end;
+
+ class function DataMapping(
+ const Inputs: TArray;
+ const Output: TDataRecord.TLayout
+ ): TConverter, TDataRecord>; static;
+
+ class function Join(const DataProviders: TArray>): TDataProvider>; static;
end;
implementation
@@ -315,6 +334,69 @@ begin
Result := TOhlcAggregation.Create(Timeframe);
end;
+class function TConverter.DataMapping(
+ const Inputs: TArray;
+ const Output: TDataRecord.TLayout
+): TConverter, TDataRecord>;
+var
+ Idxs: array of array of record
+ FromIdx, ToIdx: Integer
+ end;
+begin
+ SetLength(Idxs, Length(Inputs));
+ for var i := 0 to High(Idxs) do
+ begin
+ SetLength(Idxs[i], Length(Inputs[i].Fields));
+ for var j := 0 to High(Idxs[i]) do
+ begin
+ Idxs[i][j].FromIdx := Inputs[i].Layout.IndexOf(Inputs[i].Fields[j].FromField);
+ Idxs[i][j].ToIdx := Output.IndexOf(Inputs[i].Fields[j].ToField);
+ end;
+ end;
+
+ Result :=
+ TConverter, TDataRecord>.CreateGeneric(
+ function(const Inputs: TArray): TDataRecord
+ var
+ tmp: array[0..63] of Byte;
+ begin
+ Result := TDataRecord.CreateFrom(Output);
+ for var i := 0 to High(Idxs) do
+ begin
+ for var j := 0 to High(Idxs[i]) do
+ begin
+ Inputs[i].GetValue(Idxs[i][j].FromIdx, tmp);
+ Result.SetValue(Idxs[i][j].ToIdx, tmp);
+ end;
+ end;
+ end
+ );
+end;
+
+class function TConverter.FieldOfRecord(const Layout: TDataRecord.TLayout; const Name: String): TConverter;
+begin
+ var idx := Layout.IndexOf(Name);
+ Result := TConverter.CreateGeneric(function(const Value: TDataRecord): T begin Value.GetValue(idx, Result); end);
+end;
+
+class function TConverter.FieldToRecord(const Layout: TDataRecord.TLayout; const Name: String): TConverter;
+begin
+ var idx := Layout.IndexOf(Name);
+ Result :=
+ TConverter.CreateGeneric(
+ function(const Value: T): TDataRecord
+ begin
+ Result := TDataRecord.CreateFrom(Layout);
+ Result.SetValue(idx, Value);
+ end
+ );
+end;
+
+class function TConverter.Join(const DataProviders: TArray>): TDataProvider>;
+begin
+ Result := TMycDataJoin.Create(DataProviders);
+end;
+
class function TConverter.Parallel(Parent: TDataProvider): TConverter;
begin
Result := TMycParallelConverter.Create;
diff --git a/Src/Myc.Trade.Indicators.pas b/Src/Myc.Trade.Indicators.pas
index 0e20f68..3508e1a 100644
--- a/Src/Myc.Trade.Indicators.pas
+++ b/Src/Myc.Trade.Indicators.pas
@@ -5,6 +5,9 @@ interface
uses
System.SysUtils,
System.Math,
+ System.Generics.Collections,
+ System.Rtti,
+ Myc.DataRecord,
Myc.Trade.Types,
Myc.Trade.DataArray;
@@ -78,8 +81,72 @@ type
const AtrFunc: TConstFunc;
Multiplier: Double
): TConstFunc; overload; static;
+
+ class function CreateMean: TConstFunc, Double>; static;
end;
+ TIndicatorFactory = class
+ type
+ TFunc = TConstFunc;
+ private
+ FParams: TDataRecord.TLayout;
+ FInput: TDataRecord.TLayout;
+ FOutput: TDataRecord.TLayout;
+
+ public
+ constructor Create(const AParams, AInput, AOutput: TDataRecord.TLayout);
+
+ function CreateIndicator(const Params: TDataRecord): TFunc; virtual; abstract;
+
+ property Params: TDataRecord.TLayout read FParams;
+ property Input: TDataRecord.TLayout read FInput;
+ property Output: TDataRecord.TLayout read FOutput;
+ end;
+
+ TEMA = class(TIndicatorFactory)
+ type
+ TParam = record
+ Period: Integer;
+ end;
+
+ TInput = record
+ Price: Double;
+ end;
+
+ TResult = record
+ MA: Double;
+ end;
+
+ public
+ constructor Create;
+ function CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc; override;
+ end;
+
+ TMACD = class
+ type
+ TParam = record
+ Fast: TConstFunc;
+ Slow: TConstFunc;
+ Signal: TConstFunc;
+ end;
+
+ TInput = record
+ Price: Double;
+ end;
+
+ TResult = record
+ MacdLine: Double;
+ SignalLine: Double;
+ Histogram: Double;
+ end;
+
+ public
+ class function CreateMACD(const Param: TParam): TConstFunc; static;
+ end;
+
+var
+ Registry: TList;
+
implementation
{ TIndicators }
@@ -466,4 +533,93 @@ begin
end;
end;
+class function TIndicators.CreateMean: TConstFunc, Double>;
+begin
+ Result :=
+ function(const Value: TArray): Double
+ begin
+ if Length(Value) = 0 then
+ exit(NaN);
+ Result := Value[0];
+ for var i := 1 to High(Value) do
+ Result := Result + Value[i];
+ Result := Result / Length(Value);
+ end;
+end;
+
+// Creates a MACD indicator from three provided moving average functions.
+class function TMACD.CreateMACD(const Param: TParam): TConstFunc;
+begin
+ Result :=
+ function(const Input: TInput): TResult
+ var
+ fastVal, slowVal: Double;
+ begin
+ fastVal := Param.Fast(Input.Price);
+ slowVal := Param.Slow(Input.Price);
+
+ if IsNan(slowVal) then // slowVal will be the last one to become non-NaN
+ begin
+ Result.MacdLine := Double.NaN;
+ Result.SignalLine := Double.NaN;
+ Result.Histogram := Double.NaN;
+ end
+ else
+ begin
+ Result.MacdLine := fastVal - slowVal;
+ Result.SignalLine := Param.Signal(Result.MacdLine);
+ if not IsNan(Result.SignalLine) then
+ Result.Histogram := Result.MacdLine - Result.SignalLine
+ else
+ Result.Histogram := Double.NaN;
+ end;
+ end;
+end;
+
+constructor TEMA.Create;
+begin
+ inherited
+ Create(TDataRecord.TLayout.CreateFrom, TDataRecord.TLayout.CreateFrom, TDataRecord.TLayout.CreateFrom)
+end;
+
+function TEMA.CreateIndicator(const Params: TDataRecord): TIndicatorFactory.TFunc;
+begin
+ var Period := Params.GetValue('Period');
+
+ var Input := TDataRecord.TLayout.CreateFrom;
+ var inPrice := Input.IndexOf('Price');
+
+ var Output := TDataRecord.TLayout.CreateFrom;
+ var outMA := Output.IndexOf('MA');
+
+ var CalcEMA := TIndicators.CreateEMA(Period);
+
+ Result :=
+ function(const Input: TDataRecord): TDataRecord
+ begin
+ var Price: Double;
+ Input.GetValue(inPrice, Price);
+
+ var MA := CalcEMA(Price);
+
+ Result := TDataRecord.CreateFrom(Output);
+ Result.SetValue(outMA, MA);
+ end;
+end;
+
+constructor TIndicatorFactory.Create(const AParams, AInput, AOutput: TDataRecord.TLayout);
+begin
+ inherited Create;
+ FParams := AParams;
+ FInput := AInput;
+ FOutput := AOutput;
+end;
+
+initialization
+ Registry := TList.Create;
+ Registry.Add(TEMA.Create);
+
+finalization
+ Registry.Free;
+
end.
diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr
index d8677e5..81ac9d0 100644
--- a/Test/MycTests.dpr
+++ b/Test/MycTests.dpr
@@ -30,8 +30,7 @@ uses
Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas',
Myc.Mutable in '..\Src\Myc.Mutable.pas',
Test.Core.Mutable in 'Test.Core.Mutable.pas',
- TestDataRecord in 'TestDataRecord.pas',
- TestDataRecord.RawAccess in 'TestDataRecord.RawAccess.pas';
+ TestDataRecord in 'TestDataRecord.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT}
diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj
index a85868c..a956259 100644
--- a/Test/MycTests.dproj
+++ b/Test/MycTests.dproj
@@ -131,7 +131,6 @@ $(PreBuildEvent)]]>
-
Base
diff --git a/Test/TestDataRecord.RawAccess.pas b/Test/TestDataRecord.RawAccess.pas
index 63c12c7..2e5f63f 100644
--- a/Test/TestDataRecord.RawAccess.pas
+++ b/Test/TestDataRecord.RawAccess.pas
@@ -3,6 +3,7 @@ unit TestDataRecord.RawAccess;
interface
uses
+ System.SysuTils,
DUnitX.TestFramework,
Myc.DataRecord;
@@ -26,6 +27,7 @@ uses
type
// A simple interface for testing managed type behavior.
IMyTestInterface = interface
+ ['{1D23E456-AB78-4CD9-89EF-0123456789AB}'] // GUID for good practice, not strictly needed here
function GetValue: integer;
end;
@@ -38,6 +40,8 @@ type
function GetValue: integer;
end;
+{ TMyTestInterfaceImpl }
+
constructor TMyTestInterfaceImpl.Create(const AValue: Integer);
begin
inherited Create;
@@ -52,86 +56,118 @@ end;
procedure TTestDataRecordRawAccess.TestRawAccess_Integer;
var
rec: TDataRecord;
+ buffer: TBytes;
field: TDataRecord.IField;
- readValue, newValue: Integer;
+ initialValue, readValue, newValue: Integer;
begin
- // Arrange: Create a record with an integer field.
+ // Arrange: Create a record layout and its buffer.
var builder := TDataRecord.CreateBuilder;
- builder.AddField('IntField', 123);
+ builder.AddField('IntField');
rec := builder.CreateRec;
field := rec.GetField('IntField');
Assert.IsNotNull(field, 'Field should exist');
- // Act & Assert (GetRaw): Read the initial value via raw pointer.
- readValue := 0;
- field.GetRaw(@readValue);
- Assert.AreEqual(123, readValue, 'GetRaw should retrieve the correct integer value');
+ SetLength(buffer, rec.GetBufferSize);
+ rec.Initialize(buffer);
+ try
+ // Set initial value using raw access
+ initialValue := 123;
+ field.SetRaw(buffer, @initialValue);
- // Act (SetRaw): Set a new value via raw pointer.
- newValue := 456;
- field.SetRaw(@newValue);
+ // Act & Assert (GetRaw): Read the initial value via raw pointer.
+ readValue := 0;
+ field.GetRaw(buffer, @readValue);
+ Assert.AreEqual(123, readValue, 'GetRaw should retrieve the correct integer value');
- // Assert: Verify the new value using the typed accessor.
- var typedField := rec.GetField('IntField');
- Assert.AreEqual(456, typedField.Value, 'SetRaw should update the integer value correctly');
+ // Act (SetRaw): Set a new value via raw pointer.
+ newValue := 456;
+ field.SetRaw(buffer, @newValue);
+
+ // Assert: Verify the new value using the typed accessor.
+ var typedField := rec.GetField('IntField');
+ Assert.AreEqual(456, typedField.Value[buffer], 'SetRaw should update the integer value correctly');
+ finally
+ rec.Finalize(buffer);
+ end;
end;
procedure TTestDataRecordRawAccess.TestRawAccess_Interface;
var
rec: TDataRecord;
+ buffer: TBytes;
field: TDataRecord.IField;
initialObj, readObj, newObj: IMyTestInterface;
begin
- // Arrange: Create a record with an interface field.
- initialObj := TMyTestInterfaceImpl.Create(10);
+ // Arrange: Create a record layout and its buffer.
var builder := TDataRecord.CreateBuilder;
- builder.AddField('IField', initialObj);
+ builder.AddField('IField');
rec := builder.CreateRec;
field := rec.GetField('IField');
Assert.IsNotNull(field, 'Field should exist');
- // Act & Assert (GetRaw): Read the initial interface via raw pointer.
- readObj := nil;
- field.GetRaw(@readObj);
- Assert.IsNotNull(readObj, 'GetRaw should retrieve a non-nil interface');
- Assert.AreSame(initialObj, readObj, 'GetRaw should retrieve the same interface instance');
- Assert.AreEqual(10, readObj.GetValue, 'Value of retrieved interface should be correct');
+ SetLength(buffer, rec.GetBufferSize);
+ rec.Initialize(buffer);
+ try
+ // Set initial value
+ initialObj := TMyTestInterfaceImpl.Create(10);
+ field.SetRaw(buffer, @initialObj);
- // Act (SetRaw): Set a new interface via raw pointer.
- newObj := TMyTestInterfaceImpl.Create(20);
- field.SetRaw(@newObj);
+ // Act & Assert (GetRaw): Read the initial interface via raw pointer.
+ readObj := nil;
+ field.GetRaw(buffer, @readObj);
+ Assert.IsNotNull(readObj, 'GetRaw should retrieve a non-nil interface');
+ Assert.AreSame(initialObj, readObj, 'GetRaw should retrieve the same interface instance');
+ Assert.AreEqual(10, readObj.GetValue, 'Value of retrieved interface should be correct');
- // Assert: Verify the new interface is set correctly.
- var typedField := rec.GetField('IField');
- Assert.AreSame(newObj, typedField.Value, 'SetRaw should update to the new interface instance');
- Assert.AreEqual(20, typedField.Value.GetValue, 'Value of new interface should be correct');
+ // Act (SetRaw): Set a new interface via raw pointer.
+ newObj := TMyTestInterfaceImpl.Create(20);
+ field.SetRaw(buffer, @newObj);
+
+ // Assert: Verify the new interface is set correctly.
+ var typedField := rec.GetField('IField');
+ Assert.AreSame(newObj, typedField.Value[buffer], 'SetRaw should update to the new interface instance');
+ Assert.AreEqual(20, typedField.Value[buffer].GetValue, 'Value of new interface should be correct');
+ finally
+ rec.Finalize(buffer);
+ end;
end;
procedure TTestDataRecordRawAccess.TestRawAccess_String;
var
rec: TDataRecord;
+ buffer: TBytes;
field: TDataRecord.IField;
- readString, newString: string;
+ initialString, readString, newString: string;
begin
- // Arrange: Create a record with a string field.
+ // Arrange: Create a record layout and its buffer.
var builder := TDataRecord.CreateBuilder;
- builder.AddField('StrField', 'Hello');
+ builder.AddField('StrField');
rec := builder.CreateRec;
field := rec.GetField('StrField');
Assert.IsNotNull(field, 'Field should exist');
- // Act & Assert (GetRaw): Read the initial string via raw pointer.
- readString := '';
- field.GetRaw(@readString);
- Assert.AreEqual('Hello', readString, 'GetRaw should retrieve the correct string value');
+ SetLength(buffer, rec.GetBufferSize);
+ rec.Initialize(buffer);
+ try
+ // Set initial value
+ initialString := 'Hello';
+ field.SetRaw(buffer, @initialString);
- // Act (SetRaw): Set a new string via raw pointer.
- newString := 'World';
- field.SetRaw(@newString);
+ // Act & Assert (GetRaw): Read the initial string via raw pointer.
+ readString := '';
+ field.GetRaw(buffer, @readString);
+ Assert.AreEqual('Hello', readString, 'GetRaw should retrieve the correct string value');
- // Assert: Verify the new string using the typed accessor.
- var typedField := rec.GetField('StrField');
- Assert.AreEqual('World', typedField.Value, 'SetRaw should update the string value correctly');
+ // Act (SetRaw): Set a new string via raw pointer.
+ newString := 'World';
+ field.SetRaw(buffer, @newString);
+
+ // Assert: Verify the new string using the typed accessor.
+ var typedField := rec.GetField('StrField');
+ Assert.AreEqual('World', typedField.Value[buffer], 'SetRaw should update the string value correctly');
+ finally
+ rec.Finalize(buffer);
+ end;
end;
initialization
diff --git a/Test/TestDataRecord.pas b/Test/TestDataRecord.pas
index 7139c57..e17f62d 100644
--- a/Test/TestDataRecord.pas
+++ b/Test/TestDataRecord.pas
@@ -3,472 +3,146 @@ unit TestDataRecord;
interface
uses
+ DunitX.TestFramework,
System.SysUtils,
- System.Classes,
- System.Variants,
- DUnitX.TestFramework,
+ System.DateUtils,
Myc.DataRecord;
type
- // Helper types for various TypeKind tests
- TTestEnum = (teOne, teTwo, teThree);
- TTestSet = set of TTestEnum;
-
- TTestRecord = record
- I: Integer;
- S: string;
- end;
-
- TTestMRecord = record
- private
- FData: TArray;
- class operator Initialize(out Dest: TTestMRecord);
- class operator Finalize(var Dest: TTestMRecord);
- end;
-
- ITestInterface = interface
- ['{B1E5119C-A2B4-43C1-99C1-39B6A687363E}']
- function GetValue: Integer;
- end;
-
- TTestClass = class(TInterfacedObject, ITestInterface)
- private
- FValue: Integer;
- public
- constructor Create(AValue: Integer);
- function GetValue: Integer;
+ // A record that contains all supported data types for testing
+ TMyTestRecord = record
+ MyInteger: Integer;
+ MyInt64: Int64;
+ MySingle: Single;
+ MyDouble: Double;
+ MyString: string;
+ MyTimestamp: TDateTime;
end;
[TestFixture]
- TDataRecordTests = class
- private
- function CreateRecord(const FieldName: string; const Value: T): TDataRecord;
+ TTestDataRecord = class(TObject)
public
- // Test procedures are unchanged
[Test]
- [TestCase('TestZero', '0')]
- [TestCase('TestPositive', '123')]
- [TestCase('TestNegative', '-456')]
- procedure Test_tkInteger_Succeeds(const AValue: Integer);
+ procedure TestLayoutCreation;
[Test]
- [TestCase('TestZero', '0')]
- [TestCase('TestPositive', '1234567890123')]
- [TestCase('TestNegative', '-9876543210987')]
- procedure Test_tkInt64_Succeeds(const AValue: Int64);
+ procedure TestCreateFromInstanceAndGetValue;
[Test]
- procedure Test_tkFloat_Single_Succeeds;
-
- [Test]
- procedure Test_tkFloat_Double_Succeeds;
-
- [Test]
- [TestCase('Test_A', 'A')]
- procedure Test_tkChar_Succeeds(const AValue: Char);
-
- [Test]
- [TestCase('TestEmpty', '')]
- [TestCase('TestSimple', 'Hello World')]
- procedure Test_tkString_NonGeneric_Succeeds(const AValue: string);
-
- [Test]
- [TestCase('TestLeak', 'This test will leak memory')]
- procedure Test_tkString_Generic_LeaksMemory(const AValue: string);
-
- [Test]
- procedure Test_tkEnumeration_Succeeds;
-
- [Test]
- procedure Test_tkSet_Succeeds;
-
- [Test]
- procedure Test_tkRecord_Succeeds;
-
- [Test]
- procedure Test_tkMRecord_Succeeds;
-
- [Test]
- procedure Test_tkDynArray_Succeeds;
-
- [Test]
- procedure Test_tkInterface_Succeeds;
-
- [Test]
- procedure Test_tkClass_Succeeds_With_Manual_Cleanup;
-
- [Test]
- procedure Test_tkVariant_Succeeds;
-
- [Test]
- procedure Test_Assign_CreatesIndependentCopy;
-
- [Test]
- procedure Test_Reassign_ReleasesOldData;
-
- // New tests for RTTI-based creation and assignment
- [Test]
- [IgnoreMemoryLeaks]
- procedure Test_CreateFrom_AssignTo_Succeeds;
-
- [Test]
- [IgnoreMemoryLeaks]
- procedure Test_Assign_FromCreateFrom_IsIndependentCopy;
+ procedure TestSetValueAndGetValue;
end;
implementation
uses
- System.TypInfo,
System.Rtti;
-{ TDataRecordTests }
+{ TTestDataRecord }
-function TDataRecordTests.CreateRecord(const FieldName: string; const Value: T): TDataRecord;
+procedure TTestDataRecord.TestLayoutCreation;
var
- // Use the TBuilder helper record. Its lifetime is managed automatically.
- builder: TDataRecord.TBuilder;
+ layout: TDataRecord.TRecordLayout;
+ idx: Integer;
+ expectedSize: Integer;
begin
- builder := TDataRecord.CreateBuilder;
- builder.AddField(FieldName, Value);
- Result := builder.CreateRec;
+ // Test: Create layout from a record type
+ layout := TDataRecord.TRecordLayout.CreateFrom;
+
+ // Assert: Check field count
+ Assert.IsTrue(Length(layout.Fields) = 6, 'Layout should have 6 fields');
+
+ // Assert: Check specific fields for correct type mapping
+ idx := layout.IndexOf('MyInteger');
+ Assert.IsTrue(idx > -1, 'Field MyInteger not found');
+ Assert.AreEqual(TDataFieldType.dfInteger, layout.Fields[idx].FieldType, 'MyInteger should be mapped to dfInteger');
+
+ idx := layout.IndexOf('MyString');
+ Assert.IsTrue(idx > -1, 'Field MyString not found');
+ Assert.AreEqual(TDataFieldType.dfString, layout.Fields[idx].FieldType, 'MyString should be mapped to dfString');
+
+ idx := layout.IndexOf('MySingle');
+ Assert.IsTrue(idx > -1, 'Field MySingle not found');
+ Assert.AreEqual(TDataFieldType.dfFloat, layout.Fields[idx].FieldType, 'MySingle should be mapped to dfFloat');
+
+ idx := layout.IndexOf('MyTimestamp');
+ Assert.IsTrue(idx > -1, 'Field MyTimestamp not found');
+ Assert.AreEqual(TDataFieldType.dfTimestamp, layout.Fields[idx].FieldType, 'MyTimestamp should be mapped to dfTimestamp');
+
+ // Assert: Check total buffer size (6 fields * 8 bytes each on x64 due to type promotion and alignment)
+ expectedSize := (sizeof(Int64) * 2) + (sizeof(Double) * 2) + sizeof(String) + sizeof(TDateTime);
+ Assert.AreEqual(expectedSize, layout.GetBufferSize, 'Buffer size calculation is incorrect');
end;
-procedure TDataRecordTests.Test_tkInteger_Succeeds(const AValue: Integer);
+procedure TTestDataRecord.TestCreateFromInstanceAndGetValue;
var
- rec: TDataRecord;
- field: TDataRecord.IField;
+ srcRecord: TMyTestRecord;
+ dataRecord: TDataRecord;
begin
- rec := CreateRecord('Value', AValue);
- field := rec.GetField('Value');
- Assert.IsNotNull(field, 'Field should not be null');
- Assert.AreEqual(AValue, field.Value, 'Value should be equal');
+ // Setup: Create and populate a source record
+ srcRecord.MyInteger := 12345;
+ srcRecord.MyInt64 := 9876543210;
+ srcRecord.MySingle := 123.456;
+ srcRecord.MyDouble := 789.012345;
+ srcRecord.MyString := 'Hello Delphi!';
+ srcRecord.MyTimestamp := EncodeDateTime(2024, 7, 19, 10, 30, 0, 0);
+
+ // Test: Create a TDataRecord from the source record instance
+ dataRecord := TDataRecord.CreateFrom(srcRecord);
+
+ // Assert: Retrieve each value and check for correctness
+ Assert.AreEqual(srcRecord.MyInt64, dataRecord.GetValue('MyInt64'), 'Int64 value mismatch');
+ Assert.AreEqual(srcRecord.MyInteger, dataRecord.GetValue('MyInteger'), 'Integer value mismatch');
+ Assert.AreEqual(srcRecord.MyString, dataRecord.GetValue('MyString'), 'String value mismatch');
+ Assert.AreEqual(srcRecord.MyTimestamp, dataRecord.GetValue('MyTimestamp'), 'TDateTime value mismatch');
+
+ // Assert: Check float values with a tolerance for precision differences
+ Assert.AreEqual(srcRecord.MySingle, dataRecord.GetValue('MySingle'), 1e-6, 'Single value mismatch');
+ Assert.AreEqual(srcRecord.MyDouble, dataRecord.GetValue('MyDouble'), 1e-9, 'Double value mismatch');
+
+ // Assert: Test type promotion (reading an Integer as Int64)
+ Assert.IsTrue(srcRecord.MyInteger = dataRecord.GetValue('MyInteger'), 'Integer to Int64 promotion failed');
end;
-procedure TDataRecordTests.Test_tkInt64_Succeeds(const AValue: Int64);
+procedure TTestDataRecord.TestSetValueAndGetValue;
var
- rec: TDataRecord;
- field: TDataRecord.IField;
+ dataRecord: TDataRecord;
+ testInt: Integer;
+ testInt64: Int64;
+ testSingle: Single;
+ testDouble: Double;
+ testString: string;
+ testTimestamp: TDateTime;
begin
- rec := CreateRecord('Value', AValue);
- field := rec.GetField('Value');
- Assert.IsNotNull(field, 'Field should not be null');
- Assert.AreEqual(AValue, field.Value, 'Value should be equal');
-end;
+ // Setup: Create an empty TDataRecord with the layout of TMyTestRecord
+ dataRecord := TDataRecord.CreateFrom;
-procedure TDataRecordTests.Test_tkFloat_Single_Succeeds;
-const
- TEST_VAL: Single = 3.14;
-var
- rec: TDataRecord;
- field: TDataRecord.IField;
-begin
- rec := CreateRecord('Value', TEST_VAL);
- field := rec.GetField('Value');
- Assert.IsNotNull(field, 'Field should not be null');
- Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal');
-end;
+ // Setup: Define test values
+ testInt := 54321;
+ testInt64 := 12345678901;
+ testSingle := 987.654;
+ testDouble := 543.210987;
+ testString := 'Testing SetValue';
+ testTimestamp := Now;
-procedure TDataRecordTests.Test_tkFloat_Double_Succeeds;
-const
- TEST_VAL: Double = 123.456;
-var
- rec: TDataRecord;
- field: TDataRecord.IField;
-begin
- rec := CreateRecord('Value', TEST_VAL);
- field := rec.GetField('Value');
- Assert.IsNotNull(field, 'Field should not be null');
- Assert.AreEqual(TEST_VAL, field.Value, 'Value should be equal');
-end;
+ // Test: Set values for each field by name
+ dataRecord.SetValue('MyInteger', testInt);
+ dataRecord.SetValue('MyInt64', testInt64);
+ dataRecord.SetValue('MySingle', testSingle);
+ dataRecord.SetValue('MyDouble', testDouble);
+ dataRecord.SetValue('MyString', testString);
+ dataRecord.SetValue('MyTimestamp', testTimestamp);
-procedure TDataRecordTests.Test_tkChar_Succeeds(const AValue: Char);
-var
- rec: TDataRecord;
- field: TDataRecord.IField;
-begin
- rec := CreateRecord('Value', AValue);
- field := rec.GetField