; permuted index
(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 (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
(cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
(else (loop (cdr ss) (cons (car ss) cs) xs)))))
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
(define (join ss)
(if (null? (cdr ss)) (car ss)
(f (car ss) (join (cdr ss)))))
(if (null? ss) "" (join ss)))
(define stop-list
'("a" "an" "and" "by" "for" "if" "in" "is" "of" "on" "the" "to"))
(define (rot-line words)
(define (join xs) (string-join #\space xs))
(let loop ((front (reverse words)) (back '()) (rots '()))
(if (null? front) rots
(let ((f (cdr front)) (b (cons (car front) back)))
(loop f b (if (and (pair? f) (member (car b) stop-list)) rots
(cons (cons (join (reverse f)) (join b)) rots)))))))
(define (rot-file filename)
(define (split s) (string-split #\space s))
(with-input-from-file filename
(lambda ()
(let loop ((line (read-line)) (rs '()))
(if (eof-object? line) rs
(loop (read-line)
(append (rot-line (split line)) rs)))))))
(define (rjust n str)
(let ((len (string-length str)))
(if (< n len)
(substring str (- len n) len)
(string-append (make-string (- n len) #\space) str))))
(define (ljust n str)
(let ((len (string-length str)))
(if (< n len)
(substring str 0 n)
(string-append str (make-string (- n len) #\space)))))
(define (print rots)
(define (print-line x)
(display (rjust 32 (car x)))
(display " ")
(display (ljust 32 (cdr x)))
(newline))
(for-each print-line rots))
(define (ptx filename)
(define (order-by a b) (string-ci<? (cdr a) (cdr b)))
(print (sort order-by (rot-file filename))))