2
$\begingroup$

I have a list of reals and I want to check if for every element $i$ there is another element $j$ such that $\lvert{i-j}\rvert \leq x$ where $x$ is some arbitrary value. Each element can only be "paired" to another element once. I want to implement this in the most efficient way as possible rather than using a bunch of For-loops. I have no idea where to begin with this so any all help is appreciated.

(For simplicity's sake, assume that said list always contains an even amount of elements)

Thanks guys!

$\endgroup$
  • 1
    $\begingroup$ Quick experiment, what does list={1,2,7,5,7,4};x=1; Map[Last[#]-First[#]<=x&,Partition[Sort[list],2]] give you when you substitute your data? $\endgroup$ – Bill May 11 '18 at 20:53
  • $\begingroup$ For a random case, it gave me {False, False, True, False, False, False, True, False, False, False, False, False, False, False, False, False, False, False, False, False, False, True, True} $\endgroup$ – Joseph Eck May 11 '18 at 21:00
  • $\begingroup$ @Bill Does that look correct? Also, it looks like that only checks the one element versus another, is that correct? $\endgroup$ – Joseph Eck May 11 '18 at 21:17
  • 1
    $\begingroup$ Yes it checks the smallest element with the next greater element. If close enough the result will be True. And it does that for every subsequent pair. Since you said each element can only be paired once this works through the whole sorted list, one pair at a time. If the distance between each pair is <=x then the result should be a long list of True and if not then there will be one or more False in the list. For your random case, since I know neither the values nor the x then I cannot whether the result was correct or not, but it does tell me most of the points were more than x apart. $\endgroup$ – Bill May 11 '18 at 21:39
  • $\begingroup$ @Bill That’s fantastic! Thank you! $\endgroup$ – Joseph Eck May 11 '18 at 21:41
3
$\begingroup$

Let me generate a list with the properties you request, i.e. that contains pairs of elements each within some tolerance of each other. In this case I am using a tolerance of 0.0005 to generate the list:

data = Join[#, # + 0.005]& @ RandomReal[{100, 10000}, 50];

The idea I propose is the following. I will sort the list, so that each pair of "buddies" should end up close to each other. I then split the list by the difference between elements. Since you said that I can assume that the list is even, if the list fulfills your requisites, then the first two elements should be the first pair of buddies with a gap smaller than $tol$, then there should be a larger gap, which is where the split will happen, etc.

If everything goes according to plan, the original list should end up split into a list of pairs. If any of the new sublists is longer than a pair, then there is at least one number that has more than two buddies, and that contradicts your requirement as I understand it.

So now I check that the length of each sublist is two, getting a list of True and False. I then combine that list with And; only if each value was True will I get True at the end.

Clear[checkListQ]
checkListQ[list_List, tol_Real] :=
 And @@
  Map[
    Length[#] == 2 &,
    Split[Sort[list], Abs[#1 - #2] <= tol &]
  ]

checkListQ[data, 0.006]
(* Out: True *)

This is pretty quick, even on relatively longer lists:

longdata = Join[#, # + 0.005]& @ RandomReal[{100, 10000}, 10000];
First@RepeatedTiming[checkListQ[longdata, 0.006];]

(* Out: 0.0051 *)
$\endgroup$
  • $\begingroup$ Thank you, looks perfect! $\endgroup$ – Joseph Eck May 11 '18 at 22:19
  • $\begingroup$ checkListQ[ConstantArray[1, 10], .1] returns False (it should return True). Perhaps changing Length[#]==2& test to` EvenQ[Length@#]&` woudl fix this issue. $\endgroup$ – kglr May 12 '18 at 0:44
2
$\begingroup$
SeedRandom[1]
data = RandomReal[2, 50];

I think this function checks the condition correctly and returns the pairs if they exists. The function generates the graph with undirected edges between valid pairs vertices (corresponding to data entries) and checks if there is a Hamiltonian path for each connected component and also whether the size of each component is even which must hold.

exists[tol_] := With[{paths = FindHamiltonianPath /@ ConnectedGraphComponents[
                    Join @@ MapThread[Thread@*UndirectedEdge,
                      {Range[Length[data]], Nearest[data -> "Index", data, {∞, tol}]}]]},
                 If[FreeQ[paths, {}] && FreeQ[EvenQ[Length /@ paths], False],
                    Join @@ (Partition[#, 2] & /@ paths), False]]

At least in this case all of the returned pairs differ less than tol:

exists[0.1037]
MinMax[Subtract @@ data[[#]] & /@ exists[0.1038]]

False
{-0.10379312, 0.082294291}

$\endgroup$
  • $\begingroup$ Wow, absolutely fantastic work! Thank you so so much! $\endgroup$ – Joseph Eck May 11 '18 at 21:31
0
$\begingroup$
matchingQ1 = Max[Abs @ BlockMap[Subtract @@ # &, #[[Ordering@#]], 2]] <= #2 &;
matchingQ2 = Module[{lst= #[[Ordering@#]]}, 
  Max[Abs[Subtract[lst[[2 ;; ;; 2]], lst[[;; ;; 2]]]]] <= #2]&

Using MarcoB's data:

{matchingQ1[data, .006], matchingQ2[data, .006]}

{True, True}

$\endgroup$

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.