CS 152 Projects Added

DFA Construction/compiled/drracket/errortrace/declarations_rkt.dep

+("6.3" ("c7635e8732fe86d448ea7bd57a8c9ce4a9aba6be" . "d2fda840f162eb82ced7bd08c9898665178c8318") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt"))

DFA Construction/compiled/drracket/errortrace/utilities_rkt.dep

+("6.3" ("b3fdfc54b50ce32e8d8343af4c8ca4302b34e522" . "506ecf67ab5ae73256baaf604ac4bc61f027c0e5") #"/home/smehtani83/170050107/declarations.rkt" (collects #"parser-tools" #"lex.rkt") (collects #"parser-tools" #"yacc.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt"))

DFA Construction/declarations.rkt

+#lang racket
+
+(provide (struct-out E) (struct-out L) (struct-out O) (struct-out T)
+         (struct-out S) (struct-out Epsilon) (struct-out Literal) 
+         (struct-out Or)(struct-out Then) (struct-out Star) 
+         (struct-out Graph) (struct-out Trans))
+
+
+
+; Defining a new type for Regular expressions
+
+(struct E() #:transparent)
+(struct L(c) #:transparent)
+(struct O(r1 r2) #:transparent)
+(struct T(r1 r2) #:transparent)
+(struct S(r) #:transparent)
+
+; Defining a new type for syntax tree formed out of Regular expressions
+
+(struct Epsilon (n) #:transparent)
+(struct Literal (c n) #:transparent)
+(struct Or (t1 t2 n) #:transparent)
+(struct Then (t1 t2 n) #:transparent)
+(struct Star (t n) #:transparent)
+
+;Structure of Graph
+
+(struct Graph(greennode nodes trans  rednodes symbols) #:transparent)
+
+;Structure of a transition
+
+(struct Trans(start sym final) #:transparent)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
\ No newline at end of file

DFA Construction/regToDfa.rkt

+#lang racket
+(require parser-tools/lex
+         parser-tools/yacc)
+(require "declarations.rkt")
+(require "utilities.rkt")
+
+
+;(define (buildNullable t)
+ ; ...)
+
+;(define (buildFirst t)
+ ; ...)
+
+;(define (buildLast t)
+ ; ...)
+
+;(define (buildFollow t)
+ ; ...)
+
+;(define (buildGraph reg)
+;  ...)
+
+(define (buildNullable t)
+  (match t
+    [(Epsilon n) (list (cons n #t))]
+    [(Literal c n) (list (cons n #f))]
+    [(Or t1 t2 n) (let* [(x1 (buildNullable t1))
+                         (x2 (buildNullable t2))]
+                    
+                    (cons (cons n (or (cdar x1) (cdar x2))) (append x1 x2)))]
+    [(Then t1 t2 n) (let* [(x1 (buildNullable t1))
+                           (x2 (buildNullable t2))]
+                      (cons (cons n (and (cdar x1) (cdar x2))) (append x1 x2)))]
+    [(Star t n) (cons (cons n #t) (buildNullable t))]))
+
+(define (buildFirst t)
+  (match t
+    [(Epsilon n) (list (list n))]
+    [(Literal c n) (list (list n n))]
+    [(Or t1 t2 n) (let* ([y1 (buildFirst t1)]
+                         [y2 (buildFirst t2)])
+                    (cons (cons n (append (cdar y1) (cdar y2))) (append y1 y2)))]
+    [(Then t1 t2 n) (let* [(x1 (buildNullable t1))
+                           (y1 (buildFirst t1))
+                           (y2 (buildFirst t2))]
+                      (cond [(cdar x1) (cons (cons n (append (cdar y1) (cdar y2))) (append y1 y2))]
+                            [else (cons (cons n (cdar y1)) (append y1 y2))]))]
+    [(Star t n) (let* ([y (buildFirst t)])
+                  (cons (cons n (cdar y)) y))]))
+
+(define (buildLast t)
+  (match t
+    [(Epsilon n) (list (list n))]
+    [(Literal c n) (list (list n n))]
+    [(Or t1 t2 n) (let* ([y1 (buildLast t1)]
+                         [y2 (buildLast t2)])
+                    (cons (cons n (append (cdar y1) (cdar y2))) (append y1 y2)))]
+    [(Then t1 t2 n) (let* [(x2 (buildNullable t2))
+                           (y1 (buildLast t1))
+                           (y2 (buildLast t2))]
+                      (cond [(cdar x2) (cons (cons n (append (cdar y1) (cdar y2))) (append y1 y2))]
+                            [else (cons (cons n (cdar y2)) (append y1 y2))]))]
+    [(Star t n) (let* ([y (buildLast t)])
+                  (cons (cons n (cdar y)) y))]))
+
+(define (buildFollow t)
+  (match t
+    [(Literal c n)  (if (equal? "#" c) '() (list (list n)))]
+    [(Epsilon n) '()]
+    [(Or t1 t2 n) (append (buildFollow t1) (buildFollow t2))]
+    [(Then t1 t2 n) (let* [(z1 (cdar (buildLast t1)))
+                           (y2 (cdar (buildFirst t2)))
+                           (w1 (buildFollow t1))
+                           (w2 (buildFollow t2))
+                           (w3 (map (lambda (l1) (cond [(member (car l1) z1) (append l1 y2) ]
+                                                       [else l1])) w1))]
+                      (append w3 w2))]
+    [(Star t n) (let* [(y (cdar (buildFirst t)))
+                       (z (cdar (buildLast t)))
+                       (w (buildFollow t))]
+                  (map (lambda (l1) (cond [(member (car l1) z) (cons (car l1) (set-union (cdr l1) y))]
+                                          [else l1])) w))]))
+(define (zip l1 l2)
+  (cond [(or (null? l1) (null? l2)) '()]
+        [else (cons (cons (car l1)(car l2)) (zip (cdr l1)(cdr l2)))]))
+(define (my-last l)
+  [cond [(null? l) "error"]
+        [(null? (cdr l)) (car l)]
+        [else (my-last (cdr l))]])
+
+(define (buildGraph r)
+  (let* ([t (maketree r)])
+    (define (give-literals t)
+      (define (give-h t p)
+        (match t
+          [(Literal c n) (cons (cons c (car p)) (cons (cons c n) (cdr p)))]
+          [(Or t1 t2 n) (let* ([x1 (give-literals t1)]
+                               [x2 (give-literals t2)])
+                          (cons (append (car x1) (car x2)) (append (cdr x1) (cdr x2))))]
+          [(Then t1 t2 n) (let* ([x1 (give-literals t1)]
+                                 [x2 (give-literals t2)])
+                            (cons (append (car x1) (car x2)) (append (cdr x1) (cdr x2))))]
+          [(Star t n) (give-literals t)]
+          [(Epsilon n)  (cons (cons "@" (car p)) (cons (cons "@" n) (cdr p)))]))
+      (give-h t (cons '() '())))
+    (define (remove-repeat p l)r
+      (cond[(null? (cdr p)) l]
+           [else (cond[(member (car p) l) (remove-repeat (cdr p) l)]
+                      [else (remove-repeat (cdr p) (cons (car p) l))])]))
+    (define (give-no-r t)  
+      (let* ([v (give-literals t)]
+             [v1 (car v)]
+             [v2 (cdr v)])
+        (cons (remove-repeat v1 '()) v2)))
+    (define (green-node t)
+      (cdar (buildFirst t)))
+    (define (give-big lol)
+      (if (null? (cdr lol)) (cdar lol) (give-big (cdr lol))))
+    
+    (let* ([gl (give-no-r t)]
+           [bf1 (buildFollow t)]
+           [gl1 (car gl)]
+           [gl2 (cdr gl)]
+           [big-literal (give-big gl2)])   
+      
+      (define (trans l x)
+        (define (trans-h n bf)
+          (if (= n (caar bf)) (cdar bf) (trans-h n (cdr bf))))
+        (let* ([ lngth (length l)]
+               [ mklst (make-list lngth x)]
+               [zip-l-x (zip mklst l)]
+               [set-inter (set-intersect zip-l-x gl2)]
+               [possible (map (lambda (p) (cdr p)) set-inter)]
+               [new-node (sort (remove-duplicates (append* (map (lambda (n) (trans-h n bf1)) possible))) <)])
+          (cons new-node (Trans l x new-node))))
+      
+      (define (give-node-translist god)
+        (if (null? god) '() 
+            (let* ([caar (caar god)])
+              (if (null? caar ) (give-node-translist (cdr god)) (cons (cons caar (cdar god)) (give-node-translist (cdr god)))))))
+      
+      (define (trans-node total-n new-n total-t new-t)
+        (if (and (null? new-n) (null? new-t)) (cons total-n total-t) (let* ([god-list (append* (map(lambda (l) (map (lambda (x) (trans l x)) gl1)) new-n))]
+                                                                            [node-trans-list (give-node-translist god-list)]
+                                                                            [trans-list (map (lambda (p) (cdr p)) node-trans-list)]
+                                                                            [node-list (map (lambda (p) (car p)) node-trans-list)]
+                                                                            [new-nodes (set-subtract node-list total-n)]
+                                                                            [new-total-nodes (set-union new-nodes total-n)]
+                                                                            [new-trans (set-subtract trans-list new-t)]
+                                                                            [new-total-trans (set-union new-trans total-t)])
+                                                                       (trans-node new-total-nodes new-nodes new-total-trans new-trans))))
+      (let* ([greennode (green-node t)]
+             [trans-node-1 (trans-node (list greennode) (list greennode) '() '())]
+             [all-nodes (car trans-node-1)]
+             [all-trans (cdr trans-node-1)]
+             [rednodes (filter (lambda (lx) (if (= big-literal (my-last lx)) #t #f)) all-nodes)])
+        (Graph greennode all-nodes all-trans rednodes (append (remove "@" gl1) (list "#")))))))

DFA Construction/utilities.rkt

+#lang racket
+(require parser-tools/lex
+         parser-tools/yacc)
+(require "declarations.rkt")
+(provide (all-defined-out))
+
+;main functions being exported are
+;maketree and matches?
+ 
+
+
+(define (reNumber t l)
+  (cond [(Epsilon? t) (Epsilon (+ (Epsilon-n t) l))]
+        [(Literal? t) (Literal (Literal-c t) (+ (Literal-n t) l))]
+        [(Or? t)
+         (let ([t1 (reNumber (Or-t1 t) l)]
+               [t2 (reNumber (Or-t2 t) l)])
+           (Or t1 t2 (+ (Or-n t) l)))]
+        [(Then? t)
+         (let ([t1 (reNumber (Then-t1 t) l)]
+               [t2 (reNumber (Then-t2 t) l)])
+           (Then t1 t2 (+ (Then-n t) l)))]
+        [(Star? t)
+         (let ([t1 (reNumber (Star-t t) l)])
+           (Star t1 (+ (Star-n t) l)))]))
+
+(define (buildTreeHelper r n)
+  (cond [(E? r) (cons 1 (Epsilon 1))]
+        [(L? r) (cons 1 (Literal (L-c r) 1))]
+        [(O? r)
+         (let* ([pr1 (buildTreeHelper (O-r1 r) 0)]
+                [pr2 (buildTreeHelper (O-r2 r) 0)]
+                [t2 (reNumber (cdr pr2) (car pr1))]
+                [sub-tree (Or (cdr pr1) t2 (+ 1 (car pr1) (car pr2)))])
+           (cons (+ (car pr1) (car pr2) 1) (reNumber sub-tree n)))]
+        [(T? r)
+         (let* ([pr1 (buildTreeHelper (T-r1 r) 0)]
+                [pr2 (buildTreeHelper (T-r2 r) 0)]
+                [t2 (reNumber (cdr pr2) (car pr1))]
+                [sub-tree (Then (cdr pr1) t2 (+ 1 (car pr1) (car pr2)))])
+           (cons (+ (car pr1) (car pr2) 1) (reNumber sub-tree n)))]
+        [(S? r)
+         (let* ([pr1 (buildTreeHelper (S-r r) 0)]
+                [sub-tree (Star (cdr pr1) (+ 1 (car pr1)))])
+           (cons (+ (car pr1) 1) (reNumber sub-tree n)))]))
+
+
+
+
+(define (buildTree r)
+  (cdr (buildTreeHelper r 0)))
+
+(define (getNodeNumber t)
+  (cond [(Epsilon? t) (Epsilon-n t)]
+        [(Literal? t) (Literal-n t)]
+        [(Then? t) (Then-n t)]
+        [(Or? t) (Or-n t)]
+        [(Star? t) (Star-n t)]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (final-initialise-helper greennode  rednodes)
+  (if (> (count (curry equal? greennode) rednodes) 0)
+      greennode
+      -1))
+
+(define (eof-to-hash character) (if (eof-object? character) #\# character))
+
+(define (search-in-list item list) (> (count (curry equal? item) list) 0))
+
+(define (find-next-state trans state nextchar)
+  (cond [(eq? state empty ) empty]
+        [else (let* ([item-containing
+                      (findf (lambda (arg)
+                               (and
+                                (equal? (Trans-start arg) state)
+                                (equal? (Trans-sym arg) nextchar)))
+                             trans)])
+                (if item-containing (Trans-final item-containing) empty))]))
+
+(define (matches? graph input-string)
+  (let*
+      ([symbols (Graph-symbols graph)]
+       [trans (Graph-trans graph)]
+       [state (Graph-greennode graph)]
+       [final (final-initialise-helper state (Graph-rednodes graph))]
+       [input (open-input-string input-string)]
+       [nextchar (string (eof-to-hash (read-char input)))]
+       [driver-helper
+        ((lambda (x) (x x))
+         (lambda (driver-helper-recursive)
+           (lambda ()
+             (if (equal? nextchar "#")
+                 (if (search-in-list state (Graph-rednodes graph))
+                     "Regex and string match"
+                     "Regex and string don't match")
+                 (if (search-in-list nextchar symbols)
+                     (let*
+                         ([nextstate (find-next-state trans state nextchar)])
+                       (set! state nextstate)
+                       (let* ([initialchar nextchar])
+                         (set! nextchar (string (eof-to-hash (read-char input))))
+                                   
+                         ((driver-helper-recursive driver-helper-recursive))))
+                     (string-append "This character not in symbols of regex : " nextchar))))))]
+       )
+    (driver-helper)))
+
+(define-tokens tokens_a (CHAR))
+(define-empty-tokens tokens_b (* @ \| EOF \( \) ))
+
+(define simple-regex-lexer
+           (lexer
+            ((union (char-range "A" "Z")
+                    (char-range "a" "z"))
+             (token-CHAR lexeme))
+            ("*" (token-*))
+            ("|" (token-\|))
+            ("(" (token-\())
+            (")" (token-\)))
+            ("@" (token-@))
+            ;; recursively calls the lexer which effectively skips whitespace
+            (whitespace (simple-regex-lexer input-port))
+            ((eof) (token-EOF))))
+
+                 
+(define simple-regex-parser
+           (parser
+            (start regexp)
+            (end EOF)
+            (error void)
+            (tokens tokens_a tokens_b)
+            (precs (left \|)
+                   (nonassoc *)
+                   (nonassoc \( \)))
+            (grammar
+             (regexp ((regexp \| regexp_withoutor) (O $1 $3))
+                     ((regexp_withoutor) $1))
+             (regexp_withoutor
+              ((@) (E))
+              (() void)
+              ((regexp_withoutor \( regexp \))
+               (if (eq? void $1) $3 (T $1 $3)))
+              ((regexp_withoutor CHAR)
+               (if (eq? void $1) (L $2) (T $1 (L $2))))
+              ((regexp_withoutor \( regexp \) *)
+               (if (eq? void $1) (S $3) (T $1 (S $3))))
+              ((regexp_withoutor @)
+               (if (eq? void $1) (E) (T $1 (E))))
+              ((regexp_withoutor CHAR *)
+               (if (eq? void $1) (S (L $2)) (T $1 (S (L $2)))))))))
+
+(define (lex-this lexer input) (lambda () (lexer input)))
+
+(define (regex-parser regex-string)
+  (simple-regex-parser
+   (lex-this simple-regex-lexer (open-input-string regex-string))))
+
+(define (maketree regexp-string)
+  (let* ([regexp (regex-parser regexp-string)]
+         [regexpWithHash (T regexp (L "#"))]
+         [tree (buildTree regexpWithHash)])
+    tree))
+

SAT Solver/satSolver.rkt

+#lang racket
+
+(require "utilities.rkt")
+
+(define assign #hash())
+
+; Fill in your code here. Should finally define a function
+; called dpll which returns true or false. Should additionally
+; store the satisfying assignment in the variable assign.
+(define (tree-list t1)
+  (define (or-conv ot1)
+    (match ot1
+      [(Var lit) (list lit)]
+      [(Not e) (list (* -1 (Var-lit e)))]
+      [(Or x y) (let* ([y-list (or-conv y)])
+                  (match x 
+                    [(Var lit) (cons lit y-list) ]
+                    [(Not e) (cons (* -1 (Var-lit e)) y-list)]))]))
+  (cond [(And? t1) (let* ([x (And-x t1)]
+                          [y (And-y t1)]
+                          [o-c-x (or-conv x)])
+                     (cons o-c-x (tree-list y)))]
+        [else (list (or-conv t1))]))
+
+(define (dpll f)
+  (set! assign #hash())
+  (let* ([t-l-f (tree-list f) ] )  
+    (define xyz (remove-duplicates (append* t-l-f)))   
+    (define assign-my #hash())
+    
+    
+    (define (unit-prop-rem l x)
+      (define (unit-prop-rem-h l)
+        (cond [(null? l) '()]
+              [else (let* ([carl (car l)])
+                      (cond [(member x carl) (unit-prop-rem-h (cdr l))]
+                            [(member (* -1 x) carl) (cons (remove (* -1 x) carl) (unit-prop-rem-h (cdr l) ))]
+                            [else (cons carl (unit-prop-rem-h (cdr l) ))]))]))
+      (let* ([rough (unit-prop-rem-h l)])
+        (cond [(member '() rough ) (cons '() (remove* (list '()) rough))]
+              [else rough])))
+    
+    (define (lit-elim l x)
+      (cond  [(null? l) '()]
+             [else (let* ([carl (car l)])
+                     (if (member x carl) (lit-elim (cdr l) x) (cons carl (lit-elim (cdr l) x))))]))
+    
+    (define (basic-step l assignt xyzt )
+  ;    (display "l: ") (displayln l) (newline) (displayln xyzt) (displayln assignt) 
+      (define (search-single l1)
+        (cond [(null? l1) #f]
+              [else (let* ([carl1 (car l1)])
+                      (if (null? (cdr carl1)) (car carl1) (search-single (cdr l1))))]))
+      (define (search-both t)
+        (cond[(null? t) #f]
+             [else (let* ([cart (car t)])
+                     (if (member (* -1 cart) t) (search-both (remove* (list cart (* -1 cart)) t)) cart))]))  
+      
+      (define (b-s-h l b1 b2)
+        (cond[(null? l) (list #t assignt xyzt)]
+             [(member '() l) (list #f #f)]
+             [b1 (let* ([s-s (search-single l)])
+                   (if s-s (begin (set! xyzt (remove* (list s-s (* -1 s-s)) xyzt)) 
+                                  (if (> s-s 0) (set! assignt (dict-set assignt s-s #t)) (set! assignt (dict-set assignt (* -1 s-s) #f)))
+                                  (b-s-h (unit-prop-rem l s-s) #t #t)) (b-s-h l #f #t)))]
+             [b2 (let* ([s-b (search-both xyzt)])
+                   (if s-b (begin (set! xyzt (remove s-b xyzt))
+                                  (if (> s-b 0) (set! assignt (dict-set assignt s-b #t)) (set! assignt (dict-set assignt (* -1 s-b) #f)))
+                                  (b-s-h (lit-elim l s-b) #f #t)) (b-s-h l  #f #f)))]
+             [else (list (list l #f) assignt xyzt)]))
+      (b-s-h l #t #t))
+    
+    
+    
+    (define (dpll-h l assign-old xyz-old x)
+      (define assign2 (dict-set assign-old x #t))
+      (define assign3 (dict-set assign-old x #f))
+      (define xyz2 xyz-old)
+      (define xyz3 xyz-old)
+      
+      (let* ([u-p-r (unit-prop-rem l x)]
+             [b-s-upr (basic-step u-p-r assign2 xyz2) ])
+        (cond[(equal? #t (car b-s-upr)) (begin (set! assign (cadr b-s-upr))
+                                               #t)]
+             [(equal? #f (car b-s-upr)) (let* ([u-p-r-2 (unit-prop-rem l (* -1 x))]
+                                               [b-s-upr-2 (basic-step u-p-r-2 assign3 xyz3)])
+                                          (cond[(equal? #t (car b-s-upr-2)) (begin (set! assign (cadr b-s-upr-2))
+                                                                                   #t)]
+                                               [(equal? #f (car b-s-upr-2)) #f]
+                                               [else (let* ([car3 (abs (car (caddr b-s-upr-2)))]
+                                                            [if-fails (begin (set! xyz3 (remove* (list car3 (* -1 car3)) (caddr b-s-upr-2)))
+                                                                             (dpll-h (caar b-s-upr-2) (cadr b-s-upr-2) xyz3 car3))])
+                                                       (cond[if-fails #t]
+                                                            [else #f]))]))]
+             [else (let* ([car2 (abs (car (caddr b-s-upr)))]
+                          [if-fails-1 (begin (set! xyz2 (remove* (list car2 (* -1 car2)) (caddr b-s-upr)))
+                                             (dpll-h (caar b-s-upr) (cadr b-s-upr) xyz2 car2))])
+                     (cond [if-fails-1 #t]
+                           [else (let* ([u-p-r-2 (unit-prop-rem l (* -1 x))]
+                                        [b-s-upr-2 (basic-step u-p-r-2 assign3 xyz3)])
+                                   (cond[(equal? #t (car b-s-upr-2)) (begin (set! assign (cadr b-s-upr-2))
+                                                                            #t)]
+                                        [(equal? #f (car b-s-upr-2)) #f]
+                                        [else (let* ([car3 (abs (car (caddr b-s-upr-2)))]
+                                                     [if-fails (begin (set! xyz3 (remove* (list car3 (* -1 car3)) (caddr b-s-upr-2)))
+                                                                      (dpll-h (caar b-s-upr-2) (cadr b-s-upr-2) xyz3 car3))])
+                                                (cond[if-fails #t]
+                                                     [else #f]))]))]))])))
+    
+    
+    (let* ([car-o (abs (car xyz))]
+           [if-f-o (begin (set! xyz (remove* (list car-o (* -1 car-o)) xyz))
+                          (dpll-h t-l-f assign-my xyz car-o))])
+      (cond [if-f-o #t]
+            [else #f]))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

SAT Solver/utilities.rkt

+
+#lang racket
+
+(provide (all-defined-out))
+
+
+; Type for respresenting clauses
+(struct Var (lit) #:transparent)
+(struct And (x y) #:transparent)
+(struct Or (x y) #:transparent)
+(struct Not (e) #:transparent)
+(struct Const (bool) #:transparent)
+
+; Parses a (list 1 -2) into (Or (Var 1) (Not (Var 2)))
+
+(define (parseSubExp ls)
+  (cond [(null? ls) (error "Given an empty sub-expression")]
+        [(null? (cdr ls)) (parseNeg (car ls))]
+        [else (Or (parseNeg (car ls))
+                  (parseSubExp (cdr ls)))]))
+
+; Parses i to (Var i) and -i to (Not (Var i))
+(define (parseNeg num)
+  (if (< num 0) (Not (Var (* num -1))) (Var num)))
+
+; Parses full list
+; Ex. (list '( 1 2) '(-3 2)) into
+; (And (Or (Var 1) (Var 2)) (Or (Not (Var 3)) (Var 2)))
+(define (parseExp es)
+  (cond [(null? es) (error "Given empty list of expressions")]
+        [(null? (cdr es)) (parseSubExp (car es))]
+        [else (And (parseSubExp (car es))
+                   (parseExp (cdr es)))]))
+