0
\$\begingroup\$

The following implements a mix of hard-code (manual pick and choose) and abstracted solution for creating and placing some squares on screen using different matrix patterns for positioning. Each position is just an "easy" name for each matrix cell. Before giving names, first you need to choose the size of your main matrix, lets say 3 x 3:

{
  3x3
  0..1..2
  3..4..5
  6..7..8
}

As I am positioning squares on screen, I need some conversion functions for dealing with Top, Left (that are feed to TCell of matrices) and manual pick up positions. For example, for a 3 x 3 matrix you have:

function IntToCell(AN: Integer) : TCell;
begin
  case AN of
    0 : Result := [0, 0];
    1 : Result := [0, 1];
    2 : Result := [0, 2];
    3 : Result := [1, 0];
    4 : Result := [1, 1];
    5 : Result := [1, 2];
    6 : Result := [2, 0];
    7 : Result := [2, 1];
    8 : Result := [2, 2];
  end;
end;
 
function TGrid.RectFromPosition(APosition: integer): TRect;
var
  j, i: Integer;
begin
  for j := Low(FGrid) to High(FGrid) do begin
    for i := Low(FGrid[j]) to High(FGrid[j]) do begin
      with FGrid[j][i] do begin
        if Index = APosition then begin
          Result := Classes.Rect(Rect.x, Rect.y, Rect.x+Rect.w, Rect.y+Rect.h);
        end;
      end;
    end;
  end;
end;

function TGrid.PositionFromObject(AObject: TObject): integer;
var
  i: Integer;
  Cell: TCell;
begin
  Result := -1;
  for i := 0 to 8 do
  begin
    Cell := IntToCell(i);
    if FGrid[Cell[0], Cell[1]].Item = AObject then begin
      Result:= i;
      Exit;
    end;
  end;
end;

Also, you need to choose a positioning pattern (TGridStyle), for example, a circular distribution, a squared one centralized, and and squared one distributed along the horizontal axis:

  TGridStyle =
    (gtCircle, gtSquare, gtDistributed);

For simplicity, let's choose gtSquare. Then, you need to decide if yout gtSquare pattern will have an orientation (TGridOrientation) or not:

  TGridOrientation =
    (goNone, goLeftToRight, goRightToLeft, goTopToBottom, goBottomToTop);

If not goNone, you are done. You have enough abstraction to create matrices of arbitrary sizes, give names to each cell, and pick up positions by name, and so on.

However, if you choose to have some other orientation (goLeftToRight, goRightToLeft, goTopToBottom, goBottomToTop) stuff gets a little bit more complicated.

First, I created two sets of positions, Samples and Comparisons in my ontology (you can think Source and Destination too) and I am assuming that different positions are reserved for each set, they can not overlap. So, now you can imagine a vector starting at a sample position and ending at a comparison position.

Now, how to decide which cells are on the left? How to define names for them to chose automagically when randomization is supposed to be applied? I am really not sure. For 3 x 3 (and odd higher ones), you have just one cell at the center, one row at the top, one at the left, and so one. So, for now, I decided to do it manually. I am invalidating a list when new positions are needed (TGrid.InvalidateGridList), and retuning manually added positions from them:

function TGrid.InvalidateGridList(IsSample: Boolean): TGridList;
var
  i : integer;
begin
  Result:= TGridList.Create;
  {
    3x3
    0..1..2
    3..4..5
    6..7..8
  }
  case FGridOrientation of
      goNone: begin
        for i := 0 to FCellsCount - 1 do Result.Add(i);
      end;
      goLeftToRight: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(3);
          end else begin
            Result.Add(0);
            Result.Add(3);
            Result.Add(6);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(5);
          end else begin
            Result.Add(2);
            Result.Add(5);
            Result.Add(8);
          end;
        end;
      end;
      goRightToLeft: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(5);
          end else begin
            Result.Add(2);
            Result.Add(5);
            Result.Add(8);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(3);
          end else begin
            Result.Add(0);
            Result.Add(3);
            Result.Add(6);
          end;
        end;
      end;
      goBottomToTop: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(7);
          end else begin
            Result.Add(6);
            Result.Add(7);
            Result.Add(8);
          end;
        end else begin
          if FixedComparison then begin
            Result.Add(1);
          end else begin
            Result.Add(0);
            Result.Add(1);
            Result.Add(2);
          end;
        end;
      end;
      goTopToBottom: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(1);
          end else begin
            Result.Add(0);
            Result.Add(1);
            Result.Add(2);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(7);
          end else begin
            Result.Add(6);
            Result.Add(7);
            Result.Add(8);
          end;
        end;
      end;
    end;
end;

2x2 it is too tiny, and I wasn't ever bothered about it. But, 4x4, and higher, I didn't dare to do it manually:

{
  4x4
  0...1...2...3
  4...5...6...7
  8...9..10..11
 12..13..14..15
}

{
  5x5
  0...1...2...3...4
  5...6...7...8...9
 10..11..12..13..14
 15..16..17..18..19
 20..21..22..23..24
}

So, would be great if you reviwed this code for:

  • Clarity;
  • More abstraction and automation;
  • Does this problem have a name in mathematics?

Here is the full unit, just for reference:

unit sdl.app.grids;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, fgl, SDL2, Math.LatinSquares;

type
  TGridStyle =
    (gtCircle, gtSquare, gtDistributed);

  TGridOrientation =
    (goNone, goLeftToRight, goRightToLeft, goTopToBottom, goBottomToTop);

  TCell = array [0..1] of Integer;

  TGridList = specialize TFPGList<Integer>;
  TGridItem = record
    Index : integer;
    Rect : TSDL_Rect;
    Item : TObject;
  end;

  TGridItems = array of TGridItem;
  TMatrix = array of array of TGridItem;

  TRandomPositions = record
    Samples: TGridItems;
    SamplesRows : TLatinSquare;
    Comparisons : TGridItems;
    ComparisonsRows : TLatinSquare;
  end;

  { TGrid }
  TGrid = class
    private
      FFixedComparison: Boolean;
      FFixedSample: Boolean;
      FSeed : integer;
      FCellsCount: integer;
      FCellsSize: real;
      FComparisonsCount: integer;
      FGrid : TMatrix;
      FGridStyle : TGridStyle;
      FGridOrientation : TGridOrientation;
      FRandomPositions : TRandomPositions;
      FSamplesCount: integer;
      procedure SetCellsCount(AValue: integer);
      procedure SetCellsSize(AValue: real);
      procedure SetFixedComparison(AValue: Boolean);
      procedure SetFixedSample(AValue: Boolean);
      procedure SetGridOrientation(AValue: TGridOrientation);
      procedure SetGridStyle(AGridStyle: TGridStyle);
      procedure RandomizeGridList(AGridList: TGridList);
      function InvalidateGridList(IsSample: Boolean=true): TGridList;
      function DispersionStyle : Boolean;
      procedure CreatePositions;
    public
      constructor Create(ASeed : integer);
      destructor Destroy; override;
      property GridStyle : TGridStyle read FGridStyle write SetGridStyle;
      property CellsCount : integer read FCellsCount write SetCellsCount;
      property CellsSize : real read FCellsSize write SetCellsSize;
      property FixedSample : Boolean read FFixedSample write SetFixedSample;
      property FixedComparison : Boolean read FFixedComparison write SetFixedComparison;
      property RandomPositions : TRandomPositions read FRandomPositions;
      property Seed : integer read FSeed write FSeed;
      property Orientation: TGridOrientation read FGridOrientation write SetGridOrientation;
      procedure UpdatePositions(ASamples, AComparisons: integer;
        AGridOrientation : TGridOrientation);
      {Cria seleção randômica de modelos e comparações em posições diferentes no AGrid}
      procedure RandomizePositions;
      function GetRandomGridOrientation : TGridOrientation;
      function RectFromPosition(APosition: integer) : TRect;
      function PositionFromObject(AObject: TObject) : integer;
  end;

var
  ScreenInCentimeters : real = 39.624;
  Grid : TGrid = nil;
  BorderTop    : TRect;
  BorderBottom : TRect;
  BorderLeft   : TRect;
  BorderRight  : TRect;

implementation

uses Math, sdl.app, sdl.app.grids.methods;

var
  MonitorWidth : integer;
  MonitorHeight: integer;
{
  GetPositionFromSegment returns Left or Top position based on:
    ASegment = Width or Height from which get the Left or Top position.
    ASteps = Desired number os columns or rows.
    AStep = Target column or row.
    AStimulusSide = Width or height of the target stimulus.
    AInterStimulusSpace = Desired horizontal or vertical space from one stimulus to another.
}
function GetPositionFromSegment(ASegment, AStep, ASteps,
  AStimulusSide, AInterStimulusSpace : integer):integer;
var
  LSize : integer;
begin
  LSize := AStimulusSide + AInterStimulusSpace;
  Result := Round((LSize*AStep)-((LSize*ASteps)/2)+((ASegment+AInterStimulusSpace)/2));
end;

function CmToScreenPixels(AMeasure : real) : integer;
begin
  Result := Round(AMeasure*(MonitorWidth/ScreenInCentimeters));
end;

procedure SetBorders(ASize: integer);
begin
  BorderTop := Rect(
    0,
    0,
    MonitorWidth,
    ASize);
  BorderBottom := Rect(
    0,
    BorderTop.Height + MonitorHeight-(ASize*2),
    MonitorWidth,
    MonitorHeight);
  BorderLeft := Rect(
    0,
    0,
    ASize,
    MonitorHeight);
  BorderRight := Rect(
    BorderLeft.Width + MonitorWidth-(ASize*2),
    0,
    MonitorWidth,
    MonitorHeight);
end;

{Cria grade quadrada como uma matriz AN x AN. Quando ADistribute = true, a
distância horizontal e vertical entre os estímulos é diferente, e quando false
é igual}
function GetCentralGrid(AN: integer; ASquareSide: real;
  ADistribute: Boolean): TMatrix;
var
  LIndex      : integer = 0;
  //LSegment    : integer = 0;
  //LSteps      : integer = 0;
  //LStep       : integer = 0;
  LSquareSide : integer = 0;
  LInterSpaceW : integer = 0;
  LInterSpaceH : integer = 0;
  j : integer = 0;
  i : integer = 0;
begin
  Result := Default(TMatrix);
  SetLength(Result, AN, AN);
  LSquareSide := CmToScreenPixels(ASquareSide);
  if ADistribute then begin
    LInterSpaceW := (MonitorWidth -  (LSquareSide * AN)) div AN;
    LInterSpaceH := (MonitorHeight - (LSquareSide * AN)) div AN;
  end else begin
    if MonitorWidth > MonitorHeight then begin
      LInterSpaceH := (MonitorHeight - (LSquareSide * AN)) div AN;
      LInterSpaceW := LInterSpaceH;
    end else begin
      LInterSpaceW := (MonitorWidth -  (LSquareSide * AN)) div AN;
      LInterSpaceH := LInterSpaceW;
    end;
  end;
  for j := Low(Result) to High(Result) do begin
    for i := Low(Result[j]) to High(Result[j]) do begin
      with Result[j][i] do begin
        Index := LIndex;
        Rect.y := GetPositionFromSegment(
          MonitorHeight, j, AN, LSquareSide, LInterSpaceH);
        Rect.x := GetPositionFromSegment(
          MonitorWidth, i, AN, LSquareSide, LInterSpaceW);
        Rect.w := LSquareSide;
        Rect.h := LSquareSide;
      end;
      Inc(LIndex);
    end;
  end;
  SetBorders(Result[0][0].Rect.y);
end;

{Cria grade circular considerando j como modelo central e i como comparações em
torno de um diâmetro. AN = número de estímulos i; ASquareSide = lado do quadrado
dos estímulos}
function GetCircularCentralGrid(AN: integer; ASquareSide: real): TMatrix;
var
  LIndex      : integer = 0;
  //LSegment    : integer = 0;
  //LSteps      : integer = 0;
  //LStep       : integer = 0;
  LSquareSide : integer = 0;
  LDegree : integer = 0;
  LDegreeI : integer = 0;
  LPoint : TPoint;
  LRect  : TRect;
  j : integer = 0;
  i : integer = 0;
const
  BaseDegree : integer = 360;
begin
  Result := Default(TMatrix);
  SetLength(Result, 2);
  SetLength(Result[0], AN);
  SetLength(Result[1], 1);
  LSquareSide := CmToScreenPixels(ASquareSide);
  SetBorders(LSquareSide div 2);
  LDegree := BaseDegree;
  LDegreeI := BaseDegree div AN;
  LRect := GetCentralRect(MonitorWidth, MonitorHeight, LSquareSide div 2);
  for j := Low(Result) to High(Result) do begin
    for i := Low(Result[j]) to High(Result[j]) do begin
      with Result[j][i] do begin
        case j of
          0:  begin
            Index := LIndex;
            LPoint := GetPointFromAngle(LDegree, LRect);
            Rect.y := LPoint.Y - (LSquareSide div 2);
            Rect.x := LPoint.X - (LSquareSide div 2);
            Rect.w := LSquareSide;
            Rect.h := LSquareSide;
            Inc(LDegree, LDegreeI);
          end;

          1: begin
            Index := LIndex;
            Rect.y  := (MonitorHeight div 2) - (LSquareSide div 2);
            Rect.x := (MonitorWidth div 2) - (LSquareSide div 2);
            Rect.w := LSquareSide;
            Rect.h := LSquareSide;
          end;
        end;
      end;
      Inc(LIndex);
    end;
  end;
end;


{
  3x3
  0..1..2
  3..4..5
  6..7..8
}
function IntToCell(AN: Integer) : TCell;
begin
  case AN of
    0 : Result := [0, 0];
    1 : Result := [0, 1];
    2 : Result := [0, 2];
    3 : Result := [1, 0];
    4 : Result := [1, 1];
    5 : Result := [1, 2];
    6 : Result := [2, 0];
    7 : Result := [2, 1];
    8 : Result := [2, 2];
  end;
end;

{ TGrid }

procedure TGrid.SetGridStyle(AGridStyle: TGridStyle);
begin
  if FGridStyle = AGridStyle then Exit;
  FGridStyle := AGridStyle;
  case AGridStyle of
    gtCircle : FGrid := GetCircularCentralGrid(FSeed, FCellsSize);
    gtSquare : FGrid := GetCentralGrid(FSeed, FCellsSize, DispersionStyle);
    gtDistributed: FGrid := GetCentralGrid(FSeed, FCellsSize, DispersionStyle);
  end;
end;

procedure TGrid.RandomizeGridList(AGridList: TGridList);
var
  i : integer;
begin
  for i := AGridList.Count - 1 downto 0 do
    AGridList.Exchange(i, RandomRange(0, i + 1));
end;

function TGrid.InvalidateGridList(IsSample: Boolean): TGridList;
var
  i : integer;
