#lang racket

(require racket/match)

(module+ test
  (require rackunit))

(define (all-insertions el lst)
  (if (null? lst)
      `((,el))
      (cons (cons el lst)
            (let [(lower-inserts (all-insertions el (cdr lst)))]
              (map (curry cons (car lst)) lower-inserts)))))

(define (permutations lst)
  (if (null? lst)
      '(())
      (let [(smaller-permuts (permutations (cdr lst)))]
        (apply append
               (map (curry all-insertions (car lst)) smaller-permuts)))))

(module+ test
  (check-equal? (list->set (permutations '(1 2 3)))
                (list->set '((1 2 3)
                             (2 1 3)
                             (2 3 1)
                             (1 3 2)
                             (3 1 2)
                             (3 2 1)))))

(struct btree (lbl left right))

(define (evaluate tree vals)
  (match vals
    ['() tree]
    [`(0 . ,next) (evaluate (btree-left tree) next)]
    [`(1 . ,next) (evaluate (btree-right tree) next)]))

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

(define (satisficing-evaluations tree [rev-steps '()])
  (match tree
    [1 (list (reverse rev-steps))]
    [0 '()]
    [(btree lbl left right)
     (let [(left-paths
            (satisficing-evaluations
             left
             (cons (list lbl 0) rev-steps)))
           (right-paths
            (satisficing-evaluations
             right
             (cons (list lbl 1) rev-steps)))]
       (append left-paths right-paths))]))

(module+ test
  (check-equal? (list->set (satisficing-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))))))