Message Boards

WOLFRAM COMMUNITY

2239 Views

7 Replies

4 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Algebra Equation Solving Wolfram Language

Find an invertible integer matrix that satisfies given conditions

Hongyi Zhao

Posted 1 year ago

I am trying to find an invertible integer matrix M that satisfies the following conditions: M1 . M == M . M2 and the absolute value of the determinant of M is equal to 1. I have tried using the FindInstance function in Mathematica as follows, but it did not return any solution: M1={{0, 1, 0, 0}, {-4, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, -4, 0}}; M2={{0, 1, 4, 0}, {-4, 0, 0, -4}, {0, 0, 0, 1}, {0, 0, -4, 0}}; M=Array[x,{4,4}] FindInstance[ M1 . M==M . M2 && 1==Abs[Det[M]], Flatten[M], Integers] Is there a way to modify the code or use a different approach to find an integer matrix that satisfies these conditions? Any help or advice would be greatly appreciated. Thank you in advance! Regards, Zhao

POSTED BY: Hongyi Zhao

7 Replies

Sort By:

Bill Nelson

Posted 1 year ago

I don't know why Mathematica seems to have difficulty finding more than one solution. So try a different way of finding solutions. M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}}; M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}}; M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}}; (* Because of the number of zeros in M1 and M2 we can ) ( Eliminate variables to save memory and time ) sys=Flatten[Map[Thread,Thread[M1.M==M.M2]]]; ( M3 satisfies his first condition for any values of the variables ) M3=M/.Solve[sys,{e,f,g,h,m,n,o,p}][[1]]; ( But even after eliminating variables and not using Abs ) ( FindInstance struggles to find more than a single solution ) tupl=Tuples[{0,1,2,3,4},8]; allm=Map[M3/.Thread[Rule[{a,b,c,d,i,j,k,l},#]]&,tupl]; ( every matrix in solm satisfies both his conditions *) solm=Select[allm,Abs[Det[#]]==1&] That finds 580 solutions in a fraction of a minute. Expanding the range of {0,1,2,3,4} finds more.

I don't know why Mathematica seems to have difficulty finding more than one solution.

So try a different way of finding solutions.

M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}};
M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}};
M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}};
(* Because of the number of zeros in M1 and M2 we can *)
(* Eliminate variables to save memory and time *)
sys=Flatten[Map[Thread,Thread[M1.M==M.M2]]];
(* M3 satisfies his first condition for any values of the variables *)
M3=M/.Solve[sys,{e,f,g,h,m,n,o,p}][[1]];
(* But even after eliminating variables and not using Abs *)
(* FindInstance struggles to find more than a single solution *)
tupl=Tuples[{0,1,2,3,4},8];
allm=Map[M3/.Thread[Rule[{a,b,c,d,i,j,k,l},#]]&,tupl];
(* every matrix in solm satisfies both his conditions *)
solm=Select[allm,Abs[Det[#]]==1&]

That finds 580 solutions in a fraction of a minute. Expanding the range of {0,1,2,3,4} finds more.

POSTED BY: Bill Nelson

Roland Franzius

Posted 1 year ago

Solved consecutive by hand (MS = (M /. (Solve[(0 == # &) /@ (M . M1 - M2 . M // Flatten)][[1]]) /. { Subscript[x, 3, 1] -> 0, Subscript[x, 3, 3] -> 1 , Subscript[x, 3, 4] -> 1, Subscript[x, 3, 2] -> 1, Subscript[x, 1, 3] -> 1, Subscript[x, 1, 4] -> 1, Subscript[x, 1, 2] -> 1})) // MatrixForm (MS . M1 == M2 . MS // Simplify ) == True Regards Roland Franzius

Solved consecutive by hand

(MS = (M /. (Solve[(0 == # &) /@ (M . M1 - M2 . M // 
            Flatten)][[1]]) /. { Subscript[x, 3, 1] -> 0, 
      Subscript[x, 3, 3] -> 1 , Subscript[x, 3, 4] -> 1, 
      Subscript[x, 3, 2] -> 1, Subscript[x, 1, 3] -> 1, 
      Subscript[x, 1, 4] -> 1, 
      Subscript[x, 1, 2] -> 1})) // MatrixForm

matrix result

(MS . M1 == M2 . MS // Simplify ) == True

Regards Roland Franzius

POSTED BY: Roland Franzius

Hongyi Zhao

Posted 1 year ago

The special solution found in this way has no general significance.I can't see any particularly useful places for program implementation.

POSTED BY: Hongyi Zhao

Hongyi Zhao

Posted 1 year ago

But if you try the following, it will stuck there: M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}}; M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}}; M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}}; {{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}}/.FindInstance[ M1 . M==M . M2&& Det[M]==-1,{a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p}, Integers]

But if you try the following, it will stuck there:

M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}};
M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}};
M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}};
{{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}}/.FindInstance[ M1 . M==M . M2&&
Det[M]==-1,{a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p}, Integers]

