What approach would yield the six integer variables satisfying all given constraints?

Questions
1

The question is:

2025-07-23_175520.png
2025-07-23_175520.png932Ă—388 20.2 KB

m[a1_, a2_, a3_, a4_, a5_, a6_] = 
 a1 10^5 + a2 10^4 + a3 10^3 + a4 10^2 + a5 10 + a6
m[a, b, c, d, e, f]
m[b, c, d, e, f, a]
m[c, d, e, f, a, b]
m[d, e, f, a, b, c]
m[e, f, a, b, c, d]
m[f, a, b, c, d, e]
Reduce[{Mod[m[a, b, c, d, e, f], 7] == 0, 
  Mod[m[b, c, d, e, f, a], 9] == 0, Mod[m[c, d, e, f, a, b], 11] == 0,
   Mod[m[d, e, f, a, b, c], 13] == 0, 
  Mod[m[e, f, a, b, c, d], 15] == 0, 
  Mod[m[f, a, b, c, d, e], 17] == 0, {a, b, c, d, e, f} > 0}, {a, b, 
  c, d, e, f}, Integers]

No solution was found for the six-digit number using the described approach.

2

Edit: I didn’t see the variable orders changed in each modular restriction, so this answer is not correct.

 m[a_, b_, c_, d_, e_, f_] = 
     a 10^5 + b 10^4 + c 10^3 + d 10^2 + e 10 + f
    
base = 7*9*11*13*15*17;
vars = {a, b, c, d, e, f};
soln = Reduce[m @@ vars == 0, Modulus -> base]

a == C[1] && b == C[2] && c == C[3] && d == C[4] && e == C[5] && 
f == 2197295 C[1] + 2287295 C[2] + 2296295 C[3] + 2297195 C[4] + 2297285 C[5]
3

The previous code might have some problems. I’ve fixed it now.

4

Knowing the answer in advance, the verification using the previous code is correct. However, I still don’t know how to find this six-digit number.

{a = 5, b = 3, c = 1, d = 5, e = 3, f = 1}
m[a1_, a2_, a3_, a4_, a5_, a6_] = 
 a1 10^5 + a2 10^4 + a3 10^3 + a4 10^2 + a5 10 + a6
m[a, b, c, d, e, f]
m[b, c, d, e, f, a]
m[c, d, e, f, a, b]
m[d, e, f, a, b, c]
m[e, f, a, b, c, d]
m[f, a, b, c, d, e]
Reduce[{Mod[m[a, b, c, d, e, f], 7] == 0, 
  Mod[m[b, c, d, e, f, a], 9] == 0, Mod[m[c, d, e, f, a, b], 11] == 0,
   Mod[m[d, e, f, a, b, c], 13] == 0, 
  Mod[m[e, f, a, b, c, d], 15] == 0, 
  Mod[m[f, a, b, c, d, e], 17] == 0}]

2025-07-23_180139.png
2025-07-23_180139.png1648Ă—818 38.9 KB

And

{a, b, c, d, e, f} = IntegerDigits[594594]
m[a1_, a2_, a3_, a4_, a5_, a6_] = 
 a1 10^5 + a2 10^4 + a3 10^3 + a4 10^2 + a5 10 + a6
m[a, b, c, d, e, f]
m[b, c, d, e, f, a]
m[c, d, e, f, a, b]
m[d, e, f, a, b, c]
m[e, f, a, b, c, d]
m[f, a, b, c, d, e]
Reduce[{Mod[m[a, b, c, d, e, f], 7] == 0, 
  Mod[m[b, c, d, e, f, a], 9] == 0, Mod[m[c, d, e, f, a, b], 11] == 0,
   Mod[m[d, e, f, a, b, c], 13] == 0, 
  Mod[m[e, f, a, b, c, d], 15] == 0, 
  Mod[m[f, a, b, c, d, e], 17] == 0}]

2025-07-23_180244.png
2025-07-23_180244.png1645Ă—804 39.3 KB

5

