Islands
Given a boolean matrix, identify regions which are orthogonally connected.
col: {x*(^x)#1+!*/^x} / give each 1 a unique id
ab: {e:{(0,)'x};+(e(+e x))} / add a border of zeroes
rb: {(1_)'1_ x} / remove the border of zeroes
adj: {(,x),(-1 1!'\:x),(-1 1)!\:x} / adjacent cells
mrg: {(~~x)*|/adj x} / merge neighboring ids
rc: {l:0,,/x;g:=l;l[g]:!#g;(^x)#1_ l} / renumber ids sequentially
isl: {rc rb(mrg/col ab x)} / find islands
For example,
grid
(1 0 0 0 1
1 1 1 0 0
0 0 0 0 1
0 0 0 1 1
1 0 1 1 1
0 0 1 0 1)
isl grid
(1 0 0 0 2
1 1 1 0 0
0 0 0 0 3
0 0 0 3 3
4 0 3 3 3
0 0 3 0 3)
The general approach is to assign each nonzero cell of the starting matrix an arbitrary "color" and then progressively merge the color of adjacent regions. When the process is complete we recolor each region sequentially to make the result clearer.
This implementation assumes the grid does not wrap around the edges, but finding islands on a torus is even simpler:
grid
(0 0 0 0 1 0
1 0 1 0 1 1
1 0 0 0 0 0
1 1 0 1 1 0)
rc (mrg/col grid)
(0 0 0 0 1 0
1 0 2 0 1 1
1 0 0 0 0 0
1 1 0 1 1 0)
To assign colors to nonzero cells, we reshape an enumeration to match the matrix and multiply it by the matrix. This enumeration must start at 1, because the color 0 will represent impassable cells.
grid
(1 0 0 0 0 0
1 0 1 0 1 1
1 0 0 0 1 0
1 1 0 1 1 0)
^grid
4 6
*/^grid
24
1+!*/^grid
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
(^grid)#1+!*/^grid
(1 2 3 4 5 6
7 8 9 10 11 12
13 14 15 16 17 18
19 20 21 22 23 24)
grid*(^grid)#1+!*/^grid
(1 0 0 0 0 0
7 0 9 0 11 12
13 0 0 0 17 0
19 20 0 22 23 0)
col: {x*(^x)#1+!*/^x}
Finding a cell's neighbors can be accomplished by rolling the original matrix vertically and horizontally. To ensure that this process does not count opposing edges as neighbors we will first pad the grid with a row and column of 0. There are a number of ways to do this. One approach is catenating 0 onto each row, and doing this twice, flipping the matrix each time.
4 3#5
(5 5 5
5 5 5
5 5 5
5 5 5)
(0,)'4 3#5
(0 5 5 5
0 5 5 5
0 5 5 5
0 5 5 5)
+(0,)'4 3#5
(0 0 0 0
5 5 5 5
5 5 5 5
5 5 5 5)
(0,)'+(0,)'4 3#5
(0 0 0 0 0
0 5 5 5 5
0 5 5 5 5
0 5 5 5 5)
+(0,)'+(0,)'4 3#5
(0 0 0 0
0 5 5 5
0 5 5 5
0 5 5 5
0 5 5 5)
ab: {e:{(0,)'x};+(e(+e x))}
While we're at it, let's write the corresponding procedure to remove this padding. Again, there are many ways to go about this. One way is to perform matrix compression by creating lists of the indices of the rows and columns we want to retain from the original matrix. These lists should start at one and have magnitudes one less than the shape of the matrix.
t
(0 0 0 0
0 5 5 5
0 5 5 5
0 5 5 5
0 5 5 5)
^t
5 4
-1+^t
4 3
!:'-1+^t
(0 1 2 3
0 1 2)
1+!:'-1+^t
(1 2 3 4
1 2 3)
t 1+!:'-1+^t
(5 5 5
5 5 5
5 5 5
5 5 5)
rb: {x 1+!:'-1+^x}
A simpler approach is to use the drop operator, first on the entire matrix to remove the first row and then to each element of the matrix to remove the first column.
t
(0 0 0 0
0 5 5 5
0 5 5 5
0 5 5 5
0 5 5 5)
1_ t
(0 5 5 5
0 5 5 5
0 5 5 5
0 5 5 5)
(1_)'t
(0 0 0
5 5 5
5 5 5
5 5 5
5 5 5)
(1_)'1_ t
(5 5 5
5 5 5
5 5 5
5 5 5)
Finding the neighbors of each color is straightforward. Create a list of vertically shifted matrices, horizontally shifted matrices and the original matrix. Simple modifications to this routine could include diagonal neighbors if desired.
t
(0 0 0 0
0 0 1 0
0 2 3 0
0 0 0 0)
(-1 1)!\:t
((0 0 0 0
0 0 0 0
0 0 1 0
0 2 3 0)
(0 0 1 0
0 2 3 0
0 0 0 0
0 0 0 0))
(-1 1)!'\:t
((0 0 0 0
0 0 0 1
0 0 2 3
0 0 0 0)
(0 0 0 0
0 1 0 0
2 3 0 0
0 0 0 0))
adj: {(,x),(-1 1!'\:x),(-1 1)!\:x}
The maximum of the shifted matrices gives the highest valued color which can reach a given cell with one orthogonal shift. Multiplying this by the original boolean matrix masks away any neighboring cells which are impassable.
t
(0 0 0 0
0 0 1 0
0 2 3 0
0 0 0 0)
|/adj t
(0 0 1 0
0 2 3 1
2 3 3 3
0 2 3 0)
~~t
(0 0 0 0
0 0 1 0
0 1 1 0
0 0 0 0)
(~~t)*|/adj t
(0 0 0 0
0 0 3 0
0 3 3 0
0 0 0 0)
mrg: {(~~x)*|/adj x}
With these definitions, we simply need to take the fixed point of our color coalescing function applied to the color matrix. Observe the progress of this iteration with scan:
t
(0 0 0 0
0 1 2 3
0 0 0 4
0 7 6 5)
mrg\t
((0 0 0 0
0 1 2 3
0 0 0 4
0 7 6 5)
(0 0 0 0
0 2 3 4
0 0 0 5
0 7 7 6)
(0 0 0 0
0 3 4 5
0 0 0 6
0 7 7 7)
(0 0 0 0
0 4 5 6
0 0 0 7
0 7 7 7)
(0 0 0 0
0 5 6 7
0 0 0 7
0 7 7 7)
(0 0 0 0
0 6 7 7
0 0 0 7
0 7 7 7)
(0 0 0 0
0 7 7 7
0 0 0 7
0 7 7 7))
Recoloring the matrix makes it easier to identify regions at a glance. To do this we join the rows of the matrix, group them and renumber the elments of the group based on their index, and then reshape the result to fit the original matrix. To ensure that 0 is the first group found, we catenate a 0 onto the beginning of the list and strip it off at the end of this process. (This step is not strictly necessary if done before rb due to ab's padding, but we include it to make rc more general.)
t
(5 5 0 0
0 0 39 0
12 0 39 39)
l:0,,/t
0 5 5 0 0 0 0 39 0 12 0 39 39
g:=l
(0 3 4 5 6 8 10
1 2
7 11 12
,9)
!#g
0 1 2 3
l[g]:!#g
(0 0 0 0 0 0 0
1 1
2 2 2
,3)
l
0 1 1 0 0 0 0 2 0 3 0 2 2
1_ l
1 1 0 0 0 0 2 0 3 0 2 2
(^t)#1_ l
(1 1 0 0
0 0 2 0
3 0 2 2)
rc: {l:0,,/x;g:=l;l[g]:!#g;(^x)#1_ l}