# Synchronize lists

I have two 2d lists:

list1 = Transpose[{{1, 4, 7, 9, 4, 6, 7, 8, 3, 2},
{0.12, 0.19, 0.29, 0.39, 0.51, 0.62, 0.71, 0.80, 0.89, 0.99}}];

(*{{1, 0.12},
{4, 0.19},
{7, 0.29},
{9, 0.39},
{4, 0.51},
{6, 0.62},
{7, 0.71},
{8, 0.8},
{3, 0.89},
{2, 0.99}}*)

list2 = Transpose[{{3, 6, 9, 2, 4, 8, 5, 7, 4, 8},
{0.30, 0.40, 0.51, 0.62, 0.72, 0.79, 0.88, 0.98, 1.09, 1.2}}];

(*{{3, 0.3},
{6, 0.4},
{9, 0.51},
{2, 0.62},
{4, 0.72},
{8, 0.79},
{5, 0.88},
{7, 0.98},
{4, 1.09},
{8, 1.2}}*)


I want to synchronize the two lists according to their second vector content.

The numbers in the second vector are in both lists increasing; the difference between two neighboured values is nearly "constant" in list1[[All,2]] and list2[[All,2]], but slightly varying.

My code:

n = Flatten@Nearest[list1[[All, 2]], list2[[All, 2]]]

(*{0.29, 0.39, 0.51, 0.62, 0.71, 0.8, 0.89, 0.99, 0.99, 0.99}*)

p1 = DeleteDuplicates@Flatten[Position[list1[[All, 2]], #] & /@ n]

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

result1 = list1[[p1]]

(*{{7, 0.29}, {9, 0.39}, {4, 0.51}, {6, 0.62}, {7, 0.71}, {8, 0.8}, {3, 0.89}, {2, 0.99}}*)

result2 = list2[[p1 - Min[p1] + 1]]

{{3, 0.3}, {6, 0.4}, {9, 0.51}, {2, 0.62}, {4, 0.72}, {8, 0.79}, {5, 0.88}, {7, 0.98}}

result = Transpose[{result1, result2}]

(*{{{7, 0.29}, {3, 0.3}},
{{9, 0.39}, {6, 0.4}},
{{4, 0.51}, {9, 0.51}},
{{6, 0.62}, {2, 0.62}},
{{7, 0.71}, {4, 0.72}},
{{8, 0.8}, {8, 0.79}},
{{3, 0.89}, {5, 0.88}},
{{2, 0.99}, {7, 0.98}}}*)


Do you have another solution for this?

• If you use instead list1 = Transpose[{{1, 4, 7, 9, 10, 4, 6, 7, 8, 3, 2}, {0.12, 0.19, 0.29, 0.39, 0.39, 0.51, 0.62, 0.71, 0.80, 0.89, 0.99}}] and list2 = Transpose[{{3, 6, 9, 10, 2, 4, 8, 5, 7, 4, 8}, {0.30, 0.40, 0.40, 0.51, 0.62, 0.72, 0.79, 0.88, 0.98, 1.09, 1.2}}] then the current 4 answer and your code yields 5 different results! Which is correct? Jul 10, 2017 at 14:56
• @Coolwater: The important information is: The numbers in the second vector are in both lists increasing; the difference between two neighboured values is nearly "constant" (see question). In my case the difference is about 0.1.
– mrz
Jul 10, 2017 at 15:08

## 4 Answers

Pass a Rule to Nearest

DeleteDuplicatesBy[Transpose[{Nearest[list1[[All, 2]] -> list1,
list2[[All, 2]], 1][[All, 1]], list2}], First]


{{{7, 0.29}, {3, 0.3}}, {{9, 0.39}, {6, 0.4}}, {{4, 0.51}, {9, 0.51}}, {{6, 0.62}, {2, 0.62}}, {{7, 0.71}, {4, 0.72}}, {{8, 0.8}, {8, 0.79}}, {{3, 0.89}, {5, 0.88}}, {{2, 0.99}, {7, 0.98}}}

• I think I like this solution very much, also because it is extremely fast (see my comment to T.F) and does not need any manual input (-> 0.02). Your code needs 0.4 sec to process my real data drive.google.com/open?id=0B9wKP6yNcpyfcDc3VjZnOUlBNmc (Dimensions[list1]=Dimensions[list2]={49421, 5}) with: DeleteDuplicatesBy[Transpose[{Nearest[list1[[All, 3]] -> list1, list2[[All, 3]], 1][[All, 1]], list2}], First]; // AbsoluteTiming
– mrz
Jul 11, 2017 at 12:40

Use Gather.

Select[Gather[Join[list1, list2], Abs[Last@#1 - Last@#2] < 0.02 &], Length@# == 2 &]

• Great solution ...
– mrz
Jul 10, 2017 at 14:40
• Gather, GatherBy, Sort, SortBy, and Select are great tools to manipulate lists.
– T.F
Jul 10, 2017 at 15:15
• I tested you code with my "real data set" drive.google.com/open?id=0B9wKP6yNcpyfcDc3VjZnOUlBNmc (Dimensions[list1]=Dimensions[list2]={49421, 5}) . The following code Select[Gather[Join[list1, list2], Abs[#1[[3]] - #2[[3]]] < 1000000 &], Length@# == 2 &]; // AbsoluteTiming needs for 1000 lines 3.8 sec, for 2000 lines about 15 sec, for 3000 lines 36 sec, for 4000 lines 61 sec and so on. Unfortunately I am not able to process this way about 50000 lines. What can I do?
– mrz
Jul 11, 2017 at 12:26

we can use FixedPoint with Replace

Cases[FixedPoint[Replace[{p___, {x_, y_}, q___, {w_, z_}, r___} /;
Abs[y - z] < 0.02 :> {p, {{x, y}, {w, z}}, q, r}], Join[list1, list2]],
{{_, _}, {_, _}}]

(* {{{7, 0.29}, {3, 0.3}}, {{9, 0.39}, {6, 0.4}}, {{4, 0.51}, {9,0.51}},
{{6, 0.62}, {2, 0.62}}, {{7, 0.71}, {4, 0.72}}, {{8,0.8}, {8, 0.79}},
{{3, 0.89}, {5, 0.88}}, {{2, 0.99}, {7, 0.98}}} *)

• Thank you for you help. This is the first time that I learned about FixedPoint ...
– mrz
Jul 12, 2017 at 8:48
• @mrz you are very welcome. It is a handy construct. You can use it for expression convergence to a constant state Jul 12, 2017 at 9:12
 Cases[Partition[#, 2]& @ SortBy[Last] @ Join[list1, list2],
{{_, a_}, {_, b_}} /; b - a < 0.02] // MatrixForm


• Thank you for the help. The order of vector 1 and 2 should be exchanged at position 4 and in the last two elements
– mrz
Jul 11, 2017 at 19:05
• Oh yes, now I see - but there is no easy solution within the frame of my answer
– eldo
Jul 11, 2017 at 19:34