From: Nasser M. Abbasi on 25 Nov 2009 23:04 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 May be using the algorithm for finding longest repeated subsequence might help with your second case data2? --Nasser
From: Daniel Lichtblau on 25 Nov 2009 23:54 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 You do not specify clearly what it is you want, or how the code somebody took time and effort to write fails to do what you want. So the readers need to fill in the details. I'll take some guesses. You want a function that finds an ending repeated pattern, regardless of whether it is or is not preceded by a prior pattern. The final pattern must repeat at least twice. In a list such as ll1 = {b,a,b,a,b} the result should be {a,b}. In ll2 = {a,b,a,b,a,b,b,a,b,a,b} it should be {b,a,b,a,b} rather than {a,b}. In ll3 = {b,a,b,a,b,a,b,b,a,b,a,b,a,b} it should be {b,a,b,a,b,a,b} rather than {a,b}, because that is a longer suffix. Or should it be {a,b} because that repeats more times? I will guess the former. What about ll4 = {b,a,b,b,a,b,b,a,b,b,a,b} Should it be {b,a,b,b,a,b} (repeats twice), or {b,a,b} (repeats four times)? This is an underspecified problem. I'm going with the longer list. Can be altered by a recursive call plus a length check. So here is one approach. I will not be surprised if there are better ways, using built-in pattern matching (or related) capabilities. longestRepeat[ll_List] := Module[ {len=Length[ll], n=1, max=0}, While [n<=len/2, If [ll[[len-n+1;;len]] === ll[[len-2*n+1;;len-n]], max=n]; n++]; ll[[len-max+1;;len]] ] The examples: In[59]:= longestRepeat[ll1] Out[59]= {a, b} In[60]:= longestRepeat[ll2] Out[60]= {b, a, b, a, b} In[61]:= longestRepeat[ll3] Out[61]= {b, a, b, a, b, a, b} In[62]:= longestRepeat[ll4] Out[62]= {b, a, b, b, a, b} In[63]:= data2={5,9,11,8,1,2,3,1,2,3,1,2,3,1,2,3} Out[63]= {5, 9, 11, 8, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3} In[64]:= longestRepeat[data2] Out[64]= {1, 2, 3, 1, 2, 3} Daniel Lichtblau Wolfram Research
From: Andrzej Kozlowski on 25 Nov 2009 23:54 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 >
First
|
Prev
|
Pages: 1 2 Prev: problem about calling Mathematica in Fortran Next: Is it possible to make NIntegrate |