4
$\begingroup$

Let we have

list = {{1, 0, 2, 0, 1, 1}, {1, 1, 0, 1, 2, 1}, {1, 0, 0, 2, 1, 1},
        {1, 1, 1, 2, 1, 1}, {2, 1, 1, 0, 1, 1}, {1, 2, 1, 2, 2, 1},
        {2, 1, 1, 2, 1, 2}, {1, 2, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 0},
        {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}};

I would like to obtain the list of all possible 6 x 6 matrices which are created considering every 6 tuples in the above list.

From this list, I would like to have a list of matrices where the absolute value of the determinant is bigger than 1. When we interchange two columns or rows in the matrix, we can have a minus version of the determinant, so we may have lots of repetitions. Moreover, there should not be repetition in the list.

Addition to above problem, let us consider the above algorithm for 15 x 15 matrices as follows:

list = {{0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0, 1,
     1, 0, 2, 1, 0, 0, 0, 0, 0, 1}, {0, 0, 0, 1, 0, 1, 0, 0, 2, 0, 0, 
    1, 1, 0, 1}, {0, 0, 1, 0, 0, 0, 0, 2, 0, 2, 2, 1, 2, 4, 2}, {0, 1,
     1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 3}, {1, 1, 0, 1, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0}, {1, 2, 1, 1, 2, 2, 2, 1, 2, 1, 1, 1, 1, 1, 
    1}, {2, 1, 2, 2, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2}, {1, 2, 4, 1, 3,
     4, 2, 1, 1, 2, 1, 1, 2, 2, 2}, {1, 1, 1, 1, 1, 4, 1, 1, 1, 1, 1, 
    1, 1, 1, 1}, {1, 1, 2, 4, 3, 1, 0, 9, 7, 6, 3, 4, 5, 6, 7}, {1, 2,
     4, 5, 6, 1, 2, 1, 3, 6, 8, 6, 2, 8, 9}, {1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 0, 0, 0}, {0, 0, 1, 2, 1, 5, 7, 8, 5, 7, 3, 2, 4, 3, 
    3}, {3, 5, 8, 3, 0, 5, 3, 4, 3, 3, 4, 6, 3, 3, 3}, {3, 5, 7, 8, 3,
     9, 5, 3, 6, 3, 3, 9, 6, 3, 3}, {3, 5, 7, 8, 3, 0, 5, 3, 4, 6, 9, 
    4, 4, 6, 3}};
   
    s = Select[Subsets[list, {Length[list[[1]]]}], Abs@Det[#] > 1 &];
    Length[s]
    p = Flatten[Permutations /@ s, 1];   

    
    rowID = Flatten[Position[list, #] & /@ #] &;

    
    Dataset[{Row[{"Det", MatrixForm[#], " = ", Det[#], ",   Permutation ",
    MatrixForm@rowID[#]}] & /@ s} // Transpose, MaxItems -> 1] 

When I ran the above code I got  length[s] = 136  and also message that

General: The current computation was aborted because there was insufficient \ memory available to complete the computation.

Throw: Uncaught SystemException returned to top level. Can be caught with Catch[[Ellipsis], _SystemException].

SystemException["MemoryAllocationFailure"]

Even I got the above errors, I got the list of 136 matrices which satisfies the condition described in the code. The list is given 20 matrices by 20 Matrices. How can I see whole list at one time? How can we adjust Dataset for this?

Improve this question
$\endgroup$

2 Answers 2

Reset to default
5
$\begingroup$

Maybe this?

matrix = {{1, 0, 2, 0, 1, 1}, {1, 1, 0, 1, 2, 1}, {1, 0, 0, 2, 1, 
    1}, {1, 1, 1, 2, 1, 1}, {2, 1, 1, 0, 1, 1}, {1, 2, 1, 2, 2, 
    1}, {2, 1, 1, 2, 1, 2}, {1, 2, 1, 1, 1, 1}, {0, 1, 1, 0, 1, 
    0}, {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}};
matrix // MatrixForm
submatrixs = 
  DeleteDuplicates@
   Select[Table[matrix[[i]], {i, Subsets[Range[Length@matrix], {6}]}],
     Det[#] > 1 &];
Det /@ submatrixs
MatrixForm /@ submatrixs
Improve this answer
$\endgroup$
5
  • $\begingroup$ the code should check absolute value of the determinant bigger than 1, not determinant bigger than 1. How can we revise this code in this way. thanks @cvgmt $\endgroup$
    – gunes
    Nov 21, 2020 at 19:23
  • 1
    $\begingroup$ @gunes replace Det[#]>1 with Abs[Det[#]]>1 $\endgroup$
    – Bill
    Nov 21, 2020 at 20:17
  • $\begingroup$ Thanks, @Bill the code gives the list of the matrices, can ı also see what the determinant is for the corresponding matrix, when getting the list of all these matrices. $\endgroup$
    – gunes
    Nov 21, 2020 at 22:00
  • 2
    $\begingroup$ @gunes Use Map[{#,Det[#]}&,submatrixs] after the code above to see a list of each matrix followed by its determinant. If that # and & stuff is beyond you then use f[m_]:={m,Det[m]};Map[f,submatrixs] instead. I suggest you look up and study deeply the Map function. It will be very useful to you in the future. $\endgroup$
    – Bill
    Nov 21, 2020 at 22:08
  • 1
    $\begingroup$ @Bill Thank you! $\endgroup$
    – cvgmt
    Nov 21, 2020 at 23:30
5
$\begingroup$

Just fooling around, simply for the sake of speed:

matrix = Developer`ToPackedArray@{{1, 0, 2, 0, 1, 1}, {1, 1, 0, 1, 2, 
     1}, {1, 0, 0, 2, 1, 1}, {1, 1, 1, 2, 1, 1}, {2, 1, 1, 0, 1, 
     1}, {1, 2, 1, 2, 2, 1}, {2, 1, 1, 2, 1, 2}, {1, 2, 1, 1, 1, 
     1}, {0, 1, 1, 0, 1, 0}, {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 
     1}, {0, 0, 0, 0, 0, 1}};

submat = DeleteDuplicates@Pick[#, Positive[Abs[Det /@ N[#]] - 1.1]] &@
    Partition[
     matrix[[Flatten@
        Developer`ToPackedArray@Subsets[Range[Length@matrix], {6}]]], 
     Length@First@matrix]; // RepeatedTiming

(* {0.0030, Null}  *)

Matrices + determinants:

submat = Transpose@
        DeleteDuplicates@
         Pick[{#, Round[#2]}, Positive[Abs[{#2, #2}] - 1.1]] &[#, 
      Det /@ N[#]] &@
    Partition[
     matrix[[Flatten@
        Developer`ToPackedArray@Subsets[Range@Length@matrix, {6}]]], 
     Length@First@matrix]; // RepeatedTiming

(*  0.0032, Null}  *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.