; 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)))))
Like this:
Like Loading...
Related
Pages: 1 2 3 4 5 6 7 8 9 10
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.
[…] There are several pattern-matching libraries available for Scheme, but they are rather heavy (the one I use, by Friedman, Hilsdale and Dybvig, is over six hundred lines of code). Our Standard Prelude has a […]