Data Types

This commit is contained in:
Michael Schimmel
2025-08-25 10:26:48 +02:00
parent 75675b8dc1
commit 27f1cc5486
20 changed files with 2670 additions and 34 deletions
+2 -1
View File
@@ -8,7 +8,8 @@ uses
TestModule in 'TestModule.pas', TestModule in 'TestModule.pas',
DynamicFMXControl in 'DynamicFMXControl.pas', DynamicFMXControl in 'DynamicFMXControl.pas',
Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas', Myc.Trade.Pipeline.Impl in '..\Src\Myc.Trade.Pipeline.Impl.pas',
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas'; Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas',
Strategy2 in 'Strategy2.pas';
{$R *.res} {$R *.res}
+1
View File
@@ -139,6 +139,7 @@
<DCCReference Include="DynamicFMXControl.pas"/> <DCCReference Include="DynamicFMXControl.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/> <DCCReference Include="..\Src\Myc.Trade.Pipeline.Impl.pas"/>
<DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/> <DCCReference Include="..\Src\Myc.Trade.Indicators.pas"/>
<DCCReference Include="Strategy2.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+20 -12
View File
@@ -13,7 +13,7 @@ object Form1: TForm1
object MainPanel: TPanel object MainPanel: TPanel
Align = Client Align = Client
Size.Width = 1017.000000000000000000 Size.Width = 1017.000000000000000000
Size.Height = 712.000000000000000000 Size.Height = 406.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 2 TabOrder = 2
object Splitter1: TSplitter object Splitter1: TSplitter
@@ -22,19 +22,19 @@ object Form1: TForm1
MinSize = 20.000000000000000000 MinSize = 20.000000000000000000
Position.X = 169.000000000000000000 Position.X = 169.000000000000000000
Size.Width = 8.000000000000000000 Size.Width = 8.000000000000000000
Size.Height = 712.000000000000000000 Size.Height = 406.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
end end
object WorkspacePanel: TPanel object WorkspacePanel: TPanel
Align = Client Align = Client
Size.Width = 840.000000000000000000 Size.Width = 840.000000000000000000
Size.Height = 712.000000000000000000 Size.Height = 406.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 3 TabOrder = 3
object TabControl: TTabControl object TabControl: TTabControl
Align = Client Align = Client
Size.Width = 840.000000000000000000 Size.Width = 840.000000000000000000
Size.Height = 678.000000000000000000 Size.Height = 372.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabIndex = 0 TabIndex = 0
TabOrder = 10 TabOrder = 10
@@ -161,20 +161,20 @@ object Form1: TForm1
object ObjectsPanel: TPanel object ObjectsPanel: TPanel
Align = Left Align = Left
Size.Width = 169.000000000000000000 Size.Width = 169.000000000000000000
Size.Height = 712.000000000000000000 Size.Height = 406.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 4 TabOrder = 4
object ObjectsTabControl: TTabControl object ObjectsTabControl: TTabControl
Align = Client Align = Client
Size.Width = 169.000000000000000000 Size.Width = 169.000000000000000000
Size.Height = 712.000000000000000000 Size.Height = 406.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabIndex = 0 TabIndex = 0
TabOrder = 0 TabOrder = 0
TabPosition = Bottom TabPosition = Bottom
Sizes = ( Sizes = (
169s 169s
686s) 380s)
object ModulesTabItem: TTabItem object ModulesTabItem: TTabItem
CustomIcon = < CustomIcon = <
item item
@@ -192,13 +192,13 @@ object Form1: TForm1
object TreeView: TTreeView object TreeView: TTreeView
Align = Client Align = Client
Size.Width = 169.000000000000000000 Size.Width = 169.000000000000000000
Size.Height = 686.000000000000000000 Size.Height = 380.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 0 TabOrder = 0
OnDblClick = TreeViewDblClick OnDblClick = TreeViewDblClick
AllowDrag = True AllowDrag = True
Viewport.Width = 165.000000000000000000 Viewport.Width = 165.000000000000000000
Viewport.Height = 682.000000000000000000 Viewport.Height = 376.000000000000000000
object Button1: TButton object Button1: TButton
Position.X = 56.000000000000000000 Position.X = 56.000000000000000000
Position.Y = 72.000000000000000000 Position.Y = 72.000000000000000000
@@ -207,6 +207,14 @@ object Form1: TForm1
TextSettings.Trimming = None TextSettings.Trimming = None
OnClick = Button1Click OnClick = Button1Click
end end
object Button2: TButton
Position.X = 56.000000000000000000
Position.Y = 112.000000000000000000
TabOrder = 1
Text = 'Button2'
TextSettings.Trimming = None
OnClick = Button2Click
end
end end
end end
end end
@@ -216,13 +224,13 @@ object Form1: TForm1
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = [] DataDetectorTypes = []
Align = Bottom Align = Bottom
Position.Y = 712.000000000000000000 Position.Y = 406.000000000000000000
Size.Width = 1017.000000000000000000 Size.Width = 1017.000000000000000000
Size.Height = 128.000000000000000000 Size.Height = 434.000000000000000000
Size.PlatformDefault = False Size.PlatformDefault = False
TabOrder = 1 TabOrder = 1
Viewport.Width = 1013.000000000000000000 Viewport.Width = 1013.000000000000000000
Viewport.Height = 124.000000000000000000 Viewport.Height = 430.000000000000000000
end end
object ActionList: TActionList object ActionList: TActionList
Left = 209 Left = 209
+54 -3
View File
@@ -84,12 +84,15 @@ type
StrategyButton: TSpeedButton; StrategyButton: TSpeedButton;
Strat2Button: TSpeedButton; Strat2Button: TSpeedButton;
Button1: TButton; Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure StopButtonClick(Sender: TObject); procedure StopButtonClick(Sender: TObject);
procedure TreeViewDblClick(Sender: TObject); procedure TreeViewDblClick(Sender: TObject);
procedure AddWorkspaceActionExecute(Sender: TObject); procedure AddWorkspaceActionExecute(Sender: TObject);
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure LogMemoChange(Sender: TObject);
procedure Strat2ButtonClick(Sender: TObject); procedure Strat2ButtonClick(Sender: TObject);
procedure TestActionExecute(Sender: TObject); procedure TestActionExecute(Sender: TObject);
procedure StrategyButtonClick(Sender: TObject); procedure StrategyButtonClick(Sender: TObject);
@@ -126,7 +129,8 @@ implementation
uses uses
Myc.Data.Records, Myc.Data.Records,
TestModule; TestModule,
Strategy2;
{$R *.fmx} {$R *.fmx}
@@ -296,6 +300,46 @@ begin
end; end;
procedure TForm1.Button2Click(Sender: TObject);
begin
var Symbol := SelectedSymbol;
if Symbol = '' then
exit;
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
var ticker := TConverter.CreateTicker<TDataPoint<TOhlcItem>>;
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
var chart1 := TMycChart.Create(Self);
AlignControl(chart1);
chart1.Height := Layout.ChildrenRect.Width * 9 / 20;
chart1.Lookback.Value := 50000;
var chart2 := TMycChart.Create(Self);
AlignControl(chart2);
chart2.Height := Layout.ChildrenRect.Width * 9 / 20;
chart2.Lookback.Value := 50000;
var equity := Strategy2.CreateStrategy2(ticker.Producer, LogMemo.Lines, chart1, chart2);
var pnlChart := TMycChart.Create(Self);
AlignControl(pnlChart);
pnlChart.Height := Layout.ChildrenRect.Width * 9 / 24;
pnlChart.Lookback.Value := 50000;
pnlChart.SetXAxisCounter<Double>(equity);
var panel := pnlChart.AddPanel;
panel.AddDoubleSeries(equity, TAlphaColors.Blue, 3);
FProcessDone := FProcessDone + FServer.ProcessData(Symbol, terminated, ticker.Consumer);
end;
function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>; function TForm1.CreateStrategy2(Timeframe: TTimeframe): IConsumer<TDataPoint<TOhlcItem>>;
type type
TSignal = record TSignal = record
@@ -332,7 +376,7 @@ begin
var lastHull, lastSma: Double; var lastHull, lastSma: Double;
var conv := TConverter.Join<Double>([Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]); var conv := TConverter.Join<Double>(jmAll, [Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]);
var Signal := var Signal :=
TConverter<TArray<Double>, TSignal>.CreateConverter( TConverter<TArray<Double>, TSignal>.CreateConverter(
@@ -477,7 +521,7 @@ begin
var mean := TConverter<TArray<Double>, Double>.CreateConverter(TMean.CreateMean()); var mean := TConverter<TArray<Double>, Double>.CreateConverter(TMean.CreateMean());
TConverter.Join<Double>([Hull, Sma]).Chain<Double>(mean); TConverter.Join<Double>(jmAll, [Hull, Sma]).Chain<Double>(mean);
panel.AddDoubleSeries(mean.Producer, TAlphaColors.Blue, 5); panel.AddDoubleSeries(mean.Producer, TAlphaColors.Blue, 5);
@@ -581,6 +625,12 @@ begin
{$endif} {$endif}
end; end;
procedure TForm1.LogMemoChange(Sender: TObject);
begin
if LogMemo.Lines.Count > 1000 then
LogMemo.Lines.Clear;
end;
function TForm1.SelectedSymbol: String; function TForm1.SelectedSymbol: String;
begin begin
Result := ''; Result := '';
@@ -690,6 +740,7 @@ begin
// ExecuteStrategy(Symbol, timeframe, CreateStrategy2(timeframe)); // ExecuteStrategy(Symbol, timeframe, CreateStrategy2(timeframe));
var tstStrat := StrategyTest.CreateStrategy1(timeframe); var tstStrat := StrategyTest.CreateStrategy1(timeframe);
ExecuteStrategy(Symbol, timeframe, tstStrat.Consumer); ExecuteStrategy(Symbol, timeframe, tstStrat.Consumer);
var Layout := CurrLayout<TVertScrollBox>; var Layout := CurrLayout<TVertScrollBox>;
+503
View File
@@ -0,0 +1,503 @@
unit Strategy2;
interface
uses
System.Classes,
Myc.Signals,
Myc.Data.Pipeline,
Myc.Trade.Types,
Myc.FMX.Chart,
Myc.Trade.Pipeline;
function CreateStrategy2(
const Ticker: TProducer<TDataPoint<TOhlcItem>>;
const Log: TStrings;
const Chart1H, Chart24H: TMycChart
): TProducer<Double>;
implementation
uses
System.SysUtils,
System.Rtti,
System.Math,
System.Generics.Collections,
System.Types,
System.UITypes,
FMX.Types,
Myc.Trade.Indicators.Common,
Myc.Data.Records;
// Calculates the difference between the current value and the value N periods ago.
// (Value[0] - Value[N])
function Delta(N: Integer): TConverter<Double, Double>;
var
history: TQueue<Double>; // Captured state for the history of values
begin
if N <= 0 then
raise EArgumentException.Create('Delta period N must be positive.');
history := TQueue<Double>.Create;
Result :=
TConverter<Double, Double>.CreateAggregation(
// This function is the core of the aggregator. It is called for each value.
function(const Value: Double; const Broadcast: TBroadcastFunc<Double>): TState
var
deltaValue, oldestValue: Double;
begin
// Add current value to the history
history.Enqueue(Value);
// If the history is larger than needed, remove the oldest element.
// We need N+1 elements to have the current and the Nth previous value.
if history.Count > (N + 1) then
history.Dequeue;
// Calculate delta if we have enough data
if history.Count = (N + 1) then
begin
oldestValue := history.Peek; // Oldest value is at the front
deltaValue := Value - oldestValue;
Broadcast(deltaValue);
end
else
begin
// Not enough data yet, broadcast a neutral value.
Broadcast(0.0);
end;
Result := TState.Null;
end
);
end;
type
// Defines the direction of the slope between two points
TSlope = (sFalling, sFlat, sRising);
// Represents the last found high and low point in a series.
TExtrema = record
High: Double;
Low: Double;
constructor Create(AHigh, ALow: Double);
end;
constructor TExtrema.Create(AHigh, ALow: Double);
begin
High := AHigh;
Low := ALow;
end;
// Finds the last peak/trough. A peak is a value surrounded by N lower values on both sides.
// This introduces a signal lag of N periods.
function ExtremaFinder(N: Integer): TConverter<Double, TExtrema>;
var
// Captured state for the aggregator
history: TQueue<Double>;
lastHigh, lastLow: Double;
initialized: Boolean;
begin
if N <= 0 then
raise EArgumentException.Create('ExtremaFinder period N must be positive.');
initialized := False;
history := TQueue<Double>.Create;
lastHigh := 0;
lastLow := 0;
Result :=
TConverter<Double, TExtrema>.CreateAggregation(
function(const Value: Double; const Broadcast: TBroadcastFunc<TExtrema>): TState
var
data: TArray<Double>;
centerValue: Double;
isPeak, isTrough: Boolean;
i: Integer;
begin
history.Enqueue(Value);
// Keep the history buffer at the required size for the sliding window
if history.Count > (2 * N + 1) then
history.Dequeue;
// Initialize extrema with the first value once the buffer is full
if not initialized and (history.Count = (2 * N + 1)) then
begin
lastHigh := history.Peek;
lastLow := history.Peek;
initialized := True;
end;
// Only proceed if the window is full
if history.Count = (2 * N + 1) then
begin
data := history.ToArray;
centerValue := data[N]; // The value to be tested is in the middle of the window
// Test for a peak (center value is highest in the window)
isPeak := True;
for i := 0 to High(data) do
begin
if i <> N then
begin
if centerValue <= data[i] then
begin
isPeak := False;
break;
end;
end;
end;
if isPeak then
lastHigh := centerValue;
// Test for a trough (center value is lowest in the window)
isTrough := True;
if not isPeak then // Small optimization
begin
for i := 0 to High(data) do
begin
if i <> N then
begin
if centerValue >= data[i] then
begin
isTrough := False;
break;
end;
end;
end;
end
else
isTrough := False;
if isTrough then
lastLow := centerValue;
end;
// Broadcast the latest known extrema.
if initialized then
Broadcast(TExtrema.Create(lastHigh, lastLow));
Result := TState.Null;
end
);
end;
type
TValueHelper = record helper for TValue
class function AsValue<T>(const P: TProducer<T>): TProducer<TValue>; static;
end;
// Helper to convert a producer of any type T into a producer of TValue.
class function TValueHelper.AsValue<T>(const P: TProducer<T>): TProducer<TValue>;
begin
Result := P.Chain<TValue>(function(const V: T): TValue begin Result := TValue.From<T>(V); end);
end;
function CreateStrategy2(
const Ticker: TProducer<TDataPoint<TOhlcItem>>;
const Log: TStrings;
const Chart1H, Chart24H: TMycChart
): TProducer<Double>;
const
// Timeframe independent constants
HMA_BIAS_PERIOD = 250;
SMA_BIAS_PERIOD = 200;
ATR_PERIOD = 50;
ATR_FILTER_MULTIPLIER = 3.0;
ATR_SL_MULTIPLIER = 4.0;
// 1H specific constants
HMA_ENTRY_PERIOD = 20;
type
// Represents the current state of the trading logic
TTradeStatus = (tsFlat, tsLong, tsShort);
// Holds all necessary data for the stateful trade management aggregator
TTradeState = record
Status: TTradeStatus;
EntryPrice: Double;
StopLoss: Double;
TakeProfit: Double;
end;
var
{$region 'Producers for Indicators and Logic Signals'}
// Timeframe specific producers
Ohlc1H, Ohlc24H: TProducer<TDataPoint<TOhlcItem>>;
Close1H, Close24H: TProducer<Double>;
Time1H, Time24H: TProducer<TDateTime>;
// 24H Indicators
Hma250_24H, Sma200_24H, Atr50_24H: TProducer<Double>;
// 1H Indicators
Hma250_1H, Sma200_1H, Atr50_1H, Hma20_1H: TProducer<Double>;
// Bias producers
Bias24H_Bullish, Bias24H_Bearish: TProducer<Boolean>;
Bias1H_Bullish, Bias1H_Bearish: TProducer<Boolean>;
OverallBias_Bullish, OverallBias_Bearish: TProducer<Boolean>;
// Filter producers
Filter24H, Filter1H, TradeAllowed: TProducer<Boolean>;
// Entry producers
Hma20_Extrema: TProducer<TExtrema>;
LastLow_HMA20, LastHigh_HMA20: TProducer<Double>;
TriggerBuy, TriggerShort: TProducer<Boolean>;
GoLong, GoShort: TProducer<Boolean>;
{$endregion}
begin
{$region 'Helper function implementations'}
var All :=
function(const Prods: TArray<TProducer<Boolean>>): TProducer<Boolean>
begin
// TConverter.Join combines multiple producers of the same type into a producer of an array of that type.
Result :=
TConverter
.Join<Boolean>(TConverter.TJoinMode.jmAll, Prods)
.Chain<Boolean>(
function(const V: TArray<Boolean>): Boolean
var
i: Integer;
begin
// The output is true only if all input booleans are true.
Result := True;
for i := 0 to High(V) do
begin
if not V[i] then
begin
Result := False;
Exit;
end;
end;
end);
end;
var IsRising :=
function(const P: TProducer<Double>): TProducer<Boolean>
begin
// A series is rising if the difference to its previous value is positive.
// Assumes the existence of a Delta(1) converter.
Result := P.Chain<Double>(Delta(1)).Chain<Boolean>(function(const D: Double): Boolean begin Result := D > 0; end);
end;
var IsFalling :=
function(const P: TProducer<Double>): TProducer<Boolean>
begin
// A series is falling if the difference to its previous value is negative.
Result := P.Chain<Double>(Delta(1)).Chain<Boolean>(function(const D: Double): Boolean begin Result := D < 0; end);
end;
{$endregion}
{$region '1. Timeframe Aggregation & Chart Setup'}
// Aggregate Ticker data to 1H and 24H timeframes using a trade-specific converter.
Ohlc1H := Ticker.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(TTimeframe.H));
Ohlc24H := Ticker.Chain<TDataPoint<TOhlcItem>>(TTradeConverter.CreateOhlcAggregation(TTimeframe.D));
var Ohlc1HData := Ohlc1H.Field<TOhlcItem>('Data');
var Ohlc24HData := Ohlc24H.Field<TOhlcItem>('Data');
// Extract relevant data fields (Close price and Time) from the aggregated data points.
// The Field helper uses RTTI to access nested record fields.
Close1H := Ohlc1HData.Field<Double>('Close');
Time1H := Ohlc1H.Field<TDateTime>('Time');
Close24H := Ohlc24HData.Field<Double>('Close');
Time24H := Ohlc24H.Field<TDateTime>('Time');
// Setup the 1H chart
Chart1H.SetXAxisSeries(TTimeframe.H, Time1H);
var Panel1H_Main := Chart1H.AddPanel;
Panel1H_Main.AddOhlcSeries(Ohlc1HData);
var Panel1H_ATR := Chart1H.AddPanel;
Panel1H_ATR.Weight := 0.25;
// Setup the 24H chart
Chart24H.SetXAxisSeries(TTimeframe.D, Time24H);
var Panel24H_Main := Chart24H.AddPanel;
Panel24H_Main.AddOhlcSeries(Ohlc24HData);
var Panel24H_ATR := Chart24H.AddPanel;
Panel24H_ATR.Weight := 0.25;
{$endregion}
{$region '2. Indicator Calculation'}
// Calculate indicators for the 24H timeframe and add them to the chart.
Hma250_24H := Close24H.Chain<Double>(THMA.CreateHMA(HMA_BIAS_PERIOD));
Sma200_24H := Close24H.Chain<Double>(TSMA.CreateSMA(SMA_BIAS_PERIOD));
// ATR is calculated from OHLC data, not just the close price.
Atr50_24H := Ohlc24H.Field<TOhlcItem>('Data').Chain<Double>(TATR.CreateATR(ATR_PERIOD));
Panel24H_Main.AddDoubleSeries(Hma250_24H, TAlphaColors.Aqua);
Panel24H_Main.AddDoubleSeries(Sma200_24H, TAlphaColors.Orange);
Panel24H_ATR.AddDoubleSeries(Atr50_24H, TAlphaColors.Magenta);
// Calculate indicators for the 1H timeframe and add them to the chart.
Hma250_1H := Close1H.Chain<Double>(THMA.CreateHMA(HMA_BIAS_PERIOD));
Sma200_1H := Close1H.Chain<Double>(TSMA.CreateSMA(SMA_BIAS_PERIOD));
Atr50_1H := Ohlc1H.Field<TOhlcItem>('Data').Chain<Double>(TATR.CreateATR(ATR_PERIOD));
Hma20_1H := Close1H.Chain<Double>(THMA.CreateHMA(HMA_ENTRY_PERIOD));
Panel1H_Main.AddDoubleSeries(Hma250_1H, TAlphaColors.Aqua);
Panel1H_Main.AddDoubleSeries(Sma200_1H, TAlphaColors.Orange);
Panel1H_ATR.AddDoubleSeries(Atr50_1H, TAlphaColors.Magenta);
Panel1H_Main.AddDoubleSeries(Hma20_1H, TAlphaColors.Yellow, 2.0);
{$endregion}
{$region '3. Bias and Filter Logic'}
// Determine bullish/bearish bias for each timeframe based on moving average slopes.
Bias24H_Bullish := All([IsRising(Hma250_24H), IsRising(Sma200_24H)]);
Bias24H_Bearish := All([IsFalling(Hma250_24H), IsFalling(Sma200_24H)]);
Bias1H_Bullish := All([IsRising(Hma250_1H), IsRising(Sma200_1H)]);
Bias1H_Bearish := All([IsFalling(Hma250_1H), IsFalling(Sma200_1H)]);
// Determine overall bias: both timeframes must agree.
OverallBias_Bullish := All([Bias24H_Bullish, Bias1H_Bullish]);
OverallBias_Bearish := All([Bias24H_Bearish, Bias1H_Bearish]);
// Define the ATR filter logic.
var GetFilter :=
function(const Hma, Sma, Atr: TProducer<Double>): TProducer<Boolean>
begin
var Dist :=
TConverter
.Join<Double>(jmAll, [Hma, Sma])
.Chain<Double>(function(const V: TArray<Double>): Double begin Result := Abs(V[0] - V[1]); end);
var Threshold := Atr.Chain<Double>(function(const V: Double): Double begin Result := V * ATR_FILTER_MULTIPLIER; end);
Result :=
TConverter
.Join<Double>(jmAll, [Dist, Threshold])
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] > V[1]; end);
end;
// A trade is only allowed if the HMA/SMA distance is wide enough on both timeframes.
Filter24H := GetFilter(Hma250_24H, Sma200_24H, Atr50_24H);
Filter1H := GetFilter(Hma250_1H, Sma200_1H, Atr50_1H);
TradeAllowed := All([Filter1H, Filter24H]);
{$endregion}
{$region '4. Entry Logic'}
// Find the last high and low points of the 20-period HMA on the 1H chart.
// Assumes an ExtremaFinder converter that returns a TExtrema record.
Hma20_Extrema := Hma20_1H.Chain<TExtrema>(ExtremaFinder(1));
LastLow_HMA20 := Hma20_Extrema.Field<Double>('Low');
LastHigh_HMA20 := Hma20_Extrema.Field<Double>('High');
// Define entry triggers: price crossing below the last low (for longs) or above the last high (for shorts).
TriggerBuy :=
TConverter
.Join<Double>(jmAll, [Close1H, LastLow_HMA20])
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] < V[1]; end);
TriggerShort :=
TConverter
.Join<Double>(jmAll, [Close1H, LastHigh_HMA20])
.Chain<Boolean>(function(const V: TArray<Double>): Boolean begin Result := V[0] > V[1]; end);
// Combine all conditions for the final entry signals.
GoLong := All([OverallBias_Bullish, TradeAllowed, TriggerBuy]);
GoShort := All([OverallBias_Bearish, TradeAllowed, TriggerShort]);
{$endregion}
{$region '5. Trade Management via Aggregation'}
// The core state machine of the strategy. It's implemented as an aggregate function
// that captures a state record and processes a stream of combined input data.
var tradeState: TTradeState;
tradeState.Status := tsFlat;
tradeState.EntryPrice := 0;
tradeState.StopLoss := 0;
tradeState.TakeProfit := 0;
// The aggregator function processes an array of TValue, where each element
// corresponds to an input producer in a defined order.
var aggregatorFunc: TAggregateFunc<TArray<TValue>, Double> :=
function(const Value: TArray<TValue>; const Broadcast: TBroadcastFunc<Double>): TState
var
goLong, goShort: Boolean;
close, atr, lastHigh, lastLow: Double;
begin
// Not enough data, or data types are incorrect -> do nothing.
if (Length(Value) <> 6) or not Value[0].IsType<Boolean> then
begin
Result := TState.Null;
Exit;
end;
// Extract current values from the TValue array by index.
// This order must match the order in the 'producers' array below.
goLong := Value[0].AsBoolean;
goShort := Value[1].AsBoolean;
close := Value[2].AsExtended;
atr := Value[3].AsExtended;
lastHigh := Value[4].AsExtended;
lastLow := Value[5].AsExtended;
// The state machine logic for trade management remains identical.
case tradeState.Status of
tsFlat:
begin
if goLong then
begin
tradeState.Status := tsLong;
tradeState.EntryPrice := close;
tradeState.TakeProfit := lastHigh;
tradeState.StopLoss := close - atr * ATR_SL_MULTIPLIER;
end
else if goShort then
begin
tradeState.Status := tsShort;
tradeState.EntryPrice := close;
tradeState.TakeProfit := lastLow;
tradeState.StopLoss := close + atr * ATR_SL_MULTIPLIER;
end;
end;
tsLong:
begin
var newSL := close - atr * ATR_SL_MULTIPLIER;
if (newSL > tradeState.StopLoss) then
tradeState.StopLoss := newSL;
if (close >= tradeState.TakeProfit) or (close <= tradeState.StopLoss) then
tradeState.Status := tsFlat;
end;
tsShort:
begin
var newSL := close + atr * ATR_SL_MULTIPLIER;
if (newSL < tradeState.StopLoss) then
tradeState.StopLoss := newSL;
if (close <= tradeState.TakeProfit) or (close >= tradeState.StopLoss) then
tradeState.Status := tsFlat;
end;
end;
// Broadcast the current position status.
Broadcast(Integer(tradeState.Status) - Integer(tsLong));
Result := TState.Null;
end;
// To feed the aggregator, combine all required data streams into one.
// 1. Convert each producer to TProducer<TValue>.
var producers: TArray<TProducer<TValue>> :=
[
TValue.AsValue<Boolean>(GoLong),
TValue.AsValue<Boolean>(GoShort),
TValue.AsValue<Double>(Close1H),
TValue.AsValue<Double>(Atr50_1H),
TValue.AsValue<Double>(LastHigh_HMA20),
TValue.AsValue<Double>(LastLow_HMA20)
];
// 2. Join them into a single producer of an array of TValue.
var combinedProducer := TConverter.Join<TValue>(jmAll, producers);
// 3. Create the aggregator converter and chain it to the combined producer.
var strategyAggregator := TConverter<TArray<TValue>, Double>.CreateAggregation(aggregatorFunc);
Result := combinedProducer.Chain<Double>(strategyAggregator);
{$endregion}
end;
end.
+1 -1
View File
@@ -40,7 +40,7 @@ begin
var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50)); var ATR := Ohlc.Chain<Double>(TATR.CreateATR(50));
var conv := TConverter.Join<Double>([Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]); var conv := TConverter.Join<Double>(jmAll, [Ohlc.Field<Double>('Low'), Ohlc.Field<Double>('High'), Closes, ATR, Hull, Sma]);
// STAGE 1: Signal Generation. This converter is stateless regarding the trade itself. // STAGE 1: Signal Generation. This converter is stateless regarding the trade itself.
// It only detects the crossover event and prepares the data for the next stage. // It only detects the crossover event and prepares the data for the next stage.
+285
View File
@@ -0,0 +1,285 @@
unit Myc.Data.Types.Arrays;
interface
uses
System.Generics.Collections,
System.SysUtils,
Myc.Data.Types;
type
// An interface helper for IDataArrayValue.
TArrayValue = record
private
FArrayValue: IDataArrayValue;
function GetElementCount: Integer; inline;
function GetItem(Idx: Integer): TDataValue; inline;
public
constructor Create(const AArrayValue: IDataArrayValue);
class operator Implicit(const A: IDataArrayValue): TArrayValue; overload;
class operator Implicit(const A: TArrayValue): IDataArrayValue; overload;
property ElementCount: Integer read GetElementCount;
property Items[Idx: Integer]: TDataValue read GetItem; default;
end;
// An interface helper for IDataArrayType.
TArrayType = record
private
FArrayType: IDataArrayType;
function GetElementType: TDataType; inline;
function GetName: String; inline;
public
constructor Create(const AArrayType: IDataArrayType);
class operator Implicit(const A: IDataArrayType): TArrayType; overload;
class operator Implicit(const A: TArrayType): IDataArrayType; overload;
function CreateValue(const AItems: array of IDataValue): TArrayValue;
property Name: String read GetName;
property ElementType: TDataType read GetElementType;
end;
TDataValueHelper = record helper for TDataValue
public
function AsArray: TArrayValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsArray: TArrayType;
end;
// Public factory for creating and caching array types.
TArrayTypes = record
strict private
class var
FRegistry: TDictionary<IDataType, IDataArrayType>;
class constructor CreateClass;
class destructor DestroyClass;
public
class function GetType(const AElementType: TDataType): TArrayType; static;
end;
implementation
uses
System.SyncObjs;
type
{fwd}
TImplDataArrayType = class;
// Implements the array data value.
TImplDataArrayValue = class(TInterfacedObject, IDataValue, IDataArrayValue)
private
FArrayType: IDataArrayType;
FItems: TArray<IDataValue>;
function GetDataType: IDataType;
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
end;
// Implements the array data type.
TImplDataArrayType = class(TInterfacedObject, IDataType, IDataArrayType)
private
FElementType: IDataType;
function GetElementType: IDataType;
function GetName: String;
public
constructor Create(const AElementType: IDataType);
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
end;
{ TArrayValue }
constructor TArrayValue.Create(const AArrayValue: IDataArrayValue);
begin
FArrayValue := AArrayValue;
end;
function TArrayValue.GetElementCount: Integer;
begin
if Assigned(FArrayValue) then
Result := FArrayValue.ElementCount
else
Result := 0;
end;
function TArrayValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FArrayValue) then
Result := FArrayValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
class operator TArrayValue.Implicit(const A: TArrayValue): IDataArrayValue;
begin
Result := A.FArrayValue;
end;
class operator TArrayValue.Implicit(const A: IDataArrayValue): TArrayValue;
begin
Result.FArrayValue := A;
end;
{ TArrayType }
constructor TArrayType.Create(const AArrayType: IDataArrayType);
begin
FArrayType := AArrayType;
end;
function TArrayType.CreateValue(const AItems: array of IDataValue): TArrayValue;
begin
if Assigned(FArrayType) then
Result := FArrayType.CreateValue(AItems)
else
raise EAccessViolation.Create('Cannot create value from a nil array type.');
end;
function TArrayType.GetElementType: TDataType;
begin
if Assigned(FArrayType) then
Result := FArrayType.ElementType
else
Result := TDataType.Create(nil);
end;
function TArrayType.GetName: String;
begin
if Assigned(FArrayType) then
Result := FArrayType.Name
else
Result := '';
end;
class operator TArrayType.Implicit(const A: TArrayType): IDataArrayType;
begin
Result := A.FArrayType;
end;
class operator TArrayType.Implicit(const A: IDataArrayType): TArrayType;
begin
Result.FArrayType := A;
end;
{ TImplDataArrayValue }
constructor TImplDataArrayValue.Create(const AArrayType: IDataArrayType; const AItems: array of IDataValue);
var
i: Integer;
begin
inherited Create;
FArrayType := AArrayType;
SetLength(FItems, Length(AItems));
for i := 0 to High(AItems) do
FItems[i] := AItems[i];
end;
function TImplDataArrayValue.GetDataType: IDataType;
begin
Result := FArrayType;
end;
function TImplDataArrayValue.GetElementCount: Integer;
begin
Result := Length(FItems);
end;
function TImplDataArrayValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
{ TImplDataArrayType }
constructor TImplDataArrayType.Create(const AElementType: IDataType);
begin
inherited Create;
FElementType := AElementType;
end;
function TImplDataArrayType.CreateValue(const AItems: array of IDataValue): IDataArrayValue;
var
item: IDataValue;
i: Integer;
begin
// Validate that all items match the element type of this array type.
i := 0;
for item in AItems do
begin
if (item.DataType <> FElementType) then
raise EArgumentException.CreateFmt(
'Invalid data type for item at index %d. Expected ''%s'', but got ''%s''.',
[i, FElementType.Name, item.DataType.Name]);
inc(i);
end;
Result := TImplDataArrayValue.Create(Self, AItems);
end;
function TImplDataArrayType.GetElementType: IDataType;
begin
Result := FElementType;
end;
function TImplDataArrayType.GetName: String;
begin
Result := Format('Array<%s>', [FElementType.Name]);
end;
{ TDataValueHelper }
function TDataValueHelper.AsArray: TArrayValue;
begin
Result := Self.DataValue as IDataArrayValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsArray: TArrayType;
begin
Result := Self.DataType as IDataArrayType;
end;
{ TArrayTypes }
class constructor TArrayTypes.CreateClass;
begin
// IDataType interface keys work out-of-the-box with the default comparer.
FRegistry := TDictionary<IDataType, IDataArrayType>.Create;
end;
class destructor TArrayTypes.DestroyClass;
begin
FRegistry.Free;
end;
class function TArrayTypes.GetType(const AElementType: TDataType): TArrayType;
var
arrayTypeItf: IDataArrayType;
elementTypeItf: IDataType;
begin
elementTypeItf := AElementType.DataType; // Get underlying interface from helper
if not Assigned(elementTypeItf) then
raise EArgumentException.Create('Cannot create an array type with a nil element type.');
TMonitor.Enter(FRegistry);
try
if not FRegistry.TryGetValue(elementTypeItf, arrayTypeItf) then
begin
arrayTypeItf := TImplDataArrayType.Create(elementTypeItf);
FRegistry.Add(elementTypeItf, arrayTypeItf);
end;
finally
TMonitor.Exit(FRegistry);
end;
Result := arrayTypeItf;
end;
end.
+113
View File
@@ -0,0 +1,113 @@
unit Myc.Data.Types.Float;
interface
uses
Myc.Data.Types;
type
TDataValueHelper = record helper for TDataValue
public
function AsFloat: IDataFloatValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsFloat: IDataFloatType;
end;
// Public factory for creating float values.
TFloatType = record
public
class function CreateValue(Init: Double): IDataFloatValue; static;
end;
implementation
uses
System.SysUtils;
type
// Implements the float data value.
TImplDataFloatValue = class(TInterfacedObject, IDataValue, IDataFloatValue)
private
FValue: Double;
public
constructor Create(const AValue: Double);
// IDataValue
function GetDataType: IDataType;
// IDataFloatValue
function GetValue: Double;
end;
// Implements the float data type.
TImplDataFloatType = class(TInterfacedObject, IDataType, IDataFloatType)
strict private
class var
FSingleton: IDataFloatType;
class constructor CreateClass;
public
function GetName: String;
function CreateValue(Init: Double): IDataFloatValue;
class property Singleton: IDataFloatType read FSingleton;
end;
{ TImplDataFloatValue }
constructor TImplDataFloatValue.Create(const AValue: Double);
begin
inherited Create;
FValue := AValue;
end;
function TImplDataFloatValue.GetDataType: IDataType;
begin
Result := TImplDataFloatType.Singleton;
end;
function TImplDataFloatValue.GetValue: Double;
begin
Result := FValue;
end;
{ TImplDataFloatType }
class constructor TImplDataFloatType.CreateClass;
begin
FSingleton := TImplDataFloatType.Create;
end;
function TImplDataFloatType.GetName: String;
begin
Result := 'Float';
end;
function TImplDataFloatType.CreateValue(Init: Double): IDataFloatValue;
begin
Result := TImplDataFloatValue.Create(Init);
end;
{ TFloatType }
class function TFloatType.CreateValue(Init: Double): IDataFloatValue;
begin
Result := TImplDataFloatType.Singleton.CreateValue(Init);
end;
{ TDataValueHelper }
function TDataValueHelper.AsFloat: IDataFloatValue;
begin
Result := Self.DataValue as IDataFloatValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsFloat: IDataFloatType;
begin
Result := Self.DataType as IDataFloatType;
end;
end.
+111
View File
@@ -0,0 +1,111 @@
unit Myc.Data.Types.Ordinal;
interface
uses
Myc.Data.Types;
type
TDataValueOrdinalHelper = record helper for TDataValue
public
function AsOrdinal: IDataOrdinalValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsOrdinal: IDataOrdinalType;
end;
TOrdinalType = record
class function CreateValue(Init: Int64): IDataOrdinalValue; static;
end;
implementation
uses
System.SysUtils;
type
// Implements the ordinal data value.
TImplDataOrdinalValue = class(TInterfacedObject, IDataValue, IDataOrdinalValue)
private
FValue: Int64;
public
constructor Create(const AValue: Int64);
// IDataValue
function GetDataType: IDataType;
// IDataOrdinalValue
function GetValue: Int64;
end;
// Implements the ordinal data type.
TImplDataOrdinalType = class(TInterfacedObject, IDataType, IDataOrdinalType)
strict private
class var
FSingleton: IDataOrdinalType;
class constructor CreateClass;
public
function GetName: String;
function CreateValue(Init: Int64): IDataOrdinalValue;
class property Singleton: IDataOrdinalType read FSingleton;
end;
{ TImplDataOrdinalValue }
constructor TImplDataOrdinalValue.Create(const AValue: Int64);
begin
inherited Create;
FValue := AValue;
end;
function TImplDataOrdinalValue.GetDataType: IDataType;
begin
Result := TImplDataOrdinalType.Singleton;
end;
function TImplDataOrdinalValue.GetValue: Int64;
begin
Result := FValue;
end;
{ TImplDataOrdinalType }
class constructor TImplDataOrdinalType.CreateClass;
begin
FSingleton := TImplDataOrdinalType.Create;
end;
function TImplDataOrdinalType.GetName: String;
begin
Result := 'Integer';
end;
function TImplDataOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin
Result := TImplDataOrdinalValue.Create(Init);
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsOrdinal: IDataOrdinalType;
begin
Result := DataType as IDataOrdinalType;
end;
{ TDataValueOrdinalHelper }
function TDataValueOrdinalHelper.AsOrdinal: IDataOrdinalValue;
begin
Result := DataValue as IDataOrdinalValue;
end;
{ TOrdinalType }
class function TOrdinalType.CreateValue(Init: Int64): IDataOrdinalValue;
begin
Result := TImplDataOrdinalType.Singleton.CreateValue(Init);
end;
end.
+399
View File
@@ -0,0 +1,399 @@
unit Myc.Data.Types.Records;
interface
uses
System.Generics.Collections,
System.SysUtils,
Myc.Data.Types;
type
// An interface helper for IDataRecordType.
TRecordType = record
private
FRecordType: IDataRecordType;
function GetFieldCount: Integer; inline;
function GetField(Idx: Integer): TRecordField; inline;
function GetName: String; inline;
public
constructor Create(const ARecordType: IDataRecordType);
class operator Implicit(const A: IDataRecordType): TRecordType; overload;
class operator Implicit(const A: TRecordType): IDataRecordType; overload;
function CreateValue(const AItems: array of IDataValue): TDataValue;
function IndexOf(const AName: string): Integer; inline;
class operator Equal(const A, B: TRecordType): Boolean;
property Name: String read GetName;
property FieldCount: Integer read GetFieldCount;
property Fields[Idx: Integer]: TRecordField read GetField; default;
end;
// An interface helper for IDataRecordValue.
TRecordValue = record
private
FRecordValue: IDataRecordValue;
function GetDataType: TRecordType; inline;
function GetItem(Idx: Integer): TDataValue; inline;
public
constructor Create(const ARecordValue: IDataRecordValue);
function CreateValue(const AItems: array of IDataValue): TDataValue;
class operator Implicit(const A: IDataRecordValue): TRecordValue; overload;
class operator Implicit(const A: TRecordValue): IDataRecordValue; overload;
property DataType: TRecordType read GetDataType;
property Items[Idx: Integer]: TDataValue read GetItem; default;
end;
TDataValueRecordHelper = record helper for TDataValue
public
function AsRecord: TRecordValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsRecord: TRecordType;
end;
// Public factory for creating record types.
TRecordTypes = record
strict private
class var
FRegistry: TDictionary<TArray<TRecordField>, IDataRecordType>;
class constructor CreateClass;
class destructor DestroyClass;
public
class function GetType(const AFields: TArray<TRecordField>): TRecordType; static;
end;
implementation
uses
System.Generics.Defaults,
System.Hash,
System.SyncObjs;
type
{fwd}
TImplDataRecordType = class;
// Custom comparer for TArray<TRecordField> to be used as a dictionary key.
TRecordFieldComparer = class(TInterfacedObject, IEqualityComparer<TArray<TRecordField>>)
public
function Equals(const Left, Right: TArray<TRecordField>): Boolean; reintroduce;
function GetHashCode(const Value: TArray<TRecordField>): Integer; reintroduce;
end;
// Implements the record data value.
TImplDataRecordValue = class(TInterfacedObject, IDataValue, IDataRecordValue)
private
FDataType: IDataRecordType;
FItems: TArray<IDataValue>;
function GetDataType: IDataType;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
end;
// Implements the record data type.
TImplDataRecordType = class(TInterfacedObject, IDataType, IDataRecordType)
private
FFields: TArray<TRecordField>;
FFieldMap: TDictionary<string, Integer>; // For fast lookups by name
function GetName: String;
function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer;
public
constructor Create(const AFields: array of TRecordField);
destructor Destroy; override;
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
end;
{ TRecordValue }
constructor TRecordValue.Create(const ARecordValue: IDataRecordValue);
begin
FRecordValue := ARecordValue;
end;
function TRecordValue.CreateValue(const AItems: array of IDataValue): TDataValue;
var
recordTypeItf: IDataRecordType;
begin
recordTypeItf := Self.DataType;
if not Assigned(recordTypeItf) then
raise EAccessViolation.Create('Cannot create value from a nil record type.');
Result := recordTypeItf.CreateValue(AItems);
end;
function TRecordValue.GetDataType: TRecordType;
begin
if Assigned(FRecordValue) then
Result := FRecordValue.DataType as IDataRecordType
else
Result := TRecordType.Create(nil);
end;
function TRecordValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FRecordValue) then
Result := FRecordValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
class operator TRecordValue.Implicit(const A: TRecordValue): IDataRecordValue;
begin
Result := A.FRecordValue;
end;
class operator TRecordValue.Implicit(const A: IDataRecordValue): TRecordValue;
begin
Result.FRecordValue := A;
end;
{ TRecordType }
constructor TRecordType.Create(const ARecordType: IDataRecordType);
begin
FRecordType := ARecordType;
end;
function TRecordType.CreateValue(const AItems: array of IDataValue): TDataValue;
begin
if Assigned(FRecordType) then
Result := FRecordType.CreateValue(AItems)
else
raise EAccessViolation.Create('Cannot create value from a nil record type.');
end;
function TRecordType.GetField(Idx: Integer): TRecordField;
begin
if Assigned(FRecordType) then
Result := FRecordType.Fields[Idx]
else
Result := Default(TRecordField);
end;
function TRecordType.GetFieldCount: Integer;
begin
if Assigned(FRecordType) then
Result := FRecordType.FieldCount
else
Result := 0;
end;
function TRecordType.GetName: String;
begin
if Assigned(FRecordType) then
Result := FRecordType.Name
else
Result := '';
end;
function TRecordType.IndexOf(const AName: string): Integer;
begin
if Assigned(FRecordType) then
Result := FRecordType.IndexOf(AName)
else
Result := -1;
end;
class operator TRecordType.Equal(const A, B: TRecordType): Boolean;
begin
Result := A.FRecordType = B.FRecordType;
end;
class operator TRecordType.Implicit(const A: TRecordType): IDataRecordType;
begin
Result := A.FRecordType;
end;
class operator TRecordType.Implicit(const A: IDataRecordType): TRecordType;
begin
Result.FRecordType := A;
end;
{ TRecordFieldComparer }
function TRecordFieldComparer.Equals(const Left, Right: TArray<TRecordField>): Boolean;
var
i: Integer;
begin
if (Length(Left) <> Length(Right)) then
exit(False);
for i := 0 to High(Left) do
begin
if (CompareStr(Left[i].Name, Right[i].Name) <> 0) or (Left[i].DataType <> Right[i].DataType) then
exit(False);
end;
Result := True;
end;
function TRecordFieldComparer.GetHashCode(const Value: TArray<TRecordField>): Integer;
var
field: TRecordField;
begin
Result := 0;
for field in Value do
begin
Result := THashBobJenkins.GetHashValue(field.Name) xor THashFNV1a32.GetHashValue(field.DataType, SizeOf(IDataType)) xor Result;
end;
end;
{ TImplDataRecordValue }
constructor TImplDataRecordValue.Create(const ADataType: IDataRecordType; const AItems: array of IDataValue);
var
i: Integer;
begin
inherited Create;
FDataType := ADataType;
SetLength(FItems, Length(AItems));
for i := 0 to High(AItems) do
FItems[i] := AItems[i];
end;
function TImplDataRecordValue.GetDataType: IDataType;
begin
Result := FDataType;
end;
function TImplDataRecordValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
{ TImplDataRecordType }
constructor TImplDataRecordType.Create(const AFields: array of TRecordField);
var
i: Integer;
field: TRecordField;
begin
inherited Create;
FFieldMap := TDictionary<string, Integer>.Create;
SetLength(FFields, Length(AFields));
for i := 0 to High(AFields) do
begin
field := AFields[i];
if FFieldMap.ContainsKey(field.Name) then
raise EArgumentException.CreateFmt('Duplicate field name: ''%s''', [field.Name]);
FFields[i] := field;
FFieldMap.Add(field.Name, i);
end;
end;
destructor TImplDataRecordType.Destroy;
begin
FFieldMap.Free;
inherited;
end;
function TImplDataRecordType.CreateValue(const AItems: array of IDataValue): IDataRecordValue;
var
i: Integer;
begin
if (Length(AItems) <> Length(FFields)) then
raise EArgumentException
.CreateFmt('Invalid number of items for this record type. Expected %d, but got %d.', [Length(FFields), Length(AItems)]);
for i := 0 to High(AItems) do
if (AItems[i].DataType <> FFields[i].DataType) then
raise EArgumentException.CreateFmt(
'Invalid data type for field ''%s'' at index %d. Expected ''%s'', but got ''%s''.',
[FFields[i].Name, i, FFields[i].DataType.Name, AItems[i].DataType.Name]);
Result := TImplDataRecordValue.Create(Self, AItems);
end;
function TImplDataRecordType.GetField(Idx: Integer): TRecordField;
begin
Result := FFields[Idx];
end;
function TImplDataRecordType.GetFieldCount: Integer;
begin
Result := Length(FFields);
end;
function TImplDataRecordType.GetName: String;
var
i: Integer;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
sb.Append('Record<');
for i := 0 to High(FFields) do
begin
sb.Append(FFields[i].Name);
sb.Append(': ');
sb.Append(FFields[i].DataType.Name);
if (i < High(FFields)) then
sb.Append(', ');
end;
sb.Append('>');
Result := sb.ToString;
finally
sb.Free;
end;
end;
function TImplDataRecordType.IndexOf(const AName: string): Integer;
begin
if not FFieldMap.TryGetValue(AName, Result) then
Result := -1;
end;
{ TDataValueRecordHelper }
function TDataValueRecordHelper.AsRecord: TRecordValue;
begin
Result := Self.DataValue as IDataRecordValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsRecord: TRecordType;
begin
Result := Self.DataType as IDataRecordType;
end;
{ TRecordTypes }
class constructor TRecordTypes.CreateClass;
begin
FRegistry := TDictionary<TArray<TRecordField>, IDataRecordType>.Create(TRecordFieldComparer.Create);
end;
class destructor TRecordTypes.DestroyClass;
begin
FRegistry.Free;
end;
class function TRecordTypes.GetType(const AFields: TArray<TRecordField>): TRecordType;
var
recordTypeItf: IDataRecordType;
begin
TMonitor.Enter(FRegistry);
try
if not FRegistry.TryGetValue(AFields, recordTypeItf) then
begin
recordTypeItf := TImplDataRecordType.Create(AFields);
FRegistry.Add(AFields, recordTypeItf);
end;
finally
TMonitor.Exit(FRegistry);
end;
Result := recordTypeItf;
end;
end.
+200
View File
@@ -0,0 +1,200 @@
unit Myc.Data.Types.Tuple;
interface
uses
System.SysUtils,
Myc.Data.Types;
type
// An interface helper for the singleton IDataTupleType.
TTupleType = record
private
FTupleType: IDataTupleType;
function GetName: String; inline;
public
constructor Create(const ATupleType: IDataTupleType);
class operator Implicit(const A: IDataTupleType): TTupleType; overload;
class operator Implicit(const A: TTupleType): IDataTupleType; overload;
property Name: String read GetName;
end;
// An interface helper for IDataTupleValue.
TTupleValue = record
private
FTupleValue: IDataTupleValue;
function GetItem(Idx: Integer): TDataValue; inline;
function GetItemCount: Integer; inline;
public
constructor Create(const ATupleValue: IDataTupleValue);
class operator Implicit(const A: IDataTupleValue): TTupleValue; overload;
class operator Implicit(const A: TTupleValue): IDataTupleValue; overload;
property ItemCount: Integer read GetItemCount;
property Items[Idx: Integer]: TDataValue read GetItem; default;
end;
TDataValueHelper = record helper for TDataValue
public
function AsTuple: TTupleValue;
end;
TDataTypeHelper = record helper for TDataType
public
function AsTuple: TTupleType;
end;
// Public factory for creating simple, non-cached tuple values.
TTuple = record
public
class function Create(const AItems: array of IDataValue): IDataTupleValue; static;
end;
implementation
type
// Implements the simple tuple data value.
TImplDataTupleValue = class(TInterfacedObject, IDataValue, IDataTupleValue)
private
FItems: TArray<IDataValue>;
function GetDataType: IDataType;
function GetItemCount: Integer;
function GetItem(Idx: Integer): IDataValue;
public
constructor Create(const AItems: array of IDataValue);
end;
// Implements the singleton tuple data type.
TImplDataTupleType = class(TInterfacedObject, IDataType, IDataTupleType)
strict private
class var
FSingleton: IDataTupleType;
class constructor CreateClass;
private
function GetName: String;
public
class property Singleton: IDataTupleType read FSingleton;
end;
{ TTupleValue }
constructor TTupleValue.Create(const ATupleValue: IDataTupleValue);
begin
FTupleValue := ATupleValue;
end;
function TTupleValue.GetItem(Idx: Integer): TDataValue;
begin
if Assigned(FTupleValue) then
Result := FTupleValue.Items[Idx]
else
Result := TDataValue.Create(nil);
end;
function TTupleValue.GetItemCount: Integer;
begin
if Assigned(FTupleValue) then
Result := FTupleValue.ItemCount
else
Result := 0;
end;
class operator TTupleValue.Implicit(const A: TTupleValue): IDataTupleValue;
begin
Result := A.FTupleValue;
end;
class operator TTupleValue.Implicit(const A: IDataTupleValue): TTupleValue;
begin
Result.FTupleValue := A;
end;
{ TTupleType }
constructor TTupleType.Create(const ATupleType: IDataTupleType);
begin
FTupleType := ATupleType;
end;
function TTupleType.GetName: String;
begin
if Assigned(FTupleType) then
Result := FTupleType.Name
else
Result := '';
end;
class operator TTupleType.Implicit(const A: TTupleType): IDataTupleType;
begin
Result := A.FTupleType;
end;
class operator TTupleType.Implicit(const A: IDataTupleType): TTupleType;
begin
Result.FTupleType := A;
end;
{ TImplDataTupleValue }
constructor TImplDataTupleValue.Create(const AItems: array of IDataValue);
var
i: Integer;
begin
inherited Create;
SetLength(FItems, Length(AItems));
for i := 0 to High(AItems) do
FItems[i] := AItems[i];
end;
function TImplDataTupleValue.GetDataType: IDataType;
begin
Result := TImplDataTupleType.Singleton;
end;
function TImplDataTupleValue.GetItem(Idx: Integer): IDataValue;
begin
Result := FItems[Idx];
end;
function TImplDataTupleValue.GetItemCount: Integer;
begin
Result := Length(FItems);
end;
{ TImplDataTupleType }
class constructor TImplDataTupleType.CreateClass;
begin
FSingleton := TImplDataTupleType.Create;
end;
function TImplDataTupleType.GetName: String;
begin
Result := 'Tuple';
end;
{ TDataValueHelper }
function TDataValueHelper.AsTuple: TTupleValue;
begin
Result := Self.DataValue as IDataTupleValue;
end;
{ TDataTypeHelper }
function TDataTypeHelper.AsTuple: TTupleType;
begin
Result := Self.DataType as IDataTupleType;
end;
{ TTuple }
class function TTuple.Create(const AItems: array of IDataValue): IDataTupleValue;
begin
// Create a new value instance. The instance itself knows its item count
// and will report the singleton "Tuple" type via its DataType property.
Result := TImplDataTupleValue.Create(AItems);
end;
end.
+176
View File
@@ -0,0 +1,176 @@
unit Myc.Data.Types;
interface
type
IDataType = interface
function GetName: String;
property Name: String read GetName;
end;
IDataValue = interface
function GetDataType: IDataType;
property DataType: IDataType read GetDataType;
end;
IDataOrdinalValue = interface(IDataValue)
['{DF512FD0-D513-4B96-9687-C80624E475A4}']
function GetValue: Int64;
property Value: Int64 read GetValue;
end;
IDataOrdinalType = interface(IDataType)
['{BE97F145-3634-4F56-9783-FD2C3DD485CA}']
function CreateValue(Init: Int64): IDataOrdinalValue;
end;
IDataFloatValue = interface(IDataValue)
['{A6E1E8B5-B8E5-4F4B-9B2E-8E8E9F8F8B8E}']
function GetValue: Double;
property Value: Double read GetValue;
end;
IDataFloatType = interface(IDataType)
['{B7E2E9B6-B9E6-4F5B-9C3E-9E9E0F9F9C9F}']
function CreateValue(Init: Double): IDataFloatValue;
end;
IDataRecordValue = interface(IDataValue)
['{53B63A49-720D-4E3E-8EE5-3EA45BA93E58}']
function GetItem(Idx: Integer): IDataValue;
property Items[Idx: Integer]: IDataValue read GetItem; default;
end;
TRecordField = record
Name: string;
DataType: IDataType;
public
constructor Create(const AName: string; const ADataType: IDataType);
end;
IDataRecordType = interface(IDataType)
['{7A266BA0-B1AF-416B-941F-A730D6EDA333}']
function GetFieldCount: Integer;
function GetField(Idx: Integer): TRecordField;
function IndexOf(const AName: string): Integer;
function CreateValue(const AItems: array of IDataValue): IDataRecordValue;
property FieldCount: Integer read GetFieldCount;
property Fields[Idx: Integer]: TRecordField read GetField; default;
end;
IDataTupleValue = interface(IDataValue)
['{E1D5B0D1-8A1C-4B7E-9F2D-3A4B5C6D7E8F}']
function GetItemCount: Integer;
function GetItem(Idx: Integer): IDataValue;
property ItemCount: Integer read GetItemCount;
property Items[Idx: Integer]: IDataValue read GetItem; default;
end;
IDataTupleType = interface(IDataType)
['{9442043E-99AC-4464-99E4-75F1BE1F3118}']
end;
IDataArrayValue = interface(IDataValue)
['{1F3A4B5C-6D7E-4F1A-8B9C-0D1E2F3A4B5C}']
function GetElementCount: Integer;
function GetItem(Idx: Integer): IDataValue;
property ElementCount: Integer read GetElementCount;
property Items[Idx: Integer]: IDataValue read GetItem; default;
end;
IDataArrayType = interface(IDataType)
['{7E8F9A0B-C1D2-4E3F-A4B5-C6D7E8F9A0B1}']
function GetElementType: IDataType;
function CreateValue(const AItems: array of IDataValue): IDataArrayValue;
property ElementType: IDataType read GetElementType;
end;
TDataType = record
private
FDataType: IDataType;
function GetName: String; inline;
public
constructor Create(const ADataType: IDataType);
class operator Implicit(const A: IDataType): TDataType; overload;
class operator Implicit(const A: TDataType): IDataType; overload;
property DataType: IDataType read FDataType;
property Name: String read GetName;
end;
TDataValue = record
private
FDataValue: IDataValue;
function GetDataType: IDataType; inline;
public
constructor Create(const ADataValue: IDataValue);
class operator Implicit(const A: IDataValue): TDataValue; overload;
class operator Implicit(const A: TDataValue): IDataValue; overload;
property DataValue: IDataValue read FDataValue;
property DataType: IDataType read GetDataType;
end;
implementation
{ TRecordField }
constructor TRecordField.Create(const AName: string; const ADataType: IDataType);
begin
Name := AName;
DataType := ADataType;
end;
{ TDataType }
constructor TDataType.Create(const ADataType: IDataType);
begin
FDataType := ADataType;
end;
function TDataType.GetName: String;
begin
if Assigned(FDataType) then
Result := FDataType.Name
else
Result := '';
end;
class operator TDataType.Implicit(const A: TDataType): IDataType;
begin
Result := A.FDataType;
end;
class operator TDataType.Implicit(const A: IDataType): TDataType;
begin
Result.FDataType := A;
end;
{ TDataValue }
constructor TDataValue.Create(const ADataValue: IDataValue);
begin
FDataValue := ADataValue;
end;
function TDataValue.GetDataType: IDataType;
begin
if Assigned(FDataValue) then
Result := FDataValue.DataType
else
Result := nil;
end;
class operator TDataValue.Implicit(const A: TDataValue): IDataValue;
begin
Result := A.FDataValue;
end;
class operator TDataValue.Implicit(const A: IDataValue): TDataValue;
begin
Result.FDataValue := A;
end;
end.
+219
View File
@@ -0,0 +1,219 @@
# Zweck und Ziele
* Unterstütze mich bei der Entwicklung unter Embarcadero Delphi.
* Ich bin ein sehr erfahrener Softwareentwickler. Fasse dich kurz und nutze Fachsprache.
* Wir nutzen immer die neueste Delphi-Version, aktuell ist das Delphi 12.3 Athens.
# Allgemeine Regeln
* Sprache im Code und in den Kommentaren: Englisch
* Sprache im Chat: Deutsch
* Ändere niemals den Code, den ich poste - es sei denn, ich fordere dich ausdrücklich dazu auf. Wenn ich Code poste, dann analysiere ihn zunächst und weise mich gegebenenfalls auf Unstimmigkeiten hin.
* Von mir geposteter Code ersetzt grundsätzlich die ältere Versionen des selben Codes.
* Bei der Code-Analyse zählt nur die tatsächliche Implementierung. Kommentare können veraltet sein. Weise mich auf Differenzen zwischen Implementierung und Kommentaren hin.
* Finde Schlüsselstellen im Code und zeige mir durch eine kurze Erklärung, dass du sie verstanden hast.
* Effizienz ist mir sehr wichtig. Wenn dir etwas auffällt, das die Performance negativ beeinflussen kann, dann weise mich darauf hin.
* Schlage gegebenenfalls Korrekturen vor. Warte auf meine Zustimmung, bevor die sie vornimmst.
* Erkläre niemals grundlegende Syntax, es sei denn ich frage ausdrücklich danach.
* Fasse dich kurz. Behalte den Kontext während der gesamten Konversation bei. Alle Ideen und Antworten sollen mit der vorherigen Diskussion in Verbindung stehen. Schweife nicht ab.
* Wenn ich unvollständigen Code poste, erstelle einen Plan, wie die Implementierung aussehen könnte und präsentiere ihn kurz und prägnant.
# TODO
* Wenn ich Code poste, der einen TODO-Eintrag enthält, dann implementiere die dort spezifizierten Anforderungen.
* Ändere *nicht* den umliegenden Code. Nutze den vorhandenen Kontext um die Anforderung zu erledigen.
* Dokumentiere die Änderung knapp direkt im Code.
* Gib mir als Ergebnis den vollständigen Codeblock zurück.
# Code-Generierung
* Befolge die gängigen Delphi-Formatierungsstandards mit folgenden Ausnahmen:
- Einrückung mit 4 Leerzeichen anstelle von 2. Auch bei Kommentaren.
- Das Code-Format ist UTF-8. Nur ASCII, keine Sonderzeichen erlaubt (insb. kein No-Break-Space!)
- Folgende Schlüsselwörter müssen klein geschrieben werden:
and, or, not, mod, div, in, as, is, array of, sizeof(), inc(), dec(), exit, inc, dec, shl, shr
- Compiler-Direktiven (z.B. $region) sollen immer klein geschrieben werden.
* Ändere niemals vorhandene Bezeichner im vom Benutzer bereitgestellten Code, es sei denn du wirst dazu aufgefordert.
* Bei verketteten Vergleichen innerhalb von if-Anweisungen müssen immer runde Klammern verwendet werden, um Teilausdrücke klar zu gruppieren:
"if (a > b) and (c < d) then"
* Funktions- und Prozedurparameter dürfen keinen Präfix haben. Sie sollten großgeschrieben werden:
"procedure ProcessData(InputArray: TIntegerArray; const Count: Integer)"
* Ausnahme: Parameter von Konstruktoren haben "A" als Präfix:
"constructor Create(const AValue: Integer)"
* Lokale Variablen sollten mit einem kleinen Buchstaben beginnen (camel case) (z.B. tempValue: Integer;). Wenn ich von dieser Regel abweiche, ist das in Ordnung.
* Achte beim Erstellen von Format-Strings (z. B. mit Format()), darauf, dass die Anzahl der Parameter genau der Anzahl der Format-Tags (z. B. %s, %d) entspricht. Überprüfe die Typkompatibilität.
* Denke daran, dass Delphi nicht zwischen Groß- und Kleinschreibung unterscheidet. Bezeichner müssen sich immer von Schlüsselwörtern unterscheiden.
* Interfaces benötigen keine GUIDs. Füge keine GUIDs in Interfaces ein und schlagen Sie dies auch nicht vor. Wenn ein gegebenes Interface keine GUID hat, ist das so gewollt. GUIDs werden ausschließlich von mir vergeben. Füge niemals selbst eine GUID hinzu.
* TThread ist in System.Classes definiert.
* TInterlocked ist in System.SyncObjs definiert.
* Statement-Blöcke werden mit begin..end eingekapselt. (Niemals mit Klammern!)
* begin und end stehen am Anfang einer neuen Zeile. then steht nie am Anfang einer neuen Zeile.
* RECORDs, die einen Initialize-Operator haben, sind Managed Records. Sie benötigen also kein explizites Create.
# In Unit-Tests
* Verwende nur statische Strings für Log-Einträge und Asserts. Keine Format(), ToString usw. (Das verursacht Speicherlecks außerhalb des Test-Gültigkeitsbereichs, sodass ein Leak vom Memory Manager gemeldet wird.)
* Verwende das Attribut für parametrische Tests, um verschiedene Szenarien durchzuspielen. Z. B. [TestCase('TestName', 'Parameter1,Parameter2,...')]
# Kommentare im Code
* Vermeide jegliche Kommentare, die Änderungen am Code beschreiben. Z.B. `// hier wurde was geändert`. Das mag ich gar nicht.
* Kommentare sind immer englisch.
* Benutze keine HTML-Tags (`<summary>`, etc.)!
* Benutze `//` oder `(* *)` und fasse dich extrem kurz. Meistens genügen Einzeiler vor den Deklarationen.
* Kommentare in der interface-Sektion einer Unit sollen die Schnittstelle dokumentieren. Dokumentiere ausschließlich Elemente, die auch von außen zugänglich sind, und beziehe dich auch nur auf Elemente, die von außen zugänglich sind. Im Interface wird beschrieben, **was** eine Funktion macht. Es wird nicht beschrieben **wie** sie es macht!
* Kommentare im Implementation-Teil sollten sehr sparsam eingesetzt werden. Sie sind nur nötig, wenn etwas wirklich kompliziertes Beschrieben werden muss und auch nur, wenn sich die Funktion nicht aus dem Quelltext ergibt.
* Jede Klassen-, Record-, oder Interface-Definition sollte einen sinnvollen Einzeiler haben.
# Refactoring
* Umschließe alle Reader- und Writer-Properties innerhalb einer Interface-Definition mit eine Region 'private'. So zum Beispiel:
```
IConverter = interface(IMycProcessor<S>)
{$region 'private'}
function GetSender: TDataProvider<T>.IDataProvider;
{$endregion}
property Sender: TDataProvider<T>.IDataProvider read GetSender;
end;
```
# Projektplan
* **Wenn ich dich darum bitte**, erzeuge eine Zusammenfassung der Ergebnisse unserer Unterhaltung. Diese möchte ich in einen externen Projektplan kopieren.
- Formatiere in Markdown. Gib als Antwort nur den Projektplan aus (damit ich ihn direkt kopieren kann).
- Füge Datum und Uhrzeit hinzu.
- Gliedere in der Reihenfolge: Motivation - Ziel - Ergebnis
- Fass dich kurz
* Füge eine kurze Todo-Liste an, welche die nächsten Schritte skizziert.
# Interface helper
**Interface helper** sind ein Konzept, dass *nicht* explizit in Delphi/Pascal verankert ist. Es werden stattdessen managed records benutzt um ein Interface zu kapseln und die zugrundeliegende Implementierung vollständig zu verbergen.
- Ein "interface helper" ist ein managed record, das immer nur **genau ein** Interface referenziert.
- Die Definition des Interface findet sich meist im Scope des helpers (ganz am Anfang mit Default-Visibility).
- Es verbirgt die verschiedenen Implementierungen des Interface und fungiert als generische "Instanz" des interface.
- interface helper unterstützen das **null object pattern**. Der Sinn dieses Patterns ist es, nil-Prüfungen überflüssig zu machen und stattdessen ein Null-Objekt mit definiertem "leerem" Verhalten zu haben.
- Die Implementierungen des Interfaces finden sich oft in "Core"-Klassen, oder im implementation-Teil der Unit. Diese Implementierungen sollen von Benutzern nicht direkt eingebunden werden (außer zum Testen.)
* Wenn ich dich dazu auffordere sollst du ihn so weit wie möglich selbst erzeugen, oder einen unvollständigen helper ergänzen. Auf jeden Fall enthält ein interface helper:
- einen Konstruktor
- zwei implicit-operatoren, die vom helper zum interface casten (und umgekehrt)
- Wrapper für die Methoden und Properties des Interface.
- ein class property "Null".
* Direkte Wrapper auf Interface-Methoden sind *inline*.
* Immer wenn ein interface helper für ein interface vorhanden wird, soll er auch benutzt werden. Greife nicht direkt auf die Implementierung zu, lasse den helper das erledigen. Beispiel:
```
type
TFuture<T> = record
type
IFuture = interface
function GetValue: T;
function GetDone: TState;
end;
strict private
class var
FNull: IFuture;
class constructor CreateClass;
private
FFuture: IFuture;
function GetDone: TState; inline;
function GetValue: T; inline;
public
constructor Create(const AFuture: IFuture);
class operator Initialize(out Dest: TFuture<T>);
class operator Implicit(const A: IFuture): TFuture<T>; overload;
class operator Implicit(const A: TFuture<T>): IFuture; overload;
class property Null: IFuture read FNull;
// Wrapper methods for IFuture
property Done: TState read GetDone;
property Value: T read GetValue;
end;
constructor TFuture<T>.Create(const AFuture: IFuture);
begin
FFuture := AFuture;
if not Assigned(FFuture) then
FFuture := FNull;
end;
class constructor TFuture<T>.CreateClass;
begin
FNull := TNullFuture.Create;
end;
class operator TFuture<T>.Implicit(const A: IFuture): TFuture<T>;
begin
Result.FFuture := A;
end;
class operator TFuture<T>.Implicit(const A: TFuture<T>): IFuture;
begin
Result := A.FFuture;
end;
class operator TFuture<T>.Initialize(out Dest: TFuture<T>);
begin
Dest.FFuture := FNull;
end;
function TFuture<T>.GetDone: TState;
begin
Result := FFuture.Done;
end;
function TFuture<T>.GetValue: T;
begin
Result := FFuture.Value;
end;
```
+16
View File
@@ -0,0 +1,16 @@
unit Myc.Data.Component;
interface
uses
Myc.Signals,
Myc.Data.Pipeline;
type
IDataType = interface
end;
IDataTypeRegistry = interface
procedure RegisterType(end; IDataComponentParameter = interface property end; implementation end.
+103 -9
View File
@@ -193,8 +193,12 @@ type
function Consume(const Value: T): TState; override; final; function Consume(const Value: T): TState; override; final;
end; end;
// Endpoint that collects data into a series. IDataJoin<T> = interface(IProducer<TArray<T>>)
TMycDataJoin<T> = class(TInterfacedObject, IProducer<TArray<T>>) function GetConsumers(Idx: Integer): IConsumer<T>;
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
end;
TMycDataJoinAll<T> = class(TInterfacedObject, IProducer<TArray<T>>, IDataJoin<T>)
private private
FConsumers: array of record FConsumers: array of record
Consumer: TMycGenericConsumer<T>; Consumer: TMycGenericConsumer<T>;
@@ -214,6 +218,25 @@ type
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers; property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
end; end;
TMycDataJoinAny<T> = class(TInterfacedObject, IProducer<TArray<T>>, IDataJoin<T>)
private
FConsumers: array of TMycGenericConsumer<T>;
FValues: TArray<T>;
FInit: TArray<Boolean>;
FInitCount: Integer;
FContainedProvider: TMycContainedProducer<TArray<T>>;
FLock: TSpinLock;
function Consume(Idx: Integer; const Value: T): TState;
function GetConsumers(Idx: Integer): IConsumer<T>;
function Link(const Consumer: IConsumer<TArray<T>>): TTag;
procedure Unlink(Tag: TTag);
public
constructor Create(ACount: Integer);
destructor Destroy; override;
property Consumers[Idx: Integer]: IConsumer<T> read GetConsumers;
end;
TMycComposedConverter<S, T> = class(TInterfacedObject, IConverter<S, T>) TMycComposedConverter<S, T> = class(TInterfacedObject, IConverter<S, T>)
private private
FConsumer: IConsumer<S>; FConsumer: IConsumer<S>;
@@ -589,9 +612,9 @@ begin
FQueue := Result; FQueue := Result;
end; end;
{ TMycDataJoin<T> } { TMycDataJoinAll<T> }
constructor TMycDataJoin<T>.Create(ACount: Integer); constructor TMycDataJoinAll<T>.Create(ACount: Integer);
begin begin
inherited Create; inherited Create;
@@ -616,7 +639,7 @@ begin
end; end;
end; end;
destructor TMycDataJoin<T>.Destroy; destructor TMycDataJoinAll<T>.Destroy;
begin begin
for var i := High(FConsumers) downto 0 do for var i := High(FConsumers) downto 0 do
with FConsumers[i] do with FConsumers[i] do
@@ -629,17 +652,17 @@ begin
inherited; inherited;
end; end;
function TMycDataJoin<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag; function TMycDataJoinAll<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag;
begin begin
Result := FContainedProvider.Link(Consumer); Result := FContainedProvider.Link(Consumer);
end; end;
procedure TMycDataJoin<T>.Unlink(Tag: TTag); procedure TMycDataJoinAll<T>.Unlink(Tag: TTag);
begin begin
FContainedProvider.Unlink(Tag); FContainedProvider.Unlink(Tag);
end; end;
function TMycDataJoin<T>.Consume(Idx: Integer; const Value: T): TState; function TMycDataJoinAll<T>.Consume(Idx: Integer; const Value: T): TState;
begin begin
var Arr: TArray<T>; var Arr: TArray<T>;
@@ -671,7 +694,7 @@ begin
FContainedProvider.Broadcast(Arr); FContainedProvider.Broadcast(Arr);
end; end;
function TMycDataJoin<T>.GetConsumers(Idx: Integer): IConsumer<T>; function TMycDataJoinAll<T>.GetConsumers(Idx: Integer): IConsumer<T>;
begin begin
Result := FConsumers[Idx].Consumer; Result := FConsumers[Idx].Consumer;
end; end;
@@ -797,4 +820,75 @@ begin
end; end;
{ TMycDataJoinAny<T> }
constructor TMycDataJoinAny<T>.Create(ACount: Integer);
begin
inherited Create;
SetLength(FConsumers, ACount);
SetLength(FValues, ACount);
SetLength(FInit, ACount);
FInitCount := ACount;
FLock := TSpinLock.Create(false);
FContainedProvider := TMycContainedProducer<TArray<T>>.Create(Self);
var cFunc :=
function(Idx: Integer): TConvertFunc<T, TState>
begin
Result := function(const Value: T): TState begin Result := Consume(Idx, Value); end
end;
for var i := 0 to High(FConsumers) do
begin
FValues[i] := Default(T);
FInit[i] := false;
FConsumers[i] := TMycGenericConsumer<T>.Create(Self, cFunc(i));
end;
end;
destructor TMycDataJoinAny<T>.Destroy;
begin
for var i := High(FConsumers) downto 0 do
FConsumers[i].Free;
FContainedProvider.Free;
inherited;
end;
function TMycDataJoinAny<T>.Link(const Consumer: IConsumer<TArray<T>>): TTag;
begin
Result := FContainedProvider.Link(Consumer);
end;
procedure TMycDataJoinAny<T>.Unlink(Tag: TTag);
begin
FContainedProvider.Unlink(Tag);
end;
function TMycDataJoinAny<T>.Consume(Idx: Integer; const Value: T): TState;
begin
FLock.Enter;
try
FValues[Idx] := Value;
if not FInit[Idx] then
begin
FInit[Idx] := true;
dec(FInitCount);
end;
if FInitCount = 0 then
FContainedProvider.Broadcast(FValues);
finally
FLock.Exit;
end;
end;
function TMycDataJoinAny<T>.GetConsumers(Idx: Integer): IConsumer<T>;
begin
Result := FConsumers[Idx];
end;
end. end.
+14 -6
View File
@@ -118,7 +118,10 @@ type
class function CreateEndpoint<T>(Lookback: Int64; out Series: TLazy<TSeries<T>>): IConsumer<T>; static; class function CreateEndpoint<T>(Lookback: Int64; out Series: TLazy<TSeries<T>>): IConsumer<T>; static;
class function Join<T>(const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>; static; type
TJoinMode = (jmAll, jmAny);
class function Join<T>(Mode: TJoinMode; const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>; static;
type type
TRecordMapping = record TRecordMapping = record
@@ -344,11 +347,16 @@ begin
); );
end; end;
class function TConverter.Join<T>(const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>; class function TConverter.Join<T>(Mode: TJoinMode; const Producers: TArray<TProducer<T>>): TProducer<TArray<T>>;
var var
joiner: TMycDataJoin<T>; joiner: IDataJoin<T>;
begin begin
joiner := TMycDataJoin<T>.Create(Length(Producers)); case Mode of
jmAll: joiner := TMycDataJoinAll<T>.Create(Length(Producers));
jmAny: joiner := TMycDataJoinAny<T>.Create(Length(Producers));
else
Assert(false);
end;
Result := joiner; Result := joiner;
for var i := 0 to High(Producers) do for var i := 0 to High(Producers) do
@@ -361,7 +369,7 @@ class function TConverter.JoinRecords(
const Producers: TArray<TProducer<TDataRecord>> const Producers: TArray<TProducer<TDataRecord>>
): TConverter<TArray<TDataRecord>, TDataRecord>; ): TConverter<TArray<TDataRecord>, TDataRecord>;
begin begin
var RecProvider := Join<TDataRecord>(Producers); var RecProvider := Join<TDataRecord>(jmAll, Producers);
Result := DataMapping(Mapping, TargetLayout); Result := DataMapping(Mapping, TargetLayout);
@@ -395,7 +403,7 @@ function TDataRecordHelper.JoinRecords(
begin begin
var map := TConverter.DataMapping(Mapping, TargetLayout); var map := TConverter.DataMapping(Mapping, TargetLayout);
TConverter.Join<TDataRecord>(Self).Chain(map.Consumer); TConverter.Join<TDataRecord>(jmAll, Self).Chain(map.Consumer);
Result := map.Producer; Result := map.Producer;
end; end;
+208
View File
@@ -0,0 +1,208 @@
unit Myc.Data.Records.Types;
interface
uses
System.TypInfo,
System.Generics.Collections;
type
TDataType = class abstract
strict private
class var
FRegistry: TObjectDictionary<String, TDataType>;
class constructor CreateClass;
class destructor DestroyClass;
private
FTypeName: string;
class function GetItems(const Name: String): TDataType; static;
class procedure SetItems(const Name: String; const Value: TDataType); static;
protected
function GetHandle: PTypeInfo; virtual; abstract;
function GetSize: Integer; virtual; abstract;
public
constructor Create(const ATypeName: string);
procedure Init(P: Pointer); virtual;
procedure Assign(P, Q: Pointer); virtual; abstract;
procedure Finalize(P: Pointer); virtual;
class procedure RegisterType(DataType: TDataType);
class property Items[const Name: String]: TDataType read GetItems write SetItems; default;
property TypeName: string read FTypeName;
property Handle: PTypeInfo read GetHandle;
property Size: Integer read GetSize;
end;
TFloatType = class(TDataType)
type
TFltType = (fSingle, fDouble);
private
FHandle: PTypeInfo;
FSize: Integer;
FFloatType: TFltType;
protected
function GetHandle: PTypeInfo; override;
function GetSize: Integer; override;
public
constructor Create(const ATypeName: string);
procedure Init(P: Pointer); override;
procedure Assign(P, Q: Pointer); override;
procedure Finalize(P: Pointer); override;
end;
TIntegerType = class(TDataType)
private
FKind: TTypeKind;
public
constructor Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
procedure Init(P: Pointer); override;
procedure Assign(P, Q: Pointer); override;
procedure Finalize(P: Pointer); override;
end;
TStringType = class(TDataType)
public
constructor Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
procedure Init(P: Pointer); override;
procedure Assign(P, Q: Pointer); override;
procedure Finalize(P: Pointer); override;
end;
implementation
{ TDataType }
constructor TDataType.Create(const ATypeName: string);
begin
inherited Create;
FTypeName := ATypeName;
end;
class constructor TDataType.CreateClass;
begin
FRegistry := TObjectDictionary<String, TDataType>.Create([doOwnsValues]);
end;
class destructor TDataType.DestroyClass;
begin
FRegistry.Free;
end;
procedure TDataType.Finalize(P: Pointer);
begin
end;
class function TDataType.GetItems(const Name: String): TDataType;
begin
if not FRegistry.TryGetValue(Name, Result) then
Result := nil;
end;
procedure TDataType.Init(P: Pointer);
begin
end;
class procedure TDataType.RegisterType(DataType: TDataType);
begin
FRegistry.Add(DataType.TypeName, DataType);
end;
class procedure TDataType.SetItems(const Name: String; const Value: TDataType);
begin
// TODO -cMM: TDataType.SetItems default body inserted
end;
{ TFloatType }
constructor TFloatType.Create(const ATypeName: string);
begin
inherited;
FFloatType := GetTypeData(AHandle).FloatType;
Assert(FFloatType in [ftSingle, ftDouble]);
end;
procedure TFloatType.Assign(P, Q: Pointer);
begin
case FFloatType of
ftSingle: PSingle(Q)^ := PSingle(P)^;
ftDouble: PDouble(Q)^ := PDouble(P)^;
end;
end;
procedure TFloatType.Finalize(P: Pointer);
begin
end;
function TFloatType.GetHandle: PTypeInfo;
begin
Result := FHandle;
end;
function TFloatType.GetSize: Integer;
begin
Result := FSize;
end;
procedure TFloatType.Init(P: Pointer);
begin
end;
{ TIntegerType }
constructor TIntegerType.Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
begin
inherited;
FKind := AHandle.Kind;
Assert(FKind in [tkInteger, tkInt64]);
end;
procedure TIntegerType.Assign(P, Q: Pointer);
begin
case FKind of
tkInteger: PInteger(Q)^ := PInteger(P)^;
tkInt64: PInt64(Q)^ := PInt64(P)^;
end;
end;
procedure TIntegerType.Finalize(P: Pointer);
begin
end;
procedure TIntegerType.Init(P: Pointer);
begin
end;
{ TStringType }
constructor TStringType.Create(const ATypeName: string; AHandle: PTypeInfo; ASize: Integer);
begin
inherited;
Assert(AHandle.Kind in [tkString, tkUString]);
end;
procedure TStringType.Assign(P, Q: Pointer);
begin
PString(Q)^ := PString(P)^;
end;
procedure TStringType.Finalize(P: Pointer);
begin
System.Finalize(PString(P)^);
end;
procedure TStringType.Init(P: Pointer);
begin
System.Initialize(PString(P)^);
end;
initialization
TDataType.RegisterType(TFloatType.Create('Float'))
end.
+7 -1
View File
@@ -25,7 +25,13 @@ uses
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas', Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
Test.Core.Mutable in 'Test.Core.Mutable.pas', Test.Core.Mutable in 'Test.Core.Mutable.pas',
TestDataRecord in 'TestDataRecord.pas', TestDataRecord in 'TestDataRecord.pas',
TestDataArray in 'TestDataArray.pas'; TestDataArray in 'TestDataArray.pas',
Myc.Data.Types in '..\Src\Myc.Data.Types.pas',
Myc.Data.Types.Ordinal in 'Myc.Data.Types.Ordinal.pas',
Myc.Data.Types.Records in 'Myc.Data.Types.Records.pas',
TestDataTypes in 'TestDataTypes.pas',
Myc.Data.Types.Float in 'Myc.Data.Types.Float.pas',
Myc.Data.Types.Arrays in 'Myc.Data.Types.Arrays.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}
+7 -1
View File
@@ -58,7 +58,7 @@
<UsingDelphiRTL>true</UsingDelphiRTL> <UsingDelphiRTL>true</UsingDelphiRTL>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon> <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<DCC_UnitSearchPath>$(DUnitX);T:\Myc\Src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> <DCC_UnitSearchPath>$(DUnitX);T:\Myc\Src;T:\Myc\Src\Data;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<SanitizedProjectName>MycTests</SanitizedProjectName> <SanitizedProjectName>MycTests</SanitizedProjectName>
<VerInfo_Locale>1031</VerInfo_Locale> <VerInfo_Locale>1031</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
@@ -127,6 +127,12 @@ $(PreBuildEvent)]]></PreBuildEvent>
<DCCReference Include="Test.Core.Mutable.pas"/> <DCCReference Include="Test.Core.Mutable.pas"/>
<DCCReference Include="TestDataRecord.pas"/> <DCCReference Include="TestDataRecord.pas"/>
<DCCReference Include="TestDataArray.pas"/> <DCCReference Include="TestDataArray.pas"/>
<DCCReference Include="..\Src\Myc.Data.Types.pas"/>
<DCCReference Include="Myc.Data.Types.Ordinal.pas"/>
<DCCReference Include="Myc.Data.Types.Records.pas"/>
<DCCReference Include="TestDataTypes.pas"/>
<DCCReference Include="Myc.Data.Types.Float.pas"/>
<DCCReference Include="Myc.Data.Types.Arrays.pas"/>
<BuildConfiguration Include="Base"> <BuildConfiguration Include="Base">
<Key>Base</Key> <Key>Base</Key>
</BuildConfiguration> </BuildConfiguration>
+231
View File
@@ -0,0 +1,231 @@
unit TestDataTypes;
interface
uses
DUnitX.TestFramework;
type
[TestFixture]
TMyTestObject = class
public
[Test]
procedure TestCreateRecords;
[Test]
procedure TestTuples;
[Test]
procedure TestArrays;
end;
implementation
uses
System.SysUtils,
Myc.Data.Types,
Myc.Data.Types.Ordinal,
Myc.Data.Types.Float,
Myc.Data.Types.Tuple,
Myc.Data.Types.Arrays,
Myc.Data.Types.Records;
{ TMyTestObject }
procedure TMyTestObject.TestCreateRecords;
var
intType: TDataType;
floatType: TDataType;
fieldDef: TArray<TRecordField>;
personType1, personType2, otherType: TRecordType;
personValue: TDataValue;
idValue: IDataOrdinalValue;
floatValue: IDataFloatValue;
begin
// --- 1. Setup: Define base types and a record structure ---
intType := TOrdinalType.CreateValue(0).DataType;
floatType := TFloatType.CreateValue(0.0).DataType;
SetLength(fieldDef, 2);
fieldDef[0] := TRecordField.Create('ID', intType);
fieldDef[1] := TRecordField.Create('Value', floatType);
// --- 2. Test Type Creation and Caching ---
personType1 := TRecordTypes.GetType(fieldDef);
// Assertions for the created type
Assert.IsNotNull(IDataRecordType(personType1), 'RecordType should be created');
Assert.AreEqual(2, personType1.FieldCount, 'FieldCount should be 2');
Assert.AreEqual('ID', personType1.Fields[0].Name, 'First field name should be ID');
Assert.AreSame(intType.DataType, personType1.Fields[0].DataType, 'First field type should be Integer');
Assert.AreEqual('Value', personType1.Fields[1].Name, 'Second field name should be Value');
Assert.AreSame(floatType.DataType, personType1.Fields[1].DataType, 'Second field type should be Float');
Assert.AreEqual(0, personType1.IndexOf('ID'), 'IndexOf ID should be 0');
Assert.AreEqual(1, personType1.IndexOf('Value'), 'IndexOf Value should be 1');
Assert.AreEqual('Record<ID: Integer, Value: Float>', personType1.Name, 'Type name should match expected format');
// Test if the same definition returns the same cached instance
personType2 := TRecordTypes.GetType(fieldDef);
Assert.AreSame(personType1, personType2, 'Types should be cached and return the same instance');
// Test if a different definition returns a new instance
fieldDef[1] := TRecordField.Create('Data', floatType); // Change field name
otherType := TRecordTypes.GetType(fieldDef);
Assert.AreNotSame(personType1, otherType, 'Different definitions should result in different types');
fieldDef[1] := TRecordField.Create('Value', floatType); // Reset for next test
// --- 3. Test Value Creation and Access ---
personType1 := TRecordTypes.GetType(fieldDef); // Get the original type again
personValue := personType1.CreateValue([TOrdinalType.CreateValue(123), TFloatType.CreateValue(45.67)]);
Assert.IsNotNull(IDataRecordValue(personValue.AsRecord), 'RecordValue should be created');
Assert.IsTrue(personType1 = personValue.AsRecord.DataType, 'Value should have the correct data type');
// Access by index
idValue := personValue.AsRecord.Items[0].DataValue as IDataOrdinalValue;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := personValue.AsRecord.Items[1].DataValue as IDataFloatValue;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := personValue.AsRecord.Items[personType1.IndexOf('Value')].DataValue as IDataFloatValue;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test for duplicate field names during type creation
Assert.WillRaise(
procedure
var
duplicateDef: TArray<TRecordField>;
begin
SetLength(duplicateDef, 2);
duplicateDef[0] := TRecordField.Create('ID', intType);
duplicateDef[1] := TRecordField.Create('ID', floatType); // Duplicate name
TRecordTypes.GetType(duplicateDef);
end,
EArgumentException,
'Duplicate field names should raise an exception'
);
// Test for wrong number of items during value creation
Assert.WillRaise(
procedure begin personType1.CreateValue([TOrdinalType.CreateValue(99)]); end,
EArgumentException,
'Wrong number of items should raise exception'
);
// Test for wrong item type during value creation
Assert.WillRaise(
procedure
begin
// Passing Float instead of Integer for the first item
personType1.CreateValue([TFloatType.CreateValue(1.0), TFloatType.CreateValue(2.0)]);
end,
EArgumentException,
'Wrong item type should raise exception'
);
end;
procedure TMyTestObject.TestTuples;
var
intValue: IDataValue;
floatValue: IDataValue;
tuple1, tuple2, tuple3: IDataTupleValue;
tuple1Helper: TTupleValue;
type1, type2, type3: IDataType;
begin
// --- 1. Setup: Create some values ---
intValue := TOrdinalType.CreateValue(123);
floatValue := TFloatType.CreateValue(45.67);
// --- 2. Test Value Creation and basic properties ---
tuple1 := TTuple.Create([intValue, floatValue]);
tuple1Helper := TTupleValue.Create(tuple1); // Use helper for convenience
Assert.IsNotNull(tuple1, 'Tuple value should be created');
Assert.AreEqual(2, tuple1Helper.ItemCount, 'ItemCount should be on the value');
Assert.AreSame(intValue, tuple1Helper.Items[0].DataValue, 'Item at index 0 is incorrect');
Assert.AreSame(floatValue, tuple1Helper.Items[1].DataValue, 'Item at index 1 is incorrect');
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
tuple2 := TTuple.Create([TOrdinalType.CreateValue(99), TFloatType.CreateValue(1.1)]);
tuple3 := TTuple.Create([intValue]);
// Access the DataType via the underlying interface, as the helper is "blind".
type1 := IDataValue(tuple1).DataType;
type2 := IDataValue(tuple2).DataType;
type3 := IDataValue(tuple3).DataType;
Assert.IsNotNull(type1, 'DataType interface should be accessible');
Assert.AreEqual('Tuple', type1.Name, 'The type name for all tuples should be Tuple');
// The core test: All tuples, regardless of their content, must share the exact same singleton type object.
Assert.AreSame(type1, type2, 'All tuple types should be the same singleton instance');
Assert.AreSame(type1, type3, 'All tuple types should be the same singleton instance');
end;
procedure TMyTestObject.TestArrays;
var
intType: TDataType;
floatType: TDataType;
intArrayType1, intArrayType2, floatArrayType: TArrayType;
arrayValue: TArrayValue;
v1, v2: IDataValue;
begin
// --- 1. Setup ---
intType := TOrdinalType.CreateValue(0).DataType;
floatType := TFloatType.CreateValue(0.0).DataType;
// --- 2. Test Type Creation and Caching ---
intArrayType1 := TArrayTypes.GetType(intType);
Assert.IsNotNull(IDataArrayType(intArrayType1), 'ArrayType should be created');
Assert.AreSame(intType.DataType, intArrayType1.ElementType.DataType, 'ElementType should be Integer');
Assert.AreEqual('Array<Integer>', intArrayType1.Name, 'Type name should be Array<Integer>');
// Test caching
intArrayType2 := TArrayTypes.GetType(intType);
Assert.AreSame(intArrayType1, intArrayType2, 'Array types should be cached');
// Test uniqueness
floatArrayType := TArrayTypes.GetType(floatType);
Assert.AreNotSame(intArrayType1, floatArrayType, 'Different element types should result in different array types');
Assert.AreEqual('Array<Float>', floatArrayType.Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TOrdinalType.CreateValue(10);
v2 := TOrdinalType.CreateValue(20);
arrayValue := intArrayType1.CreateValue([v1, v2]);
Assert.IsNotNull(IDataArrayValue(arrayValue), 'ArrayValue should be created');
Assert.AreEqual(2, arrayValue.ElementCount, 'ElementCount should be 2');
// Access items and check values
Assert.AreEqual(Int64(10), (arrayValue.Items[0].DataValue as IDataOrdinalValue).Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), (arrayValue.Items[1].DataValue as IDataOrdinalValue).Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
Assert.WillRaise(
procedure begin TArrayTypes.GetType(TDataType.Create(nil)); end,
EArgumentException,
'Nil element type should raise an exception'
);
// Test creating a value with an incorrect element type (homogeneity check)
Assert.WillRaise(
procedure
begin
// Try to add a float value to an Array<Integer>
intArrayType1.CreateValue([v1, TFloatType.CreateValue(3.14)]);
end,
EArgumentException,
'Wrong element type should raise an exception'
);
end;
initialization
TDUnitX.RegisterTestFixture(TMyTestObject);
end.