(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other textfile transfer utility. It should
be read or edited using a copy of Mathematica or MathReader. If you
received this as email, use your mail application or copy/paste to save
everything from the line containing (*^ down to the line containing ^*)
into a plain text file. On some systems you may have to give the file a
name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
The line below identifies what version of Mathematica created this file,
but it can be opened using any other version as well.";
FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";
MacintoshStandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times";
fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times";
fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times";
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times";
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times";
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times";
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L3, 10, "Courier";
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L3, 10, "Courier";
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R32768, L3, 12, "Courier";
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L3, 12, "Courier";
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B32768, L3, 12, "Courier";
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier";
fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 9, "Times";
fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = leftheader, inactive, L2, 12, "Times";
fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times";
fontset = leftfooter, inactive, L2, 12, "Times";
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
paletteColors = 128; showRuler; automaticGrouping; currentKernel;
]
:[font = title; inactive; preserveAspect; rightWrapOffset = 467; startGroup]
Mathematica Pearls:
Problems and Solutions
;[s]
2:0,1;11,0;43,1;
2:1,25,18,Times,1,24,0,0,0;1,25,18,Times,3,24,0,0,0;
:[font = text; inactive; preserveAspect; rightWrapOffset = 467]
Edited by Don
Piele Volume 5, No.1
:[font = text; inactive; preserveAspect; rightWrapOffset = 467]
Starting a new volume allows one to change some old ways and try new ideas. One field that I find particularly well suited to Mathematica is probability. Recently, I have been working on notebooks for teaching probability at the introductory college level. I'd like to begin this volume with a deceptively simple problem made popular by Monty Hall.
;[s]
3:0,0;125,1;136,0;350,1;
2:2,12,9,Times,0,10,0,0,0;1,12,9,Times,2,10,0,0,0;
:[font = subsection; inactive; preserveAspect; startGroup]
Monty Hall Problem (SourceMarilyn vos Savant, Parade Magazine, Sept 9, 1990)
;[s]
3:0,0;18,2;79,1;81,1;
3:1,16,12,Times,1,14,0,0,0;1,16,12,Times,0,14,0,0,0;1,13,9,Times,0,12,0,0,0;
:[font = text; inactive; preserveAspect; endGroup]
Monty Hall was the host of the daytime T.V. show "Let's Make A Deal" that ran from 1963 to 1990. One of games he made popular was to have a contestant pick a curtain out of three possible curtains shown on stage. Behind one of the curtains was a new car, but behind the other two was a booby prizefor example a cow.
If you are allowed to only pick one door, your chances of winning the car are clearly 1/3. So to make it a bit more interesting, Monty Hall would tempt the contestant in the following way. Let's say they pick curtain number 1. Before the curtain was opened, he would reveal what was behind one of the curtains not pickedof course a curtain with a cow behind it, never the car. Let's say he shows off the cow behind curtain number 3. Now Monty Hall would allow the contestant the option of changing their mind and switching from curtain number 1 to curtain number 2.
The question is: Are they better off switching curtains or staying put?
When this problem first appeared in Parade Magazine, many readers, including mathematicians and statisticians, argured as follows: "When Monty Hall opened a door and showed you one of the cows, there are two unopened doors behind which one car and one cow are hidden. Therefore it does not matter if you change or not, since the chance of winning the car is 1/2 in both cases."
What do you think?
;[s]
3:0,0;994,1;1009,0;1369,1;
2:2,12,9,Times,0,10,0,0,0;1,12,9,Times,4,10,0,0,0;
:[font = subsection; inactive; preserveAspect; startGroup]
Solution
:[font = text; inactive; preserveAspect]
Let's begin the anaylsis by simulating this game. First pick one of the curtains at random behind which to place the car. Do this with the random variable carCurtain.
:[font = input; preserveAspect]
carCurtain:=Random[Integer,{1,3}]
:[font = text; inactive; preserveAspect]
Check it out for 20 trials.
:[font = input; preserveAspect; startGroup]
Table[carCurtain,{20}]
:[font = output; output; inactive; preserveAspect; endGroup]
{3, 1, 3, 1, 1, 1, 2, 3, 1, 2, 2, 1, 2, 1, 2, 1, 3, 3, 1, 3}
;[o]
{3, 1, 3, 1, 1, 1, 2, 3, 1, 2, 2, 1, 2, 1, 2, 1, 3, 3, 1, 3}
:[font = text; inactive; preserveAspect]
Looks OK. Now construct the prizes for a given contestant depending upon the curtain chosen.
:[font = input; preserveAspect; startGroup]
Clear[prizes]
prizes[_]="Cow";
prizes[carCurtain]="Car";
Array[prizes,3]
:[font = output; output; inactive; preserveAspect; endGroup]
{"Car", "Cow", "Cow"}
;[o]
{Car, Cow, Cow}
:[font = text; inactive; preserveAspect]
This defines one game which we make into a game function.
:[font = input; preserveAspect]
Clear[game]
game[_]:=
Module[{prizes,carCurtain},
prizes[_]:="Cow";
carCurtain:=Random[Integer,{1,3}];
prizes[carCurtain]:="Car";
Array[prizes,3]];
:[font = text; inactive; preserveAspect]
If we play the game 12 times we get the following random output:
:[font = input; preserveAspect; startGroup]
experiment=Array[game, 12];
experiment //MatrixForm
:[font = output; output; inactive; preserveAspect; endGroup]
MatrixForm[{{"Car", "Cow", "Cow"}, {"Cow", "Cow", "Car"},
{"Cow", "Car", "Cow"}, {"Cow", "Cow", "Car"},
{"Car", "Cow", "Cow"}, {"Cow", "Cow", "Car"},
{"Car", "Cow", "Cow"}, {"Car", "Cow", "Cow"},
{"Cow", "Cow", "Car"}, {"Cow", "Car", "Cow"},
{"Cow", "Cow", "Car"}, {"Cow", "Car", "Cow"}}]
;[o]
Car Cow Cow
Cow Cow Car
Cow Car Cow
Cow Cow Car
Car Cow Cow
Cow Cow Car
Car Cow Cow
Car Cow Cow
Cow Cow Car
Cow Car Cow
Cow Cow Car
Cow Car Cow
:[font = subsubsection; inactive; preserveAspect; startGroup]
Never Switch Stratgy
:[font = text; inactive; preserveAspect]
Assuming you do not switch curtains, let's compute the frequency of times
you would have won had you picked curtain 1, 2, or 3. Simply replace
each Car with a 1 and each Cow with a 0.
:[font = input; preserveAspect; startGroup]
freqWithNoSwitch =
Apply[Plus,experiment /.{"Car">1,"Cow">0}]
:[font = output; output; inactive; preserveAspect; endGroup]
{4, 3, 5}
;[o]
{4, 3, 5}
:[font = text; inactive; preserveAspect]
This yields a relative frequency for winning with each curtain of:
:[font = input; preserveAspect; startGroup]
relFreqWithNoSwitch = freqWithNoSwitch/12
:[font = output; output; inactive; preserveAspect; endGroup]
{1/3, 1/4, 5/12}
;[o]
1 1 5
{, , }
3 4 12
:[font = text; inactive; preserveAspect]
The average is exactly what we expected: 1/3.
:[font = input; preserveAspect; startGroup]
chanceWithNoSwithch =
Apply [Plus,relFreqWithNoSwitch]/3
:[font = output; output; inactive; preserveAspect; endGroup; endGroup]
1/3
;[o]
1

