Буквенно-цифровые ребусы, рекурсия, решение любых ребусов Опции

[Lapp]

Недавно снова попалась мне на глаза задачка типа "решить ТОЧКА+КРУГ=КОНУС", вместе с решением. И, как обычно, это решение вызвало у меня внутреннее отвращение.. ага, набор переменных: t,o,c,k,a, r,u,g,.. Тоска, короче )). Программирование для арифмометра. Я думаю, вы уже поняли, что я сделал.. А потом я подумал - чего добру пропадать? забацаю-ко я темку.. Но, как человек, претендующий на корректность по отношению к другим, я сначала запустил поиск по "ребус*" на нашем Форуме..

Моему вниманию открылся список тем, многие из которых были вполне по предмету. Идя по ним, я все больше утверждался в мнении, что, по крайней мере, тут подобный подход не применялся - пока, наконец, не наткнулся на это сообщение:
помогите решить ребус!

Sir volvo снова меня опередил! Но - что интересно! - на этот пост нет ни одного ответа ((. И, более того, после этого все снова и снова предлагались "решения" по типу "тоска", описанному выше.. Я, конечно, не упустил своей (не такой уж редкой, впрочем)) возможности поставить +1 автору, но хочу спросить его: volvo, почему ты даже не упомянул там ГЛАВНОГО?? Ведь главное, ессно, не то, что циклы заменены на рекурсию!! А то, что этот код годится для решения ЛЮБЫХ ребусов вида a+b=c! Достаточно просто заменить входные строки.. ))

Итак, ближе к делу.. Признавая первенство volvo, я все же публикую свой код (причем в новой теме, которую предполагаю в дальнейшем двинуть в FAQ). Этот код имеет некоторые преимущества (которые, я уверен, volvo мог бы легко добавить при желании), а именно: допустимы несколько знаков операций (как слева, так и справа от знака = ), в том числе +, -, *, / (без приоритетов). Ну и по мелочам, типа русские буквы..

Вот, собсно, код (писался под FP):

REBUS v.1.0 (Показать/Скрыть)

// REBUS Ver.1.0
// by Lapp
// forum.pascal.net.ru

const
  s: string = '';
  Alph: set of char= ['A'..'Z']+['А'..'Я'];
 
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;
    '+','-','*','/','=': 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: integer;
 
begin
  if s='' then begin
    write('Введите формулировку ребуса: ');
    readln(s)
  end;
  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;
  n:=0;
  Next(1,0,0,0,'+',[],[]);
  writeln('found ',n,' solutions');
  readln
end.

Если у кого-то есть вопросы/критика по коду - милости прошу.

Казалось бы - все, но есть еще один аспект этого вопроса. И про него я сейчас создам тему в разделе Свободное Общение.. ))
(тема создана: Конкурс ребусов! )