[Date Index]
[Thread Index]
[Author Index]
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**
| |