Year-end appeal: Please make a donation to the OEIS Foundation to support ongoing development and maintenance of the OEIS. We are now in our 61st year, we have over 378,000 sequences, and we’ve reached 11,000 citations (which often say “discovered thanks to the OEIS”).
%I #53 Sep 24 2023 10:30:40
%S 0,0,0,1,6,33,152,663,2778,11413,46332,186867,750878,3011025,12060480,
%T 48277423,193186146,772908429,3091983236,12368675691,49476275622,
%U 197908422985,791640682440,3166577409831,12666340397546,50665425902853,202661837829132,810647630936803
%N Number of derangements of S_n with exactly one peak.
%H Alois P. Heinz, <a href="/A301272/b301272.txt">Table of n, a(n) for n = 0..1663</a>
%H R. J. Cano, <a href="/A301272/a301272.txt">Sequencer program in PARI.</a>
%H <a href="/index/Rec#order_05">Index entries for linear recurrences with constant coefficients</a>, signature (6,-5,-16,12,16).
%F G.f.: x^3*(2*x^2+1)/((1-4*x)*(x+1)^2*(2*x-1)^2). - _Alois P. Heinz_, Apr 29 2018
%e a(3) = 1: 231.
%e a(4) = 6: 2143, 2341, 2413, 3142, 3412, 3421.
%p a:= n-> floor((<<0|1|0|0|0>, <0|0|1|0|0>, <0|0|0|1|0>, <0|0|0|0|1>,
%p <16|12|-16|-5|6>>^n. <<1/8, 0, 0, 1, 6>>)[1, 1]):
%p seq(a(n), n=0..30); # _Alois P. Heinz_, Apr 29 2018
%t Join[{0}, LinearRecurrence[{6, -5, -16, 12, 16}, {0, 0, 1, 6, 33}, 30]] (* _Jean-François Alcover_, May 31 2019 *)
%t CoefficientList[Series[x^3(2x^2+1)/((1-4x)(x+1)^2(2x-1)^2),{x,0,40}],x] (* _Harvey P. Dale_, Sep 01 2021 *)
%o (Python)
%o def count_peaks(pi):
%o count = 0
%o for i in range(i,len(pi)-1):
%o if pi[i] > pi[i+1] and pi[i] > pi[i-1]:
%o count += 1
%o return count
%o def main(args):
%o n = int(args[0])
%o set = {1,2,...,n}
%o drmts = []
%o for pi in itertools.permutations(set):
%o drmts.append(pi)
%o for i in range(n):
%o if pi[i] == i+1:
%o drmts.remove(pi)
%o break
%o num = 0
%o for pi in drmts:
%o if count_peaks(pi) == 1:
%o num += 1
%o print('number of 1 peak derangements: ', num)
%o (PARI) A301272(n)={my(c=0,v,t,ok);for(k=0,n!-1,v=numtoperm(n,k);ok=1;for(i=1,n,if((v[i]==i),ok=0;break));if(ok,t=0;for(i=2,n-1,if((v[i]>v[i-1])&&(v[i]>v[i+1]),t++;if(t>1,break)));if(t==1,c++)));c} \\ _R. J. Cano_, Apr 25 2018
%o (PARI) \\ See Cano link.
%Y Cf. A000166, A001045, A216963.
%Y Column k=1 of A303564.
%K nonn,easy
%O 0,5
%A _Isabella Huang_, Mar 17 2018
%E a(10)-a(20) from _Alois P. Heinz_, Apr 25 2018
%E a(21)-a(27) from _Alois P. Heinz_, Apr 29 2018