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