Skip to content

C
course_projects_at_iitb
Commit 3186495a authored by SARVESH MEHTANI's avatar SARVESH MEHTANI
Browse files
Options

CS 152 Projects Added

parents
Hide whitespace changes
Inline Side-by-side
Showing with 1005 additions and 0 deletions
DFA Construction/compiled/drracket/errortrace/declarations_rkt.dep 0 → 100755
View file @ 3186495a
("6.3" ("c7635e8732fe86d448ea7bd57a8c9ce4a9aba6be" . "d2fda840f162eb82ced7bd08c9898665178c8318") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt"))
DFA Construction/compiled/drracket/errortrace/utilities_rkt.dep 0 → 100755
View file @ 3186495a
("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 0 → 100755
View file @ 3186495a
#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 0 → 100755
View file @ 3186495a
#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 0 → 100755
View file @ 3186495a
#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))
PhotoArt/PhotoArt.rkt 0 → 100755
View file @ 3186495a
#lang racket
(require 2htdp/image)
(require 2htdp/universe)
(require lang/posn)
(require "allimages.rkt")
;(define posn1 '())
(define (draw-h s)
(place-images
(list (hash-ref (vector-ref s 0) 1)
(text "Rotate" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 1) "DarkKhaki")
(text "Blur" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 2) "DarkKhaki")
(text "Crop" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 3) "DarkKhaki")
(text "Grayscale" 30 "black")
(rectangle 150 40 (hash-ref (vector-ref s 3) 4) "DarkKhaki")
(text "Save" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 5) "DarkKhaki")
(text "Undo" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 6) "DarkKhaki")
(text "Hue" 30 "black")
(rectangle 120 40 (hash-ref (vector-ref s 3) 7) "DarkKhaki"))
(list (make-posn 500 400)
(make-posn 1200 170)
(make-posn 1200 170)
(make-posn 1200 340)
(make-posn 1200 340)
(make-posn 1200 510)
(make-posn 1200 510)
(make-posn 1200 680)
(make-posn 1200 680)
(make-posn 1400 170)
(make-posn 1400 170)
(make-posn 1400 340)
(make-posn 1400 340)
(make-posn 1400 510)
(make-posn 1400 510)
)
(rectangle 1500 800 "solid" "LemonChiffon")))
(define instr-list '())
(define images (make-hash))
(define matrices (make-hash))
(define dimen (make-hash))
(define (stopper st)
(equal? (vector-ref st 5) 'done))
(define op-but (make-hash))
(define (handler st x y me)
(cond [(equal? me "button-down") (cond [(and (> x 1140) (< x 1260) (> y 150) (< y 190) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 1 60)
(vector-set! s1 4 (list 'rotate))
s1)]
[(and (> x 1140) (< x 1260) (> y 320) (< y 360) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 2 60)
(vector-set! s1 4 (list 'blur))
s1)]
[(and (not (null? (vector-ref st 4)))
(equal? (car (vector-ref st 4)) 'blur)
(> x (- 500 (quotient (hash-ref (vector-ref st 2) 1) 2)))
(< x (+ 500 (quotient (hash-ref (vector-ref st 2) 1) 2)))
(> y (- 400 (quotient (hash-ref (vector-ref st 2) 2) 2)))
(< y (+ 400 (quotient (hash-ref (vector-ref st 2) 2) 2)))
) (cond[ (null? (cdr (vector-ref st 4)))
(begin (define s1 st)
(vector-set! s1 4 (list 'blur (cons x y)))
s1)]
[else (begin(define s1 st)
(vector-set! s1 4 (append (vector-ref s1 4) (list (cons x y))))
s1)])]
[(and (> x 1140) (< x 1260) (> y 490) (< y 530) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 3 60)
(vector-set! s1 4 (list 'crop))
s1)]
[(and (not (null? (vector-ref st 4)))
(equal? (car (vector-ref st 4)) 'crop)
(> x (- 500 (quotient (hash-ref (vector-ref st 2) 1) 2)))
(< x (+ 500 (quotient (hash-ref (vector-ref st 2) 1) 2)))
(> y (- 400 (quotient (hash-ref (vector-ref st 2) 2) 2)))
(< y (+ 400 (quotient (hash-ref (vector-ref st 2) 2) 2)))
) (cond[ (null? (cdr (vector-ref st 4)))
(begin (define s1 st)
(vector-set! s1 4 (list 'crop (cons x y)))
s1)]
[else (begin(define s1 st)
(vector-set! s1 4 (append (vector-ref s1 4) (list (cons x y))))
s1)])]
[(and (> x 1140) (< x 1260) (> y 660) (< y 700) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 4 60)
(vector-set! s1 4 (list 'grayscale))
s1)]
[(and (> x 1340) (< x 1460) (> y 150) (< y 190) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 5 60)
(vector-set! s1 4 (list 'save))
s1)]
[(and (> x 1340) (< x 1460) (> y 320) (< y 360) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 6 60)
(vector-set! s1 4 (list 'undo))
s1)]
[(and (> x 1340) (< x 1460) (> y 490) (< y 530) (null? (vector-ref st 4))) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 7 60)
(vector-set! s1 4 (list 'hue))
s1)]
;(list images (list "crop") (list 60 255 255 255))]
; [(and (> x 1240) (< x 1360) (> y 320) (< y 360)) (list 255 60 255 255)]
; [(and (> x 1240) (< x 1360) (> y 490) (< y 530)) (list 255 255 60 255)]
; [(and (> x 1240) (< x 1360) (> y 660) (< y 700)) (list 255 255 255 60)]
;[(and (> x 300) (< x 700) (> y 209) (< y 591) (equal? (car (cadr s)) "crop")) (list (car s) (cons (cons x y) (cadr s)) (caddr s))]
;[(and (> x 300) (< x 700) (> y 209) (< y 591) (equal? (cadr (cadr s)) "crop"))
;(begin (hash-set! (car s) 2 (hash-ref (car s) 1)) (hash-set! (car s) 1
; (myscale (hash-ref (car s) 1) (car (car (cadr s))) x (cadr (car (cadr s))) y )) s)]
[else st])]
[(equal? me "button-up") (cond [(equal? (vector-ref st 4) (list 'rotate)) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 1 255)
(vector-set! s1 4 '())
(hash-set! (vector-ref s1 0) 2 (hash-ref (vector-ref s1 0) 1))
(hash-set! (vector-ref s1 1) 2 (hash-ref (vector-ref s1 1) 1 ))
(hash-set! (vector-ref s1 1) 1 (myrotate-c (hash-ref (vector-ref s1 1) 2)
(hash-ref (vector-ref s1 2) 2)
(hash-ref (vector-ref s1 2) 1)))
(hash-set! (vector-ref s1 0) 1 (matrix-image (hash-ref (vector-ref s1 1) 1)
(hash-ref (vector-ref s1 2) 2)
(hash-ref (vector-ref s1 2) 1)))
(hash-set! (vector-ref s1 2) 3 (hash-ref (vector-ref s1 2) 2))
(hash-set! (vector-ref s1 2) 2 (hash-ref (vector-ref s1 2) 1))
(hash-set! (vector-ref s1 2) 1 (hash-ref (vector-ref s1 2) 3))
s1)]
[(and (not (null? (vector-ref st 4)))
(equal? (car (vector-ref st 4)) 'blur)) (cond [(null? (cdr (vector-ref st 4)))
(begin (define s1 st)
(hash-set! (vector-ref s1 3) 2 255)
s1)]
[(null? (cddr(vector-ref st 4))) st]
[(null? (cdddr(vector-ref st 4)))
(begin (define s1 st)
(hash-set! (vector-ref s1 0) 2 (hash-ref (vector-ref s1 0) 1))
(hash-set! (vector-ref s1 1) 2 (hash-ref (vector-ref s1 1) 1 ))
(hash-set! (vector-ref s1 1) 1 (gaussian-blur (hash-ref (vector-ref s1 1) 2 )
(hash-ref (vector-ref s1 2) 1)
(hash-ref (vector-ref s1 2) 2)
(+ (quotient (hash-ref (vector-ref s1 2) 1) 2) (car (cadr(vector-ref st 4))) -500)
(+ (quotient (hash-ref (vector-ref s1 2) 1) 2) (car (caddr(vector-ref st 4))) -500)
(+ (quotient (hash-ref (vector-ref s1 2) 2) 2) (cdr (cadr(vector-ref st 4))) -400)
(+ (quotient (hash-ref (vector-ref s1 2) 2) 2) (cdr (caddr(vector-ref st 4))) -400)
))
(hash-set! (vector-ref s1 0) 1 (matrix-image (hash-ref (vector-ref s1 1) 1)
(hash-ref (vector-ref s1 2) 1)
(hash-ref (vector-ref s1 2) 2)))
(vector-set! s1 4 '())
s1)])]
[(and (not (null? (vector-ref st 4)))
(equal? (car (vector-ref st 4)) 'crop)) (cond [(null? (cdr (vector-ref st 4)))
(begin (define s1 st)
(hash-set! (vector-ref s1 3) 3 255)
s1)]
[(null? (cddr(vector-ref st 4))) st]
[(null? (cdddr(vector-ref st 4)))
(begin (define s1 st)
(hash-set! (vector-ref s1 0) 2 (hash-ref (vector-ref s1 0) 1))
(hash-set! (vector-ref s1 1) 2 (hash-ref (vector-ref s1 1) 1 ))
(define scaled (myscale (hash-ref (vector-ref s1 1) 2 )
(+ (quotient (hash-ref (vector-ref s1 2) 1) 2) (car (cadr(vector-ref st 4))) -500)
(+ (quotient (hash-ref (vector-ref s1 2) 2) 2) (cdr (cadr(vector-ref st 4))) -400)
(+ (quotient (hash-ref (vector-ref s1 2) 1) 2) (car (caddr(vector-ref st 4))) -500)
(+ (quotient (hash-ref (vector-ref s1 2) 2) 2) (cdr (caddr(vector-ref st 4))) -400)
(hash-ref (vector-ref s1 2) 1)
(hash-ref (vector-ref s1 2) 2)
))
(hash-set! (vector-ref s1 1) 1 (car scaled) )
(hash-set! (vector-ref s1 0) 1 (matrix-image (hash-ref (vector-ref s1 1) 1)
(cadr scaled)
(caddr scaled)))
(hash-set! (vector-ref s1 2) 1 (cadr scaled))
(hash-set! (vector-ref s1 2) 2 (caddr scaled))
(vector-set! s1 4 '())
s1)])]
[(equal? (vector-ref st 4) (list 'save)) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 5 255)
(vector-set! s1 4 '())
(save-image (hash-ref (vector-ref s1 0) 1) "edited.png")
(vector-set! s1 5 'done)
s1)]
[(equal? (vector-ref st 4) (list 'undo)) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 6 255)
(vector-set! s1 4 '())
(hash-set! (vector-ref s1 0) 1 (hash-ref (vector-ref s1 0) 2))
(hash-set! (vector-ref s1 1) 1 (hash-ref (vector-ref s1 1) 2 ))
(hash-set! (vector-ref s1 2) 1 (image-width(hash-ref (vector-ref s1 0) 2 )))
(hash-set! (vector-ref s1 2) 2 (image-height(hash-ref (vector-ref s1 0) 2 )))
s1)]
[(equal? (vector-ref st 4) (list 'grayscale)) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 4 255)
(vector-set! s1 4 '())
(hash-set! (vector-ref s1 0) 2 (hash-ref (vector-ref s1 0) 1))
(hash-set! (vector-ref s1 1) 2 (hash-ref (vector-ref s1 1) 1 ))
(define l-o-l (grayscale (image->color-list (hash-ref (vector-ref s1 0) 2))))
(hash-set! (vector-ref s1 0) 1 (color-list->bitmap l-o-l
(hash-ref (vector-ref s1 2) 1)
(hash-ref (vector-ref s1 2) 2)))
(hash-set! (vector-ref s1 1) 1 (image-matrix (hash-ref (vector-ref s1 0) 1)))
s1)]
[(equal? (vector-ref st 4) (list 'hue)) (begin (define s1 st)
(hash-set! (vector-ref s1 3) 7 255)
(vector-set! s1 4 '())
(hash-set! (vector-ref s1 0) 2 (hash-ref (vector-ref s1 0) 1))
(hash-set! (vector-ref s1 1) 2 (hash-ref (vector-ref s1 1) 1 ))
(define l-o-l (hue (image->color-list (hash-ref (vector-ref s1 0) 2))))
(hash-set! (vector-ref s1 0) 1 (color-list->bitmap l-o-l
(hash-ref (vector-ref s1 2) 1)
(hash-ref (vector-ref s1 2) 2)))
(hash-set! (vector-ref s1 1) 1 (image-matrix (hash-ref (vector-ref s1 0) 1)))
s1)]
[else st])]
[else st]))
(define s (vector images matrices
dimen op-but instr-list 'abc))
(define edit-image
(lambda (image)
(begin (hash-set! (vector-ref s 0) 1 image)
(hash-set! (vector-ref s 0) 2 #f)
(hash-set! (vector-ref s 1) 1 (image-matrix image))
(hash-set! (vector-ref s 1) 2 #f)
(hash-set! (vector-ref s 2) 1 (image-width image))
(hash-set! (vector-ref s 2) 2 (image-height image))
(hash-set! (vector-ref s 2) 3 (image-height image))
(hash-set! (vector-ref s 3) 1 255)
(hash-set! (vector-ref s 3) 2 255)
(hash-set! (vector-ref s 3) 3 255)
(hash-set! (vector-ref s 3) 4 255)
(hash-set! (vector-ref s 3) 5 255)
(hash-set! (vector-ref s 3) 6 255)
(hash-set! (vector-ref s 3) 7 255)
(vector-set! s 4 '())
(big-bang s
(to-draw draw-h)
(on-mouse handler)
(stop-when stopper)
))))
(define (trans i x)
(color-list->bitmap (modify (image->color-list i) x) (image-width i) (image-height i)))
(define (modify l x)
(define (help l1 v l2)
(let ([a (if (null? l1) 0 (car l1))])
(cond [(null? l1) l2]
[else (if (equal? (color-alpha a) 0) (help (cdr l1) v (append l2 (list a)))
(help (cdr l1) v (append l2 (list (color (color-red a) (color-green a) (color-blue a) v)))))])))
(help l x '()))
(define-syntax lc
(syntax-rules (: <- @)
[(lc expr : var <- drawn-from) (map (lambda (var) expr) drawn-from)]
[(lc expr : @ guard) (if guard (list expr) `())]
[(lc expr : @ guard qualifier ...)
(append* (lc (lc expr : qualifier ...) : @ guard))]
[(lc expr : var <- drawn-from qualifier ...)
(append* (lc (lc expr : qualifier ... ) : var <- drawn-from))]))
(define (2d-vec r c)
(build-vector r (lambda (x) (make-vector c 0))))
(define (2d-vec-init r c init)
(build-vector r (lambda (x) (make-vector c init))))
(define (2d-vec-ref vec r c)
(vector-ref (vector-ref vec r) c))
(define (set-elem vec r c val)
(let ((v (vector-ref vec r)))
(begin
(vector-set! v c val))))
(define (l-m l w h)
(define mtrx (2d-vec h w))
(define (l-m-h l i)
(cond[(= i (* h w)) mtrx]
[else (begin (set-elem mtrx (quotient i w) (remainder i w) (car l))
(l-m-h (cdr l) (+ i 1)))]))
(l-m-h l 0 ))
(define (element-m l x y)
(list-ref (list-ref l (- x 1) (- y 1))))
(define (myrotate-c matrx h w)
(define mtrx1 (2d-vec w h))
(define (myrotate-h x y i)
(cond[(and (= x 0) (= y (- w 1))) (begin (set-elem mtrx1 (quotient i h) (remainder i h) (2d-vec-ref matrx x y))
mtrx1)]
[(= x 0) (begin (set-elem mtrx1 (quotient i h) (remainder i h) (2d-vec-ref matrx x y))
(myrotate-h (- h 1) (+ y 1) (+ i 1)))]
[else (begin (set-elem mtrx1 (quotient i h) (remainder i h) (2d-vec-ref matrx x y))
(myrotate-h (- x 1) y (+ i 1)))]))
(myrotate-h (- h 1) 0 0 ))
(define (image-matrix image)
(let* ([w (image-width image)]
[h (image-height image)])
(l-m (image->color-list image) w h)))
(define (matrix-image matrx w h)
(color-list->bitmap (append* (map (lambda (v1) (vector->list v1)) (vector->list matrx))) w h ))
(define gauss-matrix (let* ([gauss (2d-vec 5 5)])
(begin (lc (begin
(set-elem gauss (+ 2 x) (+ 2 y) (exp (/ (+ (* x x) (* y y)) (* -1 (* 2 (* 0.84089642 0.84089642))))))
#t):
x <- (list -2 -1 0 1 2) y <- (list -2 -1 0 1 2))
gauss)))
(define gauss-line (vector-ref gauss-matrix 2))
(define (color-prod c x)
(list (* x (color-red c)) (* x (color-green c)) (* x (color-blue c))(* x (color-alpha c))))
(define (list-color l)
(color (list-ref l 0) (list-ref l 1) (list-ref l 2) (list-ref l 3)))
(define (list-sum l) ;list-of-lists(of 4 elements) sum of correspinding elements
(cond[(null? l) '( 0 0 0 0)]
[else (map + (car l) (list-sum (cdr l)))]))
(define (gaussian-blur matrix w h x1 x2 y1 y2)
(define sum1 (apply + (vector->list gauss-line)))
(define padded0 (padding matrix w h 2))
(define padded1 (padding matrix w h 2))
(define padded2 (padding matrix w h 2))
(define (gausser a b c d e)
(list-color (map (lambda (x) (exact-floor (/ x sum1)))
(map + (color-prod a 0.059105748449148066 ) (color-prod b 0.4930686953310466 ) (color-prod c 1 ) (color-prod d 0.4930686953310466 ) (color-prod e 0.059105748449148066 )))))
(define lx (range (+ 2 x1) (+ 2 x2) 1))
(define ly (range (+ 2 y1) (+ 2 y2) 1))
(begin (lc (set-elem padded1 y x (gausser (2d-vec-ref padded0 y ( + x 2))
(2d-vec-ref padded0 y ( + x 1))
(2d-vec-ref padded0 y x)
(2d-vec-ref padded0 y (- x 1))
(2d-vec-ref padded0 y (- x 2)))) : x <- lx y <- ly)
(lc (vector-set! padded2 y (vector-map gausser (vector-ref padded1 (- y 2))
(vector-ref padded1 (- y 1))
(vector-ref padded1 y)
(vector-ref padded1 (+ 2 y))
(vector-ref padded1 (+ 1 y)))) : y <- ly)
(myselect padded2 2 (+ w 2) 2 (+ h 2))))
(define (padding matrix w h pad)
(let* ([pad0 (2d-vec-init (+ h (* 2 pad)) (+ w (* 2 pad)) (color 0 0 0 0))]
[rx (range pad (+ pad w ) 1)]
[ry (range pad (+ pad h ) 1)])
(begin (lc (set-elem pad0 y x (2d-vec-ref matrix (- y pad) (- x pad))) : x <- rx y <- ry)
pad0)))
(define (my-stretch vec quo l)
(let* ([vec1 (make-vector l 0)]
[count 0])
(vector-map! (lambda (x0) (begin (set! count (+ count 1))
(vector-ref vec (quotient (- count 1) (+ quo 1)))))
vec1)))
(define (myselect matrix x1 x2 y1 y2)
(let* ([matrix1 (2d-vec (- y2 y1) (- x2 x1))]
[lx (range 0 (- x2 x1))]
[ly (range 0 (- y2 y1))]
[useless-lc (lc (begin (set-elem matrix1 y x (2d-vec-ref matrix (+ y y1) (+ x x1)))
0) : x <- lx y <- ly)])
matrix1))
(define (myscale matrix x1 y1 x2 y2 w h)
(let* ([x2x1 (- x2 x1)]
[y2y1 (- y2 y1)]
[sc1 (/ w x2x1)]
[sc2 (/ h y2y1)])
(cond[(>= sc1 sc2) (let* ([new-width (floor (* sc2 x2x1))]
[quot-w-x2x1 (quotient w x2x1)]
[quot-h-y1y2 (quotient h y2y1)]
[selected (myselect matrix x1 x2 y1 y2)]
[new-matrix1 (my-stretch selected quot-h-y1y2 h)]
[scaled-matrix (vector-map! (lambda (v) (my-stretch v quot-h-y1y2 new-width)) new-matrix1)])
(list scaled-matrix new-width h))]
[else (let* ([new-height (floor (* sc1 y2y1))]
[quot-w-x2x1 (quotient w x2x1)]
[quot-h-y1y2 (quotient h y2y1)]
[selected (myselect matrix x1 x2 y1 y2)]
[new-matrix1 (my-stretch selected quot-w-x2x1 new-height)]
[scaled-matrix (vector-map! (lambda (v) (my-stretch v quot-w-x2x1 w)) new-matrix1)])
(list scaled-matrix w new-height))])))
(define (superposition im1 im2)
(map (lambda (x y) (color (quotient (+ (color-red x) (color-red y)) 2) (quotient (+ (color-green x) (color-green y)) 2) (quotient (+ (color-blue x) (color-blue y)) 2)
(max (color-alpha x) (color-alpha y))
)) im1 im2))
(define (grayscale mat-i)
(map (lambda(x) (let ([v (exact-floor (/ (+ (color-red x) (color-green x) (color-blue x)) 3))])
(color v v v (color-alpha x)))) mat-i))
;(define (convert-rgb-to-hue mat-i)
(define (HSV col)
(define (postv val)
(if (< val 0) (+ val 360) val))
(let*([r (color-red col)]
[g (color-green col)]
[b (color-blue col)]
[max (max r g b)]
[min (min r g b)]
[s (if (equal? max 0) 1 (/ (- max min) max))])
(cond [(equal? max r) (list (if (equal? max min) 360 (postv (* 60 (/ (- g b) (- max min))))) s max)]
[(equal? max g) (list (if (equal? max min) 360 (postv (+ 2 (* 60 (/ (- b r) (- max min)))))) s max)]
[(equal? max b) (list (if (equal? max min) 360 (postv (+ 4 (* 60 (/ (- r g) (- max min)))))) s max)])))
;v max,s (/ (- max min) max)
(define (RGB hsv)
(define (modulo1 x)
(cond [(or (= x 2) (= x 4) (= x 6)) 0]
[(<= x 2) x]
[(and (> x 2) (<= x 4)) (- x 2)]
[(and (> x 4) (<= x 6)) (- x 4)]))
(define x (* (cadr hsv) (caddr hsv) (- 1 (abs (- (modulo1 (/ (car hsv) 60)) 1)))))
(let* ([h (car hsv)]
[s (cadr hsv)]
[v (caddr hsv)]
[c (* v s)]
[m (exact-floor(* (caddr hsv) (- 1 (cadr hsv))))]
[cn (exact-floor(+ c m))]
[xn (exact-floor(+ x m))])
(cond [(and (< h 60) (>= h 0)) (color cn xn m)]
[(and (< h 120) (>= h 60)) (color xn cn m)]
[(and (< h 180) (>= h 120)) (color m cn xn)]
[(and (< h 240) (>= h 180)) (color m xn cn)]
[(and (< h 300) (>= h 240)) (color xn m cn)]
[(and (< h 360) (>= h 300)) (color cn m xn)])))
;;hue function changes hue by 60
(define (hue mat-i)
(define (change-hue col)
(let*([h (car (HSV col))]
[s (cadr (HSV col))]
[v (caddr (HSV col))]
[hn (if (> h 300) (- h 300) (+ h 60))])
(RGB (list hn s v))))
(map (lambda(x) (change-hue x)) mat-i))
PhotoArt/allimages.rkt 0 → 100755
View file @ 3186495a
This source diff could not be displayed because it is too large. You can view the blob instead.
SAT Solver/satSolver.rkt 0 → 100755
View file @ 3186495a
#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 0 → 100755
View file @ 3186495a
#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)))]))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment