Криптарифметическая задача

[PersonUnknown]

Здравствуйте, помогите с чего начать.
Работа на МАН по информатике.
Надо сделать так чтобы программа считывала первое, второе и третье слово, и находило (все или одно) решение это ввыражения.
ТРИ
+
Два
____
Пять

[PersonUnknown]

uses crt;
var t,r,i,d,v,a,p,y,b:byte; tri,dva,pytb:integer;
begin clrscr;
for t:= 1 to 9 do
for r:= 0 to 9 do
for i:= 0 to 9 do
for d:= 1 to 9 do
for v:= 0 to 9 do
for a:= 0 to 9 do
for p:= 1 to 9 do
for y:= 0 to 9 do
for b:= 0 to 9 do
begin
tri:=t*100+r*10+i;
dva:=d*100+v*10+b;
pytb:=p*1000+y*100+t*10+b;
if(tri+dva=pytb)and(t<>r)and(t<>i)and(t<>d)and(t<>v)and(t<>a)and(t<>p)and(t<>y)and(t<>b)and(r<>i)and(r<>d)and(r<>v)and(r<>a)
and(r<>p)and(r<>y)and(r<>b)and(i<>d)and(i<>v)and(i<>a)and(i<>p)and(i<>y)and(i<>b)and(d<>v)and(d<>a)and(d<>p)and(d<>y)and(d<>b)
and(v<>a)and(v<>p)and(v<>y)and(v<>b)and(a<>p)and(a<>y)and(a<>b)and(p<>y)and(p<>b)and(y<>b)
then writeln(tri,' ',dva,' ',pytb);
end;
end.

Решение этой задачи.
А надо сделать так чтобы:
Мы вписываем любое криптарифметическое уравнение,
1 буква в первую переменную, 2 буква во вторую и т.д. , она распознаёт одинаковые и ищет решение по вышезаданному алгоритму.

[Serge_Bliznykov]

вы не первый столкнулись с подобной задачей.

в общем виде эти задачи решаются ПЕРЕБОРОМ.

посмотрите вот эти темы:
Ребус!

Решение ребусов в Паскале

Ребус

[PersonUnknown]

Ну решения немного отличаются.
Я пришёл сюда чтобы спросить как в записать каждое значение в свою переменную из 1,2,3 слова.

Поможете, а?

[Serge_Bliznykov]

Поможете, а?

да легко!

Правда, не уверен, что Вы это расцените, как помощь,
ибо код получился не совсем примитивно/простой/учебный...
Зато универсальный!

За основу взята программа (c) Sazary по решению ребуса.
(только там было умножение, а не сложение).
Код я чуток доработал.
Результат в архиве.

[TinMan]

PersonUnknown, твоя идея поиска с переменными, которые сами распознаются на совпадения и т.п., в принципе правильная. Но только ты пойми, что отдельные именованные переменные так использовать не удастся. Нужно применять "занумерованные переменные", а иными словами - массив.

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

У меня тоже есть прожка на эту тему.. Длинных чисел она не понимает, зато умеет не только складывать, но и вычитать, умножать и делить (только в порядке слева направо и без скобок). И чистый Pascal. Данные вводятся в одну строчку, например:
корова + корова = стадо - бык
руки * голова = голова / ноги
sic + transit + gloria - mundi = 0
Эти примеры я взял с потолка прям шас, они вряд ли сработают - только чтоб продемонстрировать. Кстати, кроме букв (русских и латинских) там могут быть и цифры (их значения равны их значениям)).

// REBUS
// by TinMan, programmersforum.ru

const
  s: string = '';  // можно начальную строку ввести тут
  Alph: set of char= ['A'..'Z']+['А'..'Я'];
  Rus: array ['А'..'Я'] of char = 'абвгдежзийклмнопрстуфхцчшщъыьэюя';

type
  tCS= set of char;
  tBS= set of byte;

var
  d: array ['A'..'Я'] of byte;  // Lat 'A' through Rus 'Я'
  Op: char;
  a,b,x,n: longint;

procedure Next(i: integer; a,b,x: longint; Op: char; UsedC: tCS; UsedD: tBS);
  procedure Calculate(c: char);
  begin
    case Op of
      '+': a:= a+x;
      '-': a:= a-x;
      '*': a:= a*x;
      '/': a:= a div x;
    end;
    if c='=' then begin
      Op:='+';
      b:=a;
      a:=0;
    end
    else Op:=c;
    x:=0
  end;
var
  j: integer;
begin
  if i>Length(s) then begin
    Calculate(' ');
    if a=b then begin
      for j:=1 to Length(s) do if s[j] in Alph then write(d[s[j]]) else write(s[j]);
      writeln;
      Inc(n)
    end
  end
  else case s[i] of
    'A'..'Z','А'..'Я': if s[i] in UsedC then begin
      if (x>0) or (d[s[i]]>0) then Next(i+1,a,b,x*10+d[s[i]],Op,UsedC,UsedD)
    end
    else for j:=0 to 9 do if not (j in UsedD) then begin
      d[s[i]]:=j;
      Next(i,a,b,x,Op,UsedC+[s[i]],UsedD+[j])
    end;
    '0'..'9': Next(i+1,a,b,x*10+Ord(s[i])-48,Op,UsedC,UsedD);
    '+','-','*','/','=': begin
      Calculate(s[i]);
      Next(i+1,a,b,x,Op,UsedC,UsedD)
    end;
    else Next(i+1,a,b,x,Op,UsedC,UsedD)
  end
end;

var
  i,m: integer;
  Letters: set of char;

begin
  if s='' then begin
    write('Введите формулировку ребуса: ');
    readln(s)
  end
  else WriteLn('Решаем ребус: ',s);
  for i:=1 to Length(s) do begin
    s[i]:=UpCase(s[i]);
    case s[i] of
      'а'..'п': Dec(s[i],32);
      'р'..'я': Dec(s[i],80)
    end
  end;
  for i:=1 to Length(s) do
    if (s[i] in Alph) and not (s[i] in Letters) then begin
      Inc(m);
      Letters:= Letters+[s[i]]
    end;
  writeln('В выражении содержится ',m,' различных букв');
  if m<=10 then begin
    n:=0;
    Next(1,0,0,0,'+',[],[]);
    writeln('found ',n,' solutions')
  end
  else writeln('Задача неразрешима');
  readln
end.

[Serge_Bliznykov]

TinMan, как я писал Выше, решение не моё. я только чуток его модифицировал.

Но только ты пойми, что отдельные именованные переменные так использовать не удастся. Нужно применять "занумерованные переменные", а иными словами - массив.

Этого высказывания не понял..
поясните, пожалуйста.

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

да, и "дельфистости" в ней совсем ничего.. при необходимости легко заменю на чистый Паскаль...

меня тоже есть прожка на эту тему.. Длинных чисел она не понимает, зато умеет не только складывать, но и вычитать, умножать и делить (только в порядке слева направо и без скобок). И чистый Pascal.

А! Супер!
Забираю к себе в копилочку!
Спасибо!


добавлено
а алгоритм перебора у меня в примере, похоже, не все варианты находит!
проверил на банальном: два+два=сад
у Вас нашло 4 варианта, у меня код нашёл только один вариант.
так что - прошу взять на заметку: мой Rebus1_sources.rar не все варианты находит!

[TinMan]

Сообщение от Serge_Bliznykov

TinManЭтого высказывания не понял..

Это я автору темы.. Цитирую его:

1 буква в первую переменную, 2 буква во вторую и т.д. , она распознаёт одинаковые и ищет решение по вышезаданному алгоритму.

И обрати внимание на способ решения: по переменной на букву. А сложность он видит в том, чтобы одной букве в ребусе (КОРОВА - тут 3 [см. ниже] одинаковых букы, "О") поставить в соответствие одну и ту же переменную. Так вот, я пытался сказать, что это не есть сложность. Это есть принципиально неустранимое непроходимое препятствие (ежели без массивов)).

Забираю к себе в копилочку!
Спасибо!

Всегда пожалуйста

Исправление.
Конечно, не 3, а 2 одинаковых )).

[PersonUnknown]

Огромное спасибо за предоставленную помощь!
В какой среде написана программа, делфи?

[Serge_Bliznykov]

В какой среде написана программа, делфи?

мой пример - да, на Delphi.

вариант TinMan - на "чистом" Паскаль. (т.е. он будет компилироваться и работать как на TurboPascal, так и на FreePascal или Delphi).
Ну, разумеется, в консольном приложении...

Ну и ещё, вариант TinMan более корректный. Он отображает все варианты (мой лажает. почему не знаю, да и теперь лень разбираться.. Если есть более короткий работающий аналог...)