1
$\begingroup$

If you have a list of integers is there a way of searching that list to see if there is a trend of Ax+B in the list? Not using all of the numbers, just seeing what trends like that are embedded in a list.

Such as with data={2, 4, 6, 8, 10, 11, 12, 14, 16, 18,19, 20, 22, 24} there is the arithmetically increasing sequence of 2x+0 but there is also elements in the list that do not fit into the sequence. That is what i meant by "Not using all the numbers"

$\endgroup$
  • 1
    $\begingroup$ See FindSequenceFunction[ ] $\endgroup$ – Dr. belisarius Apr 9 '15 at 16:14
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$ – bbgodfrey Apr 9 '15 at 16:22
  • $\begingroup$ With your example data, should the output include the sequences {2, 6, 10 ... 22}, {6, 12, 18, 24}, etc? What about {10, 11, 12} and {8, 11, 14}? $\endgroup$ – 2012rcampion Apr 9 '15 at 17:51
  • $\begingroup$ @2012rcampion the problem is that {2, 6, 10 ... 24} does not appear. {2,4,6,8,10} does and {12,14,16,18} does and {20,22,24} does. I would like it to be able to find them all together as {2, 6, 10 ... 24}, it is okay if it finds other small ones that i can look through myself but it is missing the big one because of the little ones $\endgroup$ – Devyn Santos Apr 9 '15 at 18:03
  • $\begingroup$ {2, 6, 10 ... 22} appears for sure: {2, 4, 6, 8, 10, 11, 12, 14, 16, 18,19, 20, 22, 24}. In your words, "there is the arithmetically increasing sequence of [4x+2] but there is also elements in the list that do not fit into the sequence." Seems to meet the criteria to me. $\endgroup$ – 2012rcampion Apr 9 '15 at 18:10
1
$\begingroup$

Finding Subsequences

First off, here's the code I used to verify my solutions:

