(module countdown mzscheme
  ;; http://rubyquiz.com/quiz7.html
  
  (require (lib "plt-match.ss")
           (lib "list.ss")
           (only (lib "1.ss" "srfi") lset-difference)
           (planet "evector.scm" ("soegaard" "evector.plt")))
  
  (provide (all-defined))
  
  (define debug-on? (make-parameter #f))
  
  
  ;; An expression is either a number (num) or some combination (comb).
  (define-struct expression () #f)
  (define-struct (num expression) (n) #f)
  (define-struct (comb expression) (l op r) #f)
  
  
  ;; eval-expr: expression -> number
  ;; Evaluates an expression and gets its numeric value.
  (define eval-expr
    (let ([ht (make-hash-table 'weak)])
      (lambda (an-expr)
        (hash-table-get
         ht an-expr
         (lambda ()
           (let ([result
                  (match an-expr
                    [(struct num (n)) n]
                    [(struct comb (l op r))
                     (op (eval-expr l) (eval-expr r))])])
             (hash-table-put! ht an-expr result)
             result))))))
  
  
  ;; expr->string: expression -> string
  ;; Returns a nice human readable representation of an expression.
  (define (expr->string an-expr)
    (define operators `((,+ "+") (,- "-") (,* "*") (,/ "/")))
    (define (op->string op)
      (second (assq op operators)))
    (match an-expr
      [(struct num (n))
       (format "~a" n)]
      [(struct comb (l op r))
       (format "(~a ~a ~a)" (expr->string l) (op->string op) (expr->string r))]))
  
  
  ;; nums-in-expr: expr -> (listof num)
  ;; Returns the numbers in the expression.
  (define (nums-in-expr expr)
    (let loop ([expr expr])
      (match expr
        [(struct num (n)) (list expr)]
        [(struct comb (l op r))
         (append (loop l) (loop r))])))
  
  
  ;; for-each-pairs: (X X -> void) (evectorof X) number -> void
  ;; Call f for each (i, j) pair in the evector 'elts', where
  ;; i < i + 1 <= min-j <= j.
  ;; 
  ;; min-j is used to help speed up candidate generation,
  ;; but it's not obvious.
  ;;
  ;; The situation looks like: [x_1, x_2, ... x_n, x_j, x_j+1, ...]
  ;;
  ;; where the elements starting from x_j are all the fresh new expressions
  ;; from the last generation.  We want to only consider pairs of elements
  ;; that involve those fresh expressions.
  (define (for-each-pairs f elts min-j)
    (define len (evector-length elts))
    (let outer-loop ([i 0])
      (when (< i len)
        (let inner-loop ([j (max min-j (add1 i))])
          (when (< j len)
            (f (evector-ref elts i) (evector-ref elts j))
            (inner-loop (add1 j))))
        (outer-loop (add1 i)))))
  
  
  ;; distance: expression number -> number
  ;; Returns how far away the expression's value is from number.
  (define (distance an-expr target-val)
    (abs (- (eval-expr an-expr) target-val)))
  
  
  ;; build-next-generation: (evectorof expression)
  ;;                        number
  ;;                        (expression -> boolean)
  ;;                        (expression -> void)
  ;;                        -> (listof expression)
  ;; The inductive definition on expressions are:
  ;;
  ;; expression := number
  ;;             | expression op expression
  ;;
  ;; This constructs the next generation of expressions from previous ones.
  ;;
  ;; Keeps only the expressions that are ok?. Each ok? expression is visited.
  ;;
  (define (build-next-generation exprs last-gen-len ok? visit)
    (define results '())
    
    (define (collect l op r)
      (let ([e (make-comb l op r)])
        (when (ok? e)
          (visit e)
          (set! results (cons e results)))))
    
    (for-each-pairs (lambda (l r)
                      (collect l + r)
                      (collect l * r)
                      (collect l - r)
                      (collect r - l)
                      (collect l / r)
                      (collect r / l))
                    exprs
                    last-gen-len)
    results)
  
  
  ;; negative?: expression -> boolean
  ;; Returns true if the expression is negative.
  (define (negative-expr? expr)
    (< (eval-expr expr) 0))
  
  
  ;; fractional-expr? expression -> expression
  ;; Returns true if the value of the expression is fractional.
  (define (fractional-expr? expr)
    (> (denominator (eval-expr expr)) 1))
  
  
  ;; does-not-reuse-nums?: expression -> boolean
  ;; Returns true if the expression doesn't have duplicate nums.
  (define (does-not-reuse-nums? original-expr)
    (let ([ht (make-hash-table)])
      (let loop ([expr original-expr])
        (cond
          [(num? expr)
           (hash-table-get
            ht expr
            (lambda ()
              (hash-table-put! ht expr #f)
              #t))]
          [else
           (and (loop (comb-l expr))
                (loop (comb-r expr)))]))))
  
  
  ;; gen-expr: number (listof number) -> expression
  ;; Looks for an expression only involving the numbers within the hand
  ;; whose value is closest to the target.
  (define (gen-expr target hand)
    
    ;; Here are the cards in our hand as num structures.
    (define hand-nums (map make-num hand))
    
    ;; 'known-expressions' are the expressions we've generated
    ;; during the brute-force search.
    (define known-expressions (list->evector hand-nums))
    (define known-expressions-ht (make-hash-table 'equal))
    
    ;; 'best' will be the best expression we've visited so far.
    (define best (make-num 0))
    
    
    ;; brute-force-search: -> expression
    ;;
    ;; This is the top-level logic to find a good expression that's closest
    ;; to the target.
    (define (brute-force-search)
      ;; Step 0: validate input and make sure we're not doing crazy things.
      (when (empty? hand) (error 'gen-expr "hand empty"))
      
      (let/cc return
        (let ([returnable-visit (make-returnable-visit return)])
          ;; Step 1: first visit all the primitive expressions.
          (for-each returnable-visit (evector->list known-expressions))
          ;; Step 2: iteratively build new expressions out of old ones, until
          ;; we either exhaustively searched our space or our best expression
          ;; is a perfect match.
          ;;
          ;; As a shortcut, we also allow VISIT to escape quickly if
          ;; it immediately finds the answer, which is caught right here.
          (let loop ([last-gen-index 0])
            (when (debug-on?) (printf "building next generation~n"))
            (let ([new-exprs (build-next-generation
                              known-expressions last-gen-index ok?
                              returnable-visit)])
              (when (debug-on?) (printf "generation built~n"))
              (cond
                [(= 0 (distance best target)) best]
                [(empty? new-exprs) best]
                [else
                 (let ([new-last-gen-len (evector-length known-expressions)])
                   (extend-known-expressions new-exprs)
                   (loop new-last-gen-len))]))))))
    
    
    ;; expression-known?: expression -> boolean
    ;; Do we know about this expression already?
    (define (expression-known? expr)
      (hash-table-get known-expressions-ht expr #f))
    
    
    ;; extend-known-expressions: (listof expression) -> void
    ;; Add each of the expressions here to our known expression list.
    (define (extend-known-expressions exprs)
      (for-each (lambda (expr)
                  (unless (expression-known? expr)
                    (hash-table-put! known-expressions-ht expr #t)
                    (evector-push! known-expressions expr)))
                exprs))
    
    
    ;; make-returnable-visit: ((expression -> void) expression) -> void
    ;; See if the expression here is better than the best expression
    ;; so far.  If so, replace our best expression with this one.
    ;; In the case where we hit bullseye, calls quick-return.
    (define ((make-returnable-visit quick-return) expr)
      (when (< (distance expr target) (distance best target))
        (when (debug-on?)
          (printf "current-best: ~a = ~a~n"
                  (expr->string expr)
                  (exact->inexact (eval-expr expr))))
        (set! best expr)
        ;; Optimization: if we've hit the target square on the head,
        ;; return it!
        (when (= (distance expr target) 0)
          (quick-return expr))))
    
    
    ;; ok?: expression -> boolean
    ;; Returns true if the candidate expression is possibly in the path
    ;; towards the goal.  We do some of our pruning here to trim out
    ;; any expressions that have no chance of getting us toward the
    ;; goal expediently.
    (define (ok? expr)
      (and
       (not (expression-known? expr))
       (does-not-reuse-nums? expr)
       (not (negative-expr? expr))
       (not (fractional-expr? expr))
       (not (= (eval-expr expr) 0))
       (not (redundant? expr))
       (not (too-small? expr))
       ;; TODO: add more pruning?
       ))
    
    
    ;; unused-numbers: expression -> (listof number)
    ;; Returns the nums in the hand-nums that aren't used in the expression
    ;; yet.
    (define (unused-numbers expr)
      (map num-n (lset-difference eq? hand-nums (nums-in-expr expr))))
    
    
    ;; Returns true if the expression is so small as to make it
    ;; impossible as a solution.
    (define (too-small? expr)
      (define biggest-candidate (* (apply * (unused-numbers expr))
                                   (if (> (eval-expr expr) 1)
                                       (eval-expr expr)
                                       (/ 1 (eval-expr expr)))))
      (and (< (distance best target) (distance expr target))
           (< (eval-expr expr) target)
           (< biggest-candidate (- target (distance best target)))))
    
    
    ;; redundant?: expression -> boolean
    ;; Returns true if this expression has the same value as
    ;; any of its subexpressions.
    (define (redundant? expr)
      (define (some-subexpression-equals? expr val)
        (match expr
          [(struct comb (l op r))
           (or (= (eval-expr expr) val)
               (some-subexpression-equals? l val)
               (some-subexpression-equals? r val))]
          [(struct num (n)) (= n val)]))
      (match expr
        [(struct comb (l op r))
         (or (some-subexpression-equals? l (eval-expr expr))
             (some-subexpression-equals? r (eval-expr expr)))]
        [else #f]))
    
    
    (brute-force-search)))