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]= {}