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.

$\endgroup$
0

9 Answers 9

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}
$\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} *) 
$\endgroup$
2
  • $\begingroup$ (+1) Simpler, nice! $\endgroup$ Apr 24, 2023 at 18:15
  • $\begingroup$ Looking at the pattern in reverse! $\endgroup$
    – Syed
    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} *)
$\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
    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]]
$\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])]
$\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}

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

f /@ Range[6] // Column

enter image description here

$\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.