ASVisualization.pas

unit ASVisualization;

interface

uses
  SysUtils, Types, Classes, Generics.Defaults, Generics.Collections, ASNum,
  ASObjects, ASKernelDefs, VisCtl2D, rgl, ASPixmap, DoublePoint;

type
  TCategoryData = record
    Name: string;
    Value: TASR;
  end;
  TCategoryDataList = TList<TCategoryData>;

  PDataRange = ^TDataRange;
  TDataRange = record
    Min, Max: Double;
    function Span: Double; inline;
    function SpanOrUnit: Double; inline;
  end;

  THistogramData = class
    Numbers: TArray<TASR>;
  end;

  TScatterDataR2 = class
    Points: TArray<TASR2>;
  end;

  TScatterDataR3 = class
    Points: TArray<TASR3>;
  end;

  TScatterDataR3cs = class
    Points: TArray<Double>;
  end;

  TCurveDataR3 = class
    Points: TArray<rglv>;
  end;

  TCurveDataR3c = class
    Points: TArray<GLr3c3v>;
  end;

  TRegionDataR2 = class
    Slices: TArray<TSlice>;
    Axis: TCartesianAxis;
    UnboundedMin,
    UnboundedMax: Boolean;
  end;

  THeatmapData = class
    Pixmap: TASPixmap;
    x0, x1,
    y0, y1: TASR;
  end;

  TVectorFieldDataR2 = class
    Vectors: TArray<TPair<TPointD, TVectorD>>;
  end;

  TVectorFieldDataR3 = class
    Vectors: TArray<GLr3v3c3v>;
    Colored: Boolean;
  end;

  TLineDataR2 = class
    a, b: TPointD;
  end;

  TRectangleData = class
    a: TPointD;
    w, h: TASR;
  end;

  TCircleData = class
    a: TPointD;
    r: TASR;
  end;

  TPolygonData = TScatterDataR2;

  TTextData = class
    Position: TPointD;
    Text: string;
  end;

  TPixmapData = class
    Rect: TRectD;
    Pixmap: TASPixmap;
  end;

  TSurfaceData = class
    Data: TArray<rglv>;
    Domain: TRectDom;
    Nx, Ny: Integer;
  end;

  TColoredSurfaceData = class
    Data: TArray<GLr3c3v>;
    Domain: TRectDom;
    Nx, Ny: Integer;
  end;

  TObject3DData = class
    ObjectClass: TDrawable3DClass;
    Name: string;
    Data: string;
  end;

  TArrowDataR2 = class
    a, v: TPointD;
  end;

  TArrowDataR3 = class
    a, v: rglv;
  end;

function GetCategoryData(AList: TArray<TAlgosimObject>; ACatCount: PInteger = nil;
  AYStats: PDataRange = nil): TCategoryDataList;

function GetHistogramData(ANumbers: TArray<TASR>; AXStats: PDataRange = nil): THistogramData;

function GetScatterDataR2(APoints: TArray<TASR2>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil): TScatterDataR2;

