1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Буквенно-цифровые ребусы, рекурсия, решение любых ребусов
Недавно снова попалась мне на глаза задачка типа "решить ТОЧКА+КРУГ=КОНУС", вместе с решением. И, как обычно, это решение вызвало у меня внутреннее отвращение.. ага, набор переменных: 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.
Если у кого-то есть вопросы/критика по коду - милости прошу.
Казалось бы - все, но есть еще один аспект этого вопроса. И про него я сейчас создам тему в разделе Свободное Общение.. )) (тема создана: Конкурс ребусов! )
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Размещаю новую версию программы, разгадывающей ребусы. Что нового:
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.
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Первый раз использовал Вашу программу (1.1) и сразу заметил невообразимое! Ввёл последовательность Ножницы+Бумага=Кусочки. В итоге мне говорится что тут 14 решений И на следующей строке выводится надпись "Задача не разрешима" Пользуюсь Borland Pascal'ем
Извиняюсь за вопрос) Повнимательней взглянул на алгоритм, я понял, что решений должно быть меньше 10.
Сообщение отредактировано: Cheburashka -
--------------------
♣♣♣ "Себя великим не считай, гордясь величьем предков, Величья не добудешь ты и золота ценою! Хоть светит на небе луна, но отраженным светом - Чужою славой не живи, не будь второй луною!!!" ♣♣♣