Prev: problem about calling Mathematica in Fortran
Next: Is it possible to make NIntegrate
From: Ant King on 25 Nov 2009 06:18
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

From: Sjoerd C. de Vries on 25 Nov 2009 23:01
Hi Ant,

I'd say you're rather unkind to tech support. I'm amazed that they
took your question at all. I wouldn't have thought of offloading my
programming tasks to tech support, thinking that these guys would be
for bugs, installation issues etc.

Anyways, would

data2 /. {x___, Longest[Shortest[Repeated[y__, {2, Infinity}]]]} ->
{y}

suffice for you? It returns the smallest repeating subsequence, if
there is any, and otherwise returns the list unevaluated.

It's rather slow for longer lists. For that you should try cutting up
the list in sublists (Partition[data2, 3, 3, {-1, -1}, {}]) and
testing these for equality, and then repeat for all possible sublist
lengths etc. But you require a single function, for some mystical
reason, don't you? I don't think there is any built-in.

Cheers -- Sjoerd

On Nov 25, 1:18 pm, "Ant King" <mathstutor...(a)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


From: Emu on 25 Nov 2009 23:02
On Nov 25, 5:18 am, "Ant King" <mathstutor...(a)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]= {}




From: Andrzej Kozlowski on 25 Nov 2009 23:02
I pasted in the wrong definition of findCycle2 (it was an early attempt
that was clearly wrong but I did not delete it form the notebook where I
was doing these computations. The final variant was more complicated:

findCycle2[ls_] :=
With[{f = FindSequenceFunction[ls]},
f /@ GatherBy[Range[Length[ls]], f][[All, 1]]]

This works in quite many cases, e.g.

lis = {8, 1, 2, 3, 8, 1, 2, 3};

findCycle2[lis]

{8,1,2,3}

but still fails on more complex ones, e.g.

data = {8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 8, 1, 2, 3, 1, 2, 3, 1,
2, 3, 1, 2, 3};

findCycle2[data]

{8,1,2,3}


It might be possible to get something more reliable working along these
lines but since the function provided by the technical support is very
good I do not see the point of pursuing this further. The only reason I
tried was because using FindSequenceFunction here seemed to me like an
interesting idea.

Andrzej Kozlowski

On 26 Nov 2009, at 07:07, Andrzej Kozlowski wrote:

> First of all, I am very surprised that technical support replied to
this at all. I have to considerably upgrade my estimation of them ;-)
Most people, certainly not me, would not think of sending what is
essentially a programming question to technical support. The terms of
Premier Service do include, I think, some kind of programming help (I am
not sure about that - I have Premeir Service but have never thought of
this possibility), but whatever it is, technical support is not the
place one would turn to in such cases.
>
> First of all, I think there is a small error in the function(which
answers the first part of your question) you were sent by technical
support. I think the right definition should have been:
>
> findCycle1[ls_] :=
> Module[{p, a},
> p = Position[
> Table[BitXor[lis, RotateLeft[lis, i]], {i, 1, Length[lis]/2}],
> ConstantArray[0, Length[lis]]][[1]] /. {a_} -> a; ls[[1 ;; p]]]
>
> This is a very good function and I do not think I can find a better
one. There is an interesting and much shorter function that comes to my
mind, but it is not going to be as reliable. Still, it comes as close to
being a "built-in" function for this problem as one can find:
>
> findCycle2[ls_] :=
> With[{f = FindSequenceFunction[ls]}, GatherBy[ls, f][[All, 1]]]
>
> This will work in simple cases, like the one you sent:
>
> lis = Flatten[Join[Table[{1, 2, 3}, {20}]]];
>
> findCycle2[lis]
>
> {1,2,3}
>
> However, one can construct more complicated cases where it fails (and
the one sent by technical support succeeds). One such example will
appear below. But first, let's turn to the second part of your question.
This is much harder and one (but not the only) reason is that it is not
mathematically well defined. Consider the following sequence:
>
> lis =
> Join[{8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3}, {8, 1, 2, 3, 1, 2, 3,
> 1, 2, 3, 1, 2, 3}]
>
> {8,1,2,3,1,2,3,1,2,3,1,2,3,8,1,2,3,1,2,3,1,2,3,1,2,3}
>
>
> What should be the "repeating pattern here"? If we interpret this
question in the first sense the answer is {8, 1, 2, 3, 1, 2, 3, 1, 2, 3,
1, 2, 3}. But your second definition of "cycle" is allowed then one the
answer is ambiguous, it is either {8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2,
3} or simply {1,2,3}. This example confuses my findCycle2
>
> findCycle2[lis]
>
> {8,1,3}
>
> but the technical support function works fine:
>
> findCycle1[lis]
>
> {8,1,2,3,1,2,3,1,2,3,1,2,3}
>
> In order for your second function to be defined you have to give an
unambiguous criterion to use in such cases. One possible answer would be
first be that one should look for cycles by starting with the whole
sequence and then dropping terms from the beginning. It is quite easy to
implement an inefficient version of this just starting with the function
you were sent. I start by modifying findCycle1 to make it return $Fail
whenever there is no cycle. I am really using a hack here (Quiet) and it
should really be done more nicely but I do not want to spend too much
time on this (perhaps someone else will). So, here is a function that
works exactly like findCycle1 but returns $Fail when there is no cycle:
>
> findCycle3[ls_] :=
> Quiet[Module[{u = findCycle1[ls]},
> If[Head[u] === List && u == Take[ls, Length[u]], u,
$Fail]]]
>
> You can check that this works:
>
> ls = Join @@ Table[{1, 2, 3}, {1}];
>
> In[141]:= findCycle3[ls]
>
> $Fail
>
> ls = Join @@ Table[{1, 2, 3}, {2}];
>
> findCycle3[ls]
>
> {1,2,3}
>
> Now once we have got it, it is very easy to construct a function that
will just go through the list looking for cycles, if it doesn't fine one
it will drop the first element and then go through the list again etc. I
programmed it in the procedural way paying no regard to performance. It
can be done better using Sow and Reap, but again I do not want to spend
time doing that; its only meant as an example of how one can do this.
So:
>
> findCycle4[ls_] :=
> Module[{p = ls, q = findCycle3[ls]},
> While[Length[p] > 0,
> If[q =!= $Fail, Return[q], q = findCycle3[p = Rest[p]]]]; q]
>
> Now, this will work in all cases (I think). Here are your two
examples:
>
> data1 = {1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3};
>
> data2 = {5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3};
>
> findCycle4[data1]
>
> {1,2,3}
>
> findCycle4[data2]
>
> {1,2,3}
>
>
> Andrzej Kozlowski
>
>
>
>
>
> On 25 Nov 2009, at 20:14, Ant King 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
>>
>


From: DrMajorBob on 25 Nov 2009 23:04
rule = {___, Shortest[x__], x__} :> {x};
{1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} /. rule
{5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} /. rule

{1, 2, 3}

{1, 2, 3}

You can experiment with Longest, if this doesn't satisfy all your needs.

rule2 = {___, Longest[x__], x__} :> {x};
{1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} /. rule2
{5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} /. rule2

{1, 2, 3, 1, 2, 3}

{1, 2, 3, 1, 2, 3}

Or:

rule2 = {___, Longest[x__], x__} :> {x};
{1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} //. rule2
{5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} //. rule2

{1, 2, 3}

{1, 2, 3}

Bobby

On Wed, 25 Nov 2009 05:14:07 -0600, Ant King <mathstutoring(a)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
>


--
DrMajorBob(a)yahoo.com

 |  Next  |  Last
Pages: 1 2
Prev: problem about calling Mathematica in Fortran
Next: Is it possible to make NIntegrate