Enumerate all combinations (cartesian product, abacus, odometer)

Question

How to implement the following algorithm in Delphi (Object Pascal) in a way that:

• Each alpha numeric item will be a single object (in my case a reference to file strings).
• to be possible to enumerate (to output) each pick state/combination.
• imagine the columns of an abacus; all have the same size (according to its base). I need columns with different sizes. (in my case, sets of file strings with different sizes)

Last EDIT: Please, see Python intertools implementation.

Similar algorithms in other languages: c#, ruby, java, php

ALGORITHM

Consider the following sets and its members:

S1 = {a1, a2, a3, a4, a5}

S2 = {b1, b2, b3, b4}

S3 = {c1, c2, c3, c4, c5}

Pick the first member of each set (P = Pick States):

P1 = {a1, b1, c1}

Then, increment the first until its limit:

P2 = {a2, b1, c1} P3 = {a3, b1, c1} P4 = {a4, b1, c1} P5 = {a5, b1, c1}

Then, reset the first Set, and increment 'one' the second set;

P6 = {a1, b2, c1}

Increment the first set again... and so on... reseting the first and the second set for each 'plus one' on third set.

P7 = {a2, b2, c1}

Regarding the fundamental principle of counting or principle of multiplication, this algorithm would generate 100 pick states/combinations.

P100 = {a5, b4, c5}

Answer 1

You are counting.

Each bead is a digit and you're working in base 5 in your example, since each bead can have one of 5 positions.

To determine what position of beads corresponds to a given integer, it is enough to write that integer in the relevant base. Here's how to do in ruby, for 17:

>> 17.to_s(5).rjust(3, '0')
=> "032"

Here I left-padded to 3 beads to be clear where each is, and I'm using a convention that beads begin in position 0, not position 1.

Answer 2

I've reached a solution using recursive and conditional calls. I've created a record with this structure:

  TGridKey = record
    ID : Integer;
    Index : Integer;
    Files : TStringList;
  end;

  TTrialSet = record
    theGrid : array of TGridKey;
  end;

With this name in a TForm class.

TfRandStimuliSet = class (TForm)

    //...
    lst1: TListBox; 
    dlgOpenPic: TOpenPictureDialog;
private        
    FTrialSet: TTrialSet;
    procedure TfRandStimuliSet.SubSetsMountEngine;
    //...
end;

Set Length of the Grid Array:

  NumComp := 3;
  SetLength(FTrialSet.theGrid, NumComp);
  for I := Low(FTrialSet.theGrid) to High(FTrialSet.theGrid) do
  begin
    FTrialSet.theGrid[I].ID := I;
    FTrialSet.theGrid[I].Index:= -1;
    FTrialSet.theGrid[I].Files := TStringList.Create;
  end;

Put some strings in each 'I' grid:

if dlgOpenPic.Execute then
  begin
    if dlgOpenPic.Files.Count > 0 then
    for K := 0 to (dlgOpenPic.Files.Count - 1) do
    begin
     FTrialSet.theGrid[I].Files.Add(dlgOpenPic.Files.Strings[K]);
    end;
    dlgOpenPic.Files.Clear;
  end;

Then the procedure:

procedure TfRandStimuliSet.SubSetsMountEngine;
var ID: integer; s1 : string;
  procedure AddStmFromGrid(Grid, Stm : Integer);
  begin
    s1 := s1 + ExtractFileName(FTrialSet.theGrid[Grid].Files.Strings[Stm]) + ',';
  end;

  procedure AddTrialFromIndex; //each trial is the current index's
  var I: Integer;
  begin

    for I:= Low(FTrialSet.theGrid) to High(FTrialSet.theGrid) do
      AddStmFromGrid(I,FTrialSet.theGrid[I].Index);
    lst1.Items.Add(s1);
    s1:= '';
  end;

  procedure IndexReset(aGrid : Integer);
  var i : Integer;
  begin
    for  I := aGrid to (High(FTrialSet.theGrid)) do
      FTrialSet.theGrid[I].Index := 0
  end;

  procedure IndexInc(aGrid : Integer);
  begin
    AddTrialFromIndex; //Save
    Inc(FTrialSet.theGrid[aGrid].Index);
  end;

      function MoveGrid(var ID:integer): Boolean;   //begin from right most, the highest grid
      var IDMaxIndex, IDCurIndex, LowID, HighID: Integer;
      begin
        Result := True;
        LowID := Low(FTrialSet.theGrid);
        HighID := High(FTrialSet.theGrid);
        //Application.ProcessMessages;
        if  (ID < LowID) then 
          begin
            //ShowMessage('False');
            AddTrialFromIndex;
            Result := False;
          end
        else
          begin
            IDMaxIndex:= FTrialSet.theGrid[ID].Files.Count -1;
            IDCurIndex := FTrialSet.theGrid[ID].Index;

            if IDCurIndex = IDMaxIndex then  
              begin
                ID := ID - 1;
                Result:= MoveGrid(ID);//moveleft
                Exit;
              end;
            if   (ID < HighID)
             and (IDCurIndex < IDMaxIndex) then 
              begin
                IndexInc(ID);                 //increment/move donw
                IndexReset(ID + 1);           //reset everything on the right
                MoveGrid(HighID);             //move to the most right/next down
                Exit;
              end;
            if  (ID = (HighID))
             and (IDCurIndex < IDMaxIndex) then
              begin
                IndexInc(ID);          //increment/move down 
                MoveGrid(ID)           //next increment/move down
              end;  
          end;
      end;
begin
  ID := High(FTrialSet.theGrid);
  IndexReset(Low(FTrialSet.theGrid));  //0's for everyone
  MoveGrid(ID); //begin from the most right
end;