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$
  • $\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 '15 at 10:42
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$
  • $\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 '15 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 '15 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 '15 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$
  • $\begingroup$ That's clear solution, thanks. How it would be in case of 3-tuple and considering second element? $\endgroup$ – bosona Apr 8 '15 at 14:26
  • $\begingroup$ Edited the answer to fix a bug and to answer your comment. $\endgroup$ – Gerli Apr 8 '15 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, privacy policy and cookie policy

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