4
$\begingroup$

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.

Improve this question
$\endgroup$
0

9 Answers 9

Reset to default
6
$\begingroup$ 
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}
Improve this answer
$\endgroup$
5
$\begingroup$

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} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ (+1) Simpler, nice! $\endgroup$
    – E. Chan-López
    Commented Apr 24, 2023 at 18:15
  • $\begingroup$ Looking at the pattern in reverse! $\endgroup$
    – Syed
    Commented Apr 25, 2023 at 11:10
4
$\begingroup$

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} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$
    – yode
    Commented Feb 11, 2017 at 17:53
4
$\begingroup$ 
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]]
Improve this answer
$\endgroup$
4
$\begingroup$

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])]
Improve this answer
$\endgroup$
3
$\begingroup$ 
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}

Improve this answer
$\endgroup$
3
$\begingroup$ 
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]
Improve this answer
$\endgroup$
2
$\begingroup$ 
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}
Improve this answer
$\endgroup$
2
$\begingroup$ 
f = Catenate @ Transpose[{#, # - 2}] & @ Range[#, 2, -1] &;


f /@ Range[6] // Column

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.