Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

TTicker

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-14 16:44:29 +02:00
parent d0ad547aa3
commit 6f0b927a05
7 changed files with 177 additions and 169 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/AuraTrader.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion> <ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType> <FrameworkType>FMX</FrameworkType>
<Base>True</Base> <Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config> <Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform> <Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName> <ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName>
<TargetedPlatforms>3</TargetedPlatforms> <TargetedPlatforms>3</TargetedPlatforms>
AuraTrader/FirstStrategy.pas
+94 -91
View File
@@ -24,24 +24,6 @@ type
constructor Create(const AFunc: TConvertFunc); constructor Create(const AFunc: TConvertFunc);
end; end;
TTicksToTimeframe = class(TMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>>)
private
FTimeframe: TTimeframe;
// Stores the currently aggregating OHLC data.
FCurrentBar: TDataPoint<TOhlcItem>;
function GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
function GetCurrentBar: TDataPoint<TOhlcItem>;
function GetTimeframe: TTimeframe;
public
constructor Create(const ATimeframe: TTimeframe);
// Process new data. This is called concurrently and must not have side effects out of the scope of this class!
function ProcessData(const Values: TArray<TDataPoint<TAskBidItem>>): TState; override;
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
property Timeframe: TTimeframe read GetTimeframe;
end;
TIndicator<S, T> = class(TMycConverter<S, T>) TIndicator<S, T> = class(TMycConverter<S, T>)
protected protected
function ProcessData(const Value: S): TState; override; final; function ProcessData(const Value: S): TState; override; final;
@@ -57,21 +39,77 @@ type
constructor Create(const AFunc: TIndicatorFunc<S, T>); constructor Create(const AFunc: TIndicatorFunc<S, T>);
end; end;
TTicksToBars = class(TMycConverter<TDataPoint<TAskBidItem>, TDataPoint<TOhlcItem>>)
private
FTimeframe: TTimeframe;
// Stores the currently aggregating OHLC data.
FCurrentBar: TDataPoint<TOhlcItem>;
function GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
function GetCurrentBar: TDataPoint<TOhlcItem>;
function GetTimeframe: TTimeframe;
public
constructor Create(const ATimeframe: TTimeframe);
// Process new data. This is called concurrently and must not have side effects out of the scope of this class!
function ProcessData(const Value: TDataPoint<TAskBidItem>): TState; override;
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
property Timeframe: TTimeframe read GetTimeframe;
end;
TTicker<T> = class(TMycConverter<TArray<T>, T>)
public
function ProcessData(const Values: TArray<T>): TState; override;
end;
implementation implementation
uses uses
System.DateUtils, System.DateUtils,
System.Math; System.Math;
{ TTicksToTimeframe } { TMycGenericConverter<S, T> }
constructor TTicksToTimeframe.Create(const ATimeframe: TTimeframe); constructor TMycGenericConverter<S, T>.Create(const AFunc: TConvertFunc);
begin
inherited Create;
FFunc := AFunc;
end;
function TMycGenericConverter<S, T>.ProcessData(const Value: S): TState;
begin
Result := Broadcast(FFunc(Value));
end;
{ TIndicator<S,T> }
function TIndicator<S, T>.ProcessData(const Value: S): TState;
begin
Result := Broadcast(Calculate(Value));
end;
{ TGenericIndicator<S,T> }
constructor TGenericIndicator<S, T>.Create(const AFunc: TIndicatorFunc<S, T>);
begin
inherited Create;
FFunc := AFunc;
end;
function TGenericIndicator<S, T>.Calculate(const Value: S): T;
begin
Result := FFunc(Value);
end;
{ TTicksToBars }
constructor TTicksToBars.Create(const ATimeframe: TTimeframe);
begin begin
inherited Create; inherited Create;
FTimeframe := ATimeframe; FTimeframe := ATimeframe;
end; end;
function TTicksToTimeframe.GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime; function TTicksToBars.GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
var var
baseTime: TDateTime; baseTime: TDateTime;
begin begin
@@ -119,99 +157,64 @@ begin
end; end;
end; end;
function TTicksToTimeframe.GetCurrentBar: TDataPoint<TOhlcItem>; function TTicksToBars.GetCurrentBar: TDataPoint<TOhlcItem>;
begin begin
Result := FCurrentBar; Result := FCurrentBar;
end; end;
function TTicksToTimeframe.GetTimeframe: TTimeframe; function TTicksToBars.GetTimeframe: TTimeframe;
begin begin
Result := FTimeframe; Result := FTimeframe;
end; end;
function TTicksToTimeframe.ProcessData(const Values: TArray<TDataPoint<TAskBidItem>>): TState; function TTicksToBars.ProcessData(const Value: TDataPoint<TAskBidItem>): TState;
var var
point: TDataPoint<TAskBidItem>;
midPrice: Single; midPrice: Single;
barStartTime: TDateTime; barStartTime: TDateTime;
lastBarTime: TDateTime; lastBarTime: TDateTime;
currentBar: TOhlcItem; currentBar: TOhlcItem;
states: TList<TState>;
begin begin
states := TList<TState>.Create; midPrice := (Value.Data.Ask + Value.Data.Bid) / 2;
try
// Process each incoming data point // Update bar for the strategy's timeframe
for point in Values do barStartTime := GetBarStartTime(Value.Time, FTimeframe);
lastBarTime := FCurrentBar.Time;
if (barStartTime > lastBarTime) then
begin
// A new bar starts, so the previous one is now complete.
if (lastBarTime > 0) then
begin begin
midPrice := (point.Data.Ask + point.Data.Bid) / 2; Result := Broadcast(FCurrentBar);
// Update bar for the strategy's timeframe
barStartTime := GetBarStartTime(point.Time, FTimeframe);
lastBarTime := FCurrentBar.Time;
if (barStartTime > lastBarTime) then
begin
// A new bar starts, so the previous one is now complete.
if (lastBarTime > 0) then
begin
states.Add(Broadcast(FCurrentBar));
end;
// Start a new bar, Volume is 1 because this is the first tick.
currentBar := TOhlcItem.Create(midPrice, midPrice, midPrice, midPrice, 1);
FCurrentBar.Data := currentBar;
FCurrentBar.Time := barStartTime;
end
else
begin
// Update the currently aggregating bar
currentBar := FCurrentBar.Data;
currentBar.High := Max(currentBar.High, midPrice);
currentBar.Low := Min(currentBar.Low, midPrice);
currentBar.Close := midPrice;
// Volume is the number of ticks needed to build the complete bar.
currentBar.Volume := currentBar.Volume + 1;
FCurrentBar.Data := currentBar;
end;
end; end;
Result := TState.All(states.ToArray); // Start a new bar, Volume is 1 because this is the first tick.
finally currentBar := TOhlcItem.Create(midPrice, midPrice, midPrice, midPrice, 1);
states.Free; FCurrentBar.Data := currentBar;
FCurrentBar.Time := barStartTime;
end
else
begin
// Update the currently aggregating bar
currentBar := FCurrentBar.Data;
currentBar.High := Max(currentBar.High, midPrice);
currentBar.Low := Min(currentBar.Low, midPrice);
currentBar.Close := midPrice;
// Volume is the number of ticks needed to build the complete bar.
currentBar.Volume := currentBar.Volume + 1;
FCurrentBar.Data := currentBar;
end; end;
end; end;
{ TMycGenericConverter<S, T> } function TTicker<T>.ProcessData(const Values: TArray<T>): TState;
constructor TMycGenericConverter<S, T>.Create(const AFunc: TConvertFunc);
begin begin
inherited Create; var done := TLatch.CreateLatch( Length(Values) );
FFunc := AFunc;
end;
function TMycGenericConverter<S, T>.ProcessData(const Value: S): TState; // Process each incoming data point
begin for var i:=0 to High(Values) do
Result := Broadcast(FFunc(Value)); Broadcast(Values[i]).Signal.Subscribe(done);
end;
{ TIndicator<S,T> } Result := done.State;
function TIndicator<S, T>.ProcessData(const Value: S): TState;
begin
Result := Broadcast(Calculate(Value));
end;
{ TGenericIndicator<S,T> }
constructor TGenericIndicator<S, T>.Create(const AFunc: TIndicatorFunc<S, T>);
begin
inherited Create;
FFunc := AFunc;
end;
function TGenericIndicator<S, T>.Calculate(const Value: S): T;
begin
Result := FFunc(Value);
end; end;
end. end.
AuraTrader/MainForm.pas
+5 -2
View File
@@ -167,7 +167,10 @@ begin
var timeframe := TTimeframe.S15; var timeframe := TTimeframe.S15;
var OhlcPoint: IMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>> := TTicksToTimeframe.Create(timeframe); var ticker := TTicker<TDataPoint<TAskBidItem>>.Create;
var OhlcPoint := TTicksToBars.Create(timeframe);
ticker.Sender.Link(OhlcPoint);
var Timestamps: IMycConverter<TDataPoint<TOhlcItem>, TDateTime> := var Timestamps: IMycConverter<TDataPoint<TOhlcItem>, TDateTime> :=
TMycGenericConverter<TDataPoint<TOhlcItem>, TDateTime> TMycGenericConverter<TDataPoint<TOhlcItem>, TDateTime>
@@ -272,7 +275,7 @@ begin
Stoch.Sender.Link(StochD); Stoch.Sender.Link(StochD);
Panel.AddDoubleSeries(StochD.Sender, TAlphaColors.Red); Panel.AddDoubleSeries(StochD.Sender, TAlphaColors.Red);
var done := ExecuteStrategy(Symbol, OhlcPoint); var done := ExecuteStrategy(Symbol, ticker);
///// /////
Src/Myc.Core.Tasks.pas
+6 -2
View File
@@ -112,7 +112,11 @@ begin
FWorkGate := TSemaphore.Create(nil, 0, MaxInt, ''); // Initial count is 0, workers will wait FWorkGate := TSemaphore.Create(nil, 0, MaxInt, ''); // Initial count is 0, workers will wait
SetLength(FWorkThreads, TThread.ProcessorCount); // Create one thread per processor core var threadCnt := TThread.ProcessorCount - 1;
if threadCnt < 2 then
threadCnt := 2;
SetLength(FWorkThreads, threadCnt);
for var i := 0 to High(FWorkThreads) do for var i := 0 to High(FWorkThreads) do
begin begin
FWorkThreads[i] := CreateAnonymousThread('Thread pool [' + IntToStr(i) + ']', WorkerThread); FWorkThreads[i] := CreateAnonymousThread('Thread pool [' + IntToStr(i) + ']', WorkerThread);
@@ -158,7 +162,7 @@ begin
if TThread.CurrentThread.ThreadID = MainThreadID then if TThread.CurrentThread.ThreadID = MainThreadID then
begin begin
prio := TThread.CurrentThread.Priority; prio := TThread.CurrentThread.Priority;
if prio > Low(TThreadPriority) then if prio > tpLowest then
prio := TThreadPriority(Ord(prio) - 1); // Decrease priority by one step prio := TThreadPriority(Ord(prio) - 1); // Decrease priority by one step
Result.Priority := prio; Result.Priority := prio;
Src/Myc.Fmx.Chart.pas
+22 -9
View File
@@ -65,8 +65,12 @@ type
protected protected
function GetOwner: TMycChart; override; final; function GetOwner: TMycChart; override; final;
// Paint crosshair and other axis related overlays // Paint crosshair and other axis related overlays
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos: Integer); virtual; procedure Paint(
abstract; const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
IdxAtMousePos: Integer
); virtual; abstract;
public public
constructor Create(AOwner: TMycChart); constructor Create(AOwner: TMycChart);
end; end;
@@ -74,7 +78,12 @@ type
TXAxisLayer = class(TAxisLayer) TXAxisLayer = class(TAxisLayer)
protected protected
// Paint crosshair and time caption // Paint crosshair and time caption
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos: Integer); override; procedure Paint(
const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
IdxAtMousePos: Integer
); override;
// This function delivers the text for the caption. // This function delivers the text for the caption.
function GetCaption(Idx: Int64): String; virtual; abstract; function GetCaption(Idx: Int64): String; virtual; abstract;
end; end;
@@ -339,11 +348,11 @@ begin
end; end;
// Draw crosshair if mouse is in control // Draw crosshair if mouse is in control
if FIsMouseInControl and Assigned(FXAxisSeries) and (FMousePos.Idx >= 0 ) then if FIsMouseInControl and Assigned(FXAxisSeries) and (FMousePos.Idx >= 0) then
begin begin
// Do not draw crosshair if mouse is over the jump button // Do not draw crosshair if mouse is over the jump button
if not FJumpButtonRect.Contains(FMousePos.Point) then if not FJumpButtonRect.Contains(FMousePos.Point) then
FXAxisSeries.Paint(Self.Canvas, rect, FViewStartIndex, FViewCount, FViewStartIndex + FMousePos.Idx ); FXAxisSeries.Paint(Self.Canvas, rect, FViewStartIndex, FViewCount, FViewStartIndex + FMousePos.Idx);
end; end;
// --- Draw the "jump to latest" button (code unchanged) --- // --- Draw the "jump to latest" button (code unchanged) ---
@@ -512,7 +521,7 @@ begin
panel2.Weight := (newH2 / (newH1 + newH2)) * twoPanelWeight; panel2.Weight := (newH2 / (newH1 + newH2)) * twoPanelWeight;
end; end;
FDragStartPoint := CreateDragPoint( FDragStartPoint.Point.X, Y ); // Update start point for next move FDragStartPoint := CreateDragPoint(FDragStartPoint.Point.X, Y); // Update start point for next move
Repaint; Repaint;
exit; // Do not continue with other mouse move logic exit; // Do not continue with other mouse move logic
end; end;
@@ -615,7 +624,7 @@ begin
FViewCount := newViewCount; FViewCount := newViewCount;
var oldIdx := FViewStartIndex + FMousePos.Idx; var oldIdx := FViewStartIndex + FMousePos.Idx;
FMousePos := CreateDragPoint( FMousePos.Point.X, FMousePos.Point.Y ); FMousePos := CreateDragPoint(FMousePos.Point.X, FMousePos.Point.Y);
FViewStartIndex := oldIdx - FMousePos.Idx; FViewStartIndex := oldIdx - FMousePos.Idx;
// Clamp start index // Clamp start index
@@ -819,8 +828,12 @@ end;
{ TMycChart.TXAxisLayer } { TMycChart.TXAxisLayer }
procedure TMycChart.TXAxisLayer.Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos: procedure TMycChart.TXAxisLayer.Paint(
Integer); const Canvas: TCanvas;
const Viewport: TRectF;
ViewStartIndex, ViewCount: Int64;
IdxAtMousePos: Integer
);
var var
caption: string; caption: string;
captionRect: TRectF; captionRect: TRectF;
Test/MycTests.dpr
+28 -28
View File
@@ -5,34 +5,34 @@ program MycTests;
{$ENDIF} {$ENDIF}
{$STRONGLINKTYPES ON} {$STRONGLINKTYPES ON}
uses uses
FastMM5, FastMM5,
DUnitX.MemoryLeakMonitor.FastMM5, DUnitX.MemoryLeakMonitor.FastMM5,
System.SysUtils, System.SysUtils,
{$IFDEF TESTINSIGHT} {$IFDEF TESTINSIGHT}
TestInsight.DUnitX, TestInsight.DUnitX,
{$ELSE} {$ELSE}
DUnitX.Loggers.Console, DUnitX.Loggers.Console,
{$ENDIF } {$ENDIF }
DUnitX.TestFramework, DUnitX.TestFramework,
TestNotifier in 'TestNotifier.pas', TestNotifier in 'TestNotifier.pas',
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
TestTasks in 'TestTasks.pas', TestTasks in 'TestTasks.pas',
Myc.Futures in '..\Src\Myc.Futures.pas', Myc.Futures in '..\Src\Myc.Futures.pas',
TestCoreFutures in 'TestCoreFutures.pas', TestCoreFutures in 'TestCoreFutures.pas',
Myc.TaskManager in '..\Src\Myc.TaskManager.pas', Myc.TaskManager in '..\Src\Myc.TaskManager.pas',
TestFutures in 'TestFutures.pas', TestFutures in 'TestFutures.pas',
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas', Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas',
Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas', Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas',
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas', Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas', Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas',
Myc.Trade.Node in '..\Src\Myc.Trade.Node.pas', Myc.Trade.Node in '..\Src\Myc.Trade.Node.pas',
Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas', Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas',
Myc.Test.Trade.DataStream in '..\Src\Myc.Test.Trade.DataStream.pas', Myc.Test.Trade.DataStream in '..\Src\Myc.Test.Trade.DataStream.pas',
Myc.Test.Trade.DataPoint in '..\Src\Myc.Test.Trade.DataPoint.pas', Myc.Test.Trade.DataPoint in '..\Src\Myc.Test.Trade.DataPoint.pas',
Myc.Trade.DataProvider in '..\Src\Myc.Trade.DataProvider.pas', Myc.Trade.DataProvider in '..\Src\Myc.Trade.DataProvider.pas',
Myc.Mutable in '..\Src\Myc.Mutable.pas', Myc.Mutable in '..\Src\Myc.Mutable.pas',
Test.Core.Mutable in 'Test.Core.Mutable.pas'; Test.Core.Mutable in 'Test.Core.Mutable.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}
Test/Test.Core.Mutable.pas
+21 -36
View File
@@ -34,9 +34,6 @@ type
[TestCase('Writeable', '10,20')] [TestCase('Writeable', '10,20')]
procedure TestWriteableMutable(InitialValue, NewValue: Integer); procedure TestWriteableMutable(InitialValue, NewValue: Integer);
[Test]
procedure TestWriteableMutable_SignalOnSameValue;
[Test] [Test]
[TestCase('Protected', '100,200')] [TestCase('Protected', '100,200')]
procedure TestProtectedMutable_Delegation(InitialValue, NewValue: Integer); procedure TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
@@ -106,7 +103,8 @@ var
func: TFunc<Integer>; func: TFunc<Integer>;
begin begin
callCount := 0; callCount := 0;
func := function: Integer func :=
function: Integer
begin begin
Inc(callCount); Inc(callCount);
Result := 42; Result := 42;
@@ -125,10 +123,7 @@ var
func: TFunc<Integer>; func: TFunc<Integer>;
begin begin
source := TEvent.CreateEvent; source := TEvent.CreateEvent;
func := function: Integer func := function: Integer begin Result := 123; end;
begin
Result := 123;
end;
mutable := TMutable<Integer>.Construct(source.Signal, func); mutable := TMutable<Integer>.Construct(source.Signal, func);
lazy := TLazy<Integer>.Create(mutable); lazy := TLazy<Integer>.Create(mutable);
@@ -156,19 +151,6 @@ begin
subscription.Unsubscribe; subscription.Unsubscribe;
end; end;
procedure TTestCoreMutable.TestWriteableMutable_SignalOnSameValue;
var
writeable: TWriteable<Integer>;
subscriber: TSignal.ISubscriber;
subscription: TSignal.TSubscription;
begin
writeable := TWriteable<Integer>.CreateWriteable(100);
subscriber := TTestSubscriber.Create(SubscriberCallback);
subscription := writeable.Changed.Subscribe(subscriber);
subscription.Unsubscribe;
end;
procedure TTestCoreMutable.TestProtectedMutable_Delegation(InitialValue, NewValue: Integer); procedure TTestCoreMutable.TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
var var
writeable: TWriteable<Integer>; writeable: TWriteable<Integer>;
@@ -203,21 +185,24 @@ begin
for i := 0 to ThreadCount - 1 do for i := 0 to ThreadCount - 1 do
begin begin
threads := threads + [TThread.CreateAnonymousThread( threads :=
procedure threads
var + [
j: Integer; TThread.CreateAnonymousThread(
begin procedure
for j := 1 to Iterations do var
begin j: Integer;
// This is an intentional race condition to test lock stability. begin
// The lock protects the GetValue calls individually, for j := 1 to Iterations do
// preventing memory corruption during concurrent access. begin
var curr := writeable.Value; // This is an intentional race condition to test lock stability.
writeable.Value := curr + 1; // The lock protects the GetValue calls individually,
end; // preventing memory corruption during concurrent access.
end var curr := writeable.Value;
)]; writeable.Value := curr + 1;
end;
end
)];
end; end;
for var thread in threads do for var thread in threads do