# How to get this sequence list?

I hope to get a list whose elements decrease by $2$ or increase by $1$, in turn, until the last element is $0$. For instance, starting with $4$ the sequence would be {4, 2, 3, 1, 2, 0}. If you gave me $5$ instead, the sequence would be {5, 3, 4, 2, 3, 1, 2, 0}.

This is my current method:

i = 1;
NestWhileList[If[++i; EvenQ[i], # - 2, # + 1]&, 5, UnequalTo[0]]


{5, 3, 4, 2, 3, 1, 2, 0}

But I am not very satisfied with that intermediate variable i. I would like to find other methods.

f1 = FoldList[Plus, #, 3 Mod[Range[0, 2 (# - 2)], 2] - 2] &

f1 @ 5

{5, 3, 4, 2, 3, 1, 2, 0}

f1 @ 4

{4, 2, 3, 1, 2, 0}


Also

f2 = Accumulate @ Prepend[#] @ (3 Mod[Range[0, 2 (# - 2)], 2] - 2) &;

f2 @ 5

{5, 3, 4, 2, 3, 1, 2, 0}

f2  @ 4

{4, 2, 3, 1, 2, 0}


Update

Another use for SubstitutionSystem, which I was unaware of before I read this great answer by @azerbajdzan.

SubstitutionSystem[{n_-> n-1}, {4,2},2]//Flatten

(* {4,2,3,1,2,0} *)


Or

SubstitutionSystem[{n_-> n+1}, {0,2},2]//Flatten//Reverse

(* {4,2,3,1,2,0} *)

(SubstitutionSystem[{n_->n+1}, {0,2},#]//Flatten//Reverse)&/@Range[2,10]

(* {
{4,2,3,1,2,0},
{5,3,4,2,3,1,2,0},
{6,4,5,3,4,2,3,1,2,0},
{7,5,6,4,5,3,4,2,3,1,2,0},
{8,6,7,5,6,4,5,3,4,2,3,1,2,0},
{9,7,8,6,7,5,6,4,5,3,4,2,3,1,2,0},
{10,8,9,7,8,6,7,5,6,4,5,3,4,2,3,1,2,0},
{11,9,10,8,9,7,8,6,7,5,6,4,5,3,4,2,3,1,2,0},
{12,10,11,9,10,8,9,7,8,6,7,5,6,4,5,3,4,2,3,1,2,0}
} *)


(1)

(NestList[#+1&,{0,2},2]//Flatten//Reverse)

(* {4, 2, 3, 1, 2, 0} *)


(2)

(NestList[#+1&,{0,2},3]//Flatten//Reverse)

(*{5, 3, 4, 2, 3, 1, 2, 0} *)


(3)

(NestList[#+1&,{0,2},#]//Flatten//Reverse)&/@Range[2,10]

(*
{
{4, 2, 3, 1, 2, 0},
{5, 3, 4, 2, 3, 1, 2, 0},
{6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{9, 7, 8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{10, 8, 9, 7, 8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{11, 9, 10, 8, 9, 7, 8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0},
{12, 10, 11, 9, 10, 8, 9, 7, 8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0}
}
*)


(4) Recursively

If[#1[[-1]]>5, Nothing, #0[Sow[#1]+1]]&[{0,2}]//Reap//Flatten//Reverse

(* {5, 3, 4, 2, 3, 1, 2, 0} *)

• (+1) Simpler, nice! Commented Apr 24, 2023 at 18:15
• Looking at the pattern in reverse!
– Syed
Commented Apr 25, 2023 at 11:10

A combination of Range and Riffle produces the desired result.

sequence[n_Integer] := Riffle[Range[n, 2, -1], Range[n - 2, 0, -1]]


Applying to 5

sequence[5]
(* {5, 3, 4, 2, 3, 1, 2, 0} *)

• The answer can solve this problem,I have thought it here.But I don't like it still,because that two alternate function(#-2& and #+1&) can be more complicate function.Then this method will be run out.
– yode
Commented Feb 11, 2017 at 17:53
seq[n_Integer?(GreaterThan[1])] :=
Accumulate[Prepend[Most[ConstantArray[Splice[{-2, 1}], n - 1]], n]]


Or

seq[n_Integer?(GreaterThan[1])] :=
Reverse@Most@FoldList[Plus, 0, ConstantArray[Splice[{2, -1}], n - 1]]


A variant of one of the two forms proposed by @lericr:

seq[n_ /; n > 1] :=
Reverse@FoldList[Plus, 0, Most@(Sequence @@@ ConstantArray[{2, -1}, n - 1])]

seq[n_ /; n > 1] := Reverse[Riffle[Range[0, n - 2], Range[2, n]]]
seq[6]


{6, 4, 5, 3, 4, 2, 3, 1, 2, 0}

Clear["Global*"];
s[2] = {2, 0};
s[n_] := s[n] = {n, n - 2, Sequence @@ s[n - 1]}

s[6]


{6, 4, 5, 3, 4, 2, 3, 1, 2, 0}

Information[s]

f[{x_, y_}] := {x + 1 - 3 Mod[y, 2], y + 1}
func[a_] := NestWhileList[f, {a, 1}, #[[1]] != 0 &][[All, 1]]


e.g.func[10] yields:

{10, 8, 9, 7, 8, 6, 7, 5, 6, 4, 5, 3, 4, 2, 3, 1, 2, 0}

f = Catenate @ Transpose[{#, # - 2}] & @ Range[#, 2, -1] &;

f /@ Range[6] // Column
`