Sort@DeleteDuplicates[
 Select[Select[Reverse@Subsets[data, {3, ∞}], 
   Equal @@ Differences[#] &], Unequal @@ # &], 
 SubsetQ[##] && Equal @@ Sign@*First@*Differences /@ {##} &]
  • First, we get all Subsets of data that are no shorter than three elements long, and reverse them so that the larger subsets come first. Since Subsets returns sets in the same order they are in the input, this effectively finds all subsequences for us.
  • Next, we Select the subsequences that form arithmetic sequences by checking that their first-order Differences are all Equal.
  • We then Select again to discard constant subsequences by checking that the elements are Unequal.
  • Finally we eliminate subsequences that are themselves subsequences of other subsequences, checking with SubsetQ (and also checking that both subsequences are increasing and decreasing.)

This function has exponential time and space complexity, due to the presence of Subsets. We can, however, create a cubic-time algorithm that gives us the same result.


First I'll define a helper function subSequenceQ that tests to see if one range specification (second argument) is a subsequence of another (first argument):

subSequenceQ[{s1_, e1_, t1_: 1}, {s2_, e2_, t2_: 1}] := (Divisible[t2, t1] &&
   (s1 <= s2 <= e2 <= e1 || s1 >= s2 >= e2 >= e1) && Divisible[s2 - s1, t1])

Next, the function itself, which returns range specifications for all the discovered subsequences. (For example, if the subsequence {5, 3, 1, -1} exists, {5, -1, -2} would be returned.)

arithmeticSubSequences[data_] := With[{n = Length[data]},
 Module[{seq = {}, count, start, end, step},
  Do[
   start = data[[i]];
   If[MemberQ[seq, {start, _, _}], Continue[]];
   Do[
    step = data[[j]] - start;
    If[step == 0, Continue[]];
    count = 2;
    Do[If[data[[k]] == start + step count, count++], {k, j + 1, n}];
    end = start + step (count - 1);
    If[count > 2 && !MemberQ[seq, r:{_, _, _} /; subSequenceQ[r, {start, end, step}]],
     seq~AppendTo~{start, end, step}
     ];,
    {j, i + 1, n}
    ];,
   {i, n}
   ];
  seq = Reverse@SortBy[seq, Abs[Subtract @@ Most[#]/Last[#]] + 1 &];
  DeleteDuplicates[seq, subSequenceQ]]
 ]

seq is a list of range specifications of subsequences found so far. i loops over each element, testing it as a potential starting point for a subsequence. If there is already a sequence starting with data[[i]], then we won't find any new subsequences, so we skip to the next i.

j loops over the remaining elements, testing each one as a potential second element of a subsequence. We use it to determine the potential sequence's step size. We then loop k over the rest of the array to see how many more elements would be part of this sequence. If the number of elements is greater than 2, and we haven't already found a sequence that is a subsequence of, we add it to seq.

Finally we sort the ranges by length and delete subsequences that are themselves subsequences of others.

On your dataset:

data = {2, 4, 6, 8, 10, 11, 12, 14, 16, 18, 19, 20, 22, 24};

we get the output:

arithmeticSubSequences[data]
(* {{2, 24, 2}, {18, 20, 1}, {16, 22, 3}, {14, 24, 5}, {10, 12, 1},
    {8, 14, 3}, {6, 16, 5}, {4, 18, 7}, {2, 20, 9}} *)

You can see which sequences these correspond to with Grid[{#, Range @@ #} & /@ %]:

{2,24,2}    {2,4,6,8,10,12,14,16,18,20,22,24}
{18,20,1}   {18,19,20}
{16,22,3}   {16,19,22}
{14,24,5}   {14,19,24}
{10,12,1}   {10,11,12}
{8,14,3}    {8,11,14}
{6,16,5}    {6,11,16}
{4,18,7}    {4,11,18}
{2,20,9}    {2,11,20}

Finding Substrings (original answer)

(First /@ #)~Append~Last[Last[#]] & /@ 
 Select[SplitBy[Partition[data, 2, 1], Differences], Length[#] > 1 &]
  • First we Partition the data into a list of pairs of adjacent elements.
  • Then we Split the pairs into runs where the Differences are the same.
  • We Select runs of length more than one.
  • Finally we process the resulting lists of pairs to return them as lists of numbers.

We can go faster by getting the ranges instead:

With[{len = Length /@ Split[Differences[data]]}, {#2 - #1, #2} + 1 & @@@
   Pick[Transpose[{len, Accumulate[len]}], Thread[len > 1]]]
  • First we find the Differences between adjacent elements, Split them into runs, then get the Length of each run
  • We use Accumulate to get the position of the end of each run, then Pick runs longer than one pair.
  • Then we use {#2 - #1, #2} + 1 to get the position of the first and last element in each run.
$\endgroup$
  • $\begingroup$ Note that this only finds runs that exactly form an increasing subsequence. You might try Split[ ... , Equal] to use the default tolerance that applies when using == on floating-point numbers, or something like Split[ ... , Abs[#1-#2] < 10^-3] to get an adjustable tolerance that will work on exact numbers as well. $\endgroup$ – 2012rcampion Apr 9 '15 at 17:03
  • $\begingroup$ 2012rcampion, I see that it only catches exactly increasing sub, but I am not sure what you mean by the modification in your second comment. I don't understand what the imply? do they imply that you replace the word Differences? $\endgroup$ – Devyn Santos Apr 9 '15 at 17:10
  • $\begingroup$ @DevynSantos Look up the documentation for Split, it takes a second argument that is a function to use to test if adjacent elements are identical. (Also, the second one should be Split[ ... , Abs[#1-#2] < 10^-3 &], I forgot the &) $\endgroup$ – 2012rcampion Apr 9 '15 at 17:13
  • $\begingroup$ neither of those is finding subsequences that other values in it. For a simple example if I take data = {2, 4, 6, 8, 10, 11, 12, 14, 16, 18, 20, 22, 24} they do not find the trend because of the 11 in there. $\endgroup$ – Devyn Santos Apr 9 '15 at 17:28
  • $\begingroup$ I am sorry if i was unclear, I am only looking for arithmetically increasing sequences, i am just looking to find them with other data points mixed in that do not belong in the sequences. Such as with data={2, 4, 6, 8, 10, 11, 12, 14, 16, 18, 20, 22, 24} there is the arithmetically increasing sequence of 2x+0 but there is also elements in the list that do not fit into the sequence. That is what i meant by "Not using all the numbers" I am sorry if i was unclear. $\endgroup$ – Devyn Santos Apr 9 '15 at 17:46
0
$\begingroup$

This will kludge it up:

c = Cases[{#, Chop@FindFit[#, a x + b, {a, b}, x]} & /@ 
    Subsets[data, {4, Length@data}], {_, {a -> aa_, b -> bb_}} /; 
    FractionalPart[Round[aa, .0001]] == 0 && 
     FractionalPart[Round[bb, .0001]] == 0];
Last@SortBy[c, Length]

(* {{2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24}, {a -> 2., b -> 0}} *)

It's no sure-fire mechanism, but it's reasonably quick. Fiddle with parameters (subset size limits, rounding) to tune specificity.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.