2
$\begingroup$

Having a list of 2-tuples, I would like to delete such 2-tuples that have 0 at second position, but only those, whose first element is not unique in the list. E.g. leave

{-2053.5150, -2053.46}, {-802.7016, 0}

but delete

{-2053.5150, 0}

I am using command

DeleteDuplicates[list, (Second[#] == 0 & && SameQ[First[#1], First[#2]] &)]

but returns the same input. Any suggestions ? Here's a sample list

list = {{-2053.5150, 0}, {-2053.5150, -2053.46}, {-2012.7445, 0}, {-1297.0270, 0},
     {-1297.0270, -1297.09}, {-1296.0551, 0}, {-1296.0551, -1296.08}, {-802.7016, 0},
     {-760.9591, 0}, {-757.1460, 0}, {-715.4035, 0}, {-44.5266, 0}, {-44.5266, -44.498},
     {-41.8274, 0}, {-41.8274, -41.456}, {-41.4285, 0}, {-41.4285, -41.456}, {-1.0569, 0},
     {-1.0569, -1.031}, {0.3139, 0}, {0.3139, 0.309}, {0.3140, 0}, {0.3140, 0.309}, {1.0289, 0},
     {1.0289, 1.054}, {1.0290, 0}, {1.0290, 1.054}, {39.7136, 0}, {39.7136, 39.736}, {42.0564, 0},
     {42.0564, 42.055}, {1295.3121, 0}, {1295.3121, 1295.36}, {1296.2841, 0},
     {1296.2841, 1296.3}, {1337.0546, 0}, {2053.4871, 0}, {2053.4871, 2053.48}}
$\endgroup$
1
  • $\begingroup$ Hi ! Your list is clearly inconsistent. Check it near the end and read in the documentation about proper code formatting guidelines. $\endgroup$
    – Sektor
    Apr 8, 2015 at 10:42

3 Answers 3

2
$\begingroup$
list = {{-2053.5150, 0}, {-2053.5150, -2053.46}, {-2012.7445, 
   0}, {-1297.0270, 0}, {-1297.0270, -1297.09}, {-1296.0551, 
   0}, {-1296.0551, -1296.08}, {-802.7016, 0}, {-760.9591, 
   0}, {-757.1460, 0}, {-715.4035, 0}, {-44.5266, 
   0}, {-44.5266, -44.498}, {-41.8274, 
   0}, {-41.8274, -41.456}, {-41.4285, 
   0}, {-41.4285, -41.456}, {-1.0569, 0}, {-1.0569, -1.031}, {0.3139, 
   0}, {0.3139, 0.309}, {0.3140, 0}, {0.3140, 0.309}, {1.0289, 
   0}, {1.0289, 1.054}, {1.0290, 0}, {1.0290, 1.054}, {39.7136, 
   0}, {39.7136, 39.736}, {42.0564, 0}, {42.0564, 
   42.055}, {12 {-2053.5150, 0}, 95.3121, 0}, {1295.3121, 
   1295.36}, {1296.2841, 0}, {1296.2841, 1296.3}, {1337.0546, 
   0}, {2053.4871, 0}, {2053.4871, 2053.48}}

If order does not matter:

Join @@ (If[Length[#] > 1, DeleteCases[#, {_, 0}], #] & /@ 
   GatherBy[list, First])

yields:

{{-2053.52, -2053.46}, {-2012.74, 
  0}, {-1297.03, -1297.09}, {-1296.06, -1296.08}, {-802.702, 
  0}, {-760.959, 0}, {-757.146, 0}, {-715.404, 
  0}, {-44.5266, -44.498}, {-41.8274, -41.456}, {-41.4285, -41.456}, \
{-1.0569, -1.031}, {0.3139, 0.309}, {0.314, 0.309}, {1.0289, 
  1.054}, {1.029, 1.054}, {39.7136, 39.736}, {42.0564, 
  42.055}, {{-24642.2, 0}, 95.3121, 0}, {1295.31, 1295.36}, {1296.28, 
  1296.3}, {1337.05, 0}, {2053.49, 2053.48}}
$\endgroup$
3
  • $\begingroup$ For this to work the list should start out free of duplicates. If it is not apply DeleteDuplicates before GatherBy. +1 $\endgroup$
    – Mr.Wizard
    Apr 8, 2015 at 14:58
  • $\begingroup$ @Mr.Wizard...you are right, of course, I will amend or delete when time permits, as works for special case, as you refer to and not general case...time poor working 12 hour days at present... $\endgroup$
    – ubpdqn
    Apr 8, 2015 at 20:04
  • $\begingroup$ @Mr.Wizard...I guess also I was not sure, tiredness perhaps, that 'duplicates' were only the ones specified by criteria or same elements Or repeated first element and second element zero...though I agree latter seems more natural...either way very glad your comment explicit $\endgroup$
    – ubpdqn
    Apr 8, 2015 at 20:10
1
$\begingroup$

From the details section of the documentation page, it says that

DeleteDuplicates[list] deletes all but the first occurrence of each distinct element that appears in list.

So, to make sure that the tuples with 0-s are deleted, we have to sort the list first. Also, Second is not a built-in function so using Last here instead:

DeleteDuplicates[SortBy[list, -Abs[#] &], (Last[#2] == 0 && First[#1] == First[#2]) &]

You can also use Part instead of Last - this then works with any $n$-tuple where $n \geq 2$:

DeleteDuplicates[SortBy[list, -Abs[#] &], (#2[[2]] == 0 && First[#1] == First[#2]) &]

Notice that with two conditions the test has to be of the form (test1[##] && test2[##])&.

$\endgroup$
2
  • $\begingroup$ That's clear solution, thanks. How it would be in case of 3-tuple and considering second element? $\endgroup$
    – bosona
    Apr 8, 2015 at 14:26
  • $\begingroup$ Edited the answer to fix a bug and to answer your comment. $\endgroup$
    – Gerli
    Apr 8, 2015 at 14:42
1
$\begingroup$

Here's a generalized function:

delDupeOnZeroes[list_, zerpos_, distpos_, any_: False] :=
 Module[{up = Union@Flatten@{distpos}, r = Range@Length@list, zp = zerpos, p, gb, jgb, patt},

  If[any,

   p = Cases[Tally[list[[All, #]]], {val_, num_ /; num > 1} :> val] & /@ up;
   If[Flatten@p === {}, Return[list, Module]];
   patt = MapThread[ReplacePart[ConstantArray[_, Length@list[[1]]],
                        {zp -> 0, #1 -> Alternatives @@ #2}] &, {up, p}];
   DeleteCases[list, Alternatives @@ patt],

   gb = GatherBy[list, #[[up]] &];
   jgb = Join @@ Pick[gb, Unitize[Subtract[Length /@ gb, 1]], 1];
   DeleteCases[list, Alternatives @@ (DeleteDuplicates@
                     Pick[jgb, Unitize@jgb[[All, zp]], 0])]]];

Use:

Arguments are the target list, position to look for zeroes in sublists, element position(s) to be tested for distinctness, and whether test for distinctness is conjunctive or disjunctive.

Using your example list:

delDupeOnZeroes[list, 2, 1]

(*
{{-2053.52, -2053.46}, {-2012.74,0}, {-1297.03, -1297.09}, {-1296.06, -1296.08}, 
 {-802.702, 0}, {-760.959, 0}, {-757.146, 0}, {-715.404, 0}, {-44.5266, -44.498}, 
 {-41.8274, -41.456}, {-41.4285, -41.456}, {-1.0569, -1.031}, {0.3139, 0.309}, 
 {0.314, 0.309}, {1.0289,1.054}, {1.029, 1.054}, {39.7136, 39.736}, {42.0564,42.055},
 {1295.31, 1295.36}, {1296.28, 1296.3}, {1337.05, 0}, {2053.49, 2053.48}}

*)

Note, this keeps the order of the original list intact, and considers both 0 and 0. as zeroes (if your list has inexact zeroes where you're looking for them, solutions that do not account for that will fail.)

More complex use cases:

list = {{1, 2, 5}, {1, 0, 1}, {2, 2, 3}, {0, 0, 0}, {1, 1, 1}, {2, 0,1}, {7, 0, 5}};

(* look for 0 in slot 3, drop if any list matches in first pos.*)
delDupeOnZeroes[list, 3, 1]
(* {{1, 2, 5}, {1, 0, 1}, {2, 2, 3}, {0, 0, 0}, {1, 1, 1}, {2, 0, 1}, {7, 0, 5}} *)

 (* look for 0 in slot 2, drop if any list matches in first pos.*)
delDupeOnZeroes[list, 2, 1]
(* {{1, 2, 5}, {2, 2, 3}, {0, 0, 0}, {1, 1, 1}, {7, 0, 5}} *)

(* look for 0 in slot 2, drop if any list matches in *both* first and third pos.*)
delDupeOnZeroes[list, 2, {1, 3}]
(* {{1, 2, 5}, {2, 2, 3}, {0, 0, 0}, {1, 1, 1}, {2, 0, 1}, {7, 0, 5}} *)

(* look for 0 in slot 3, drop if any list matches in *either* first *or* third pos..*)
delDupeOnZeroes[list, 2, {1, 3}, True]
(* {{1, 2, 5}, {2, 2, 3}, {0, 0, 0}, {1, 1, 1}} *)
$\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.