POSTED BY: Hongyi Zhao

Bill Nelson

Posted 1 year ago

It might be possible, because of the number of zeros that you have in M1 and M2, that you could use algebra to show that there is a single solution to your problem. That would probably require a lot of careful steps to do and I would suggest first trying to do that by hand. I have not spent the time to try to prove that to myself. Using Abs in calculations probably makes it more difficult for some or many of the algorithms used to search for solutions. It does not appear that FindInstance is able to quickly determine there is no solution for determinant == -1. I am very impressed, as always, that FindInstance is able to find a solution for +1 as quickly as it does. Asking it to find two solutions for +1 also takes a very long time and does not appear to find two.

POSTED BY: Bill Nelson

Daniel Lichtblau

Daniel Lichtblau, Wolfram Research

Posted 1 year ago

It's not a single solution and I suspect that's a big part of the cause of slowness. As noted already. one solution can be found quickly like so. mM1 = {{0, 1, 0, 0}, {-4, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, -4, 0}}; mM2 = {{0, 1, 4, 0}, {-4, 0, 0, -4}, {0, 0, 0, 1}, {0, 0, -4, 0}}; mM = Array[x, {4, 4}]; sol1 = First[ mM /. FindInstance[Flatten[{mM1 . mM == mM . mM2, Det[mM] == 1}], Flatten[mM], Integers]] (* Out[30]= {{0, 0, 1, 0}, {0, 0, 0, 1}, {1, 0, 0, 0}, {0, 1, 4, 0}} ) We can get another by ignoring the determinant constraint, solving over the integers, and then imposing it on the resulting parametrized solution. InputForm[ Timing[soln = Solve[Flatten[{mM1 . mM == mM . mM2}], Flatten[mM], Integers]]] ( Out[32]//InputForm= {0.008802, {{x[1, 1] -> ConditionalExpression[C[4], Element[C[3] \| C[4], Integers]], x[1, 2] -> ConditionalExpression[-C[2], Element[C[1] \| C[2], Integers]], x[1, 3] -> ConditionalExpression[C[1], Element[C[1] \| C[2], Integers]], x[1, 4] -> ConditionalExpression[C[3], Element[C[3] \| C[4], Integers]], x[2, 1] -> ConditionalExpression[4C[2], Element[C[1] \| C[2], Integers]], x[2, 2] -> ConditionalExpression[C[4], Element[C[3] \| C[4], Integers]], x[2, 3] -> ConditionalExpression[ -4C[3] + 4C[4], Element[C[3] \| C[4], Integers]], x[2, 4] -> ConditionalExpression[C[1] + 4C[2], Element[C[1] \| C[2], Integers]], x[3, 1] -> ConditionalExpression[C[8], Element[C[7] \| C[8], Integers]], x[3, 2] -> ConditionalExpression[-C[6], Element[C[5] \| C[6], Integers]], x[3, 3] -> ConditionalExpression[C[5], Element[C[5] \| C[6], Integers]], x[3, 4] -> ConditionalExpression[C[7], Element[C[7] \| C[8], Integers]], x[4, 1] -> ConditionalExpression[4C[6], Element[C[5] \| C[6], Integers]], x[4, 2] -> ConditionalExpression[C[8], Element[C[7] \| C[8], Integers]], x[4, 3] -> ConditionalExpression[ -4C[7] + 4C[8], Element[C[7] \| C[8], Integers]], x[4, 4] -> ConditionalExpression[C[5] + 4C[6], Element[C[5] \| C[6], Integers]]}}} ) dd = First[Det[mM /. soln[[1]]]]; dvars = Variables[dd]; d1 = FindInstance[dd == 1, dvars, Integers]; ( {{C[2] -> 0, C[5] -> 1, C[4] -> 1, C[1] -> 0, C[6] -> 0, C[3] -> 0, C[7] -> 0, C[8] -> 0}} ) This does give a different (albeit quite similar) solution. sol2 = First[mM /. (soln /. d1)] ( Out[33]= {{{1, 0, 0, 0}, {0, 1, 4, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}} *) Again, asking for more than one appears to get into a hang situation.

It's not a single solution and I suspect that's a big part of the cause of slowness.

As noted already. one solution can be found quickly like so.

mM1 = {{0, 1, 0, 0}, {-4, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, -4, 0}};
mM2 = {{0, 1, 4, 0}, {-4, 0, 0, -4}, {0, 0, 0, 1}, {0, 0, -4, 0}};
mM = Array[x, {4, 4}];
sol1 = First[
  mM /. FindInstance[Flatten[{mM1 . mM == mM . mM2, Det[mM] == 1}], 
    Flatten[mM], Integers]]

(* Out[30]= {{0, 0, 1, 0}, {0, 0, 0, 1}, {1, 0, 0, 0}, {0, 1, 4, 0}} *)

We can get another by ignoring the determinant constraint, solving over the integers, and then imposing it on the resulting parametrized solution.

InputForm[
 Timing[soln = 
   Solve[Flatten[{mM1 . mM == mM . mM2}], Flatten[mM], Integers]]]

(* Out[32]//InputForm=
{0.008802, {{x[1, 1] -> ConditionalExpression[C[4], 
     Element[C[3] | C[4], Integers]], 
   x[1, 2] -> ConditionalExpression[-C[2], 
     Element[C[1] | C[2], Integers]], 
   x[1, 3] -> ConditionalExpression[C[1], Element[C[1] | C[2], 
      Integers]], x[1, 4] -> ConditionalExpression[C[3], 
     Element[C[3] | C[4], Integers]], 
   x[2, 1] -> ConditionalExpression[4*C[2], 
     Element[C[1] | C[2], Integers]], 
   x[2, 2] -> ConditionalExpression[C[4], Element[C[3] | C[4], 
      Integers]], x[2, 3] -> ConditionalExpression[
     -4*C[3] + 4*C[4], Element[C[3] | C[4], Integers]], 
   x[2, 4] -> ConditionalExpression[C[1] + 4*C[2], 
     Element[C[1] | C[2], Integers]], 
   x[3, 1] -> ConditionalExpression[C[8], Element[C[7] | C[8], 
      Integers]], x[3, 2] -> ConditionalExpression[-C[6], 
     Element[C[5] | C[6], Integers]], 
   x[3, 3] -> ConditionalExpression[C[5], Element[C[5] | C[6], 
      Integers]], x[3, 4] -> ConditionalExpression[C[7], 
     Element[C[7] | C[8], Integers]], 
   x[4, 1] -> ConditionalExpression[4*C[6], 
     Element[C[5] | C[6], Integers]], 
   x[4, 2] -> ConditionalExpression[C[8], Element[C[7] | C[8], 
      Integers]], x[4, 3] -> ConditionalExpression[
     -4*C[7] + 4*C[8], Element[C[7] | C[8], Integers]], 
   x[4, 4] -> ConditionalExpression[C[5] + 4*C[6], 
     Element[C[5] | C[6], Integers]]}}} *)

dd = First[Det[mM /. soln[[1]]]];
dvars = Variables[dd];
d1 = FindInstance[dd == 1, dvars, Integers];

(* {{C[2] -> 0, C[5] -> 1, C[4] -> 1, C[1] -> 0, C[6] -> 0, C[3] -> 0, 
  C[7] -> 0, C[8] -> 0}} *)

This does give a different (albeit quite similar) solution.

sol2 = First[mM /. (soln /. d1)]

(* Out[33]= {{{1, 0, 0, 0}, {0, 1, 4, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}}} *)

Again, asking for more than one appears to get into a hang situation.

POSTED BY: Daniel Lichtblau

Bill Nelson

Posted 1 year ago

M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}}; M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}}; M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}}; M/.FindInstance[M1.M==M.M2&& Det[M]==1,Flatten[M], Integers] instantly returns {{0,0,1,0},{0,0,0,1},{1,0,0,0},{0,1,4,0}}

M1={{0,1,0,0},{-4,0,0,0},{0,0,0,1},{0,0,-4,0}};
M2={{0,1,4,0},{-4,0,0,-4},{0,0,0,1},{0,0,-4,0}};
M={{a,b,c,d},{e,f,g,h},{i,j,k,l},{m,n,o,p}};
M/.FindInstance[M1.M==M.M2&& Det[M]==1,Flatten[M], Integers]

instantly returns

{{0,0,1,0},{0,0,0,1},{1,0,0,0},{0,1,4,0}}

POSTED BY: Bill Nelson

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback