To be more specific, I am working on a code to help me find patterns and solve this problem: Which sets of numbers of size n (starting at one) can be divided into pairs that add up to a perfect square, such that every number has a partner, and there are no repeats? A simple known solution is 8, because the set 8 can be paired (1,8) (2,7) (3,6) and (4,5) with each pair adding to 9.
Here is my code that works:
Remove["Global`*"]
f[n_] := Permutations[Table[i, {i, 1, n}], {2}]
listfunction[n_] :=
Module[
{},
newlist = {};
duplicates = {};
Do[
If[
f[n][[j, 1]] < f[n][[j, 2]],
AppendTo[ newlist, f[n][[j]]],
AppendTo[duplicates, f[n][[j]]]]
, {j, 1, (n!/(n - 2)!)}]; Module[{},
perfectsquares100 =
Table[x^2, {x, 1, 100}];
possibles = {};
impossibles = {};
Do[
If[
MemberQ[perfectsquares100, newlist[[k, 1]] + newlist[[k, 2]]],
AppendTo[possibles, newlist[[k]]],
AppendTo[impossibles, newlist[[k]]]],
{k, 1, Length[newlist]}]; Print[possibles]]]
Which generates the list for n of all the pairs whose sum is a perfect square.
So now, I need to whittle that list down to the numbers 1 to n, so that each digit is only represented once, eliminating extra pairs.
This is the code I have come up with to do that, that doesn't work. The following code will use the immediate output from the above code.
finallist[possibles] = Module[{},
rejects = {};
answer = {};
Do[
If[MemberQ[possibles[[h + 1 ;; Length[possibles]]],
possibles[[h, 1]], 2] \[And]
MemberQ[possibles[[h + 1 ;; Length[possibles]]],
possibles[[h, 2]], 2], AppendTo[rejects, possibles[[h]]],
AppendTo[answer, possibles[[h]]]], {h, 1, Length[possibles]}];
Print[answer]]
I built the code working from n=8, but when I tried it on n=16, it fails to provide the correct answer.
So, any ideas on what commands might work?
