Ребус: "ТОЧКА+КРУГ=КОНУС"

06.01.2011, 19:20. **Показов** 2565. **Ответов** 7

Студворк — интернет-сервис помощи студентам

Мне нужно решить ребус ТОЧКА+КРУГ=КОНУС
Я писал его по этому примеру: http://volvo71.narod.ru/faq_fo... #set_rebus

Вот что получилось:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
program _konus; {tocka+krug=konus}
uses crt;
var t,o,c,k,a,r,u,g,n,s:0..9;
    dig: set of 0..9;
    konus,sum:longint;
begin
 clrscr;
 for t:=0 to 9 do begin
  include(dig,t);
  for o:=0 to 9 do if not (o in dig) then begin
   include(dig,o);
   for c:=0 to 9 do if not (c in dig) then begin
   include(dig,c);
    for k:=0 to 9 do if not (k in dig) then begin
    include(dig,k);
     for a:=0 to 9 do if not (a in dig) then begin
     include(dig,a);
      for r:=0 to 9 do if not (r in dig) then begin
      include(dig,r);
       for u:=0 to 9 do if not (u in dig) then begin
       include(dig,u);
        for g:=0 to 9 do if not (g in dig) then begin
        include(dig,g);
         for n:=0 to 9 do if not (n in dig) then begin
         include(dig,n);
          for s:=0 to 9 do if not (s in dig) then begin
          include(dig,s);
          sum:=t*10000+(o+k)*1000+(c+r)*100+(k+u)*10+(a+g);
          konus:=k*10000+o*1000+n*100+u*10+s;
          if sum=konus then
          writeln(t,o,c,k,a,'+',k,r,u,g,'=',k,o,n,u,s);
          exclude(dig,s);
          end;
         exclude(dig,n);
         end;
        exclude(dig,g);
        end;
       exclude(dig,u);
       end;
      exclude(dig,r);
      end;
     exclude(dig,a);
     end;
    exclude(dig,k)
    end;
   exclude(dig,c);
   end;
  exclude(dig,o);
  end;
 exclude(dig,t);
 end;
end.

Паскаль ругается ошибкой 215 в 28-й строке

Помогите пожалуйста найти все возможные ошибки. Заранее спасибо

@Puporev · 06.01.2011, 21:29

Очень неудачное решение, оно и в оригинале не работает.

Добавлено через 51 секунду

Паскаль ругается ошибкой 215 в 28-й строке

У меня ничем не ругается, просто зависает программа...

@use · 07.01.2011, 10:15

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

Очень неудачное решение, оно и в оригинале не работает.

Да, я согласен, это уродство. Чем-то оно мне напомнило арифмометр - наверное, для механических счетных машин могло писаться что-то подобное..

Но оно у меня с успехом отработало таки, плюнуло списком равенств (привожу только конец):

84296+9735=94031
84395+9617=94012
84397+9615=94012
84593+9617=94210
84597+9613=94210
84693+9517=94210
84695+9317=94012
84697+9315=94012
84697+9513=94210
84795+9236=94031
84796+9235=94031
85394+9627=95021
85394+9726=95120
85396+9724=95120
85397+9624=95021
85493+9627=95120
85497+9623=95120
85693+9427=95120
85694+9327=95021
85697+9324=95021
85697+9423=95120
85794+9326=95120
85796+9324=95120

Но использовать такое на практике я бы все же не рекомендовал.. Писать такое на Паскале - это как заворачивать селедку в полотно Ренуара. Старик Блез заслуживает чего-то большего. Я попробую накарябать ченть на эту темку, гляньте сюда через пару часиков (если кому интересно)..

@Puporev · 07.01.2011, 10:58

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

Но оно у меня с успехом отработало таки, плюнуло списком равенств (привожу только конец):

Видимо у меня компьютер слабоват для этого, так и не дождался этого "плевка"...

Добавлено через 40 минут
Чисто арифметически видно что k=9,t=8, потому и считает долго что все ответы в конце.

@use · 07.01.2011, 16:41

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

Чисто арифметически видно что k=9,t=8, потому и считает долго что все ответы в конце

Да, действительно, ответы ближе к концу.

Короче, как обычно: человек предполагает, а Господь располагает.. Отвлекли меня от этого дела так неслабо, но все же дорвался я до клавы )). Код есть!

Правда, работает он намнооооого медленнее того, с которого пошла вся заварушка, но дело же не в этом. Дело - оно в КРАСОТЕ! которая, как известно, есть страшная сила )). Ну а точнее - мой код совершенно развязан с условием (никаких переменных по буквам в ребусе)), то есть можно задать любой ребус простой строкой. Можно использовать несколько действий (но пока только + и - ) в обеих сторонах равенства (досконально не проверял) - но, конечно, чтоб число использованных букв не превышало 10. Например:
МАМА+МИЛА=МЫЛИ-РАМЫ+МОЛОКОМ
- и, если повезет, он решится )).

Предупреждаю (типа disclaimer)) : код совсем сырой, ошибки могут быть. Работает действительно медленно. На моем Phenom II X4 965, DDR3-1600 тот пример занял чуть ли не полсекунды (правда, при всех включенных проверках). Расчет прекращается по нахождении первого решения. Оптимизация (ускорение) возможна (в основном, за счет облегчения стека и чисткой ручками).

Код писался под FreePascal 2.4.2, на всяких ТР пробуйте сами, если есть желание )). За найденные ошибки буду признателен.

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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: 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;
    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
      writeln('solved');
      for j:=1 to Length(s) do if s[j] in Alph then write(d[s[j]]) else write(s[j]);
      readln;
      halt
    end
  end
  else case s[i] of
    'A'..'Z','А'..'Я': if s[i] in UsedC then begin
      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;
 
begin
  Next(1,0,0,0,'+',[],[]);
  writeln('no solutions found');
  readln
end.

Уфф!..

Только ногами не бейте.. ))

@Puporev · 07.01.2011, 17:01

Вообще-то вроде в этих ребусах первая значащая цифра обычно по условию не равна 0, хотя и сильно не спорю.
Проверил на ребусе МУХА+МУХА+МУХА=СЛОН, идиотский конечно, но первый ответ
0543+0543+0543=1629, без первых нолей
1089+1089+1089=3267

@use · 08.01.2011, 06:17

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

Вообще-то вроде в этих ребусах первая значащая цифра обычно по условию не равна 0, хотя и сильно не спорю

Согласен, это пришло мне в голову, но поздно )). Потом поправлю.

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

Проверил на ребусе МУХА+МУХА+МУХА=СЛОН, идиотский конечно, но первый ответ
0543+0543+0543=1629, без первых нолей
1089+1089+1089=3267

Wow!! Оч.симпотно! А скажи, какой из них не идиотский?

Только не надо предлагать Шекспира потрошить на эти штуки.. ))

Добавлено через 12 часов 56 минут
Всем привет, спасибо за спасибо )).
Доработал прожку:
1. теперь первая буква слова не может быть нулем;
2. выводятся все возможные комбинации, а также их общее число;
3. добавлены умножение, *, и деление, /;
4. убрана разница между строчными и прописными буквами (можно вводить в любом регистре);
5. строка ребуса запрашивается с клавиатуры (если она пустая в коде).

По поводу п.3.. Деление работает как div (то есть остаток отбрасывается). Приоритет операций НЕ СОБЛЮДАЕТСЯ (все считается слева направо)! Вообще, я в сомениях, насколько ценны в данной ситуации эти две операции.. Надеюсь, кто-то их развеет блестяще-остроумным ребусом!!

А потому..

предлагаю устроить КОНКУРС РЕБУСОВ!!

Все выдумывают, кто во что горазд, прогоняют через эту прогу - удачные кладут сюда! Другие высказывают свое мнение (например, оценивают по 5-бальной системе). По истечении некоторого срока (типа месяца) выявляем победителя. При этом должно влиять также количество решений (чем меньше, тем лучше). Призы.. ну, можно подумать )).

Я заранее извиняюсь перед админами и модераторами, если лезу не в свой огород.. Мне кажется, идея забавная - может быть толк!

Поднятие активности и т.п. )) Если я не прав - снимаю все притязания. Если, наоборот, сочтете полезным - поддержите, вносите свои изменения (только не нужно слишком заорганизовывать)! Если просто не будет ответов на это мое предложение - ну, что ж, видимо я что-то не учел..

Лично у меня дело с выдумыванием ребусов идет туговаааато.. Самое забавное (well, судите сами)) вот такое:
АДМИН+МОДЕР=ФОРУМ
- сие перлО имеет 24 решения )).

Привожу доработанный код:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
// REBUS Ver.1.0
// by use
// cyberforum.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.

Приглашаю всех к участию в доработке кода. Также буду рад новым идеям )).
Всем желаю успеха!

PS
ну, надо же иногда оторваться от подсчета нечетных элементов между максимумом и минимумом.. ))

@M_A_X · 15.05.2012, 17:42

Всем привет! Мне дали задание решить ребус точка + круг = конус по этому примеру (муха+муха=слон), помогите пожалуйста:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
program rebus;
type
mn=set of 0..9;
var
n1,n2,n: integer;
m,y,x,a:0..9;
a1,a2,a3,a4:0..9;
s1,s2:mn;
procedure print(x,y: integer);
begin
writeln(x:5);
writeln('+');
writeln(x:5);
writeln('______');
writeln(y:5);
end;
 
begin
n:=0;
s1:=[];
s2:=[];
 
for m:=1 to 4 do
begin
s1:=s1+[m];
for y:=0 to 9 do
if not (y in s1) then
 
begin
s1:=s1+[y];
for x:=0 to 9 do
if not (x in s1) then
 
begin
s1:=s1+[x];
for a:=1 to 9 do
if not (a in s1) then
 
begin
s1:=s1+[a];
 
n1:=1000*m+100*y+10*x+a;
n2:=2*n1;
a1:=n2 div 1000;
a2:=n2 div 100 mod 10;
a3:=n2 div 10 mod 10;
a4:=n2 mod 10;
s2:=[a1,a2,a3,a4];
if (s1*s2=[]) and ([a1]*[a2]*[a3]*[a4]=[])
then
begin
n:=n+1;
print(n1,n2);
end;
s1:=s1-[a];
end;
s1:=s1-[x];
end;
s1:=s1-[y];
end;
s1:=s1-[m];
end;
writeln('n=',n);
end.

Новые блоги и статьи Все статьи Все блоги /
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .
Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	07.01.2011, 17:01
	Вообще-то вроде в этих ребусах первая значащая цифра обычно по условию не равна 0, хотя и сильно не спорю. Проверил на ребусе МУХА+МУХА+МУХА=СЛОН, идиотский конечно, но первый ответ 0543+0543+0543=1629, без первых нолей 1089+1089+1089=3267 0