[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/i0n0uIS7    [ raw code | fork ]

programmingpraxis - Scheme, pasted on Feb 14:
; soundex

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (test)
  (let ((names1 (list "Euler"  "Gauss" "Hilbert"
                      "Knuth"  "Lloyd" "Lukasiewicz"))
        (names2 (list "Ellery" "Ghosh" "Heilbronn"
                      "Kant"   "Ladd"  "Lissajous"))
        (result (list "E460"   "G200"  "H416"
                      "K530"   "L300"  "L222")))
    (assert (map soundex names1) result)
    (assert (map soundex names2) result)))

(define (soundex str)
  (define (code c)
    ;            ABCDEFGHIJKLMNOPQRSTUVWXYZ
    (string-ref "01230120022455012623010202"
      (- (char->integer (char-upcase c)) 65)))
  (define (finish zs)
    (substring (list->string (reverse
      (append (list #\0 #\0 #\0) zs))) 0 4))
  (let* ((cs (cdr (map char-upcase (string->list str))))
         (f (string-ref str 0)) (fx (code f))
         (prev (if (char=? fx #\0) #\0 fx)))
    (let loop ((cs cs) (zs (list f)) (prev prev))
      (if (null? cs) (finish zs)
        (let ((z (code (car cs))))
          (cond ((char=? z prev) (loop (cdr cs) zs prev))
                ((char=? z #\0) (loop (cdr cs) zs #\0))
                (else (loop (cdr cs) (cons z zs) z))))))))


Output:
No errors or program output.


Create a new paste based on this one


Comments: