# Research positions of lists of varying size

I'm new to the site and I am French, so I ask your indulgence for my future mistakes in English.

I would like to optimise the following code :

Proc1V1[x_] :=
Block[
{ListO = x, F°1B1, F°1B1oneseq, F°2B1, F°2B1oneseq, F°3B1, F°4B1, F°1B2,
Res1V1},

F°1B1 = Table[
Partition[ListO, j, 1],
{j, 1, Length[ListO], 1}
];

F°1B1oneseq = Partition[ListO, 1, 1];

F°2B1 = Sort[
Tally [
Flatten[F°1B1, 1]
],
#1 [[2]] > #2 [[2]] &
];

F°2B1oneseq = Tally[F°1B1oneseq][[All, 1]];

F°3B1 = Sort[
F°2B1 [[1 ;; (Position[F°2B1[[All, 2]], 1][[1, 1]])-1]][[All, 1]],
Length[#1] > Length[#2] &
];

F°4B1 = Join[
TakeWhile[F°3B1, Length[#] > 1 &],
F°2B1oneseq
];

F°1B2 = Table[
Position[ F°1B1[[ Length[ F°4B1 [[i]]] ]],F°4B1 [[i]]],
{i, 1, Length[F°4B1], 1}
];

Res1V1 = {F°1B2, F°4B1}
];


After applying AbsoluteTiming on the different steps of my algorithm, F°1B2 appeared to be the longest step in the calculation. So I focus on it. The algorithm acting at F°1B2 is responsible for determining the positions of the various lists of numbers stored in F°4B1 and contained in F°1B1. It may be noted here that ListO is a simple list of integers or reals.

For example:

ListO = {1, 2, 3, 4, 5, 6, 7}


I've tried using Compile but this does not work if it has to deal with lists of different size.

I know that finding an alternative to the Position is a recurring topic on StackExchange but I have yet to find a reliable solution to replace F°1B2 by a faster algorithm, especially because Proc1V1 is the first algorithm to a broader set and therefore it is difficult to change the structure of the data it produces.

Edit n°1

To better understand my project, I will give an overview of the context. My goal is to make an algorithm to detect and store the sequences detected in an ordered list of number (Real or Integer number). To start, I got used to test my code with :

ListTest= IntegerPart [ RandomReal [ 10,50 ] ] ;

Therefore, Proc1V1 must detect the different sequences contained inside ListTest. It is important to note here that a set of numbers will be considered as a sequence, if it appears at least twice in ListTest and if it is length is greater than 1. To do this (it’s probably perfectible but I have not found better yet), the algorithm I did create partitions of different lengths in the starting list ListTest. These partitions are compared and sorted at F°2B1. All other operations are responsible for ensuring that the definition of the sequences as I defined above is respected.

If all operations are relatively fast, the operation performed under F°1B2 turns long . For the rest of the algorithms which I wrote it, I need that Proc1V1 provide me the positions of these sequences inside F1B2 and obviously the sequences identified.

Final Edit

Tested functions

Proc1V1 : see above.

Proc1V1alt1[list_]:= {#[[1,2]],#[[All,1]]}&/@ ReplaceList[list,{a___,x__,___}:>{Length@{a}+1, {x}}]~GatherBy~Last~Cases~{_,__};

Proc1V1alt2[list_]:= {#[[1,2]],#[[All,1]]}&/@ (Join@@Table[{i,list[[i;;j]]},{i,Length[list]}, {j,i,Length[list]}])~GatherBy~Last~Cases~{_,__};

Proc1V1alt3[list_]:= Block[ {bigL=list,z1,z2,z3,z4,z5,z6,z7,minlength}, minlength=1; z1=Flatten[Position[#,True]]& /@Rest@ListCorrelate[bigL,bigL,1,x,SameQ,List]; z2=Split[#,(#1+1===#2)&]&/@z1; z3=DeleteCases[z2,q_List/;Length[q]<minlength,{2}]; z4=DeleteCases[MapIndexed[w[#2,#1]&,z3],w[_,{}]]; z5=Flatten[z4/.w[{u_},q_List]:>Map[w[bigL[[#]],First[#]+{0,u}]&,q]]; z6=Split[Sort[z5],First[#1]===First[#2]&]; z7={#[[1,1]],Union@@(Last/@#)}&/@z6 ];

Proc1V1alt4: See Rasher's post.

With :

Proc1V1 : personal function.
Proc1V1alt1 : Mr Wizard's function n°1.
Proc1V1alt2: Mr Wizard's function n°2.
Proc1V1alt3 : Wouter's function.
Proc1V1alt4 : Rasher's function

Test code

ValeurPerfTemps= Table[ AbsoluteTiming[ func[IntegerPart[RandomReal[10,i]]] ][[1]], {i,50,500,1} ];

ListLinePlot[ValeurPerfTemps]

Result

Conclusion

In the context of my original question, the function n°2 of Mr. Wizard is the most suitable. Nevertheless, it is important to note that my function Proc1V1 takes place in a set of algorithm, and some of which are specifically dedicated to the elimination of sequences "encapsulated" (ex : 123 is contained in 11234). Actually I will use Rasher's function, which is very fast.

Thank you all for your help.

Benchmark

On my computer :
Proc1V1[{3, 0, 1, 0, 3, 2, 2, 0, 3, 0, 1, 3, 0, 2, 3, 3, 0, 0, 1, 2}]
give
{{{{1}, {9}}, {{4}, {8}}, {{2}, {10}, {18}}, {{1}, {9}, {12}, {16}}, \ {{1}, {5}, {9}, {12}, {15}, {16}}, {{2}, {4}, {8}, {10}, {13}, {17}, \ {18}}, {{3}, {11}, {19}}, {{6}, {7}, {14}, {20}}}, {{3, 0, 1}, {0, 3}, {0, 1}, {3, 0}, {3}, {0}, {1}, {2}}}

-
Doedalos, welcome to mathematica.stackexchange.com! Don't worry about language, I think you are quite understandable, although F°1B2 is a pretty wild variable name ;). I think this is a pretty decent first question, but still I would encourage you to practise formatting your question. Please see the edit that is suggested (and will probably be approved). –  Jacob Akkerboom Apr 3 '14 at 12:47
Actually the code is still not formatted very nicely, I will try to improve it. –  Jacob Akkerboom Apr 3 '14 at 12:51
Could you explain a little more about what you're trying to accomplish with this code? As it is, your example for ListO returns a list of empty lists, and there are a lot of error messages along the way. A working example with the desired output can help a lot in a case like this. –  Pillsy Apr 3 '14 at 13:11
I wonder why F°1B2 = Table[Position[F°1B1[[Length[F°4B1[[i]], F°4B1[[i]]], {j, 1, Length[F°4B1], 1}]; isn't F°1B2 = Table[Position[F°1B1[[Length[F°4B1[[i]], F°4B1[[i]]], {i, Length[F°4B1]}];. The main point being about the discrepancy between i and j, not so much about the unneeded elements in the iteration control list. –  m_goldberg Apr 3 '14 at 13:36
If I understand the query correctly, you want a list of repeats of any sequence and the positions? If so, comment, I'll post some old code that can do this in a few hundredths of a second (on a netbook, so a few thousandths on a real machine) for your 400 length list example. If that's not the question and I misunderstood it, never mind ;-) –  ciao Apr 30 '14 at 8:16

I didn't read all of your question so I may misunderstand, but based on the example at the bottom I believe your operation is equivalent to this:

sspos[list_] := {#[[1, 2]], #[[All, 1]]} & /@
ReplaceList[list, {a___, x__, ___} :> {Length@{a} + 1, {x}}
] ~GatherBy~ Last ~Cases~ {_, __};

test = {3, 0, 1, 0, 3, 2, 2, 0, 3, 0, 1, 3, 0, 2, 3, 3, 0, 0, 1, 2};

sspos[test] // Grid

{3}      {1,5,9,12,15,16}
{3,0}    {1,9,12,16}
{3,0,1}  {1,9}
{0}      {2,4,8,10,13,17,18}
{0,1}    {2,10,18}
{1}      {3,11,19}
{0,3}    {4,8}
{2}      {6,7,14,20}


Can you confirm that this works as you desire? If so I will explain it, and also seek to improve it. If not I'll try again.

I waited to add an explanation of the code above because I was trying to figure out a more efficient approach that would make it obsolete, but since I haven't succeeded I'll do that now. Also I just corrected an error; apologies if it caused you frustration.

The core of the function is:

ReplaceList[list, {a___, x__, ___} :> {Length@{a} + 1, {x}}]


This is simply a fancy way to generate all subsequences of list, along with their positions. It came naturally to me because I am familiar with this method(1)(2) but one could just as well (in fact, better) use Table:

f1 = ReplaceList[#, {a___, x__, ___} :> {Length@{a} + 1, {x}}] &;

f2 = Join @@ Table[{i, #[[i ;; j]]}, {i, Length@#}, {j, i, Length@#}] &;

f1[test] === f2[test]

True


The output of either function is a list with elements of the form: {startposition, sequence}, e.g. {4, {0, 3, 2, 2}}. This list is passed to GatherBy with Last for the second parameter. (Using infix notation that probably adds confusion, but which I have difficulty not using.) This groups these elements by the sequence, e.g. {0, 3, 2, 2}.

Next Cases is used with a pattern of {_, __} so as to extract only groups with more than one member. (Again using infix notation; sorry.) It occurs to me that this would probably have been clearer using DeleteCases with a pattern of {_}.

Finally, the Function {#[[1, 2]], #[[All, 1]]} & is mapped onto the remaining groups, which extracts one copy of the sequence (by which the elements were grouped) and the startposition for every element.

-
According to the results you get, it is exactly what I want to do ! I am pretty enthusiastic ! Thanks ! I am going to study your answer... –  Doedalos Apr 6 '14 at 9:30
In fact, I have some difficulty to understand how your code works. Would it be possible to have some additional explanations please ? –  Doedalos Apr 8 '14 at 5:23
@Doedalos I added an explanation. I hope it helps. I would still like to find a more efficient way to approach this problem that the brute-force method I employ above. –  Mr.Wizard Apr 8 '14 at 6:42
Thank you for the explanations that allow me to better understand your solution, even though my procedural brain could never find this. I'll try to include your great algorithm inside of my previous work. –  Doedalos Apr 8 '14 at 8:43

One possible answer would be to try and reconstruct your problem analysis from the code you gave. I will not attempt that here.

Rather, I'll start from your statement

"..a set of numbers will be considered as a (sub)sequence, if it appears at least twice in (sic) and if its is length is greater than 1".

That sounds like searching for subsequences of length 2 or larger in a given list.

More specificaly, we could ask for sublists themselves, their multiplicity, their starting position(s) and even cases where a sublist is contained also as a part in a longer sublist (pardon my French: "enchevêtrement") as in ...12...12...0123..12...0123....

This raises the question of how to count the ..12.. substrings with or without double counting those inside the ..0123.. substring.

An attempt to program this using ListCorrelate :

test = IntegerPart[RandomReal[4, 24]];
test={3,0,1,0,3,2,2,0,3,0,1,3,0,2,3,3,0,0,1,2}; minlength=2;

z1=Flatten[Position[#, True]] & /@ Rest@ListCorrelate[test, test, 1, x, SameQ, List];
z2=Split[#, (#1 + 1 === #2) &] & /@ z1;
z3=DeleteCases[z2, q_List/;Length[q]<minlength, {2}];
z4=DeleteCases[MapIndexed[w[#2, #1] &, z3], w[_, {}]];


Edit and correction 2014/04/05 18:30 UTC+1 (using the test from your edit):
Second edit 2014/04/06 19:32 UTC+1 (to conform to Mr.Wizard's output format)

z5 = Flatten[z4 /. w[{u_}, q_List] :> Map[w[test[[#]], First[#] + {0, u}] &, q]];
z6 = Split[Sort[z5], First[#1] === First[#2] &];
z7 = {#[[1, 1]], Union @@ (Last /@ #)} & /@ z6;
z7[[Ordering[PadRight[#, Max[Length /@ Last /@ z7], " "] & /@ (Last /@ z7)]]]//Grid

{ {{3, 0}, {1, 9, 12, 16}},
{{3, 0, 1}, {1, 9}},
{{0, 1}, {2, 10, 18}},
{{0, 3}, {4, 8}}  }


In this case equivalent to , but for test = {1, 1, 1, 2, 3, 1, 1, 2, 3, 1}; the results are quite different. I have always admired one-liners, and Mr.Wizard's is a gem.

-
First, thank you for attention to my post. Then I apologize for the first version of my algorithm which had suffered some mistake when I made ​​the translation of my first post. Your code is very interesting especially for the first part of my algorithm but for the moment I would just focus calculations under F°1B2. –  Doedalos Apr 5 '14 at 17:01
It's a good thing to try and optimise your own code, written along your own problem analysis. My goal was to show a different strategy, using the built-in (fast!) ListCorrelate. I imagine that the detection of repeating sub-strings must be quite common in DNA analysis and such. –  Wouter Apr 5 '14 at 17:20
An afterthought: testing the speed of Mr.Wizard's and my code on a random 1000-character string on 4 letters gives 80 s for the first and 1 s for the latter. So, implementation of choice depends on problem size, I guess. –  Wouter Apr 12 '14 at 15:04
An afterthought : Having reread your post, I posed the following question: Is it possible that the desire to avoid the phenomenon of "enchevêtrement" is the cause of the difference between the function n°2 of Mr. Wizard and yours ? –  Doedalos Apr 29 '14 at 9:31
Yes, the difference is that my version avoids reporting sub-strings of a larger string already reported (but still needs some extra work). –  Wouter Apr 29 '14 at 13:43