Помогите расшифровать ребус

[avatar76]

Помогите расшифровать ребус

Расшифровать ребус, полученный в результате замены одинаковых букв
одинаковыми цифрами. Найти также такие значения цифр, при которых сумма цифр в результате окажется наибольшей

КОТ+КОТ+КОТ+КОТ=УСЫ

Что бы получилось аналогично как в этом примере: (шлак+шлак+шлак=блок)

 CONST D=10;
  TYPE CIPFER=0..9;
  VAR A,P2,P4,PR,O,L,L1,S,FLAG: CIPFER;
      K,P1,P3,B,SLAK,BLOK: INTEGER;
BEGIN
 K:=0; FLAG:=0;
 REPEAT
  PR:=K*3 DIV D;
  FOR A:=0 TO 9 DO
   IF A<>K THEN
    BEGIN
     P1:=A*3+PR; P2:=P1 DIV D; O:=P1 MOD D;
     IF(O<>A) AND (O<>K) THEN
       FOR L:=0 TO 9 DO
        IF (L<>O) AND (L<>A) AND (L<>K) THEN
         BEGIN
          P3:=L*3+P2; P4:=P3 DIV D; L1:=P3 MOD D;
          IF L1=L THEN
           FOR S:=1 TO 3 DO
            IF (S<>L) AND (S<>A) AND (S<>O) AND (S<>K) THEN
             BEGIN
              B:=S*3+P4;
              IF(B<D)AND(B<>L)AND(B<>A)AND(B<>O)AND(B<>K) THEN
                BEGIN SLAK:=S*1000+L*100+A*D+K;
                      BLOK:=B*1000+L*100+O*D+K;
                      WRITE (SLAK:5,'*3=',BLOK:5,'  ');
                      INC(FLAG);
                      IF FLAG>3 THEN
                       BEGIN WRITELN; FLAG:=0
                       END;
                END;
             END;
     END;
    END;
    K:=K+5
 UNTIL K>5
END.

 

[Vladimir_S]

Расшифровать ребус, полученный в результате замены одинаковых букв одинаковыми цифрами. Найти также такие значения цифр, при которых сумма цифр в результате окажется наибольшей КОТ+КОТ+КОТ+КОТ=УСЫ Что бы получилось аналогично как в этом примере: (шлак+шлак+шлак=блок)

Знаете... разбираться в чужой программе ине, извините, лень, проще свою накатать, что я и сделал.
Несколько пояснений.
Поскольку вариантов расшифровки оказалось много (аж 27 штук), я поставил вывод в файл, а не на экран. Имя файла и путь, естественно, поправьте по своему усмотрению.
Булева функция St1 проверяет, что все цифры в трехзначном числе - разные.
Булева функция St2 проверяет, что в слагаемом и сумме нет одинаковых цифр.
Эти функции нужны потому, что в словах "КОТ" и "УСЫ" нет как повторяющихся букв внутри них, так и между собой.
Функция Sum считает сумму цифр в результате.

Var
 kot,usi,R:Array[1..100] of Integer;
 i,j,k,Rmax:Integer;
 f:text;

Function St1(n:Integer):boolean;
var S:String;
begin
 Str(n,S);
 St1:=(S[1]<>S[2]) and (S[1]<>S[3]) and (S[2]<>S[3]);
end;

Function St2(n,m:Integer):boolean;
var
 Sn,Sm:String;
 p,q:byte;
 b:boolean;
begin
 Str(n,Sn);
 Str(m,Sm);
 b:=true;
 for p:=1 to 3 do
  for q:=1 to 3 do
   if Sn[p]=Sm[q] then b:=false;
 St2:=b;
end;

Function Sum(n:Integer):Byte;
var
 m:Integer;
 Smm:byte;
begin
 m:=n;
 Smm:=m mod 10;
 m:=m div 10;
 Smm:=Smm+(m mod 10)+(m div 10);
 Sum:=Smm;
end;

Begin
 Assign(f,'D:\kot_usi.txt');
 Rewrite(f);
 Rmax:=0;
 j:=0;
 for i:=400 to 999 do
  if ((i mod 4)=0) then
   begin
    k:=i div 4;
    if St1(k) and St1(i) and St2(k,i) then
     begin
      j:=j+1;
      usi[j]:=i;
      kot[j]:=k;
      R[j]:=Sum(usi[j]);
      if R[j]>Rmax then Rmax:=R[j];
      writeln(f,j:2,')  ',kot[j],' + ',kot[j],' + ',kot[j],' + ',kot[j],' = ',usi[j], '   Sum = ',R[j]);
     end;
   end;
 Writeln(f);
 Writeln(f,'With maximal sum:');
 for i:=1 to j do
  if R[i]=Rmax then
   writeln(f,'     ',kot[i],' + ',kot[i],' + ',kot[i],' + ',kot[i],' = ',usi[i], '   Sum = ',R[i]);
 Close(f);
End.

 

[avatar76]

Не могли бы вы помочь, если не сложно, составить именно так как в примере, что бы получилось аналогичное решение, очень нужно