7
$\begingroup$

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"
$\endgroup$
4
  • $\begingroup$ 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++. $\endgroup$ Nov 13, 2013 at 13:19
  • 3
    $\begingroup$ insert doesnt change b, but returns the result, you need to do b=Insert[..] (there are other issues, but thats the immediate one..) $\endgroup$
    – george2079
    Nov 13, 2013 at 13:21
  • $\begingroup$ 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.) $\endgroup$ Nov 13, 2013 at 13:28
  • $\begingroup$ 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. $\endgroup$
    – Wojciech
    Nov 13, 2013 at 13:33

9 Answers 9

9
$\begingroup$

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}}  *)
$\endgroup$
1
  • $\begingroup$ Or Sort@Join[b, Thread[{missing, 1}]] $\endgroup$ Nov 13, 2013 at 21:09
5
$\begingroup$

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

$\endgroup$
2
  • 2
    $\begingroup$ This can simplified to Table[{i, 1}, {i, First @ Last @ b}] /. (Rule[{#[[1]], 1}, #] & /@ b), and its probably a little faster too. $\endgroup$
    – m_goldberg
    Nov 13, 2013 at 14:28
  • $\begingroup$ @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! $\endgroup$ Nov 13, 2013 at 14:53
4
$\begingroup$

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}}  *)
$\endgroup$
3
$\begingroup$

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}} *)
$\endgroup$
3
$\begingroup$

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}}

$\endgroup$
1
$\begingroup$

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} *)
$\endgroup$
1
$\begingroup$
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}}

$\endgroup$
1
$\begingroup$

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}}

$\endgroup$
1
$\begingroup$

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}}*)
$\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.