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

Type System

Browse Source
This commit is contained in:
Michael Schimmel
2025-08-26 12:06:47 +02:00
parent 5adbe67d0b
commit d2f7b01911
5 changed files with 634 additions and 687 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Types.Method.pas
+1 -2
View File
@@ -52,8 +52,7 @@ end;
function TImplDataMethodType.CreateValue(const AValue: TDataMethodProc): IDataMethodValue;
begin
if not Assigned(AValue) then
raise EArgumentException.Create('AValue');
Assert(Assigned(AValue));
Result := TImplDataMethodValue.Create(Self, AValue);
end;
Src/Data/Myc.Data.Types.pas
+331 -333
View File
File diff suppressed because it is too large Load Diff
Src/Data/TestDataTypes.pas
+99 -96
View File
@@ -51,9 +51,9 @@ uses
procedure TMyTestObject.TestRecords;
var
intType: TDataOrdinalType;
floatType: TDataFloatType;
personType1, personType2, otherType: TDataRecordType;
intType: TDataType.TOrdinal;
floatType: TDataType.TFloat;
personType1, personType2, otherType: TDataType.TRecord;
personValue: TDataRecordValue;
idValue: TDataOrdinalValue;
floatValue: TDataFloatValue;
@@ -86,19 +86,19 @@ begin
Assert.AreNotSame(IDataRecordType(personType1), IDataRecordType(otherType), 'Different definitions should result in different types');
// --- 3. Test Value Creation and Access ---
personValue := personType1.CreateValue([TDataValue.FromOrdinal(123), TDataValue.FromFloat(45.67)]);
personValue := personType1.CreateValue([TDataType.FromOrdinal(123), TDataType.FromFloat(45.67)]);
Assert.IsNotNull(IDataRecordValue(personValue), 'RecordValue should be created');
Assert.AreSame(IDataRecordType(personType1), IDataRecordValue(personValue).DataType, 'Value should have the correct data type');
// Access by index
idValue := TDataValue(personValue.Items[0]).AsOrdinal;
idValue := TDataType.TValue(personValue.Items[0]).AsOrdinal;
Assert.AreEqual(Int64(123), idValue.Value, 'Value at index 0 is incorrect');
floatValue := TDataValue(personValue.Items[1]).AsFloat;
floatValue := TDataType.TValue(personValue.Items[1]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value at index 1 is incorrect');
// Access by name
floatValue := TDataValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
floatValue := TDataType.TValue(personValue.Items[personType1.IndexOf('Value')]).AsFloat;
Assert.AreEqual(45.67, floatValue.Value, 'Value accessed by name is incorrect');
// --- 4. Test Validation and Error Handling ---
@@ -111,7 +111,7 @@ begin
// Test for wrong number of items during value creation
Assert.WillRaise(
procedure begin personType1.CreateValue([TDataValue.FromOrdinal(99)]); end,
procedure begin personType1.CreateValue([TDataType.FromOrdinal(99)]); end,
EArgumentException,
'Wrong number of items should raise exception'
);
@@ -121,7 +121,7 @@ begin
procedure
begin
// Passing Float instead of Integer for the first item
personType1.CreateValue([TDataValue.FromFloat(1.0), TDataValue.FromFloat(2.0)]);
personType1.CreateValue([TDataType.FromFloat(1.0), TDataType.FromFloat(2.0)]);
end,
EArgumentException,
'Wrong item type should raise exception'
@@ -130,7 +130,7 @@ end;
procedure TMyTestObject.TestRecords_Generic;
var
dataType: TDataRecordType;
dataType: TDataType.TRecord;
dataValue: TDataRecordValue;
begin
// Test the generic implementation for records with > 2 fields.
@@ -142,13 +142,13 @@ begin
TRecordField.Create('C', TDataType.Float)
]
);
dataValue := dataType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('two'), TDataValue.FromFloat(3.0)]);
dataValue := dataType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('two'), TDataType.FromFloat(3.0)]);
Assert.IsNotNull(IDataRecordValue(dataValue), 'Generic record value should be created');
Assert.AreEqual(3, dataType.FieldCount, 'Generic record should have 3 fields');
Assert.AreEqual(Int64(1), TDataValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual(Int64(1), TDataType.TValue(dataValue.Items[0]).AsOrdinal.Value, 'Field A is incorrect');
Assert.AreEqual('two', TDataType.TValue(dataValue.Items[1]).AsText.Value, 'Field B is incorrect');
Assert.AreEqual(3.0, TDataType.TValue(dataValue.Items[2]).AsFloat.Value, 'Field C is incorrect');
Assert.AreEqual('<A: 1, B: two, C: 3>', IDataRecordValue(dataValue).AsString, 'Generic record AsString is incorrect');
end;
@@ -161,11 +161,11 @@ var
begin
// This test covers optimized implementations for 1 and 2 elements.
// --- 1. Setup: Create some values ---
intValue := TDataValue.FromOrdinal(123);
floatValue := TDataValue.FromFloat(45.67);
intValue := TDataType.FromOrdinal(123);
floatValue := TDataType.FromFloat(45.67);
// --- 2. Test Value Creation and basic properties ---
tuple1 := TDataValue.FromTuple([intValue, floatValue]);
tuple1 := TDataType.FromTuple([intValue, floatValue]);
Assert.IsNotNull(IDataTupleValue(tuple1), 'Tuple value should be created');
Assert.AreEqual(2, tuple1.ItemCount, 'ItemCount should be on the value');
@@ -174,8 +174,8 @@ begin
// --- 3. Test Singleton Type Behavior ---
// Create more tuples with different structures
tuple2 := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromFloat(1.1)]);
tuple3 := TDataValue.FromTuple([intValue]);
tuple2 := TDataType.FromTuple([TDataType.FromOrdinal(99), TDataType.FromFloat(1.1)]);
tuple3 := TDataType.FromTuple([intValue]);
// Access the DataType via the underlying interface
type1 := IDataValue(tuple1).DataType;
@@ -196,29 +196,29 @@ var
begin
// Test the generic implementation for tuples with > 5 elements.
tupleValue :=
TDataValue.FromTuple(
TDataType.FromTuple(
[
TDataValue.FromOrdinal(1),
TDataValue.FromOrdinal(2),
TDataValue.FromOrdinal(3),
TDataValue.FromOrdinal(4),
TDataValue.FromOrdinal(5),
TDataValue.FromOrdinal(6)
TDataType.FromOrdinal(1),
TDataType.FromOrdinal(2),
TDataType.FromOrdinal(3),
TDataType.FromOrdinal(4),
TDataType.FromOrdinal(5),
TDataType.FromOrdinal(6)
]
);
Assert.IsNotNull(IDataTupleValue(tupleValue), 'Generic tuple value should be created');
Assert.AreEqual(6, tupleValue.ItemCount, 'Generic tuple should have 6 items');
Assert.AreEqual(Int64(6), TDataValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
Assert.AreEqual(Int64(6), TDataType.TValue(tupleValue.Items[5]).AsOrdinal.Value, 'Last item is incorrect');
Assert.AreEqual('(1, 2, 3, 4, 5, 6)', IDataTupleValue(tupleValue).AsString, 'Generic tuple AsString is incorrect');
end;
procedure TMyTestObject.TestArrays;
var
intType: TDataOrdinalType;
floatType: TDataFloatType;
intArrayType1, intArrayType2: TDataArrayType;
floatArrayType: TDataArrayType;
intType: TDataType.TOrdinal;
floatType: TDataType.TFloat;
intArrayType1, intArrayType2: TDataType.TArray;
floatArrayType: TDataType.TArray;
arrayValue: TDataArrayValue;
v1, v2: TDataOrdinalValue;
begin
@@ -247,16 +247,16 @@ begin
Assert.AreEqual('Array<Float>', TDataType(floatArrayType).Name, 'Type name should be Array<Float>');
// --- 3. Test Value Creation and Access ---
v1 := TDataValue.FromOrdinal(10);
v2 := TDataValue.FromOrdinal(20);
v1 := TDataType.FromOrdinal(10);
v2 := TDataType.FromOrdinal(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), TDataValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
Assert.AreEqual(Int64(10), TDataType.TValue(arrayValue.Items[0]).AsOrdinal.Value, 'Item at index 0 is incorrect');
Assert.AreEqual(Int64(20), TDataType.TValue(arrayValue.Items[1]).AsOrdinal.Value, 'Item at index 1 is incorrect');
// --- 4. Test Validation and Error Handling ---
// Test creating an array with a nil element type
@@ -267,7 +267,7 @@ begin
procedure
begin
// Try to add a float value to an Array<Integer>
intArrayType1.CreateValue([v1, TDataValue.FromFloat(3.14)]);
intArrayType1.CreateValue([v1, TDataType.FromFloat(3.14)]);
end,
EArgumentException,
'Wrong element type should raise an exception'
@@ -276,7 +276,7 @@ end;
procedure TMyTestObject.TestArrays_OptimizedAndGeneric;
var
arrayType: TDataArrayType;
arrayType: TDataType.TArray;
empty1, empty2, single, generic: TDataArrayValue;
begin
arrayType := TDataType.ArrayOf(TDataType.Ordinal);
@@ -290,14 +290,14 @@ begin
Assert.AreEqual('[]', IDataArrayValue(empty1).AsString, 'Empty array AsString is incorrect');
// Test optimized path for 1 element
single := arrayType.CreateValue([TDataValue.FromOrdinal(42)]);
single := arrayType.CreateValue([TDataType.FromOrdinal(42)]);
Assert.IsNotNull(IDataArrayValue(single), 'Single element array should be created');
Assert.AreEqual(1, single.ElementCount, 'Single element array should have 1 element');
Assert.AreEqual(Int64(42), TDataValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
Assert.AreEqual(Int64(42), TDataType.TValue(single.Items[0]).AsOrdinal.Value, 'Single element value is incorrect');
Assert.AreEqual('[42]', IDataArrayValue(single).AsString, 'Single element array AsString is incorrect');
// Test generic path for > 1 elements
generic := arrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2), TDataValue.FromOrdinal(3)]);
generic := arrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2), TDataType.FromOrdinal(3)]);
Assert.IsNotNull(IDataArrayValue(generic), 'Generic array should be created');
Assert.AreEqual(3, generic.ElementCount, 'Generic array should have 3 elements');
Assert.AreEqual('[1, 2, 3]', IDataArrayValue(generic).AsString, 'Generic array AsString is incorrect');
@@ -305,7 +305,7 @@ end;
procedure TMyTestObject.TestTexts;
var
textType: TDataTextType;
textType: TDataType.TText;
textValue1, textValue2: TDataTextValue;
dataValue: IDataValue;
begin
@@ -317,24 +317,27 @@ begin
Assert.AreEqual(dkText, TDataType(textType).Kind, 'Type kind should be dkText');
// --- 2. Test Value Creation and Access ---
textValue1 := TDataValue.FromText('Hello World');
textValue1 := TDataType.FromText('Hello World');
Assert.IsNotNull(IDataTextValue(textValue1), 'TextValue should be created');
Assert.AreSame(IDataType(textType), IDataTextValue(textValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual('Hello World', textValue1.Value, 'Value should be ''Hello World''');
// Test another text value
textValue2 := TDataValue.FromText('Delphi');
textValue2 := TDataType.FromText('Delphi');
Assert.AreEqual('Delphi', textValue2.Value, 'Value should be ''Delphi''');
// --- 3. Test AsText casting ---
dataValue := TDataValue.FromText('Test Text');
Assert.AreEqual('Test Text', TDataValue(dataValue).AsText.Value, 'AsText should return correct value');
dataValue := TDataType.FromText('Test Text');
Assert.AreEqual('Test Text', TDataType.TValue(dataValue).AsText.Value, 'AsText should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
Assert
.WillRaise(procedure begin TDataValue(dataValue).AsText; end, EInvalidCast, 'Casting non-text to AsText should raise EInvalidCast');
dataValue := TDataType.FromOrdinal(123);
Assert.WillRaise(
procedure begin TDataType.TValue(dataValue).AsText; end,
EInvalidCast,
'Casting non-text to AsText should raise EInvalidCast'
);
end;
procedure TMyTestObject.TestTexts_OptimizedEmpty;
@@ -342,8 +345,8 @@ var
empty1, empty2: TDataTextValue;
begin
// Test the singleton implementation for the empty string.
empty1 := TDataValue.FromText('');
empty2 := TDataValue.FromText('');
empty1 := TDataType.FromText('');
empty2 := TDataType.FromText('');
Assert.IsNotNull(IDataTextValue(empty1), 'Empty text value should be created');
Assert.AreSame(IDataTextValue(empty1), IDataTextValue(empty2), 'Empty text value should be a singleton');
@@ -356,22 +359,22 @@ var
zero1, zero2, nan1, nan2, generic: TDataFloatValue;
begin
// Test singleton for 0.0
zero1 := TDataValue.FromFloat(0.0);
zero2 := TDataValue.FromFloat(0.0);
zero1 := TDataType.FromFloat(0.0);
zero2 := TDataType.FromFloat(0.0);
Assert.IsNotNull(IDataFloatValue(zero1), 'Zero float should be created');
Assert.AreSame(IDataFloatValue(zero1), IDataFloatValue(zero2), 'Zero float should be a singleton');
Assert.AreEqual(0.0, zero1.Value, 'Value of zero float is incorrect');
// Test singleton for NaN
nan1 := TDataValue.FromFloat(NaN);
nan2 := TDataValue.FromFloat(NaN);
nan1 := TDataType.FromFloat(NaN);
nan2 := TDataType.FromFloat(NaN);
Assert.IsNotNull(IDataFloatValue(nan1), 'NaN float should be created');
Assert.AreSame(IDataFloatValue(nan1), IDataFloatValue(nan2), 'NaN float should be a singleton');
Assert.IsTrue(IsNaN(nan1.Value), 'Value of NaN float should be NaN');
Assert.AreEqual('NaN', IDataFloatValue(nan1).AsString, 'NaN AsString is incorrect');
// Test generic path
generic := TDataValue.FromFloat(123.45);
generic := TDataType.FromFloat(123.45);
Assert.IsNotNull(IDataFloatValue(generic), 'Generic float should be created');
Assert.AreNotSame(IDataFloatValue(zero1), IDataFloatValue(generic), 'Generic float should not be the zero singleton');
Assert.AreNotSame(IDataFloatValue(nan1), IDataFloatValue(generic), 'Generic float should not be the NaN singleton');
@@ -380,7 +383,7 @@ end;
procedure TMyTestObject.TestTimestamps;
var
tsType: TDataTimestampType;
tsType: TDataType.TTimestamp;
tsValue1, tsValue2: TDataTimestampValue;
dataValue: IDataValue;
now: TDateTime;
@@ -394,24 +397,24 @@ begin
// --- 2. Test Value Creation and Access ---
now := System.Sysutils.Now;
tsValue1 := TDataValue.FromTimestamp(now);
tsValue1 := TDataType.FromTimestamp(now);
Assert.IsNotNull(IDataTimestampValue(tsValue1), 'TimestampValue should be created');
Assert.AreSame(IDataType(tsType), IDataTimestampValue(tsValue1).DataType, 'Value should have the correct data type');
Assert.AreEqual(now, tsValue1.Value, 'Value should be the same');
// Test another text value
tsValue2 := TDataValue.FromTimestamp(Date);
tsValue2 := TDataType.FromTimestamp(Date);
Assert.AreEqual(Date, tsValue2.Value, 'Value should be the same');
// --- 3. Test AsTimestamp casting ---
dataValue := TDataValue.FromTimestamp(now);
Assert.AreEqual(now, TDataValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
dataValue := TDataType.FromTimestamp(now);
Assert.AreEqual(now, TDataType.TValue(dataValue).AsTimestamp.Value, 'AsTimestamp should return correct value');
// Test invalid cast
dataValue := TDataValue.FromOrdinal(123);
dataValue := TDataType.FromOrdinal(123);
Assert.WillRaise(
procedure begin TDataValue(dataValue).AsTimestamp; end,
procedure begin TDataType.TValue(dataValue).AsTimestamp; end,
EInvalidCast,
'Casting non-timestamp to AsTimestamp should raise EInvalidCast'
);
@@ -419,7 +422,7 @@ end;
procedure TMyTestObject.TestEnums;
var
colorType: TDataEnumType;
colorType: TDataType.TEnum;
red, green, blue: TDataEnumValue;
begin
// --- 1. Test Type Creation ---
@@ -482,26 +485,26 @@ var
arrayValue: TDataArrayValue;
recordValue: TDataRecordValue;
tupleValue: TDataTupleValue;
colorType: TDataEnumType;
personType: TDataRecordType;
intArrayType: TDataArrayType;
colorType: TDataType.TEnum;
personType: TDataType.TRecord;
intArrayType: TDataType.TArray;
now: TDateTime;
begin
// Ordinal
ordinalValue := TDataValue.FromOrdinal(123);
ordinalValue := TDataType.FromOrdinal(123);
Assert.AreEqual('123', IDataOrdinalValue(ordinalValue).AsString, 'Ordinal AsString incorrect');
// Float
floatValue := TDataValue.FromFloat(45.67);
floatValue := TDataType.FromFloat(45.67);
Assert.AreEqual(FloatToStr(45.67), IDataFloatValue(floatValue).AsString, 'Float AsString incorrect');
// Text
textValue := TDataValue.FromText('Hello');
textValue := TDataType.FromText('Hello');
Assert.AreEqual('Hello', IDataTextValue(textValue).AsString, 'Text AsString incorrect');
// Timestamp
now := System.Sysutils.Now;
tsValue := TDataValue.FromTimestamp(now);
tsValue := TDataType.FromTimestamp(now);
Assert.AreEqual(DateTimeToStr(now), IDataTimestampValue(tsValue).AsString, 'Timestamp AsString incorrect');
// Enum
@@ -511,16 +514,16 @@ begin
// Array
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
arrayValue := intArrayType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromOrdinal(2)]);
arrayValue := intArrayType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromOrdinal(2)]);
Assert.AreEqual('[1, 2]', IDataArrayValue(arrayValue).AsString, 'Array AsString incorrect');
// Record
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
recordValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
recordValue := personType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]);
Assert.AreEqual('<ID: 1, Name: Bob>', IDataRecordValue(recordValue).AsString, 'Record AsString incorrect');
// Tuple
tupleValue := TDataValue.FromTuple([TDataValue.FromOrdinal(10), TDataValue.FromText('Tuple')]);
tupleValue := TDataType.FromTuple([TDataType.FromOrdinal(10), TDataType.FromText('Tuple')]);
Assert.AreEqual('(10, Tuple)', IDataTupleValue(tupleValue).AsString, 'Tuple AsString incorrect');
end;
@@ -529,26 +532,26 @@ var
dataValue: IDataValue; // Keep as generic interface to test AsTValue
tv, element: TValue;
now: TDateTime;
colorType: TDataEnumType;
intArrayType: TDataArrayType;
personType: TDataRecordType;
colorType: TDataType.TEnum;
intArrayType: TDataType.TArray;
personType: TDataType.TRecord;
begin
// --- Ordinal ---
dataValue := TDataValue.FromOrdinal(123);
dataValue := TDataType.FromOrdinal(123);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Ordinal TValue should not be empty');
Assert.AreEqual(tkInt64, tv.Kind, 'Ordinal TValue kind should be tkInt64');
Assert.AreEqual(Int64(123), tv.AsInt64, 'Ordinal TValue content is incorrect');
// --- Float ---
dataValue := TDataValue.FromFloat(45.67);
dataValue := TDataType.FromFloat(45.67);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Float TValue should not be empty');
Assert.AreEqual(tkFloat, tv.Kind, 'Float TValue kind should be tkFloat');
Assert.AreEqual(45.67, tv.AsExtended, 'Float TValue content is incorrect');
// --- Text ---
dataValue := TDataValue.FromText('Hello');
dataValue := TDataType.FromText('Hello');
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Text TValue should not be empty');
Assert.AreEqual(tkUString, tv.Kind, 'Text TValue kind should be tkUString');
@@ -556,7 +559,7 @@ begin
// --- Timestamp ---
now := System.SysUtils.Now;
dataValue := TDataValue.FromTimestamp(now);
dataValue := TDataType.FromTimestamp(now);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Timestamp TValue should not be empty');
Assert.AreEqual(tkFloat, tv.Kind, 'Timestamp TValue kind is incorrect');
@@ -572,7 +575,7 @@ begin
// --- Array ---
intArrayType := TDataType.ArrayOf(TDataType.Ordinal);
dataValue := intArrayType.CreateValue([TDataValue.FromOrdinal(10), TDataValue.FromOrdinal(20)]);
dataValue := intArrayType.CreateValue([TDataType.FromOrdinal(10), TDataType.FromOrdinal(20)]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Array TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Array TValue should be an array');
@@ -595,7 +598,7 @@ begin
// --- Record ---
personType := TDataType.RecordOf([TRecordField.Create('ID', TDataType.Ordinal), TRecordField.Create('Name', TDataType.Text)]);
dataValue := personType.CreateValue([TDataValue.FromOrdinal(1), TDataValue.FromText('Bob')]);
dataValue := personType.CreateValue([TDataType.FromOrdinal(1), TDataType.FromText('Bob')]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Record TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Record TValue should be represented as an array');
@@ -605,7 +608,7 @@ begin
Assert.AreEqual('Bob', tv.GetArrayElement(1).AsType<TValue>.AsString, 'Record TValue element 1 is incorrect');
// --- Tuple ---
dataValue := TDataValue.FromTuple([TDataValue.FromOrdinal(99), TDataValue.FromText('Red')]);
dataValue := TDataType.FromTuple([TDataType.FromOrdinal(99), TDataType.FromText('Red')]);
tv := dataValue.AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Tuple TValue should not be empty');
Assert.IsTrue(tv.IsArray, 'Tuple TValue should be represented as an array');
@@ -617,10 +620,10 @@ end;
procedure TMyTestObject.TestMethods;
var
ordinalType: TDataOrdinalType;
textType: TDataTextType;
methodType1, methodType2, otherMethodType: TDataMethodType;
myFunc: TMethodProc;
ordinalType: TDataType.TOrdinal;
textType: TDataType.TText;
methodType1, methodType2, otherMethodType: TDataType.TMethod;
myFunc: TDataType.TMethod.TProc;
methodValue: TDataMethodValue;
inputValue: TDataOrdinalValue;
resultValue: IDataValue;
@@ -657,28 +660,28 @@ begin
// --- 3. Test Value Creation ---
// Define a function that matches the signature Ordinal -> Text
myFunc :=
function(const AValue: IDataValue): IDataValue
function(const AValue: TDataType.TValue): TDataType.TValue
var
ordinalValue: TDataOrdinalValue;
val: Int64;
begin
ordinalValue := TDataValue(AValue).AsOrdinal;
ordinalValue := AValue.AsOrdinal;
val := ordinalValue.Value;
Result := TDataValue.FromText(val.ToString);
Result := TDataType.FromText(val.ToString);
end;
methodValue := TDataValue.FromMethod(methodType1, myFunc);
methodValue := TDataType.FromMethod(methodType1, myFunc);
Assert.IsNotNull(IDataMethodValue(methodValue), 'MethodValue should be created');
Assert.AreSame(IDataType(methodType1), IDataMethodValue(methodValue).DataType, 'Value should have the correct data type');
// --- 4. Test Execution (Simulated) ---
inputValue := TDataValue.FromOrdinal(42);
inputValue := TDataType.FromOrdinal(42);
// Execute the function retrieved from the value
resultValue := methodValue.Value(inputValue);
Assert.IsNotNull(resultValue, 'Execution result should not be nil');
Assert.AreSame(IDataType(textType), resultValue.DataType, 'Result value should have Text type');
Assert.AreEqual('42', TDataValue(resultValue).AsText.Value, 'Result value content is incorrect');
Assert.AreEqual('42', TDataType.TValue(resultValue).AsText.Value, 'Result value content is incorrect');
// --- 5. Test AsString and AsTValue ---
Assert.AreEqual('<METHOD>', IDataMethodValue(methodValue).AsString, 'Method AsString is incorrect');
@@ -686,19 +689,19 @@ begin
tv := IDataMethodValue(methodValue).AsTValue;
Assert.IsFalse(tv.IsEmpty, 'Method TValue should not be empty');
Assert.AreEqual(tkInterface, tv.Kind, 'TValue kind for a TMethodProc should be tkInterface, as it is a reference-to-function');
Assert.IsTrue(TypeInfo(TMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
Assert.IsTrue(TypeInfo(TDataMethodProc) = tv.TypeInfo, 'TValue should hold TMethodProc type info');
// --- 6. Test Validation and Error Handling ---
// Test creating a value with a nil type
Assert.WillRaise(
procedure begin TDataValue.FromMethod(nil, myFunc); end,
procedure begin TDataType.FromMethod(nil, myFunc); end,
EArgumentException,
'FromMethod with nil type should raise an exception'
);
// Test creating a value with a nil function
Assert.WillRaise(
procedure begin TDataValue.FromMethod(methodType1, nil); end,
procedure begin TDataType.FromMethod(methodType1, nil); end,
EArgumentException,
'FromMethod with nil function should raise an exception'
);
Src/Myc.Trade.Indicators.Common.pas
+192 -245
View File
@@ -350,57 +350,24 @@ implementation
class constructor TSMA.CreateClass;
begin
{ var params := TDataType.RecordOf( [TRecordField.Create( 'Period', TDataType.Ordinal )] );
var args := TDataType.RecordOf( [TRecordField.Create( 'Value', TDataType.Float )] );
var results := TDataType.RecordOf( [TRecordField.Create( 'SMA', TDataType.Float )] );
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf( args, results );
var factoryMethod := TDataType.MethodOf( params, indicatorMethod );
FFactory := factoryMethod.CreateValue(
function( const Params: IDataValue ): IDataValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var SMA := CreateSMA( period );
Result := indicatorMethod.CreateValue(
function( const Args: IDataValue ): IDataValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := SMA( value );
Result := results.CreateValue( [TDataValue.FromFloat(res)] );
end );
end );
}
// ....or....
var params := TDataType.Ordinal;
var args := TDataType.Float;
var results := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(Params).AsOrdinal.Value;
var SMA := CreateSMA(period);
// Local variable is necessary here to capture the created function.
var SMA := CreateSMA(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(Args).AsFloat.Value;
var res := SMA(value);
Result := results.CreateValue(res);
Result := TDataType.FromFloat(SMA(Args.AsFloat.Value));
end
);
end
@@ -483,28 +450,23 @@ end;
class constructor TEMA.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results := TDataType.RecordOf([TRecordField.Create('EMA', TDataType.Float)]);
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var EMA := CreateEMA(period);
var EMA := CreateEMA(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := EMA(value);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(EMA(Args.AsFloat.Value));
end
);
end
@@ -571,26 +533,23 @@ end;
class constructor TWMA.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results := TDataType.RecordOf([TRecordField.Create('WMA', TDataType.Float)]);
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var WMA := CreateWMA(period);
var WMA := CreateWMA(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := WMA(value);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(WMA(Args.AsFloat.Value));
end
);
end
@@ -669,26 +628,23 @@ end;
class constructor THMA.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results := TDataType.RecordOf([TRecordField.Create('HMA', TDataType.Float)]);
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var HMA := CreateHMA(period);
var HMA := CreateHMA(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := HMA(value);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(HMA(Args.AsFloat.Value));
end
);
end
@@ -740,26 +696,23 @@ end;
class constructor TRSI.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results := TDataType.RecordOf([TRecordField.Create('RSI', TDataType.Float)]);
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var RSI := CreateRSI(period);
var RSI := CreateRSI(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := RSI(value);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(RSI(Args.AsFloat.Value));
end
);
end
@@ -841,7 +794,7 @@ end;
class constructor TMACD.CreateClass;
begin
var params :=
var paramsType :=
TDataType.RecordOf(
[
TRecordField.Create('FastPeriod', TDataType.Ordinal),
@@ -849,8 +802,8 @@ begin
TRecordField.Create('SignalPeriod', TDataType.Ordinal)
]
);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results :=
var argsType := TDataType.Float;
var resultType :=
TDataType.RecordOf(
[
TRecordField.Create('MacdLine', TDataType.Float),
@@ -859,33 +812,34 @@ begin
]
);
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
var
paramsRec: IDataRecordValue;
paramsRec: TDataRecordValue;
begin
paramsRec := TDataValue(Params).AsRecord;
var fastPeriod := TDataValue(paramsRec.Items[0]).AsOrdinal.Value;
var slowPeriod := TDataValue(paramsRec.Items[1]).AsOrdinal.Value;
var signalPeriod := TDataValue(paramsRec.Items[2]).AsOrdinal.Value;
var MACD := CreateMACD(fastPeriod, slowPeriod, signalPeriod);
paramsRec := Params.AsRecord;
var MACD :=
CreateMACD(
TDataType.TValue(paramsRec.Items[0]).AsOrdinal.Value,
TDataType.TValue(paramsRec.Items[1]).AsOrdinal.Value,
TDataType.TValue(paramsRec.Items[2]).AsOrdinal.Value
);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := MACD(value);
var res := MACD(Args.AsFloat.Value);
Result :=
results.CreateValue(
resultType.CreateValue(
[
TDataValue.FromFloat(res.MacdLine),
TDataValue.FromFloat(res.SignalLine),
TDataValue.FromFloat(res.Histogram)
TDataType.FromFloat(res.MacdLine),
TDataType.FromFloat(res.SignalLine),
TDataType.FromFloat(res.Histogram)
]
);
end
@@ -1007,7 +961,7 @@ end;
class constructor TStochastic.CreateClass;
begin
var params :=
var paramsType :=
TDataType.RecordOf([TRecordField.Create('KPeriod', TDataType.Ordinal), TRecordField.Create('DPeriod', TDataType.Ordinal)]);
var ohlcType :=
@@ -1021,42 +975,43 @@ begin
]
);
var args := TDataType.RecordOf([TRecordField.Create('Value', ohlcType)]);
var results := TDataType.RecordOf([TRecordField.Create('K', TDataType.Float), TRecordField.Create('D', TDataType.Float)]);
var argsType := ohlcType;
var resultType := TDataType.RecordOf([TRecordField.Create('K', TDataType.Float), TRecordField.Create('D', TDataType.Float)]);
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
var
paramsRec: IDataRecordValue;
paramsRec: TDataRecordValue;
begin
paramsRec := TDataValue(Params).AsRecord;
var kPeriod := TDataValue(paramsRec.Items[0]).AsOrdinal.Value;
var dPeriod := TDataValue(paramsRec.Items[1]).AsOrdinal.Value;
var Stochastic := CreateStochastic(kPeriod, dPeriod);
paramsRec := Params.AsRecord;
var Stochastic :=
CreateStochastic(
TDataType.TValue(paramsRec.Items[0]).AsOrdinal.Value,
TDataType.TValue(paramsRec.Items[1]).AsOrdinal.Value
);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
var
argRec, ohlcRec: IDataRecordValue;
ohlcRec: TDataRecordValue;
ohlcVal: TOhlcItem;
begin
argRec := TDataValue(Args).AsRecord;
ohlcRec := TDataValue(argRec.Items[0]).AsRecord;
ohlcRec := Args.AsRecord;
ohlcVal.Open := TDataValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataValue(ohlcRec.Items[4]).AsFloat.Value;
ohlcVal.Open := TDataType.TValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataType.TValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataType.TValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataType.TValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataType.TValue(ohlcRec.Items[4]).AsFloat.Value;
var res := Stochastic(ohlcVal);
Result := results.CreateValue([TDataValue.FromFloat(res.K), TDataValue.FromFloat(res.D)]);
Result := resultType.CreateValue([TDataType.FromFloat(res.K), TDataType.FromFloat(res.D)]);
end
);
end
@@ -1172,26 +1127,23 @@ end;
class constructor TStdDev.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results := TDataType.RecordOf([TRecordField.Create('StdDev', TDataType.Float)]);
var paramsType := TDataType.Ordinal;
var argsType := TDataType.Float;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var StdDev := CreateStdDev(period);
var StdDev := CreateStdDev(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := StdDev(value);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(StdDev(Args.AsFloat.Value));
end
);
end
@@ -1265,10 +1217,10 @@ end;
class constructor TBollingerBands.CreateClass;
begin
var params :=
var paramsType :=
TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal), TRecordField.Create('Multiplier', TDataType.Float)]);
var args := TDataType.RecordOf([TRecordField.Create('Value', TDataType.Float)]);
var results :=
var argsType := TDataType.Float;
var resultType :=
TDataType.RecordOf(
[
TRecordField.Create('UpperBand', TDataType.Float),
@@ -1277,32 +1229,33 @@ begin
]
);
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
var
paramsRec: IDataRecordValue;
paramsRec: TDataRecordValue;
begin
paramsRec := TDataValue(Params).AsRecord;
var period := TDataValue(paramsRec.Items[0]).AsOrdinal.Value;
var multiplier := TDataValue(paramsRec.Items[1]).AsFloat.Value;
var BollingerBands := CreateBollingerBands(period, multiplier);
paramsRec := Params.AsRecord;
var BollingerBands :=
CreateBollingerBands(
TDataType.TValue(paramsRec.Items[0]).AsOrdinal.Value,
TDataType.TValue(paramsRec.Items[1]).AsFloat.Value
);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
begin
var value := TDataValue(TDataValue(Args).AsRecord.Items[0]).AsFloat.Value;
var res := BollingerBands(value);
var res := BollingerBands(Args.AsFloat.Value);
Result :=
results.CreateValue(
resultType.CreateValue(
[
TDataValue.FromFloat(res.UpperBand),
TDataValue.FromFloat(res.MiddleBand),
TDataValue.FromFloat(res.LowerBand)
TDataType.FromFloat(res.UpperBand),
TDataType.FromFloat(res.MiddleBand),
TDataType.FromFloat(res.LowerBand)
]
);
end
@@ -1359,8 +1312,7 @@ end;
class constructor TATR.CreateClass;
begin
var params := TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal)]);
var paramsType := TDataType.Ordinal;
var ohlcType :=
TDataType.RecordOf(
[
@@ -1371,35 +1323,32 @@ begin
TRecordField.Create('Volume', TDataType.Float)
]
);
var args := TDataType.RecordOf([TRecordField.Create('Value', ohlcType)]);
var results := TDataType.RecordOf([TRecordField.Create('ATR', TDataType.Float)]);
var argsType := ohlcType;
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var period := TDataValue(TDataValue(Params).AsRecord.Items[0]).AsOrdinal.Value;
var ATR := CreateATR(period);
var ATR := CreateATR(Params.AsOrdinal.Value);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
var
argRec, ohlcRec: IDataRecordValue;
ohlcRec: TDataRecordValue;
ohlcVal: TOhlcItem;
begin
argRec := TDataValue(Args).AsRecord;
ohlcRec := TDataValue(argRec.Items[0]).AsRecord;
ohlcVal.Open := TDataValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataValue(ohlcRec.Items[4]).AsFloat.Value;
var res := ATR(ohlcVal);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
ohlcRec := Args.AsRecord;
ohlcVal.Open := TDataType.TValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataType.TValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataType.TValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataType.TValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataType.TValue(ohlcRec.Items[4]).AsFloat.Value;
Result := TDataType.FromFloat(ATR(ohlcVal));
end
);
end
@@ -1455,7 +1404,7 @@ end;
class constructor TKeltnerChannels.CreateClass;
begin
var params :=
var paramsType :=
TDataType.RecordOf([TRecordField.Create('Period', TDataType.Ordinal), TRecordField.Create('Multiplier', TDataType.Float)]);
var ohlcType :=
TDataType.RecordOf(
@@ -1467,8 +1416,8 @@ begin
TRecordField.Create('Volume', TDataType.Float)
]
);
var args := TDataType.RecordOf([TRecordField.Create('Value', ohlcType)]);
var results :=
var argsType := ohlcType;
var resultType :=
TDataType.RecordOf(
[
TRecordField.Create('UpperBand', TDataType.Float),
@@ -1477,42 +1426,43 @@ begin
]
);
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
var
paramsRec: IDataRecordValue;
paramsRec: TDataRecordValue;
begin
paramsRec := TDataValue(Params).AsRecord;
var period := TDataValue(paramsRec.Items[0]).AsOrdinal.Value;
var multiplier := TDataValue(paramsRec.Items[1]).AsFloat.Value;
var KeltnerChannels := CreateKeltnerChannels(period, multiplier);
paramsRec := Params.AsRecord;
var KeltnerChannels :=
CreateKeltnerChannels(
TDataType.TValue(paramsRec.Items[0]).AsOrdinal.Value,
TDataType.TValue(paramsRec.Items[1]).AsFloat.Value
);
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
var
argRec, ohlcRec: IDataRecordValue;
ohlcRec: TDataRecordValue;
ohlcVal: TOhlcItem;
begin
argRec := TDataValue(Args).AsRecord;
ohlcRec := TDataValue(argRec.Items[0]).AsRecord;
ohlcVal.Open := TDataValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataValue(ohlcRec.Items[4]).AsFloat.Value;
ohlcRec := Args.AsRecord;
ohlcVal.Open := TDataType.TValue(ohlcRec.Items[0]).AsFloat.Value;
ohlcVal.High := TDataType.TValue(ohlcRec.Items[1]).AsFloat.Value;
ohlcVal.Low := TDataType.TValue(ohlcRec.Items[2]).AsFloat.Value;
ohlcVal.Close := TDataType.TValue(ohlcRec.Items[3]).AsFloat.Value;
ohlcVal.Volume := TDataType.TValue(ohlcRec.Items[4]).AsFloat.Value;
var res := KeltnerChannels(ohlcVal);
Result :=
results.CreateValue(
resultType.CreateValue(
[
TDataValue.FromFloat(res.UpperBand),
TDataValue.FromFloat(res.MiddleBand),
TDataValue.FromFloat(res.LowerBand)
TDataType.FromFloat(res.UpperBand),
TDataType.FromFloat(res.MiddleBand),
TDataType.FromFloat(res.LowerBand)
]
);
end
@@ -1576,35 +1526,32 @@ end;
class constructor TMean.CreateClass;
begin
var params := TDataType.RecordOf([]);
var args := TDataType.RecordOf([TRecordField.Create('Values', TDataType.ArrayOf(TDataType.Float))]);
var results := TDataType.RecordOf([TRecordField.Create('Mean', TDataType.Float)]);
var paramsType := TDataType.RecordOf([]);
var argsType := TDataType.ArrayOf(TDataType.Float);
var resultType := TDataType.Float;
var indicatorMethod := TDataType.MethodOf(args, results);
var factoryMethod := TDataType.MethodOf(params, indicatorMethod);
var indicatorMethodType := TDataType.MethodOf(argsType, resultType);
var factoryMethodType := TDataType.MethodOf(paramsType, indicatorMethodType);
FFactory :=
factoryMethod.CreateValue(
function(const Params: IDataValue): IDataValue
factoryMethodType.CreateValue(
function(const Params: TDataType.TValue): TDataType.TValue
begin
var Mean := CreateMean();
Result :=
indicatorMethod.CreateValue(
function(const Args: IDataValue): IDataValue
indicatorMethodType.CreateValue(
function(const Args: TDataType.TValue): TDataType.TValue
var
i: Integer;
argsRec: IDataRecordValue;
valuesArray: IDataArrayValue;
valuesArray: TDataArrayValue;
values: TArray<Double>;
begin
argsRec := TDataValue(Args).AsRecord;
valuesArray := TDataValue(argsRec.Items[0]).AsArray;
valuesArray := Args.AsArray;
SetLength(values, valuesArray.ElementCount);
for i := 0 to valuesArray.ElementCount - 1 do
values[i] := TDataValue(valuesArray.Items[i]).AsFloat.Value;
values[i] := TDataType.TValue(valuesArray.Items[i]).AsFloat.Value;
var res := Mean(values);
Result := results.CreateValue([TDataValue.FromFloat(res)]);
Result := TDataType.FromFloat(Mean(values));
end
);
end
Src/Myc.Trade.Indicators_v2.pas
+11 -11
View File
@@ -79,7 +79,7 @@ type
function GetArgType: TDataType;
function GetResultType: TDataType;
function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
function CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>;
// Provides direct access to the type information of parameters, arguments, and results.
property ParamType: TDataType read GetParamType;
@@ -108,7 +108,7 @@ type
function GetParamType: TDataType;
function GetArgType: TDataType;
function GetResultType: TDataType;
function CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>; overload;
function CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
@@ -163,7 +163,7 @@ type
var
IndicatorRegistry: TIndicatorRegistry;
function DataValueFromTValue(const aValue: TValue): TDataValue;
function DataValueFromTValue(const aValue: TValue): TDataType.TValue;
function DataTypeFromRttiType(const Ctx: TRttiContext; rttiType: TRttiType): TDataType;
implementation
@@ -207,20 +207,20 @@ begin
end;
// Converts a TValue into an IDataValue. This is the bridge from RTTI to the custom type system.
function DataValueFromTValue(const aValue: TValue): TDataValue;
function DataValueFromTValue(const aValue: TValue): TDataType.TValue;
var
ctx: TRttiContext;
begin
if aValue.IsEmpty then
begin
Result := TDataValue.Create(nil);
Result := TDataType.TValue.Create(nil);
exit;
end;
case aValue.Kind of
tkInteger, tkInt64, tkEnumeration: Result := TDataValue.FromOrdinal(aValue.AsInt64);
tkFloat: Result := TDataValue.FromFloat(aValue.AsExtended);
tkString, tkUString: Result := TDataValue.FromText(aValue.AsString);
tkInteger, tkInt64, tkEnumeration: Result := TDataType.FromOrdinal(aValue.AsInt64);
tkFloat: Result := TDataType.FromFloat(aValue.AsExtended);
tkString, tkUString: Result := TDataType.FromText(aValue.AsString);
tkRecord:
begin
ctx := TRttiContext.Create;
@@ -438,12 +438,12 @@ begin
Result := FResultType;
end;
function TGenericIndicatorFactory.CreateIndicator(const Params: TDataValue): TConvertFunc<TDataValue, TDataValue>;
function TGenericIndicatorFactory.CreateIndicator(const Params: TDataType.TValue): TConvertFunc<TDataType.TValue, TDataType.TValue>;
var
internalProc: TConvertFunc<IDataValue, IDataValue>;
begin
internalProc := FFactoryProc(Params);
Result := function(const Args: TDataValue): TDataValue begin Result := internalProc(Args); end;
Result := function(const Args: TDataType.TValue): TDataType.TValue begin Result := internalProc(Args); end;
end;
function TGenericIndicatorFactory.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
@@ -531,7 +531,7 @@ var
// Generates a field layout from a data type.
function LayoutFromDataType(DataType: TDataType): TFieldLayout;
var
recordType: TDataRecordType;
recordType: TDataType.TRecord;
begin
if DataType.Kind <> TDataKind.dkRecord then
begin