codepad

Language:

; word cube

(define (read-line . port)
  (define (eat p c)
    (if (and (not (eof-object? (peek-char p)))
             (char=? (peek-char p) c))
        (read-char p)))
  (let ((p (if (null? port) (current-input-port) (car port))))
    (let loop ((c (read-char p)) (line '()))
      (cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
            ((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
            ((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
            (else (loop (read-char p) (cons c line)))))))

(define sort #f)
(define merge #f)
(let ()
  (define dosort
    (lambda (pred? ls n)
      (if (= n 1)
          (list (car ls))
          (let ((i (quotient n 2)))
            (domerge pred?
                     (dosort pred? ls i)
                     (dosort pred? (list-tail ls i) (- n i)))))))
  (define domerge
    (lambda (pred? l1 l2)
      (cond
        ((null? l1) l2)
        ((null? l2) l1)
        ((pred? (car l2) (car l1))
         (cons (car l2) (domerge pred? l1 (cdr l2))))
        (else (cons (car l1) (domerge pred? (cdr l1) l2))))))
  (set! sort
    (lambda (pred? l)
      (if (null? l) l (dosort pred? l (length l)))))
  (set! merge
    (lambda (pred? l1 l2)
      (domerge pred? l1 l2))))

(define (subset? s1 s2)
  (let loop ((s1 s1) (s2 s2))
    (cond ((null? s1) #t) ((null? s2) #f)
          ((char<? (car s1) (car s2)) #f)
          ((char<? (car s2) (car s1))
            (loop s1 (cdr s2)))
          (else (loop (cdr s1) (cdr s2))))))

(define (wordcube puzzle)
  (let* ((ltrs (string->list puzzle))
         (must (string-ref puzzle 4))
         (sign (sort char<? ltrs)))
    (with-input-from-file "/usr/share/dict/words"
      (lambda ()
        (let loop ((word (read-line)) (words '()))
          (if (eof-object? word) (reverse words)
            (let ((ws (sort char<? (string->list word))))
              (if (and (< 3 (length ws))
                       (member must ws)
                       (subset? ws sign))
                  (loop (read-line) (cons word words))
                  (loop (read-line) words)))))))))

(display (wordcube "ncbcioune"))

Private [?]

Run code