; 145-puzzle

(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 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 (uniq-c eql? xs)
  (if (null? xs) xs
    (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
      (cond ((null? xs) (reverse (cons (cons prev k) result)))
            ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
            (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))

(define (numb xs)
  (let loop ((n (- (char->integer (car xs)) 48)) (xs (cdr xs)))
    (cond ((null? xs) (values n xs))
          ((member (car xs) (string->list "0123456789"))
            (loop (+ (* 10 n) (- (char->integer (car xs)) 48)) (cdr xs)))
          (else (values n xs)))))

(define (fact xs)
  (cond ((null? xs) (error 'fact "missing factor"))
        ((char=? (car xs) #\space) (fact (cdr xs)))
        ((member (car xs) (string->list "0123456789"))
          (let-values (((n rest) (numb xs)))
            (values n rest)))
        ((char=? (car xs) #\()
          (let-values (((n rest) (expr (cdr xs))))
            (if (or (null? rest) (not (char=? (car rest) #\))))
                (error 'fact "missing right parenthesis")
                (values n (cdr rest)))))
        (else (error 'fact "expected number or left parenthesis"))))

(define (term xs)
  (let-values (((f rest) (fact xs)))
    (let loop ((n f) (xs rest))
      (cond ((null? xs) (values n xs))
            ((char=? (car xs) #\space)
              (loop n (cdr xs)))
            ((char=? (car xs) #\*)
              (let-values (((f rest) (fact (cdr xs))))
                (loop (* n f) rest)))
            ((char=? (car xs) #\/)
              (let-values (((f rest) (fact (cdr xs))))
                (loop (/ n f) rest)))
            (else (values n xs))))))

(define (expr xs)
  (let-values (((t rest) (term xs)))
    (let loop ((n t) (xs rest))
      (cond ((null? xs) (values n xs))
            ((char=? (car xs) #\space)
              (loop n (cdr xs)))
            ((char=? (car xs) #\+)
              (let-values (((t rest) (term (cdr xs))))
                (loop (+ n t) rest)))
            ((char=? (car xs) #\-)
              (let-values (((t rest) (term (cdr xs))))
                (loop (- n t) rest)))
            (else (values n xs))))))

(define (evaluate str)
  (let-values (((x xs) (expr (string->list str))))
    (if (null? xs) x
      (error 'evaluate "extra characters at end"))))

(define (f digits)
 (let loop ((n (string-length digits)) (digits digits))
  (if (= n 1) (list digits)
   (let
    ((first-digit (substring digits 0 1))
     (other-digits (substring digits 1 n)))
    (let ((r (loop (- n 1) other-digits)))
     (append
      (map (lambda (r) (string-append first-digit r)) r)
      (map (lambda (r) (string-append first-digit "+" r)) r)
      (map (lambda (r) (string-append first-digit "*" r)) r)))))))

(display (car (sort (lambda (a b) (< (cdr b) (cdr a)))
  (uniq-c = (sort < (map evaluate (f "123456789")))))))
(newline)

(display (map car (filter (lambda (x) (= (cdr x) 145))
  (map (lambda (str) (cons str (evaluate str))) (f "123456789")))))
(newline)

(145 . 12)
(12+3+45+6+7+8*9 12+3+4+5*6+7+89 12+3*4+56+7*8+9 1+23+4+5*6+78+9 1+2+3+4+56+7+8*9 1+2*34+5+6+7*8+9 1+2*3+45+6+78+9 1*23+4*5+6+7+89 1*2+34+5*6+7+8*9 1*2+3+4+5+6*7+89 1*2*3+4+56+7+8*9 1*2*3*4+56+7*8+9)