Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: Fast List-Selection

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19959] Re: [mg19925] Re: [mg19880] Fast List-Selection
  • From: "Carl K.Woll" <carlw at fermi.phys.washington.edu>
  • Date: Wed, 22 Sep 1999 04:11:30 -0400
  • Organization: Department of Physics
  • References: <1046AA21E07@gauss.cam.wits.ac.za>
  • Sender: owner-wri-mathgroup at wolfram.com

Arnold,

I was thinking about improving the speed of the various algorithms by compiling, and
came up with the algorithm below, which is 10 times faster than my previous version of
your algorithm.

In[120]:=
dif = Compile[{{ls, _Integer, 1}, {n, _Integer}, {m, _Integer}},
      Flatten at Position[Drop[ls, n] - Drop[ls, -n], m]];
rep4[ls_, n_] :=
  SilentCheck[Module[{ss = dif[ls, 1, 0]}, ss[[dif[ss, n - 2, n - 2]]]], {}]

where SilentCheck has the definition

In[129]:=
ClearAll[SilentCheck]
SetAttributes[SilentCheck, {HoldAll}]

SilentCheck::usage =
    "SilentCheck[expr,failexpr] evaluates expr, and returns the result, \
unless messages were generated, in which case it evaluates and returns \
failexpr. SilentCheck suppresses the output of the messages generated in \
evaluating expr.";

SilentCheck[expr_, err_] := Module[{ans, flag},
  Unprotect[Message];
  _Message := Throw[flag, SilentCheck];
  ans = Catch[expr, SilentCheck];
  Clear[Message];
  Protect[Message];
  If[ans === flag, err, ans]
]

SilentCheck is useful here, since if the compiled program fails to find any runs of the
right length, it will produce an error. Normally, once the error occurs, the uncompiled
version will be applied. In this case that is totally unnecessary, since if the compiled
program fails to find any runs we are done. With SilentCheck, the uncompiled version is
never run. The timings of the various versions (defined in my previous post) were as
follows:

In[144]:=
l = Table[Random[Integer, {0, 2}], {100000}];

In[145]:=
r1 = rep1[l, 8]; // Timing
r2 = rep2[l, 8]; // Timing
r3 = rep3[l, 8]; // Timing
r4 = rep4[l, 8]; // Timing
r1 === r2 === r3 === r4

Out[145]=
{3.75 Second, Null}

Out[146]=
{2.171 Second, Null}

Out[147]=
{0.954 Second, Null}

Out[148]=
{0.094 Second, Null}

Out[149]=
True

Carl Woll
Physics Dept
U of Washington

Arnold Knopfmacher wrote:

> Some Timings for Andrzejs functions applied to the list
>
> l=Table[Random[Integer,{0,9}],{100000}];
>
> findsequence[3][l] // Timing
> {3.51 Second,{{32432}}}
>
> findsequence[4][l] // Timing
> {2.58 Second,32432}
>
> findsequence[5][l] // Timing
> {5.27 Second,32432}
>
> Carl Wolls function:
>
> rep[ls_,n_]:=Position[Partition[ls,n,1],{x_ ..}]
>
> rep[l,6]//Timing
> {2.47 Second,{{32432}}}
>
> Rob Pratts function
>
> Consec[l_,n_]:=
>   Flatten[Position[Partition[l,n,1],Table[x_,{n}]]]
>
> Consec[l,6]//Timing
> {2.14 Second,{32432}}
>
> My function  is still faster (at least for this test list and under Mathematica
> 3)
>
> dif[s_]:=Drop[s,1]-Drop[s,-1];
> nconsecB[s_,n_]:=
>   Module[{ss=Flatten[Position[dif[s],0]],ans={}},
>     Do[If[ss[[i+n-2]]-ss[[i]]==n-2,ans={ans,ss[[i]]}],{i,Length[ss]-n+2}];ans]
>
> nconsecB[l,6]//Timing
> {1.81 Second,{32432}}
>
> Perhaps my function can be rewritten in a more elegant form?
>
> Arnold Knopfmacher
> Witwatersrand University
> South Africa
>
> > Date:          Tue, 21 Sep 1999 02:22:54 -0400
> > Subject: [mg19959]       [mg19925] Re: [mg19880] Fast List-Selection
> > From:          "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
To: mathgroup at smc.vnet.net
> > To:            mathgroup at smc.vnet.net
>
> > I have managed to produce four additional examples, three  of which seem to
> > be faster than yours. I will change the search to 6 rather than 7
> > consecutive identical elements because I want to use for my testing a famous
> > example:
> >
> > In[1]:=
> > l = RealDigits[N[Pi, 10000]][[1]];
> >
> > Hear are the functions I will test, beginning with yours:
> >
> > In[2]:=
> > findsequence[1][l_] := Do[If[Count[t = Take[l, {i, i + 5}], t[[1]]] == 6,
> > Print[i]], {i, 1, Length[l] - 5}]
> >
> > In[3]:=
> > findsequence[2][l_] :=
> >   Position[l /. {a___, y_, y_, y_, y_, y_, y_, b___} -> {a, mark, b}, mark,
> > 1]
> >
> > In[4]:=
> > findsequence[3][l_] :=
> >   Module[{m = Split[l], mark},
> >     Position[Flatten[m /. Cases[m, _?(Length[#] == 6 &)][[1]] -> mark],
> > mark,
> >       1]]
> >
> > In[5]:=
> > findsequence[4][l_] :=
> >   Module[{m = Split[l]},
> >     Length[Flatten[
> >           Take[m, Position[m, Select[m, Length[#] == 6 &][[1]]][[1, 1]] -
> >               1]]] + 1]
> >
> > In[6]:=
> > f[x_, x_, x_, x_, x_, x_] := 0;
> > f[y__] := 1;
> > g[l_, i_] := f[Apply[Sequence, Take[l, {i, i + 5}]]];
> > findsequence[5][l_] := Scan[If[g[l, #] == 0, Return[#]] &,
> > Range[Length[l]]];
> >
> > Now the test:
> >
> > In[9]:=
> > Table[findsequence[i][l] // Timing, {i, 1, 5}]
> > 763
> > Out[9]=
> > {{1.38333 Second,
> >     Null}, {2.18333 Second, {{763}}}, {0.783333 Second, {{763}}}, {0.683333
> > Second, 763}, {0.183333 Second, 763}}
> >
> > The last one wins by a big margin The programs using Split may do better on
> > other machines (I am using Mac PowerBook G3 ,233 mghz) because there seems
> > to be something wrong with Split on the Mac where it doesn't scale linearly
> > with the size of the input.
> >
> > Finally: In[10]:=
> > Take[l, {763, 763 + 5}]
> > Out[10]=
> > {9, 9, 9, 9, 9, 9}
> > --
> > Andrzej Kozlowski
> > Toyama International University
> > JAPAN
> > http://sigma.tuins.ac.jp
> > http://eri2.tuins.ac.jp
> >
> >
> > ----------
> > >From: Hans Havermann <haver at total.net>
To: mathgroup at smc.vnet.net
> > To: mathgroup at smc.vnet.net
> > >To: mathgroup at smc.vnet.net
> > >Subject: [mg19959] [mg19925] [mg19880] Fast List-Selection
> > >Date: Mon, Sep 20, 1999, 7:47 AM
> > >
> >
> > > I have a list 's' composed of a large number of (small) integers. I wish to
> > > search this list for instances of 7 consecutive, identical elements.
> > >
> > > My approach is:
> > >
> > > Do[If[Count[t = Take[s, {i, i + 6}], t[[1]]] == 7,
> > >     Print[i]], {i, 1, Length[s] - 6}]
> > >
> > > Can anyone think of a *faster* way of doing this?
> > >
> > >
> > >
> >
> > --
> > Andrzej Kozlowski
> > Toyama International University
> > JAPAN
> > http://sigma.tuins.ac.jp
> > http://eri2.tuins.ac.jp
> >
> >
> > ----------
> > >From: Hans Havermann <haver at total.net>
To: mathgroup at smc.vnet.net
> > To: mathgroup at smc.vnet.net
> > >To: mathgroup at smc.vnet.net
> > >Subject: [mg19959] [mg19925] [mg19880] Fast List-Selection
> > >Date: Sun, 19 Sep 1999 18:47:32 -0400
> > >
> >
> > > I have a list 's' composed of a large number of (small) integers. I wish to
> > > search this list for instances of 7 consecutive, identical elements.
> > >
> > > My approach is:
> > >
> > > Do[If[Count[t = Take[s, {i, i + 6}], t[[1]]] == 7,
> > >     Print[i]], {i, 1, Length[s] - 6}]
> > >
> > > Can anyone think of a *faster* way of doing this?
> > >
> > >
> > >
> >
> >



  • Prev by Date: Re: Plot, Table.
  • Next by Date: Re: Re: Fast List-Selection
  • Previous by thread: Re: Re: Fast List-Selection
  • Next by thread: Re: Re: Fast List-Selection