How to find modulus patterns using Mathematica

Is there any way to find the lowest modulus of a list of integers? I'm not sure how to say it correctly, so I'm going to clarify with an example.

I'd like to input a list (mod x) and output the "same" list, modulus y (< x). For example, the list {0, 4, 6, 10, 12, 16, 18, 22} (mod 24) is essential开发者_开发百科ly the same as {0, 4} (mod 6).

Thank you for all your help.

---

You are looking for a set of arithmetic sequences. We'll consider your example

ee = {0, 4, 6, 10, 12, 16, 18, 22};

which has two such sequences, and an example with four of them.

ff = {0, 3, 7, 11, 17, 20, 24, 28, 34, 37, 41, 45};

In this second one we start with {0,3,7,11} and then increase by 17. So what is the general way to get from the nth term to the n+1th? If the set has k sequences (k=2 for ee and 4 for ff) then add the modulus to the n-k+1th term. What is the modulus? It is the difference between the nth and n-kth terms.

Putting this together and assuming we know k (we don't in general, but we'll get to that) we have a recurrence of the form f(n+1)=f(n-k+1) + (f(n)-f(n-k)). So we need to find a recurrence (if one exists), check that it is of the correct form, and post-process if so.

Here is code to do all this. Note that it in effect solves for k.

findArithmeticSequences[ll : {_Integer ..}] := With[
  {rec = FindLinearRecurrence[ll]},
  {Take[ll, Length[rec] - 1], ll[[Length[rec]]]} /;
   ListQ[rec] &&
    (rec === {1, 1, -1} || MatchQ[rec, {1, 0 .., 1, -1}])
  ]

(Afficionados of pure functions might prefer the variant below. Failure cases are handled a bit differently, for no compelling reason.)

findArithmeticSequences2[ll : {_Integer ..}] :=
 If[ListQ[#] &&
     (# === {1, 1, -1} || MatchQ[#, {1, 0 .., 1, -1}]), {Take[ll, 
      Length[#] - 1], ll[[Length[#]]]}, $Failed] &[
  FindLinearRecurrence[ll]]

Tests:

In[115]:= findArithmeticSequences[ee]

Out[115]= {{0, 4}, 6}

In[116]:= findArithmeticSequences[ff]

Out[116]= {{0, 3, 7, 11}, 17}

Note that one can "almost" do such problems by polynomial factorization (if the input has no partial sequences at the end). For example, the polynomial

In[117]:= poly = Plus @@ (x^ee)

Out[117]= 1 + x^4 + x^6 + x^10 + x^12 + x^16 + x^18 + x^22

factors into

(1+x^4)*(1+x^6+x^12+x^18)

which contains the needed information in a way that is easy to see. Unfortunately for this particular purpose, Factor will factor beyond this point, and obscure the information in so doing.

I keep wondering if there might be a signal processing way to go about this sort of thing, e.g. via DFTs. But I've not come up with anything.

Daniel Lichtblau

---

Wow, thank you Daniel for this! It works nearly the way I want it to. Your method is just a bit "too restrictive". It doesn't return anything useful if 'FindLinearRecurrence' doesn't find any recurrence. I've modified your method a bit, so it suits my needs better. I hope you don't mind. Here's my code.

findArithmeticSequences[ll_List] := Module[{rec = FindLinearRecurrence[ll]}, If[! MatchQ[rec, {1, 0 ..., 1, -1}], Return[ll], Return[{ll[[Length[rec]]], Take[ll, Length[rec] - 1]}]; ]; ];

I had a feeling it'd have to involve recurrence, I just don't have enough experience with Mathematica to implement it. Thank you again for your time!

---

Mod is listable, and you can remove duplicate elements by DeleteDuplicates. So

DeleteDuplicates[Mod[{0, 4, 6, 10, 12, 16, 18, 22}, 6]]
(*
-> {0,4}
*)