(*Version 1*)
Clear[a,b,c,d,e,f,g,h];
sol={a,b,c,d,e,f,g,h}/.Solve[{
Max[{a, b, c, d, e, f, g, h}] == 14,
Min[{a, b, c, d, e, f, g, h}] == 1,
a == 11, h == 4, b + g == 15, c + f == 15, d + e == 15},
{a, b, c, d, e, f, g, h},Integers
];
Select[sol,({a,b,c,d,e,f,g,h}=#; Mod[b, 2] == 0 && Mod[c, 3] > 0 (*&&etc*))&]
If you can complete the work on all equations for n==8 and describe what form you want the code to be in to directly generate the result then I will see what I can do. Thanks.
Begin to generalize for any even n variables.
Thank you for the pastebin, that was essential for doing this.
(*Version 2*)
n=8;(*must be even*)
vars=Table[v[i],{i,1,n}];
cons=Join[
{ Total[vars - Sort[vars]] == 0,(*I think this line is always true*)
Abs[Total[Take[vars,n/2]]-Total[Drop[vars,n/2]]]==16,(*Is there a formula of n to replace 16 *)
v[n-1]>0
},
Table[v[i]+v[n-i+1]==15,{i,1,n/2}],
{ Total[Table[v[i],{i,1,n}]]==60 },(*Is there a formula of n to replace 60*)
Table[v[i]-v[i+1]==v[n-i]-v[n-i+1],{i,1,n/2-1}],
{ v[4]-v[5]==v[2]-v[3],
v[4]-v[5]==v[6]-v[7],
v[1]-v[8]==7,
v[8]-v[1]== -7},
{ Total[Abs[Table[v[i]-v[i+1],{i,1,n-1}]]]==35}
];
sol=vars/.Solve[cons, vars,Integers]
(* returns {{11, 2, 1, 8, 7, 14, 13, 4}} *)
Please check to see if your code returns the same result and if not then let me know what the result should be.
Revised
(*Version 3*)
n = 48;
(* Goal
v = {27, -18, 1, 4, 23, 26, 13, 32, 19, 22, 41, 44,
31, 18, 37, 24, 27, 46, 33, 36, 23, -6, -3, 16,
19, 38, 41, 12, -1, 2, -11, 8, 11, -2, 17, 4,
-9, -6, 13, 16, 3, 22, 9, 12, 31, 34, 53, 8};
*)
(*Verify that this returns True so that doesn't seem to solve for any unknowns*)
v=Table[x[i],{i,n}];
Total[Total[Table[v[[i]]-Sort[Table[v[[i]],{i,n}]],{i,n}]]] == 0
(*Verify this is correct*)
Table[v[[i]]+v[[n-i+1]]==constant2,{i,n/2}];
(*so*)
Table[v[[n-i+1]]==35-v[[i]],{i,n/2}];
(*so*)
Reverse[Table[v[[n-i+1]]==35-v[[i]],{i,n/2}]];
(*so this reduces 48 unknowns to 24 unknowns*)
Join[Table[x[i],{i,n/2}],Reverse[Table[35-v[[i]],{i,n/2}]]];
v={x[1], x[2], x[3], x[4], x[5], x[6], x[7], x[8], x[9], x[10], x[11], x[12],
x[13], x[14], x[15], x[16], x[17], x[18], x[19], x[20], x[21], x[22], x[23], x[24],
35-x[24], 35-x[23], 35-x[22], 35-x[21], 35-x[20], 35-x[19], 35-x[18], 35-x[17],
35-x[16], 35-x[15], 35-x[14], 35-x[13], 35-x[12], 35-x[11], 35-x[10], 35-x[9],
35-x[8], 35-x[7], 35-x[6], 35-x[5], 35-x[4], 35-x[3], 35-x[2], 35-x[1]};
(*Verify this returns True so that doesn't seem to solve for any unknowns*)
Total[v]==840
(*Verify this returns True so that doesn't seem to solve for any unknowns*)
Total[v]==Total[Table[v[[i]],{i,n/2-n/4+1,n/2+n/4}]]*2
(*Verify this returns True so that doesn't seem to solve for any unknowns*)
Total[Table[v[[i]],{i,n/2-n/4+1,n/2+n/4}]]==Total[Table[v[[i]],{i,n/2-n/8+1,n/2+n/8}]]*2
(*Verify this returns {True,True,True...} so that doesn't seem to solve for any unknowns*)
Table[v[[i]]-v[[i+1]]==v[[n-i]]-v[[n-i+1]], {i,n/2-1}]
(*Verify this returns x[1]==27*)
Total[Table[v[[i]]-v[[i+1]],{i,1,n-1}]]==19//Simplify
(*Verify this returns x[1]==27*)
v[[1]]-v[[n]]==19//Simplify
(*Verify this returns x[1]==27*)
v[[n]]-v[[1]]== -19//Simplify
(*Verify this returns 35+x[22]==x[23]+2*x[24]*)
v[[n/2]]-v[[n/2+1]]==v[[n/2-2]]-v[[n/2-1]]//Simplify
(*Verify this returns 35+x[22]==x[23]+2*x[24]*)
v[[n/2]]-v[[n/2+1]]==v[[n/2+2]]-v[[n/2+3]]//Simplify
Min[Table[v[[i]]-v[[i+1]],{i,n-1}]]== -19
Max[Table[v[[i]]-v[[i+1]],{i,n-1}]]==45
Total[Abs[Table[v[[i]]-v[[i+1]],{i,n-1}]]]==641
Abs[Total[Table[v[[i]],{i,n/2}]]-Total[Table[v[[i]],{i,n/2+1,n}]]]==192
(*Verify this is correct*)
Abs[Total[Table[v[[i]],{i,n/2}]]-Total[Table[v[[i]],{i,n/2+1,n}]]]==
Abs[Total[Take[v,n/2]]-Total[Drop[v,n/2]]]==
Abs[Total[Take[v,n/2]]-(35*24-Total[Take[v,n/2]])]==
Abs[Total[Take[v,n/2]]-35*24+Total[Take[v,n/2]]]==
Abs[2*Total[Take[v,n/2]]-35*24]
(*I think I can verify everything except the last line of that
and the last line of that seems like it should also be correct.
This should simplify even further and possibly solve for no more variables.*)
(*This seems to simplify the problem as much as I can see to do now*)
n=48;
v={x[1], x[2], x[3], x[4], x[5], x[6], x[7], x[8], x[9], x[10], x[11], x[12],
x[13], x[14], x[15], x[16], x[17], x[18], x[19], x[20], x[21], x[22], x[23], x[24],
35-x[24], 35-x[23], 35-x[22], 35-x[21], 35-x[20], 35-x[19], 35-x[18], 35-x[17],
35-x[16], 35-x[15], 35-x[14], 35-x[13], 35-x[12], 35-x[11], 35-x[10], 35-x[9],
35-x[8], 35-x[7], 35-x[6], 35-x[5], 35-x[4], 35-x[3], 35-x[2], 35-x[1]};
Reduce[{x[1]==27,35+x[22]==x[23]+2*x[24],
Min[Table[v[[i]]-v[[i+1]],{i,n-1}]]== -19,
Max[Table[v[[i]]-v[[i+1]],{i,n-1}]]==45,
Total[Abs[Table[v[[i]]-v[[i+1]], {i,n-1}]]]==641,
Abs[Total[Table[v[[i]],{i,n/2}]]-Total[Table[v[[i]],{i,n/2+1,n}]]]==192},
{x[1], x[2], x[3], x[4], x[5], x[6], x[7], x[8], x[9], x[10], x[11], x[12],
x[13], x[14], x[15], x[16], x[17], x[18], x[19], x[20], x[21], x[22], x[23], x[24]}]
But that is still 24 unknowns and only 6 equations. And it seems to run forever. It might, but there is no guarantee, be faster if there were another 18 reasonably simple equations constraining the solution. But the Min and Max and Abs mean that some methods of speeding this up cannot be used.
Please check all this carefully and see if you can find any mistakes that I have made. If you bookmark this page and check it every day or so then I will increment the version number on the code when I make any substantial change given your input and we will see if we can get you the last few steps to your solution. If you keep checking the version number then I don't have to add "more revision" comments and there is a small limit on the number of comments before they start trying to push this off into another chat page. You can edit your original post and add version numbers and updates to the end of that. I will check that every day. Thanks
