Решение головоломки Ж. Арсака

Выполнила ученица 11 А класса Коробова Тамара Аркадьевна

Муниципальное общеобразовательное учреждение  «Лицей №43»

Саранск, 2004

Моя работа будет посвящена решению головоломки, условие которой находится в книге Ж.Арсака «Программирование игр и головоломок».

Условие головоломки таково:

Выбрали два натуральных числа большие 1 и меньшие 100. Значение их произведения сообщили господину Р, а значение суммы - господину S (причем, ни один из них не знает какое число сообщили другому). Далее между господином Р и господином S произошел такой диалог:

Господин Р: Я не могу найти эти два числа.

Господин S: Я знаю, что Вам это и не удалось бы.

Господин Р: Ах так. Ну тогда я их знаю.

Господин S: Ну тогда и я тоже их знаю.

Этим диалогом загаданные числа «вычисляются» однозначно.

Я составила программу на языке Pascal, которая «анализирует» высказывания господина Р и господина S и поэтому, естественно, состоит из 4 частей:

1) первая «отбрасывает» пары, состоящие из простых чисел;

2) вторая «отбрасывает» из оставшихся пар такие, сумма которых может быть представлена в виде двух простых слагаемых;

3) третья - те пары чисел, произведение которых встречается у какой-нибудь другой пары чисел, которая, кстати, тоже будет отброшена;

4) четвертая - те пары чисел, сумма которых встречается у какой-нибудь другой пары чисел, которая, кстати, тоже будет отброшена.

Теперь о самой программе: для хранения информации о парах чисел я использую двумерный булевский массив b, в который на соответствующие места я буду записывать «истину», если пара чисел удовлетворяет условию задачи на данном шаге и, естественно, «ложь», если – нет. Кстати, чтобы числа i, j и j, i не считались дважды перебор идет только по половине таблицы.

Булевская процедура prost будет «истиной», если число х – простое и «ложью», если – составное.

Остальные пояснения находятся в ремарках самой программы.

const n=99;

m=(n-1)*n div 2;

var b: array[2..250,2..250] of boolean;

i,j,k,l,p,vs1,vs2,vs3,vs4,sum,s: word;

fin: boolean;

function prost(x: word): boolean; {истина, если х - простое число}

var da: boolean;

p: word;

begin

da:=true;

if x>2 then

for p:=2 to trunc(sqrt(x)) do if x=(x div p)*p then da:=false;

prost:=da;

end;

begin

{начинается первый шаг - будут отброшены те пары чисел,

у которых оба числа - простые}

writeln(' при n= ',n);

vs1:=0; {vs1 - количество решений после первого шага}

for i:=2 to n do

for j:=i to n do

begin

if prost(i) and prost(j) then b[i,j]:=false

else begin b[i,j]:=true; vs1:=vs1+1; end;

end;

writeln('vs1= ',vs1:5,' iz ',m);

s:=0; {s -количество решений, которые будут отбрасываться в дальнейшем}

{начинается второй шаг - будут отброшены те пары чисел i,j, сумма которых

может быть представлена в виде двух простых слагаемых}

for i:=2 to n do

for j:=i to n do

begin

if b[i,j] then

begin

sum:=i+j; fin:=false; k:=2;

while (not fin) and (k<=(sum div 2)) do

begin

if prost(k) and prost(sum-k) then fin:=true;

k:=k+1;

end;

if fin then begin b[i,j]:=false; s:=s+1; end;

end;

end;

vs2:=vs1-s; writeln('vs2= ',vs2:5,' iz ',m);

{начинается третий шаг - будут отброшены те пары чисел i,j, произведение

которых встречается у какой-нибудь другой пары чисел, которая, кстати,

тоже будет отброшена}

for i:=2 to n do

for j:=i to n do if b[i,j] and (i=98) and (j=99) then writeln(i:3,j:3);

for i:=2 to n do

for j:=i to n do

begin

if b[i,j] then

begin

p:=i*j; fin:=false; k:=2;

while k<=n do

begin

l:=k;

while l<=n do

begin

if b[k,l] and (p=k*l) and (i<>k) then

begin fin:=true; b[k,l]:=false; s:=s+1; end;

l:=l+1;

end;

k:=k+1;

end;

if fin then begin b[i,j]:=false; s:=s+1; end;

end;

end;

vs3:=vs1-s; writeln('vs3= ',vs3:5,' iz ',m);

{начинается четвертый шаг - будут отброшены те пары чисел i,j, сумма

которых встречается у какой-нибудь другой пары чисел, которая, кстати,

тоже будет отброшена}

for i:=2 to n do

for j:=i to n do

begin

if b[i,j] then

begin

sum:=i+j; fin:=false; k:=2;

while k<=n do

begin

l:=k;

while l<=n do

begin

if b[k,l] and (sum=k+l) and (i<>k) then

begin fin:=true; b[k,l]:=false; s:=s+1; end;

l:=l+1;

end;

k:=k+1;

end;

if fin then beg