; optimal alphabetical order

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))
          ((pred? (car xs))
            (loop (cdr xs) (cons (car xs) ys)))
          (else (loop (cdr xs) ys)))))

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
  (define (mod-diff x y) (modulo (- x y) two31)) ; generic version
  ; (define (mod-diff x y) (logand (- x y) #x7FFFFFFF)) ; fast version
  (define (flip-cycle)
    (do ((ii 1 (+ ii 1)) (jj 32 (+ jj 1))) ((< 55 jj))
      (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
    (do ((ii 25 (+ ii 1)) (jj 1 (+ jj 1))) ((< 55 ii))
      (vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
    (set! fptr 54) (vector-ref a 55))
  (define (init-rand seed)
    (let* ((seed (mod-diff seed 0)) (prev seed) (next 1))
      (vector-set! a 55 prev)
      (do ((i 21 (modulo (+ i 21) 55))) ((zero? i))
        (vector-set! a i next) (set! next (mod-diff prev next))
        (set! seed (+ (quotient seed 2) (if (odd? seed) #x40000000 0)))
        (set! next (mod-diff next seed)) (set! prev (vector-ref a i)))
      (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle)))
  (define (next-rand)
    (if (negative? (vector-ref a fptr)) (flip-cycle)
      (let ((next (vector-ref a fptr))) (set! fptr (- fptr 1)) next)))
  (define (unif-rand m)
    (let ((t (- two31 (modulo two31 m))))
      (let loop ((r (next-rand)))
        (if (<= t r) (loop (next-rand)) (modulo r m)))))
  (init-rand 19380110) ; happy birthday donald e knuth
  (set! rand (lambda seed
    (cond ((null? seed) (/ (next-rand) two31))
          ((eq? (car seed) 'get) (cons fptr (vector->list a)))
          ((eq? (car seed) 'set) (set! fptr (caadr seed))
                                 (set! a (list->vector (cdadr seed))))
          (else (/ (init-rand (modulo (numerator
                  (inexact->exact (car seed))) two31)) two31)))))
  (set! randint (lambda args
    (cond ((null? (cdr args))
            (if (< (car args) two31) (unif-rand (car args))
              (floor (* (next-rand) (car args)))))
          ((< (car args) (cadr args))
            (let ((span (- (cadr args) (car args))))
              (+ (car args)
                 (if (< span two31) (unif-rand span)
                   (floor (* (next-rand) span))))))
          (else (let ((span (- (car args) (cadr args))))
                  (- (car args)
                     (if (< span two31) (unif-rand span)
                       (floor (* (next-rand) span))))))))))

(define words
  (map (lambda (w) (map char-upcase w)) (map string->list
  (list "assume" "we" "have" "a" "list" "of" "all" "the" "words"
  "in" "english" "language" "under" "normal" "ordering" "change"
  "alphabet" "abbey" "clot" "fizz" "foxy" "longest" "words" "his"
  "pig" "roof" "unfed" "ogee" "pong" "skied" "starting" "point"))))

(define alpha (vector 1 2 3 4 5 6 7 8 9 10 11 12
  13 14 15 16 17 18 19 20 21 22 23 24 25 26))

(define (display-key key)
  (let loop ((ks (vector->list key)) (xs (list)))
    (if (null? ks)
        (list->string (reverse xs))
        (loop (cdr ks) (cons (integer->char (+ (car ks) 64)) xs)))))

(define (alpha? word key)
  (let loop ((cs word) (prev 0))
    (if (null? cs) #t
      (let ((curr (vector-ref key (- (char->integer (car cs)) 65))))
        (if (< curr prev) #f (loop (cdr cs) curr))))))

(define (count words key)
  (length (filter (lambda (w) (alpha? w key)) words)))

(define (alter key)
  (let ((p (randint 0 26)) (q (randint 0 26)))
    (let ((t (vector-ref key p)))
      (vector-set! key p (vector-ref key q))
      (vector-set! key q t)))
  key)

(define (shuffle vec)
  (do ((n (vector-length vec) (- n 1)))
      ((zero? n) vec)
    (let* ((r (randint n)) (t (vector-ref vec r)))
      (vector-set! vec r (vector-ref vec (- n 1)))
      (vector-set! vec (- n 1) t))))

(define (climb words key)
  (let ((prev (count words key)))
    (display (display-key key))
    (display " ") (display prev) (newline)
    (let loop ((key key) (prev prev))
      (let* ((new-key (alter key))
             (score (count words new-key)))
        (cond ((< prev score)
                (display (display-key key))
                (display " ") (display score) (newline)
                (loop new-key score))
              ((zero? (randint 1000000))
                (loop (shuffle key) prev))
              ((zero? (randint 50000))
                (loop (alter (alter (alter new-key))) prev))
              ((zero? (randint 2000))
                (loop (alter new-key) prev))
              (else (loop key prev)))))))

(climb words (shuffle alpha))

PEOUXTGCRJYZFLNWHAMDBIKSVQ 5
EBUVNYQXGLDPTJRHIAOSCWMKFZ 6
UAHRWYOXGKDLPVNESBZTCIMQJF 8
BEOMTGSXKPDHIQNJYVCWFRLUAZ 9
BEOMTGSXNPDHIQKJYVCWFRLUAZ 10
BEZMTDSANPGHIQKJYVCOFRLUXW 12

Timeout