Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Combinaions from X,Y string in massive

Tags:

delphi

Firs of all excuse me for my bad english. I'm trying to generate combinations of symbols taking them from str: TStringList (Xn, Yn) where X is the position of the char in the new word and Y is the variable for the position.
For example lets say my StringList have

str[0]: '013456789'          
str[1]: 'abcdef'
str[2]: '5421'


In this case I will expact 216 words (length(str[0]) * length(str[1]) * length(str[2])) The result will be like:

str[0][1]+ str[1][1]+ str[2][1] -> 0a5
str[0][1]+ str[1][1]+ str[2][2] -> 0a4
str[0][1]+ str[1][1]+ str[2][3] -> 0a2
str[0][1]+ str[1][1]+ str[2][4] -> 0a1

str[0][1]+ str[1][2]+ str[2][1] -> 0b5
str[0][1]+ str[1][2]+ str[2][2] -> 0b4
str[0][1]+ str[1][2]+ str[2][3] -> 0b2
str[0][1]+ str[1][2]+ str[2][4] -> 0b1

str[0][1]+ str[1][3]+ str[2][1] -> 0c5
str[0][1]+ str[1][3]+ str[2][2] -> 0c4
str[0][1]+ str[1][3]+ str[2][3] -> 0c2
str[0][1]+ str[1][3]+ str[2][4] -> 0c1

and so on untill

str[0][10]+ str[1][6]+ str[2][3] -> 9f2 
str[0][10]+ str[1][6]+ str[2][4] -> 9f1

Now I'm comfused how to make the "FOR" loops to make cicles for every possible word.

Best regards Martin

like image 628
mara21 Avatar asked Oct 02 '22 12:10

mara21


1 Answers

This can be done with recursion.

procedure Recurse(startIx,stopIx: Integer; prefix: String; const aList: TStringList);
var
  ch : Char;
begin
  if (startIx > stopIx) then begin
    WriteLn(prefix);
  end
  else
  begin
    for ch in aList[startIx] do begin
      Recurse( startIx+1,stopIx,prefix + ch,aList);
    end;
  end;
end;

Recurse(0,str.Count-1,'',str);

Recursion may seem like magic at first, but is a very effective way to solve this kind of combinatorics.

The solution to this problem is a Cartesian product.

Should you have an older Delphi version, iterate the character like this:

procedure Recurse(startIx,stopIx: Integer; prefix: String; const aList: TStringList);
var
  i : Integer;
begin
  if (startIx > stopIx) then begin
    WriteLn(prefix);
  end
  else
  begin
    for i := 1 to Length(aList[startIx]) do begin
      Recurse( startIx+1,stopIx,prefix + aList[startIx][i],aList);
    end;
  end;
end;
like image 141
LU RD Avatar answered Oct 13 '22 11:10

LU RD