Недавно снова попалась мне на глаза задачка типа "решить ТОЧКА+КРУГ=КОНУС", вместе с решением. И, как обычно, это решение вызвало у меня внутреннее отвращение.. ага, набор переменных: 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.
Если у кого-то есть вопросы/критика по коду - милости прошу.
Казалось бы - все, но есть еще один аспект этого вопроса. И про него я сейчас создам тему в разделе Свободное Общение.. )) (тема создана: Конкурс ребусов! )
Lapp
12.01.2011 13:59
Размещаю новую версию программы, разгадывающей ребусы. Что нового:
1. Интерфейс. Теперь в начале выдается информация о том, сколько присутствует различных букв. Мне кажется, это полезно (так как надо следить, чтоб их число не превзошло 10).
2. Теперь можно использовать и цифры! Цифры, конечно, просто имеют свои значения. Например, ребус: a*3-5=7 - имеет одно решение: 4*3-5=7 (помним, что решением называется ВСЯ строка). В связи с этим интересная особенность: ребус, составленный из одних только цифр (без букв) может служить для проверки верности соотношения. И это совсем нелишне, потому что не каждый калькулятор сделает вам вычисления БЕЗ учета приоритетов операций!
3. Исправлена небольшая ошибка (умножение и деление фактически не работали, извиняюсь..) - отсутствовали символы * и / в операторе CASE (исправления уже внесены в предыдущий пост, так что тот код тоже верен теперь).
Итак, прошу любить и жаловать:
REBUS v.1.1(Показать/Скрыть)
// REBUS // v.1.1 // by Lapp // forum.pascal.net.ru
const s: string = //'abc+cde-2f=g*h' + // уберите первые "//", чтобы отлаживаться на этой строке ''; 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.
Cheburashka
19.01.2011 17:37
Первый раз использовал Вашу программу (1.1) и сразу заметил невообразимое! Ввёл последовательность Ножницы+Бумага=Кусочки. В итоге мне говорится что тут 14 решений И на следующей строке выводится надпись "Задача не разрешима" Пользуюсь Borland Pascal'ем
Извиняюсь за вопрос) Повнимательней взглянул на алгоритм, я понял, что решений должно быть меньше 10.
volvo
19.01.2011 17:46
Цитата
В итоге мне говорится что тут 14 решений
Не 14 решений, а 14 разных букв... Именно поэтому задача и неразрешима.
Только если в 16-ричной СС решать ребусы
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.