fork(4) download
copy 
  1. ; matrix fill-in
  2.  
  3. (define (matrix-rows x) (vector-length x))
  4.  
  5. (define (matrix-cols x) (vector-length (vector-ref x 0)))
  6.  
  7. (define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
  8.  
  9. (define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
  10.  
  11. (define-syntax for
  12.   (syntax-rules ()
  13.     ((for (var first past step) body ...)
  14.       (let ((ge? (if (< first past) >= <=)))
  15.         (do ((var first (+ var step)))
  16.             ((ge? var past))
  17.           body ...)))
  18.     ((for (var first past) body ...)
  19.       (let* ((f first) (p past) (s (if (< first past) 1 -1)))
  20.         (for (var f p s) body ...)))
  21.     ((for (var past) body ...)
  22.       (let* ((p past)) (for (var 0 p) body ...)))))
  23.  
  24. (define (fill-in m)
  25.   (let ((nrows (matrix-rows m))
  26.         (ncols (matrix-cols m))
  27.         (xs (list)))
  28.     (for (r 0 nrows)
  29.       (for (c 0 ncols)
  30.         (when (= (matrix-ref m r c) 1)
  31.           (set! xs (cons (cons r c) xs)))))
  32.     (let loop ((xs xs))
  33.       (cond ((null? xs) m)
  34.       (else (for (r 0 nrows)
  35.               (matrix-set! m r (cdar xs) 1))
  36.             (for (c 0 ncols)
  37.               (matrix-set! m (caar xs) c 1))
  38.             (loop (cdr xs)))))))
  39.  
  40. (display
  41.   (fill-in '#(
  42.     #(0 0 0 0 0)
  43.     #(0 0 0 0 0)
  44.     #(0 0 0 1 0)
  45.     #(1 0 0 0 0)
  46.     #(0 0 0 0 0))))
Success #stdin #stdout 0.06s 8792KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#(#(1 0 0 1 0) #(1 0 0 1 0) #(1 1 1 1 1) #(1 1 1 1 1) #(1 0 0 1 0))
https://ideone.com/zDuUDl
language:
Scheme (guile 2.2.4)
created:
8 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!