(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other text-file 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 = "NeXT Mathematica Notebook Front End Version 2.2";
NeXTStandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e8, 24, "Times"; ;
fontset = subtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, L1, e6, 18, "Times"; ;
fontset = subsubtitle, inactive, noPageBreakBelow, noPageBreakInGroup, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, L1, e6, 14, "Times"; ;
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, L1, a20, 18, "Times"; ;
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, L1, a15, 14, "Times"; ;
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L1, a12, 12, "Times"; ;
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ;
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-4, 12, "Courier"; ;
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-4, 12, "Courier"; ;
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R32768, L-4, 12, "Courier"; ;
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-4, 12, "Courier"; ;
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B32768, L-4, 12, "Courier"; ;
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, L1, 12, "Courier"; ;
fontset = name, inactive, noPageBreakInGroup, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, B65535, L1, 10, "Times"; ;
fontset = header, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = leftheader, inactive, 12;
fontset = footer, inactive, nohscroll, noKeepOnOnePage, preserveAspect, center, M7, L1, 12;
fontset = leftfooter, inactive, 12;
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 10, "Times"; ;
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, L1, 12;
paletteColors = 128; showRuler; automaticGrouping; currentKernel;
]
:[font = title; inactive; preserveAspect; rightWrapOffset = 467; startGroup]
Mathematica Pearls:
Problems and Solutions
;[s]
2:0,0;11,1;43,-1;
2:1,22,17,Times,3,24,0,0,0;1,21,16,Times,1,24,0,0,0;
:[font = subsubtitle; inactive; preserveAspect]
Studying permutations with Mathematica
:[font = text; inactive; preserveAspect; rightWrapOffset = 467]
Edited by Don Piele
:[font = text; inactive; preserveAspect; rightWrapOffset = 467]
:[font = text; inactive; preserveAspect]
Complete permutations (sometimes called derangements) are permutations
that leave no number fixed. For example, (3,1,2} and {2,3,1} are the only
complete permutations in the set of six permutations of {1,2,3}.
Thus if three people check their hats and the
hats are somehow scrambled, the probability that none of the three get
their own hat back is 2/6 or 1/3. It is a surprising result, that as the
number of hats grows, the probability that no one gets their own hat back
approaches 1/E (See Introduction to Probability Theory with Computing, by
J. Laurie Snell, Prentice Hall, 1975.) Thus the number of complete
permutations is closely approximated by n!/E.
Snell also shows that the number of complete permutations (cp) can be
computed recursively as :
:[font = input; preserveAspect]
cp[1]=0;
cp[2]=1;
cp[n_]:= cp[n]= (n-1) cp[n-1] + (n-1) cp[n-2]
;[s]
1:0,0;64,-1;
1:1,10,8,Times,1,12,0,0,0;
:[font = text; inactive; preserveAspect]
Snell argues: " Assume we want to find the number of ways n people can
have hats none of which are their own. Assume one person, say Ann,
arrives withher own hat, and all the the other n-1 people have different hats.
Then Ann can change her hat with any one of the n-1 people, and then eveyone
will not have have their own hat. There are cp(n-1) ways that the n-1
people can have different hats, and Ann has n-1 people she can exchange
with. Thus there are (n-1) cp[n-1] ways this can be done. However, there
are other possibilities. One of the group of n-1 people could have their
own hat, and the remaining n-2 have all different hats. Thus Ann need
only exchange hats with the person who has their own hat and everyone
will now have different hats. This can occur in (n-1) cp[n-2] ways. There
is no duplication in these two ways that Ann can give up her hat, since
if we undo the process, in one case we end up with only 1 person having
their own hat and in the other case 2. These are the only two ways that
Ann can give up her hat; hence the recursion relationship is proved."
:[font = text; inactive; preserveAspect]
Comparing this exact result to Round[ n!/E], we have total agreement for
all n.
:[font = input; preserveAspect; startGroup]
Table[{cp[i],Round[N[i!/E]]},{i,1,12}]//MatrixForm
:[font = output; output; inactive; preserveAspect; endGroup]
MatrixForm[{{0, 0}, {1, 1}, {2, 2}, {9, 9}, {44, 44}, {265, 265},
{1854, 1854}, {14833, 14833}, {133496, 133496}, {1334961, 1334961},
{14684570, 14684570}, {176214841, 176214841}}]
;[o]
0 0
1 1
2 2
9 9
44 44
265 265
1854 1854
14833 14833
133496 133496
1334961 1334961
14684570 14684570
176214841 176214841
:[font = text; inactive; preserveAspect]
Other problems can also be looked at with the aid of complete permutations.
:[font = subsection; inactive; preserveAspect; startGroup]
Menage II (Source: Problems and Snapshots from the World of
Probability, Gunnar Blom, Springer-Verlag 1991)
;[s]
2:0,0;10,1;163,-1;
2:1,12,9,Times,1,14,0,0,0;1,11,8,Times,0,12,0,0,0;
:[font = text; inactive; preserveAspect]
At a dinner for 4n people (all husband and wife pairs) , the host assigns
at random 4 people to sit at each of the n tables, with the restriction
that each table should have two men and two women.This is done by
allowing the women to be seated first, two to a table, and randomly
placing the men in the empty seats. Find the probability that none of the
married couples is sitting at the same table.
:[font = text; inactive; preserveAspect; endGroup]
One way to model this problem is to number the tables from 1 to n, and if
a women is placed at table i then make out a slip for her husband with
her table number on it. Thus the men will all end up with slips numbered
{ 1, 1, 2, 2, 3, 3, .... n, n}. If a husband with slip 1 sits at table 1
he will be sitting with his wife. Any complete permutation of the slip
numbers will result in a seating where no husband sits with his own wife.
:[font = subsection; inactive; preserveAspect; startGroup]
Your Turn
:[font = text; inactive; preserveAspect; leftWrapOffset = 37; leftNameWrapOffset = 18]
a) Generate the complete permutations of {1,1,2,2,3,3,....,n,n} for as
large an n
as possible.
b) Is there a way of counting the complete permutations of
{1,1,2,2,3,3,...n,n}
without generating them?
c) The number of different ways of seating the men is (2n)!/ (2 ^n). Thus
the probability that none end up sitting with his own wife is:
number of complete permutations of {1,1,2,2,3,3,4,4,....n,n}
p[n] =
----------------------------------------------------------------------------
(2n)!/ (2 ^n)
Evaluate p[n] for a few values of n.
d) Does the Limit[p[n], n-> Infinity] exist?
:[font = subsubsection; inactive; preserveAspect; startGroup]
SUBMITTING PROBLEMS AND SOLUTIONS
:[font = text; inactive; preserveAspect; endGroup]
The preferred way to submit problems or solutions is via email. They may also be submitted on paper or on a disk through the regular mail. When you submit your work, include a brief English description of your solution or use comments in your program to help the reader follow your ideas. Of course, you should include your name, institution, category (high school, college undergraduate, other) and mail or email address.
:[font = subsubsection; inactive; preserveAspect; startGroup]
CONTACTING THE EDITOR
:[font = text; inactive; preserveAspect; endGroup]
Donald T. Peile
Mathematics Department
University of Wisconsin-Parkside
900 Wood Road
Kenosha, WI 53141
peile@cs.uwp.edu
fax: 414-595-2056
:[font = subsubsection; inactive; preserveAspect; startGroup]
ELECTRONIC SUBSCRIPTIONS
:[font = text; inactive; preserveAspect; endGroup; endGroup; endGroup]
Included in the distribution for each electronic subscription is the file Perm.ma containing Mathematica code for the material described in this article.
;[s]
5:0,0;74,1;82,2;93,3;104,4;154,-1;
5:1,11,8,Times,0,12,0,0,0;1,10,8,Courier,0,12,0,0,0;1,11,8,Times,0,12,0,0,0;1,10,8,Times,2,12,0,0,0;1,11,8,Times,0,12,0,0,0;
^*)