Re: Simple n-tuple problem - with no simple solution
- To: mathgroup at smc.vnet.net
- Subject: [mg115879] Re: Simple n-tuple problem - with no simple solution
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Sun, 23 Jan 2011 17:32:58 -0500 (EST)
I may as well show how to convert my results into the more voluminous ones
returned by other solvers.
A similar conversion works if IntegerPartitions (which seems faster) is
substituted for my ILP method using Solve.
So here goes:
Clear[t1]
t1[range_List, n_Integer] :=
Module[{addends = Rationalize@range, multipliers, m, sum,
nonNegative}, multipliers = Array[m, Length@range];
sum = Total@multipliers;
nonNegative = And @@ Thread[multipliers >= 0];
Sort[multipliers /.
Solve[{multipliers.addends == 1, nonNegative, sum == n},
multipliers, Integers]]]
Example:
n = 5; addends = Rationalize@Range[0, 1.0, 0.05];
s1 = t1[addends, n];
Length@s1
192
After removing rearrangements, ALL the solvers give 192 solutions for n =
5.
Here's a randomly chosen solution.
r1 = RandomChoice@s1
r2 = MapIndexed[{#1, addends[[First@#2]]} &, r1] /. {0, _} :>
Sequence[]
{0, 1, 0, 2, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
{{1, 1/20}, {2, 3/20}, {1, 3/10}, {1, 7/20}}
That represents all solutions that involve 1/20 once, 3/20 twice, 3/10
once, and 7/20 once -- in any order -- for a total of n = 5 choices from
the range.
Now to expand the chosen solution into all its permutations:
r3 = Permutations@
Flatten@Replace[r2, {k_Integer, x_} :> Table[x, {k}], 1]
{{1/20, 3/20, 3/20, 3/10, 7/20}, {1/20, 3/20, 3/20, 7/20, 3/10}, {1/
20, 3/20, 3/10, 3/20, 7/20}, {1/20, 3/20, 3/10, 7/20, 3/20}, {1/20,
3/20, 7/20, 3/20, 3/10}, {1/20, 3/20, 7/20, 3/10, 3/20}, {1/20, 3/
10, 3/20, 3/20, 7/20}, {1/20, 3/10, 3/20, 7/20, 3/20}, {1/20, 3/10,
7/20, 3/20, 3/20}, {1/20, 7/20, 3/20, 3/20, 3/10}, {1/20, 7/20, 3/
20, 3/10, 3/20}, {1/20, 7/20, 3/10, 3/20, 3/20}, {3/20, 1/20, 3/20,
3/10, 7/20}, {3/20, 1/20, 3/20, 7/20, 3/10}, {3/20, 1/20, 3/10, 3/
20, 7/20}, {3/20, 1/20, 3/10, 7/20, 3/20}, {3/20, 1/20, 7/20, 3/20,
3/10}, {3/20, 1/20, 7/20, 3/10, 3/20}, {3/20, 3/20, 1/20, 3/10, 7/
20}, {3/20, 3/20, 1/20, 7/20, 3/10}, {3/20, 3/20, 3/10, 1/20, 7/
20}, {3/20, 3/20, 3/10, 7/20, 1/20}, {3/20, 3/20, 7/20, 1/20, 3/
10}, {3/20, 3/20, 7/20, 3/10, 1/20}, {3/20, 3/10, 1/20, 3/20, 7/
20}, {3/20, 3/10, 1/20, 7/20, 3/20}, {3/20, 3/10, 3/20, 1/20, 7/
20}, {3/20, 3/10, 3/20, 7/20, 1/20}, {3/20, 3/10, 7/20, 1/20, 3/
20}, {3/20, 3/10, 7/20, 3/20, 1/20}, {3/20, 7/20, 1/20, 3/20, 3/
10}, {3/20, 7/20, 1/20, 3/10, 3/20}, {3/20, 7/20, 3/20, 1/20, 3/
10}, {3/20, 7/20, 3/20, 3/10, 1/20}, {3/20, 7/20, 3/10, 1/20, 3/
20}, {3/20, 7/20, 3/10, 3/20, 1/20}, {3/10, 1/20, 3/20, 3/20, 7/
20}, {3/10, 1/20, 3/20, 7/20, 3/20}, {3/10, 1/20, 7/20, 3/20, 3/
20}, {3/10, 3/20, 1/20, 3/20, 7/20}, {3/10, 3/20, 1/20, 7/20, 3/
20}, {3/10, 3/20, 3/20, 1/20, 7/20}, {3/10, 3/20, 3/20, 7/20, 1/
20}, {3/10, 3/20, 7/20, 1/20, 3/20}, {3/10, 3/20, 7/20, 3/20, 1/
20}, {3/10, 7/20, 1/20, 3/20, 3/20}, {3/10, 7/20, 3/20, 1/20, 3/
20}, {3/10, 7/20, 3/20, 3/20, 1/20}, {7/20, 1/20, 3/20, 3/20, 3/
10}, {7/20, 1/20, 3/20, 3/10, 3/20}, {7/20, 1/20, 3/10, 3/20, 3/
20}, {7/20, 3/20, 1/20, 3/20, 3/10}, {7/20, 3/20, 1/20, 3/10, 3/
20}, {7/20, 3/20, 3/20, 1/20, 3/10}, {7/20, 3/20, 3/20, 3/10, 1/
20}, {7/20, 3/20, 3/10, 1/20, 3/20}, {7/20, 3/20, 3/10, 3/20, 1/
20}, {7/20, 3/10, 1/20, 3/20, 3/20}, {7/20, 3/10, 3/20, 1/20, 3/
20}, {7/20, 3/10, 3/20, 3/20, 1/20}}
As you can see, sixty solutions from other solvers are represented by ONE
solution from "t1" (for this particular randomly chosen solution).
Length@r3
60
Here's the code that removes rearrangements, which I used to verify that
other solvers were returning the right number of DISTINCT solutions.
Union[Sort /@ r3]
{{1/20, 3/20, 3/20, 3/10, 7/20}}
Bobby
--
DrMajorBob at yahoo.com