begin
  Result:= TGridList.Create;
  {
    3x3
    0..1..2
    3..4..5
    6..7..8
  }
  case FGridOrientation of
      goNone: begin
        for i := 0 to FCellsCount - 1 do Result.Add(i);
      end;
      goLeftToRight: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(3);
          end else begin
            Result.Add(0);
            Result.Add(3);
            Result.Add(6);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(5);
          end else begin
            Result.Add(2);
            Result.Add(5);
            Result.Add(8);
          end;
        end;
      end;
      goRightToLeft: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(5);
          end else begin
            Result.Add(2);
            Result.Add(5);
            Result.Add(8);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(3);
          end else begin
            Result.Add(0);
            Result.Add(3);
            Result.Add(6);
          end;
        end;
      end;
      goBottomToTop: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(7);
          end else begin
            Result.Add(6);
            Result.Add(7);
            Result.Add(8);
          end;
        end else begin
          if FixedComparison then begin
            Result.Add(1);
          end else begin
            Result.Add(0);
            Result.Add(1);
            Result.Add(2);
          end;
        end;
      end;
      goTopToBottom: begin
        if IsSample then begin
          if FFixedSample then begin
            Result.Add(1);
          end else begin
            Result.Add(0);
            Result.Add(1);
            Result.Add(2);
          end;
        end else begin
          if FFixedComparison then begin
            Result.Add(7);
          end else begin
            Result.Add(6);
            Result.Add(7);
            Result.Add(8);
          end;
        end;
      end;
    end;
end;

function TGrid.DispersionStyle: Boolean;
begin
  case FGridStyle of
    gtCircle : Result := False; // it is ignored
    gtSquare : Result := False;
    gtDistributed : Result := True;
  end;
end;

procedure TGrid.CreatePositions;
var
  i : integer;
  LGridList : TGridList;
begin
  with FRandomPositions do begin
    SetLength(Samples, FSamplesCount);
    SetLength(Comparisons, FComparisonsCount);

    for i := low(Samples) to high(Samples) do
        Samples[i].Index := -1;
    for i := low(Comparisons) to high(Comparisons) do
        Comparisons[i].Index := -1;
    case FGridOrientation of
        goNone: begin
          // do nothing for now
        end;
        else begin
          LGridList := InvalidateGridList(True);
          SamplesRows := TLatinSquare.Create(FSeed);
          for i := 0 to LGridList.Count-1 do
            SamplesRows.Signs[i] := LGridList[i];
          SamplesRows.Invalidate;
          LGridList.Free;

          LGridList := InvalidateGridList(False);
          ComparisonsRows := TLatinSquare.Create(FSeed);
          for i := 0 to LGridList.Count-1 do
            ComparisonsRows.Signs[i] := LGridList[i];
          ComparisonsRows.Invalidate;
          LGridList.Free;
        end;
    end;
  end;
end;

procedure TGrid.RandomizePositions;
var
  Cell : TCell;
  LGridList : TGridList;

  {Change positions only}
  procedure SecureCopy(var A: TGridItem; B : TGridItem);
  begin
    A.Index := B.Index;
    A.Rect  := B.Rect;
    // A.Item := B.Item; // do not override Item Pointer
  end;

  procedure RandomizeGridItems(var AGridItems : TGridItems);
  var
    i: Integer;
  begin
    for i := Low(AGridItems) to High(AGridItems) do
    begin
      Cell := IntToCell(LGridList.First);
      SecureCopy(AGridItems[i], FGrid[Cell[0], Cell[1]]);
      LGridList.Delete(0);
    end;
  end;

procedure LatinRowToGridItems(ALatinSquare: TLatinSquare;
  var AGridItems : TGridItems);
var
 LLatinRow : TLatinRow;
 i : integer;
begin
  LLatinRow := ALatinSquare.NextRow;
  LGridList := TGridList.Create;
  for i in LLatinRow do LGridList.Add(i);
  //RandomizeGridList(LGridList);
  RandomizeGridItems(AGridItems);
  LGridList.Free;
end;

