Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2010

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Deleting Duplicates

  • To: mathgroup at smc.vnet.net
  • Subject: [mg110098] Re: Deleting Duplicates
  • From: Patrick Scheibe <pscheibe at trm.uni-leipzig.de>
  • Date: Tue, 1 Jun 2010 07:41:26 -0400 (EDT)

Hi,

start with the first element x, test whether it is contained in one the
the others. If yes, start again with the rest of the list, if not then
prepend x to the output of doing the same with the rest of the list.

deleteDup[{fst_List, r__List}] :=
   If[
    Or @@ ((SameQ @@ (Sort /@ {Intersection[fst, #], fst})) & /@ {r}),
    deleteDup[{r}],
    Prepend[deleteDup[{r}], fst]
    ];
deleteDup[{elm_}] := {elm}

In[106]:= deleteDup[a]
Out[106]= {{x1, x2, x3, x13, x18}, {x1, x2, x7, x12, x15}, {x1, x4,  
x5, x9, x16}, {x1,
   x2, x7, x12, x14, x18}, {x1, x4, x5, x9, x11, x17}, {x1, x4, x6,  
x8, x10,
   x17}}

Cheers
Patrick

Am Jun 1, 2010 um 10:23 AM schrieb Robert Wright:

> I have a list 'a' in which there are 'sets', and I want to reduce  
> the list so that repeated patterns are eliminated.
>
> Here is an example list:
>
> a = {{x1, x2}, {x1, x4}, {x2, x3}, {x4, x5}, {x4, x6}, {x2, x7}, {x7,
>   x12}, {x3, x13}, {x13, x18}, {x6, x8}, {x5, x9}, {x9, x11}, {x9,  
> x16}, {x8,
>    x10}, {x12, x14}, {x12, x15}, {x10, x17}, {x11, x17}, {x14, x18},  
> {x1, x2,
>    x3}, {x1, x4, x5}, {x1, x4, x6}, {x1, x2, x7}, {x4, x6, x8}, {x4,  
> x5,
>   x9}, {x2, x7, x12}, {x2, x3, x13}, {x7, x12, x14}, {x5, x9, x16},  
> {x9, x11,
>    x17}, {x8, x10, x17}, {x12, x14, x18}, {x1, x4, x6, x8}, {x1, x4,  
> x5,
>   x9}, {x1, x2, x7, x12}, {x1, x2, x3, x13}, {x4, x5, x9, x11}, {x4,  
> x6, x8,
>   x10}, {x2, x7, x12, x14}, {x7, x12, x14, x18}, {x1, x4, x5, x9,  
> x11}, {x1,
>   x4, x6, x8, x10}, {x1, x2, x7, x12, x14}, {x1, x2, x3, x13, x18},  
> {x1, x2,
>   x7, x12, x15}, {x1, x4, x5, x9, x16}, {x1, x2, x7, x12, x14, x18},  
> {x1, x4,
>    x5, x9, x11, x17}, {x1, x4, x6, x8, x10, x17}}
>
>
>
> The idea is to start with the first element, in this case  {x1, x2},  
> and see if it appears at the start of a subsequent sublist. So for  
> example, because it appears in  {x1, x2, x7, x12, x15}, and  
> elsewhere, we can delete it. The process should be repeated until we  
> get to the fundamental lists which contain all the sublists. In this  
> case, the result should be:
>
> {
> {x1, x2, x3, x13, x18},
> {x1, x2, x7, x12, x15},
> {x1, x4, x5, x9, x16},
> {x1, x2, x7, x12, x14, x18},
> {x1, x4, x5, x9, x11, x17},
> {x1, x4, x6, x8, x10, x17}
> }
>
> I have tried to use DeleteDuplicates and FixedPoint as shown below,  
> but I end up with an empty list!!
>
>
> myDeleteDuplicates[allPaths_] :=
> Module[{duplicates},
>  duplicates =
>   DeleteDuplicates[ allPaths, (#2[[1 ;; Length[#1]]] === #1) &];
>  Complement[allPaths, duplicates]
>  ]
>
> FixedPoint[myDeleteDuplicates, a]
>
> Help appreciated
>
> Robert
>



  • Prev by Date: Re: Colored wire ContourPlot3d
  • Next by Date: Re: Assigning values to a list.
  • Previous by thread: Re: Colored wire ContourPlot3d
  • Next by thread: Re: Deleting Duplicates