function GetScatterDataR3(APoints: TArray<TASR3>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TScatterDataR3;

function GetScatterDataR3cs(APoints: TArray<Double>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TScatterDataR3cs;

function GetCurveDataR3(APoints: TArray<TASR3>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TCurveDataR3;

function GetCurveDataR3cs(APoints: TArray<Double>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TCurveDataR3c;

function GetRegionDataR2(ASlices: TArray<TSlice>; AUnboundedMin, AUnboundedMax: Boolean;
  AXStats: PDataRange = nil; AYStats: PDataRange = nil): TRegionDataR2;

function GetSurfaceData(APoints: TArray<TASR3>;
  const xmin, xmax: TASR; Nx: Integer; const ymin, ymax: TASR; Ny: Integer): TSurfaceData;

function GetColoredSurfaceData(APoints: TArray<TASR4>;
  const xmin, xmax: TASR; Nx: Integer; const ymin, ymax: TASR; Ny: Integer): TColoredSurfaceData;

function O3D(AClass: TDrawable3DClass; const AName: string = '';
  const AData: string = ''): TObject3DData; overload;
function O3D(const AName: string): TObject3DData; overload;

function GetArrowDataR2(const a, v: TRealVector): TArrowDataR2;
function GetArrowDataR3(const a, v: TRealVector): TArrowDataR3;

type
  TVisualizationTarget = (vt2D, vt3D);
  TVisualKind = (vkNull, vkBarChart, vkPieChart, vkHistogram, vkXYPlot, vkRegion,
    vkHeatmap, vkVectorField, vkPixmap, vkText, vkLine, vkRectangle, vkCircle,
    vkPolygon, vkXYZPlot, vkXYZcsPlot, vkSurface, vkSpaceCurve, vkObject3D,
    vkArrow);

  TVisSetupProc2D = reference to procedure(ACtl: TVisCtl2D; ADrawable: TDrawable);
  TVisSetupProc3D = reference to procedure(ACtl: TVisCtl3D; ADrawable: TDrawable3D);

  TVisual = class
    Target: TVisualizationTarget;
    Kind: TVisualKind;
    Data: TObject;
    ViewSetupProc2D,
    OwnSetupProc2D: TVisSetupProc2D;
    ViewSetupProc3D,
    OwnSetupProc3D: TVisSetupProc3D;
    constructor Create2D(AKind: TVisualKind;
      AData: TObject; AViewSetupProc: TVisSetupProc2D = nil;
      AOwnSetupProc: TVisSetupProc2D = nil);
    constructor Create3D(AKind: TVisualKind;
      AData: TObject; AViewSetupProc: TVisSetupProc3D = nil;
      AOwnSetupProc: TVisSetupProc3D = nil);
    destructor Destroy; override;
  end;

implementation

uses
  Math, Graphics, ASColors;

function GetCategoryData(AList: TArray<TAlgosimObject>; ACatCount: PInteger;
  AYStats: PDataRange): TCategoryDataList;

  procedure Inv;
  begin
    raise Exception.Create('Invalid category data list.');
  end;

var
  i: Integer;
  elem: TAlgosimObject;
  cd: TCategoryData;
begin
  if Assigned(ACatCount) then
    ACatCount^ := Length(AList);
  if Assigned(AYStats) then
    FillChar(AYStats^, SizeOf(AYStats^), 0);
  Result := TCategoryDataList.Create;
  try
    for i := 0 to High(AList) do
    begin
      elem := AList[i];
      if elem.IsObjectContainer and (elem.ElementCount = 2) and elem.Elements[2].TryToASR(cd.Value) then
      begin
        cd.Name := elem.Elements[1].ToString;
        Result.Add(cd);
        if Assigned(AYStats) then
        begin
          if i = 1 then
          begin
            AYStats.Min := cd.Value;
            AYStats.Max := cd.Value;
          end
          else
          begin
            if cd.Value < AYStats.Min then
              AYStats.Min := cd.Value;
            if cd.Value > AYStats.Max then
              AYStats.Max := cd.Value;
          end
        end;
      end
      else
        Inv;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function GetHistogramData(ANumbers: TArray<TASR>; AXStats: PDataRange): THistogramData;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    if Length(ANumbers) > 0 then
    begin
      AXStats.Min := MinValue(ANumbers);
      AXStats.Max := MaxValue(ANumbers);
    end;
  end;

  Result := THistogramData.Create;
  try
    Result.Numbers := ANumbers;
  except
    Result.Free;
    raise;
  end;

end;

function GetScatterDataR2(APoints: TArray<TASR2>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil): TScatterDataR2;
var
  i: Integer;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    if Length(APoints) > 0 then
    begin
      AXStats.Min := APoints[0].X;
      AXStats.Max := APoints[0].X;
      for i := 0 to High(APoints) do
      begin
        if APoints[i].X < AXStats.Min then
          AXStats.Min := APoints[i].X;
        if APoints[i].X > AXStats.Max then
          AXStats.Max := APoints[i].X;
      end;
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    if Length(APoints) > 0 then
    begin
      AYStats.Min := APoints[0].Y;
      AYStats.Max := APoints[0].Y;
      for i := 0 to High(APoints) do
      begin
        if APoints[i].Y < AYStats.Min then
          AYStats.Min := APoints[i].Y;
        if APoints[i].Y > AYStats.Max then
          AYStats.Max := APoints[i].Y;
      end;
    end;
  end;

  Result := TScatterDataR2.Create;
  try
    Result.Points := APoints;
  except
    Result.Free;
    raise;
  end;

end;

function GetScatterDataR3(APoints: TArray<TASR3>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TScatterDataR3;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    if Length(APoints) > 0 then
    begin
      AXStats.Min := APoints[0].X;
      AXStats.Max := APoints[0].X;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].X < AXStats.Min then
          AXStats.Min := APoints[i].X;
        if APoints[i].X > AXStats.Max then
          AXStats.Max := APoints[i].X;
      end;
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    if Length(APoints) > 0 then
    begin
      AYStats.Min := APoints[0].Y;
      AYStats.Max := APoints[0].Y;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].Y < AYStats.Min then
          AYStats.Min := APoints[i].Y;
        if APoints[i].Y > AYStats.Max then
          AYStats.Max := APoints[i].Y;
      end;
    end;
  end;

  if Assigned(AZStats) then
  begin
    FillChar(AZStats^, SizeOf(AZStats^), 0);
    if Length(APoints) > 0 then
    begin
      AZStats.Min := APoints[0].Z;
      AZStats.Max := APoints[0].Z;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].Z < AZStats.Min then
          AZStats.Min := APoints[i].Z;
        if APoints[i].Z > AZStats.Max then
          AZStats.Max := APoints[i].Z;
      end;
    end;
  end;

  Result := TScatterDataR3.Create;
  try
    Result.Points := APoints;
  except
    Result.Free;
    raise;
  end;

end;

function GetCurveDataR3(APoints: TArray<TASR3>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TCurveDataR3;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    if Length(APoints) > 0 then
    begin
      AXStats.Min := APoints[0].X;
      AXStats.Max := APoints[0].X;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].X < AXStats.Min then
          AXStats.Min := APoints[i].X;
        if APoints[i].X > AXStats.Max then
          AXStats.Max := APoints[i].X;
      end;
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    if Length(APoints) > 0 then
    begin
      AYStats.Min := APoints[0].Y;
      AYStats.Max := APoints[0].Y;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].Y < AYStats.Min then
          AYStats.Min := APoints[i].Y;
        if APoints[i].Y > AYStats.Max then
          AYStats.Max := APoints[i].Y;
      end;
    end;
  end;

  if Assigned(AZStats) then
  begin
    FillChar(AZStats^, SizeOf(AZStats^), 0);
    if Length(APoints) > 0 then
    begin
      AZStats.Min := APoints[0].Z;
      AZStats.Max := APoints[0].Z;
      for var i := 0 to High(APoints) do
      begin
        if APoints[i].Z < AZStats.Min then
          AZStats.Min := APoints[i].Z;
        if APoints[i].Z > AZStats.Max then
          AZStats.Max := APoints[i].Z;
      end;
    end;
  end;

  Result := TCurveDataR3.Create;
  try
    SetLength(Result.Points, Length(APoints));
    for var i := 0 to High(Result.Points) do
        Result.Points[i] := vec(APoints[i].X, APoints[i].Y, APoints[i].Z);
  except
    Result.Free;
    raise;
  end;

end;

function GetScatterDataR3cs(APoints: TArray<Double>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TScatterDataR3cs;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    const n = Length(APoints) div 5;
    if n > 0 then
    begin
      AXStats.Min := APoints[0];
      AXStats.Max := APoints[0];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[5*i] < AXStats.Min then
        AXStats.Min := APoints[5*i];
      if APoints[5*i] > AXStats.Max then
        AXStats.Max := APoints[5*i];
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    const n = Length(APoints) div 5;
    if n > 0 then
    begin
      AYStats.Min := APoints[0 + 1];
      AYStats.Max := APoints[0 + 1];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[5*i + 1] < AYStats.Min then
        AYStats.Min := APoints[5*i + 1];
      if APoints[5*i + 1] > AYStats.Max then
        AYStats.Max := APoints[5*i + 1];
    end;
  end;

  if Assigned(AZStats) then
  begin
    FillChar(AZStats^, SizeOf(AZStats^), 0);
    const n = Length(APoints) div 5;
    if n > 0 then
    begin
      AZStats.Min := APoints[0 + 2];
      AZStats.Max := APoints[0 + 2];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[5*i + 2] < AZStats.Min then
        AZStats.Min := APoints[5*i + 2];
      if APoints[5*i + 2] > AZStats.Max then
        AZStats.Max := APoints[5*i + 2];
    end;
  end;

  Result := TScatterDataR3cs.Create;
  try
    Result.Points := APoints;
  except
    Result.Free;
    raise;
  end;

end;

function GetCurveDataR3cs(APoints: TArray<Double>; AXStats: PDataRange = nil;
  AYStats: PDataRange = nil; AZStats: PDataRange = nil): TCurveDataR3c;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    const n = Length(APoints) div 4;
    if n > 0 then
    begin
      AXStats.Min := APoints[0];
      AXStats.Max := APoints[0];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[4*i] < AXStats.Min then
        AXStats.Min := APoints[4*i];
      if APoints[4*i] > AXStats.Max then
        AXStats.Max := APoints[4*i];
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    const n = Length(APoints) div 4;
    if n > 0 then
    begin
      AYStats.Min := APoints[0 + 1];
      AYStats.Max := APoints[0 + 1];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[4*i + 1] < AYStats.Min then
        AYStats.Min := APoints[4*i + 1];
      if APoints[4*i + 1] > AYStats.Max then
        AYStats.Max := APoints[4*i + 1];
    end;
  end;

  if Assigned(AZStats) then
  begin
    FillChar(AZStats^, SizeOf(AZStats^), 0);
    const n = Length(APoints) div 4;
    if n > 0 then
    begin
      AZStats.Min := APoints[0 + 2];
      AZStats.Max := APoints[0 + 2];
    end;
    for var i := 0 to n - 1 do
    begin
      if APoints[4*i + 2] < AZStats.Min then
        AZStats.Min := APoints[4*i + 2];
      if APoints[4*i + 2] > AZStats.Max then
        AZStats.Max := APoints[4*i + 2];
    end;
  end;

  Result := TCurveDataR3c.Create;
  try
    SetLength(Result.Points, Length(APoints) div 4);
    for var i := 0 to High(Result.Points) do
    begin
      Result.Points[i].r := vec(APoints[4*i + 0], APoints[4*i + 1], APoints[4*i + 2]);
      Result.Points[i].c := TColor(RBSwap(Round(APoints[4*i + 3])));;
    end;
  except
    Result.Free;
    raise;
  end;

end;

function GetRegionDataR2(ASlices: TArray<TSlice>; AUnboundedMin, AUnboundedMax: Boolean;
  AXStats: PDataRange = nil; AYStats: PDataRange = nil): TRegionDataR2;
var
  i: Integer;
begin

  if Assigned(AXStats) then
  begin
    FillChar(AXStats^, SizeOf(AXStats^), 0);
    if Length(ASlices) > 0 then
    begin
      AXStats.Min := ASlices[0].t;
      AXStats.Max := ASlices[0].t;
      for i := 0 to High(ASlices) do
      begin
        if ASlices[i].t < AXStats.Min then
          AXStats.Min := ASlices[i].t;
        if ASlices[i].t > AXStats.Max then
          AXStats.Max := ASlices[i].t;
      end;
    end;
  end;

  if Assigned(AYStats) then
  begin
    FillChar(AYStats^, SizeOf(AYStats^), 0);
    if Length(ASlices) > 0 then
    begin
      if not AUnboundedMin then
      begin
        AYStats.Min := ASlices[0].a;
        AYStats.Max := ASlices[0].a;
      end;
      if not AUnboundedMax then
      begin
        AYStats.Min := ASlices[0].b;
        AYStats.Max := ASlices[0].b;
      end;
      for i := 0 to High(ASlices) do
      begin
        if not AUnboundedMin then
        begin
          if ASlices[i].a < AYStats.Min then
            AYStats.Min := ASlices[i].a;
          if ASlices[i].a > AYStats.Max then
            AYStats.Max := ASlices[i].a;
        end;
        if not AUnboundedMax then
        begin
          if ASlices[i].b < AYStats.Min then
            AYStats.Min := ASlices[i].b;
          if ASlices[i].b > AYStats.Max then
            AYStats.Max := ASlices[i].b;
        end;
      end;
    end;
  end;

  Result := TRegionDataR2.Create;
  try
    Result.Slices := ASlices;
  except
    Result.Free;
    raise;
  end;

end;

function GetSurfaceData(APoints: TArray<TASR3>;
  const xmin, xmax: TASR; Nx: Integer; const ymin, ymax: TASR; Ny: Integer): TSurfaceData;
begin
  Result := TSurfaceData.Create;
  try
    SetLength(Result.Data, Length(APoints));
    for var i := 0 to High(Result.Data) do
      Result.Data[i] := vec(APoints[i].X, APoints[i].Y, APoints[i].Z);
    Result.Domain := TRectDom.Create(xmin, xmax, ymin, ymax);
    Result.Nx := Nx;
    Result.Ny := Ny;
  except
    Result.Free;
    raise;
  end;
end;

function GetColoredSurfaceData(APoints: TArray<TASR4>;
  const xmin, xmax: TASR; Nx: Integer; const ymin, ymax: TASR; Ny: Integer): TColoredSurfaceData;
begin
  Result := TColoredSurfaceData.Create;
  try
    SetLength(Result.Data, Length(APoints));
    for var i := 0 to High(Result.Data) do
    begin
      Result.Data[i].r := vec(APoints[i].X, APoints[i].Y, APoints[i].Z);
      Result.Data[i].c := TColor(RBSwap(Round(APoints[i].W)));
    end;
    Result.Domain := TRectDom.Create(xmin, xmax, ymin, ymax);
    Result.Nx := Nx;
    Result.Ny := Ny;
  except
    Result.Free;
    raise;
  end;
end;

function O3D(AClass: TDrawable3DClass; const AName: string; const AData: string): TObject3DData;
begin
  Result := TObject3DData.Create;
  Result.ObjectClass := AClass;
  Result.Name := AName;
  Result.Data := AData;
end;

function O3D(const AName: string): TObject3DData;
begin
  var LClass := TDrawable3DClass(nil);
  if TSolidModelClass.TryFromString(AName, LClass) then
    Result := O3D(LClass)
  else
  begin
    var LResInfo := ResLookup(AName);
    if LResInfo.ResKind = rkModel then
      Result := O3D(TObjModel, LResInfo.ResName, ASKernelDefs.LoadCompressedResString(AName))
    else
      raise EAlgosimObjectException.CreateFmt('Resource "%s" is not a 3D model.', [LResInfo.ResName]);
  end;
end;

function GetArrowDataR2(const a, v: TRealVector): TArrowDataR2;
begin
  Result := TArrowDataR2.Create;
  Result.a := TPointD.Create(a);
  Result.v := TPointD.Create(v);
end;

function GetArrowDataR3(const a, v: TRealVector): TArrowDataR3;
begin
  Result := TArrowDataR3.Create;
  Result.a := a;
  Result.v := v;
end;

{ TVisual }

constructor TVisual.Create2D(AKind: TVisualKind; AData: TObject;
  AViewSetupProc, AOwnSetupProc: TVisSetupProc2D);
begin
  Target := vt2D;
  Kind := AKind;
  Data := AData;
  ViewSetupProc2D := AViewSetupProc;
  OwnSetupProc2D := AOwnSetupProc;
end;

constructor TVisual.Create3D(AKind: TVisualKind; AData: TObject;
  AViewSetupProc, AOwnSetupProc: TVisSetupProc3D);
begin
  Target := vt3D;
  Kind := AKind;
  Data := AData;
  ViewSetupProc3D := AViewSetupProc;
  OwnSetupProc3D := AOwnSetupProc;
end;

destructor TVisual.Destroy;
begin
  FreeAndNil(Data);
  inherited;
end;

{ TDataRange }

function TDataRange.Span: Double;
begin
  Result := Max - Min;
end;

function TDataRange.SpanOrUnit: Double;
begin
  if Min < Max then
    Result := Max - Min
  else
    Result := 1;
end;

end.