Home > Mathematica, Mathematics > Mr P and Mr S

Mr P and Mr S

Mathematica Stackexchange is an excellent resource. I have been learning a lot looking at the questions and answers. I have also learned how swiftly poor questions are filtered out: having sadly earned a NARQ (not a real question) assessment while trying to understand “self-triggering” in dynamic vaisualization.  My question was poor, non-specific and motivates me to look further.

One of the questions brings up the following puzzle:

We pick two numbers a and b, such that a≥b and both numbers are within the range (2,99). We give Mr.P the product ab and give Mr.S the sum a+b. Then following dialog takes place:
Mr.P: I don’t know the numbers 
Mr.S: I knew you didn’t know. I don’t know either.
Mr.P: Now I know the numbers
Mr.S: Now I know them too
Can we find the numbers a and b?

This is an interesting puzzle and reminiscent of another puzzle:

Two mathematicians are sitting for lunch.
Mr. A: how old are your three sons?
Mr. B: the product of their ages is 36 and the sum of their ages is the same as the number of windows in that building over there.
Mr. A looked perplexed.
Mr. B: the eldest has red
hair

This last problem can be solved relatively quickly by noting that there is only one case where the sum of three factors of 36 is not unique: 13 =2+2+9=1+6+6. Allowing for semantic arguments about one twin always being older than another, the answer is: 2,2,9.

The Mr P and Mr S puzzle has a unique solution but has more cases to examine (though these can be reduced with thought: see here for solution).

Here is my commented attempt:

(* table of possible pairs and their sum and product *)
all=Join @@ Table[{i, j, i + j, i j}, {i, 2, 99}, {j, 2, i}];
(* function to select unique products/sums *)
s[u_, j_] := Join @@ Select[GatherBy[u, #[[j]] &], Length[#] == 1 &];
(* Possibilities Mr. P would not know *)
pu=Complement[all, s[all, 4]];
(* Possibilities Mr. S would not know *)
su=Complement[all, s[all, 3]];
(* Possibilities Mr. P and Mr S. would not know *)
ju=Intersection[pu,su];
(* Sums without unique entries *)
com = Complement[all[[All, 3]], s[all, 4][[All, 3]]];
(* Mr P knows: selects from subset of intersection. Mr S. knows: selects from this *)
(* i.e. nested selection *)
s[s[Select[ju, MemberQ[com, #[[3]]] &], 4], 3]
(* yields {{13, 4, 17, 52}} *)

Uncommented code:

all= Join @@ Table[{i, j, i + j, i j}, {i, 2, 99}, {j, 2, i}];
s[u_, j_] := Join @@ Select[GatherBy[u, #[[j]] &], Length[#] == 1 &];
pu = Complement[all, s[all, 4]];
su = Complement[all, s[all, 3]];
ju = Intersection[su, pu];
com = Complement[all[[All, 3]], s[all, 4][[All, 3]]];
s[s[Select[ju, MemberQ[com, #[[3]]] &], 4], 3]

The timing: {0.125, {{13, 4, 17, 52}}}

Advertisements
Categories: Mathematica, Mathematics
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: