# How to add some element in a incomplete list

I have two list to process.Their first of each 2D part increasing monotonically and without repetition.

SeedRandom[1]
list1=Sort@Transpose[{RandomSample[Range@9,5],RandomSample[Range@9,5]}]


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

and

SeedRandom[2]
list2=Sort@Transpose[{RandomSample[Range@9,5],RandomSample[Range@9,5]}]


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

I want to inset some 2-dimension(such as $\{n,n\}$) list into place when the first element is incomplete.Like the two place where I have highlight it with red arrow

This is my solution for this

addElement[list_List] := Module[{pre},
pre = Array[{#, #} &, Max[First /@ list]];
Union[list,
Complement[pre, list, SameTest -> (Equal @@ First /@ {##} &)]]]


But I couldn't bear this ugly code.Can any elegant method do this?

• Are the lists always sorted like this, with the first of each 2D part increasing monotonically? Commented Jun 3, 2016 at 20:45
• @MariusLadegårdMeyer Actually this is this post's permutations,I will show I how to get this test list in my later edit.
– yode
Commented Jun 3, 2016 at 20:48
• With[{c = Complement[Range[1, #[[-1, 1]]], #[[All, 1]]]}, Union[#, Transpose[{c, c}]]] & does what I think you're after, and much more quickly.
– ciao
Commented Jun 3, 2016 at 21:03
• @ciao Look nice than me.Could you post it as an a solution?
– yode
Commented Jun 3, 2016 at 21:09

Per request, from the comment, this appears to do what you're after, much more quickly for large cases:

 With[{c = Complement[Range[1, #[[-1, 1]]], #[[All, 1]]]}, Union[#, Transpose[{c, c}]]] &


This appears faster yet:

Module[{a, b}, a = b = Range[1, #[[-1, 1]]];
b[[#[[All, 1]]]] = #[[All, 2]]; Transpose[{a, b}]] &

• @Mr.Wizard - good catch, fixed for purity and essence...
– ciao
Commented Jun 3, 2016 at 23:44
• The last method is wonderful
– yode
Commented Jun 4, 2016 at 1:03

If your lists are not going to be very long, pure pattern stuff is easy to read:

addElems[list_List] :=
list //. {
{x___, s1 : {n1_, _}, s2 : {n2_, _}, y___} /;
n2 - n1 != 1 :> {x, s1, {n1, n1} + 1, s2, y},
{s : {n1_, _}, y___} /; n1 > 1 :> {{n1, n1} - 1, s, y}
}


This is going to be very slow if the lists get long, but I thought it was more "elegant", as you asked for.

addElems2[list_List] := With[{ns = list[[All,1]]},
ReplacePart[Table[{i, i}, {i, Last@ns}], Thread[ns -> list]]
]

• Thanks a lot.It seem the pattern is my Achilles'heel. :)
– yode
Commented Jun 3, 2016 at 21:13
• +1 on the second, pretty efficient (first is pretty, but as you noted, BlankNullSequence is a killer...)