A090460 Number of essentially different permutations of the numbers 1 to n such that the sum of adjacent numbers is a square.

1, 1, 1, 0, 0, 0, 0, 0, 3, 0, 10, 12, 35, 52, 19, 20, 349, 361, 637, 3678, 15237, 11875, 13306, 10964, 27223, 37054, 201408, 510152, 1995949, 4867214, 11255174, 35705858, 63029611, 129860749, 258247089, 190294696, 686125836, 2195910738, 5114909395, 9141343219, 19769529758, 44678128099, 63885400119

Offset

15,9

Comments

For n > 31, some solutions are circular; that is, the first and last numbers also sum to a square. Note that A071983 counts each circular solution n times. This sequence counts each circular solution only once. The Mathematica program uses backtracking to find all solutions, which can be printed by removing the comment symbols.

Links

Zhao Hui Du, Table of n, a(n) for n = 15..59

Formula

a(n) = A071983(n) - (n-1)*A071984(n).

Example

See A071983.

Mathematica

SquareQ[n_] := IntegerQ[Sqrt[n]]; try[lev_] := Module[{t, j, circular}, If[lev>n, circular=SquareQ[soln[[1]]+soln[[n]]]; If[(!circular&&soln[[1]]<soln[[n]]) || (circular&&soln[[1]]==1&&soln[[2]]<=soln[[n]]), (*Print[soln]; *) cnt++ ], (*else append another number to the soln list*) t=soln[[lev-1]]; For[j=1, j<=Length[s[[t]]], j++, If[ !MemberQ[soln, s[[t]][[j]]], soln[[lev]]=s[[t]][[j]]; try[lev+1]; soln[[lev]]=0]]]]; nMax=32; For[lst={}; n=15, n<=nMax, n++, s=Table[{}, {n}]; For[i=1, i<=n, i++, For[j=1, j<=n, j++, If[i != j && SquareQ[i+j], AppendTo[s[[i]], j]]]]; soln=Table[0, {n}]; For[cnt=0; i=1, i<=n, i++, soln[[1]]=i; try[2]]; AppendTo[lst, cnt]]; lst

Crossrefs

Cf. A071983, A071984 (number of circular solutions), A090461 (n for which there is a solution).

Cf. A078107 (n for which there is no solution).

Sequence in context: A327072 A327377 A095200 * A071983 A302693 A327881

Adjacent sequences: A090457 A090458 A090459 * A090461 A090462 A090463

Keyword

hard,nonn

Author

T. D. Noe, Dec 01 2003

Extensions

a(43)-a(45) from Donovan Johnson, Sep 14 2010

a(46)-a(47) from Jud McCranie, Aug 18 2018

a(48) from Jud McCranie, Sep 17 2018

a(49)-a(52) from Bert Dobbelaere, Dec 30 2018

a(47) corrected by Bert Dobbelaere, Jan 12 2019

a(53)-a(54) from Martin Ehrenstein, May 22 2023

a(55)-a(57) from Zhao Hui Du, Apr 26 2024

Status

approved