11
$\begingroup$

I have f.e. the following square matrix:

x = {{2, 5, 5, 11, 11, 23, 37, 41, 43, 47},
    {2, 5, 11, 17, 19, 23, 41, 41, 43, 67},
    {2, 7, 11, 19, 19, 41, 41, 43, 47, 73},
    {3, 11, 17, 19, 23, 41, 43, 53, 67, 79},
    {3, 11, 19, 19, 31, 43, 47, 59, 67, 83},
    {3, 17, 19, 29, 37, 43, 53, 59, 73, 83},
    {5, 17, 29, 31, 37, 47, 53, 71, 73, 83},
    {7, 19, 29, 31, 37, 53, 59, 73, 73, 89},
    {11, 23, 31, 41, 43, 53, 61, 73, 79, 97},
    {29, 29, 37, 41, 53, 67, 71, 79, 79, 97}};

I want to keep the first and last row / column and replace all other numbers with 0. I have written:

n = Length@First@x;

Table[x[[i, j]] = 0, {i, 2, n - 1}, {j, 2, n - 1}];

x // MatrixForm

enter image description here

Before that I tried to find a more functional solution (f.e. with replacement patterns) but gave up after some unsuccesful attempts. Thanks for showing me some alternatives.

$\endgroup$
14
$\begingroup$

Just another alternative.

x - ArrayPad[ArrayPad[x, -1], 1] // MatrixForm
$\endgroup$
  • 2
    $\begingroup$ Quite an unusual approach but I like it. $\endgroup$ – Mr.Wizard Jul 9 '14 at 19:32
  • 3
    $\begingroup$ Could also be written: x - Fold[ArrayPad, x, {-1, 1}] $\endgroup$ – Mr.Wizard Jul 9 '14 at 19:52
  • $\begingroup$ @Pickett Without doing any speed comparisons I would like to accept your answer because it is so clever and, like Mr. Wizard remarked, "unusual". $\endgroup$ – eldo Jul 10 '14 at 1:38
  • $\begingroup$ @eldo Thank you! :) $\endgroup$ – C. E. Jul 10 '14 at 9:14
20
$\begingroup$

You can do:

x[[2 ;; -2, 2 ;; -2]] = 0;
x

or

ReplacePart[x, {i, j} -> 0 /; And @@ MapThread[Less, {{1, 1}, {i, j}, Dimensions@x}]]
$\endgroup$
  • 1
    $\begingroup$ Probably THE answer. Actually I tried Part but wasn't able to find your sequence. $\endgroup$ – eldo Jul 9 '14 at 19:06
  • 1
    $\begingroup$ This is what I thought to use as well, but please note that this does in-place modification. That's often advantageous but if you don't want it you'll have to make a copy. $\endgroup$ – Mr.Wizard Jul 9 '14 at 19:31
  • $\begingroup$ @Mr.Wizard I agree, now there is something different too :) $\endgroup$ – Kuba Jul 9 '14 at 19:42
10
$\begingroup$

Although I believe that Kuba's first method is the best approach here is another:

