3
$\begingroup$

I have a very large matrix (tensor) in Mathematica with some zero and non-zero elements. I am interested in replacing the non-zero elements with some symbol or a 1 so that it is easier to view the entire object.

I would include my code but there is a lot of preamble so here is an analogue of what I would like to work on:

{{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[a^2 + c^2], 
 0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}}, {{{0, 0, 
 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}}, {{{0, 0, 0}, {0, 
 0, 0}, {0, 0, 0}}}}

and I would like to output something like:

{{{{0, 1, 1}, {1, 0, 0}, {1, 0, 0}}}, {{{0, 0, 0}, {0, 1, 1}, {0, 1, 
 1}}}, {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}
$\endgroup$
  • 3
    $\begingroup$ Try SparseArray[array]["PatternArray"] // Normal. $\endgroup$ – J. M. is away May 20 '16 at 15:22
  • 1
    $\begingroup$ @J.M. it replaces non-zeros with blanks... And it looks like black magic $\endgroup$ – BlacKow May 20 '16 at 15:52
  • $\begingroup$ @BlacKow, well, you can always do Verbatim[_] -> 1 if need be. :) $\endgroup$ – J. M. is away May 20 '16 at 15:56
  • $\begingroup$ Map[Boole@*PossibleZeroQ, array, {4}] $\endgroup$ – BlacKow May 20 '16 at 16:13
  • $\begingroup$ Cross-ref: What are SparseArray Properties? How and when should they be used? $\endgroup$ – user1066 May 20 '16 at 19:33
5
$\begingroup$

I propose the use of ArrayComponents and Unitize:

array = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]},
           {-a Sqrt[a^2 + c^2], 0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}},
         {{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}},
         {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}};

array // ArrayComponents // Unitize
{{{{0, 1, 1}, {1, 0, 0}, {1, 0, 0}}},
 {{{0, 0, 0}, {0, 1, 1}, {0, 1, 1}}},
 {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}

For the purpose of visualization you may also be interested to know that MatrixPlot and ArrayPlot will handle symbolic element in the following way:

{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}} // ArrayPlot

enter image description here

Therefore you could visualize your complete array with something like:

array /. m_?MatrixQ :> ArrayPlot[m] // Grid

enter image description here

Other possibilities exist if you have different needs.

$\endgroup$
3
$\begingroup$
mat = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[a^2 + c^2], 0, 0},
          {-c Sqrt[a^2 + c^2], 0, 0}}}, 
        {{{0, 0, 0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}}, 
        {{{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}}}

You can use

f1 = Replace[#, Except[0 | _List] -> 1, Infinity] &;
f2 = SparseArray[SparseArray[#]["NonzeroPositions"] -> 1, Dimensions[#]] &;
f3 = Block[{f}, SetAttributes[f, Listable]; f[0] = 0; f[_] := 1; f@#] &;


f1 @ mat

Mathematica graphics

Equal @@ (Through[{f1, f2, f3}@mat])

True

$\endgroup$
1
$\begingroup$

I used the following code for almost a similar purpose. Hope it also helps you out:

mtx = {{{{0, -a Sqrt[a^2 + c^2], -c Sqrt[a^2 + c^2]}, {-a Sqrt[
    a^2 + c^2], 0, 0}, {-c Sqrt[a^2 + c^2], 0, 0}}}, {{{0, 0, 
  0}, {0, -2 a^2, -2 a c}, {0, -2 a c, -2 c^2}}}, {{{0, 0, 0}, {0,
   0, 0}, {0, 0, 0}}}};

  {Rw, Cl, rw, cl} = Dimensions[mtx];

  Do[
    If[
    mtx[[k, 1, i, j]] =!= 0,
    mtx[[k, 1, i, j]] = 1
    ],
    {k, Rw},
    {i, rw},
    {j, cl}
];
$\endgroup$
1
$\begingroup$

You could also use a Replace that only works at one level instead of all of them (as in @kglr's answer):

Replace[mat, Except[0]->1, {ArrayDepth[mat]}] //TeXForm

$\left( \begin{array}{c} \left( \begin{array}{ccc} 0 & 1 & 1 \\ 1 & 0 & 0 \\ 1 & 0 & 0 \\ \end{array} \right) \\ \left( \begin{array}{ccc} 0 & 0 & 0 \\ 0 & 1 & 1 \\ 0 & 1 & 1 \\ \end{array} \right) \\ \left( \begin{array}{ccc} 0 & 0 & 0 \\ 0 & 0 & 0 \\ 0 & 0 & 0 \\ \end{array} \right) \\ \end{array} \right)$

$\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.