Necessary and sufficient conditions for a helix
Can be done with a bit of programming. Below I also enforce that exactly half the values be used in each subset. I show one subset in the result and obviously its complement would be the companion subset.
vals = Range[16]^2;
vars = Array[x, Length[vals]];
c1 = Map[0 <= # <= 1 &, vars];
c2 = Total[vars] == 8;
c3 = 2*vars.vals == Total[vals];
DeleteCases[(vars*vals) /.
First[FindInstance[Flatten[{c1, c2, c3}], vars, Integers]], 0]
--- Edit ---
There are other solutions in this case. Can find them all using Reduce
.
DeleteCases[(vars*vals) /. {ToRules[
Reduce[Flatten[{c1, c2, c3}], vars, Integers]]}, 0, {2}]
(* {{16, 25, 36, 81, 100, 121, 144, 225}, {9, 36, 49, 64, 100,
121, 144, 225}, {9, 36, 49, 64, 81, 144, 169, 196}, {9, 25, 36, 49,
64, 144, 196, 225}, {9, 16, 36, 64, 81, 121, 196, 225}, {9, 16, 36,
49, 100, 144, 169, 225}, {9, 16, 25, 36, 81, 100, 225, 256}, {4, 25,
49, 64, 81, 100, 169, 256}, {4, 25, 36, 64, 81, 144, 169, 225}, {4,
16, 49, 64, 100, 121, 169, 225}, {4, 16, 25, 49, 81, 121, 196,
256}, {4, 16, 25, 49, 64, 169, 196, 225}, {4, 9, 64, 81, 100, 121,
144, 225}, {4, 9, 36, 49, 81, 144, 169, 256}, {4, 9, 25, 64, 100,
121, 169, 256}, {4, 9, 25, 64, 81, 144, 196, 225}, {4, 9, 25, 36,
49, 144, 225, 256}, {4, 9, 16, 81, 100, 144, 169, 225}, {4, 9, 16,
36, 81, 121, 225, 256}, {1, 25, 49, 64, 100, 144, 169, 196}, {1, 25,
36, 49, 64, 121, 196, 256}, {1, 16, 64, 81, 100, 121, 169,
196}, {1, 16, 36, 49, 100, 121, 169, 256}, {1, 16, 36, 49, 81, 144,
196, 225}, {1, 16, 25, 64, 100, 121, 196, 225}, {1, 16, 25, 36, 49,
169, 196, 256}, {1, 9, 36, 81, 100, 121, 144, 256}, {1, 9, 36, 64,
100, 144, 169, 225}, {1, 9, 25, 36, 81, 144, 196, 256}, {1, 9, 16,
49, 100, 121, 196, 256}, {1, 9, 16, 36, 121, 144, 196, 225}, {1, 4,
49, 64, 121, 144, 169, 196}, {1, 4, 25, 64, 81, 121, 196, 256}, {1,
4, 25, 49, 100, 144, 169, 256}, {1, 4, 16, 81, 100, 121, 169,
256}, {1, 4, 16, 25, 100, 121, 225, 256}, {1, 4, 16, 25, 81, 169,
196, 256}, {1, 4, 9, 49, 64, 169, 196, 256}} *)
--- Edit #2 ---
Here is a method that is somewhat generating function related, but unfortunately it is not very efficient. The idea is to expand a certain multinomial to its 7th power, making sure to get no nontrivial powers of factors (as that would correspond to repeated use of elements from our list). We also repress powers that exceed our goal sum.
tv = Total[vars*t^(Range[16]^2)]
(*
t x[1] + t^4 x[2] + t^9 x[3] + t^16 x[4] + t^25 x[5] + t^36 x[6] +
t^49 x[7] + t^64 x[8] + t^81 x[9] + t^100 x[10] + t^121 x[11] +
t^144 x[12] + t^169 x[13] + t^196 x[14] + t^225 x[15] + t^256 x[16] *)
Timing[
expanded =
Nest[Expand[#*tv] /. {x[_]^n_ :> 0,
t^m_ /; m > (Total[vals]/2) :> 0} &, tv, 7];]
(* {2.990000, Null} *)
Coefficient[expanded, t^(Total[vals]/2)]
(*
40320 x[1] x[4] x[8] x[9] x[10] x[11] x[13] x[14] +
40320 x[3] x[6] x[7] x[8] x[9] x[12] x[13] x[14] +
40320 x[1] x[5] x[7] x[8] x[10] x[12] x[13] x[14] +
40320 x[1] x[2] x[7] x[8] x[11] x[12] x[13] x[14] +
40320 x[3] x[6] x[7] x[8] x[10] x[11] x[12] x[15] +
40320 x[4] x[5] x[6] x[9] x[10] x[11] x[12] x[15] +
40320 x[2] x[3] x[8] x[9] x[10] x[11] x[12] x[15] +
40320 x[2] x[4] x[7] x[8] x[10] x[11] x[13] x[15] +
40320 x[2] x[5] x[6] x[8] x[9] x[12] x[13] x[15] +
40320 x[3] x[4] x[6] x[7] x[10] x[12] x[13] x[15] +
40320 x[1] x[3] x[6] x[8] x[10] x[12] x[13] x[15] +
40320 x[2] x[3] x[4] x[9] x[10] x[12] x[13] x[15] +
40320 x[3] x[4] x[6] x[8] x[9] x[11] x[14] x[15] +
40320 x[1] x[4] x[5] x[8] x[10] x[11] x[14] x[15] +
40320 x[3] x[5] x[6] x[7] x[8] x[12] x[14] x[15] +
40320 x[1] x[4] x[6] x[7] x[9] x[12] x[14] x[15] +
40320 x[2] x[3] x[5] x[8] x[9] x[12] x[14] x[15] +
40320 x[1] x[3] x[4] x[6] x[11] x[12] x[14] x[15] +
40320 x[2] x[4] x[5] x[7] x[8] x[13] x[14] x[15] +
40320 x[1] x[3] x[6] x[9] x[10] x[11] x[12] x[16] +
40320 x[2] x[5] x[7] x[8] x[9] x[10] x[13] x[16] +
40320 x[1] x[4] x[6] x[7] x[10] x[11] x[13] x[16] +
40320 x[2] x[3] x[5] x[8] x[10] x[11] x[13] x[16] +
40320 x[1] x[2] x[4] x[9] x[10] x[11] x[13] x[16] +
40320 x[2] x[3] x[6] x[7] x[9] x[12] x[13] x[16] +
40320 x[1] x[2] x[5] x[7] x[10] x[12] x[13] x[16] +
40320 x[1] x[5] x[6] x[7] x[8] x[11] x[14] x[16] +
40320 x[2] x[4] x[5] x[7] x[9] x[11] x[14] x[16] +
40320 x[1] x[2] x[5] x[8] x[9] x[11] x[14] x[16] +
40320 x[1] x[3] x[4] x[7] x[10] x[11] x[14] x[16] +
40320 x[1] x[3] x[5] x[6] x[9] x[12] x[14] x[16] +
40320 x[1] x[4] x[5] x[6] x[7] x[13] x[14] x[16] +
40320 x[1] x[2] x[3] x[7] x[8] x[13] x[14] x[16] +
40320 x[1] x[2] x[4] x[5] x[9] x[13] x[14] x[16] +
40320 x[3] x[4] x[5] x[6] x[9] x[10] x[15] x[16] +
40320 x[2] x[3] x[4] x[6] x[9] x[11] x[15] x[16] +
40320 x[1] x[2] x[4] x[5] x[10] x[11] x[15] x[16] +
40320 x[2] x[3] x[5] x[6] x[7] x[12] x[15] x[16] *)
What would be nice is to have a more sensible way of doing this. By sensible I mean something that extracts a coefficient but does not have to work so hard to repress unwanted terms in a polynomial or series expansion.
This is a small version of a PE problem which asks for counts of certain solutions. If the OP is interested, there is a generating function approach to finding such counts. Consider the product of binomial terms where the power of z is the sequence of squares defined in the problem statement.
Expand[Product[(1 + z^k), {k, Range[16]^2}]]
The coefficient of $z^{748}$ gives the number of ways of writing 748 as a sum of squares from the list of the first 16 squares. The following use ofCoefficient
shows there are 114 ways.
Coefficient[Expand[Product[(1 + z^k), {k, Range[16]^2}]], z, 748]
The number of squares m summed for any particular representation of 748 is given by incorporating an additional parameter t. The exponent of t in the coefficient of $z^{748}$ in the following expansion gives the number of squares m.
Coefficient[Expand[Product[(1 + t*z^k), {k, Range[16]^2}]], z, 748]
(* 10 t^6 + 28 t^7 + 38 t^8 + 28 t^9 + 10 t^10 *)
The result shows there must be from m=6 to m=10 squares summed to represent 748, and the number of ways for each m is given by the corresponding coefficient.
The challenge becomes to find such counts when there are 100 rather than simply 16 squares in the original set. Enumerating the partitions is doomed, even expanding the generating function may exceed memory limits. The trick is for the OP, if pursuing PE solutions, to find a recursive method of constructing only the "interesting" part of the generating function.
The following will produce all 114 subsets that total 748. Note: Only 38 of these are of length 8.
d = Table[j^2, {j, 16}];
s=Select[Subsets[d], Total[#] == 748 &];
Length[%]
114
Clearly, the complement of each of these with d
, the full set, will return the partitions we seek. We then use Sort
and Union
to eliminate duplicates, partitions with the elements in both orders.
This results in 57 partitions.
Union[Sort /@ ({#, Complement[d, #]} & /@ s)];
Length[%]
57