found Вот [more=Здесь]Program numbers;
Uses Crt;
{Будем хранить числа в массивах цифр}
Const
N1 = 5; {длина массива для первого числа}
N2 = 6; {для второго}
N3 = N1 + N2; {для результата}
Var
Num1 : Array [1..N1] Of ShortInt; {hrust}
Num2 : Array [1..N2] Of ShortInt; {grohot}
Resul : Array [1..N3] Of ShortInt; {result}
i : Integer;
{Процедура заполнения третьего массива заданным числом}
Procedure FillResul(x : Integer);
Var i : Integer;
Begin
For i:=1 To N3 Do
Resul[i] := x;
End;
{Задача очевидно на перебор. Благодаря тому, что заданы буквенные эквиваленты
цифр, количество возможных вариантов существенно ограничивается, то есть, если
первое слово "хруст", значит в нем все цифры разные. Функция Add2Num1 вставляет
число x в элемент ndx массива Num1, только если такой цифры еще нет в этом массиве.
Если такая цифра уже была, то возвращается false. Так же эта функция по возможности
заполняет элементы второго массива (когда в нем тоже присутсвует соотв. цифра).}
Function Add2Num1(ndx : Integer; x : Integer) : Boolean;
Var isNewNum : Boolean;
i : integer;
Begin
isNewNum := True;
For i:=1 to N1 Do isNewNum := isNewNum and (x <> Num1[i]);
If isNewNum Then Begin
Num1[ndx] := x;
If ndx=1 Then {мы узнали Х}
Num2[4] := x
Else
If ndx=2 Then Begin {мы узнали Р}
Num2[2] := x;
FillResul(x);
End
Else
If ndx=5 Then {мы узнали Т}
Num2[6] := x;
End;
Add2Num1 := isNewNum;
End;
{
Эта функция производит умножение столбиком полученных чисел.
Промежуточные строки для следующего суммирования находятся в двумерном
массиве SummArr. Для удобства он нумерется справа налево:
h r u s t
*
g r o h o t
SummArr:
1110 9 8 7 6 5 4 3 2 r
1110 9 8 7 6 5 4 3 2
1110 9 8 7 6 5 4 3
1110 9 8 7 6 5 4
1110 9 8 7 6 5
1110 9 8 7 6
Если полученный результат умножения совпадает с глобальным массивом Resul,
то возвращается True. Массив Resul должен автоматически заполнятся во время
перебора при получении очередного значения Т в процедуре Pick.
}
Function Match : Boolean;
Var SummArr : Array [1..N2, 1..N3] Of ShortInt;
Res : Array [1..N3] Of ShortInt;
Ext : Integer;
b : Boolean;
i, j : Integer;
Begin
For i:=1 To N2 Do
For j:=1 To N3 Do SummArr[i][j] := 0;
For i:=1 To N3 Do Res[i] := 0;
{Выполняем перемножение каждой цифры второго числа на первое, заполняя массив
SummArr}
Ext := 0;
For i:=N2 downto 1 Do Begin
For j:=N1 downto 1 Do Begin
SummArr[N2-i+1][N1-j+1+N2-i] := (Num2[i]*Num1[j] + Ext) mod 10;
Ext := (Num2[i]*Num1[j] + Ext) div 10;
End;
SummArr[N2-i+1][N1+N2-i+1] := Ext;
Ext := 0;
End;
{Выполняем сложение в массиве SummArr}
Ext := 0;
For j:=1 To N3 Do Begin
For i:=1 To N2 Do Inc(Ext, SummArr[i][j]);
Res[N3-j+1] := Ext mod 10;
Ext := Ext div 10;
End;
{Проверяем совпадение}
B := True;
For i:=1 To N3 Do
B := B And (Res[i]=Resul[i]);
Match := B;
End;
{Наша задача подобрать все возможные комбинации цифр для последовательности
ХРУСТГО (остальные цифры в массивах повторяются). Этим занимается
рекурсивная функция Pick. Она подбирает очередное значение очередной цифре и
переходит к следующей. На самом нижнем уровне сформированные массивы
проверяются функцией Match.}
Procedure Pick(x: Integer);
Var i : Integer;
Begin
If x=N1+1 Then
For Num2[1]:=0 To 9 Do Pick(x+1) {подобрали значение для Г}
Else
If x=N1+2 Then
For Num2[3]:=0 To 9 Do Begin {подбираем значение для О}
Num2[5] := Num2[3];
Pick(x+1);
End
Else
If x<=N1 Then Begin {подбираем значение для букв ХРУСТ}
For i:=0 To 9 Do Begin
If Not Add2Num1(x, i) Then continue; {попытка вставить уже существующую цифру}
If (x=N1) and (i=0) Then continue; {Т не может равнятся нулю}
If x=N1 Then FillResul(i*i mod 10); {Заполняем массив результата}
Pick(x+1);
End;
End
Else
If Match Then Begin
For i:=1 To N1 Do Write(Num1[i]); Writeln;
For i:=1 To N2 Do Write(Num2[i]); Writeln;
For i:=1 To N3 Do Write(Resul[i]); Writeln;
End;
End;
Begin
ClrScr;
{Заполняем массивы значением -1 для правильной работы
функции Add2Num1 }
For i:=1 To N1 Do Num1[i]:=-1;
For i:=1 To N2 Do Num2[i]:=-1;
Pick(1);
Writeln('Done');
ReadKey;
End.[/more] Код.
Вообще по большему счету, это тоже самое, что у
ShIvADeSt, только решение более универсальное, так как числа хранятся в массивах цифр - их величина ограничивается не емкостью целочисленных типов, а возможной максимальной длинной массива типа ShortInt. А так же перебор сделан не кучей вложенных циклов, а рекурсивной функцией.
Вообще я ее дописывал "на коленке" и конечный вариант не запускал - паскаля под рукой нету. Так что может там чего не заработает