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: [mg9238] Re: [mg9162] Horse Race Puzzle
  • From: Robert Pratt <rpratt at math.unc.edu>
  • Date: Fri, 24 Oct 1997 01:00:52 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

The solutions can be computed recursively using pattern matching as 
follows:

HorseRaces[1]={{1}};
HorseRaces[n_]:=HorseRaces[n]=
	Join[
   Flatten[Map[ReplaceList[#,{x___,y___}->{x,n,y}]&,HorseRaces[n-1]],1],
   Flatten[ReplaceList[#,{x___,y_,z___}->Flatten[{y,n}],z}]&,
	HorseRaces[n-1]],1]
	]

Unfortunately, Mathematica seems to ignore the Flatten[{y,n}] command,
returning  {y,n} unflattened.  However, this only gives some
unambiguous extra nesting in the solutions.

Also, the number of solutions a[n] for n horses is given by

a[1]=1;
a[n_]:=a[n]=Sum[Binomial[n,k] a[n-k],{k,n}]

Rob Pratt
Department of Mathematics
The University of North Carolina at Chapel Hill CB# 3250, 331 Phillips
Hall
Chapel Hill, NC  27599-3250

rpratt at math.unc.edu

http://www.math.unc.edu/Grads/rpratt/

On Thu, 16 Oct 1997, 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: Write Protected Functions
  • Next by Date: RE: Help with findroot
  • Previous by thread: Re: Horse Race Puzzle
  • Next by thread: Another Bug in Mathematica 3.0.0 definite integration