How to generate a random matrix with specific parameters?

I want to use Mathematica to generate a random matrix with given dimensions, entries coming from a finite set, and with a determinant also coming from a finite set. (It's very important that the generation of this matrix is random. Ideally this process would give the same results as making a list of all matrices of the given size and possible entries with one of the acceptable determinants, and picking one at random.)

Some implementations of this are easy. To solve the 2x2 case with determinant == 1, and integral entries from -10 to 10, I can enter

Solve[{a d - b c == 1, -10 <= a <= 10, -10 <= b <= 10, -10 <= c <= 10, -10 <= d <= 10}, {a, b, c, d}, Integers]

But this doesn't easily extend to the problem of having broader sets of possible entries, e.g. a, b, c, and d being from -20 to 15, and being fractions with denominator between 1 and 10. That isn't essential, but the following condition is: I only need one random matrix, and I need it quickly -- but Mathematica takes forever via the above trick to generate all possible 3x3s. I thought of trying to use FindRoot together with seeding the process with random values, but I couldn't find control over

If there isn't a single function that will do the trick, I don't mind writing a function in Mathematica to do what I'm looking for -- but I'm very much a newbie to MM, so as much advice as you can give me would be greatly appreciated!

EDIT: As per gpap's excellent answer, here's the code that I've ended up with, modified from his answer to work with fractions.

det = Module[{i}, Sequence @@ (i /. Solve[Det[{{#1, #2, #3}, {#4, #5, #6}, {#7, #8, i}}] == 1, i]) &];

candidates = Apply[{##, det@##} &, RandomChoice[{0, 1/2, 1, 3/2, 2}, {10000, 8}], 2] // Quiet;

RandomChoice[Select[candidates, MemberQ[{0, 1/2, 1, 3/2, 2}, Last@# ] &]];

I don't know if this is very efficient but it should be random.

Assuming you are after $3 \times 3$ unitary matrices with integer coefficients in $[-10,10].$ Your determinant condition puts a constraint to one of the variables so you might as well solve it symbolically:

det =
Module[{i},Sequence @@ (i /.
Solve[Det[{{#1, #2, #3}, {#4, #5, #6}, {#7, #8, i}}] == 1, i]) &];

The above makes a pure function that takes a string of 8 arguments and spits out a ninth that obeys the determinant condition (here $=1$). Now you can make a few sequences of 8 arguments that obey the constraint you want (here I assume integers) and apply the above function:

candidates = Apply[{##, det@##} &, RandomInteger[{-10, 10}, {10000, 8}], 2] //Quiet;

Keeping it Quiet because you are bound to divide by zero at some point. This takes a little more than half a second on my machine. Now you have a set that obeys the determinant condition but not the integer one, so you can pick these:

RandomChoice[
Select[candidates, Abs@Last@# <= 10 && IntegerQ@Last@# &]]

(* out: *) {2, 0, 5, -6, -3, -5, 1, -2, 9}

Partition[%, 3]

I don't think you need to produce 10000 candidates to just get a random matrix obeying the constraint so even less will do and probably a random choice from a random set wouldn't ruin the randomness.

• This is amazing! I don't understand why, but even extending it to the 4x4 case and still running 10,000 samples runs in the same amount of time. I do have one more question -- I'm trying to modify the code to work with more general entries (not just integers), and I get hung up on the Select command. When generating candidates I replaced RandomInteger[interval] with RandomChoice[fractions], and that seemed to work perfectly. Then I put RandomChoice[ Select[candidates, MemberQ[{0, 1/2, 1, 3/2, 2}, Last@# &]]]; and MM didn't seem to like my formatting. Any ideas? – Twiffy Aug 14 '13 at 6:06
• Very nice and much much better than my mindless brute force. Learned a lot. – ubpdqn Aug 14 '13 at 6:10
• Nevermind, my & was in the wrong environment! Everything is working perfectly. Thanks so much! – Twiffy Aug 14 '13 at 6:16

On my machine (old) Solve takes 22 seconds. Your toy case could be done:

ans = Tuples[Range[-10, 10], 4];
se = Select[ans, #[] #[] - #[] #[] == 1 &];

yields the 1012 solutions in about 3.8 seconds

To get them into matrices:

ans = Tuples[Range[-10, 10], 4];
se = Select[ans, #[] #[] - #[] #[] == 1 &];
mat=Partition[#, 2] & /@ se;

adds only a small penalty.

This will scale poorly but for smaller matrices may be ok.

Generalizing:

fun[min_, max_, det_, size_] := Module[{tuples, sel},
tuples = Tuples[Range[min, max], size^2];
sel = Select[tuples, Det[Partition[#,size]] ==det &];
Partition[#, size] & /@ sel]

The toy example is obtained from fun[-10,10,1,2] takes about 3.7 seconds.

These lists, I presume, will be randomly sampled.

EDIT As pointed outed this fails for larger input sizes (as it is just brute force testing of possibilities). It works for size -2.

• Thanks for your post -- this definitely runs faster than my "Solve" approach. However, when I try to compute fun[-10, 10, 1, 3], I get an "insufficient memory" error and it aborts the computation. But I suspect that even if I allocated more memory, 3.8 seconds for the 2x2 case would be bad for the 3x3 case and impossible for the 4x4 case. Ideally I need to be able to get a 5x5 in less than 5 seconds. Maybe there's a way to do it without generating all the possibilities? – Twiffy Aug 13 '13 at 18:57
• @Twiffy: yes alluded to not scale well: combinatorial explosion...sorry. The experts on this site will be have manifold ideas...I just thought for the small scale case testing the cases would have been just as/more efficient than <code>Solve</code>. – ubpdqn Aug 14 '13 at 4:52