[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/6fUMlr92    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Aug 10:
; word breaks

(define (make-hash hash eql? oops size)
  (let ((table (make-vector size '())))
    (lambda (message . args)
      (if (eq? message 'enlist)
          (let loop ((k 0) (result '()))
            (if (= size k)
                result
                (loop (+ k 1) (append (vector-ref table k) result))))
          (let* ((key (car args))
                 (index (modulo (hash key) size))
                 (bucket (vector-ref table index)))
            (case message
              ((lookup fetch get ref recall)
                (let loop ((bucket bucket))
                  (cond ((null? bucket) oops)
                        ((eql? (caar bucket) key) (cdar bucket))
                        (else (loop (cdr bucket))))))
              ((insert insert! ins ins! set set! store store! install install!)
                (vector-set! table index
                  (let loop ((bucket bucket))
                    (cond ((null? bucket)
                            (list (cons key (cadr args))))
                          ((eql? (caar bucket) key)
                            (cons (cons key (cadr args)) (cdr bucket)))
                          (else (cons (car bucket) (loop (cdr bucket))))))))
              ((delete delete! del del! remove remove!)
                (vector-set! table index
                  (let loop ((bucket bucket))
                    (cond ((null? bucket) '())
                          ((eql? (caar bucket) key)
                            (cdr bucket))
                          (else (cons (car bucket) (loop (cdr bucket))))))))
              ((update update!)
                (vector-set! table index
                  (let loop ((bucket bucket))
                    (cond ((null? bucket)
                            (list (cons key (caddr args))))
                          ((eql? (caar bucket) key)
                            (cons (cons key ((cadr args) key (cdar bucket))) (cdr bucket)))
                          (else (cons (car bucket) (loop (cdr bucket))))))))
              (else (error 'hash-table "unrecognized message")) ))))))

(define (string-hash str)
  (let loop ((cs (string->list str)) (s 0))
    (if (null? cs) s
      (loop (cdr cs) (+ (* s 31)
        (char->integer (car cs)))))))

(define dict '("a" "aa" "aaa" "ab" "apple"
  "apricot" "is" "pie" "test" "this"))

(define (segments str) ; exponential
  (if (member str dict) str
    (let ((len (string-length str)))
      (let loop ((i 1))
        (if (= i len) ""
          (let ((prefix (substring str 0 i)))
            (if (not (member prefix dict)) (loop (+ i 1))
              (let ((suffix (segments (substring str i len))))
                (if (string=? suffix "") (loop (+ i 1))
                  (string-append prefix " " suffix))))))))))

(display (segments "applepie")) (newline)
(display (segments "thisisatest")) (newline)
(display (segments "aaab")) (newline)

(define cache (make-hash string-hash string=? #f 97))

(define (segments str)
  (if (member str dict) str
    (if (cache 'lookup str) (cache 'lookup str)
      (let ((len (string-length str)))
        (let loop ((i 1))
          (if (= i len) ""
            (let ((prefix (substring str 0 i)))
              (if (not (member prefix dict)) (loop (+ i 1))
                (let ((suffix (segments (substring str i len))))
                  (if (string=? suffix "") (loop (+ i 1))
                    (let ((output (string-append prefix " " suffix)))
                      (cache 'insert str output) output)))))))))))

(display (segments "applepie")) (newline)
(display (segments "thisisatest")) (newline)
(display (segments "aaab")) (newline)


Output:
1
2
3
4
5
6
apple pie
this is a test
a a ab
apple pie
this is a test
a a ab


Create a new paste based on this one


Comments: