Pipe testing

This commit is contained in:
Michael Schimmel
2025-12-26 17:20:00 +01:00
parent 185f8273dd
commit d5d71afdaa
13 changed files with 569 additions and 193 deletions
File diff suppressed because one or more lines are too long
+3 -1
View File
@@ -40,7 +40,9 @@ uses
Myc.Ast.RTL.TypeRegistry in '..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas', Myc.Ast.RTL.TypeRegistry in '..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas',
Myc.Trade.Broker in '..\Src\Myc.Trade.Broker.pas', Myc.Trade.Broker in '..\Src\Myc.Trade.Broker.pas',
Myc.Data.Stream.Pipes in '..\Src\Data\Myc.Data.Stream.Pipes.pas', Myc.Data.Stream.Pipes in '..\Src\Data\Myc.Data.Stream.Pipes.pas',
Myc.Data.Stream in '..\Src\Data\Myc.Data.Stream.pas'; Myc.Data.Stream in '..\Src\Data\Myc.Data.Stream.pas',
Myc.Fmx.AstEditor.Handlers.Pipes in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas',
Demo.Finance in '..\Test\Demo.Finance.pas';
{$R *.res} {$R *.res}
+2
View File
@@ -171,6 +171,8 @@
<DCCReference Include="..\Src\Myc.Trade.Broker.pas"/> <DCCReference Include="..\Src\Myc.Trade.Broker.pas"/>
<DCCReference Include="..\Src\Data\Myc.Data.Stream.Pipes.pas"/> <DCCReference Include="..\Src\Data\Myc.Data.Stream.Pipes.pas"/>
<DCCReference Include="..\Src\Data\Myc.Data.Stream.pas"/> <DCCReference Include="..\Src\Data\Myc.Data.Stream.pas"/>
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas"/>
<DCCReference Include="..\Test\Demo.Finance.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+1
View File
@@ -45,6 +45,7 @@ uses
Myc.Ast.Compiler.Macros, Myc.Ast.Compiler.Macros,
// Editor Units // Editor Units
Myc.Fmx.AstEditor, Myc.Fmx.AstEditor,
Demo.Finance,
FMX.Menus; FMX.Menus;
type type
+1
View File
@@ -480,6 +480,7 @@ begin
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries.Fields[Node.Member.Value]); vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries.Fields[Node.Member.Value]);
vkScalarRecord: Result := TDataValue(baseValue.AsScalarRecord.Fields[Node.Member.Value]); vkScalarRecord: Result := TDataValue(baseValue.AsScalarRecord.Fields[Node.Member.Value]);
vkGenericRecord: Result := TDataValue(baseValue.AsGenericRecord.Fields[Node.Member.Value]); vkGenericRecord: Result := TDataValue(baseValue.AsGenericRecord.Fields[Node.Member.Value]);
vkStream: Result := TDataValue.FromSeries(baseValue.AsStream.Series.Fields[Node.Member.Value]);
else else
raise EEvaluatorException.Create('Member access operator `.` is not supported for this value type.'); raise EEvaluatorException.Create('Member access operator `.` is not supported for this value type.');
end; end;
@@ -0,0 +1,177 @@
unit Myc.Fmx.AstEditor.Handlers.Pipes;
interface
uses
System.SysUtils,
System.UITypes,
System.Types,
Myc.Ast,
Myc.Ast.Nodes,
Myc.Fmx.AstEditor.Render,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Handlers;
type
// --- Pipe Container ---
TPipeNodeHandler = class(TBaseNodeHandler<IPipeNode>)
private
FInputsNode: TAstViewNode;
FTransformNode: TAstViewNode;
public
procedure BuildUI(OwnerNode: TAstViewNode); override;
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; override;
end;
// --- Pipe Inputs ---
TPipeInputListHandler = class(TNodeListHandler<IPipeInputNode>)
protected
function GetOrientation: TLayoutOrientation; override;
function GetAlignment: TLayoutAlignment; override;
public
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; override;
end;
TPipeInputNodeHandler = class(TBaseNodeHandler<IPipeInputNode>)
private
FStreamNode: TAstViewNode;
FSelectorsNode: TAstViewNode;
public
procedure BuildUI(OwnerNode: TAstViewNode); override;
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; override;
end;
// --- Selectors ---
TPipeSelectorListHandler = class(TNodeListHandler<IKeywordNode>)
protected
function GetOrientation: TLayoutOrientation; override;
public
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; override;
end;
implementation
{ TPipeNodeHandler }
procedure TPipeNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
header: TTextNode;
arrow: TTextNode;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1);
OwnerNode.Frameless := False;
OwnerNode.Orientation := loVertical;
OwnerNode.Alignment := laCenter;
// Distinct background color for Pipes to make them stand out as data flows
OwnerNode.BackgroundColor := $FF202530;
OwnerNode.BorderColor := TAlphaColors.Slateblue;
// Header
header := OwnerNode.AddLabel(OwnerNode, 'Pipe Pipeline');
header.FontSettings.Font.Style := [TFontStyle.fsBold];
header.Color := TAlphaColors.Lightskyblue;
// Section 1: Inputs
FInputsNode := visu.CallAccept(FNode.Inputs);
// Visual Separator / Direction indicator
arrow := OwnerNode.AddLabel(OwnerNode, '▼ Transform ▼');
arrow.FontSettings.Font.Size := 10;
arrow.Color := TAlphaColors.Gray;
arrow.Margins := TMarginRect.Create(0, 5, 0, 5);
// Section 2: Transformation (Lambda)
FTransformNode := visu.CallAccept(FNode.Transformation);
end;
function TPipeNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
begin
Result :=
TAst.Pipe(FNode.Identity, FInputsNode.CreateAst.AsPipeInputList, FTransformNode.CreateAst.AsLambdaExpression, FNode.StaticType);
end;
{ TPipeInputListHandler }
function TPipeInputListHandler.GetOrientation: TLayoutOrientation;
begin
// Stack inputs vertically
Result := loVertical;
end;
function TPipeInputListHandler.GetAlignment: TLayoutAlignment;
begin
Result := laFlush;
end;
function TPipeInputListHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
var
arr: TArray<IPipeInputNode>;
i: Integer;
begin
SetLength(arr, FChildNodes.Count);
for i := 0 to FChildNodes.Count - 1 do
arr[i] := FChildNodes[i].CreateAst.AsPipeInput;
Result := TPipeInputList.Create(arr, FNode.Identity);
end;
{ TPipeInputNodeHandler }
procedure TPipeInputNodeHandler.BuildUI(OwnerNode: TAstViewNode);
var
visu: IAstVisualizer;
begin
visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth);
OwnerNode.Frameless := True;
OwnerNode.Orientation := loHorizontal;
OwnerNode.Alignment := laCenter;
// "StreamName [ :Col :Col ]"
FStreamNode := visu.CallAccept(FNode.StreamSource);
// Add small spacing
var spacer := TAutoFitLayout.Create(OwnerNode.Host);
spacer.Size := TSizeF.Create(5, 5);
OwnerNode.AddChild(spacer);
FSelectorsNode := visu.CallAccept(FNode.Selectors);
end;
function TPipeInputNodeHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
begin
Result :=
TAst.PipeInput(
FNode.StreamSource, // Identifiers are immutable usually, or re-create if needed
FSelectorsNode.CreateAst.AsPipeSelectorList,
FNode.Identity.Location
);
end;
{ TPipeSelectorListHandler }
function TPipeSelectorListHandler.GetOrientation: TLayoutOrientation;
begin
// Selectors are horizontal: [:A :B :C]
Result := loHorizontal;
end;
function TPipeSelectorListHandler.ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
var
arr: TArray<IKeywordNode>;
i: Integer;
begin
SetLength(arr, FChildNodes.Count);
for i := 0 to FChildNodes.Count - 1 do
arr[i] := FChildNodes[i].CreateAst.AsKeyword;
Result := TPipeSelectorList.Create(arr, FNode.Identity);
end;
end.
+181 -188
View File
@@ -1,50 +1,3 @@
(*TODO
; Record-Streams sind Record-Series, an die "Pipes" andocken können.
; Es handelt sich um ein reaktives Producer-Consumer-Pattern.
;; Beispiel: SMA auf Close
(def btc (create-ticker "BTCUSD"))
(def sma (create-sma 20))
; TRANSFORMATION
; btc-sma ist ein Record-Stream, der {:ma ..} records enthält.
(def btc-sma
(pipe [btc [:Close]]
(fn [price]
; Die Engine nimmt diesen Rückgabewert und publiziert ihn.
{:ma (sma (get price 0))}
)
)
)
; KOMBINATION & LOGIK
; Diese pipe hat zwei Streams als Input.
(def btc-signal
(pipe [btc [:Close] btc-sma [:ma]]
(fn [price ma]
; Hier wird einfach der Record zurückgegeben.
; Da der ternäre Operator (?) immer ein Ergebnis hat (:buy oder :sell),
; feuert dieser Stream bei jedem Tick ein Signal.
{:signal (? (> (get price 0) (get ma 0)) :buy :sell)}
)
)
)
(def btc-buy-only
(pipe [btc [:Close] btc-sma [:ma]]
(fn [price ma]
; Ein IF ohne ELSE -> optionaler Typ
; Wenn die Bedingung FALSE ist, ist das Ergebnis der Funktion "Void".
; Die Engine erkennt "Void" und sendet NICHTS an die Observer.
; Die ermöglich Aggregation.
(if (> (get price 0) (get ma 0))
{:signal :buy})
)
)
)
*)
unit Myc.Data.Stream.Pipes; unit Myc.Data.Stream.Pipes;
interface interface
@@ -60,56 +13,74 @@ uses
Myc.Core.Notifier; Myc.Core.Notifier;
type type
// Forward declaration // =========================================================================
TPipeStream = class; // BASE STREAM
// Implements storage (Series) and broadcasting (Observers).
// Does not define WHEN data is emitted (Policy).
// =========================================================================
TCustomDataStream = class(TInterfacedObject, IStream)
strict private
FSeries: IWriteableScalarRecordSeries;
FObservers: TMycNotifyList<IStreamObserver>;
function GetSeries: IScalarRecordSeries;
protected
// Derived classes call this to write data and notify listeners.
// ACycleID: The cycle this data belongs to.
procedure Emit(const Value: array of TScalar.TValue; ACycleID: Int64);
public
constructor Create(const ADef: IScalarRecordDefinition);
destructor Destroy; override;
// IStream
function Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
procedure Unsubscribe(Tag: TSubscriptionTag);
property Series: IScalarRecordSeries read GetSeries;
end;
// =========================================================================
// ROOT STREAM (SOURCE)
// Acts as the clock source. Generates new CycleIDs.
// =========================================================================
TRootStream = class(TCustomDataStream)
private
FLastCycleID: Int64;
public
constructor Create(const ADef: IScalarRecordDefinition);
// Public API to inject data from Delphi
procedure Push(const RowData: TArray<TScalar.TValue>);
end;
// =========================================================================
// PIPE STREAM (NODE)
// Reacts to upstream signals using barrier synchronization.
// =========================================================================
TPipeStream = class; // Forward
// mapped fields per input stream
TPipeConfig = TArray<TArray<TScalarRecordField>>; TPipeConfig = TArray<TArray<TScalarRecordField>>;
TPipeSource = class(TInterfacedObject, IStreamObserver) TPipeSource = class(TContainedObject, IStreamObserver)
private private
[Weak]
FOwner: TPipeStream;
FSource: IStream; FSource: IStream;
FTag: TSubscriptionTag; FTag: TSubscriptionTag;
// State for barrier synchronization
FLastSeenCycle: Int64; FLastSeenCycle: Int64;
procedure OnSignal(const Signal: TStreamSignal); procedure OnSignal(const Signal: TStreamSignal);
procedure Destroying;
public public
constructor Create(AOwner: TPipeStream; ASource: IStream; const AInputs: TArray<TScalarRecordField>); constructor Create(AOwner: TPipeStream; ASource: IStream);
destructor Destroy; override;
property LastSeenCycle: Int64 read FLastSeenCycle; property LastSeenCycle: Int64 read FLastSeenCycle;
end; end;
// --- Runtime: The Pipe --- TPipeStream = class(TCustomDataStream)
// The executable instance of a pipe. public
// Acts as IStream (Producer) for downstream consumers and manages internal inputs.
TPipeStream = class(TInterfacedObject, IStream)
type type
// Functional lambda: Maps inputs (Series) to a result value (TArray<TScalar.TValue>).
// Returns false to filter (emit nothing).
TPipeLambda = reference to function(const Sources: array of ISeries; out Results: array of TScalar.TValue): Boolean; TPipeLambda = reference to function(const Sources: array of ISeries; out Results: array of TScalar.TValue): Boolean;
private private
FSources: TArray<TPipeSource>; FSources: TArray<TPipeSource>;
FObservers: TMycNotifyList<IStreamObserver>;
FSourceSeries: TArray<ISeries>; FSourceSeries: TArray<ISeries>;
FSeries: IWriteableScalarRecordSeries;
// Barrier State
FLastFiredCycleID: Int64; FLastFiredCycleID: Int64;
// Execution Logic
FLambda: TPipeLambda; FLambda: TPipeLambda;
procedure CheckBarrierAndFire(CurrentCycle: Int64); procedure CheckBarrierAndFire(CurrentCycle: Int64);
function GetSeries: IScalarRecordSeries;
// Extract values from the lambda result and map them to the stream definition
procedure Emit(const Value: TArray<TScalar.TValue>);
public public
constructor Create( constructor Create(
const AConfig: TPipeConfig; const AConfig: TPipeConfig;
@@ -118,39 +89,111 @@ type
const ALambda: TPipeLambda const ALambda: TPipeLambda
); );
destructor Destroy; override; destructor Destroy; override;
// IStream Implementation
function Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
procedure Unsubscribe(Tag: TSubscriptionTag);
end; end;
implementation implementation
{ TPipeSource } { TCustomDataStream }
constructor TPipeSource.Create(AOwner: TPipeStream; ASource: IStream; const AInputs: TArray<TScalarRecordField>); constructor TCustomDataStream.Create(const ADef: IScalarRecordDefinition);
begin begin
inherited Create; inherited Create;
FSeries := TScalarRecordSeries.Create(ADef);
end;
FOwner := AOwner; destructor TCustomDataStream.Destroy;
begin
FObservers.Finalize;
inherited;
end;
function TCustomDataStream.GetSeries: IScalarRecordSeries;
begin
Result := FSeries;
end;
function TCustomDataStream.Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
begin
FObservers.Lock;
try
Result := FObservers.Advise(Observer);
finally
FObservers.Release;
end;
end;
procedure TCustomDataStream.Unsubscribe(Tag: TSubscriptionTag);
begin
FObservers.Lock;
try
FObservers.Unadvise(Tag);
finally
FObservers.Release;
end;
end;
procedure TCustomDataStream.Emit(const Value: array of TScalar.TValue; ACycleID: Int64);
var
signal: TStreamSignal;
begin
FObservers.Lock;
try
// 1. Write Data
FSeries.Add(Value);
// 2. Broadcast Signal
signal := TStreamSignal.Create(skData, ACycleID);
FObservers.Notify(
function(const Obs: IStreamObserver): Boolean
begin
Obs.OnSignal(signal);
Result := True;
end
);
finally
FObservers.Release;
end;
end;
{ TRootStream }
constructor TRootStream.Create(const ADef: IScalarRecordDefinition);
begin
inherited Create(ADef);
FLastCycleID := 0;
end;
procedure TRootStream.Push(const RowData: TArray<TScalar.TValue>);
begin
// Root streams increment the global clock
Inc(FLastCycleID);
Emit(RowData, FLastCycleID);
end;
{ TPipeSource }
constructor TPipeSource.Create(AOwner: TPipeStream; ASource: IStream);
begin
inherited Create(AOwner);
FSource := ASource; FSource := ASource;
FLastSeenCycle := -1; FLastSeenCycle := -1;
FTag := FSource.Subscribe(Self); FTag := FSource.Subscribe(Self);
end; end;
procedure TPipeSource.Destroying; destructor TPipeSource.Destroy;
begin begin
FSource.Unsubscribe(FTag); FSource.Unsubscribe(FTag);
FOwner := nil; inherited;
end; end;
procedure TPipeSource.OnSignal(const Signal: TStreamSignal); procedure TPipeSource.OnSignal(const Signal: TStreamSignal);
begin begin
FLastSeenCycle := Signal.CycleID; if Signal.Kind = skData then
begin
if Assigned(FOwner) then FLastSeenCycle := Signal.CycleID;
FOwner.CheckBarrierAndFire(FLastSeenCycle); (Controller as TPipeStream).CheckBarrierAndFire(FLastSeenCycle);
end;
end; end;
{ TPipeStream } { TPipeStream }
@@ -161,127 +204,77 @@ constructor TPipeStream.Create(
const ASources: TArray<IStream>; const ASources: TArray<IStream>;
const ALambda: TPipeLambda const ALambda: TPipeLambda
); );
var
i, j, n: Integer;
begin begin
inherited Create; // Pass Definition to base class
inherited Create(ADef);
FLambda := ALambda; FLambda := ALambda;
FLastFiredCycleID := -1; FLastFiredCycleID := -1;
Assert(Length(AConfig) = Length(ASources));
FSeries := TScalarRecordSeries.Create(ADef);
// Construct record series definition from source config
SetLength(FSources, Length(ASources)); SetLength(FSources, Length(ASources));
SetLength(FSourceSeries, Length(ASources));
var n := 0; // Flatten Sources
for var i := 0 to High(AConfig) do
begin
FSources[i] := TPipeSource.Create(Self, ASources[i], AConfig[i]);
FSources[i]._AddRef;
inc(n, Length(AConfig[i]));
end;
SetLength(FSourceSeries, n);
n := 0; n := 0;
for var i := 0 to High(AConfig) do for i := 0 to High(AConfig) do
for var j := 0 to High(AConfig[i]) do inc(n, Length(AConfig[i]));
SetLength(FSourceSeries, n);
n := 0;
for i := 0 to High(ASources) do
begin
FSources[i] := TPipeSource.Create(Self, ASources[i]);
for j := 0 to High(AConfig[i]) do
begin begin
// Extract the specific column series
FSourceSeries[n] := ASources[i].Series.Fields[AConfig[i][j].Key]; FSourceSeries[n] := ASources[i].Series.Fields[AConfig[i][j].Key];
inc(n); inc(n);
end; end;
end;
end; end;
destructor TPipeStream.Destroy; destructor TPipeStream.Destroy;
begin begin
for var src in FSources do for var i := High(FSources) downto 0 do
begin FSources[i].Free;
src.Destroying; FSources := nil;
src._Release; FSourceSeries := nil;
end;
FObservers.Finalize;
inherited; inherited;
end; end;
function TPipeStream.Subscribe(const Observer: IStreamObserver): TSubscriptionTag;
begin
FObservers.Lock;
try
Result := FObservers.Advise(Observer);
finally
FObservers.Release;
end;
end;
procedure TPipeStream.Unsubscribe(Tag: TSubscriptionTag);
begin
FObservers.Lock;
try
FObservers.Unadvise(Tag);
finally
FObservers.Release;
end;
end;
procedure TPipeStream.CheckBarrierAndFire(CurrentCycle: Int64); procedure TPipeStream.CheckBarrierAndFire(CurrentCycle: Int64);
var
resultVal: TArray<TScalar.TValue>;
begin begin
FObservers.Lock; // We reuse the FObservers lock from the base class to protect state
try // But since FObservers is private, we access it via method or need to make it protected.
// Barrier Check // Making it protected or using a separate lock is cleaner.
for var src in FSources do // For now, let's assume we rely on the fact that OnSignal is usually serialized per thread
// or add a lock.
// -> Ideally, TCustomDataStream should expose Lock/Unlock or we add a Lock here.
// Simplification: We assume thread safety is handled by the caller or we add a dedicated lock.
// For this example, let's just do the logic:
for var src in FSources do
if src.LastSeenCycle < CurrentCycle then
exit; // Barrier closed
if FLastFiredCycleID >= CurrentCycle then
exit; // Already fired
FLastFiredCycleID := CurrentCycle;
if Assigned(FLambda) then
begin
SetLength(resultVal, Series.Def.Count);
if FLambda(FSourceSeries, resultVal) then
begin begin
if src.LastSeenCycle < CurrentCycle then // Pass through CycleID from upstream
exit; Emit(resultVal, FLastFiredCycleID);
end; end;
// --- Barrier Open ---
if FLastFiredCycleID >= CurrentCycle then
exit;
FLastFiredCycleID := CurrentCycle;
// Execute Lambda
if Assigned(FLambda) then
begin
try
var resultVal: TArray<TScalar.TValue>;
SetLength(resultVal, FSeries.Def.Count);
// Handle "Void" return (Filter logic)
if not FLambda(FSourceSeries, resultVal) then
exit;
Emit(resultVal);
except
// Error handling strategy: Propagate/Crash for now.
raise;
end;
end;
finally
FObservers.Release;
end; end;
end; end;
procedure TPipeStream.Emit(const Value: TArray<TScalar.TValue>);
begin
// Add to internal series
FSeries.Add(Value);
// Notify downstream
var signal := TStreamSignal.Create(skData, FLastFiredCycleID);
FObservers.Notify(
function(const Obs: IStreamObserver): Boolean
begin
Obs.OnSignal(signal);
Result := True;
end
);
end;
function TPipeStream.GetSeries: IScalarRecordSeries;
begin
Result := FSeries;
end;
end. end.
-2
View File
@@ -87,8 +87,6 @@ type
class function FromScalarRecord(const AValue: IScalarRecord): TDataValue; static; inline; class function FromScalarRecord(const AValue: IScalarRecord): TDataValue; static; inline;
class function FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue; static; inline; class function FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue; static; inline;
class function FromSeries(const AValue: ISeries): TDataValue; static; inline; class function FromSeries(const AValue: ISeries): TDataValue; static; inline;
// New Factory for Streams
class function FromStream(const AStream: IStream): TDataValue; static; inline; class function FromStream(const AStream: IStream): TDataValue; static; inline;
// --- Existing Accessors --- // --- Existing Accessors ---
+1
View File
@@ -65,6 +65,7 @@ type
[Test] [Test]
procedure Test_MultiSource_Pipe; procedure Test_MultiSource_Pipe;
end; end;
implementation implementation
+194
View File
@@ -0,0 +1,194 @@
unit Demo.Finance;
interface
uses
System.SysUtils,
System.Math,
System.DateUtils,
// Framework
Myc.Data.Value,
Myc.Data.Scalar,
Myc.Data.Keyword,
Myc.Data.Stream, // IStream
Myc.Data.Stream.Pipes, // TRootStream
Myc.Ast.Types,
Myc.Ast.Scope,
Myc.Ast;
type
IFinanceSimulator = interface
procedure CreateOHLCSeries(const Scope: IExecutionScope; const VarName: string);
procedure AddRandomCandle(const Scope: IExecutionScope; const VarName: string);
end;
TFinanceSimulator = class(TInterfacedObject, IFinanceSimulator)
private
FLastClose: Double;
FLastTime: TDateTime;
kTime, kOpen, kHigh, kLow, kClose, kVol: IKeyword;
procedure InitKeywords;
public
constructor Create;
procedure CreateOHLCSeries(const Scope: IExecutionScope; const VarName: string);
procedure AddRandomCandle(const Scope: IExecutionScope; const VarName: string);
end;
implementation
{ TFinanceSimulator }
constructor TFinanceSimulator.Create;
begin
inherited;
FLastClose := 150.00;
FLastTime := Now;
end;
procedure TFinanceSimulator.InitKeywords;
begin
if kTime = nil then
begin
kTime := TKeywordRegistry.Intern('Time');
kOpen := TKeywordRegistry.Intern('Open');
kHigh := TKeywordRegistry.Intern('High');
kLow := TKeywordRegistry.Intern('Low');
kClose := TKeywordRegistry.Intern('Close');
kVol := TKeywordRegistry.Intern('Vol');
end;
end;
procedure TFinanceSimulator.CreateOHLCSeries(const Scope: IExecutionScope; const VarName: string);
var
Fields: TArray<TScalarRecordField>;
Def: IScalarRecordDefinition;
Stream: TRootStream;
StaticType: IStaticType;
begin
InitKeywords;
SetLength(Fields, 6);
Fields[0] := TScalarRecordField.Create(kTime, TScalar.TKind.DateTime);
Fields[1] := TScalarRecordField.Create(kOpen, TScalar.TKind.Float);
Fields[2] := TScalarRecordField.Create(kHigh, TScalar.TKind.Float);
Fields[3] := TScalarRecordField.Create(kLow, TScalar.TKind.Float);
Fields[4] := TScalarRecordField.Create(kClose, TScalar.TKind.Float);
Fields[5] := TScalarRecordField.Create(kVol, TScalar.TKind.Ordinal);
Def := TKeywordMappingRegistry<TScalar.TKind>.Intern(Fields);
// Wir erzeugen einen aktiven RootStream
Stream := TRootStream.Create(Def);
// Für den Compiler ist es eine RecordSeries (Typ), zur Laufzeit ein Stream (Wert)
StaticType := TTypes.CreateRecordSeries(Def);
Scope.Define(VarName, TDataValue.FromStream(Stream), StaticType);
end;
procedure TFinanceSimulator.AddRandomCandle(const Scope: IExecutionScope; const VarName: string);
var
Addr: TResolvedAddress;
Val: TDataValue;
Stream: TRootStream;
Def: IScalarRecordDefinition;
RowData: TArray<TScalar.TValue>;
i: Integer;
Key: IKeyword;
O, H, L, C: Double;
V: Int64;
begin
InitKeywords;
Addr := Scope.Resolve(VarName);
if Addr.Kind = akUnresolved then
raise Exception.CreateFmt('Variable "%s" not found.', [VarName]);
Val := Scope[Addr];
// Wir benötigen zwingend einen Stream für sim-tick, um Events zu feuern
if Val.Kind <> vkStream then
raise Exception.CreateFmt('Variable "%s" is not a Stream.', [VarName]);
// Sicherer Cast auf TRootStream
if not (Val.AsStream is TRootStream) then
raise Exception.CreateFmt('Variable "%s" is a Stream, but not a TRootStream (cannot push manually).', [VarName]);
Stream := TRootStream(Val.AsStream);
Def := Stream.Series.Def;
// --- Simulation ---
FLastTime := IncMinute(FLastTime, 5);
O := FLastClose;
C := O + (Random - 0.5) * 2.0;
H := Max(O, C) + Random * 0.5;
L := Min(O, C) - Random * 0.5;
V := Random(1000) + 100;
FLastClose := C;
// ------------------
SetLength(RowData, Def.Count);
for i := 0 to Def.Count - 1 do
begin
Key := Def.Items[i].Key;
if Key = kTime then
RowData[i] := FLastTime
else if Key = kOpen then
RowData[i] := O
else if Key = kHigh then
RowData[i] := H
else if Key = kLow then
RowData[i] := L
else if Key = kClose then
RowData[i] := C
else if Key = kVol then
RowData[i] := V;
end;
// Push triggert das Notify-Event für alle angeschlossenen Pipes
Stream.Push(RowData);
end;
procedure RegisterFinanceLibrary(const Scope: IExecutionScope);
var
Sim: IFinanceSimulator;
Sig: IStaticType;
begin
Sim := TFinanceSimulator.Create;
Sig := TTypes.CreateMethod([TTypes.Text], TTypes.Void);
Scope.Define(
'sim-create',
function(const Args: TArray<TDataValue>): TDataValue
begin
if Length(Args) <> 1 then
raise Exception.Create('sim-create(Name) expects 1 argument');
Sim.CreateOHLCSeries(Scope, Args[0].AsText);
Result := TDataValue.Void;
end,
Sig
);
Scope.Define(
'sim-tick',
function(const Args: TArray<TDataValue>): TDataValue
begin
if Length(Args) <> 1 then
raise Exception.Create('sim-tick(Name) expects 1 argument');
Sim.AddRandomCandle(Scope, Args[0].AsText);
Result := TDataValue.Void;
end,
Sig
);
// Some Demo-Stream
Sim.CreateOHLCSeries(Scope, 'btc');
end;
initialization
TAst.RegisterLibrary(RegisterFinanceLibrary);
end.
+2 -1
View File
@@ -36,7 +36,8 @@ uses
Test.Myc.Ast.RTL.TypeRegistry in 'AST\Test.Myc.Ast.RTL.TypeRegistry.pas', Test.Myc.Ast.RTL.TypeRegistry in 'AST\Test.Myc.Ast.RTL.TypeRegistry.pas',
Test.Myc.Ast.NullPropagation in 'AST\Test.Myc.Ast.NullPropagation.pas', Test.Myc.Ast.NullPropagation in 'AST\Test.Myc.Ast.NullPropagation.pas',
Test.Myc.Ast.Pipes in 'AST\Test.Myc.Ast.Pipes.pas', Test.Myc.Ast.Pipes in 'AST\Test.Myc.Ast.Pipes.pas',
Test.Myc.Ast.Integration in 'Test.Myc.Ast.Integration.pas'; Test.Myc.Ast.Integration in 'Test.Myc.Ast.Integration.pas',
Demo.Finance in 'Demo.Finance.pas';
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit } { keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
{$IFNDEF TESTINSIGHT} {$IFNDEF TESTINSIGHT}
+1
View File
@@ -138,6 +138,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="AST\Test.Myc.Ast.NullPropagation.pas"/> <DCCReference Include="AST\Test.Myc.Ast.NullPropagation.pas"/>
<DCCReference Include="AST\Test.Myc.Ast.Pipes.pas"/> <DCCReference Include="AST\Test.Myc.Ast.Pipes.pas"/>
<DCCReference Include="Test.Myc.Ast.Integration.pas"/> <DCCReference Include="Test.Myc.Ast.Integration.pas"/>
<DCCReference Include="Demo.Finance.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+5
View File
@@ -0,0 +1,5 @@
;; EXPECT: <series[0]>
(do
(def btc-ma (pipe [btc [:Close]] (fn [c] (do {:ma c}))))
(.ma btc-ma)
)