Re: Deleting Duplicates
- To: mathgroup at smc.vnet.net
- Subject: [mg110123] Re: Deleting Duplicates
- From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
- Date: Wed, 2 Jun 2010 02:07:40 -0400 (EDT)
This method seems to be fairly quick:
test[p_, a_] :==
Position[Complement[a, {p}], {___, Sequence @@ p, ___}, 1, 1] !== {}
DeleteCases[a, _?(test[#, a] &)]
{{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}}
Andrzej Kozlowski
On 1 Jun 2010, at 17:23, Robert Wright wrote:
> 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