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

Improve this question
$\endgroup$

9 Answers 9

Reset to default
15
$\begingroup$

Just another alternative.

x - ArrayPad[ArrayPad[x, -1], 1] // MatrixForm
Improve this answer
$\endgroup$
4
  • 2
    $\begingroup$ Quite an unusual approach but I like it. $\endgroup$
    – Mr.Wizard
    Commented Jul 9, 2014 at 19:32
  • 3
    $\begingroup$ Could also be written: x - Fold[ArrayPad, x, {-1, 1}] $\endgroup$
    – Mr.Wizard
    Commented Jul 9, 2014 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
    Commented Jul 10, 2014 at 1:38
  • $\begingroup$ @eldo Thank you! :) $\endgroup$
    – C. E. ♦
    Commented Jul 10, 2014 at 9:14
21
$\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}]]
Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Probably THE answer. Actually I tried Part but wasn't able to find your sequence. $\endgroup$
    – eldo
    Commented Jul 9, 2014 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
    Commented Jul 9, 2014 at 19:31
  • $\begingroup$ @Mr.Wizard I agree, now there is something different too :) $\endgroup$
    – Kuba
    Commented Jul 9, 2014 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)$

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ An equivalent method: zerofill[a_?MatrixQ] := (1 - BoxMatrix[Quotient[#, 2, 1] - 1, #]) &[Dimensions[a]] a $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Mar 18, 2018 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}]] &
Improve this answer
$\endgroup$
3
  • $\begingroup$ I never expected this to be faster than x[[2 ;; -2, 2 ;; -2]] but it is! Big +1! $\endgroup$
    – Mr.Wizard
    Commented Jul 9, 2014 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
    Commented Jul 10, 2014 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
    Commented Jul 11, 2014 at 1:21
8
$\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)$

Improve this answer
$\endgroup$
0
7
$\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}]
Improve this answer
$\endgroup$
3
  • 2
    $\begingroup$ +1. Just 0 & is enough. $\endgroup$
    – C. E. ♦
    Commented Jul 9, 2014 at 20:07
  • $\begingroup$ @ Pickett, thanks for the tip :) $\endgroup$
    – Basheer Algohi
    Commented Jul 9, 2014 at 20:18
  • $\begingroup$ @kuba, thanks,I have modified it for non square matrices. $\endgroup$
    – Basheer Algohi
    Commented Jul 9, 2014 at 20:23
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}]
Improve this answer
$\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]] &
Improve this answer
$\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

Improve this answer
$\endgroup$
1
  • $\begingroup$ @Kuba good point, easy to fix, will do in sec $\endgroup$
    – Nasser
    Commented Jul 10, 2014 at 7:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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