unit U_KnowDontKnow2;
{Copyright © 2002, 2007, Gary Darby, www.DelphiForFun.org
This program may be used or modified for any non-commercial purpose
so long as this original notice remains in place.
All other rights are reserved
}
{Two integers, A and B, each between 2 and 100 inclusive, have been chosen.
The product, AB, is given to mathematician Dr. P. The sum, A+B, is given to
mathematician Dr. S. They each know the range of numbers. Their
conversation is as follows:
P: "I don't have the foggiest idea what your sum is, S."
S: "That's no news to me, P. I already knew that you didn't know. I don't know either."
P: "Aha, NOW I know what your sum must be, S!"
S: "And likewise P, I have figured out your product!!"
What are the numbers?
References:
http://mathforum.org/library/drmath/view/55655.html
http://www.mathematik.uni-bielefeld.de/%7Esillke/PUZZLES/logic_sum_product
}
{Version 2.0 - allows a max other than 100 to be specified. Multiple solutions
exist for higher max values unless additional constraints are added}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, shellAPI;
type
TForm1 = class(TForm)
ListBox1: TListBox;
SearchBtn: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
IntroMemo: TMemo;
TabSheet2: TTabSheet;
Memo2: TMemo;
TabSheet3: TTabSheet;
ListBox2: TListBox;
ListBox3: TListBox;
Label1: TLabel;
Label2: TLabel;
MaxNum: TEdit;
MaxNumUD: TUpDown;
Label3: TLabel;
StaticText1: TStaticText;
Label4: TLabel;
procedure SearchBtnClick(Sender: TObject);
procedure MaxNumChange(Sender: TObject);
procedure StaticText1Click(Sender: TObject);
end;
var Form1: TForm1;
implementation
{$R *.DFM}
uses u_primes;
const
lownum=2;
highnum:integer=100;
maxhighnum=1000;
Type
tsumrec=record
count,A,B:integer;
end;
{************ SearchBtnClick *************}
procedure TForm1.SearchBtnClick(Sender: TObject);
var
TestA,TestB,aa,bb,i:integer;
sum,prod,factor:integer;
fcount:integer;
OK:boolean;
SumList1:array[lownum+lownum..maxhighnum+maxhighnum] of boolean;
SumList2:array[lownum+lownum..maxhighnum+maxhighnum] of TsumRec;
begin
listbox1.clear; listbox2.clear; listbox3.clear;
screen.cursor:=crhourglass;
for i:= lownum+lownum to maxhighnum+maxhighnum do
begin
SumList1[i]:=false;
SumList2[i].count:=0;
end;
{Filter all possible solution pairs based on given range}
for TestA:= lownum to highnum do for TestB:=TestA to highnum do
{no need to check both orders of A & B, so we'll keep TestB >= TestA}
begin
sum:=TestA+TestB;
prod:=TestA*TestB;
{Observation 1: product can't be product of 2 primes, otherwise Dr. P would know the numbers}
primes.getfactors(prod);
if primes.nbrfactors<>2 then {Filter from observation 1}
with primes do
begin
{Observation 2: Cannot be the cube of a prime otherwise there would only be one
choice for the two numbers and Dr. P would have figured that out.}
if (nbrfactors=3) and (factors[1]=factors[3])
then break; {Filter from observation 2}
{Observation 3: Must not be able to form A+B as the sum of two primes,
otherwise Dr. S could not have been sure in advance that
Dr. P did not know the numbers.}
{Filter from Observation 3}
ok:=true;
for i:=lownum to sum div lownum do
begin
If (isprime(i)) and (isprime(sum-i)) then
begin
ok:=false;
break;
end;
end;
{Action #1 Make a list of candidate sums}
If OK then {This A,B pair passed all filters so save the info in SumList1}
begin {We'll index the list by sum to simplify checking}
If not sumlist1[sum] then
begin
listbox2.items.add(inttostr(sum)); {show allowable sums}
listbox2.update;
end;
SumList1[sum]:=true;
end;
end;
end;
{For every possible A and B in the range}
for TestA:= lownum to highnum-1 do for TestB:=TestA to highnum do
begin
sum:=TestA+TestB;
If SumList1[Sum] then {it is not the product of 2 primes or the cube of a prime}
begin
{Observation 4: Since Dr. P says that he knows the numbers, there
must be only one factorization of his product into two numbers whose
sum is in the SumList1 candidate list (which he was smart enough to
figure out once Dr. S told him that he did not know the numbers either.}
prod:=TestA*TestB;
fcount:=0;
aa:=0; bb:=0;
{now check every pair of integers that could produce Dr P's product and
see if the sum of these two is in Sumlist1 only one time}
for i:=lownum to trunc(sqrt(prod)) do {check sum of factorizations}
begin
factor:=prod div i;
sum:=i+factor;
if (sum<=highnum) and (i*factor=prod) and (SumList1[sum])
then
begin
inc(fcount);
{just in case this is a solution}
aa:=i;
bb:=factor;
end;
{Might as well speed things up a little, once count of factorizations
exceeds one, it's not unique and cannot be the solution}
if fcount>1 then break;
end;
{Action 2: Make a second list of solution sum records containing A,B and
a count of how many possible solutions have this sum}
if fcount =1 then
with SumList2[aa+bb] do
begin
{Count occurrences of Dr. P choices and save the A,B values in case it is
a unique solution}
inc(count);
A:=aa;
B:=bb;
end;
end;
end;
{Display SumList2}
for i:= low(Sumlist2) to high(sumlist2) do
with sumlist2[i] do
if count>0 then
begin
listbox3.items.add('Sum:'+inttostr(i)+', A:'+inttostr(a)
+', B:'+inttostr(B)+', Count:'+inttostr(count));
listbox3.update;
end;
{Action 3: The sums that pass the previous tests had better only occur one
time, otherwise Dr. S could not say that he knows the number also}
//for i:=low(Sumlist2) to high(sumlist2)do
{For debugging, index value in "For" loop may not reflect current expected
value. Above stement replaced by "While" loop and manually incrementing
the index}
i:=low(sumlist2);
while i<=high(sumlist2) do
with SumList2[i] do
begin
if count=1
then listbox1.items.add(
format('A=%3d, B=%3d, Sum=%3d, Product=%3d',
[a,b,a+b,a*b]));
inc(i);
end;
screen.cursor:=crdefault;
end;
{******** MaxNumChange **********}
procedure TForm1.MaxNumChange(Sender: TObject);
begin
highnum:=maxnumUD.position
end;
procedure TForm1.StaticText1Click(Sender: TObject);
begin
ShellExecute(Handle, 'open', 'http://www.delphiforfun.org/',
nil, nil, SW_SHOWNORMAL) ;
end;
end.