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.