fork download
copy 
  1. ; zeroing a matrix
  2.  
  3. (define (make-matrix rows columns . value)
  4.   (do ((m (make-vector rows)) (i 0 (+ i 1)))
  5.       ((= i rows) m)
  6.     (if (null? value)
  7.         (vector-set! m i (make-vector columns))
  8.         (vector-set! m i (make-vector columns (car value))))))
  9.  
  10. (define (matrix-rows x) (vector-length x))
  11.  
  12. (define (matrix-cols x) (vector-length (vector-ref x 0)))
  13.  
  14. (define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
  15.  
  16. (define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
  17.  
  18. (define-syntax for
  19.   (syntax-rules ()
  20.     ((for (var first past step) body ...)
  21.       (let ((ge? (if (< first past) >= <=)))
  22.         (do ((var first (+ var step)))
  23.             ((ge? var past))
  24.           body ...)))
  25.     ((for (var first past) body ...)
  26.       (let* ((f first) (p past) (s (if (< first past) 1 -1)))
  27.         (for (var f p s) body ...)))
  28.     ((for (var past) body ...)
  29.       (let* ((p past)) (for (var 0 p) body ...)))))
  30.  
  31. (define (adjoin x xs)
  32.   (if (member x xs) xs
  33.     (cons x xs)))
  34.  
  35. (define (zero mtrx)
  36.   (let ((rows (list)) (cols (list))
  37.         (n-rows (matrix-rows mtrx))
  38.         (n-cols (matrix-cols mtrx)))
  39.     (for (row 0 n-rows)
  40.       (for (col 0 n-cols)
  41.         (when (zero? (matrix-ref mtrx row col))
  42.           (set! rows (adjoin row rows))
  43.           (set! cols (adjoin col cols)))))
  44.     (do ((rows rows (cdr rows))) ((null? rows))
  45.       (for (col 0 n-cols)
  46.         (matrix-set! mtrx (car rows) col 0)))
  47.     (do ((cols cols (cdr cols))) ((null? cols))
  48.       (for (row 0 n-rows)
  49.         (matrix-set! mtrx row (car cols) 0)))
  50.     mtrx))
  51.  
  52. (display (zero '#(#(0 2 3 4 5)
  53.                   #(1 0 3 4 5)
  54.                   #(1 2 0 4 5)
  55.                   #(1 2 3 0 5)
  56.                   #(1 2 3 4 0))))
Success #stdin #stdout 0.02s 43200KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#(#(0 0 0 0 0) #(0 0 0 0 0) #(0 0 0 0 0) #(0 0 0 0 0) #(0 0 0 0 0))
https://ideone.com/X7roST
language:
Scheme (guile 2.2.4)
created:
7 years ago
visibility:
public

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!