3
:[font = subsubsection; inactive; preserveAspect; startGroup]
Always Switch Strategy
:[font = text; inactive; preserveAspect]
What happens if we always switch? To understand the solution consider the following cases:
1) If the first pick is the curtain with the car behind it, then we will lose when we switch.
2) However, if your first pick is a curtain with a cow behind it, we will always get the car if we switch. Why? Because Monty Hall will be forced to reveal the curtain with the other cow behind it, since he will never show the car. Thus when we switch we must get the car  it's all that is left. Thus we win if we first pick the Cow ( Cow>1 ) and lose if we first pick the Car (Car>0). So now our frequency becomes:
:[font = input; preserveAspect; startGroup]
freqAlwaysSwitch =
Apply[Plus,experiment /. {"Car">0,"Cow">1}]
:[font = output; output; inactive; preserveAspect; endGroup]
{8, 9, 7}
;[o]
{8, 9, 7}
:[font = text; inactive; preserveAspect]
That's higher. And the relative frequency with a switch strategy is:
:[font = input; preserveAspect; startGroup]
relFreqAlwaysSwitch =
freqAlwaysSwitch/12
:[font = output; output; inactive; preserveAspect; endGroup]
{2/3, 3/4, 7/12}
;[o]
2 3 7
{, , }
3 4 12
:[font = text; inactive; preserveAspect]
The average gives the exact probability of 2/3.
:[font = input; preserveAspect; startGroup]
chanceAlwaysSwithch =
Apply [Plus,relFreqAlwaysSwitch]/3
:[font = output; output; inactive; preserveAspect; endGroup]
2/3
;[o]
2

3
:[font = text; inactive; preserveAspect; endGroup; endGroup]
By following the strategy of always switching, you have doubled your chances of winning the car. Not bad! This was the answer Marilyn vos Savant gave.
Her readers, however, didn't agree. Ms. vos Savant estimates she has received 10,000 letters, the great majority gloating over her apparent mistake. The most vehement criticism came from mathematicians and scientists with PhDs, who lamented the nation's innumeracy.
:[font = subsection; inactive; preserveAspect; startGroup]
Your Turn
:[font = text; inactive; preserveAspect; leftWrapOffset = 19; leftNameWrapOffset = 18]
What happens when we extend this problem to include N curtains, behind which we have placed P prizes (cars) and NP cows (one behind each curtain), and we repeat the game R times? Create a function called montyHall[N,P,R] which will simulate the game R times and compare the chances of winning a prize by following the two strategies used above: 1) never switch; or 2) always switch. We assume of course that all curtains are equally likely to hide a prize and equally likely to be chosen. First get the function working for P=1 and then expand it to the general case.
:[font = input; preserveAspect; startGroup]
montyHall[4,1,10]
:[font = print; inactive; preserveAspect; fontSize = 10; endGroup; endGroup; endGroup]
Car Cow Cow Cow
Cow Car Cow Cow
Cow Cow Car Cow
Cow Car Cow Cow
Car Cow Cow Cow
Cow Car Cow Cow
Cow Car Cow Cow
Cow Cow Car Cow
Cow Cow Cow Car
Cow Cow Car Cow
1
Never Switch: Relative Freq ={0.2, 0.4, 0.3, 0.1}, Average 
4
3
Always Switch: Relative Freq = {0.4, 0.3, 0.35, 0.45}, Average 
8
^*)