4
$\begingroup$

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?

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ 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? $\endgroup$
    – Coolwater
    Jul 10, 2017 at 14:56
  • 1
    $\begingroup$ @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. $\endgroup$
    – mrz
    Jul 10, 2017 at 15:08

4 Answers 4

Reset to default
2
$\begingroup$

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

Improve this answer
$\endgroup$
1
  • $\begingroup$ 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 $\endgroup$
    – mrz
    Jul 11, 2017 at 12:40
3
$\begingroup$

Use Gather.

Select[Gather[Join[list1, list2], Abs[Last@#1 - Last@#2] < 0.02 &], Length@# == 2 &]
Improve this answer
$\endgroup$
3
  • $\begingroup$ Great solution ... $\endgroup$
    – mrz
    Jul 10, 2017 at 14:40
  • $\begingroup$ Gather, GatherBy, Sort, SortBy, and Select are great tools to manipulate lists. $\endgroup$
    – T.F
    Jul 10, 2017 at 15:15
  • $\begingroup$ 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? $\endgroup$
    – mrz
    Jul 11, 2017 at 12:26
2
$\begingroup$

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

enter image description here

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.