Re: removing sublist . Again and Different

*To*: mathgroup at smc.vnet.net*Subject*: [mg56350] Re: [mg56305] removing sublist . Again and Different*From*: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>*Date*: Fri, 22 Apr 2005 06:23:45 -0400 (EDT)*Sender*: owner-wri-mathgroup at wolfram.com

>-----Original Message----- >From: giampi1960 [mailto:giampiero1960 at yahoo.com] To: mathgroup at smc.vnet.net >Sent: Thursday, April 21, 2005 11:36 AM >Subject: [mg56350] [mg56305] removing sublist . Again and Different > >hello i read borges2003xx at yahoo.it meassage : > > >>i'm a newbie. How implement the _faster functon_ which removes in a >>list every element that are a subelement. >>which means >>f[x]:= {..,{1,2,3,4},..,{2,3},..} removes {2,3}. >>thanx a lot. >>giorgio borghi > > >i ask your help for faster way to do the opposite >f[x]:= {..,{1,2,3,4},..,{2,3},..} removes {1,2,3,4}. > >best regards > >giampiero > > Giampiero, I'm afraid, I simple cannot understand what you want to attain. Could you please first specify a _slow function_ that does the job? Your example is rather droughty! Alternatively specify what is a "subelement"? Is {3,2} a "subelement" of {1,2,3,4} ? or of {4,3,2,1}? or of {3,4,1,2}? Is the list sorted? Are all "elements" sorted? Are all "elements" ranges of integers? How many "elements" do you have, of what max and everage length, can "element" {} occur? (which might make everything collapse), etc... And above all, you have to specify in which form you want to have the result! And -- if you like -- state your real problem, in case you want to hear of other approaches. This is an attempt by example. (A slow, but not too slow, procedure; its essential kernel should behave as O[n log n], i.e. except for statements like repeated Append-s, ReplaceAll-s which can be avoided.) I also will not forge it into a function, just sketch the idea: I assume the "elements" are ranges of Integers, not empty, but the list is not ordered. This here then should constitute valid test data: In[44]:= xlen = 6; xnum = 20; In[46]:= re := With[{start = Random[Integer, {1, xnum}], len = Random[Integer, {1, xlen}]}, Range[start, start + len]] In[88]:= ll = Table[re, {20}] Out[88]= {{9, 10}, {4, 5, 6, 7, 8, 9, 10}, {20, 21, 22, 23}, {17, 18, 19, 20}, {19, 20}, {4, 5, 6, 7, 8, 9}, {14, 15, 16, 17}, {7, 8, 9, 10, 11, 12}, {3, 4, 5, 6}, {14, 15, 16}, {9, 10, 11}, {15, 16}, {20, 21}, {17, 18}, {13, 14, 15, 16, 17, 18}, {18, 19, 20}, {1, 2, 3, 4, 5}, {7, 8, 9, 10, 11, 12, 13}, {9, 10}, {20, 21}} (Just excuse that silly "20", where it appears again below, it should be replaced by Length[ll].) Now we sort this list according to the order of the last number in each element: In[106]:= ord = Ordering[ll, All, Last[#1] < Last[#2] || Last[#1] == Last[#2] && First[#1] >= First[#2] &] Out[106]= {17, 9, 6, 1, 19, 2, 11, 8, 18, 12, 10, 7, 14, 15, 5, 16, 4, 13, 20, 3} In[107]:= ll2 = ll[[ord]] Out[107]= {{1, 2, 3, 4, 5}, {3, 4, 5, 6}, {4, 5, 6, 7, 8, 9}, {9, 10}, {9, 10}, {4, 5, 6, 7, 8, 9, 10}, {9, 10, 11}, {7, 8, 9, 10, 11, 12}, {7, 8, 9, 10, 11, 12, 13}, {15, 16}, {14, 15, 16}, {14, 15, 16, 17}, {17, 18}, {13, 14, 15, 16, 17, 18}, {19, 20}, {18, 19, 20}, {17, 18, 19, 20}, {20, 21}, {20, 21}, {20, 21, 22, 23}} Now the idea is: if the first number of an "element" following the current "element" is smaller or equal than the first number of this current one, then the "current element is contained" in that element, hence that element should be deleted. We continue such, until the condition is false and then simply advance. So we have only a single linear scan through the list. Let's do it: In[108]:= dpos = {}; For[i = 1, i < Length[ll2], i = j, j = i + 1; While[j <= Length[ll2] && First[ll2[[i]]] >= First[ll2[[j]]] , AppendTo[dpos, {j++}]]] In[110]:= dpos Out[110]= {{5}, {6}, {7}, {8}, {9}, {11}, {12}, {14}, {16}, {17}, {19}, {20}} These are the positions (in sorted list) to be deleted. Let's just mark these "elements" and look at them: In[111]:= zz2 = ReplacePart[ll2, x /@ ll2, dpos, dpos] Out[111]= {{1, 2, 3, 4, 5}, {3, 4, 5, 6}, {4, 5, 6, 7, 8, 9}, {9, 10}, x[{9, 10}], x[{4, 5, 6, 7, 8, 9, 10}], x[{9, 10, 11}], x[{7, 8, 9, 10, 11, 12}], x[{7, 8, 9, 10, 11, 12, 13}], {15, 16}, x[{14, 15, 16}], x[{14, 15, 16, 17}], {17, 18}, x[{13, 14, 15, 16, 17, 18}], {19, 20}, x[{18, 19, 20}], x[{17, 18, 19, 20}], {20, 21}, x[{20, 21}], x[{20, 21, 22, 23}]} In fact, it's easy to see, that those are to be deleted. (I can't however see whether these are all.) Before deleting, we first bring things into original order: In[112]:= dro = Range[20] /. Thread[ord -> Range[20]] Out[112]= {4, 6, 20, 17, 15, 3, 12, 8, 2, 11, 7, 10, 18, 13, 14, 16, 1, 9, 5, 19} This is just the "reversed" ordering. With that we get the elements + marks back into original order: In[114]:= zz2[[dro]] Out[114]= {{9, 10}, x[{4, 5, 6, 7, 8, 9, 10}], x[{20, 21, 22, 23}], x[{17, 18, 19, 20}], {19, 20}, {4, 5, 6, 7, 8, 9}, x[{14, 15, 16, 17}], x[{7, 8, 9, 10, 11, 12}], {3, 4, 5, 6}, x[{14, 15, 16}], x[{9, 10, 11}], {15, 16}, {20, 21}, {17, 18}, x[{13, 14, 15, 16, 17, 18}], x[{18, 19, 20}], {1, 2, 3, 4, 5}, x[{7, 8, 9, 10, 11, 12, 13}], x[{9, 10}], x[{20, 21}]} compare with In[115]:= ll Out[115]= {{9, 10}, {4, 5, 6, 7, 8, 9, 10}, {20, 21, 22, 23}, {17, 18, 19, 20}, {19, 20}, {4, 5, 6, 7, 8, 9}, {14, 15, 16, 17}, {7, 8, 9, 10, 11, 12}, {3, 4, 5, 6}, {14, 15, 16}, {9, 10, 11}, {15, 16}, {20, 21}, {17, 18}, {13, 14, 15, 16, 17, 18}, {18, 19, 20}, {1, 2, 3, 4, 5}, {7, 8, 9, 10, 11, 12, 13}, {9, 10}, {20, 21}} Now we delete: In[116]:= zz2[[dro]] /. x[__] -> Sequence[] Out[116]= {{9, 10}, {19, 20}, {4, 5, 6, 7, 8, 9}, {3, 4, 5, 6}, {15, 16}, {20, 21}, {17,18}, {1, 2, 3, 4, 5}} I can't see any spurious rests: In[117]:= Sort[%, First[#1] < First[#2] &] Out[117]= {{1, 2, 3, 4, 5}, {3, 4, 5, 6}, {4, 5, 6, 7, 8, 9}, {9, 10}, {15, 16}, {17, 18}, {19, 20}, {20, 21}} This of course is not yet production code. I just wanted to show you a way of how to develop an (one) algorithm. BTW, I haven't show that it is correct! -- Hartmut Wolf