cp's OEIS Frontend

A174700 The number of permutations p of {1,...,n} such that |p(i)-p(i+1)| is in {1,2,3} for all i from 1 to n-1.

%I A174700 #31 Sep 23 2024 05:06:30
%S A174700 1,1,2,6,24,72,180,428,1042,2512,5912,13592,30872,69560,155568,345282,
%T A174700 761312,1669612,3645236,7927404,17180092,37119040,79986902,171964534,
%U A174700 368959906,790214816,1689779842,3608413750,7696189046,16397254612,34902593796,74230774324
%N A174700 The number of permutations p of {1,...,n} such that |p(i)-p(i+1)| is in {1,2,3} for all i from 1 to n-1.
%C A174700 For n>1, a(n)/2 is the number of Hamiltonian paths on the graph with vertex set {1,...,n} where i is adjacent to j iff |i-j| is in {1,2,3}.
%H A174700 Andrew Howroyd, <a href="/A174700/b174700.txt">Table of n, a(n) for n = 0..100</a>
%F A174700 Empirical: a(n) = 3*a(n-1) - 4*a(n-3) + 3*a(n-4) - 4*a(n-5) - 9*a(n-6) + 2*a(n-7) + 5*a(n-8) + 9*a(n-9) + 17*a(n-10) + 16*a(n-11) + 14*a(n-12) + 8*a(n-13) - 2*a(n-14) - 5*a(n-15) - 5*a(n-16) - 6*a(n-17) - 4*a(n-18) - a(n-19) for n > 20. - _Andrew Howroyd_, Apr 08 2016
%F A174700 Empirical G.f.: (-3+x) + (2*(2-6*x+x^2+8*x^3-3*x^4+12*x^5 +9*x^6-17*x^7 -2*x^8-19*x^10 -26*x^11 -29*x^12-13*x^13+9*x^14+7*x^15 +4*x^16+6*x^17 +3*x^18)) / ((1+x)*(-1+x+x^2 +x^4+x^5)^2*(1-2*x+x^2-2*x^3-x^4-x^5 +x^7 +x^8)). - _Andrew Howroyd_, Apr 08 2016
%p A174700 f:= proc(m, M, n) option remember; local i, l, p, cnt; l:= array([i$i=1..n]); cnt:=0; p:= proc(t) local d, j, h; if t=n then d:=`if`(t=1,m,abs(l[t]-l[t-1])); if m<=d and d<=M then cnt:= cnt+1 fi else for j from t to n do l[t],l[j]:= l[j],l[t]; d:=`if`(t=1,m,abs(l[t]-l[t-1])); if m<=d and d<=M then p(t+1) fi od; h:= l[t]; for j from t to n-1 do l[j]:= l[j+1] od; l[n]:= h fi end; p(1); cnt end: a:=n->f(1,3,n); # _Alois P. Heinz_, Mar 27 2010
%t A174700 f[m_, M_, n_] := f[m, M, n] = Module[{i, l, p, cnt}, Do[l[i] = i, {i, 1, n}]; cnt = 0; p[t_] := Module[{d, j, h}, If[t == n, d = If[t == 1, m, Abs[l[t] - l[t-1]]]; If [m <= d && d <= M, cnt = cnt+1], For[j = t, j <= n, j++, {l[t], l[j]} = {l[j], l[t]}; d = If[t == 1, m, Abs[l[t] - l[t-1]]]; If [m <= d && d <= M, p[t+1]]]; h = l[t]; For[j = t, j <= n-1, j++, l[j] = l[j+1]]; l[n] = h]]; p[1]; cnt]; a[n_] := f[1, 3, n]; Table[Print["a(", n, ") = ", a[n]]; a[n], {n, 1, 15}] (* slow beyond n = 15 *) (* _Jean-François Alcover_, Jun 01 2015, after _Alois P. Heinz_ *)
%Y A174700 Cf. A003274, A174701, A174702, A174703, A174704, A174705, A174706, A174707, A174708, A185030, A216837, A302118.
%K A174700 nonn
%O A174700 0,3
%A A174700 _W. Edwin Clark_, Mar 27 2010
%E A174700 a(19)-a(28) from _R. H. Hardin_, May 06 2010