;; CSE341 - Section 6 - Structs in Scheme + more Scheme
;; define-struct
;; gives you 'make-automobile' constructor,
;; 'automobile-make/model/year'
;; accessors, 'automobile?' tester,
;; and 'set-automobile-make/model/year!' setter functions
(define-struct automobile (make model year))
;; binary trees?
(define-struct binary-tree-node (val left-child right-child))
(define-struct binary-tree-leaf ())
;; here's a binary tree
(define bin-tree1
(make-binary-tree-node
1
(make-binary-tree-node 2 (make-binary-tree-leaf) (make-binary-tree-leaf))
(make-binary-tree-node 3 (make-binary-tree-leaf) (make-binary-tree-leaf))))
;; a tree insert routine
(define (tree-insert atree val)
(cond
[(binary-tree-leaf? atree)
(make-binary-tree-node
val
(make-binary-tree-leaf)
(make-binary-tree-leaf))]
[#t
(if (<= val (binary-tree-node-val atree))
(let* ([left-child (tree-insert (binary-tree-node-left-child atree) val)]
[new-tree
(make-binary-tree-node
(binary-tree-node-val atree)
left-child
(binary-tree-node-right-child atree))])
new-tree)
(let* ([right-child (tree-insert (binary-tree-node-right-child atree) val)]
[new-tree
(make-binary-tree-node
(binary-tree-node-val atree)
(binary-tree-node-left-child atree)
right-child)])
new-tree))]))
;; list -> tree
(define (list->tree lst)
(letrec ([tree (make-binary-tree-leaf)]
{helper
(lambda (l)
(cond
[(null? l)]
[#t (begin
(set! tree (tree-insert tree (car l)))
(helper (cdr l)))]))})
(begin
(helper lst)
tree)))
;; pretty-print a tree
(define (pprint-tree atree)
(letrec ([helper
(lambda (t acc)
(cond
[(binary-tree-leaf? t) (string-append acc "leaf")]
[#t (string-append
(helper (binary-tree-node-right-child t)
(string-append
(helper (binary-tree-node-left-child t)
(string-append
acc
"("
(number->string (binary-tree-node-val t)) ", "))
", "))
")")]))])
(helper atree "")))
;; Remember boolean logic formulas from HW3??
;; Let's do (part of) HW3 in Scheme
;; Structs for different 'flavors' of formula
(define-struct Constant (bool))
(define-struct Var (var))
(define-struct MyNot (form))
(define-struct MyAnd (form1 form2))
(define-struct MyOr (form1 form2))
(define-struct Implies (form1 form2))
;; evaluate a logic formula
;; NOTE: vars not appearing in truth table evaluate to #f
(define (evaluate table form)
(letrec ([lookup
(lambda(v t)
(if (null? t)
#f
(if (equal? v (caar t))
(cdar t)
(lookup v (cdr t)))))]
[inner
(lambda (f)
(cond
[(Constant? f) (Constant-bool f)]
[(Var? f) (lookup (Var-var f) table)]
[(MyNot? f) (not (inner (MyNot-form f)))]
[(MyAnd? f) (and (inner (MyAnd-form1 f))
(inner (MyAnd-form2 f)))]
[(MyOr? f) (or (inner (MyOr-form1 f))
(inner (MyOr-form2 f)))]
[(Implies? f) (or (not (inner (Implies-form1 f)))
(inner (Implies-form2 f)))]))])
(inner form)))
;; Some example formulas and a truthtable
;; f1 = (a or b) and (not c)
(define f1 (make-MyAnd (make-MyOr (make-Var "a") (make-Var "b"))
(make-MyNot (make-Var "c"))))
;; f2 = (a and (b or c)) => (d or (not (a and b)))
(define f2 (make-Implies (make-MyAnd
(make-Var "a")
(make-MyOr (make-Var "b")
(make-Var "c")))
(make-MyOr
(make-Var "d")
(make-MyNot
(make-MyAnd (make-Var "a")
(make-Var "b"))))))
;; Not(And(b, c))
(define f3 (make-MyNot (make-MyAnd (make-Var "b") (make-Var "c"))))
;; a truthtable with vars a,b,c,d
(define tt1 (list (cons "a" #t) (cons "b" #t) (cons "c" #t)
(cons "d" #f)))
;; pretty-print a formula
(define (pprint formula)
(letrec ([bool->string (lambda (b)
(if b "#t" "#f"))]
[helper
(lambda (f acc)
(cond
[(Constant? f)
(string-append
acc
(bool->string (Constant-bool f)))]
[(Var? f) (string-append acc (Var-var f))]
[(MyNot? f)
(string-append
(helper (MyNot-form f)
(string-append acc "Not("))
")")]
[(MyAnd? f)
(string-append
(helper (MyAnd-form2 f)
(string-append
(helper (MyAnd-form1 f)
(string-append
acc
"And(")) ", ")) ")")]
[(MyOr? f)
(string-append
(helper (MyOr-form2 f)
(string-append
(helper (MyOr-form1 f)
(string-append
acc
"Or(")) ", ")) ")")]
[(Implies? f)
(string-append
(helper (Implies-form2 f)
(string-append
(helper (Implies-form1 f)
(string-append
acc
"Implies(")) ", ")) ")")]))])
(helper formula "")))
;; DeMorgan routine
(define (demorgan form)
(letrec ([neg (lambda (f)
(cond
[(MyNot? f) (pos (MyNot-form f))]
[(MyAnd? f) (make-MyOr
(neg (MyAnd-form1 f))
(neg (MyAnd-form2 f)))]
[(MyOr? f) (make-MyAnd
(neg (MyOr-form1 f))
(neg (MyOr-form2 f)))]
[(Implies? f) (make-MyAnd
(pos (Implies-form1 f))
(neg (Implies-form2 f)))]
[(Constant? f) (make-Constant
(not (Constant-bool f)))]
[(Var? f) (make-MyNot f)]))]
[pos (lambda (f)
(cond
[(MyNot? f) (neg (MyNot-form f))]
[(MyAnd? f) (make-MyAnd
(pos (MyAnd-form1 f))
(pos (MyAnd-form2 f)))]
[(MyOr? f) (make-MyOr
(pos (MyOr-form1 f))
(pos (MyOr-form2 f)))]
[(Implies? f) (make-MyOr
(neg (Implies-form1 f))
(pos (Implies-form2 f)))]
[#t f]))])
(pos form)))