A296530 Number of non-averaging permutations of [n] with first element n.

1, 1, 1, 1, 2, 2, 5, 10, 28, 24, 50, 124, 283, 528, 1266, 3715, 10702, 8740, 15414, 31988, 68465, 160964, 380124, 890738, 2230219, 3990852, 8354276, 20281732, 46056920, 131289988, 349369117, 1054037937, 3081527146, 2440225484, 4201202020, 7475926894, 13276918426

Offset

0,5

Comments

A non-averaging permutation avoids any 3-term arithmetic progression.

a(0) = 1 by convention.

Links

Alois P. Heinz, Table of n, a(n) for n = 0..99

Eric Weisstein's World of Mathematics, Nonaveraging Sequence

Wikipedia, Arithmetic progression

Index entries related to non-averaging sequences

Formula

a(n) = A296529(n,n).

Example

a(4) = 2: 4213, 4231.
a(5) = 2: 51324, 51342.
a(6) = 5: 621453, 624153, 624315, 624351, 624513.
a(7) = 10: 7312564, 7315264, 7315426, 7315462, 7315624, 7351264, 7351426, 7351462, 7351624, 7356124.

Maple

b:= proc(s) option remember; local n, r, ok, i, j, k;
      if nops(s) = 1 then 1
    else n, r:= max(s), 0;
         for j in s minus {n} do ok, i, k:= true, j-1, j+1;
           while ok and i>=0 and k<n do ok, i, k:=
             not i in s xor k in s, i-1, k+1 od;
           r:= r+ `if`(ok, b(s minus {j}), 0)
         od; r
      fi
    end:
a:= n-> b({$0..n} minus {n-1}):
seq(a(n), n=0..30);

Mathematica

b[s_] := b[s] = Module[{n = Max[s], r = 0, ok, i, j, k}, If[Length[s] == 1, 1, Do[{ok, i, k} = {True, j - 1, j + 1}; While[ok && i >= 0 && k < n, {ok, i, k} = {FreeQ[s, i] ~Xor~ MemberQ[s, k], i - 1, k + 1}]; r = r + If[ok, b[s ~Complement~ {j}], 0], {j, s ~Complement~ {n}}]; r]];
a[n_] := b[Complement[Range[0, n], {n - 1}]]
Table[a[n], {n, 0, 30}] (* Jean-François Alcover, Jun 02 2018, from Maple *)

Crossrefs

Main diagonal of A296529.

Cf. A003407, A292523.

Sequence in context: A081374 A243338 A245306 * A117400 A005637 A233018

Adjacent sequences: A296527 A296528 A296529 * A296531 A296532 A296533

Keyword

nonn

Author

Alois P. Heinz, Dec 14 2017

Status

approved