MathGroup Archive 2010

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

Search the Archive

Re: Deleting Duplicates

  • To: mathgroup at smc.vnet.net
  • Subject: [mg110246] Re: Deleting Duplicates
  • From: Peter Pein <petsie at dordos.net>
  • Date: Thu, 10 Jun 2010 08:08:04 -0400 (EDT)
  • References: <hu2g1m$l0b$1@smc.vnet.net>

The RotateRight in my solution is superflous but it leads to the same
result as in Andrzeij's answer:

For[i = 1, i <= Length[a], i++; a = RotateLeft[a], 
 If[MemberQ[Complement[First[a], #] & /@ Rest[a], {}], 
  a = Rest[a]]]; RotateRight@a

Peter

 Am Tue, 1 Jun 2010 08:23:18 +0000 (UTC)
schrieb Robert Wright <mathematicauser1 at yahoo.com>:

> 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: Programatically creating delayed
  • Next by Date: Re: difficulty using FindRoot
  • Previous by thread: Re: Deleting Duplicates
  • Next by thread: PDE, laplace, exact, should be simple...