А как выписать набор вручную? Можно построить дерево вариантов, использующее связь типа Q -> QE -> QEW. Сначала выбираем элемент и наращиваем на него не использовавшийся символ, т.е. который не присутствует как в обрастающем элементе, так и на данном этапе обрастания. Т.е, берем Q, выбираем W (Q не подходит по условию). Идем дальше. Снова берем Q, W противоречит условию, остается E.
Нечто подобное:
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | var
i, j, k, l, VarLength, CurVar: integer ;
Str, Sym: string ;
Used, Current: string ;
Output: array of string ;
Again: boolean ;
begin
Str := Edit1 . Text;
Current := '' ;
CurVar := 0 ;
VarLength := 0 ;
SetLength(Output, 1 );
l := 1 ;
while (Length(Str) - VarLength) > 0 do
begin
Used := Current;
for i := 1 to (Length(Str) - VarLength) do
begin
k := 1 ;
repeat
Again := false ;
j := 1 ;
Sym := Str[k];
while (j <= Length(Used)) and (Again = false ) do
begin
if Sym = Used[j] then Again := true ;
j := j + 1 ;
end ;
k := k + 1 ;
until (Again = false ) or (k > Length(Str));
Output[Length(Output)- 1 ] := Current + Sym;
Used := Used + Sym;
ShowMessage(Output[Length(Output)- 1 ]);
SetLength(Output, Length(Output) + 1 );
end ;
Current := Output[CurVar];
CurVar := CurVar + 1 ;
VarLength := Length(Current);
l := l + 1 ;
end ;
end ;
|