## Chez Scheme Setup

### October 3, 2017

; 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)))))

Advertisements

My apologies; the formatting got really messed up. I’ll work on fixing through the day today.

I think the pairing heap implementation will not scale to beyond stack limits since it uses non-tail recursion. An easy fix would be to replace the recursive calls in pq-merge-pairs with a fold of pq-merge on pre-paired arguments.