Re: Programming Probability of puzzle in Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg44952] Re: Programming Probability of puzzle in Mathematica
- From: drbob at bigfoot.com (Bobby R. Treat)
- Date: Wed, 10 Dec 2003 04:02:06 -0500 (EST)
- References: <br19mm$7ri$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
You meant something like this, I think.
There are eight subsets of the 9 digits that add to 15:
s = Select[KSubsets[Range@9, 3], Tr@# == 15 &]
Length@s
{{1,5,9},{1,6,8},{2,4,9},{2,5,8},{2,6,7},{3,4,8},{3,5,7},{4,5,6}}
8
There are three rows, three columns, and two diagonals in a magic
square, so a magic square is not only a rearrangement of the nine
digits, but an arrangement of the eight subsets just identified.
The central digit must be in a row, a column, and two diagonals, and
hence must appear in four of the subsets just found.
Count[Flatten@s, #] & /@ Range@9
{2, 3, 2, 3, 4, 3, 2, 3, 2}
Only the digit 5 appears in the required four subsets. Digits 2, 4, 6,
and 8 appear in three subsets, and hence can be placed at corners of
the figure. 2 and 8 must be opposite each other to total 15-5=10, as
must 4 and 6. Placement of the center digit and four corners
determines the remaining four digits.
It follows that all magic squares are generated by rotations and
reflections of the matrix:
{{2, 9, 4}, {7, 5, 3},{6, 1, 8}}//MatrixForm
Bobby
Bill Rowe <readnewscix at mail.earthlink.net> wrote in message news:<br19mm$7ri$1 at smc.vnet.net>...
> On 12/7/03 at 6:03 AM, mathtutoring at comcast.net (art burke) wrote:
>
> > I'd like to come up with several small programs that compute the
> > probability of random numbers being inserted into let's say, a magic
> > cube, triangle, or such that all rows, columns, and diagonals add up
> > to a certain number.
>
> > Let's say a 3x3 magic square, using the numbers 1,2,3,4,5,6,7,8 and 9.
> > Of course, if you know how to put them into the magic square, all
> > rows, diagonals, and columns add up to 15.
>
> > Having Mathematica insert random numbers in cells, compute all sums
> > and see if it has it correct, and keep up the repetions until it comes
> > up with an average probability, let's say after 1000 tries....What
> > would be the probability?
>
> Essentially, 0
>
> Taking your example of a 3 x 3 square and the numbers 1 though 9, there are 9! = 362880 different ways to arrange these numbers in a 3 x 3 array.
>
> <<DiscreteMath`
> Length@Select[KSubsets[Range@9,3],Tr@#==15&]
>
> Shows there are only 8 subsets of the 9 digits that add to 15. Further,
>
> Count[Flatten@KSubsets[Range@9,3],#]&/@Range@9 results in
>
> {2, 3, 2, 3, 4, 3, 2, 3, 2}
>
> showing the only possible arangements that meet the magic square requirement are rotations and reflections of
>
> 8 3 4
> 1 5 9
> 6 7 2
>
> If I've counted correctly, this means 8 possible magic squares.
>
> So the probability of a randomly chosen arrangement being a magic square is
>
> 8/9! = 1/45360, or in other words you will need on average to try 45360 random arrangements to get one magic square.
>
> > I've been quit interested in this for a while, but am wondering how it
> > would be done??
>
> <<DiscreteMath`
> a = Partition[RandomPermutation@9,3]
>
> will generate a random 3 x 3 array of the 9 digits and assign it to a. Then
>
> Flatten@{Tr/@a, Tr@a, Tr/@Transpose@a, Tr@Reverse@a}
>
> will give you the sums