Replace non-zero elements with symbol

Question

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

@J.M. it replaces non-zeros with blanks... And it looks like black magic — BlacKow, May 20 '16 at 15:52
@BlacKow, well, you can always do Verbatim[_] -> 1 if need be. :) — J. M.'s missing motivation, May 20 '16 at 15:56
Cross-ref: What are SparseArray Properties? How and when should they be used? — user1066, May 20 '16 at 19:33

Mr.Wizard · Answer 1 · 2016-05-20T16:59:36.853

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

Therefore you could visualize your complete array with something like:

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

Other possibilities exist if you have different needs.

kglr · Answer 2 · 2016-05-20T17:27:42.790

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

score 1 · Answer 3 · answered Jun 04 '18 at 05:48

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

score 1 · Answer 4 · answered Jun 04 '18 at 12:57

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)$

Replace non-zero elements with symbol

4 Answers4