Files
MycLib/Src/Data/Myc.Data.Scalar.pas
T
Michael Schimmel 957171f089 Keywords as basic scalar type
Script enhancements
2025-11-01 00:56:59 +01:00

755 lines
24 KiB
ObjectPascal

unit Myc.Data.Scalar;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
Myc.Utils,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Data.Keyword;
{$SCOPEDENUMS ON}
type
// A scalar value with a type identifier.
TScalar = record
public
type
// Defines the underlying storage kinds for scalar values
TKind = (Ordinal, Float, Keyword);
// The 8-byte storage for the scalar value
TValue = record
case TKind of
TKind.Ordinal, TKind.Keyword: (AsInt64: Int64); // Ordinal and Keyword index
TKind.Float: (AsDouble: Double);
end;
TBinaryOp = (Add, Subtract, Multiply, Divide, Equal, NotEqual, Less, Greater, LessOrEqual, GreaterOrEqual);
TUnaryOp = (Negate, &Not);
TKindHelper = record helper for TKind
public
function ToString: string;
end;
TBinaryOpHelper = record helper for TScalar.TBinaryOp
function ToString: string;
end;
TUnaryOpHelper = record helper for TScalar.TUnaryOp
function ToString: string;
end;
public
Kind: TKind;
Value: TValue;
// Creates a new scalar from a kind and a value.
constructor Create(AKind: TKind; const AValue: TValue);
// Factory methods for core types.
class function FromInt64(AValue: Int64): TScalar; static; inline;
class function FromDouble(AValue: Double): TScalar; static; inline;
class function FromKeyword(const AValue: IKeyword): TScalar; static; inline;
// Implicit casts for core types.
class operator Implicit(AValue: Int64): TScalar; overload; inline;
class operator Implicit(AValue: Double): TScalar; overload; inline;
class operator Implicit(const AValue: IKeyword): TScalar; overload; inline;
class operator Implicit(const A: TScalar): Double; overload;
class operator Implicit(const A: TScalar): Int64; overload;
class function StringToKind(const AName: string): TKind; static;
function ToString: String;
class function IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean; static;
class function IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean; static;
class function TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; static;
class function TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; static;
class operator Add(const A, B: TScalar): TScalar;
class operator Divide(const A, B: TScalar): TScalar;
class operator Equal(const A, B: TScalar): Boolean;
class operator GreaterThan(const A, B: TScalar): Boolean;
class operator GreaterThanOrEqual(const A, B: TScalar): Boolean;
class operator LessThan(const A, B: TScalar): Boolean;
class operator LessThanOrEqual(const A, B: TScalar): Boolean;
class operator LogicalNot(const A: TScalar): TScalar;
class operator Multiply(const A, B: TScalar): TScalar;
class operator Negative(const A: TScalar): TScalar;
class operator NotEqual(const A, B: TScalar): Boolean;
class operator Round(const A: TScalar): TScalar;
class operator Subtract(const A, B: TScalar): TScalar;
class operator Trunc(const A: TScalar): TScalar;
end;
// An array of scalar values of the same kind.
TScalarArray = record
public
Kind: TScalar.TKind;
Items: TArray<TScalar.TValue>;
constructor Create(AKind: TScalar.TKind; const AItems: TArray<TScalar.TValue>);
end;
TScalarTuple = TArray<TScalar>;
// A field definition for a scalar record.
TScalarRecordField = TPair<IKeyword, TScalar.TKind>;
IScalarRecordDefinition = IKeywordMapping<TScalar.TKind>;
TScalarRecordRegistry = TKeywordMappingRegistry<TScalar.TKind>;
// A record of scalar values, based on a definition.
TScalarRecord = record
public
constructor Create(const ADef: IScalarRecordDefinition; const AFields: TArray<TScalar.TValue>);
function GetDef: IScalarRecordDefinition; inline;
function GetFields: TArray<TScalar.TValue>; inline;
function GetKeys(const Key: IKeyword): TScalar;
property Def: IScalarRecordDefinition read GetDef;
property Fields: TArray<TScalar.TValue> read GetFields;
property Keys[const Key: IKeyword]: TScalar read GetKeys; default;
strict private
FDef: IScalarRecordDefinition;
FFields: TArray<TScalar.TValue>;
end;
ISeries = interface
{$region 'private'}
function GetCount: Int64;
function GetItems(Idx: Integer): TScalar;
function GetTotalCount: Int64;
{$endregion}
property Count: Int64 read GetCount;
property Items[Idx: Integer]: TScalar read GetItems; default;
property TotalCount: Int64 read GetTotalCount;
end;
IWriteableSeries = interface(ISeries)
procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
end;
// A time series of scalar records, optimized for memory and access speed.
TScalarSeries = class(TInterfacedObject, ISeries, IWriteableSeries)
private
FKind: TScalar.TKind;
FArray: TChunkArray<TScalar.TValue>;
FTotalCount: Int64;
function GetCount: Int64; inline;
function GetItems(Idx: Integer): TScalar; inline;
function GetTotalCount: Int64; inline;
public
constructor Create(AKind: TScalar.TKind);
procedure Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
end;
IRecordSeries = interface
{$region 'private'}
function GetCount: Int64;
function GetDef: IScalarRecordDefinition;
function GetTotalCount: Int64;
function GetFields(const Key: IKeyword): ISeries;
{$endregion}
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
property Count: Int64 read GetCount;
property Def: IScalarRecordDefinition read GetDef;
property Fields[const Key: IKeyword]: ISeries read GetFields; default;
property TotalCount: Int64 read GetTotalCount;
end;
// A time series of scalar records, optimized for memory and access speed.
TScalarRecordSeries = class(TInterfacedObject, IRecordSeries)
type
TMemberSeries = class(TGenericContainedObject<TScalarRecordSeries>, ISeries)
private
FKind: TScalar.TKind;
FOffset: Integer;
function GetCount: Int64;
function GetItems(Idx: Integer): TScalar;
function GetRecordSeries: TScalarRecordSeries; inline;
function GetTotalCount: Int64;
public
constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
property RecordSeries: TScalarRecordSeries read GetRecordSeries;
end;
private
FDef: IScalarRecordDefinition;
FArray: TChunkArray<TScalar.TValue>;
FFields: TArray<TMemberSeries>;
FTotalCount: Int64;
function GetCount: Int64; inline;
function GetFields(const Key: IKeyword): ISeries;
function GetDef: IScalarRecordDefinition; inline;
function GetTotalCount: Int64; inline;
function GetItemRef(Idx: Integer): TChunkArray<TScalar.TValue>.PT; inline;
public
constructor Create(const ADef: IScalarRecordDefinition);
destructor Destroy; override;
procedure Add(const Item: TScalarRecord; Lookback: Int64 = -1);
property Count: Int64 read GetCount;
property Fields[const Key: IKeyword]: ISeries read GetFields; default;
property Def: IScalarRecordDefinition read GetDef;
property TotalCount: Int64 read GetTotalCount;
end;
TIndexSeries = class(TInterfacedObject, ISeries)
private
FIndexArray: TArray<Integer>;
function GetCount: Int64;
function GetTotalCount: Int64;
function GetItems(Idx: Integer): TScalar;
public
constructor Create(const AIndexArray: TArray<Integer>);
end;
implementation
{ TScalar }
constructor TScalar.Create(AKind: TKind; const AValue: TValue);
begin
Kind := AKind;
Value := AValue;
end;
class function TScalar.FromDouble(AValue: Double): TScalar;
begin
Result.Kind := TKind.Float;
Result.Value.AsDouble := AValue;
end;
class function TScalar.FromInt64(AValue: Int64): TScalar;
begin
Result.Kind := TKind.Ordinal;
Result.Value.AsInt64 := AValue;
end;
class function TScalar.FromKeyword(const AValue: IKeyword): TScalar;
begin
Result.Kind := TKind.Keyword;
if not Assigned(AValue) then
raise EArgumentException.Create('Keyword must not be nil.');
Result.Value.AsInt64 := AValue.Idx
end;
class operator TScalar.Implicit(AValue: Double): TScalar;
begin
Result.Kind := TKind.Float;
Result.Value.AsDouble := AValue;
end;
class operator TScalar.Implicit(AValue: Int64): TScalar;
begin
Result.Kind := TKind.Ordinal;
Result.Value.AsInt64 := AValue;
end;
class operator TScalar.Implicit(const AValue: IKeyword): TScalar;
begin
Result.Kind := TKind.Keyword;
if not Assigned(AValue) then
raise EArgumentException.Create('Keyword must not be nil.');
Result.Value.AsInt64 := AValue.Idx
end;
class operator TScalar.Implicit(const A: TScalar): Double;
begin
case A.Kind of
TKind.Ordinal: Result := A.Value.AsInt64;
TKind.Float: Result := A.Value.AsDouble;
else
raise EInvalidCast.Create('Cannot implicitly convert Keyword to Double');
end;
end;
class operator TScalar.Implicit(const A: TScalar): Int64;
begin
case A.Kind of
TKind.Ordinal: Result := A.Value.AsInt64;
else
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Int64', [A.Kind.ToString]);
end;
end;
class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean;
begin
// Deny all operations if either operand is Keyword...
if (A = TKind.Keyword) or (B = TKind.Keyword) then
begin
// ...except for Equality checks
Result := (Op in [TBinaryOp.Equal, TBinaryOp.NotEqual]);
exit;
end;
// Default for Ordinal/Float
Result := True;
end;
class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean;
begin
// Deny all unary ops for Keywords
if (A = TKind.Keyword) then
exit(False);
// Deny 'not' for Float
if (Op = TUnaryOp.Not) and (A = TKind.Float) then
exit(False);
Result := True;
end;
class function TScalar.StringToKind(const AName: string): TKind;
begin
if SameText(AName, 'Ordinal') then
Result := TKind.Ordinal
else if SameText(AName, 'Float') then
Result := TKind.Float
else if SameText(AName, 'Keyword') then
Result := TKind.Keyword
else
raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]);
end;
function TScalar.ToString: String;
begin
case Kind of
TKind.Ordinal: Result := IntToStr(Value.AsInt64);
TKind.Float: Result := FloatToStr(Value.AsDouble);
TKind.Keyword: Result := ':' + TKeywordRegistry.GetName(Value.AsInt64);
else
Result := '[Unknown Scalar]';
end;
end;
class function TScalar.TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean;
begin
if not IsBinaryOperatorSupported(Op, A.Kind, B.Kind) then
exit(False);
try
case Op of
TBinaryOp.Add: Res := A + B;
TBinaryOp.Subtract: Res := A - B;
TBinaryOp.Multiply: Res := A * B;
TBinaryOp.Divide: Res := A / B;
TBinaryOp.Equal: Res := TScalar.FromInt64(Integer(A = B));
TBinaryOp.NotEqual: Res := TScalar.FromInt64(Integer(A <> B));
TBinaryOp.Less: Res := TScalar.FromInt64(Integer(A < B));
TBinaryOp.Greater: Res := TScalar.FromInt64(Integer(A > B));
TBinaryOp.LessOrEqual: Res := TScalar.FromInt64(Integer(A <= B));
TBinaryOp.GreaterOrEqual: Res := TScalar.FromInt64(Integer(A >= B));
else
Result := False;
exit;
end;
Result := True;
except
Result := False;
end;
end;
class function TScalar.TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean;
begin
if not IsUnaryOperatorSupported(Op, A.Kind) then
exit(False);
try
case Op of
TUnaryOp.Negate: Res := -A;
TUnaryOp.Not: Res := not A;
else
Result := False;
exit;
end;
Result := True;
except
Result := False;
end;
end;
class operator TScalar.Add(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 + B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A; // Use implicit cast
valB := B; // Use implicit cast
Result := valA + valB;
end
else
raise EArgumentException.CreateFmt('Operator Add not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.Divide(const A, B: TScalar): TScalar;
begin
// Division *always* promotes to Float, unless types are invalid
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) then
raise EArgumentException.CreateFmt('Operator Divide not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
var valA, valB: Double;
valA := A; // Use implicit cast
valB := B; // Use implicit cast
Result := valA / valB;
end;
class operator TScalar.Equal(const A, B: TScalar): Boolean;
begin
// Must be same kind to be equal (e.g., Ordinal(5) <> Keyword(5))
if A.Kind <> B.Kind then
exit(False);
case A.Kind of
TKind.Ordinal, TKind.Keyword: Result := A.Value.AsInt64 = B.Value.AsInt64;
TKind.Float: Result := A.Value.AsDouble = B.Value.AsDouble;
else
Result := False;
end;
end;
class operator TScalar.GreaterThan(const A, B: TScalar): Boolean;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 > B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA > valB;
end
else
raise EArgumentException.CreateFmt('Operator GreaterThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean;
begin
Result := not (A < B);
end;
class operator TScalar.LessThan(const A, B: TScalar): Boolean;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 < B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA < valB;
end
else
raise EArgumentException.CreateFmt('Operator LessThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.LessThanOrEqual(const A, B: TScalar): Boolean;
begin
Result := not (A > B);
end;
class operator TScalar.LogicalNot(const A: TScalar): TScalar;
begin
if A.Kind <> TKind.Ordinal then
raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]);
if A.Value.AsInt64 = 0 then
Result := 1
else
Result := 0;
end;
class operator TScalar.Multiply(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 * B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA * valB;
end
else
raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.Negative(const A: TScalar): TScalar;
begin
Result.Kind := A.Kind;
case A.Kind of
TKind.Ordinal: Result.Value.AsInt64 := -A.Value.AsInt64;
TKind.Float: Result.Value.AsDouble := -A.Value.AsDouble;
else
raise EArgumentException.CreateFmt('Operator Negative not supported for type %s', [A.Kind.ToString]);
end;
end;
class operator TScalar.NotEqual(const A, B: TScalar): Boolean;
begin
Result := not (A = B);
end;
class operator TScalar.Round(const A: TScalar): TScalar;
begin
var val: Double;
val := A; // Implicit cast handles Ordinal or Float
Result := System.Round(val);
end;
class operator TScalar.Subtract(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 - B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA - valB;
end
else
raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.Trunc(const A: TScalar): TScalar;
begin
var val: Double;
val := A; // Implicit cast handles Ordinal or Float
Result := System.Trunc(val);
end;
{ TScalarArray }
constructor TScalarArray.Create(AKind: TScalar.TKind; const AItems: TArray<TScalar.TValue>);
begin
Kind := AKind;
Items := AItems;
end;
{ TScalarRecord }
constructor TScalarRecord.Create(const ADef: IScalarRecordDefinition; const AFields: TArray<TScalar.TValue>);
begin
Assert(Length(ADef.Fields) = Length(AFields), 'Field definition and value count must match.');
FDef := ADef;
FFields := AFields;
end;
function TScalarRecord.GetDef: IScalarRecordDefinition;
begin
Result := FDef;
end;
function TScalarRecord.GetFields: TArray<TScalar.TValue>;
begin
Result := FFields;
end;
function TScalarRecord.GetKeys(const Key: IKeyword): TScalar;
var
idx: Integer;
begin
idx := FDef.IndexOf(Key);
if idx < 0 then
raise EArgumentException.CreateFmt('Field ":%s" not found in record definition.', [Key.Name]);
Result.Create(FDef.Fields[idx].Value, FFields[idx]);
end;
{ TScalarRecordSeries }
constructor TScalarRecordSeries.Create(const ADef: IScalarRecordDefinition);
begin
Assert(Length(ADef.Fields) > 0);
FDef := ADef;
FTotalCount := 0;
SetLength(FFields, Length(FDef.Fields));
for var i := 0 to High(FFields) do
FFields[i] := TMemberSeries.Create(Self, i);
end;
destructor TScalarRecordSeries.Destroy;
begin
for var i := High(FFields) downto 0 do
FFields[i].Free;
inherited;
end;
procedure TScalarRecordSeries.Add(const Item: TScalarRecord; Lookback: Int64 = -1);
begin
FArray.Add(Item.Fields, Length(FDef.Fields) * Lookback);
inc(FTotalCount);
end;
function TScalarRecordSeries.GetFields(const Key: IKeyword): ISeries;
begin
var elem := FDef.IndexOf(Key);
if elem < 0 then
raise EArgumentException.CreateFmt('Field ":%s" not found in record definition.', [Key.Name]);
Result := FFields[elem];
end;
function TScalarRecordSeries.GetCount: Int64;
begin
Result := FArray.Count div Length(FDef.Fields);
end;
function TScalarRecordSeries.GetDef: IScalarRecordDefinition;
begin
Result := FDef;
end;
function TScalarRecordSeries.GetItemRef(Idx: Integer): TChunkArray<TScalar.TValue>.PT;
begin
var len := Length(FDef.Fields);
Result := FArray.ItemRef[(FArray.Count - len) - (Idx * len)];
end;
function TScalarRecordSeries.GetTotalCount: Int64;
begin
Result := FTotalCount;
end;
{ TScalar.TKindHelper }
function TScalar.TKindHelper.ToString: string;
begin
case Self of
TScalar.TKind.Ordinal: Result := 'Ordinal';
TScalar.TKind.Float: Result := 'Float';
TScalar.TKind.Keyword: Result := 'Keyword';
else
Result := 'unknown';
end;
end;
{ TScalar.TBinaryOpHelper }
function TScalar.TBinaryOpHelper.ToString: string;
begin
case Self of
TScalar.TBinaryOp.Add: Result := '+';
TScalar.TBinaryOp.Subtract: Result := '-';
TScalar.TBinaryOp.Multiply: Result := '*';
TScalar.TBinaryOp.Divide: Result := '/';
TScalar.TBinaryOp.Equal: Result := '=';
TScalar.TBinaryOp.NotEqual: Result := '<>';
TScalar.TBinaryOp.Less: Result := '<';
TScalar.TBinaryOp.Greater: Result := '>';
TScalar.TBinaryOp.LessOrEqual: Result := '<=';
TScalar.TBinaryOp.GreaterOrEqual: Result := '>=';
else
Result := '?';
end;
end;
{ TScalar.TUnaryOpHelper }
function TScalar.TUnaryOpHelper.ToString: string;
begin
case Self of
TScalar.TUnaryOp.Negate: Result := '-';
TScalar.TUnaryOp.Not: Result := 'not';
else
Result := '?';
end;
end;
{ TScalarRecordSeries.TMemberSeries }
constructor TScalarRecordSeries.TMemberSeries.Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer);
begin
inherited Create(ARecordSeries);
FKind := ARecordSeries.FDef.Fields[AElementIdx].Value;
FOffset := sizeof(TScalar.TValue) * AElementIdx;
end;
function TScalarRecordSeries.TMemberSeries.GetCount: Int64;
begin
Result := RecordSeries.Count;
end;
function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar;
var
P: TChunkArray<TScalar.TValue>.PT;
begin
P := RecordSeries.GetItemRef(Idx);
inc(PByte(P), FOffset);
Result.Create(FKind, P^);
end;
function TScalarRecordSeries.TMemberSeries.GetRecordSeries: TScalarRecordSeries;
begin
Result := TScalarRecordSeries(Controller);
end;
function TScalarRecordSeries.TMemberSeries.GetTotalCount: Int64;
begin
Result := RecordSeries.TotalCount;
end;
{ TScalarSeries }
constructor TScalarSeries.Create(AKind: TScalar.TKind);
begin
FKind := AKind;
FTotalCount := 0;
end;
procedure TScalarSeries.Add(const Item: TScalar.TValue; Lookback: Int64 = -1);
begin
FArray.Add(Item, Lookback);
inc(FTotalCount);
end;
function TScalarSeries.GetCount: Int64;
begin
Result := FArray.Count;
end;
function TScalarSeries.GetItems(Idx: Integer): TScalar;
begin
Result.Create(FKind, FArray[FArray.Count - Idx - 1]);
end;
function TScalarSeries.GetTotalCount: Int64;
begin
Result := FTotalCount;
end;
{ TIndexSeries }
constructor TIndexSeries.Create(const AIndexArray: TArray<Integer>);
begin
inherited Create;
FIndexArray := AIndexArray;
end;
function TIndexSeries.GetCount: Int64;
begin
Result := Length(FIndexArray);
end;
function TIndexSeries.GetTotalCount: Int64;
begin
Result := GetCount;
end;
function TIndexSeries.GetItems(Idx: Integer): TScalar;
var
sourceIndex: Integer;
begin
sourceIndex := FIndexArray[GetCount - 1 - Idx];
Result := TScalar.FromInt64(sourceIndex);
end;
initialization
Assert(sizeof(TScalar.TValue) = 8);
end.