zerofill[a_] := a (1 - BoxMatrix[#/2 - 2, #]) & @ Dimensions @ a

Now:

Array[Times, {5, 8}] // zerofill // MatrixForm

$\left( \begin{array}{cccccccc} 1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 \\ 2 & 0 & 0 & 0 & 0 & 0 & 0 & 16 \\ 3 & 0 & 0 & 0 & 0 & 0 & 0 & 24 \\ 4 & 0 & 0 & 0 & 0 & 0 & 0 & 32 \\ 5 & 10 & 15 & 20 & 25 & 30 & 35 & 40 \end{array} \right)$

$\endgroup$
  • 1
    $\begingroup$ An equivalent method: zerofill[a_?MatrixQ] := (1 - BoxMatrix[Quotient[#, 2, 1] - 1, #]) &[Dimensions[a]] a $\endgroup$ – J. M. will be back soon Mar 18 '18 at 9:51
10
$\begingroup$

This performs quite well on large matrices, seems to outrun the others I've tested so far:

Module[{z = ConstantArray[0, Dimensions@#]},
  z[[1, All]] = #[[1, All]];
  z[[All, 1]] = #[[All, 1]];
  z[[-1, All]] = #[[-1, All]];
  z[[All, -1]] = #[[All, -1]];
  z] &

For really large arrays, it would behoove one to work in the sparse domain, where the following is even faster and certainly more memory efficient:

With[{r = First@Dimensions@#, c = Last@Dimensions@#},
  SparseArray[
   Join[Tuples[{{1}, Range@c}], Tuples[{{r}, Range@c}], 
        Tuples[{Range@r, {1}}], Tuples[{Range@r, {c}}]] -> 
    Join[#[[1]], #[[r]], #[[All, 1]], #[[All, c]]], {r, c}]] &
$\endgroup$
  • $\begingroup$ I never expected this to be faster than x[[2 ;; -2, 2 ;; -2]] but it is! Big +1! $\endgroup$ – Mr.Wizard Jul 9 '14 at 23:27
  • $\begingroup$ @Mr.Wizard: Yes, I was surprised (a bit - I expected faster, just not the degree) - but makes sense - less copy (direct or pointer) involved. I kind of like the update sparse method - even faster than the order of magnitude faster than accepted of the first (would be nice if posters specified they want 'clever' vs efficient)... Thx for +! $\endgroup$ – ciao Jul 10 '14 at 4:32
  • $\begingroup$ @rasher I'm sorry, I tested your code (and upvoted it), but I don't have enough experience to make reliable speed comparisons. $\endgroup$ – eldo Jul 11 '14 at 1:21
6
$\begingroup$
n = Dimensions[x];
ReplacePart[x, {i_, j_} /;2 <= i <= n[[1]] - 1 && 2 <= j <= n[[2]] - 1 :> 0]

another way:

MapAt[0 &, x, {2 ;; -2, 2 ;; -2}]
$\endgroup$
  • 2
    $\begingroup$ +1. Just 0 & is enough. $\endgroup$ – C. E. Jul 9 '14 at 20:07
  • $\begingroup$ @ Pickett, thanks for the tip :) $\endgroup$ – Algohi Jul 9 '14 at 20:18
  • $\begingroup$ @kuba, thanks,I have modified it for non square matrices. $\endgroup$ – Algohi Jul 9 '14 at 20:23
6
$\begingroup$

MorphologicalPerimeter

x MorphologicalPerimeter[$MaxMachineNumber + x] // MatrixForm // TeXForm

$\left( \begin{array}{cccccccccc} 2 & 5 & 5 & 11 & 11 & 23 & 37 & 41 & 43 & 47 \\ 2 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 67 \\ 2 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 73 \\ 3 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 79 \\ 3 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 83 \\ 3 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 83 \\ 5 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 83 \\ 7 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 89 \\ 11 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 97 \\ 29 & 29 & 37 & 41 & 53 & 67 & 71 & 79 & 79 & 97 \\ \end{array} \right)$

If there are no zeros on the perimeter of the input matrix, you can use MorphologicalPerimeter[x] instead of MorphologicalPerimeter[$MaxMachineNumber + x].

# MorphologicalPerimeter[$MaxMachineNumber + #] &@RandomInteger[5, {5, 15}] // 
  MatrixForm // TeXForm

$\left(\begin{array}{ccccccccccccccc} 4 & 0 & 2 & 1 & 5 & 0 & 1 & 5 & 0 & 2 & 2 & 0 & 0 & 0 & 4 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 5 \\ 3 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 1 \\ 5 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 3 \\ 0 & 1 & 2 & 5 & 3 & 4 & 4 & 3 & 4 & 0 & 2 & 4 & 5 & 3 & 4 \\ \end{array}\right)$

$\endgroup$
  • 3
    $\begingroup$ +1 - that's cool! $\endgroup$ – ciao Jan 16 '18 at 0:25
  • $\begingroup$ thank you @ciao. $\endgroup$ – kglr Jan 16 '18 at 0:32
3
$\begingroup$
       # ArrayPad[ConstantArray[0, Dimensions@# - 2], 1, 1] &@ 
             Array[Times, {5, 8}] 

or

       # SparseArray[# -> 1 & /@
           Flatten[{#, Reverse@# } &@ 
                  {_, #} & /@ {1, -1}, 1],
                    Dimensions@#] &@  Array[Times, {5, 8}] 
$\endgroup$
3
$\begingroup$

A variation on @rasher's post:

border = Module[{a = ConstantArray[0, Dimensions@#], i = {1, -1}}, 
                {a[[i]], a[[All, i]]} = {#[[i]], #[[All, i]]}; a] &

border@x //MatrixForm

enter image description here

and another SparseArray variation

border2 = Module[{a = ConstantArray[0, Dimensions@# - 2], d = Dimensions@#}, 
                  # SparseArray[Band[{2, 2}] -> a, d, 1]] &
$\endgroup$
3
$\begingroup$

All the good answers are given. For fun, here is one using SparseArray

 {n, m} = Dimensions[x];
 x = SparseArray[{{i_, j_} /; j == 1||j == m||i == 1||i == n} :> {x[[i, j]]}, {n, m}];
 MatrixForm[x]

Mathematica graphics

$\endgroup$
  • $\begingroup$ @Kuba good point, easy to fix, will do in sec $\endgroup$ – Nasser Jul 10 '14 at 7:53

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.