MathGroup Archive 2003

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

Search the Archive

Re: Need a nice way to do this

  • To: mathgroup at smc.vnet.net
  • Subject: [mg40470] Re: Need a nice way to do this
  • From: "Dana DeLouis" <delouis at bellsouth.net>
  • Date: Mon, 7 Apr 2003 04:53:53 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Hello.  I'm too new at this to contribute much.
I modified Andrzej's second code slightly for two variables.  I seem to get
a 30% speed increase with the following idea.
 
f3[s_List] := Module[
{v, t}, 
v = Length /@ Split[s]; 
t = Transpose[Partition[v, 2, 2, {1, 1}, 0]]; 
t = (FoldList[Plus, 0, #1] & ) /@ t; 
t = Take[Rest[Flatten[Transpose[t]]], Length[v]]; 
Flatten[MapThread[Table[#1, {#2}] & , {t, v}]]
]
 
-- 
Dana DeLouis 
Windows XP
$VersionNumber -> 4.2
= = = = = = = = = = = = = = = = = 
 
 
"Andrzej Kozlowski" <akoz at mimuw.edu.pl> wrote in message
news:b66cb8$fr7$1 at smc.vnet.net...
> Here is one (nice?) way of doing this  that does not depend on how many 
> different values s contains:
> 
> f1[s_List] := MapIndexed[Length[DeleteCases[Take[s, First[#2]], #1]] &, 
> s]
> 
> and here is another one that works only (as it stands) with just two 
> distinct values:
> 
> f2[l_List] := Module[{mult =
>     Length /@ Split[l], list1,
>          list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], 
> {i, 1,
>         Length[mult],
>      2}]]]; list2 =
>        FoldList[Plus,
>           0, Table[mult[[i]], {i, 2, 2(
>            Floor[(Length[mult] + 1)/2]) - 1, 2}]];
>              values = Take[Flatten[Transpose[{list2,
>                list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], 
> {
>          mult[[i]]}], {i, 1, Length[mult]}]]]
> 
> 
> The second function is a lot more complex and may not satisfy your 
> criteria of "niceness" but it is also a lot more efficient.
> 
> Let's first make sure they both work correctly with your original s:
> 
> In[3]:=
> s={a,b,b,a,a,a,b,a,b,a,a};
> 
> In[4]:=
> f1[s]
> 
> Out[4]=
> {0,1,1,2,2,2,4,3,5,4,4}
> 
> In[5]:=
> f2[s]
> 
> Out[5]=
> {0,1,1,2,2,2,4,3,5,4,4}
> 
> Now let's try something bigger:
> 
> In[6]:=
> s=Table[If[Random[Integer]==1,a,b],{10^3}];
> 
> In[7]:=
> a=f1[s];//Timing
> 
> Out[7]=
> {1.37 Second,Null}
> 
> In[8]:=
> b=f2[s];//Timing
> 
> Out[8]=
> {0.04 Second,Null}
> 
> In[9]:=
> a==b
> 
> Out[9]=
> True
> 
> So "niceness" doesn't always pays, it seems.
> 
> 
> Andrzej Kozlowski
> Yokohama, Japan
> http://www.mimuw.edu.pl/~akoz/
> http://platon.c.u-tokyo.ac.jp/andrzej/
> 
> On Saturday, March 29, 2003, at 07:19  pm, Steve Gray wrote:
> 
> > Given a list consisting of only two distinct values, such as
> > s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length
> > g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position
> > 1<=p<=Length[s], look at list s and set g[[p]] to the number of
> > elements in s to the left of p which are not equal to s[[p]].
> > In a more general version, which I do  not need now, s would
> > not be restricted to only two distinct values.
> >
> > Thank you for any ideas, including other applications where
> > this particular calculation is used. The current application is an
> > unusual conjecture in geometry.



  • Prev by Date: Re: Re: Combinatorical efficiency
  • Next by Date: arrows at both ends of a line?
  • Previous by thread: Re: Re: Need a nice way to do this
  • Next by thread: Re: Re: Need a nice way to do this