# Manipulating a list to insert new elements

I have a list:

b = {{1, 1}, {2, 2}, {3, 3}, {5, 5}, {6, 6}, {8, 8}, {10, 10}};


I want to insert new elements into the list:

ClearAll[n];
n = 1;
While[n < 10,
If[Unequal[n, b[[n, 1]]], Insert[b, n, b[[n, 1]]]]
n++
]


I expect to get this:

b = {{1, 1}, {2, 2}, {3, 3}, {4, 1},{5, 5}, {6, 6}, {7, 1}, {8, 8}, {9, 1}, {10, 10}};


However I get these errors:

Part::partw: "Part 8 of {{1,1},{2,2},{3,3},{5,5},{6,6},{8,8},{10,10}} does not \
exist"
Part::partw: "Part 9 of {{1,1},{2,2},{3,3},{5,5},{6,6},{8,8},{10,10}} does not \
exist"

• Sorry, can't reproduce this. Quit your kernel and try again. You probably have some definition lingering around. BTW, I suppose you wanted a ; before the n++. Nov 13, 2013 at 13:19
• insert doesnt change b, but returns the result, you need to do b=Insert[..]  (there are other issues, but thats the immediate one..) Nov 13, 2013 at 13:21
• George is right. Most of Mathematica's functions do not affect their arguments. There are some exceptions (like AppendTo and Increment), but in most cases Mathematica just returns a result that you then use to update the variable concerned. The description of Insert is terribly confusing/incorrect (Insert[list,elem,n] inserts elem at position n in list.) Nov 13, 2013 at 13:28
• Errors occur because n in b[[n, 1]] means the number of a sublist in a nested list, and b has only 7 sublists, so Mathematica can't find next sublists when You force it to find 10 of them. Nov 13, 2013 at 13:33

For this problem you could first calculate the list of missing elements:

missing = Complement[Range@10, b[[All, 1]]];
(*  {4, 7, 9}  *)


Then Fold the insertions into the list:

Fold[Insert[#1, {#2, 1}, #2] &, b, missing]
(*  {{1, 1}, {2, 2}, {3, 3}, {4, 1}, {5, 5}, {6, 6}, {7, 1}, {8, 8}, {9, 1}, {10, 10}}  *)

• Or Sort@Join[b, Thread[{missing, 1}]] Nov 13, 2013 at 21:09

yet another idea, rule based:

Table[{i, 1}, {i, Max[b[[All, 1]]]}] /. (Rule[{#[[1]], 1}, ##] & /@ b)


note that I create a table of all elements {i,1} first and then replace according to b, based on the first entry of an element in b.

Depending on the list, maybe not the fastest idea...

• This can simplified to Table[{i, 1}, {i, First @ Last @ b}] /. (Rule[{#[[1]], 1}, #] & /@ b), and its probably a little faster too. Nov 13, 2013 at 14:28
• @m_goldberg: thanks - I guess I'll keep it, as I think the difference will be rather small and as nobody mentioned that b is sorted. But thanks for the input! Nov 13, 2013 at 14:53

Modification to Simons method:

after getting the missing elements

missing = Complement[Range@10, b[[All, 1]]];


use Thread and Join

Sort@Join[b, Thread[{missing, 1}]]

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


I'm not sure what the range of possible inputs are, but for this case, here is one way:

b = {{1, 1}, {2, 2}, {3, 3}, {5, 5}, {6, 6}, {8, 8}, {10, 10}};

Module[{n = 0},
b = Nest[If[++n; Unequal[n, #[[n, 1]]], Insert[#, {n, 1}, n], #] &, b, b[[-1, -1]]]
]

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


## TimeSeriesResample

TimeSeriesResample[b, 1, ResamplingMethod -> {"Constant", 1}]


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

Just ReplaceRepeated, Condition and some patterns:

b //. {
pre___,
l : {i_, _}, r : {j_, _},
post___
} /; j != i + 1 :> {pre, l, {i + 1, 1}, r, post}
(* {1, 1}, {2, 2}, {3, 3}, {4, 1}, {5, 5}, {6, 6}, {7, 1}, {8, 8}, {9, 1}, {10, 10} *)

SortBy[Union[b, {#, 1} & /@ Complement[Range[10], First[#] & /@ b]], First]


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

Using the automatic replacement feature of Asssociation:

 KeyValueMap[List] @ <|Thread[Range[10] -> Table[1, 10]], Rule @@@ b|>


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

Another method using GroupBy:

f[b_] := Values[GroupBy[Sort@(Join @@ {b, Outer[PadRight[#, Last@Dimensions[b], 1] &@*List,
Complement[Range[Last@*Last@b], b[[All, 1]]]]}), First, #[[1]] &]]
f[b]

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


An alternative method using SequenceCases and ConsecutiveQ:

ConsecutiveQ = Most[#] == Rest[#] - 1 &;(*By @Kuba*)
f[b_] := Catenate@Riffle[SequenceCases[b[[All, 1]],
x : {_, ___}?ConsecutiveQ :> Transpose@ConstantArray[x, 2]],
Most@Map[{{Last@# + 1, +1}} &, SequenceCases[b[[All, 1]], {_, ___}?ConsecutiveQ]]]
f[b]

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


Or using SequenceCases without using ConsecutiveQ:

f[b_?MatrixQ] := Catenate[Riffle[SequenceCases[#,
a_ /; Times @@ Union[Differences[a]] <= 1 :>
Transpose@Array[a &, 2]], List /@ (PadRight[#, 2, 1] & /@
Complement[Outer[List, Range[Last@#]], Transpose@{#}])]] &@b[[All, 1]]
f[b]

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