[mg9162] Horse Race Puzzle

[Fred Simons]

In the following solution I restrict myself to the number of different
finishes; the complete list of all possible finishes can be constructed
in a similar way, but I am afraid that already for relative small
values of N the system will crash due to lack of memory.

The result of each race is a list of time of arrivals; on each arrival
time a group of horses finishes. A result will be of type T[n1, n2,
..., np] if there are n1 arrival times on which exactly one horse
finishes, n2 arrival times on which exactly two horses finish, etc.
Obviously, n1 + ... + np is the number of different arrival times and
n1 + 2 n2 + ... + p np = N.

Assume that we have a result of type T[n1, ..., np] for N horses, and
that we let another horse enter the race. This extra horse may finish
alone, which yields (n1 + ... + np + 1) results of type T[n1+1, n2,
..., np], or it may finish in a time of i of the other horses. The
latter situation yields ni results of type T[ n1, ..., ni-1, n(i+1)+1,
..., np] if i<p and np solutions of type T[n1, ..., np-1, 1] if i =p.

This construction can be implemented in the following way:

f[ T[ a__] ] := Module[ {arg = {a}, result, aux, i =1},
aux = arg;
aux[[1]] = aux[[1]] + 1;
result = (1+Plus @@ arg) (T @@ aux);
While[ i < Length[arg],
aux = arg;
aux[[i]] = aux[[i]]-1;
aux[[i+1]] = aux[[i+1]]+1;
result = result + arg[[i]] (T @@ aux);
i = i+1];
aux = arg; aux[[-1]] = aux[[-1]] - 1; AppendTo[aux,1];
result= result + arg[[-1]] (T @@ aux)
]

f[ n_Integer x_T] := Expand[ n f[x] ]

f[ x_Plus] := Expand[ f /@ x ]

Obviously, for N=1, there is only one result of type T[1].

To find all types of results for N = 3:

In[1] := n = 3; Nest[ f, T[1], n-1 ]

Out[1] = 6 T[3]+6 T[1,1]+T[0,0,1]

If we want to find the number of different finishes, we have to set all
T-functions to 1. For example, for n = 20:

In[2] := n =20; Nest[ f, T[1], n-1 ] /. T[___]->1

Out[2] = 2677687796244384203115

Fred Simons
Eindhoven University of Technology

[Ersek_T...@mr.nawcad.navy.mil]

Seth J. Chandler wrote:
----------
|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}} |
|

I propose a different convention. Make a list where we have a list of
those in first, a list of those in second, and a list of those in
third. This gives the following for three horses:

{{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}, {}, {}}

I don't know but this may be easy to do using some of the 230 commands
in the package, DisctreteMath`CombinatorialFunctions`. See
Mathematica 3.0 Standard Packages (pp 83-102).

Apparently an even better guide to the package is the following book:
Implementing Discrete Mathematics: Combinatorics and Graph Theory with
Mathematica, by Steven Skiena

On the other hand you could write the code yourself if you want to take
on the challenge.
However, I don't have the time to pursue this any further right now.

Ted Ersek

[Olivier Gerard]

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