Programming Praxis

; miscellaneous.ss

; useful functions not appearing elsewhere
; do not load this file; instead copy/paste code from here to your program

; make a temporary filename that doesn't currently exist
(define (tempname)
  (let loop ((i 0))
    (let ((f (string-append "temp" (number->string i))))
      (if (file-exists? f) (loop (+ i 1)) f))))

; fetch file from the internet
(define (with-input-from-url url thunk)
  ; (define wget "c:\cygwin\bin\wget -qO") ; windows/cygwin
  ; (define wget "/usr/local/bin/wget -qO") ; unix/hp
  (define wget "/usr/bin/wget -q0") ; linux/ubuntu
  (let ((f (tempname)))
    (if (zero? (system (string-append wget " " f " " url)))
        (begin (with-input-from-file f thunk) (delete-file f #t))
        (error 'with-input-from-url "system error in wget"))))

; generator pushback
(define-generator (pushback val gen)

; matrix determinant and inverse
(define (sub-matrix a i j)
  (let ((r (matrix-rows a)) (c (matrix-cols a)))
    (let ((m (make-matrix (- r 1) (- c 1))) (new-i -1))
      (for (old-i c)
        (when (not (= old-i i))
          (set! new-i (+ new-i 1))
          (let ((new-j -1))
            (for (old-j r)
              (when (not (= old-j j))
                (set! new-j (+ new-j 1))
                (matrix-set! m new-i new-j
                  (matrix-ref a old-i old-j)))))))
      m)))
(define (matrix-determinant a) ; assume a is square
  (let ((n (matrix-rows a)))
    (if (= n 2)
        (- (* (matrix-ref a 0 0) (matrix-ref a 1 1))
           (* (matrix-ref a 1 0) (matrix-ref a 0 1)))
        (let loop ((j 0) (k 1) (d 0))
          (if (= j n) d
            (loop (+ j 1) (* k -1)
                  (+ d (* k (matrix-ref a 0 j)
                          (matrix-determinant
                            (sub-matrix a 0 j))))))))))
(define (matrix-cofactors a) ; assume a is square
  (let* ((n (matrix-rows a)) (cof (make-matrix n n)))
    (if (= n 2)
        (for (i n)
          (for (j n)
            (matrix-set! cof i j
              (* (expt -1 (+ i j))
                 (matrix-ref a (- 1 i) (- 1 j))))))
        (for (i n)
          (for (j n)
            (matrix-set! cof i j
              (* (expt -1 (+ i j))
                 (matrix-determinant (sub-matrix a i j)))))))
    cof))
(define (matrix-adjugate a)
  (matrix-transpose (matrix-cofactors a)))
(define (matrix-inverse a)
  (matrix-scalar-multiply
    (/ (matrix-determinant a))
    (matrix-adjugate a)))
  (yield val) (while #t (yield (gen))))

; make memoized version of a function
(define-syntax define-memoized
  (syntax-rules ()
    ((define-memoized (f arg ...) body ...)
      (define f
        (let ((cache (list)))
          (lambda (arg ...)
            (cond ((assoc `(,arg ...) cache) => cdr)
            (else (let ((val (begin body ...)))
                    (set! cache (cons (cons `(,arg ...) val) cache))
                    val)))))))))

; higher-order string functions
(define (string-map proc str)
  (let* ((len (string-length str))
         (out (make-string len)))
    (do ((i 0 (+ i 1)))
        ((= i len) out)
      (string-set! out i
        (proc (string-ref str i))))))
(define (string-for-each proc str)
  (do ((i 0 (+ i 1)))
      ((= i (string-length str)))
    (proc (string-ref str i))))
(define (string-fold proc base str)
  (let loop ((base base) (i 0))
    (if (= i (string-length str)) base
      (loop (proc (string-ref str i) base) (+ i 1)))))

Pages: 1 2 3 4 5 6 7 8 9 10