How can I insert an element every $n$th position in a list?

Question

How can I insert an element every $n$ positions in a list?

For example, inserting a zero as every 4th element to turn

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

into

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

Surely there must be a simpler way than

list = {1, 2, 3, 4, 5, 6, 7};
every = 4;
Insert[list, 0, List /@ Range[1, Floor[Length@list/(every - 1)]]*(every - 1)]

Answer 1

I'm answering my own question because I found it curious that neither Google nor Mathematica's documentation located my solution when I searched by, what were to me, the most obvious combinations of keyphrases, e.g. mathematica insert every list.

Riffle is probably an obvious thought for anyone familiar with Mathematica, but not a common term that newcomers could be expected to know. Until today, even my own idea of Riffle was that it was a "zipper" function (i.e. interleaving two lists but without an "every" option).

---

This is exactly one of the things Riffle does.

list = {1, 2, 3, 4, 5, 6, 7};
every = 4;
Riffle[list, 0, every]
(* {1, 2, 3, 0, 4, 5, 6, 0, 7} *)

Answer 2

Riffle is surely the canonical method since version 6 but there are other approaches:

fn1[lst_, ele_, n_, m_: 1] :=
  Take[
    Join @@ ArrayPad[Partition[lst, n, n, 1], {0, {0, m}}, ele],
    QuotientRemainder[Length @ lst, n].{n + m, 1}
  ]

Test:

fn1[Range@10, "x", 3]
fn1[Range@10, "x", 4, 2]
fn1[Range@10, "x", 5, 3]

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

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

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

Also:

fn1[Range@10, {"a", "b"}, 3, 2]

{1, 2, 3, "a", "b", 4, 5, 6, "a", "b", 7, 8, 9, "a", "b", 10}

Related:

• Is there a way to riffle more than two lists?

Answer 3

Using Fold:

Clear["Global`*"];
list = Range[10];
pos = {2, 5, 9};
Fold[Insert[#1, Style[0, Bold, Red], #2] &, list, pos]

---

OP's specific case:

everyfourthpos = Range[4, Length@list, 4]
Fold[Insert[#1, Style[0, Bold, Red], #2] &, list, everyfourthpos]

Answer 4

ls1 = Range[10];
ls2 = CharacterRange["a", "j"];

---

Positions and replacement:

pos = Table[{Flatten@Position[#1, #1[[k]]], {#3, 
      Extract[#1, {k}]}}, {k, #2, Length@#1, #2 - 1}] &;

Using ReplacePart:

rep1 = {ls1, 4, Style[0, Bold, Red]};

Flatten[ReplacePart[ls1, Thread[#[[All, 1]] -> #[[All, 2]] &@(pos @@ rep1)]]]

rep2 = {ls2, 4, Style["z", Bold, Red]};

Flatten[ReplacePart[ls2, Thread[#[[All, 1]] -> #[[All, 2]] &@(pos @@ rep2)]]]

Answer 5

list = Range[10];

p = {2, 5, 9};

Using RightComposition

list // RightComposition @@ MapThread[Insert, {Table[0, Length[p]], p}]

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

list // RightComposition @@ MapThread[Insert, {{"a", "b"}, {2, 4}}]

{1, "a", 2, "b", 3, 4, 5, 6, 7, 8, 9, 10}

Answer 6

or use Sow and Reap.

{1, 2, 3, 4, 5, 6, 7} // MapIndexed[
(
    Sow[#1];
    If[Mod[First[#2], 3] == 0, Sow[0]]
)&
] // Reap // Last // First

if index % 3 == 0, Sow a 0

Answer 7

By recursive function call:

n=4;
ins0[x_List] := If[Length[x]<n-1, x, Join[x[[;;n-1]], {0}, ins0[x[[n;;]]]]];
  
ins0[{1, 2, 3, 4, 5, 6, 7}]

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

ins0[CharacterRange["a", "p"]]

(* {"a", "b", "c", 0, "d", "e", "f", 0, "g", "h", "i", 0, "j", "k", "l", 0, "m", "n", "o", 0, "p"}