#lang racket

(require racket/match)

(module+ test
  (require rackunit))

(define (interleave elt lst)
  (if (null? lst)
      (list (list elt))
      (let [(smaller-interleaves (interleave elt (cdr lst)))
            (head (car lst))]
        (cons (cons elt lst)
              (map (curry cons head) smaller-interleaves)))))

(define (permutations lst)
  (if (null? lst)
      (list '())
      (let [(smaller-permutations (permutations (cdr lst)))
            (head (car lst))]
        (apply append (map (curry interleave head) smaller-permutations)))))

(struct bintree (label left right))

(define (evaluate tree decs)
  (match decs
    ['() tree]
    [(cons 0 tail) (evaluate (bintree-left tree) tail)]
    [(cons 1 tail) (evaluate (bintree-right tree) tail)]))

(module+ test
  (define bool-tree
    (bintree
     'x1
     (bintree
      'x2
      (bintree 'x3 1 0)
      (bintree 'x3 0 1))
     (bintree
      'x2
      (bintree 'x3 0 0)
      (bintree 'x3 1 1))))
  (check-equal? (evaluate bool-tree '(1 0 1)) 0)
  (check-equal? (evaluate bool-tree '(0 1 1)) 1))

(define (satisfying-evaluations tree [rev-path '()])
  (match tree
    [0 '()]
    [1 (list (reverse rev-path))]
    [(bintree lbl left right)
     (let [(left-paths
            (satisfying-evaluations
             left
             (cons (list lbl 0)
                   rev-path)))
           (right-paths
            (satisfying-evaluations
             right
             (cons (list lbl 1)
                   rev-path)))]
       (append left-paths right-paths))]))

(module+ test
  (check-equal? (list->set (satisfying-evaluations bool-tree))
                (list->set '(((x1 0) (x2 0) (x3 0))
                             ((x1 0) (x2 1) (x3 1))
                             ((x1 1) (x2 1) (x3 0))
                             ((x1 1) (x2 1) (x3 1))))))