Re: Group and Replace itens sequence in a list
- To: mathgroup at smc.vnet.net
- Subject: [mg127880] Re: Group and Replace itens sequence in a list
- From: Dana DeLouis <dana01 at me.com>
- Date: Wed, 29 Aug 2012 01:14:05 -0400 (EDT)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- Delivered-to: l-mathgroup@wolfram.com
- Delivered-to: mathgroup-newout@smc.vnet.net
- Delivered-to: mathgroup-newsend@smc.vnet.net
Hi. Just an observation on Fred's excellent code.
Just want to post the question on what to do about Overlap. ( ie a,b,a,b,a)
v={1,2,3,a,b,a,4,5,6,a,b,c,7,8,9,a,b,a,10,11,12};
vv=Flatten[Table[v,{500}],1];
// OK when there is no overlap
g[v]
{{1,2,3},{4,5,6,a,b,c,7,8,9},{10,11,12}}
// Error with overlap
g[{a,b,a,b,a,1,2,3}]
Take::take: Cannot take positions 4 through 2 in {a,b,a,b,a,1,2,3}. >>
{{},Take[{a,b,a,b,a,1,2,3},{4,2}],{1,2,3}}
This idea just deletes them all:
Fx[v_List,Patt_List]:=Module[{k,p},
k=Length[Patt];
p=ListConvolve[Patt,v,{-1,1},Null,SameQ,And];
p=Position[p,True];
Do[p=Join[p,p+1],{k-1}];
p=Union[p];
Delete[v,p]
]
// This idea deletes them all
Fx[{a,b,a,b,a,1,2,3},{a,b,a}]
{1,2,3}
// I get the same timing on the larger list:
g[vv]//Timing//First
0.015412
// A negligible speed improvement.
Fx[vv,{a,b,a}]//Timing//First
0.012741
// With same results as your:
Flatten[g[vv]]==Fx[vv,{a,b,a}]
True
= = = = = = = = = =
HTH :>)
Dana DeLouis
Mac & Mathematica 8
= = = = = = = = = =
On Saturday, August 25, 2012 4:26:30 AM UTC-4, Fred Simons wrote:
> Solutions with pattern matching can be very elegant, such as Bob
>
> Hanlon's solution, but also tend to be very slow when the problem is a
>
> little bit larger.
>
>
>
> Here is a solution by finding the position of the triple {a,b,a} and
>
> then taking the parts of the list outside these triples.
>
> g[lst_] := With[{limits=Partition[Flatten[{1,
>
> Position[Partition[lst,3,1], {a,b,a}] /.
>
> {n_Integer}->{n-1,n+3},Length[lst]}],2]}, Take[lst, #]& /@ limits]
>
>
>
> In the following commands f is Bob's function:
>
>
>
> In[4]:= lst={1,2,3,a,b,a,4,5,6,a,b,c,7,8,9,a,b,a,10,11,12} ;
>
> z1=f[lst]; // Timing
>
> z2=g[lst]; // Timing
>
> z1===z2
>
> Out[5]= {0.,Null}
>
> Out[6]= {0.,Null}
>
> Out[7]= True
>
>
>
> Both functions are fast enough. Now we make the list 500 times longer:
>
>
>
> In[12]:= lstt=Flatten[Table[lst, {500}],1];
>
> z1=f[lstt]; // Timing
>
> z2=g[lstt]; // Timing
>
> z1===z2
>
> Out[13]= {5.007632,Null}
>
> Out[14]= {0.015600,Null}
>
> Out[15]= True
>
>
>
> Fred Simons
>
> Eindhoven University of Technology
>
>
>
>
>
> Op 24-8-2012 11:04, Bob Hanlon schreef:
>
> > Clear[f]
>
> >
>
> > f[list_?VectorQ] := Cases[
>
> > (list //. {s___, a, b, a, r___} -> {{s}, {r}}) /.
>
> > {} ->
>
> > Sequence[], _?VectorQ, Infinity]
>
> >
>
> > f[{1, 2, 3, a, b, a, 4, 5, 6, a, b, c, 7, 8, 9, a, b, a, 10, 11, 12}]
>
> >
>
> > {{1, 2, 3}, {4, 5, 6, a, b, c, 7, 8, 9}, {10, 11, 12}}
>
> >
>
> > f[{a, b, a, 1, 2, 3, a, b, a, 4, 5, 6, a, b, c, 7, 8, 9, a, b, a, 10,
>
> > 11, 12}]
>
> >
>
> > {{1, 2, 3}, {4, 5, 6, a, b, c, 7, 8, 9}, {10, 11, 12}}
>
> >
>
> > f[{1, 2, 3, a, b, a, 4, 5, 6, a, b, c, 7, 8, 9, a, b, a, 10, 11, 12,
>
> > a, b, a}]
>
> >
>
> > {{1, 2, 3}, {4, 5, 6, a, b, c, 7, 8, 9}, {10, 11, 12}}
>
> >
>
> > f[{a, b, a, 1, 2, 3, a, b, a, 4, 5, 6, a, b, c, 7, 8, 9, a, b, a, 10,
>
> > 11, 12, a, b, a}]
>
> >
>
> > {{1, 2, 3}, {4, 5, 6, a, b, c, 7, 8, 9}, {10, 11, 12}}
>
> >
>
> >
>
> > Bob Hanlon
>
> >
>
> >
>
> > On Thu, Aug 23, 2012 at 2:52 AM, Murta <rodrigomurtax at gmail.com> wrote:
>
> >> Hi All
>
> >>
>
> >> I have a simple problem that is:
>
> >>
>
> >> l={1,2,3,a,b,a,4,5,6,a,b,c,7,8,9,a,b,a,10,11,12}
>
> >>
>
> >> I want to replace all a,b,a sequence by X to get:
>
> >>
>
> >> l={1,2,3,X,4,5,6,a,b,7,8,9,X,10,11,12}
>
> >>
>
> >> Then I want to group it by X intervals as
>
> >> l={{1,2,3},{4,5,6,a,b,7,8,9},{10,11,12}}
>
> >>
>
> >> If I don't need to put the intermediate X, even better!
>
> >> I think the with pattern, RaplaceAll and DeleteCases I can do It. Some clue?
>
> >> Tks
>
> >> Murta
>
> >>
>
> >>
>
> >>
>
> >
>
> >
>
> > -----
>
> > Geen virus gevonden in dit bericht.
>
> > Gecontroleerd door AVG - www.avg.com
>
> > Versie: 2012.0.2197 / Virusdatabase: 2437/5219 - datum van uitgifte: 08/23/12
>
> >
>
> >
>
> >