Group Abstract

Message Boards

WOLFRAM COMMUNITY

8.4K Views

4 Replies

17 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

ArrayCrop: anti ArrayPad, à la ImageCrop

Vitaliy Kaurov

Vitaliy Kaurov, WOLFRAM Research

Posted 9 years ago

I sometimes need a function that would remove background of constant elements from an array, which surround a non-background array block. This is an opposite (so not always inverse) action to an `ArrayPad`. `ArrayCrop` is to `ArrayPad` as `ImageCrop` to `ImagePad`. Did I miss a built-in function that allows to do this? Can function below be improved? While you ponder about it, I will share a version I wrote, at least for programming exercise sake. It is based on `SparseArray` as it contains all needed information about background. Here is the function: Clear@ArrayCrop; ArrayCrop[m_,v_]:= Module[ { ar=Most[ArrayRules[SparseArray[m, Automatic, v]]], corn }, corn=Map[Min,Transpose[ar[[All,1]]]]; Normal[ SparseArray[ Rule@@@Thread[{ Map[#-corn+1&,ar[[All,1]]], ar[[All,2]] }], Automatic, v ] ] ] ArrayCrop[m_]:=ArrayCrop[m,0] 1D case Automatic removal of $0$: l = ArrayPad[{x, y, z}, {2, 3}] ArrayCrop[l] Out[1]= {0, 0, x, y, z, 0, 0, 0} Out[2]= {x, y, z} Specify element to remove: l = ArrayPad[{x, y, z}, {2, 3}, w] ArrayCrop[l, w] Out[1]= {w, w, x, y, z, w, w, w} Out[2]= {x, y, z} 2D case Automatic removal of $0$, - note the $0$-corner cases: m = ArrayPad[{{0, x, 0}, {x, x, x}, {0, x, 0}}, {{1, 2}, {3, 4}}]; MatrixForm[m] ArrayCrop[m] // MatrixForm Specify element to remove: m = ArrayPad[{{w, x, w}, {x, x, x}, {w, x, w}}, {{1, 2}, {3, 4}}, w]; MatrixForm[m] ArrayCrop[m, w] // MatrixForm 3D case core = RandomInteger[2, {2, 3, 4}]; pad = ArrayPad[core, {{1, 1}, {1, 1}, {1, 1}}]; AbsoluteTiming[ArrayCrop[pad] === core] Image3D[#, ImageSize -> 200] & /@ {core, pad, ArrayCrop[pad]} 5D case core = RandomInteger[9, {10, 20, 30, 40, 50}]; pad = ArrayPad[core, {{1, 1}, {2, 4}, {5, 6}, {7, 8}, {9, 10}}]; AbsoluteTiming[ArrayCrop[pad] === core] Out[]= {25.0324, True} Attachments:

I sometimes need a function that would remove background of constant elements from an array, which surround a non-background array block. This is an opposite (so not always inverse) action to an ArrayPad. ArrayCrop is to ArrayPad as ImageCrop to ImagePad.

Did I miss a built-in function that allows to do this?
Can function below be improved?

While you ponder about it, I will share a version I wrote, at least for programming exercise sake. It is based on SparseArray as it contains all needed information about background. Here is the function:

Clear@ArrayCrop;

ArrayCrop[m_,v_]:=
Module[
    {
    ar=Most[ArrayRules[SparseArray[m, Automatic, v]]],
    corn
    }, 

    corn=Map[Min,Transpose[ar[[All,1]]]];

    Normal[
       SparseArray[
         Rule@@@Thread[{
          Map[#-corn+1&,ar[[All,1]]],
          ar[[All,2]]
          }],
          Automatic,
          v
       ]
    ]
]

ArrayCrop[m_]:=ArrayCrop[m,0]

1D case

Automatic removal of $0$:

l = ArrayPad[{x, y, z}, {2, 3}]
ArrayCrop[l]

Out[1]= {0, 0, x, y, z, 0, 0, 0}  
Out[2]= {x, y, z}

Specify element to remove:

l = ArrayPad[{x, y, z}, {2, 3}, w]
ArrayCrop[l, w]

Out[1]= {w, w, x, y, z, w, w, w}    
Out[2]= {x, y, z}

2D case

Automatic removal of $0$, - note the $0$-corner cases:

m = ArrayPad[{{0, x, 0}, {x, x, x}, {0, x, 0}}, {{1, 2}, {3, 4}}];
MatrixForm[m]
ArrayCrop[m] // MatrixForm

enter image description here

Specify element to remove:

m = ArrayPad[{{w, x, w}, {x, x, x}, {w, x, w}}, {{1, 2}, {3, 4}}, w];
MatrixForm[m]
ArrayCrop[m, w] // MatrixForm

enter image description here

3D case

core = RandomInteger[2, {2, 3, 4}];
pad = ArrayPad[core, {{1, 1}, {1, 1}, {1, 1}}];
AbsoluteTiming[ArrayCrop[pad] === core]
Image3D[#, ImageSize -> 200] & /@ {core, pad, ArrayCrop[pad]}

enter image description here

5D case

core = RandomInteger[9, {10, 20, 30, 40, 50}];
pad = ArrayPad[core, {{1, 1}, {2, 4}, {5, 6}, {7, 8}, {9, 10}}];
AbsoluteTiming[ArrayCrop[pad] === core]

Out[]= {25.0324, True}

POSTED BY: Vitaliy Kaurov

4 Replies

Sort By:

Sander Huisman

Sander Huisman, University of Twente

Posted 9 years ago

POSTED BY: Sander Huisman

Sander Huisman

Sander Huisman, University of Twente

Posted 9 years ago

I don't think you missed a particular function. Though it can be done faster. For one, you don't need to scan/touch the 'core', I can just start looking at the edge, and once I see non-padding I don't have to scan further. By cyclically Transposing the data I can check if that digit (array, matrix, hypermatrix) is only the padding stuff and if so, remove it. It can be done also without transposing but it is trickier... $HistoryLength = 1; ClearAll[ArrayCrop, DeleteStart, DeleteM, TransposeAndDelete] DeleteStart[m_, pad_] := Module[{len}, len = LengthWhile[m, MatchQ[Flatten[{#}], {pad ..}] &]; Drop[m, len] ] DeleteM[m_, pad_] := Reverse[DeleteStart[Reverse[DeleteStart[m, pad]], pad]] TransposeAndDelete[m_, pad_] := DeleteM[Transpose[m, RotateLeft[Range[Depth[m] - 1]]], pad] ArrayCrop2[m_, pad_] := Nest[TransposeAndDelete[#, pad] &, m, Depth[m] - 1] ArrayCrop2[m_] := ArrayCrop2[m, 0] 1D: core = {x, y, z}; l = ArrayPad[core, {2, 3}] ArrayCrop[l] === ArrayCrop2[l] === core 2D: core = {{0, x, y}, {x, x, x}, {0, x, 0}}; m = ArrayPad[core, {{1, 2}, {3, 4}}]; ArrayCrop[m] === ArrayCrop2[m] === core 5D: core=RandomInteger[9,{10,20,30,40,50}]; pad=ArrayPad[core,{{1,1},{2,4},{5,6},{7,8},{9,10}}]; AbsoluteTiming[ac=ArrayCrop[pad];] AbsoluteTiming[ac2=ArrayCrop2[pad];] core===ac===ac2 5x speed up compared to your solution for big solutions, there may be room for more improvement by passing things by reference...

I don't think you missed a particular function. Though it can be done faster. For one, you don't need to scan/touch the 'core', I can just start looking at the edge, and once I see non-padding I don't have to scan further. By cyclically Transposing the data I can check if that digit (array, matrix, hypermatrix) is only the padding stuff and if so, remove it. It can be done also without transposing but it is trickier...

$HistoryLength = 1;
ClearAll[ArrayCrop, DeleteStart, DeleteM, TransposeAndDelete]
DeleteStart[m_, pad_] := Module[{len},
  len = LengthWhile[m, MatchQ[Flatten[{#}], {pad ..}] &];
  Drop[m, len]
  ]
DeleteM[m_, pad_] := Reverse[DeleteStart[Reverse[DeleteStart[m, pad]], pad]]
TransposeAndDelete[m_, pad_] := DeleteM[Transpose[m, RotateLeft[Range[Depth[m] - 1]]], pad]
ArrayCrop2[m_, pad_] := Nest[TransposeAndDelete[#, pad] &, m, Depth[m] - 1]
ArrayCrop2[m_] := ArrayCrop2[m, 0]

1D:

core = {x, y, z};
l = ArrayPad[core, {2, 3}]
ArrayCrop[l] === ArrayCrop2[l] === core

2D:

core = {{0, x, y}, {x, x, x}, {0, x, 0}};
m = ArrayPad[core, {{1, 2}, {3, 4}}];
ArrayCrop[m] === ArrayCrop2[m] === core

5D:

core=RandomInteger[9,{10,20,30,40,50}];
pad=ArrayPad[core,{{1,1},{2,4},{5,6},{7,8},{9,10}}];
AbsoluteTiming[ac=ArrayCrop[pad];]
AbsoluteTiming[ac2=ArrayCrop2[pad];]
core===ac===ac2

5x speed up compared to your solution for big solutions, there may be room for more improvement by passing things by reference...

POSTED BY: Sander Huisman

Sander Huisman

Sander Huisman, University of Twente

Posted 9 years ago

The DeleteStart function should be called DropWhile perhaps, but that is not (yet) an existing function but would fit in with TakeWhile.

POSTED BY: Sander Huisman

Michael Hale

Posted 9 years ago

Position and Extract allow a more direct approach than SparseArray while keeping the logic similar. Shorter code plus a 2-3x speedup on the 5D case makes a good trade I think. ArrayCrop[a_, b_] := Extract[a, Span @@@ MinMax /@ Transpose@Position[a, Except@b, {-1}, Heads -> False]] ArrayCrop[a_] := ArrayCrop[a, 0]

POSTED BY: Michael Hale

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback