This note describes a Scheme solution to Task 206 Bitmap at the Sphere Online Judge. If you like, go read the problem definition now, and think about how you would solve it, before reading on to the solution. A word of warning: the problem is harder than it first appears.

Consider a bitmap of r rows and c columns; pixels may be 0 (black) or 1 (white), and at least one is white. The distance between two pixels is the Manhattan distance between them: if pixel1 is at row r1 and column c1, and pixel2 is at row r2 and column c2, the Manhattan distance between them is the absolute value of (- r1 r2) plus the absolute value of (- c1 c2).

The task is to write a program which reads a description of the bitmap, computes for each pixel the Manhattan distance to the nearest white pixel, and writes the result. For example, the bitmap below left, which can be represented as the list of strings "0001" "0011" "0110", should result in the distance matrix shown below right:
 ```0 0 0 1 0 0 1 1 0 1 1 0``` ```3 2 1 0 2 1 0 0 1 0 0 1```
Since Scheme doesn't support a native type of two-dimensional arrays, the first task is to simulate them using vectors of vectors:

```(define (make-array rows cols . default)
(do ((array (make-vector rows)) (r 0 (+ r 1))) ((= r rows) array)
(if (null? default)
(vector-set! array r (make-vector cols))
(vector-set! array r (make-vector cols (car default))))))
```

```(define (array-rows array) (vector-length array))
```

```(define (array-cols array) (vector-length (vector-ref array 0)))
```

```(define (array-ref array row col) (vector-ref (vector-ref array row) col))
```

```(define (array-set! array row col value) (vector-set! (vector-ref array row) col value))
```

```(define (copy-array old)
(let* ((nr (array-rows old)) (nc (array-cols old)) (new (make-array nr nc)))
(do ((r 0 (+ r 1))) ((= nr r) new)
(do ((c 0 (+ c 1))) ((= nc c))
(array-set! new r c (array-ref old r c))))))
```

```(define (display-array array)
(do ((r 0 (+ r 1))) ((>= r (vector-length array)))
(do ((c 0 (+ c 1))) ((>= c (vector-length (vector-ref array r))))
(display (vector-ref (vector-ref array r) c))
(if (= c (- (vector-length (vector-ref array r)) 1))
(newline)
(display " ")))))
```

Function array-init reads the input and creates the array, taking a list of strings that describes the bitmap and returning the initial array, with white cells represented as 0 and black cells represented as #f. The outer do loops over the strings xs, and the inner do loops over the characters in each of the strings. The array is initialized to #f, and each white pixel resets the appropriate element of array to 0. This representation uses a pun on the value of 0, which is simultaneously #t when used in a predicate and the Manhattan distance to the nearest white pixel.

```(define (array-init . xs)
(let* ((nr (length xs)) (nc (string-length (car xs))) (array (make-array nr nc #f)))
(do ((xs xs (cdr xs)) (r 0 (+ r 1))) ((null? xs) array)
(do ((c 0 (+ c 1))) ((= c nc))
(if (char=? (string-ref (car xs) c) #\1)
(array-set! array r c 0))))))
```

The obvious approach to calculating the distances for each black pixel involves iterating over the bitmap, calculating the distance for each black pixel by depth-first search of its neighbors, looking for a white pixel. That's possible, but involves some tricky coding to prevent re-entering a previously-visited cell during the search.

Instead, this solution uses a dynamic programming approach to the problem, building up a complete solution by iterating through a sequence of partial solutions. The initial partial solution marks each white pixel with a 0, as in array-init. In the first iteration, all the neighbors of those pixels are marked with a distance of 1; there can be no other pixels within one step from a white pixel. In the second iteration, all the neighbors of all the marked pixels are marked with a distance of 2; they can't be at a distance less than 2, because they aren't marked, but they are neighbors of a pixel that is marked, so they must be at a distance of 2 from the nearest white pixel. And so on, extending each partial solution until the entire distance array is calculated. All the marks at each iteration must be made simultaneously, so they don't interfere with the marking at the current distance; this is done by recording new distances on a copy of the array, then propagating the copy to the next round of changes.

```(define (bitmap array)
(let loop ((old array) (new (copy-array array)) (dist 1) (changed? #f))
(do ((r 0 (+ r 1))) ((= (array-rows old) r))
(do ((c 0 (+ c 1))) ((= (array-cols old) c))
(if (and (not (array-ref old r c))
(or (and (> r 0) (array-ref old (- r 1) c))
(and (< r (- (array-rows old) 1)) (array-ref old (+ r 1) c))
(and (> c 0) (array-ref old r (- c 1)))
(and (< c (- (array-cols old) 1)) (array-ref old r (+ c 1)))))
(begin (array-set! new r c dist)
(set! changed? #t)))))
(if changed? (loop new (copy-array new) (+ dist 1) #f) new)))
```

The predicate is a two-legged and; the expression (not (array-ref old r c)) searches for unoccupied pixels, and the or-expression searches for occupied neighbors. Any pixel may have four neighbors, above, below, left or right. The various clauses of the or-expression return #t if the pixel is within range (that is, isn't at the edge of the bitmap) and the neighbor is occupied.

Thus, the following dialog computes the distances for the sample bitmap:

```| > (display-array (bitmap (array-init "0001" "0011" "0110")))
| 3 2 1 0
| 2 1 0 0
| 1 0 0 1
```

The original task specified an input file containing multiple bitmaps in a particular format; a sample input file is available at bitmap.test. Read-bitmap reads the next bitmap from an input port, returning a list of strings, or null when the input is exhausted.

```(define (read-bitmap port)
'()
(let loop ((rows rows) (lines '()))
(if (zero? rows)
(reverse lines)
(loop (- rows 1) (cons (read-line port) lines)))))))
```

Bitmap-file calls read-bitmap to fetch the next bitmap from the input file, then computes and displays the array of distance array for each.

```(define (bitmap-file file-name)
(let ((port (open-input-file file-name)))
(if (null? bm)
(close-input-port port)
(begin (display-array (bitmap (apply array-init bm)))
(newline)
```

Read-line is copied from a standard library.

```(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p))) (char=? (peek-char p) c))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
```

By the way, here's what the bitmap function looks like in some other language, using -1 instead of #f to represent black pixels. Warning: this code hasn't been tested — it hasn't even been run.

```| int [] [] bitmap(int [] [] array)
| {
|
|     int [] [] old, new;
|     int nr, nc, dist, changed;
|
|     old = array;
|     new = copy(array);
|     nr = row_size(array);
|     nc = col_size(array);
|     dist = 0;
|
|     for (changed = 1; changed; ) {
|         changed = 0;
|         dist = dist + 1;
|         for (r = 0; r < nr; r++) {
|             for (c = 0; c < nc; c++) {
|                 if ( old[r][c] == -1
|                      && (  (r > 0      and old[r-1][c] > -1)
|                         || (r < nr - 1 and old[r+1][c] > -1)
|                         || (c > 0      and old[r][c-1] > -1)
|                         || (c < nc - 1 and old[r][c+1] > -1))) {
|                     new[r][c] = dist;
|                     changed = 1;
|                 }
|             }
|         }
|         old = new;
|     }
|     return new;
| }
```

Be glad you program in Scheme!