0. #lang racket
1.  
2. ;; A solver for the following puzzle:
3. ;; Given 5 integers a, b, c, d, and e,
4. ;; find an expression that combines a, b, c, and d with arithmetic operations (+, -, *, and /) to get e.
5.  
6. (require srfi/1)
7. (require racket/generator)
8.  
9. (define (bool<= x y) (implies x y))
10.  
11. ;; Monadic bind for lists.
12. (define-syntax-rule (let*/list (clause ...) body ...)
13.   (for*/list (clause ... [x (let () body ...)]) x))
14.  
15. ;; lexical ordering on lists.
16. (define (list<= l1 l2 [<= <=])
17.   (match* (l1 l2)
18.     [('() _) #t]
19.     [(_ '()) #f]
20.     [((cons x xs) (cons y ys))
21.      (match* [(<= x y) (<= y x)]
22.        [(#t #t) (list<= xs ys <=)]
23.        [(x _) x])]))
24.  
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))))