Select[Tuples[{1,2,3,4,5,6,7,8,9},6],
Mod[FromDigits[#],7]==0&&
Mod[FromDigits[RotateLeft[#,1]],9]==0&&
Mod[FromDigits[RotateLeft[#,2]],11]==0&&
Mod[FromDigits[RotateLeft[#,3]],13]==0&&
Mod[FromDigits[RotateLeft[#,4]],15]==0&&
Mod[FromDigits[RotateLeft[#,5]],17]==0&]

quickly returns

{{5,3,1,5,3,1},{5,9,4,5,9,4}}
6

Bill’s answer is much faster, but here is a way to use Reduce[] on such problems. The option "ExhaustiveSearchMaxPoints" is discussed in
Diophantine Polynomial Systems—Wolfram Documentation.

Clear[a, b, d, c, d, e, f];
m[a1_, a2_, a3_, a4_, a5_, a6_] = 
  a1 10^5 + a2 10^4 + a3 10^3 + a4 10^2 + a5 10 + a6;

Reduce[{
   Mod[m[a, b, c, d, e, f], 7] == 0, 
   Mod[m[b, c, d, e, f, a], 9] == 0, 
   Mod[m[c, d, e, f, a, b], 11] == 0, 
   Mod[m[d, e, f, a, b, c], 13] == 0, 
   Mod[m[e, f, a, b, c, d], 15] == 0, 
   Mod[m[f, a, b, c, d, e], 17] == 0
   , And @@ Thread[1 <= {a, b, c, d, e, f} <= 9]}, 
  {a, b, d, c, d, e, f}, Integers,
  Method -> 
   {"ExhaustiveSearchMaxPoints" -> {9^6 + 1, 1000000}}
 ] // AbsoluteTiming
(*
{4.69601,
  (a == 5 && b == 3 && c == 1 && d == 5 && e == 3 && f == 1) || 
  (a == 5 && b == 9 && c == 4 && d == 5 && e == 9 && f == 4)}
*)
7

This is a bit indirect but quite fast. First set it up as a linear algebra problem.

m[ll : {a1_, a2_, a3_, a4_, a5_, a6_}] :=  ll . 10^Range[Length[ll] - 1, 0, -1]
mods = {7, 9, 11, 13, 15, 17};
vars = {a, b, c, d, e, f};
{rhs, mat} = Normal@CoefficientArrays[Map[m, NestList[RotateLeft, vars, 5]], vars]
    
(* Out[69]= {{0, 0, 0, 0, 0, 0}, {{100000, 10000, 1000, 100, 10, 1}, {1, 100000, 10000, 1000, 
       100, 10}, {10, 1, 100000, 10000, 1000, 100}, {100, 10, 1, 100000, 
       10000, 1000}, {1000, 100, 10, 1, 100000, 10000}, {10000, 1000, 100,
        10, 1, 100000}}}*)

Now solve over the integers taking into account the moduli. Since the rhs is all zeros it is really the null vectors that are of interest. I use a setting for the appropriate WFR function to obtain those null vectors. This is followed with LatticeReduce to make the integers reasonably small.

Timing[{sol, nulls} =ResourceFunction["LinearSolveMod"][mat, rhs, mods, True];
  rednulls = LatticeReduce[nulls]]

(* Out[70]= {0.004999, {{-5, 3, 1, 5, 3, 2}, {-5, 3, 2, -5, 3, 
   2}, {-5, -3, -2, 5, -3, -1}, {1, -4, 3, 0, 6, 3}, {0, -1, 10, 0, 0,
    0}, {-1, 1, 0, 0, -11, 20}}} *)

Now we take integer combinations of the nulls and use Solve over the integers to obtain all sets where the resulting values are between 1 and 9 inclusive.

newvars = Array[t, Length[rednulls]];
newvals = newvars . rednulls;
Timing[solns = Solve[Map[1 <= # <= 9 &, newvals], newvars, Integers];
 newvals /. solns]

(* Out[73]= {0.023115, {{5, 3, 1, 5, 3, 1}, {5, 9, 4, 5, 9, 4}}} *)

An advantage to this roundabout approach is that we can avoid a brute-force method (to the extent that integer linear programming does so) and also make the task of Reduce easier by first getting inputs to be small using lattice reduction.

8

You can save time by rotating the powers of ten to the right instead of rotating the digits to the left:

(toNumber = Table[RotateRight[10^Range[5, 0, -1], k - 3], {k, 3, 8}]; 
 digits = Tuples[{1, 2, 3, 4, 5, 6, 7, 8, 9}, 6]; 
 pick = Mod[toNumber . Transpose@digits, {7, 9, 11, 13, 15, 17}]; 
 Pick[digits, Total[pick], 0]) // AbsoluteTiming
(*
{0.024831, 
 {{5, 3, 1, 5, 3, 1}, {5, 9, 4, 5, 9, 4}}}
*)