Deleting Duplicates
in [Mathematica]
|
Prev: Colored wire ContourPlot3d
Next: Graphics3D question
From: Robert Wright on 1 Jun 2010 04:23 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
From: Raffy on 1 Jun 2010 07:40 On Jun 1, 1:23 am, Robert Wright <mathematicaus...(a)yahoo.com> 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, x1 1}, {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 I'm not exactly sure if I understand your criteria, but this seems to work (although inefficient): m=ToExpression(a)StringReplace["{{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}}","x"->""]; q=SortBy[GatherBy[m,Length],-Length[#[[1,1]]]&]; v=Union(a)Flatten[q]; Do[ u=Append[Take[q,i-1],q[[i,x]]]; If[Union(a)Flatten[u]===v,Return[Join@@u]];, {i,Length[q]}, {x,Subsets[Range(a)Length[q[[i]]],{1,Infinity}]} ]//TableForm
From: Patrick Scheibe on 1 Jun 2010 07:41 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 >
From: Andrzej Kozlowski on 2 Jun 2010 02:07 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
From: Simon on 2 Jun 2010 02:07
Hi Robert, I think that the simplest solution would be something like a //. {aa___, {x__}, bb___, {y__}, cc___} /; Complement[{x}, {y}] == {} :> {aa, bb, {y}, cc} Simon On Jun 1, 4:23 pm, Robert Wright <mathematicaus...(a)yahoo.com> 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, x1 1}, {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 |