Group Abstract

Message Boards

WOLFRAM COMMUNITY

290 Views

7 Replies

8 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Calculus

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

Jim Clinton

Posted 10 days ago

The question is: 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.

The question is:

enter image description here

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.

POSTED BY: Jim Clinton

7 Replies

Sort By:

Updating Name

Posted 9 days ago

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}}} *)

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}}}
*)

POSTED BY: Updating Name

Daniel Lichtblau

Daniel Lichtblau, Wolfram Research

Posted 9 days ago

POSTED BY: Daniel Lichtblau

Michael Rogers

Michael Rogers, Emory University

Posted 9 days ago

Bill's answer is much faster, but here is a way to use `Reduce[]` on such problems. The option `"ExhaustiveSearchMaxPoints"` is discussed in https://reference.wolfram.com/language/tutorial/DiophantineReduce.html. 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)} *)

Bill's answer is much faster, but here is a way to use Reduce[] on such problems. The option "ExhaustiveSearchMaxPoints" is discussed in https://reference.wolfram.com/language/tutorial/DiophantineReduce.html.

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)}
*)

POSTED BY: Michael Rogers

David Trimas

David Trimas, University of Michigan

Posted 10 days ago

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 = 79111315*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]

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]

POSTED BY: David Trimas

Jim Clinton

Posted 9 days ago

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

POSTED BY: Jim Clinton

Jim Clinton

Posted 9 days ago

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}] 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}]

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}]

enter image description here

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}]

enter image description here

POSTED BY: Jim Clinton

Bill Nelson

Posted 9 days ago

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}}

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}}

POSTED BY: Bill Nelson

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback