Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Re: When Wolfram's technical support cannot help

  • To: mathgroup at smc.vnet.net
  • Subject: [mg105277] Re: When Wolfram's technical support cannot help
  • From: Emu <samuel.thomas.blake at gmail.com>
  • Date: Wed, 25 Nov 2009 23:02:26 -0500 (EST)
  • References: <hej3pj$d77$1@smc.vnet.net>

On Nov 25, 5:18 am, "Ant King" <mathstutor... at ntlworld.com> wrote:
> Hi
>
> I sent this email to technical support (as I hold a premier licence)
>
> I am looking for a single function that will extract the cyclic part of (a)
> a completely cyclic sequence and (b) an eventually cyclic sequence. So if
>
> data1={1,2,3,1,2,3,1,2,3,1,2,3} then cyclicpart[data1] should return {1,2,3}
>
> And if
>
> data2={5,9,11,8,1,2,3,1,2,3,1,2,3,1,2,3} then cyclicpart[data2] should also
> return {1,2,3}
>
> And this was the reply that I got
>
> Here is one way to extract out the cyclic part:
>
> lis = Flatten[Join[Table[{1, 2, 3}, {8}]]]
>
> p = Position[Table[BitXor[lis, RotateLeft[lis, i]], {i, 1, 10}],
>     ConstantArray[0, Length[lis]]][[1]] /. {a_} -> a
> lis[[1 ;; p]]
>
> The above however will only work for case where the list always contains
> the repeated pattern.
>
> There is no built-in function as such that will extract out the pattern
> automatically. I have filed a suggestion with our developers and you will
> be notified when this suggestion gets implemented. Again, my apologies for
> the delay and my thanks for your patience.
>
> Now I don't believe that. I think that it should be quite achievable. Anyone
> got any ideas
>
> Thanks a lot
>
> Ant

I am sure someone will post a really elegant and efficient way of
solving your problem. Until that happens, here's a fairly naive way to
extract the periodic part from a list.

Sam

In[120]:= ExtractPeriodicPart[lst_List] := Block[{diffs, start},
  diffs = SortBy[Select[
     Table[{i, lst - RotateLeft[lst, i]}, {i, Length[lst] - 1}],
     MatchQ[Last[#], {a___, 0 .., b___}] &
     ], Count[Last[#], Except[0]] &];
  If[diffs === {}, Return[{}], diffs = First[diffs]];
  start = Position[Last[diffs], 0, Heads -> False][[1, 1]];
  lst[[start ;; start + First[diffs] - 1]]
  ]

In[121]:= data1 = {1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3}

Out[121]= {1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3}

In[122]:= ExtractPeriodicPart[data1]

Out[122]= {1, 2, 3}

In[123]:= data2 = {5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3}

Out[123]= {5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3}

In[124]:= ExtractPeriodicPart[data2]

Out[124]= {1, 2, 3}

In[125]:= ExtractPeriodicPart[{0, 1, 2, 0, 1, 2, 342, 453, 123, 0, 1,
2, 0, 1, 2}]

Out[125]= {0, 1, 2}

In[126]:= ExtractPeriodicPart[{0, 1, 2, 3, 0, 1, 2, 3, 342, 453, 123,
0, 1, 2, 3, 0, 1, 2, 3, 23, 1231, 4535, 34234}]

Out[126]= {0, 1, 2, 3}

In[127]:= ExtractPeriodicPart[{0, 1, 2342, 453, 123, 23, 1231, 4535,
34234}]

Out[127]= {}





  • Prev by Date: Re: Re: newbie q-n about FinancialData
  • Next by Date: Re: When Wolfram's technical support cannot help
  • Previous by thread: Re: When Wolfram's technical support cannot help
  • Next by thread: Formal Concept Analysis