Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1997
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1997

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Horse Race Puzzle

  • To: mathgroup at smc.vnet.net
  • Subject: [mg9179] Re: [mg9162] Horse Race Puzzle
  • From: Olivier Gerard <jacquesg at pratique.fr>
  • Date: Tue, 21 Oct 1997 02:02:52 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

Hi Seth,

Here is my solution:

The algorithm is, generate all 2^(n-1) non empty subdivisions of n and
apply them to all permutations and then sort duplicates. To conform to
your original description, I have converted the result into lowercase
letter strings. Just suppress the final Map if you want only numbers.
This code needs 3.0 function Split.


AllRaces[n_Integer] :=
(Map[FromCharacterCode[#+96]&,
Union[Flatten[
	Outer[Function[{perm,cut}, Map[Sort[perm[[#]]]&,cut]] ,
	Permutations[Range[n]] ,
	Module[{i},
		Map[(i=0;Map[++i&,#,{2}])& ,
			 Split/@(IntegerDigits[#,2,n]&/@Range[0, 2^(n-1) -1])
		]],
	 1,1],
1]],
{3}]/. {{j_?AtomQ}-> j})


If someone come up with an elegant solution which does not generate any
intermediate duplicates, I am very interested.

If you only want to know the terms of the sequence, here they are:

A000670 Preferential arrangements of n things:
1,3,13,75,541,4683,47293,545835,7087261,102247563

exponential generating function: 1/(2-Exp[x])


Olivier Gerard.



At 09:38 +0200 97.10.16, Seth Chandler wrote:
> Here's a mathematics problem that might be well suited to some elegant
> Mathematica programming.
>
> N horses enter a race. Given the possibility of ties, how many different
> finishes to the horse race exist. Write a Mathematica program that
> shows all the possibilities.
>
> By way of example: here is the solution (13) by brute force for N=3. The
> horses are creatively named a, b and c. The expression {{b,c},a}
> denotes a finish in which b and c tie for first and a comes in next.
>
> {a, b, c}, {a, c, b}, {b, a, c}, {b, c, a}, {c, b, a}, {c, a, b},
> {a,{b,c}}, {{b,c},a}, {b,{a,c}},
> {{a,c},b},{{c,{a,b}},{{a,b},c},{{a,b,c}}
>
> P.S. I have a solution to the problem, I think, but it seems unduly
> complex and relies on the package DiscreteMath`Combinatorica`
>
> Seth J. Chandler
> Associate Professor of Law
> University of Houston Law Center



  • Prev by Date: DiracDelta Integrals
  • Next by Date: Re: Help with findroot
  • Previous by thread: RE: Horse Race Puzzle
  • Next by thread: Re: Horse Race Puzzle