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}
} *)
Original Answer
(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} *)
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} *)
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
