2
$\begingroup$

I have a set of sequences with length 8,48,480,5760,.. and would like to do sequence analysis on them. I plugged the length 8 sequence into wolframalpha:

https://www.wolframalpha.com/input/?i=11,+2,+1,+8,+7,+14,+13,+4

This gives the output:

Diophantine relations: 11 - 2 - 1 + 8 + 7 - 14 - 13 + 4 = 0 11 - 2 + 1 - 8 - 7 + 14 - 13 + 4 = 0 11 + 2 - 1 - 8 - 7 - 14 + 13 + 4 = 0 11^2 + 2^2 - 1^2 - 8^2 - 7^2 - 14^2 + 13^2 + 4^2 = 0 11^3 + 2^3 - 1^3 - 8^3 - 7^3 - 14^3 + 13^3 + 4^3 = 0

I exceeded the free computation time for any more processing of the larger sequences, is there a way to do the same as Wolfram|Alpha does? I can send the longer sequences if someone is able to plug them into Wolfram|Alpha Pro. Thanks.

cheers, Jamie

$\endgroup$
2
  • 1
    $\begingroup$ The sequence lengths sequence is OEIS sequence 5867 and this not a coincidence. Even for length 48 there are too many possibilities for naive search to check in any reasonable time. I know that the sign patterns found have a number theoretic origin. $\endgroup$
    – Somos
    Jun 7 '19 at 23:52
  • $\begingroup$ Hi, there is a draft for the sequence here: oeis.org/draft/A308121. These 48,480,5760 length sequences are on Primorial rows, ie rows 210,2310,30030. $\endgroup$
    – Jamie M
    Jun 8 '19 at 2:14
2
$\begingroup$

You can use Solve for this purpose. Let v be your vector:

v = {11, 2, 1, 8, 7, 14, 13, 4};

Then, to find the linear Diophantine relations:

linear = Solve[
    v . a == 0 && 
    a ∈ RegionProduct @@ Prepend[
        Table[Point[{{-1},{1}}],7],
        Point[{{1}}]
    ],
    a
]

{{a -> {1, -1, -1, 1, 1, -1, -1, 1}}, {a -> {1, -1, 1, -1, -1, 1, -1, 1}}, {a -> {1, 1, -1, -1, -1, -1, 1, 1}}}

Comparison:

v #& /@ (a /. linear)

{{11, -2, -1, 8, 7, -14, -13, 4}, {11, -2, 1, -8, -7, 14, -13, 4}, {11, 2, -1, -8, -7, -14, 13, 4}}

To find the quadratic Diophantine relations:

Solve[
    vec^2 . a == 0 && 
    a ∈ RegionProduct @@ Prepend[
        Table[Point[{{-1},{1}}],7],
        Point[{{1}}]
    ],
    a
]

{{a -> {1, 1, -1, -1, -1, -1, 1, 1}}}

etc.

$\endgroup$
1
  • $\begingroup$ Would you be able to analyze this sequence? 27, -18, 1, 4, 23, 26, 13, 32, 19, 22, 41, 44, 31, 18, 37, 24, 27, 46, 33, 36, 23, -6, -3, 16, 19, 38, 41, 12, -1, 2, -11, 8, 11, -2, 17, 4, -9, -6, 13, 16, 3, 22, 9, 12, 31, 34, 53, 8 $\endgroup$
    – Jamie M
    Jun 8 '19 at 14:23
1
$\begingroup$

Another approach using Solve

Clear["Global`*"]

diophantine[p_Integer?Positive] :=
 Inner[Times, coef,
    If[p == 1, seq, Inactive[Power][#, p] & /@ seq],
    Inactive[Plus]] == 0 /.
  Union[
   Solve[
    seq^p.coef == 0 && And @@ (# == -1 || # == 1 & /@ coef),
    coef],
   SameTest -> ((coef /. #1) == -(coef /. #2) &)]

seq = {11, 2, 1, 8, 7, 14, 13, 4};

coef = Array[c, Length@seq];

Column[d[1] = diophantine[1]]

enter image description here

Verifying,

And @@ (d[1] // Activate)

(* True *)

Column[d[2] = diophantine[2]]

enter image description here

Verifying,

And @@ (d[2] // Activate)

(* True *)

Column[d[3] = diophantine[3]]

enter image description here

Verifying,

And @@ (d[3] // Activate)

(* True *)
$\endgroup$
1
  • $\begingroup$ Thanks, is there any way to reduce the memory requirements? I tried it on seq={27, -18, 1, 4, 23, 26, 13, 32, 19, 22, 41, 44, 31, 18, 37, 24, 27, 46, 33, 36, 23, -6, -3, 16, 19, 38, 41, 12, -1, 2, -11, 8, 11, -2, 17, 4, -9, -6, 13, 16, 3, 22, 9, 12, 31, 34, 53, 8} But Mathematica exited after using 16GB ram. $\endgroup$
    – Jamie M
    Jun 8 '19 at 13:27

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