PasteRack.org
Paste # 46703
2016-07-13 13:58:02

Fork as a new paste.

Paste viewed 309 times.


Embed:

  1. #lang racket
  2.  
  3. ;; A solver for the following puzzle:
  4. ;; Given 5 integers a, b, c, d, and e,
  5. ;; find an expression that combines a, b, c, and d with arithmetic operations (+, -, *, and /) to get e.
  6.  
  7. (require srfi/1)
  8. (require racket/generator)
  9.  
  10. (define (bool<= x y) (implies x y))
  11.  
  12. ;; Monadic bind for lists.
  13. (define-syntax-rule (let*/list (clause ...) body ...)
  14.   (for*/list (clause ... [x (let () body ...)]) x))
  15.  
  16. ;; lexical ordering on lists.
  17. (define (list<= l1 l2 [<= <=])
  18.   (match* (l1 l2)
  19.     [('() _) #t]
  20.     [(_ '()) #f]
  21.     [((cons x xs) (cons y ys))
  22.      (match* [(<= x y) (<= y x)]
  23.        [(#t #t) (list<= xs ys <=)]
  24.        [(x _) x])]))
  25.  
  26. ;;; ok, now we start doing things.
  27. (define ops '(+ - * /))
  28.  
  29. (define (commutative? op)
  30.   (or (eq? '+ op) (eq? '* op)))
  31.  
  32. (define (all-partitions l)
  33.   (match l
  34.     ['() (list (list '() '()))]
  35.     [(cons x xs) (let*/list ([part (all-partitions xs)])
  36.                    (match-define (list as bs) part)
  37.                    (list (list (cons x as) bs)
  38.                          (list as (cons x bs))))]))
  39.  
  40. (define (partitions l)
  41.   (filter (lambda (l) (not (ormap null? l))) (all-partitions l)))
  42.  
  43. (define (commutative-partitions l)
  44.   (for*/list ([part (partitions l)]
  45.               #:when (list<= (first part) (second part)))
  46.     part))
  47.  
  48. ;; produces a sequence (usually lazy) of all possible combinations of `nums'
  49. ;; using operators in `ops'.
  50. (define (combine nums)
  51.   (match nums
  52.     ['() (error "impossible")] ;; should never get called recursively.
  53.     [(list x) (list x)]
  54.     [_ (in-generator
  55.         (for* ([op ops]
  56.                [halves (if (commutative? op)
  57.                            (commutative-partitions nums)
  58.                            (partitions nums))]
  59.                [left   (combine (first  halves))]
  60.                [right  (combine (second halves))])
  61.           (yield `(,op ,left ,right))))]))
  62.  
  63. (define (eval-expr e)
  64.   (with-handlers ([exn:fail:contract:divide-by-zero?
  65.                    (lambda (exn) +inf.0)])
  66.     (eval e)))
  67.  
  68. (define (solve n1 n2 n3 n4 target)
  69.   (delete-duplicates
  70.    (for*/list ([l (combine (list n1 n2 n3 n4))]
  71.                #:when (= target (eval-expr l)))
  72.      l)))
  73.  
  74. (pretty-print (solve 6 6 5 2 17))

=>

'((* 6 (+ 2 (/ 5 6))))