52419 bsmntbombdood (define (print-chars tape chars) (if (null? chars) "" (shortest (map (lambda (using-cell) (let* ((data (print-char tape (car chars) using-cell)) (new-tape (cdr data)) (code (car data))) (string-append code (print-chars new-tape (cdr chars))))) (from-to 0 (- (vector-length (tape-cells tape)) 1)))))) (define (print-char tape char using-cell) (cons (string-append (if (< using-cell (tape-pos tape)) (make-string (- (tape-pos tape) using-cell) #\<) (make-string (- using-cell (tape-pos tape)) #\>)) (if (< char (vector-ref (tape-cells tape) using-cell)) (make-string (- (vector-ref (tape-cells tape) using-cell) char) #\-) (make-string (- char (vector-ref (tape-cells tape) using-cell)) #\+)) ".") (make-tape (let ((v (vector-copy (tape-cells tape)))) (vector-set! v using-cell char) v) using-cell))) (define (from-to n m) (if (= n m) (list n) (cons n (from-to (+ n 1) m)))) (define (shortest lst) (let loop ((lst lst) (shortest #f) (len #f)) (cond ((null? lst) shortest) ((or (not shortest) (< (string-length (car lst)) len)) (loop (cdr lst) (car lst) (string-length (car lst)))) (else (loop (cdr lst) shortest len))))) (define (initialize-factors factor num) (make-factors (make-tape (let ((v (make-vector (+ num 1) 0))) (vector-set! v 0 factor) v) 0) factor num)) (define (make-factors tape factor num) (set! tape (make-tape (vector-copy (tape-cells tape)) (tape-pos tape))) (let loop ((i 1)) (if (< i (+ num 1)) (begin (vector-set! (tape-cells tape) i (* i (vector-ref (tape-cells tape) (tape-pos tape)))) (loop (+ i 1))))) (vector-set! (tape-cells tape) (tape-pos tape) 0) (cons tape (call-with-output-string (lambda (out) (write-string (make-string factor #\+) out) (write-string "[" out) (let loop ((n 1)) (if (> n num) (write-string (make-string num #\<) out) (begin (write-string ">" out) (write-string (make-string n #\+) out) (loop (+ n 1))))) (write-string "-]" out))))) (define (print-string string) (shortest (map (lambda (factor) (let* ((data (initialize-factors factor (min (min 8 (floor (/ 256 factor)))))) (tape (car data)) (code (cdr data))) (string-append code (print-chars tape (map char->integer (string->list string)))))) (from-to 2 256)))) 3406513855 #lispcafe Scheme