Delphi 7. Циклы. Задача

[Юрий2009]

Замените буквы цифрами так, чтобы соотношение оказалось верным (одинаковым буквам, соответствуют одинаковые цифры, разным - разные): ХРУСТ * ГРОХОТ = РРРРРРРРРРР. Заранее СПАСИБО!!!!!

[fbus]

что-то я ничего не понял

ХРУСТ * ГРОХОТ = РРРРРРРРРРР

откройте тайну где тут цифры?

[Тёма(C@$pEr)]

Эт наверно какие они в алфавите стоят по счету таким и соответствуют цифрам да?

[Stilet]

Врядли... тут перебором нужно делать...

[KORN]

так не забывайте, что мы экстрасенсы...

[DeKot]

А если через коды символов? ( правда будет не замена на цифры, а на числа).Перевести слова в символы (Char), через Ord(C) в коды ANSII и уже работать с чисдами.

[Stilet]

DeKot

Тогда скорее всего не будет выполняться условие задания: "одинаковым буквам, соответствуют одинаковые цифры, разным - разные" Ибо цифры более 9 в таком случае (я так думаю) допускаться не должны...
Хотя, автору виднее..

[Anatole]

Задача на логику. Сначала необходимо сделать вручную, а затем програмироваить иначе не узнаешь алгоритма. Простым перебороом вариантов возможно, но не элегантно, хотя...?

[DeKot]

Тогда скорее всего не будет выполняться условие задания: "одинаковым буквам, соответствуют одинаковые цифры, разным - разные"

наоборот - у каждого символа буквы свой код, причем с учетом регистра.А в поставленном вопросе изначально ошибка - букв в алфавите 33, а цифр всего 10.

[Sazary]

Собственно, это обычный числовой ребус. Каждой букве соответствует цифра.
Только приведенный ребус, похоже, неверный.
Написал прогу. Все решает, а этот не может.

unit Rebus1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
dlin = array[1..100] of integer; // длинное число
bukvy = array[1..100] of char;   // массив имеющихся букв
numbukvy = array[1..100] of integer; // соответствующие буквам цифры
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
  function rec(tek : integer) : boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var
mas : bukvy;
masN : integer;
nummas : numbukvy;
s1,s2,s3 : string;

// обнуление длинного числа
procedure dlinObnul(var a : dlin);
var i : integer;
begin
for i:=1 to 100 do
 a[i] := 0;
end;
//----------

// функция умножения длинных чисел
procedure umn(chislo1 : dlin; len1 : integer; chislo2 : dlin; len2 : integer; var chislo3 : dlin; var len3 : integer);
var
i,j : integer;
a,b : dlin;
ak,bk : integer;
ost,gr : integer;
begin
if len1>len2 then
 begin
 a := chislo1;
 b := chislo2;
 ak := len1;
 bk := len2;
 end
else
 begin
 a := chislo2;
 b := chislo1;
 ak := len2;
 bk := len1;
 end;
//----
dlinObnul(chislo3);
len3 := 0;
for i:=1 to bk do
 begin
 gr := i;
 ost := 0;
 for j:=1 to ak do
  begin
  chislo3[gr] := chislo3[gr] + b[j]*a[i] + ost;
  if chislo3[gr] > 9 then
   begin
   ost := chislo3[gr] div 10;
   chislo3[gr] := chislo3[gr] mod 10;
   end; //if
  inc(gr);
  if gr>len3 then len3 := gr;
  end; //for j

 dec(len3);
 while ost>0 do
  begin
  inc(len3);
  chislo3[len3] := ost mod 10;
  ost := ost div 10;
  end;

 end; //for i

end;
//--------------------------------------------------------------

// процедура для помещения в массив имеющихся букв
procedure StringToBukvy(var a : bukvy; var n : integer);
var i,j : integer;
b : boolean;
begin
n := 0;
for i:=1 to length(s1) do
 begin
 b := true;
 for j:=1 to n do
  if s1[i]=a[j] then b:=false;
 if b then
  begin
  inc(n);
  a[n] := s1[i];
  end;
 end;
for i:=1 to length(s2) do
 begin
 b := true;
 for j:=1 to n do
  if s2[i]=a[j] then b:=false;
 if b then
  begin
  inc(n);
  a[n] := s2[i];
  end;
 end;
for i:=1 to length(s3) do
 begin
 b := true;
 for j:=1 to n do
  if s3[i]=a[j] then b:=false;
 if b then
  begin
  inc(n);
  a[n] := s3[i];
  end;
 end;
//----
end;
//---------------------

function TForm1.rec(tek : integer) : boolean;
var i,j : integer;
a,b,c : dlin;
ak,bk,ck : integer;
rez : string;
fl : boolean;

begin
if tek = masN+1 then
 begin
 ak := 0;
 bk := 0;

 for i:=length(s1) downto 1 do
  begin
  for j:=1 to masN do
   if s1[i] = mas[j] then
    begin
    inc(ak);
    a[ak] := nummas[j];
    break;
    end;
  end;
 for i:=length(s2) downto 1 do
  begin
  for j:=1 to masN do
   if s2[i] = mas[j] then
    begin
    inc(bk);
    b[bk] := nummas[j];
    break;
    end;
  end;
 //--
 umn(a,ak,b,bk,c,ck);

 rez := '';
 for i:=ck downto 1 do
  begin
  for j:=1 to masN+1 do
   begin
   if j=masN+1 then
    begin
    Result := false;
    exit;
    end;
   if c[i]=nummas[j] then
    begin
    rez := rez + mas[j];
    break;
    end;
   end;
  end;
  //----
 // Memo1.Lines.Add(rez);
  //----
 if rez = s3 then
  begin
 // ShowMessage(IntTOSTr(ck)+'  '+s3+'  '+rez);
//  for i:=ck downto 1 do
 //  ShowMessage(IntTOSTr(c[i]));
  Result := true;
  exit;
  end;
 Result := false;
 exit;
 end;
 //-------------

for i:=0 to 9 do
 begin
 fl := true;
 for j:=1 to tek-1 do
  if nummas[j]=i then fl := false;
 if not fl then continue;
 nummas[tek] := i;
 if rec(tek+1) = true then
  begin
  Result := true;
  exit;
  end;
 end;


Result := false;
end;

//-------------------------

Продолжение следует...