aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l13
diff options
context:
space:
mode:
authorFranciszek Malinka <franciszek.malinka@gmail.com>2021-02-25 14:42:55 +0100
committerFranciszek Malinka <franciszek.malinka@gmail.com>2021-02-25 14:42:55 +0100
commit9477dbe667f250ecd23f8fc0d56b942191526421 (patch)
treea4b50c9a726f415f835f5311c11c5d66e95f688c /Semestr 2/racket/l13
parent1968c1e590077bd51844eacfac722d7963848cb8 (diff)
Stare semestry, niepoukladane
Diffstat (limited to 'Semestr 2/racket/l13')
-rw-r--r--Semestr 2/racket/l13/oceny.txt18
-rw-r--r--Semestr 2/racket/l13/rozw.rkt79
-rw-r--r--Semestr 2/racket/l13/solution.rkt124
-rw-r--r--Semestr 2/racket/l13/zad6.rkt132
4 files changed, 353 insertions, 0 deletions
diff --git a/Semestr 2/racket/l13/oceny.txt b/Semestr 2/racket/l13/oceny.txt
new file mode 100644
index 0000000..9f17cad
--- /dev/null
+++ b/Semestr 2/racket/l13/oceny.txt
@@ -0,0 +1,18 @@
+1 sem
+
+MDM - 5 5
+AO - 5
+AM 1 - 5 5
+LDI - 5 5
+MIA - 5
+
+8 * 5
+
+
+2 sem
+
+Topologia - 5 3
+Analiza - 4 4
+MP - 5 5
+PPS - 5
+Algebra - 5 5 \ No newline at end of file
diff --git a/Semestr 2/racket/l13/rozw.rkt b/Semestr 2/racket/l13/rozw.rkt
new file mode 100644
index 0000000..b4094db
--- /dev/null
+++ b/Semestr 2/racket/l13/rozw.rkt
@@ -0,0 +1,79 @@
+#lang typed/racket
+
+
+;;; zadanie 1
+
+(: prefixes (All (a) (-> (Listof a) (Listof (Listof a)))))
+(define (prefixes xs)
+ (if (null? xs)
+ (list null)
+ (cons xs (prefixes (cdr xs)))))
+
+
+
+;;; zadanie 2
+
+(struct vector2 ([x : Real] [y : Real]) #:transparent)
+(struct vector3 ([x : Real] [y : Real] [z : Real]) #:transparent)
+
+(define-type Vector (U vector2 vector3))
+(define-predicate vector? Vector)
+
+
+(: square (-> Real Nonnegative-Real))
+(define (square x)
+ (if (< x 0) (* x x) (* x x)))
+
+
+;;; pierwsza wersja
+
+(: vector-length (-> Vector Nonnegative-Real))
+(define (vector-length v)
+ (if (vector2? v)
+ (match v [(vector2 x y) (sqrt (+ (square x) (square y)))])
+ (match v [(vector3 x y z) (sqrt (+ (square x) (square y) (square z)))])))
+
+
+;;; druga wersja
+
+(: vector-length-match (-> Vector Nonnegative-Real))
+(define (vector-length-match v)
+ (match v
+ [(vector2 x y) (sqrt (+ (square x) (square y)))]
+ [(vector3 x y z) (sqrt (+ (square x) (square y) (square z)))]))
+
+
+
+;;; zadanie 4
+
+(struct leaf () #:transparent)
+(struct [a] node ([v : a] [xs : (Listof (Tree a))]) #:transparent)
+
+(define-type (Tree a) (node a))
+(define-predicate tree? (Tree Any))
+
+
+(: flat-map (All (a) (-> (-> (Tree a) (Listof a)) (Listof (Tree a)) (Listof a))))
+(define (flat-map f xs)
+ (if (null? xs)
+ null
+ (append (f (car xs)) (flat-map f (cdr xs)))))
+
+(: preorder (All (a) (-> (Tree a) (Listof a))))
+(define (preorder t)
+ (match t
+ [(node v xs)
+ (cons v (flat-map preorder xs))]))
+
+;;; (preorder (node 1 (list
+;;; (node 2 (list
+;;; (node 3 '())
+;;; (node 4 '())))
+;;; (node 5 '())
+;;; (node 'x (list
+;;; (node 't (list
+;;; (node 'z '()))))))))
+
+
+;;; zadanie 6
+
diff --git a/Semestr 2/racket/l13/solution.rkt b/Semestr 2/racket/l13/solution.rkt
new file mode 100644
index 0000000..61804b3
--- /dev/null
+++ b/Semestr 2/racket/l13/solution.rkt
@@ -0,0 +1,124 @@
+#lang typed/racket
+
+; --------- ;
+; Wyrazenia ;
+; --------- ;
+
+(provide parse typecheck)
+
+(define-type Expr (U const binop var-expr let-expr if-expr))
+(define-type Value (U Real Boolean))
+(define-type ArithOp (U '+ '- '/ '* '%))
+;;; (define-type ModOp '%)
+(define-type CompOp (U '= '> '>= '< '<=))
+(define-type LogicOp (U 'and 'or))
+(define-type BinopSym (U ArithOp CompOp LogicOp))
+
+(struct const ([val : Value]) #:transparent)
+(struct binop ([op : BinopSym] [l : Expr] [r : Expr]) #:transparent)
+(struct var-expr ([id : Symbol]) #:transparent)
+(struct let-expr ([id : Symbol] [e1 : Expr] [e2 : Expr]) #:transparent)
+(struct if-expr ([eb : Expr] [et : Expr] [ef : Expr]) #:transparent)
+
+(define-predicate expr? Expr)
+(define-predicate value? Value)
+(define-predicate arith-op? ArithOp)
+;;; (define-predicate mod-op? ModOp)
+(define-predicate comp-op? CompOp)
+(define-predicate logic-op? LogicOp)
+(define-predicate binop-sym? BinopSym)
+(define-predicate let-list? (List Symbol Any))
+
+(: parse (-> Any Expr))
+(define (parse q)
+ (match q
+ [_ #:when (value? q) (const q)]
+ [_ #:when (eq? q 'true) (const true)]
+ [_ #:when (eq? q 'false) (const false)] ; <---------------------------- !!!
+ [_ #:when (symbol? q) (var-expr q)]
+ [`(,s ,e1 ,e2)
+ #:when (and (eq? s 'let) (let-list? e1))
+ (let-expr (car e1)
+ (parse (cadr e1))
+ (parse e2))]
+ [`(,s ,eb ,et ,ef)
+ #:when (eq? s 'if)
+ (if-expr (parse eb)
+ (parse et)
+ (parse ef))]
+ [`(,s ,e1 ,e2)
+ #:when (binop-sym? s)
+ (binop s
+ (parse e1)
+ (parse e2))]
+ [else (error "Parse error" q)]))
+
+; ---------- ;
+; Srodowiska ;
+; ---------- ;
+
+(define-type EType (U 'real 'boolean))
+(define-predicate EType? EType)
+
+(struct environ ([xs : (Listof (Pairof Symbol EType))]))
+(define env-empty (environ null))
+
+(: env-add (-> Symbol EType environ environ))
+(define (env-add x v env)
+ (environ (cons (cons x v) (environ-xs env))))
+
+(: env-lookup (-> Symbol environ EType))
+(define (env-lookup x env)
+ (: assoc-lookup (-> (Listof (Pairof Symbol EType)) EType))
+ (define (assoc-lookup xs)
+ (cond [(null? xs) (error "Unknown identifier" x)]
+ [(eq? x (car (car xs))) (cdr (car xs))]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (environ-xs env)))
+
+(: check-op (-> Expr Expr EType EType environ (U EType #f)))
+(define (check-op e1 e2 arg-type ret-type env)
+ (if (and (eq? (typecheck-env e1 env) arg-type)
+ (eq? (typecheck-env e2 env) arg-type))
+ ret-type
+ #f))
+
+(: typecheck-env (-> Expr environ (U EType #f)))
+(define (typecheck-env e env)
+ (match e
+ [(const val)
+ (cond
+ [(real? val) 'real]
+ [(boolean? val) 'boolean])]
+ [(var-expr id) (env-lookup id env)]
+ [(binop op e1 e2)
+ (cond
+ [(arith-op? op) (check-op e1 e2 'real 'real env)]
+ [(comp-op? op) (check-op e1 e2 'real 'boolean env)]
+ [(logic-op? op) (check-op e1 e2 'boolean 'boolean env)])]
+ [(let-expr id e1 e2)
+ (let ((id-type (typecheck-env e1 env)))
+ (if id-type
+ (typecheck-env e2 (env-add id id-type env))
+ #f))]
+ [(if-expr eb et ef)
+ (let ((eb-type (typecheck-env eb env)))
+ (if (not (eq? eb-type 'boolean))
+ #f
+ (let ((et-type (typecheck-env et env))
+ (ef-type (typecheck-env ef env)))
+ (if (eq? et-type ef-type) ;;; nie trzeba sprawdzac czy ktores z nich to #f
+ et-type ;;; jesli tak jest, to i tak sie na pewno zwroci #f
+ #f))))]))
+
+(: typecheck (-> Expr (U EType #f)))
+(define (typecheck e)
+ (typecheck-env e env-empty))
+
+(define program
+ '(if (or (< (% 123 10) 5)
+ true)
+ (+ 2 3)
+ (/ 2 0)))
+
+(define (test-eval) (eval (parse program))) \ No newline at end of file
diff --git a/Semestr 2/racket/l13/zad6.rkt b/Semestr 2/racket/l13/zad6.rkt
new file mode 100644
index 0000000..1dcfbfc
--- /dev/null
+++ b/Semestr 2/racket/l13/zad6.rkt
@@ -0,0 +1,132 @@
+#lang typed/racket
+
+; Do let-env.rkt dodajemy wartosci boolowskie
+;
+; Miejsca, ktore sie zmienily oznaczone sa przez !!!
+
+; --------- ;
+; Wyrazenia ;
+; --------- ;
+
+(define-type Expr (U const binop var-expr let-expr if-expr))
+(define-type Value (U Real Boolean))
+(define-type BinopSym (U '+ '- '/ '* '% '= '> '>= '< '<= 'and 'or))
+
+(struct const ([val : Value]) #:transparent)
+(struct binop ([op : BinopSym] [l : Expr] [r : Expr]) #:transparent)
+(struct var-expr ([id : Symbol]) #:transparent)
+(struct let-expr ([id : Symbol] [e1 : Expr] [e2 : Expr]) #:transparent)
+(struct if-expr ([eb : Expr] [et : Expr] [ef : Expr]) #:transparent)
+
+
+(define-predicate expr? Expr)
+(define-predicate value? Value)
+(define-predicate binop-sym? BinopSym)
+(define-predicate let-list? (List Symbol Any))
+
+(: parse (-> Any Expr))
+(define (parse q)
+ (match q
+ [_ #:when (value? q) (const q)]
+ [_ #:when (eq? q 'true) (const true)]
+ [_ #:when (eq? q 'false) (const false)] ; <---------------------------- !!!
+ [_ #:when (symbol? q) (var-expr q)]
+ [`(,s ,e1 ,e2)
+ #:when (and (eq? s 'let) (let-list? e1))
+ (let-expr (car e1)
+ (parse (cadr e1))
+ (parse e2))]
+ [`(,s ,eb ,et ,ef)
+ #:when (eq? s 'if)
+ (if-expr (parse eb)
+ (parse et)
+ (parse ef))]
+ [`(,s ,e1 ,e2)
+ #:when (binop-sym? s)
+ (binop s
+ (parse e1)
+ (parse e2))]
+ [else (error "Parse error" q)]))
+
+;;; (define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1))))
+
+; ---------- ;
+; Srodowiska ;
+; ---------- ;
+
+(struct environ ([xs : (Listof (Pairof Symbol Value))]))
+(define env-empty (environ null))
+
+(: env-add (-> Symbol Value environ environ))
+(define (env-add x v env)
+ (environ (cons (cons x v) (environ-xs env))))
+
+(: env-lookup (-> Symbol environ Value))
+(define (env-lookup x env)
+ (: assoc-lookup (-> (Listof (Pairof Symbol Value)) Value))
+ (define (assoc-lookup xs)
+ (cond [(null? xs) (error "Unknown identifier" x)]
+ [(eq? x (car (car xs))) (cdr (car xs))]
+ [else (assoc-lookup (cdr xs))]))
+ (assoc-lookup (environ-xs env)))
+
+; --------- ;
+; Ewaluacja ;
+; --------- ;
+
+(: arith-op (-> (-> Real Real Real) (-> Value Value Value)))
+(define (arith-op op)
+ (lambda (x y) (if (and (real? x) (real? y))
+ (ann (op x y) Value)
+ (error "Wrong args for arithmetic operator" op x y))))
+
+(: mod-op (-> (-> Integer Integer Integer) (-> Value Value Value)))
+(define (mod-op op)
+ (lambda (x y) (if (and (exact-integer? x) (exact-integer? y))
+ (ann (op x y) Value)
+ (error "Wrong args for modulo operator" op x y))))
+
+(: logic-op (-> (-> Boolean Boolean Boolean) (-> Value Value Value)))
+(define (logic-op op)
+ (lambda (x y) (if (and (boolean? x) (boolean? y))
+ (ann (op x y) Value)
+ (error "Wrong args for logic operator" op x y))))
+
+(: comp-op (-> (-> Real Real Boolean) (-> Value Value Value)))
+(define (comp-op op)
+ (lambda (x y) (if (and (real? x) (real? y))
+ (ann (op x y) Value)
+ (error "Wrong args for comparator" op x y))))
+
+
+(: op->proc (-> BinopSym (-> Value Value Value)))
+(define (op->proc op)
+ (match op ['+ (arith-op +)] ['- (arith-op -)] ['* (arith-op *)] ['/ (arith-op /)]
+ ['% (mod-op modulo)]
+ ['= (comp-op =)] ['> (comp-op >)] ['>= (comp-op >=)] ['< (comp-op <)] ['<= (comp-op <=)]
+ ['and (logic-op (lambda (x y) (and x y)))]
+ ['or (logic-op (lambda (x y) (or x y)))]))
+
+(: eval-env (-> Expr environ Value))
+(define (eval-env e env)
+ (match e
+ [(const n) n]
+ [(binop op l r) ((op->proc op) (eval-env l env)
+ (eval-env r env))]
+ [(let-expr x e1 e2)
+ (eval-env e2 (env-add x (eval-env e1 env) env))]
+ [(var-expr x) (env-lookup x env)]
+ [(if-expr eb et ef) (if (eval-env eb env) ; <----------------- !!!
+ (eval-env et env)
+ (eval-env ef env))]))
+
+(: eval (-> Expr Value))
+(define (eval e) (eval-env e env-empty))
+
+(define program
+ '(if (or (< (% 123 10) 5)
+ true)
+ (+ 2 3)
+ (/ 2 0)))
+
+;;; (define (test-eval) (eval (parse program))) \ No newline at end of file