begin
  with FRandomPositions do begin
    case FGridOrientation of
      goNone: begin
        LGridList:= InvalidateGridList;
        RandomizeGridList(LGridList);
        RandomizeGridItems(Samples);
        RandomizeGridItems(Comparisons);
        LGridList.Free;
      end;
      else begin
        if FFixedSample then begin
          LGridList := InvalidateGridList(True);
          Cell := IntToCell(LGridList.First);
          SecureCopy(Samples[Low(Samples)], FGrid[Cell[0], Cell[1]]);
        end else begin
          LatinRowToGridItems(SamplesRows, Samples);
        end;
        if FFixedComparison then begin
          LGridList := InvalidateGridList(False);
          Cell := IntToCell(LGridList.First);
          SecureCopy(Comparisons[Low(Comparisons)], FGrid[Cell[0], Cell[1]]);
        end else begin
          LatinRowToGridItems(ComparisonsRows, Comparisons);
        end;
      end;
    end;
  end;
end;

function TGrid.RectFromPosition(APosition: integer): TRect;
var
  j, i: Integer;
begin
  for j := Low(FGrid) to High(FGrid) do begin
    for i := Low(FGrid[j]) to High(FGrid[j]) do begin
      with FGrid[j][i] do begin
        if Index = APosition then begin
          Result := Classes.Rect(Rect.x, Rect.y, Rect.x+Rect.w, Rect.y+Rect.h);
        end;
      end;
    end;
  end;
end;

function TGrid.PositionFromObject(AObject: TObject): integer;
var
  i: Integer;
  Cell: TCell;
begin
  Result := -1;
  for i := 0 to 8 do
  begin
    Cell := IntToCell(i);
    if FGrid[Cell[0], Cell[1]].Item = AObject then begin
      Result:= i;
      Exit;
    end;
  end;
end;

procedure TGrid.SetCellsCount(AValue: integer);
begin
  if FCellsCount=AValue then Exit;
  FCellsCount:=AValue;
end;

procedure TGrid.SetCellsSize(AValue: real);
begin
  if FCellsSize=AValue then Exit;
  FCellsSize:=AValue;
end;

procedure TGrid.SetFixedComparison(AValue: Boolean);
begin
  if FFixedComparison=AValue then Exit;
  FFixedComparison:=AValue;
end;

procedure TGrid.SetFixedSample(AValue: Boolean);
begin
  if FFixedSample=AValue then Exit;
  FFixedSample:=AValue;
end;

procedure TGrid.SetGridOrientation(AValue: TGridOrientation);
begin
  if FGridOrientation=AValue then Exit;
  FGridOrientation:=AValue;
end;

function TGrid.GetRandomGridOrientation : TGridOrientation;
var
  i: integer;
begin
  i:= RandomRange(1, 5);
  Result := TGridOrientation(i);
end;

constructor TGrid.Create(ASeed: integer);
var
  LRect : TSDL_Rect;
begin
  LRect := SDLApp.Monitor;
  MonitorWidth := LRect.w;
  MonitorHeight:= LRect.h;
  FSeed := ASeed;
  FSamplesCount := -1;
  FComparisonsCount := -1;
  FCellsCount:=ASeed*ASeed;
  FCellsSize := 6;
  FFixedSample := True;
  FFixedComparison:=False;
  FGridStyle := gtDistributed;
  FGridOrientation:= goTopToBottom;
  FGrid := GetCentralGrid(FSeed, FCellsSize, DispersionStyle);
end;

destructor TGrid.Destroy;
begin
  with FRandomPositions do
  begin
    SamplesRows.Free;
    ComparisonsRows.Free;
  end;
end;

procedure TGrid.UpdatePositions(ASamples, AComparisons : integer;
  AGridOrientation : TGridOrientation);
begin
  if (FSamplesCount <> ASamples) or
     (FComparisonsCount <> AComparisons) or
     (FGridOrientation <> AGridOrientation) then begin
    FSamplesCount := ASamples;
    FComparisonsCount := AComparisons;
    FGridOrientation := AGridOrientation;
    CreatePositions;
  end;
  RandomizePositions;
end;

end.

```
Improve this question
\$\endgroup\$

0

Reset to default

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Browse other questions tagged or ask your own question.