diff options
Diffstat (limited to 'Semestr 2/racket')
87 files changed, 0 insertions, 10740 deletions
diff --git a/Semestr 2/racket/cnf.rkt b/Semestr 2/racket/cnf.rkt deleted file mode 100644 index 67bd70f..0000000 --- a/Semestr 2/racket/cnf.rkt +++ /dev/null @@ -1,188 +0,0 @@ -#lang racket - -(define (var? t) (symbol? t)) - -(define (neg? t) - (and (list? t) - (= 2 (length t)) - (eq? 'neg (car t)))) - -(define (conj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'conj (car t)))) - -(define (disj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'disj (car t)))) - -(define (lit? t) - (or (var? t) - (and (neg? t) - (var? (neg-subf t))))) - -(define (prop? f) - (or (var? f) - (and (neg? f) - (prop? (neg-subf f))) - (and (disj? f) - (prop? (disj-left f)) - (prop? (disj-right f))) - (and (conj? f) - (prop? (conj-left f)) - (prop? (conj-right f))))) - -(define (make-conj left right) - (list 'conj left right)) - -(define (make-disj left right) - (list 'disj left right)) - -(define (make-neg f) - (list 'neg f)) - -(define (conj-left f) - (if (conj? f) - (cadr f) - (error "Złe dane ze znacznikiem -- CONJ-LEFT" f))) - -(define (conj-right f) - (if (conj? f) - (caddr f) - (error "Złe dane ze znacznikiem -- CONJ-RIGHT" f))) - -(define (disj-left f) - (if (disj? f) - (cadr f) - (error "Złe dane ze znacznikiem -- DISJ-LEFT" f))) - -(define (disj-right f) - (if (disj? f) - (caddr f) - (error "Złe dane ze znacznikiem -- DISJ-RIGHT" f))) - -(define (neg-subf f) - (if (neg? f) - (cadr f) - (error "Złe dane ze znacznikiem -- NEG-FORM" f))) - -(define (lit-var f) - (cond [(var? f) f] - [(neg? f) (neg-subf f)] - [else (error "Złe dane ze znacznikiem -- LIT-VAR" f)])) - -(define (free-vars f) - (cond [(null? f) null] - [(var? f) (list f)] - [(neg? f) (free-vars (neg-subf f))] - [(conj? f) (append (free-vars (conj-left f)) - (free-vars (conj-right f)))] - [(disj? f) (append (free-vars (disj-left f)) - (free-vars (disj-right f)))] - [else (error "Zła formula -- FREE-VARS" f)])) - -(define (gen-vals xs) - (if (null? xs) - (list null) - (let* - ((vss (gen-vals (cdr xs))) - (x (car xs)) - (vst (map (λ (vs) (cons (list x true) vs)) vss)) - (vsf (map (λ (vs) (cons (list x false) vs)) vss))) - (append vst vsf)))) - -(define (eval-formula f evaluation) - (cond [(var? f) - (let ((val (assoc f evaluation))) - (if (not val) - (error "Zmienna wolna nie wystepuje w wartościowaniu -- EVAL-FORMULA" f evaluation) - (cadr val)))] - [(neg? f) (not (eval-formula (neg-subf f) evaluation))] - [(disj? f) (or (eval-formula (disj-left f) evaluation) - (eval-formula (disj-right f) evaluation))] - [(conj? f) (and (eval-formula (conj-left f) evaluation) - (eval-formula (conj-right f) evaluation))] - [else (error "Zła formuła -- EVAL-FORMULA" f evaluation)])) - -(define (falsifable-eval? f) - (let* ((evaluations (gen-vals (free-vars f))) - (results (map (λ (evaluation) (eval-formula f evaluation)) evaluations))) - (ormap false? results))) - -(define (nff? f) - (cond [(lit? f) true] - [(neg? f) false] - [(conj? f) (and (nff? (conj-left f)) - (nff? (conj-right f)))] - [(disj? f) (and (nff? (disj-left f)) - (nff? (disj-right f)))] - [else (error "Zła formuła -- NFF?" f)])) - -(define (convert-to-nnf f) - (cond [(lit? f) f] - [(neg? f) (convert-negation (neg-subf f))] - [(conj? f) (make-conj (convert-to-nnf (conj-left f)) - (convert-to-nnf (conj-right f)))] - [(disj? f) (make-disj (convert-to-nnf (disj-left f)) - (convert-to-nnf (disj-right f)))] - [else (error "Zła formuła -- CONVERT" f)])) - -(define (convert-negation f) - (cond [(lit? f) - (if (var? f) - (make-neg f) - (neg-subf f))] - [(neg? f) (convert-to-nnf (neg-subf f))] - [(conj? f) (make-disj (convert-negation (conj-left f)) - (convert-negation (conj-right f)))] - [(disj? f) (make-conj (convert-negation (disj-left f)) - (convert-negation (disj-right f)))] - [else (error "Zła formuła -- CONVERT-NEGATION" f)])) - -(define (clause? x) - (and (list? x) - (andmap lit? x))) - -(define (clause-empty? x) - (and (clause? x) - (null? x))) - -(define (cnf? x) - (and (list? x) - (andmap clause? x))) - -(define (flatmap proc seq) - (foldl append null (map proc seq))) - -(define (convert-to-cnf f) - (define (convert f) - (cond [(lit? f) (list (list f))] - [(conj? f) (append (convert-to-cnf (conj-left f)) - (convert-to-cnf (conj-right f)))] - [(disj? f) - (let ((clause-left (convert-to-cnf (disj-left f))) - (clause-right (convert-to-cnf (disj-right f)))) - (flatmap (λ (clause) - (map (λ (clause2) - (append clause2 clause)) clause-left)) - clause-right))])) - (convert (convert-to-nnf f))) - -(define (falsifable-clause? clause) - (cond [(clause-empty? clause) true] - [(lit? (findf (λ (l) (equal? - l - (convert-to-nnf (make-neg (car clause))))) - clause)) false] - [else (falsifable-clause? (cdr clause))])) - -(define (falsifable-cnf? f) - (define (neg-value lit) - (if (var? lit) - (list lit false) - (list (neg-subf lit) true))) - (ormap (λ (clause) (if (falsifable-clause? clause) - (map neg-value clause) - false)) - (convert-to-cnf f)))
\ No newline at end of file diff --git a/Semestr 2/racket/cw.rkt b/Semestr 2/racket/cw.rkt deleted file mode 100644 index f1e706f..0000000 --- a/Semestr 2/racket/cw.rkt +++ /dev/null @@ -1,57 +0,0 @@ -#lang racket - -(define (accumulate op initial sequence) - (if (null? sequence) - initial - (op (car sequence) - (accumulate op initial (cdr sequence))))) - -(define (horner-eval x coefficient-sequence) - (accumulate (lambda (this-coeff higher-terms) - (+ this-coeff (* x higher-terms))) - 0 - coefficient-sequence)) - - -(define (accumulate-n op init seqs) - (if (null? (car seqs)) - null - (cons (accumulate op init (map car seqs)) - (accumulate-n op init (map cdr seqs))))) - -(define (count-leaves t) - (accumulate + 0 (map (lambda (x) - (if (not (pair? x)) - 1 - (count-leaves x))) t))) - -(define (flatmap proc seq) - (accumulate append null (map proc seq))) - -(define (prime? x) (= (modulo x 2) 1)) - -(define (prime-sum? pair) - (prime? (+ (car pair) (cadr pair)))) - -(define (make-pair-sum pair) - (list (car pair) (cadr pair) (+ (car pair) (cadr pair)))) - -(define (enumerate-interval low high) - (if (> low high) - null - (cons low (enumerate-interval (+ 1 low) high)))) - -(define (unique-pairs n) - (flatmap (lambda (i) - (map (lambda (j) (list j i)) - (enumerate-interval 1 (- i 1)))) - (enumerate-interval 1 n))) - -(define (prime-sum-pairs n) - (map make-pair-sum - (filter prime-sum? (unique-pairs n)))) - -(define (is-eq-s? s triplet) - (= s (accumulate + 0 triplet))) - -(define
\ No newline at end of file diff --git a/Semestr 2/racket/deriv.rkt b/Semestr 2/racket/deriv.rkt deleted file mode 100644 index 0eef9d2..0000000 --- a/Semestr 2/racket/deriv.rkt +++ /dev/null @@ -1,47 +0,0 @@ -#lang racket - -(define (variable? x) (symbol? x)) - -(define (same-variable? v1 v2) - (and (variable? v1) (variable? v2) (eq? v1 v2))) - -(define (=number? exp num) - (and (number? exp) (= exp num))) - -(define (make-sum a1 a2) - (cond ((=number? a1 0) a2) - ((=number? a2 0) a1) - ((and (number? a1) (number? a2) (+ a1 a2))) - (else (list '+ a1 a2)))) -(define (sum? x) - (and (pair? x) (eq? (car x) '+))) -(define (addend s) (cadr s)) -(define (augend s) (caddr s)) - -(define (make-product m1 m2) - (cond ((or (=number? m1 0) (=number? m2 0)) 0) - ((=number? m1 1) m2) - ((=number? m2 1) m1) - ((and (number? m1) (number? m2)) (* m1 m2)) - (else (list '* m1 m2)))) -(define (product? x) - (and (pair? x) (eq? (car x) '*))) -(define (multiplier p) (cadr p)) -(define (multiplicand p) (caddr p)) - -(define (deriv exp var) - (cond ((number? exp) 0) - ((variable? exp) - (if (same-variable? exp var) 1 0)) - ((sum? exp) - (make-sum (deriv (addend exp) var) - (deriv (augend exp) var))) - ((product? exp) - (make-sum - (make-product (multiplier exp) - (deriv (multiplicand exp) var)) - (make-product (deriv (multiplier exp) var) - (multiplicand exp)))) - (else - (error "Nieznany rodzaj wyrazenia -- DERIV" exp)))) -
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/rozw2.txt b/Semestr 2/racket/egzamin/rozw2.txt deleted file mode 100644 index a70232e..0000000 --- a/Semestr 2/racket/egzamin/rozw2.txt +++ /dev/null @@ -1 +0,0 @@ -Zasada indukcji dla
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad1.bak b/Semestr 2/racket/egzamin/zad1.bak deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/egzamin/zad1.bak +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/egzamin/zad1.rkt b/Semestr 2/racket/egzamin/zad1.rkt deleted file mode 100644 index a90d2fd..0000000 --- a/Semestr 2/racket/egzamin/zad1.rkt +++ /dev/null @@ -1,300 +0,0 @@ -#lang racket - -;; ZADANIE 1 -;; ========= - -;; W tym zadaniu rozważamy język WHILE (w formie z grubsza -;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o -;; lokalnym zakresie. - -;; Zadanie polega na dodaniu do języka procedur definiowanych na -;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie -;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o -;; dowolnym wybranym przez siebie modelu działania. W tym celu należy: -;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów -;; · rozszerzyć procedurę parsowania -;; · rozszerzyć ewaluator -;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia -;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić -;; w komentarzu, podobnie jak niniejsze polecenie. - -;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele -;; sensownych rozwiązań które stosowały liczne języki imperatywne w -;; historii — nie jest treścią zadania znalezienie *najlepszego*, -;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur -;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto -;; pokazać że ma się tego świadomość w słownym opisie jego działania. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (name) #:transparent) -(struct call-expr (name args) #:transparent) -(struct return-expr (val) #:transparent) - -(define (operator? x) - (member x '(+ * - / > < = >= <=))) - -(define (keyword? x) - (member x '(skip while if := func call return))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(var-expr x) - (and (symbol? x) - (not (keyword? x)))] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - -(struct skip () #:transparent) -(struct assign (id exp) #:transparent) -(struct if-cmd (exp ct cf) #:transparent) -(struct while (exp cmd) #:transparent) -(struct comp (left right) #:transparent) -(struct var-in (name expr cmd) #:transparent) -(struct function (name args cmd) #:transparent) - -(define (cmd? c) - (match c - [(skip) true] - [(assign x e) (and (symbol? x) (expr? e))] - [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))] - [(while e c) (and (expr? e) (cmd? c))] - [(comp c1 c2) (and (cmd? c1) (cmd? c2))] - [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))] - [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))])) - -(define (prog? p) - (cmd? p)) - -(define (parse-expr p) - (cond - [(number? p) (const p)] - [(and (symbol? p) - (not (keyword? p))) - (var-expr p)] - [(and (list? p) - (= 3 (length p)) - (operator? (car p))) - (binop (first p) - (parse-expr (second p)) - (parse-expr (third p)))] - [(and (list? p) ; <------ wywołanie funkcji - (= (length p) 3) - (eq? (first p) 'call) - (symbol? (second p)) - (list? (third p))) - (call-expr (second p) (map parse-expr (third p)))] - [else false])) - -(define (parse-cmd q) - (cond - [(eq? q 'skip) (skip)] - [(and (list? q) - (= (length q) 3) - (eq? (second q) ':=)) - (assign (first q) (parse-expr (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'while)) - (while (parse-expr (second q)) (parse-cmd (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'var) - (list? (second q)) - (= (length (second q)) 2)) - (var-in (first (second q)) - (parse-expr (second (second q))) - (parse-cmd (third q)))] - [(and (list? q) ; <------ funkcje - (= (length q) 4) - (eq? (first q) 'func) - (symbol? (second q)) - (list? (third q)) - (andmap symbol? (third q))) - (function (second q) (third q) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 2) - (eq? (first q) 'return)) - (return-expr (parse-expr (second q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-comp (map parse-cmd q))] - [else false])) - -(define (desugar-comp cs) - (if (null? (cdr cs)) - (car cs) - (comp (car cs) - (desugar-comp (cdr cs))))) - -(define (value? v) - (number? v)) - -(struct mem (xs) #:transparent) - -(define (mem-lookup x m) - (define (assoc-lookup xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cdar xs)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane - (define (assoc-lookup xs) - (cond - [(null? xs) #f] - [(eq? x (caar xs) #t)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-update x v m) - (define (assoc-update xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cons (cons x v) (cdr xs))] - [else (cons (car xs) (assoc-update (cdr xs)))])) - (mem (assoc-update (mem-xs m)))) - -(define (mem-alloc x v m) - (mem (cons (cons x v) (mem-xs m)))) - -(define (mem-drop-last m) - (cond - [(null? (mem-xs m)) - (error "Deallocating from empty memory")] - [else - (mem (cdr (mem-xs m)))])) - -(define empty-mem - (mem null)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /] - ['< (lambda (x y) (if (< x y) 1 0))] - ['> (lambda (x y) (if (> x y) 1 0))] - ['= (lambda (x y) (if (= x y) 1 0))] - ['<= (lambda (x y) (if (<= x y) 1 0))] - ['>= (lambda (x y) (if (>= x y) 1 0))] - )) - -;; zał: (expr? e) i (mem? m) jest prawdą -;; (value? (eval e m)) jest prawdą -(define (eval e m) - (match e - [(const v) v] - [(var-expr x) (mem-lookup x m)] - [(binop op l r) - (let ((vl (eval l m)) - (vr (eval r m)) - (p (op->proc op))) - (p vl vr))] - [(call-expr name args) - (match (mem-lookup name m) - [(clo func-args cmd) - (if (= (length args) (length func-args)) - (let* ([func-mem (assign-values args func-args m)] - [final-mem (eval-cmd cmd func-mem)] - [ret (mem-lookup 'RETURN final-mem)]) - (if ret - ret - (error "No return statement in function" name))) - (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))] - [else (error "Undefined function" name)])])) - -(define (assign-values args func-args mem) - (if (null? args) - mem - (assign-values (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) mem)))) - - -(struct clo (args cmd)) - -;; zał: (cmd? c) (mem? m) -;; (mem? (eval-cmd c m)) -(define (eval-cmd c m) - (if (mem-lookup 'RETURN m) - m - (match c - [(skip) m] - [(assign x e) (mem-update x (eval e m) m)] - [(if-cmd e ct cf) (if (= (eval e m) 0) - (eval-cmd cf m) - (eval-cmd ct m))] - [(while e cw) (if (= (eval e m) 0) - m - (let* ((m1 (eval-cmd cw m)) - (m2 (eval-cmd c m1))) - m2))] - [(comp c1 c2) (let* ((m1 (eval-cmd c1 m)) - (m2 (eval-cmd c2 m1))) - m2)] - [(var-in x e c) (let* ((v (eval e m)) - (m1 (mem-alloc x v m)) - (m2 (eval-cmd c m1))) - (mem-drop-last m2))] - [(function name args cmd) - (mem-alloc name (clo args cmd) m)] - [(return-expr val) - (mem-update 'RETURN (eval val m) m)] - [_ (error "Unknown command" c "— likely a syntax error")]))) - - -(define (eval-prog p m) - (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m)))) - (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))]) - (match (mem-lookup 'main final-mem) - [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))])))) - -(define WHILE_FACT - '({func decr (x) - {(x := (- x 1)) - (return x)}} - {func main () - {(i := 1) - (while (> t 0) - {(i := (* i t)) - (t := (call decr (t)))}) - (return i)}} - )) - -(define TEST - '({func decr (x) (return (- x 1))} - {func main () - (var (x 1) - {(x := (+ x 1)) - (return (call decr (x)))})})) - -(define TEST2 - '({func decr (x) (return (- x 1))} - {func main () (return (call decr (3)))})) - -(define TEST3 - '({func sth (x) - {(i := -1) - (return x)}} - {func main () - {(i := 2) - (return (call sth (i)))}})) - -(define TEST4 - '(func f () - {return 1})) - -(define (fact n) - (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))]) - (eval-prog (parse-cmd WHILE_FACT) init-env))) - diff --git a/Semestr 2/racket/egzamin/zad1a.bak b/Semestr 2/racket/egzamin/zad1a.bak deleted file mode 100644 index a90d2fd..0000000 --- a/Semestr 2/racket/egzamin/zad1a.bak +++ /dev/null @@ -1,300 +0,0 @@ -#lang racket - -;; ZADANIE 1 -;; ========= - -;; W tym zadaniu rozważamy język WHILE (w formie z grubsza -;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o -;; lokalnym zakresie. - -;; Zadanie polega na dodaniu do języka procedur definiowanych na -;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie -;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o -;; dowolnym wybranym przez siebie modelu działania. W tym celu należy: -;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów -;; · rozszerzyć procedurę parsowania -;; · rozszerzyć ewaluator -;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia -;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić -;; w komentarzu, podobnie jak niniejsze polecenie. - -;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele -;; sensownych rozwiązań które stosowały liczne języki imperatywne w -;; historii — nie jest treścią zadania znalezienie *najlepszego*, -;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur -;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto -;; pokazać że ma się tego świadomość w słownym opisie jego działania. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (name) #:transparent) -(struct call-expr (name args) #:transparent) -(struct return-expr (val) #:transparent) - -(define (operator? x) - (member x '(+ * - / > < = >= <=))) - -(define (keyword? x) - (member x '(skip while if := func call return))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(var-expr x) - (and (symbol? x) - (not (keyword? x)))] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - -(struct skip () #:transparent) -(struct assign (id exp) #:transparent) -(struct if-cmd (exp ct cf) #:transparent) -(struct while (exp cmd) #:transparent) -(struct comp (left right) #:transparent) -(struct var-in (name expr cmd) #:transparent) -(struct function (name args cmd) #:transparent) - -(define (cmd? c) - (match c - [(skip) true] - [(assign x e) (and (symbol? x) (expr? e))] - [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))] - [(while e c) (and (expr? e) (cmd? c))] - [(comp c1 c2) (and (cmd? c1) (cmd? c2))] - [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))] - [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))])) - -(define (prog? p) - (cmd? p)) - -(define (parse-expr p) - (cond - [(number? p) (const p)] - [(and (symbol? p) - (not (keyword? p))) - (var-expr p)] - [(and (list? p) - (= 3 (length p)) - (operator? (car p))) - (binop (first p) - (parse-expr (second p)) - (parse-expr (third p)))] - [(and (list? p) ; <------ wywołanie funkcji - (= (length p) 3) - (eq? (first p) 'call) - (symbol? (second p)) - (list? (third p))) - (call-expr (second p) (map parse-expr (third p)))] - [else false])) - -(define (parse-cmd q) - (cond - [(eq? q 'skip) (skip)] - [(and (list? q) - (= (length q) 3) - (eq? (second q) ':=)) - (assign (first q) (parse-expr (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'while)) - (while (parse-expr (second q)) (parse-cmd (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'var) - (list? (second q)) - (= (length (second q)) 2)) - (var-in (first (second q)) - (parse-expr (second (second q))) - (parse-cmd (third q)))] - [(and (list? q) ; <------ funkcje - (= (length q) 4) - (eq? (first q) 'func) - (symbol? (second q)) - (list? (third q)) - (andmap symbol? (third q))) - (function (second q) (third q) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 2) - (eq? (first q) 'return)) - (return-expr (parse-expr (second q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-comp (map parse-cmd q))] - [else false])) - -(define (desugar-comp cs) - (if (null? (cdr cs)) - (car cs) - (comp (car cs) - (desugar-comp (cdr cs))))) - -(define (value? v) - (number? v)) - -(struct mem (xs) #:transparent) - -(define (mem-lookup x m) - (define (assoc-lookup xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cdar xs)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane - (define (assoc-lookup xs) - (cond - [(null? xs) #f] - [(eq? x (caar xs) #t)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-update x v m) - (define (assoc-update xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cons (cons x v) (cdr xs))] - [else (cons (car xs) (assoc-update (cdr xs)))])) - (mem (assoc-update (mem-xs m)))) - -(define (mem-alloc x v m) - (mem (cons (cons x v) (mem-xs m)))) - -(define (mem-drop-last m) - (cond - [(null? (mem-xs m)) - (error "Deallocating from empty memory")] - [else - (mem (cdr (mem-xs m)))])) - -(define empty-mem - (mem null)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /] - ['< (lambda (x y) (if (< x y) 1 0))] - ['> (lambda (x y) (if (> x y) 1 0))] - ['= (lambda (x y) (if (= x y) 1 0))] - ['<= (lambda (x y) (if (<= x y) 1 0))] - ['>= (lambda (x y) (if (>= x y) 1 0))] - )) - -;; zał: (expr? e) i (mem? m) jest prawdą -;; (value? (eval e m)) jest prawdą -(define (eval e m) - (match e - [(const v) v] - [(var-expr x) (mem-lookup x m)] - [(binop op l r) - (let ((vl (eval l m)) - (vr (eval r m)) - (p (op->proc op))) - (p vl vr))] - [(call-expr name args) - (match (mem-lookup name m) - [(clo func-args cmd) - (if (= (length args) (length func-args)) - (let* ([func-mem (assign-values args func-args m)] - [final-mem (eval-cmd cmd func-mem)] - [ret (mem-lookup 'RETURN final-mem)]) - (if ret - ret - (error "No return statement in function" name))) - (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))] - [else (error "Undefined function" name)])])) - -(define (assign-values args func-args mem) - (if (null? args) - mem - (assign-values (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) mem)))) - - -(struct clo (args cmd)) - -;; zał: (cmd? c) (mem? m) -;; (mem? (eval-cmd c m)) -(define (eval-cmd c m) - (if (mem-lookup 'RETURN m) - m - (match c - [(skip) m] - [(assign x e) (mem-update x (eval e m) m)] - [(if-cmd e ct cf) (if (= (eval e m) 0) - (eval-cmd cf m) - (eval-cmd ct m))] - [(while e cw) (if (= (eval e m) 0) - m - (let* ((m1 (eval-cmd cw m)) - (m2 (eval-cmd c m1))) - m2))] - [(comp c1 c2) (let* ((m1 (eval-cmd c1 m)) - (m2 (eval-cmd c2 m1))) - m2)] - [(var-in x e c) (let* ((v (eval e m)) - (m1 (mem-alloc x v m)) - (m2 (eval-cmd c m1))) - (mem-drop-last m2))] - [(function name args cmd) - (mem-alloc name (clo args cmd) m)] - [(return-expr val) - (mem-update 'RETURN (eval val m) m)] - [_ (error "Unknown command" c "— likely a syntax error")]))) - - -(define (eval-prog p m) - (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m)))) - (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))]) - (match (mem-lookup 'main final-mem) - [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))])))) - -(define WHILE_FACT - '({func decr (x) - {(x := (- x 1)) - (return x)}} - {func main () - {(i := 1) - (while (> t 0) - {(i := (* i t)) - (t := (call decr (t)))}) - (return i)}} - )) - -(define TEST - '({func decr (x) (return (- x 1))} - {func main () - (var (x 1) - {(x := (+ x 1)) - (return (call decr (x)))})})) - -(define TEST2 - '({func decr (x) (return (- x 1))} - {func main () (return (call decr (3)))})) - -(define TEST3 - '({func sth (x) - {(i := -1) - (return x)}} - {func main () - {(i := 2) - (return (call sth (i)))}})) - -(define TEST4 - '(func f () - {return 1})) - -(define (fact n) - (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))]) - (eval-prog (parse-cmd WHILE_FACT) init-env))) - diff --git a/Semestr 2/racket/egzamin/zad1a.rkt b/Semestr 2/racket/egzamin/zad1a.rkt deleted file mode 100644 index a587359..0000000 --- a/Semestr 2/racket/egzamin/zad1a.rkt +++ /dev/null @@ -1,314 +0,0 @@ -#lang racket - -;; ZADANIE 1 -;; ========= - -;; W tym zadaniu rozważamy język WHILE (w formie z grubsza -;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o -;; lokalnym zakresie. - -;; Zadanie polega na dodaniu do języka procedur definiowanych na -;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie -;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o -;; dowolnym wybranym przez siebie modelu działania. W tym celu należy: -;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów -;; · rozszerzyć procedurę parsowania -;; · rozszerzyć ewaluator -;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia -;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić -;; w komentarzu, podobnie jak niniejsze polecenie. - -;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele -;; sensownych rozwiązań które stosowały liczne języki imperatywne w -;; historii — nie jest treścią zadania znalezienie *najlepszego*, -;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur -;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto -;; pokazać że ma się tego świadomość w słownym opisie jego działania. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (name) #:transparent) -(struct call-expr (name args) #:transparent) -(struct return-expr (val) #:transparent) - -(define (operator? x) - (member x '(+ * - / > < = >= <=))) - -(define (keyword? x) - (member x '(skip while if := func call return))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(var-expr x) - (and (symbol? x) - (not (keyword? x)))] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - -(struct skip () #:transparent) -(struct assign (id exp) #:transparent) -(struct if-cmd (exp ct cf) #:transparent) -(struct while (exp cmd) #:transparent) -(struct comp (left right) #:transparent) -(struct var-in (name expr cmd) #:transparent) -(struct function (name args cmd) #:transparent) - -(define (cmd? c) - (match c - [(skip) true] - [(assign x e) (and (symbol? x) (expr? e))] - [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))] - [(while e c) (and (expr? e) (cmd? c))] - [(comp c1 c2) (and (cmd? c1) (cmd? c2))] - [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))] - [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))])) - -(define (prog? p) - (cmd? p)) - -(define (parse-expr p) - (cond - [(number? p) (const p)] - [(and (symbol? p) - (not (keyword? p))) - (var-expr p)] - [(and (list? p) - (= 3 (length p)) - (operator? (car p))) - (binop (first p) - (parse-expr (second p)) - (parse-expr (third p)))] - [(and (list? p) ; <------ wywołanie funkcji - (= (length p) 3) - (eq? (first p) 'call) - (symbol? (second p)) - (list? (third p))) - (call-expr (second p) (map parse-expr (third p)))] - [else false])) - -(define (parse-cmd q) - (cond - [(eq? q 'skip) (skip)] - [(and (list? q) - (= (length q) 3) - (eq? (second q) ':=)) - (assign (first q) (parse-expr (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'while)) - (while (parse-expr (second q)) (parse-cmd (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'var) - (list? (second q)) - (= (length (second q)) 2)) - (var-in (first (second q)) - (parse-expr (second (second q))) - (parse-cmd (third q)))] - [(and (list? q) ; <------ funkcje - (= (length q) 4) - (eq? (first q) 'func) - (symbol? (second q)) - (list? (third q)) - (andmap symbol? (third q))) - (function (second q) (third q) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 2) - (eq? (first q) 'return)) - (return-expr (parse-expr (second q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-comp (map parse-cmd q))] - [else false])) - -(define (desugar-comp cs) - (if (null? (cdr cs)) - (car cs) - (comp (car cs) - (desugar-comp (cdr cs))))) - -(define (value? v) - (number? v)) - -(struct mem (xs) #:transparent) - -(define (mem-lookup x m) - (define (assoc-lookup xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cdar xs)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane - (define (assoc-lookup xs) - (cond - [(null? xs) #f] - [(eq? x (caar xs) #t)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-update x v m) - (define (assoc-update xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cons (cons x v) (cdr xs))] - [else (cons (car xs) (assoc-update (cdr xs)))])) - (mem (assoc-update (mem-xs m)))) - -(define (mem-alloc x v m) - (mem (cons (cons x v) (mem-xs m)))) - -(define (mem-drop-last m) - (cond - [(null? (mem-xs m)) - (error "Deallocating from empty memory")] - [else - (mem (cdr (mem-xs m)))])) - -(define empty-mem - (mem null)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /] - ['< (lambda (x y) (if (< x y) 1 0))] - ['> (lambda (x y) (if (> x y) 1 0))] - ['= (lambda (x y) (if (= x y) 1 0))] - ['<= (lambda (x y) (if (<= x y) 1 0))] - ['>= (lambda (x y) (if (>= x y) 1 0))] - )) - -;; zał: (expr? e) i (mem? m) jest prawdą -;; (value? (eval e m)) jest prawdą -(define (eval e m) - (match e - [(const v) v] - [(var-expr x) (mem-lookup x m)] - [(binop op l r) - (let ((vl (eval l m)) - (vr (eval r m)) - (p (op->proc op))) - (p vl vr))] - [(call-expr name args) - (match (mem-lookup name m) - [(clo func-args cmd) - (if (= (length args) (length func-args)) - (let* ([func-mem (assign-values args func-args m)] - [final-mem (eval-cmd cmd func-mem)] - [ret (mem-lookup 'RETURN final-mem)]) - (if ret - ret - (error "No return statement in function" name))) - (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))] - [else (error "Undefined function" name)])])) - -(define (assign-values args func-args mem) - (define (iter args func-args new-mem) - (if (null? args) - new-mem - (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem)))) - (iter args func-args mem)) - - -(struct clo (args cmd)) - -;; zał: (cmd? c) (mem? m) -;; (mem? (eval-cmd c m)) -(define (eval-cmd c m) - (if (mem-lookup 'RETURN m) - m - (match c - [(skip) m] - [(assign x e) (mem-update x (eval e m) m)] - [(if-cmd e ct cf) (if (= (eval e m) 0) - (eval-cmd cf m) - (eval-cmd ct m))] - [(while e cw) (if (= (eval e m) 0) - m - (let* ((m1 (eval-cmd cw m)) - (m2 (eval-cmd c m1))) - m2))] - [(comp c1 c2) (let* ((m1 (eval-cmd c1 m)) - (m2 (eval-cmd c2 m1))) - m2)] - [(var-in x e c) (let* ((v (eval e m)) - (m1 (mem-alloc x v m)) - (m2 (eval-cmd c m1))) - (mem-drop-last m2))] - [(function name args cmd) - (mem-alloc name (clo args cmd) m)] - [(return-expr val) - (mem-update 'RETURN (eval val m) m)] - [_ (error "Unknown command" c "— likely a syntax error")]))) - - -(define (eval-prog p m) - (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m)))) - (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))]) - (match (mem-lookup 'main final-mem) - [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))])))) - -(define WHILE_FACT - '({func decr (x) - {(x := (- x 1)) - (return x)}} - {func main () - {(i := 1) - (while (> t 0) - {(i := (* i t)) - (t := (call decr (t)))}) - (return i)}} - )) - -(define (fact n) - (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))]) - (eval-prog (parse-cmd WHILE_FACT) init-env))) - -(define TEST - '({func decr (x) (return (- x 1))} - {func main () - (var (x 1) - {(x := (+ x 1)) - (return (call decr (x)))})})) - -(define TEST2 - '({func decr (x) (return (- x 1))} - {func main () (return (call decr (3)))})) - -(define TEST3 - '({func sth (x) - {(i := -1) - (return x)}} - {func main () - {(i := 2) - (return (call sth (i)))}})) - -(define TEST4 - '(func f () - {return 1})) - -(define TEST5 - '({func f1 (x y z) - (return y)} - {func f2 (x y z) - (return (+ (+ x y) z))} - {func main () - {(if (> 4 3) - (var (x 2) - (return (call f1 (1 x 3)))) - (x := 5)) - (return (call f2 (x 3 4)))}})) -
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad1b.bak b/Semestr 2/racket/egzamin/zad1b.bak deleted file mode 100644 index a587359..0000000 --- a/Semestr 2/racket/egzamin/zad1b.bak +++ /dev/null @@ -1,314 +0,0 @@ -#lang racket - -;; ZADANIE 1 -;; ========= - -;; W tym zadaniu rozważamy język WHILE (w formie z grubsza -;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o -;; lokalnym zakresie. - -;; Zadanie polega na dodaniu do języka procedur definiowanych na -;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie -;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o -;; dowolnym wybranym przez siebie modelu działania. W tym celu należy: -;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów -;; · rozszerzyć procedurę parsowania -;; · rozszerzyć ewaluator -;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia -;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić -;; w komentarzu, podobnie jak niniejsze polecenie. - -;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele -;; sensownych rozwiązań które stosowały liczne języki imperatywne w -;; historii — nie jest treścią zadania znalezienie *najlepszego*, -;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur -;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto -;; pokazać że ma się tego świadomość w słownym opisie jego działania. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (name) #:transparent) -(struct call-expr (name args) #:transparent) -(struct return-expr (val) #:transparent) - -(define (operator? x) - (member x '(+ * - / > < = >= <=))) - -(define (keyword? x) - (member x '(skip while if := func call return))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(var-expr x) - (and (symbol? x) - (not (keyword? x)))] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - -(struct skip () #:transparent) -(struct assign (id exp) #:transparent) -(struct if-cmd (exp ct cf) #:transparent) -(struct while (exp cmd) #:transparent) -(struct comp (left right) #:transparent) -(struct var-in (name expr cmd) #:transparent) -(struct function (name args cmd) #:transparent) - -(define (cmd? c) - (match c - [(skip) true] - [(assign x e) (and (symbol? x) (expr? e))] - [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))] - [(while e c) (and (expr? e) (cmd? c))] - [(comp c1 c2) (and (cmd? c1) (cmd? c2))] - [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))] - [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))])) - -(define (prog? p) - (cmd? p)) - -(define (parse-expr p) - (cond - [(number? p) (const p)] - [(and (symbol? p) - (not (keyword? p))) - (var-expr p)] - [(and (list? p) - (= 3 (length p)) - (operator? (car p))) - (binop (first p) - (parse-expr (second p)) - (parse-expr (third p)))] - [(and (list? p) ; <------ wywołanie funkcji - (= (length p) 3) - (eq? (first p) 'call) - (symbol? (second p)) - (list? (third p))) - (call-expr (second p) (map parse-expr (third p)))] - [else false])) - -(define (parse-cmd q) - (cond - [(eq? q 'skip) (skip)] - [(and (list? q) - (= (length q) 3) - (eq? (second q) ':=)) - (assign (first q) (parse-expr (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'while)) - (while (parse-expr (second q)) (parse-cmd (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'var) - (list? (second q)) - (= (length (second q)) 2)) - (var-in (first (second q)) - (parse-expr (second (second q))) - (parse-cmd (third q)))] - [(and (list? q) ; <------ funkcje - (= (length q) 4) - (eq? (first q) 'func) - (symbol? (second q)) - (list? (third q)) - (andmap symbol? (third q))) - (function (second q) (third q) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 2) - (eq? (first q) 'return)) - (return-expr (parse-expr (second q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-comp (map parse-cmd q))] - [else false])) - -(define (desugar-comp cs) - (if (null? (cdr cs)) - (car cs) - (comp (car cs) - (desugar-comp (cdr cs))))) - -(define (value? v) - (number? v)) - -(struct mem (xs) #:transparent) - -(define (mem-lookup x m) - (define (assoc-lookup xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cdar xs)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-defined? x m) ; <----------- !!! Sprawdz, czy x jest w ogole zdefiniowane - (define (assoc-lookup xs) - (cond - [(null? xs) #f] - [(eq? x (caar xs) #t)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-update x v m) - (define (assoc-update xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cons (cons x v) (cdr xs))] - [else (cons (car xs) (assoc-update (cdr xs)))])) - (mem (assoc-update (mem-xs m)))) - -(define (mem-alloc x v m) - (mem (cons (cons x v) (mem-xs m)))) - -(define (mem-drop-last m) - (cond - [(null? (mem-xs m)) - (error "Deallocating from empty memory")] - [else - (mem (cdr (mem-xs m)))])) - -(define empty-mem - (mem null)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /] - ['< (lambda (x y) (if (< x y) 1 0))] - ['> (lambda (x y) (if (> x y) 1 0))] - ['= (lambda (x y) (if (= x y) 1 0))] - ['<= (lambda (x y) (if (<= x y) 1 0))] - ['>= (lambda (x y) (if (>= x y) 1 0))] - )) - -;; zał: (expr? e) i (mem? m) jest prawdą -;; (value? (eval e m)) jest prawdą -(define (eval e m) - (match e - [(const v) v] - [(var-expr x) (mem-lookup x m)] - [(binop op l r) - (let ((vl (eval l m)) - (vr (eval r m)) - (p (op->proc op))) - (p vl vr))] - [(call-expr name args) - (match (mem-lookup name m) - [(clo func-args cmd) - (if (= (length args) (length func-args)) - (let* ([func-mem (assign-values args func-args m)] - [final-mem (eval-cmd cmd func-mem)] - [ret (mem-lookup 'RETURN final-mem)]) - (if ret - ret - (error "No return statement in function" name))) - (error "Arity mismatch, function" name "takes" (length func-args) ", got" (length args)))] - [else (error "Undefined function" name)])])) - -(define (assign-values args func-args mem) - (define (iter args func-args new-mem) - (if (null? args) - new-mem - (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem)))) - (iter args func-args mem)) - - -(struct clo (args cmd)) - -;; zał: (cmd? c) (mem? m) -;; (mem? (eval-cmd c m)) -(define (eval-cmd c m) - (if (mem-lookup 'RETURN m) - m - (match c - [(skip) m] - [(assign x e) (mem-update x (eval e m) m)] - [(if-cmd e ct cf) (if (= (eval e m) 0) - (eval-cmd cf m) - (eval-cmd ct m))] - [(while e cw) (if (= (eval e m) 0) - m - (let* ((m1 (eval-cmd cw m)) - (m2 (eval-cmd c m1))) - m2))] - [(comp c1 c2) (let* ((m1 (eval-cmd c1 m)) - (m2 (eval-cmd c2 m1))) - m2)] - [(var-in x e c) (let* ((v (eval e m)) - (m1 (mem-alloc x v m)) - (m2 (eval-cmd c m1))) - (mem-drop-last m2))] - [(function name args cmd) - (mem-alloc name (clo args cmd) m)] - [(return-expr val) - (mem-update 'RETURN (eval val m) m)] - [_ (error "Unknown command" c "— likely a syntax error")]))) - - -(define (eval-prog p m) - (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m)))) - (with-handlers ([exn:fail? (lambda (v) (error "Undefined reference to main"))]) - (match (mem-lookup 'main final-mem) - [(clo args cmd) (mem-lookup 'RETURN (eval-cmd cmd final-mem))])))) - -(define WHILE_FACT - '({func decr (x) - {(x := (- x 1)) - (return x)}} - {func main () - {(i := 1) - (while (> t 0) - {(i := (* i t)) - (t := (call decr (t)))}) - (return i)}} - )) - -(define (fact n) - (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))]) - (eval-prog (parse-cmd WHILE_FACT) init-env))) - -(define TEST - '({func decr (x) (return (- x 1))} - {func main () - (var (x 1) - {(x := (+ x 1)) - (return (call decr (x)))})})) - -(define TEST2 - '({func decr (x) (return (- x 1))} - {func main () (return (call decr (3)))})) - -(define TEST3 - '({func sth (x) - {(i := -1) - (return x)}} - {func main () - {(i := 2) - (return (call sth (i)))}})) - -(define TEST4 - '(func f () - {return 1})) - -(define TEST5 - '({func f1 (x y z) - (return y)} - {func f2 (x y z) - (return (+ (+ x y) z))} - {func main () - {(if (> 4 3) - (var (x 2) - (return (call f1 (1 x 3)))) - (x := 5)) - (return (call f2 (x 3 4)))}})) -
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad1b.rkt b/Semestr 2/racket/egzamin/zad1b.rkt deleted file mode 100644 index 628619f..0000000 --- a/Semestr 2/racket/egzamin/zad1b.rkt +++ /dev/null @@ -1,482 +0,0 @@ -#lang racket - - - -;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem -;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu, -;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania. -;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich -;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem -;; i nie udostępniałem nikomu swojego rozwiązania. - -;; ZADANIE 1 -;; ========= - -;; W tym zadaniu rozważamy język WHILE (w formie z grubsza -;; odpowiadającej tej z wykładu), z blokami deklarującymi zmienne o -;; lokalnym zakresie. - -;; Zadanie polega na dodaniu do języka procedur definiowanych na -;; zewnątrz głównego polecenia programu (podobnie jak w C, gdzie -;; główne polecenie odpowiadałoby procedurze main, czy Pascalu) — o -;; dowolnym wybranym przez siebie modelu działania. W tym celu należy: -;; · rozszerzyć składnię abstrakcyjną o składnię procedur i rozbudować odpowiednio składnię programów -;; · rozszerzyć procedurę parsowania -;; · rozszerzyć ewaluator -;; · *opisać* wybrany model działania procedur, w tym jego potencjalne zalety lub ograniczenia -;; Należy rozszerzyć poniższy szablon, a część słowną zadania umieścić -;; w komentarzu, podobnie jak niniejsze polecenie. - -;; Uwaga! Zadanie jest *bardzo* szeroko sformułowane, jest wiele -;; sensownych rozwiązań które stosowały liczne języki imperatywne w -;; historii — nie jest treścią zadania znalezienie *najlepszego*, -;; tylko swojego, które *rozumiecie*. Wybrany model działania procedur -;; *może* być relatywnie ubogi, jednak jeśli tak się zrobi, warto -;; pokazać że ma się tego świadomość w słownym opisie jego działania. - - - - - - - -;; Postanowiłem, że struktura programów w moim języku będzie miała trochę z pythona i trochę z C. -;; Istotną decyzją którą podjąłem jest to, że wszystkie funkcje w naszym języku muszą zwracać -;; jakąś wartość (zawsze zwracają inta), łącznie z funkcją main, przy pomocy dyrektywy "return". -;; To, co zwraca main, jest tym co zwraca -;; cały program (z małym wyjątkiem, ale o tym później). Okazało się, że takie podejście -;; do sprawy jest bardzo wygodne -- nie musiałem się dzięki temu nawet przejmować -;; osobnym implementowaniem funkcji rekurencyjnych, wzajemnie rekurencyjnych -;; czy nawet zagnieżdżonych, a do tego można definiować funkcje w dowolnej kolejności! -;; Co więcej, funkcje przyjmują dowolnie wiele argumentów, również 0. -;; On top of that, do funkcji można przekazywać cokolwiek co ewaluuje się do wartości -;; Czyli mozna przekazywać wartości zmiennych, jak i dowolne wyrażenia! - -;; Oto przykładowy kod, po którym raczej jasno widać w jak wygląda nowa składnia: -(define BINOM '({func main () - (return (call binom (N K)))} - {func fact (t) - (if (= t 0) - (return 1) - ({func decr (x) (return (- x 1))} - (return (* t (call fact ((call decr (t))))))))} - {func binom (n k) - (if (= k 0) - (return 1) - (var (num (call fact (n))) - (var (den (* (call fact (k)) (call fact ((- n k))))) - (return (/ num den)))))} - )) -(define (bin n k) - (eval-prog (parse-cmd BINOM) (mem-alloc 'i 1 (mem-alloc 'N n (mem-alloc 'K k empty-mem))))) -;; Specjalnie trochę pokomplikowałem, ale widać featury naszego języka. - -;; Jak to w ogóle działa? - -;; Za każdym razem, kiedy definiuję funkcję, to do środowiska dodaję parę (nazwa funkcji . clo), -;; gdzie clo jest takim quasi-domknięciem, jest to po prostu struktura trzymająca nazwy -;; argumentów funkcji oraz jej ciało. Właśnie takie podejście bardzo dobrze -;; załatwiło łatwość w definiowaniu funkcji rekurencyjnych oraz wzajemnie rekurencyjnych i -;; zagnieżdżonych -- żadna funkcja nie zostanie wywołana, dopóki nie wywołam maina, -;; a tego wywołam dopiero po zewaluowaniu wszystkich definicji (tym samym dodaniu ich do środowiska). - -;; Takie podejście ma trochę problemów, chyba największym z nich jest to, że nie ma możliwości -;; zmiany wartości globalnych wewnątrz funkcji. Tj. możemy je zmieniać, ale zmiany będą -;; widoczne jedynie w jej lokalnym zakresie. -;; W zasadzie nie jest to aż tak bolesne -- globalne zmienne możemy traktować po prostu -;; jak argumenty wywołania funkcji main. - -;; Wywoływać funkcję mogę tylko za pomocą specjalnego wyrażenia call, -;; które jako pierwszy argument -;; przyjmuje nazwę funkcji, a jako drugi przyjmuje listę argumentów. -;; Żeby wiedzieć jak działa call, spójrzmy najpierw jak działa return. - -;; return napisane jest tak, że jeśli w jakimkolwiek miejscu funkcji -;; się na niego trafi, to reszta funkcji nie jest już wywoływana -;; (czyli tak jakbyśmy sie spodziewali). Jak on w sumie działa? -;; Na samym początku eval-prog, zanim zacznę w ogóle ewaluować definicje funkcji, -;; dodaje do środowiska specjalną zmienną o nazwie RETURN o wartości #f. -;; Jeśli w funkcji gdziekolwiek wywołam returna, to -;; zmieniam wartość RETURN w środowisku na to, co chcę zwrócić. -;; W eval-cmd za każdym razem sprawdzam jaka jest wartość RETURN. -;; Jeśli jest to #f, to pracuje jakby nigdy nic, a jeśli jest to coś innego, -;; to po prostu zwracam aktualne środowisko. -;; Zatem funkcja zwraca środowisko, w którym zmienna RETURN -;; ustawiona jest na wynik jej obliczenia. - -;; Teraz już prosto widać, że jedyne co robi call, to szuka ciała funkcji -;; w środowisku i wywołuje ją dla podanych argumentów, dostaje od tej -;; funkcji środowisko, a następnie odzyskuje wartość RETURN w zwróconym -;; przez nią środowisku. Dzięki temu po wywołaniu funkcji -;; wewnątrz innej funkcji nie zmienią się wartości żadnych zmiennych (w tym globalnych). -;; Jest to dosyć podobne do pythona -- tam inty są immutable i nie można ich wysłać przez -;; referencję. Ale możemy to robić jeśli się uprzemy np. tak: -;; {func decr (x) -;; (return (- x 1))} -;; {func main () -;; {(i := (call decr (i))) -;; (return i)} -;; Uruchomienie takiego programu ze zmienną globalną i zwróci oczywiście i-1. - -;; Mały problem którego za bardzo nie umiem rozwiązać jest taki, że jeśli gdzieś poza -;; jakąkolwiek funkcją wywołam return, to wartość którą tam zwrócę będzie -;; wartością dla całego programu, bo zmienna RETURN w środowisku zmieni swoją wartość -;; na coś innego od #f i niestety main nawet się nie wykona (na samym wstępie stwierdzi, -;; że coś zostało już zwrócone). Widać to w TEST10. Generalnie co za tym idzie, -;; między definicjami funkcji mogą być jakieś instrukcje, które zostaną -;; wywołane razem z ewaluacją programu, zanim zostanie wywołany main. - -;; Dodatkowe informacje umieściłem w komentarzach w odpowiednich miejscach pliku. -;; Na dole umieściłem kilka testów które pokazują co jak działa. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (name) #:transparent) -(struct call-expr (name args) #:transparent) ;; wywołanie funkcji - -(define (operator? x) - (member x '(+ * - / > < = >= <=))) - -(define (keyword? x) - (member x '(skip while if := func func-rec call return))) ;; kilka nowych słów kluczowych - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(var-expr x) - (and (symbol? x) - (not (keyword? x)))] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [(call-expr n a) - (and (symbol? n) - (list? a) - (andmap expr? a))] - [_ false])) - -(struct skip () #:transparent) -(struct assign (id exp) #:transparent) -(struct if-cmd (exp ct cf) #:transparent) -(struct while (exp cmd) #:transparent) -(struct comp (left right) #:transparent) -(struct var-in (name expr cmd) #:transparent) -(struct function (name args cmd) #:transparent) ;; dodane funkcje, funkcje rekurencyjne oraz return -(struct funcrec (name args cmd) #:transparent) -(struct return-stat (exp) #:transparent) - -(define (cmd? c) - (match c - [(skip) true] - [(assign x e) (and (symbol? x) (expr? e))] - [(if-cmd e ct cf) (and (expr? e) (cmd? ct) (cmd? cf))] - [(while e c) (and (expr? e) (cmd? c))] - [(comp c1 c2) (and (cmd? c1) (cmd? c2))] - [(var-in x e c) (and (symbol? x) (expr? e) (cmd? c))] - [(function f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))] - [(funcrec f a c) (and (symbol? f) (list? a) (andmap symbol? a) (cmd? c))] - [(return-stat exp) (expr? exp)])) - -(define (prog? p) - (cmd? p)) - -(define (parse-expr p) - (cond - [(number? p) (const p)] - [(and (symbol? p) - (not (keyword? p))) - (var-expr p)] - [(and (list? p) - (= 3 (length p)) - (operator? (car p))) - (binop (first p) - (parse-expr (second p)) - (parse-expr (third p)))] - [(and (list? p) ; <------ wywołanie funkcji - (= (length p) 3) - (eq? (first p) 'call) - (symbol? (second p)) - (list? (third p))) - (call-expr (second p) (map parse-expr (third p)))] - [else false])) - -(define (parse-cmd q) - (cond - [(eq? q 'skip) (skip)] - [(and (list? q) - (= (length q) 3) - (eq? (second q) ':=)) - (assign (first q) (parse-expr (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-cmd (parse-expr (second q)) (parse-cmd (third q)) (parse-cmd (fourth q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'while)) - (while (parse-expr (second q)) (parse-cmd (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'var) - (list? (second q)) - (= (length (second q)) 2)) - (var-in (first (second q)) - (parse-expr (second (second q))) - (parse-cmd (third q)))] - [(and (list? q) ; <------ funkcje - (= (length q) 4) - (eq? (first q) 'func) - (symbol? (second q)) - (list? (third q)) - (andmap symbol? (third q))) - (function (second q) (third q) (parse-cmd (fourth q)))] - [(and (list? q) ; <------ return - (= (length q) 2) - (eq? (first q) 'return)) - (return-stat (parse-expr (second q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-comp (map parse-cmd q))] - [else false])) - -(define (desugar-comp cs) - (if (null? (cdr cs)) - (car cs) - (comp (car cs) - (desugar-comp (cdr cs))))) - -(define (value? v) - (number? v)) - -(struct mem (xs) #:transparent) - -(define (mem-lookup x m) - (define (assoc-lookup xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cdar xs)] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (mem-xs m))) - -(define (mem-update x v m) - (define (assoc-update xs) - (cond - [(null? xs) (error "Undefined variable" x)] - [(eq? x (caar xs)) (cons (cons x v) (cdr xs))] - [else (cons (car xs) (assoc-update (cdr xs)))])) - (mem (assoc-update (mem-xs m)))) - -(define (mem-alloc x v m) - (mem (cons (cons x v) (mem-xs m)))) - -(define (mem-drop-last m) - (cond - [(null? (mem-xs m)) - (error "Deallocating from empty memory")] - [else - (mem (cdr (mem-xs m)))])) - -(define empty-mem - (mem null)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /] - ['< (lambda (x y) (if (< x y) 1 0))] - ['> (lambda (x y) (if (> x y) 1 0))] - ['= (lambda (x y) (if (= x y) 1 0))] - ['<= (lambda (x y) (if (<= x y) 1 0))] - ['>= (lambda (x y) (if (>= x y) 1 0))] - )) - -;; zał: (expr? e) i (mem? m) jest prawdą -;; (value? (eval e m)) jest prawdą -(define (eval e m) - (match e - [(const v) v] - [(var-expr x) (mem-lookup x m)] - [(binop op l r) - (let ((vl (eval l m)) - (vr (eval r m)) - (p (op->proc op))) - (p vl vr))] - [(call-expr name args) ;; <------ ewaluacja wywołania funkcji - (match (mem-lookup name m) - [(clo func-args cmd) - (if (= (length args) (length func-args)) ;; <------ sprawdzanie arnosci - (let* ([func-mem (assign-values args func-args m)] - [final-mem (eval-cmd cmd func-mem)] - [ret (mem-lookup 'RETURN final-mem)]) - (if ret - ret - (error "No return statement in function" name))) - (error "Arity mismatch, function" name "takes" (length func-args) "arguments, got" (length args)))] - [else (error "Undefined function" name)])])) - -(define (assign-values args func-args mem) ;; <------ przypisanie wartosci do argumentow funkcji - (define (iter args func-args new-mem) - (if (null? args) - new-mem - (iter (cdr args) (cdr func-args) (mem-alloc (car func-args) (eval (car args) mem) new-mem)))) - (iter args func-args mem)) - - -(struct clo (args cmd)) ; <----- tak trzymana jest funkcja w środowisku, tj. jako lista nazw argumentow i cialo funkcji - -;; zał: (cmd? c) (mem? m) -;; (mem? (eval-cmd c m)) -(define (eval-cmd c m) - (if (mem-lookup 'RETURN m) ; <----- jeśli RETURN jest na coś ustawione, to chcemy zrwócic pamięc - m - (match c - [(skip) m] - [(assign x e) (mem-update x (eval e m) m)] - [(if-cmd e ct cf) (if (= (eval e m) 0) - (eval-cmd cf m) - (eval-cmd ct m))] - [(while e cw) (if (= (eval e m) 0) - m - (let* ((m1 (eval-cmd cw m)) - (m2 (eval-cmd c m1))) - m2))] - [(comp c1 c2) (let* ((m1 (eval-cmd c1 m)) - (m2 (eval-cmd c2 m1))) - m2)] - [(var-in x e c) (let* ((v (eval e m)) - (m1 (mem-alloc x v m)) - (m2 (eval-cmd c m1))) - (mem-drop-last m2))] - [(function name args cmd) ; <------ dodanie ciała funkcji do środowiska - (mem-alloc name (clo args cmd) m)] - [(return-stat val) ; <------ zmiana wartości zmiennej RETURN - (mem-update 'RETURN (eval val m) m)] - [_ (error "Unknown command" c "— likely a syntax error")]))) - - -;; program ewaluowany jest tak -;; ewaluowane są wszystkie definicje funkcji, wtedy -;; ręcznie szukam definicji main i ewaluuje jej ciało i zwracam to co zwróci main. -;; zakładam, że main nie przyjmuje żadnych argumentów. -(define (eval-prog p m) - (let ((final-mem (eval-cmd p (mem-alloc 'RETURN #f m)))) - (match (mem-lookup 'main final-mem) - [(clo args cmd) - (let ((res (mem-lookup 'RETURN (eval-cmd cmd final-mem)))) - (if res res (error "No return statement in main")))]))) - -(define WHILE_FACT - '({func decr (x) - {(x := (- x 1)) - (return x)}} - {func main () - {(i := 1) - (while (> t 0) - {(i := (* i t)) - (t := (call decr (t)))}) - (return i)}} - )) - -(define (fact n) - (let* ([init-env (mem-alloc 'i 1 (mem-alloc 't n empty-mem))]) - (eval-prog (parse-cmd WHILE_FACT) init-env))) - -(define TEST - '({func decr (x) (return (- x 1))} - {func main () - (var (x 1) - {(x := (+ x 2)) - (return (call decr (x)))})})) -(define (test) (eval-prog (parse-cmd TEST) empty-mem)) - -(define TEST2 - '({func decr (x) (return (- x 1))} - {func main () (return (call decr (3)))})) -(define (test2) (eval-prog (parse-cmd TEST2) empty-mem)) - -; nie da się zmienić wartości zmiennej globalnej, zmienne są wysyłane przez kopie -(define TEST3 - '({func sth (x) - {(i := -1) - (return x)}} - {func main () - {(i := 2) - (return (call sth (i)))}})) -(define (test3) (eval-prog (parse-cmd TEST3) (mem-alloc 'i 3 empty-mem))) - -; nie ma maina, wywala błąd -(define TEST4 - '(func f () - {return 1})) -(define (test4) (eval-prog (parse-cmd TEST4) empty-mem)) - -; funkcje wieloargumentowe -(define TEST5 - '({func f1 (x y z) - (return y)} - {func f2 (x y z) - (return (+ (+ x y) z))} - {func main () - {(if (> X 3) - (var (x 2) - (return (call f1 (1 x 3)))) - (x := 5)) - (return (call f2 (x 3 4)))}})) -(define (test5) (eval-prog (parse-cmd TEST5) (mem-alloc 'x -1 (mem-alloc 'X 4 empty-mem)))) - -; Działa rekurencja!! -(define TEST6 - '({func f (x) - (if (= x 0) - (return 1) - (return (* x (call f ((- x 1))))))} - {func main () - (return (call f (X)))})) -(define (test6) (eval-prog (parse-cmd TEST6) (mem-alloc 'X 5 empty-mem))) - -; kolejnośc deklaracji funkcji nie ma znaczenia, można zagnieżdżać funkcje -(define TEST7 - '( - {func main () - (return (call f (2)))} - {func f (x) - (return (call f1 (x)))} - {func f1 (x) - {{func local-fun (x) - (return (+ 1 x))} - (return (call local-fun (x)))}})) -(define (test7) (eval-prog (parse-cmd TEST7) empty-mem)) - -; instrukcje poza jakimikolwiek funkcjami sa wykonywane przed wywołaniem main -(define TEST8 - '({func main () - (return i)} - (i := 2))) -(define (test8) (eval-prog (parse-cmd TEST8) (mem-alloc 'i 1 empty-mem))) - -; nic nie zwraca main, wywala błąd -(define TEST9 - '(func main () - (i := 1))) -(define (test9) (eval-prog (parse-cmd TEST9) (mem-alloc 'i 1 empty-mem))) - -; return poza jakąkolwiek funkcją jest wynikiem programu -(define TEST10 - '({func main () - (return i)} - (i := 2) - (return -1))) -(define (test10) (eval-prog (parse-cmd TEST10) (mem-alloc 'i 1 empty-mem))) - - -; arity mismatch -(define TEST11 - '({func main () - (return (call decr ()))} - {func decr (x) - (return (- x 1))})) -(define (test11) (eval-prog (parse-cmd TEST11) empty-mem)) diff --git a/Semestr 2/racket/egzamin/zad2.bak b/Semestr 2/racket/egzamin/zad2.bak deleted file mode 100644 index 02e2ae0..0000000 --- a/Semestr 2/racket/egzamin/zad2.bak +++ /dev/null @@ -1,119 +0,0 @@ -#lang racket - -;; ZADANIE 2 -;; ========= - -;; W tym zadaniu przyjrzymy się pierwszemu "językowi programowania" -;; który widzieliśmy na zajęciach: wyrażeniom arytmetycznym. Ich -;; prostota przejawia się przede wszystkim tym że nie występują w nich -;; zmienne (a w szczególności ich wiązanie) — dlatego możemy o nich -;; wnioskować nie używając narzędzi cięższych niż te poznane na -;; wykładzie. - -;; W tym zadaniu będziemy chcieli udowodnić że nasza prosta kompilacja -;; do odwrotnej notacji polskiej jest poprawna. Konkretniej, należy -;; · sformułować zasady indukcji dla obydwu typów danych -;; reprezentujących wyrażenia (expr? i rpn-expr?) -;; · sformułować i udowodnić twierdzenie mówiące że kompilacja -;; zachowuje wartość programu, tj. że obliczenie wartości programu -;; jest równoważne skompilowaniu go do RPN i obliczeniu. -;; · sformułować i udowodnić twierdzenie mówiące że translacja z RPN -;; do wyrażeń arytmetycznych (ta która była zadaniem domowym; -;; implementacja jest poniżej) jest (prawą) odwrotnością translacji -;; do RPN (czyli że jak zaczniemy od wyrażenia i przetłumaczymy do -;; RPN i z powrotem, to dostaniemy to samo wyrażenie). -;; Swoje rozwiązanie należy wpisać na końcu tego szablonu w -;; komentarzu, podobnie do niniejszej treści zadania; proszę zadbać o -;; czytelność dowodów! - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (operator? x) - (member x '(+ * - /))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - - -(define (value? v) - (number? v)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /])) - -;; zał: (expr? e) jest prawdą -;; (value? (eval e)) jest prawdą -(define (eval e) - (match e - [(const v) v] - [(binop op l r) - (let ((vl (eval l)) - (vr (eval r)) - (p (op->proc op))) - (p vl vr))])) - -(define (rpn-expr? e) - (and (list? e) - (pair? e) - (andmap (lambda (x) (or (number? x) (operator? x))) e))) - - -(struct stack (xs)) - -(define empty-stack (stack null)) -(define (empty-stack? s) (null? (stack-xs s))) -(define (top s) (car (stack-xs s))) -(define (push a s) (stack (cons a (stack-xs s)))) -(define (pop s) (stack (cdr (stack-xs s)))) - - -(define (eval-am e s) - (cond - [(null? e) (top s)] - [(number? (car e)) (eval-am (cdr e) (push (car e) s))] - [(operator? (car e)) - (let* ((vr (top s)) - (s (pop s)) - (vl (top s)) - (s (pop s)) - (v ((op->proc (car e)) vl vr))) - (eval-am (cdr e) (push v s)))])) - -(define (rpn-eval e) - (eval-am e empty-stack)) - -(define (arith->rpn e) - (match e - [(const v) (list v)] - [(binop op l r) (append (arith->rpn l) (arith->rpn r) (list op))])) - -(define (rpn-translate e s) - (cond - [(null? e) - (top s)] - - [(number? (car e)) - (rpn-translate (cdr e) (push (const (car e)) s))] - - [(operator? (car e)) - (let* ((er (top s)) - (s (pop s)) - (el (top s)) - (s (pop s)) - (en (binop (car e) el er))) - (rpn-translate (cdr e) (push en s)))])) - -(define (rpn->arith e) - (rpn-translate e empty-stack))
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad2.rkt b/Semestr 2/racket/egzamin/zad2.rkt deleted file mode 100644 index e549f07..0000000 --- a/Semestr 2/racket/egzamin/zad2.rkt +++ /dev/null @@ -1,186 +0,0 @@ -#lang racket - -;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem -;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu, -;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania. -;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich -;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem -;; i nie udostępniałem nikomu swojego rozwiązania. - -;; ZADANIE 2 -;; ========= - -;; W tym zadaniu przyjrzymy się pierwszemu "językowi programowania" -;; który widzieliśmy na zajęciach: wyrażeniom arytmetycznym. Ich -;; prostota przejawia się przede wszystkim tym że nie występują w nich -;; zmienne (a w szczególności ich wiązanie) — dlatego możemy o nich -;; wnioskować nie używając narzędzi cięższych niż te poznane na -;; wykładzie. - -;; W tym zadaniu będziemy chcieli udowodnić że nasza prosta kompilacja -;; do odwrotnej notacji polskiej jest poprawna. Konkretniej, należy -;; · sformułować zasady indukcji dla obydwu typów danych -;; reprezentujących wyrażenia (expr? i rpn-expr?) -;; · sformułować i udowodnić twierdzenie mówiące że kompilacja -;; zachowuje wartość programu, tj. że obliczenie wartości programu -;; jest równoważne skompilowaniu go do RPN i obliczeniu. -;; · sformułować i udowodnić twierdzenie mówiące że translacja z RPN -;; do wyrażeń arytmetycznych (ta która była zadaniem domowym; -;; implementacja jest poniżej) jest (prawą) odwrotnością translacji -;; do RPN (czyli że jak zaczniemy od wyrażenia i przetłumaczymy do -;; RPN i z powrotem, to dostaniemy to samo wyrażenie). -;; Swoje rozwiązanie należy wpisać na końcu tego szablonu w -;; komentarzu, podobnie do niniejszej treści zadania; proszę zadbać o -;; czytelność dowodów! - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (operator? x) - (member x '(+ * - /))) - -(define (expr? e) - (match e - [(const v) - (integer? v)] - [(binop op l r) - (and (operator? op) - (expr? l) - (expr? r))] - [_ false])) - - -(define (value? v) - (number? v)) - -(define (op->proc op) - (match op - ['+ +] - ['- -] - ['* *] - ['/ /])) - -;; zał: (expr? e) jest prawdą -;; (value? (eval e)) jest prawdą -(define (eval e) - (match e - [(const v) v] - [(binop op l r) - (let ((vl (eval l)) - (vr (eval r)) - (p (op->proc op))) - (p vl vr))])) - -(define (rpn-expr? e) - (and (list? e) - (pair? e) - (andmap (lambda (x) (or (number? x) (operator? x))) e))) - -;; mój kod -(define (parse-expr q) - (cond - [(integer? q) (const q)] - [(and (list? q) (= (length q) 3) (operator? (first q))) - (binop (first q) (parse-expr (second q)) (parse-expr (third q)))])) - -(struct stack (xs)) - -(define empty-stack (stack null)) -(define (empty-stack? s) (null? (stack-xs s))) -(define (top s) (car (stack-xs s))) -(define (push a s) (stack (cons a (stack-xs s)))) -(define (pop s) (stack (cdr (stack-xs s)))) - - -(define (eval-am e s) - (cond - [(null? e) (top s)] - [(number? (car e)) (eval-am (cdr e) (push (car e) s))] - [(operator? (car e)) - (let* ((vr (top s)) - (s (pop s)) - (vl (top s)) - (s (pop s)) - (v ((op->proc (car e)) vl vr))) - (eval-am (cdr e) (push v s)))])) - -(define (rpn-eval e) - (eval-am e empty-stack)) - -(define (arith->rpn e) - (match e - [(const v) (list v)] - [(binop op l r) (append (arith->rpn l) (arith->rpn r) (list op))])) - -(define (rpn-translate e s) - (cond - [(null? e) - (top s)] - - [(number? (car e)) - (rpn-translate (cdr e) (push (const (car e)) s))] - - [(operator? (car e)) - (let* ((er (top s)) - (s (pop s)) - (el (top s)) - (s (pop s)) - (en (binop (car e) el er))) - (rpn-translate (cdr e) (push en s)))])) - -(define (rpn->arith e) - (rpn-translate e empty-stack)) - - -;; W kilku miejscach pozwoliłem sobie zapomnieć że symbol operatora i operator -;; to nie to samo, ale nie ma to znaczenia w kontekście dowodów. -;; Przez ES oznaczam empty-stack -;; -;; Zasada indukcji dla expr: -;; Dla dowolnej własności P, jeśli -;; · zachodzi P((const x)) dla dowolnego x oraz -;; · dla dowolnych e1, e2 oraz operator op jeśli zachodzi P(e1), P(e2) -;; to zachodzi P((binop op e1 e2)) -;; to dla dowolnego e, jeśli zachodzi (expr? e) to zachodzi P(e) -;; -;; Zasada indukcji dla rpn (ale tego wg rpn-expr?): -;; Dla dowolnej własności P, jeśli -;; · zachodzi P(x) dla dowolnej liczby lub opeartora x oraz -;; · dla dowolnej listy liczb lub operatorów xs oraz dowolnej liczby lub -;; operatora x, jesli zachodzi P(xs), to zachodzi P((cons x xs)) -;; to dla dowolnej listy xs liczb lub operatorów zachodzi P(xs) -;; -;; -;; Tw. 1: Jeśli spełnione jest (expr? e), to (eval e) ≡ (rpn-eval (arith->rpn e)) -;; -;; D-d. Skorzystamy z zasady indukcji dla wyrażeń. -;; · Weźmy dowolną liczbę x. Wtedy jeśli e ≡ (const x), to zachodzi -;; (eval (const x)) ≡ x ≡ (rpn-eval '(x)) ≡ (rpn-eval (arith->rpn (const x))) -;; · Weźmy dowolne e1, e2 spełniające naszą tezę oraz jakiś operator op. Wtedy -;; (eval (binop op e1 e2)) ≡ -;; (op (eval e1) (eval e2)) ≡ [Z definicji eval-am] -;; (eval-am '() (push (op (eval e1) (eval e2)) ES)) ≡ -;; (eval-am '(op) (push (eval e2) (push (eval e1) ES))) ≡ [Z założenia indukcyjnego] -;; (eval-am '(op) (push (rpn-eval (arith->rpn e2)) (push (eval e1) ES))) ≡ -;; (eval-am (append (arith->rpn e2) '(op)) (push (eval e1) ES)) ≡ [Z założenia indukcyjnego] -;; (eval-am (append (arith->rpn e1) (arith->rpn e2) '(op)) ES) ≡ -;; (rpn-eval (append (arith->rpn e1) (arith->rpn e2) '(op))) ≡ [Z definicji arith->rpn] -;; (rpn-eval (arith->rpn (binop op e1 e2))) -;; Pokazaliśmy oba warunki indukcji dla wyrażeń, zatem twierdzenie prawdziwe jest -;; dla dowolnego wyrażenia e spełniającego (expr? e). -;; -;; Tw. 2: Jeśli spełnione jest (expr? e), to (rpn->arith (arith->rpn e)) ≡ e -;; -;; D-d. Skoryzstamy z indukcji dla wyrażeń. -;; · Weźmy dowolną liczbę x. Wtedy dla e ≡ (const x) zachodzi -;; (rpn->arith (arith->rpn e)) ≡ (rpn->arith '(x)) ≡ (const x) -;; · Weźmy dowolne e1, e2 dla których twierdzenie zachodzi oraz operator op. Wtedy -;; (rpn->arith (arith->rpn (binop op e1 e2))) ≡ [Z definicji arith->rpn] -;; (rpn->arith (append (arith->rpn e1) (arith->rpn e2) '(op))) ≡ -;; (rpn-translate (append (arith->rpn e1) (arith->rpn e2) '(op)) ES) ≡ [Z zał. (arith->rpn e1) ewaluuje się do liczby] -;; (rpn-translate (append (arith->rpn e2) '(op)) (push e1 ES)) ≡ [Z zał. (arith->rpn e2) ewaluuje się do liczby] -;; (rpn-translate '(op) (push e2 (push e1 ES))) ≡ [Z definicji rpn-translate] -;; (rpn-translate '() (push (binop op e1 e2) ES)) ≡ -;; (binop op e1 e2) -;; Pokazaliśmy oba warunki indukcji dla wyrażeń, zatem twierdzenie jest prawdziwe -;; dla dowolnego e spełniającego (expr? e). diff --git a/Semestr 2/racket/egzamin/zad3.bak b/Semestr 2/racket/egzamin/zad3.bak deleted file mode 100644 index 20115e9..0000000 --- a/Semestr 2/racket/egzamin/zad3.bak +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket - - - diff --git a/Semestr 2/racket/egzamin/zad3.rkt b/Semestr 2/racket/egzamin/zad3.rkt deleted file mode 100644 index 9bfed02..0000000 --- a/Semestr 2/racket/egzamin/zad3.rkt +++ /dev/null @@ -1,347 +0,0 @@ -#lang racket - -;; Oświadczam, że rozwiązanie zadania egzaminacyjnego przygotowałem -;; w pełni samodzielnie, korzystając wyłącznie z materiałów do wykładu, -;; notatek, podręcznika, oraz materiałów zacytowanych w treści rozwiązania. -;; Oświadczam że nie korzystałem w żadnej formie z pomocy osób trzecich -;; w przygotowaniu rozwiązania ani też takiej pomocy nie udzielałem -;; i nie udostępniałem nikomu swojego rozwiązania. - -;; ZADANIE 3 -;; ========= - -;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do -;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych -;; programów. - -;; Przypomnijmy, że gramatyka bezkontekstowa składa się z -;; · skończonego zbioru *symboli nieterminalnych* -;; · skończonego zbioru *symboli terminalnych* -;; · wybranego nieterminalnego symbolu startowego -;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista -;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych - -;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki, -;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego -;; możemy użyć skończonej liczby produkcji z gramatyki przepisując -;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej -;; produkcji). - - -;; Przykład: poprawne nawiasowania - -;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który -;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych -;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane -;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!): -;; S -> -;; S -> SS -;; S -> (S) - -;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę -;; gramatykę zapisać tak (dbając trochę bardziej o wizualne -;; oddzielenie symboli terminalnych i nieterminalnych): -;; S ::= "" | SS | "(" S ")" -;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z -;; powtarzających się lewych stron. - -;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione -;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów) -;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu -;; startowego i przepisujemy: -;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()()) - - -;; Zadanie cz. 1 - -;; Zdefiniuj reprezentację gramatyki jako typu danych w -;; Rackecie. Warto zastanowić się co można uprościć względem definicji -;; matematycznej — w szczególności możemy założyć że dowolne napisy -;; (typu string) są ciągami symboli terminalnych, i że nie musimy -;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji -;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest -;; najwygodniejsza. - -;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i -;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc -;; sensownie przetestować swoje rozwiązanie! - - -;; "Optymalizacja" gramatyk - -;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć -;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli -;; nieterminalnych, których nie da się wyprowadzić z symbolu -;; startowego, lub symboli nieterminalnych z których nie da się -;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego -;; symboli nieterminalnych). Przykładowo, do naszej gramatyki -;; moglibyśmy dodać symbole P i Q, i produkcje: -;; S -> ")(" P -;; P -> PP "qed" -;; Q -> "abc" - -;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak -;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu -;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z -;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa, -;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego -;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy -;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które -;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i -;; te, z których nie da się ułożyć słowa terminalnego (tj. są -;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy -;; takie symbole, dostaniemy oczywiście gramatykę początkową. - - -;; Zadanie cz. 2 - -;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania -;; napisz dwie procedury: cfg-unreachable, znajdującą symbole -;; nieterminalne które są nieosiągalne z symbolu startowego, i -;; cfg-unproductive, znajdującą symbole nieterminalne które nie są -;; produktywne. Następnie użyj tych procedur żeby zdefiniować -;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z -;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie -;; produkcje. - -;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem -;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu -;; decyzje), a także zaimplementowane w cz. 2. algorytmy. - - - - - - -;; Zadanie 1 - -;; Reprezentacja jest docyś prosta, mianowicie stworzyłem struktury -;; terminal, non-terminal, rule oraz grammar. Dwa pierwsze to -;; po prostu jednoelementowe struktury utrzymujące nazwę symboli. -;; grammar to dwuelementowa struktura, jej pierwszym elementem -;; jest symbol startowy, a następnym produkcja, czyli lista reguł (listof rule), -;; a reguły to dwuelementowe struktury (symbol niterminalny - lista nonterminali lub termianli). -;; Generalnie dzięki temu, że mam te struktury terminal oraz non-terminal -;; to symbol nieterminalne i temrinalne mogą być czykolwiek. Dodatkowo -;; dla uproszczenia w miejscach, gdzie mam pewność że chodzi mi o -;; symbol nieterminalny, to nie opakowuję go w strukturę. -;; Przykładowo rules w gramatyce może wyglądać tak: -;; (list -;; (rule 'S (list (terminal ""))) -;; (rule 'S (list (non-terminal 'S) (non-terminal 'S))) -;; (rule 'S (list (terminal "(") (non-terminal 'S) (terminal ")")))) -;; Oczywiście symbol nieterminalny nie musi być racketowym symbolem, może być czymkolwiek. -;; Podobnie z symbolami terminalnymi. Proszę również zauważyć, że dzięki -;; strukturom non-terminal oraz terminal te same racketowe obiekty mogą być jednocześnie -;; terminalami oraz nieterminalami! -;; W tych parach na pierwszym miejscu nie jest non-terminal, tylko po prostu cokolwiek -;; no i oczywiście mam wtedy pewność że musi być to non-terminal, nie ma potrzeby -;; żeby pakować go również w tę strukturę. - - -;; Postanowiłem napisać parser (make-cfg q), generuje on gramatyki w bardzo konkretny sposób, -;; trochę ograniczo to czym mogą być symbole nieterminalne oraz terminalne, -;; ale nie wydaje mi się że i tak składnia jest bardzo wygodna i mało ograniczająca. - -;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu -;; przedstawionego w treści zadania. -;; np. gramatyka nawiasowania będzie wyglądać następująco: -;; '(grammar S (S ::= "" -- SS -- "(" S ")")) -;; ale mogłaby wyglądać też tak: -;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")")) -;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania: -;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc")) -;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar -;; na drugim miejscu ma symbol startowy -;; następnie następuje lista produkcji w formacie: -;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem --> -;; Zalety: -;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych -;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak -;; jak terminalne, tj. "S" nie jest tym samym co 'S. -;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać -;; dodatkowe reguły dla jakiegoś nieterminala, -;; - parser jest całkiem łatwy w implementacji -;; Wady: -;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich -;; zbyt wiele. Jest tak dlatego, że np. tutaj (S ::= SS) nie chodzi mi o symbol SS, tylko -;; o sąsiadujące symbole SS (jednak gdyby nie używać parsera to normalnie moglibyśmy -;; mieć wieloznakowe symbole nieterminalne!). - -;; Dla przykładu taka gramatyka: -;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]")) -;; będzie reprezentowana następująco: -;; (grammar -;; 'S -;; (list -;; (rule 'S (list (terminal ""))) -;; (rule 'S (list (non-terminal 'S) (non-terminal 'S))) -;; (rule 'S (list (terminal "(") (non-terminal 'S) (terminal ")"))) -;; (rule 'S (list (non-terminal 'Q))) -;; (rule 'Q (list (terminal ""))) -;; (rule 'Q (list (non-terminal 'Q) (non-terminal 'S))) -;; (rule 'Q (list (terminal "[") (non-terminal 'Q) (terminal "]"))))) - -;; Cała reprezentacja :D -(struct non-terminal (sym) #:transparent) -(struct terminal (sym) #:transparent) -(struct rule (nt xs) #:transparent) -(struct grammar (start rules) #:transparent) - - -;; PARSER -(define SEPARATOR '--) - -(define (split-at-symb symb xs) - (define (iter left right) - (cond - [(null? right) (cons left null)] - [(eq? symb (car right)) (cons left (cdr right))] - [else (iter (cons (car right) left) (cdr right))])) - (let ([res (iter null xs)]) - (cons (reverse (car res)) (cdr res)))) - -(define (split-by-separator xs) - (let ([res (split-at-symb SEPARATOR xs)]) - (if (null? (cdr res)) - res - (cons (car res) (split-by-separator (cdr res)))))) - -;; PARSER SKŁADNI KONKRETNEJ DO JEJ REPREZENTACJI -(define (make-cfg q) - (cond - [(and (list? q) (eq? 'grammar (first q))) - (grammar (second q) (append-map make-cfg (cddr q)))] - [(and (list? q) (eq? '::= (second q))) - (let ([nt (first q)] - [rules (split-by-separator (cddr q))]) - (map (lambda (x) (rule nt x)) (map make-prod rules)))])) - -(define (symbol->list s) - (map string->symbol - (map string - (string->list (symbol->string s))))) - -(define (make-prod xs) - (cond - [(null? xs) null] - [(string? (car xs)) (cons (terminal (car xs)) (make-prod (cdr xs)))] - [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-prod (cdr xs)))] - [else (error "Invalid syntax in production" xs)])) - - -(define sample '(S ::= "" -- SS -- "(" S ")")) -(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]"))) -(define sample3 '(grammar S - (S ::= A B -- D E) - (A ::= "a") - (B ::= "b" C) - (C ::= "c") - (D ::= "d" F) - (E ::= "e") - (F ::= "f" D))) - -(define (sample-grammar) (make-cfg sample3)) - -;; zadanie 2 - -;; korzystam z algorytmów przedstawionych w tej książce: -;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51 -;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive -;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne -;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza, -;; a jest bardzo nieistotną zmianą koncepcyjną. -;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable - -;; cfg-productive działa w ten sposób: -;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę -;; Jakąś regułę nazywamy produktywną, jeśli składa się z terminali lub produktywnych nieterminali -;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne -;; wg definicji zadania, a cała reszta jest produktwna. - -;; Algorytm znajdowania produktywnych nieterminali: -;; Mamy listę produktywnych nieterminali P, początkowo pustą -;; 1. Stwórz nową listę P' -;; 2. Przejdź po liście reguł -;; -> jeśli dana reguła jest produktywna (wg P), dodaj jej nieterminal do P' -;; 3. Jeśli P != P', zrób P := P' i wróć do 1. -;; 4. Zwróć P - -;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego -;; używamy w jakiejś regule, ale ten nieterminal nie ma zdefiniowanej żadnej reguły, -;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne. - -;; Algorytm znajdowania osiągalnych nieterminali: -;; Traktujemy nitereminale jak wierzchołki w grafie a reguły jako listy sąsiedztwa. -;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminala -;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne. - -;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale, -;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna. -;; Wydaje się to w miarę sensowne -- pierszy algorytm to takie odcinanie liści i odcyklanie -;; grafu, a ten drugi to po prostu DFS. - -;; przydatne predykaty -- na productive-nt mam listę symboli niterminalnych -;; (nie struktury non-terminal, tylko te symbole!) -;; które wiem że są produktywne. -;; productive? sprawdza, czy nietermial jest produktywny -;; to drugie sprawdza czy reguła jest produktywna -;; (czyli czy składa się z produktywnych nonterminali lub terminali) -(define (productive? p productive-nt) - (or (terminal? p) (member (non-terminal-sym p) productive-nt))) -(define (rule-productive? r productive-nt) - (andmap (lambda (x) (productive? x productive-nt)) r)) - -;; zwraca listę produktywnych symboli (nie nonterminali!) -(define (cfg-productive g) - (define (find-productive-nt productive-nt rules) - (cond - [(null? rules) (remove-duplicates productive-nt)] - [(rule-productive? (rule-xs (car rules)) productive-nt) - (find-productive-nt (cons (rule-nt (car rules)) productive-nt) (cdr rules))] - [else (find-productive-nt productive-nt (cdr rules))])) - (define (iter productive-nt) - (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))]) - (if (equal? productive-nt new-prod-nt) - productive-nt - (iter new-prod-nt)))) - (iter null)) - -;; zwraca listę osiągalnych symboli -(define (cfg-reachable g) - (define (iter verts vis) - (cond - [(null? verts) vis] - [(member (car verts) vis) (iter (cdr verts) vis)] - [else (iter (cdr verts) (dfs (car verts) vis))])) - (define (dfs v vis) - (let* ([rules (filter (lambda (r) (eq? (rule-nt r) v)) (grammar-rules g))] - [verts (append-map (lambda (r) (rule-xs r)) rules)] - [verts (filter non-terminal? verts)] - [verts (map non-terminal-sym verts)]) - (iter verts (cons v vis)))) - (dfs (grammar-start g) null)) - - -;; robi z gramatyki g gramatykę regularną -(define (cfg-optimize g) - (let* ([productive-nt (cfg-productive g)] - [productive-rules (filter (lambda (r) - (rule-productive? (rule-xs r) productive-nt)) - (grammar-rules g))] - [new-g (grammar (grammar-start g) productive-rules)] ; <----- nowa gramatyka, bez nieproduktywnych - [reachable-nt (cfg-reachable new-g)] ; reguł i symboli nieterminalnych - [res-g (grammar (grammar-start new-g) (filter ; <----- dobra gramatyka - (lambda (r) (member (rule-nt r) reachable-nt)) - (grammar-rules new-g)))]) - res-g)) - -(define (test) (cfg-optimize (make-cfg sample3))) - -;; Pokazanie że symbole nie muszą być racketowymi symbolami :) -(define (test2) (cfg-optimize - (grammar '() - (list (cons '() (list (terminal '()))) - (cons '() (list (terminal "(") (non-terminal '()) (terminal ")"))) - (cons '() (list (non-terminal '()) (non-terminal '()))))))) -
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad3a.bak b/Semestr 2/racket/egzamin/zad3a.bak deleted file mode 100644 index 81570d0..0000000 --- a/Semestr 2/racket/egzamin/zad3a.bak +++ /dev/null @@ -1,298 +0,0 @@ -#lang racket - -;; ZADANIE 3 -;; ========= - -;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do -;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych -;; programów. - -;; Przypomnijmy, że gramatyka bezkontekstowa składa się z -;; · skończonego zbioru *symboli nieterminalnych* -;; · skończonego zbioru *symboli terminalnych* -;; · wybranego nieterminalnego symbolu startowego -;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista -;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych - -;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki, -;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego -;; możemy użyć skończonej liczby produkcji z gramatyki przepisując -;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej -;; produkcji). - - -;; Przykład: poprawne nawiasowania - -;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który -;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych -;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane -;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!): -;; S -> -;; S -> SS -;; S -> (S) - -;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę -;; gramatykę zapisać tak (dbając trochę bardziej o wizualne -;; oddzielenie symboli terminalnych i nieterminalnych): -;; S ::= "" | SS | "(" S ")" -;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z -;; powtarzających się lewych stron. - -;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione -;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów) -;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu -;; startowego i przepisujemy: -;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()()) - - -;; Zadanie cz. 1 - -;; Zdefiniuj reprezentację gramatyki jako typu danych w -;; Rackecie. Warto zastanowić się co można uprościć względem definicji -;; matematycznej — w szczególności możemy założyć że dowolne napisy -;; (typu string) są ciągami symboli terminalnych, i że nie musimy -;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji -;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest -;; najwygodniejsza. - -;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i -;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc -;; sensownie przetestować swoje rozwiązanie! - - -;; "Optymalizacja" gramatyk - -;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć -;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli -;; nieterminalnych, których nie da się wyprowadzić z symbolu -;; startowego, lub symboli nieterminalnych z których nie da się -;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego -;; symboli nieterminalnych). Przykładowo, do naszej gramatyki -;; moglibyśmy dodać symbole P i Q, i produkcje: -;; S -> ")(" P -;; P -> PP "qed" -;; Q -> "abc" - -;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak -;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu -;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z -;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa, -;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego -;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy -;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które -;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i -;; te, z których nie da się ułożyć słowa terminalnego (tj. są -;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy -;; takie symbole, dostaniemy oczywiście gramatykę początkową. - - -;; Zadanie cz. 2 - -;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania -;; napisz dwie procedury: cfg-unreachable, znajdującą symbole -;; nieterminalne które są nieosiągalne z symbolu startowego, i -;; cfg-unproductive, znajdującą symbole nieterminalne które nie są -;; produktywne. Następnie użyj tych procedur żeby zdefiniować -;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z -;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie -;; produkcje. - -;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem -;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu -;; decyzje), a także zaimplementowane w cz. 2. algorytmy. - - - - - - -;; Zadanie 1 - -;; Postanowiłem napisać parser, bo bez tego zadanie wydaje mi się dosyć ubogie -;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu -;; przedstawionego w treści zadania. -;; np. gramatyka nawiasowania będzie wyglądać następująco: -;; '(grammar S (S ::= "" -- SS -- "(" S ")")) -;; ale mogłaby wyglądać też tak: -;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")")) -;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania: -;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc")) -;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar -;; na drugim miejscu ma symbol startowy -;; następnie następuje lista produkcji w formacie: -;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem --> -;; Zalety: -;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych -;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak -;; jak terminalne, tj. "S" nie jest tym samym co 'S. -;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać -;; dodatkowe produkcje dla jednego symbolu nieterminalnego, np. (S ::= "") (S ::= SS) -;; - parser jest łatwy w implementacji -;; Wady: -;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich -;; zbyt wiele - -;; Reprezentacja gramatyki: podczas parsowania gramatyki symbole i stringi wewnątrz produkcji -;; reprezentowane są przez struktury terminal oraz non-terminal. Cała gramatyka to -;; struktura dwuelementowa - pierwszym jest symbol startowy, a drugim lista par <symbol . produkcja> -;; Taka decyzja właśnie pozwoliła na to, że zaproponowana przeze mnie składania konkretna jest -;; bardzo prosta do sparsowania - wystarczy każdą produkcję podzielić ze względu na separator '-- -;; i do czegoś podobnego do środowisk dodawać po prostu odpowiednie pary. -;; dla przykładu taka gramatyka: -;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]")) -;; będzie reprezentowana następująco: -;; (grammar -;; 'S -;; (production -;; (list -;; (list 'S (terminal "")) -;; (list 'S (non-terminal 'S) (non-terminal 'S)) -;; (list 'S (terminal "(") (non-terminal 'S) (terminal ")")) -;; (list 'S (non-terminal 'Q)) -;; (list 'Q (terminal "")) -;; (list 'Q (non-terminal 'Q) (non-terminal 'S)) -;; (list 'Q (terminal "[") (non-terminal 'Q) (terminal "]"))))) -;; Prosze zauważyć, że np. SS zostało zamienione na dwa sąsiednie nieterminalne symbole S -;; (to właśnie powód, dlaczego symbole nieterminalne mogą być jedynie jednoznakowe). - -;; Zdecydowałem się dodać strukturę production, bo wtedy łatwo można na niej operować -;; pisząc funkcje production-add, czy production-lookup itp. - - -(struct non-terminal (sym) #:transparent) -(struct terminal (sym) #:transparent) -(struct grammar (start rules) #:transparent) - -(define SEPARATOR '--) - -(define (split-at-symb symb xs) - (define (iter left right) - (cond - [(null? right) (cons left null)] - [(eq? symb (car right)) (cons left (cdr right))] - [else (iter (cons (car right) left) (cdr right))])) - (let ([res (iter null xs)]) - (cons (reverse (car res)) (cdr res)))) - -(define (split-by-separator xs) - (let ([res (split-at-symb SEPARATOR xs)]) - (if (null? (cdr res)) - res - (cons (car res) (split-by-separator (cdr res)))))) - -(define (make-cfg q) - (cond - [(and (list? q) (eq? 'grammar (first q))) - (grammar (second q) (append-map make-cfg (cddr q)))] - [(and (list? q) (eq? '::= (second q))) - (let ([nt (first q)] - [rules (split-by-separator (cddr q))]) - (map (lambda (x) (cons nt x)) (map make-prod rules)))])) - -(define (symbol->list s) - (map string->symbol - (map string - (string->list (symbol->string s))))) - -(define (make-prod xs) - (cond - [(null? xs) null] - [(string? (car xs)) (cons (terminal (car xs)) (make-prod (cdr xs)))] - [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-prod (cdr xs)))] - [else (error "Invalid syntax in production" xs)])) - - -(define sample '(S ::= "" -- SS -- "(" S ")")) -(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]"))) -(define sample3 '(grammar S - (S ::= A B -- D E) - (A ::= "a") - (B ::= "b" C) - (C ::= "c") - (D ::= "d" F) - (E ::= "e") - (F ::= "f" D))) - -;; zadanie 2 - -;; korzystam z algorytmów przedstawionych w tej książce: -;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51 -;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive -;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne -;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza, -;; a jest bardzo nieistotną zmianą koncepcyjną. -;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable - -;; cfg-productive działa w ten sposób: -;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę -;; Jakąś zasadę nazywamy produktywną, jeśli składa się z terminali oraz produktywnych nieterminali -;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne -;; wg definicji zadania, a cała reszta jest produktwna. - -;; Algorytm znajdowania produktywnych nieterminali: -;; Mamy listę produktywnych nieterminali P, początkowo pustą -;; 1. Stwórz nową listę P' -;; 2. Przejdź po liście produkcji -;; -> jeśli dana produkcja jest produktywna (wg P), dodaj jej nieterminal do P' -;; 3. Jeśli P != P', zrób P := P' i wróć do 1. -;; 4. Zwróć P - -;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego -;; używamy w jakiejś produkcji, ale ten nieterminal nie ma zdefiniowanej swojej produkcji -;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne - -;; Algorytm znajdowania osiągalnych nieterminali: -;; Traktujemy nitereminale jak wierzchołki w grafie a zasady jako listy sąsiedztwa. -;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminalu -;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne. - -;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale, -;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna. - -(define (productive? p productive-nt) - (or (terminal? p) (member (non-terminal-sym p) productive-nt))) -(define (rule-productive? r productive-nt) - (andmap (lambda (x) (productive? x productive-nt)) r)) - -(define (cfg-productive g) - (define (find-productive-nt productive-nt rules) - (cond - [(null? rules) (remove-duplicates productive-nt)] - [(rule-productive? (cdar rules) productive-nt) - (find-productive-nt (cons (caar rules) productive-nt) (cdr rules))] - [else (find-productive-nt productive-nt (cdr rules))])) - (define (iter productive-nt) - (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))]) - (if (equal? productive-nt new-prod-nt) - productive-nt - (iter new-prod-nt)))) - (iter null)) - -(define (cfg-reachable g) - (define (iter verts vis) - (cond - [(null? verts) vis] - [(member (car verts) vis) (iter (cdr verts) vis)] - [else (iter (cdr verts) (dfs (car verts) vis))])) - (define (dfs v vis) - (display v) - (newline) - (let* ([rules (filter (lambda (r) (eq? (car r) v)) (grammar-rules g))] - [verts (append-map (lambda (r) (cdr r)) rules)] - [verts (filter non-terminal? verts)] - [verts (map non-terminal-sym verts)]) - (iter verts (cons v vis)))) - (dfs (grammar-start g) null)) - -(define (cfg-optimize g) - (let* ([productive-nt (cfg-productive g)] - [productive-rules (filter (lambda (r) - (rule-productive? (cdr r) productive-nt)) - (grammar-rules g))] - [new-g (grammar (grammar-start g) productive-rules)] - [reachable-nt (cfg-reachable new-g)] - [res-g (grammar (grammar-start new-g) (filter - (lambda (r) (member (car r) reachable-nt)) - (grammar-rules new-g)))]) - res-g)) -
\ No newline at end of file diff --git a/Semestr 2/racket/egzamin/zad3a.rkt b/Semestr 2/racket/egzamin/zad3a.rkt deleted file mode 100644 index eaa6645..0000000 --- a/Semestr 2/racket/egzamin/zad3a.rkt +++ /dev/null @@ -1,301 +0,0 @@ -#lang racket - -;; ZADANIE 3 -;; ========= - -;; Z gramatykami bezkontekstowymi spotkaliście się już na Wstępie do -;; Informatyki. W tym zadaniu potraktujemy je jako dane dla naszych -;; programów. - -;; Przypomnijmy, że gramatyka bezkontekstowa składa się z -;; · skończonego zbioru *symboli nieterminalnych* -;; · skończonego zbioru *symboli terminalnych* -;; · wybranego nieterminalnego symbolu startowego -;; · zbioru *produkcji*, czyli par symbol nieterminalny - lista -;; (potencjalnie pusta) symboli terminalnych lub nieterminalnych - -;; Słowo (ciąg symboli terminalnych) możemy wyprowadzić z gramatyki, -;; jeśli możemy zacząć od ciągu składającego się z symbolu startowego -;; możemy użyć skończonej liczby produkcji z gramatyki przepisując -;; symbol nieterminalny na ciąg symboli mu odpowiadających (w danej -;; produkcji). - - -;; Przykład: poprawne nawiasowania - -;; Gramatyka składa się z jednego symbolu nieterminalnego, S (który -;; jest oczywiście symbolem startowym) i dwóch symboli terminalnych -;; "(" i ")", i zawiera następujące produkcje (zwyczajowo zapisywane -;; przy użyciu strzałki; zwróćcie uwagę że pierwszy ciąg jest pusty!): -;; S -> -;; S -> SS -;; S -> (S) - -;; W często spotykanej, bardziej zwięzłej, postaci BNF moglibyśmy tę -;; gramatykę zapisać tak (dbając trochę bardziej o wizualne -;; oddzielenie symboli terminalnych i nieterminalnych): -;; S ::= "" | SS | "(" S ")" -;; Mamy tu te same produkcje, ale tylko raz zapisujemy każdą z -;; powtarzających się lewych stron. - -;; Z gramatyki tej da się wyprowadzić wszystkie poprawnie rozstawione -;; ciągi nawiasów — zobaczmy jak wyprowadzić (na jeden ze sposobów) -;; ciąg "(()())". Zaczynamy, jak zawsze, od słowa złożonego z symbolu -;; startowego i przepisujemy: -;; S -> (S) -> (SS) -> ((S)S) -> ((S)(S)) -> (()(S)) -> (()()) - - -;; Zadanie cz. 1 - -;; Zdefiniuj reprezentację gramatyki jako typu danych w -;; Rackecie. Warto zastanowić się co można uprościć względem definicji -;; matematycznej — w szczególności możemy założyć że dowolne napisy -;; (typu string) są ciągami symboli terminalnych, i że nie musimy -;; podawać jawnie zbioru nieterminali; również reprezentacja produkcji -;; gramatyki jako worka z parami wejście-wyjście niekoniecznie jest -;; najwygodniejsza. - -;; Uwaga: w tym zadaniu nie wymagamy definiowania składni konkretnej i -;; parsowania, ale bardzo polecamy wybranie jakiejś formy, żeby móc -;; sensownie przetestować swoje rozwiązanie! - - -;; "Optymalizacja" gramatyk - -;; Gramatyki, podobnie jak programy, piszą ludzie — może więc zdarzyć -;; się że znajdą się tam śmieci. Mogą one mieć dwojaką formę: symboli -;; nieterminalnych, których nie da się wyprowadzić z symbolu -;; startowego, lub symboli nieterminalnych z których nie da się -;; wyprowadzić żadnego słowa terminalnego (tj. niezawierającego -;; symboli nieterminalnych). Przykładowo, do naszej gramatyki -;; moglibyśmy dodać symbole P i Q, i produkcje: -;; S -> ")(" P -;; P -> PP "qed" -;; Q -> "abc" - -;; Mimo że nasza gramatyka wygląda inaczej na pierwszy rzut oka, tak -;; naprawdę się nie zmieniła: do symbolu Q nie możemy dojść z symbolu -;; S, a więc "abc" nigdy nie wystąpi w słowie wyprowadzalnym z -;; gramatyki. Analogicznie, z P nie da się wyprowadzić żadnego słowa, -;; które nie zawierałoby symbolu P — a zatem żadnego słowa złożonego -;; tylko z symboli terminalnych. To znaczy, że naszą gramatykę możemy -;; uprościć wyrzucając z niej symbole nieterminalne (i produkcje które -;; ich używają) do których nie da się dojść (tj. są *nieosiągalne*) i -;; te, z których nie da się ułożyć słowa terminalnego (tj. są -;; *nieproduktywne*). Jeśli z naszej rozszerzonej gramatyki wyrzucimy -;; takie symbole, dostaniemy oczywiście gramatykę początkową. - - -;; Zadanie cz. 2 - -;; Dla swojej reprezentacji gramatyki z poprzedniej części zadania -;; napisz dwie procedury: cfg-unreachable, znajdującą symbole -;; nieterminalne które są nieosiągalne z symbolu startowego, i -;; cfg-unproductive, znajdującą symbole nieterminalne które nie są -;; produktywne. Następnie użyj tych procedur żeby zdefiniować -;; procedurę cfg-optimize, która uprości daną gramatykę usuwając z -;; niej symbole nieosiągalne i nieproduktywne, a także odpowiednie -;; produkcje. - -;; Rozwiązanie wpisz w poniższym pliku, i opatrz komentarzem -;; opisującym wybraną reprezentację (i podjęte przy jej projektowaniu -;; decyzje), a także zaimplementowane w cz. 2. algorytmy. - - - - - - -;; Zadanie 1 - -;; Postanowiłem napisać parser, bo bez tego zadanie wydaje mi się dosyć ubogie -;; Składnia konkretna naszych gramatyk wygląda bardzo podobnie do zapisu -;; przedstawionego w treści zadania. -;; np. gramatyka nawiasowania będzie wyglądać następująco: -;; '(grammar S (S ::= "" -- SS -- "(" S ")")) -;; ale mogłaby wyglądać też tak: -;; '(grammar S (S ::= "") (S ::= SS -- "(" S ")")) -;; a np. ta nieciekawa gramatyka przedstawiona w treści zadania: -;; '(grammar S (S ::= "] [" P) (P ::= PP "qed") (Q ::= "abc")) -;; Zatem będzie to lista, która na pierwszym miejscu ma symbol 'grammar -;; na drugim miejscu ma symbol startowy -;; następnie następuje lista produkcji w formacie: -;; <non-terminal> ::= <lista produkcji, produkcje oddzielone są separatorem --> -;; Zalety: -;; - rozróżnienie w składni konkretnej symboli nieterminalnych i terminalnych -;; przez użycie symboli i stringów pozwala na to, aby symbole terminalne nazywały się tak -;; jak terminalne, tj. "S" nie jest tym samym co 'S. -;; - składnia wydaje się bardzo wygodna w użyciu, nie ma też problemu, żeby później dopisać -;; dodatkowe produkcje dla jednego symbolu nieterminalnego, np. (S ::= "") (S ::= SS) -;; - parser jest łatwy w implementacji -;; Wady: -;; - symbole nieterminalne mogą składać się jedynie z jednego symbolu, zatem nie możemy robić ich -;; zbyt wiele - -;; Reprezentacja gramatyki: podczas parsowania gramatyki symbole i stringi wewnątrz produkcji -;; reprezentowane są przez struktury terminal oraz non-terminal. Cała gramatyka to -;; struktura dwuelementowa - pierwszym jest symbol startowy, a drugim lista par <symbol . produkcja> -;; Taka decyzja właśnie pozwoliła na to, że zaproponowana przeze mnie składania konkretna jest -;; bardzo prosta do sparsowania - wystarczy każdą produkcję podzielić ze względu na separator '-- -;; i do czegoś podobnego do środowisk dodawać po prostu odpowiednie pary. -;; dla przykładu taka gramatyka: -;; '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QS -- "[" Q "]")) -;; będzie reprezentowana następująco: -;; (grammar -;; 'S -;; (production -;; (list -;; (list 'S (terminal "")) -;; (list 'S (non-terminal 'S) (non-terminal 'S)) -;; (list 'S (terminal "(") (non-terminal 'S) (terminal ")")) -;; (list 'S (non-terminal 'Q)) -;; (list 'Q (terminal "")) -;; (list 'Q (non-terminal 'Q) (non-terminal 'S)) -;; (list 'Q (terminal "[") (non-terminal 'Q) (terminal "]"))))) -;; Prosze zauważyć, że np. SS zostało zamienione na dwa sąsiednie nieterminalne symbole S -;; (to właśnie powód, dlaczego symbole nieterminalne mogą być jedynie jednoznakowe). - -;; Zdecydowałem się dodać strukturę production, bo wtedy łatwo można na niej operować -;; pisząc funkcje production-add, czy production-lookup itp. - - -(struct non-terminal (sym) #:transparent) -(struct terminal (sym) #:transparent) -(struct grammar (start rules) #:transparent) - -(define SEPARATOR '--) - -(define (make-cfg q) - (cond - [(and (list? q) (eq? 'grammar (first q))) - (grammar (second q) (append-map make-cfg (cddr q)))] - [(and (list? q) (eq? '::= (second q))) - (let ([nt (first q)] - [rules (split-by-separator (cddr q))]) - (map (lambda (x) (cons nt x)) (map make-rules rules)))] - [else (error "MAKE-CFG -- Parse error, unknown token" q)])) - -(define (make-cfg start rules) - (grammar start (make-rules rules))) - -(define (make-rules xs) - (cond - [(null? xs) null] - [(string? (car xs)) (cons (terminal (car xs)) (make-rules (cdr xs)))] - [(symbol? (car xs)) (append (map non-terminal (symbol->list (car xs))) (make-rules (cdr xs)))] - [else (error "Invalid syntax in production" xs)])) - -(define (split-at-symb symb xs) - (define (iter left right) - (cond - [(null? right) (cons left null)] - [(eq? symb (car right)) (cons left (cdr right))] - [else (iter (cons (car right) left) (cdr right))])) - (let ([res (iter null xs)]) - (cons (reverse (car res)) (cdr res)))) - -(define (split-by-separator xs) - (let ([res (split-at-symb SEPARATOR xs)]) - (if (null? (cdr res)) - res - (cons (car res) (split-by-separator (cdr res)))))) - -(define (symbol->list s) - (map string->symbol - (map string - (string->list (symbol->string s))))) - -(define sample '(S ::= "" -- SS -- "(" S ")")) -(define sample2 '(grammar S (S ::= "" -- SS -- "(" S ")" -- Q) (Q ::= "" -- QQ -- "[" Q "]"))) -(define sample3 '(grammar S - (S ::= A B -- D E) - (A ::= "a") - (B ::= "b" C) - (C ::= "c") - (D ::= "d" F) - (E ::= "e") - (F ::= "f" D))) - -;; zadanie 2 - -;; korzystam z algorytmów przedstawionych w tej książce: -;; https://bit.ly/3ev0NUA, konkretnie te ze stron 50-51 -;; Pozwoliłem sobie trochę zmienić przeznaczenie funkcji cfg-unreachable oraz cfg-unproductive -;; Zamiast zwracać nieproduktywne nieterminale, zwracają właśnie produktywne -;; i analogicznie w tym drugim. Po prostu taka implementacja jest dla mnie wygodniejsza, -;; a jest bardzo nieistotną zmianą koncepcyjną. -;; Stąd zmiana nazwy na cfg-productive oraz cfg-reachable - -;; cfg-productive działa w ten sposób: -;; Jakiś nieterminal nazywamy produktywnym, jeśli ma co najmniej jedną produktywną zasadę -;; Jakąś zasadę nazywamy produktywną, jeśli składa się z terminali oraz produktywnych nieterminali -;; Jasno widać, że wg tej definicji te nieterminale, które nie są produktywne, są nieproduktywne -;; wg definicji zadania, a cała reszta jest produktwna. - -;; Algorytm znajdowania produktywnych nieterminali: -;; Mamy listę produktywnych nieterminali P, początkowo pustą -;; 1. Stwórz nową listę P' -;; 2. Przejdź po liście produkcji -;; -> jeśli dana produkcja jest produktywna (wg P), dodaj jej nieterminal do P' -;; 3. Jeśli P != P', zrób P := P' i wróć do 1. -;; 4. Zwróć P - -;; Fajne w tym algorytmie jest to, że jeśli mamy jakiś nieterminal, którego -;; używamy w jakiejś produkcji, ale ten nieterminal nie ma zdefiniowanej swojej produkcji -;; to nie zostanie oznaczony jako produktywny, co jest dla nas korzystne - -;; Algorytm znajdowania osiągalnych nieterminali: -;; Traktujemy nitereminale jak wierzchołki w grafie a zasady jako listy sąsiedztwa. -;; Terminale są liśćmi, a nieterminale węzłami. Robimy po prostu DFSa z nieterminalu -;; startowego i węzły do których dotrzemy oznaczamy jako osiągalne. - -;; Wg papierka który tutaj podałem, jeśli najpierw usuniemy nieproduktywne nieterminale, -;; a w następnej kolejności nieosiągalne, to nasza gramatyka stanie się regularna. - -(define (productive? p productive-nt) - (or (terminal? p) (member (non-terminal-sym p) productive-nt))) -(define (rule-productive? r productive-nt) - (andmap (lambda (x) (productive? x productive-nt)) r)) - -(define (cfg-productive g) - (define (find-productive-nt productive-nt rules) - (cond - [(null? rules) (remove-duplicates productive-nt)] - [(rule-productive? (cdar rules) productive-nt) - (find-productive-nt (cons (caar rules) productive-nt) (cdr rules))] - [else (find-productive-nt productive-nt (cdr rules))])) - (define (iter productive-nt) - (let ([new-prod-nt (find-productive-nt productive-nt (grammar-rules g))]) - (if (equal? productive-nt new-prod-nt) - productive-nt - (iter new-prod-nt)))) - (iter null)) - -(define (cfg-reachable g) - (define (iter verts vis) - (cond - [(null? verts) vis] - [(member (car verts) vis) (iter (cdr verts) vis)] - [else (iter (cdr verts) (dfs (car verts) vis))])) - (define (dfs v vis) - (display v) - (newline) - (let* ([rules (filter (lambda (r) (eq? (car r) v)) (grammar-rules g))] - [verts (append-map (lambda (r) (cdr r)) rules)] - [verts (filter non-terminal? verts)] - [verts (map non-terminal-sym verts)]) - (iter verts (cons v vis)))) - (dfs (grammar-start g) null)) - -(define (cfg-optimize g) - (let* ([productive-nt (cfg-productive g)] - [productive-rules (filter (lambda (r) - (rule-productive? (cdr r) productive-nt)) - (grammar-rules g))] - [new-g (grammar (grammar-start g) productive-rules)] - [reachable-nt (cfg-reachable new-g)] - [res-g (grammar (grammar-start new-g) (filter - (lambda (r) (member (car r) reachable-nt)) - (grammar-rules new-g)))]) - res-g)) -
\ No newline at end of file diff --git a/Semestr 2/racket/l10z18/solution.bak b/Semestr 2/racket/l10z18/solution.bak deleted file mode 100644 index 02eb770..0000000 --- a/Semestr 2/racket/l10z18/solution.bak +++ /dev/null @@ -1,363 +0,0 @@ -#lang racket - -;; Składnia abstrakcyjna -(struct const (val) #:transparent) -(struct var-expr (name) #:transparent) -(struct let-expr (id bound body) #:transparent) -(struct letrec-expr (id bound body) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct lambda-expr (arg body) #:transparent) -(struct app-expr (fun arg) #:transparent) - -(define (keyword s) - (member s '(true false null and or if cond else lambda let letrec))) - -(define (expr? e) - (match e - [(const n) (or (number? n) - (boolean? n) - (null? n) - (string? n))] - [(var-expr id) (symbol? id)] - [(let-expr x e1 e2 ) (and (symbol? x) - (expr? e1) - (expr? e2))] - [(letrec-expr x e1 e2) (and (symbol? x) - (expr? e1) - (expr? e2))] - [(if-expr eb et ef) (and (expr? eb) - (expr? et) - (expr? ef))] - [(lambda-expr x e) (and (symbol? x) - (expr? e))] - [(app-expr ef ea) (and (expr? ef) - (expr? ea))] - [_ false])) - -;; Parsowanie (zacytowane wyrażenie -> składnia abstrakcyjna) -(define (parse q) - (cond - [(number? q) (const q)] - [(string? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (const null)] - [(and (symbol? q) - (not (keyword q))) - (var-expr q)] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'let) - (list? (second q)) - (= (length (second q)) 2) - (symbol? (first (second q)))) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'letrec) - (list? (second q)) - (= (length (second q)) 2) - (symbol? (first (second q)))) - (letrec-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) - (pair? q) - (eq? (first q) 'and)) - (desugar-and (map parse (cdr q)))] - [(and (list? q) - (pair? q) - (eq? (first q) 'or)) - (desugar-or (map parse (cdr q)))] - [(and (list? q) - (>= (length q) 2) - (eq? (first q) 'cond)) - (parse-cond (cdr q))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'lambda) - (list? (second q)) - (andmap symbol? (second q)) - (cons? (second q))) - (desugar-lambda (second q) (parse (third q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-app (parse (first q)) (map parse (cdr q)))] - [else (error "Unrecognized token:" q)])) - -(define (parse-cond qs) - (match qs - [(list (list 'else q)) - (parse q)] - - [(list (list q _)) - (error "Expected 'else' in last branch but found:" q)] - - [(cons (list qb qt) qs) - (if-expr (parse qb) (parse qt) (parse-cond qs))])) - -(define (desugar-and es) - (if (null? es) - (const true) - (if-expr (car es) (desugar-and (cdr es)) (const false)))) - -(define (desugar-or es) - (if (null? es) - (const false) - (if-expr (car es) (const true) (desugar-or (cdr es))))) - -(define (desugar-lambda xs e) - (if (null? xs) - e - (lambda-expr (car xs) (desugar-lambda (cdr xs) e)))) - -(define (desugar-app e es) - (if (null? es) - e - (desugar-app (app-expr e (car es)) (cdr es)))) - -;; Środowiska -(struct blackhole ()) -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (mcons x v) (environ-xs env)))) -(define (env-lookup x env) - (define (assoc-lookup xs) - (cond [(null? xs) - (error "Unknown identifier" x)] - [(eq? x (mcar (car xs))) - (let ((v (mcdr (car xs)))) - (if (blackhole? v) - (error "Jumped into blackhole at" x) - v))] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (environ-xs env))) -(define (env-update! x v env) - (define (assoc-update xs) - (cond [(null? xs) (error "Unknown identifier" x)] - [(eq? x (mcar (car xs))) - (set-mcdr! (car xs) v)] - [else (assoc-update (cdr xs))])) - (assoc-update (environ-xs env))) - -;; Domknięcia -(struct clo (arg body env)) - -;; Procedury wbudowane, gdzie -;; proc — Racketowa procedura którą należy uruchomić -;; args — lista dotychczas dostarczonych argumentów -;; pnum — liczba brakujących argumentów (> 0) -;; W ten sposób pozwalamy na częściową aplikację Racketowych procedur -;; — zauważmy że zawsze znamy pnum, bo w naszym języku arność -;; procedury jest ustalona z góry -(struct builtin (proc args pnum) #:transparent) - -;; Pomocnicze konstruktory procedur unarnych i binarnych -(define (builtin/1 p) - (builtin (lambda (x) (return (p x))) null 1)) -(define (builtin/2 p) - (builtin (lambda (x y) (return (p x y))) null 2)) - -;; Procedury -(define (proc? v) - (or (and (clo? v) - (symbol? (clo-arg v)) - (expr? (clo-body v)) - (environ? (clo-env v))) - (and (builtin? v) - (procedure? (builtin-proc v)) - (andmap value? (builtin-args v)) - (natural? (builtin-pnum v)) - (> (builtin-pnum v) 0)))) - -;; Definicja typu wartości -(define (value? v) - (or (number? v) - (boolean? v) - (null? v) - (string? v) - (and (cons? v) - (value? (car v)) - (value? (cdr v))) - (proc? v))) - -;; Środowisko początkowe (przypisujące procedury wbudowane ich nazwom) - -(define start-env - (foldl (lambda (p env) (env-add (first p) (second p) env)) - env-empty - `((+ ,(builtin/2 +)) - (- ,(builtin/2 -)) - (* ,(builtin/2 *)) - (/ ,(builtin/2 /)) - (~ ,(builtin/1 -)) - (< ,(builtin/2 <)) - (> ,(builtin/2 >)) - (= ,(builtin/2 =)) - (<= ,(builtin/2 <=)) - (>= ,(builtin/2 >=)) - (not ,(builtin/1 not)) - (cons ,(builtin/2 cons)) - (car ,(builtin/1 car)) - (cdr ,(builtin/1 cdr)) - (pair? ,(builtin/1 cons?)) - (null? ,(builtin/1 null?)) - (boolean? ,(builtin/1 boolean?)) - (number? ,(builtin/1 number?)) - (procedure? ,(builtin/1 (lambda (x) (or (clo? x) (builtin? x))))) - (string? ,(builtin/1 string?)) - (string-= ,(builtin/2 string=?)) - ;; and so on, and so on - ))) - -;; Efekt - -(define (effect-builtin/1 p) - (builtin p null 1)) -(define (effect-builtin/2 p) - (builtin p null 2)) - -(define effect-env - (foldl (lambda (p env) (env-add (first p) (second p) env)) - start-env - `((choose ,(effect-builtin/2 (lambda (x y) (list x y)))) - ))) - -(define (bind c k) (append-map k c)) - -(define (return x) (list x)) - -;; Ewaluator -(define (eval-env e env) - (match e - [(const n) - (return n)] - - [(var-expr x) - (return (env-lookup x env))] - - [(let-expr x e1 e2) - (bind (eval-env e1 env) (lambda (v1) - (eval-env e2 (env-add x v1 env))))] - - [(letrec-expr f ef eb) - (let ((new-env (env-add f (blackhole) env))) - (bind (eval-env ef new-env) (lambda (vf) - (env-update! f vf new-env) - (eval-env eb new-env))))] - - [(if-expr eb et ef) - (bind (eval-env eb env) (lambda (vb) - (match vb - [#t (eval-env et env)] - [#f (eval-env ef env)] - [v (error "Not a boolean:" v)])))] - - [(lambda-expr x e) - (return (clo x e env))] - - [(app-expr ef ea) - (bind (eval-env ef env) (lambda (vf) - (bind (eval-env ea env) (lambda (va) - (match vf - [(clo x e env) - (eval-env e (env-add x va env))] - [(builtin p args nm) - (if (= nm 1) - (apply p (reverse (cons va args))) - (return (builtin p (cons va args) (- nm 1))))] - [_ (error "Not a function:" vf)])))))])) - -(define (eval e) - (eval-env e effect-env)) - - -;; Przykladowy program - -(define PROGRAM - '((if (choose true false) (lambda (x) x) (lambda (x) (+ x 1))) (choose 1 2))) - - -;; REPL — interpreter interaktywny (read-eval-print loop) - -;; dodajemy składnię na wiązanie zmiennych "na poziomie interpretera" -;; i komendę wyjścia "exit" ... -(struct letrec-repl (id expr)) -(struct let-repl (id expr)) -(struct exit-repl ()) - -;; ... a także rozszerzoną procedurę parsującą te dodatkowe komendy i -;; prostą obsługę błędów -(define (parse-repl q) - (with-handlers - ([exn? (lambda (exn) - (display "Parse error! ") - (displayln (exn-message exn)))]) - (cond - [(eq? q 'exit) (exit-repl)] - [(and (list? q) - (= 3 (length q)) - (eq? (first q) 'let)) - (let-repl (second q) (parse (third q)))] - [(and (list? q) - (= 3 (length q)) - (eq? (first q) 'letrec)) - (letrec-repl (second q) (parse (third q)))] - [else (parse q)]))) - -;; trochę zamieszania w procedurze eval-repl wynika z rudymentarnej -;; obsługi błędów: nie chcemy żeby błąd w interpretowanym programie -;; kończył działanie całego interpretera! -(define (eval-repl c env continue) - (define (eval-with-err e env) - (with-handlers - ([exn? (lambda (exn) - (display "Error! ") - (displayln (exn-message exn)))]) - (eval-env e env))) - (match c - [(exit-repl) - (void)] - - [(let-repl x e) - (let ((v (eval-with-err e env))) - (if (void? v) - (continue env) - (continue (env-add x v env))))] - - [(letrec-repl f e) - (let* ((new-env (env-add f (blackhole) env)) - (v (eval-with-err e new-env))) - (if (void? v) - (continue env) - (begin - (env-update! f v new-env) - (continue new-env))))] - - [_ - (let ((v (eval-with-err c env))) - (unless (void? v) - (displayln v)) - (continue env))])) - -;; I w końcu interaktywny interpreter -(define (repl) - (define (go env) - (display "FUN > ") - (let* ((q (read)) - (c (parse-repl q))) - (if (void? c) - (go env) - (eval-repl c env go)))) - (displayln "Welcome to the FUN functional language interpreter!") - (go start-env))
\ No newline at end of file diff --git a/Semestr 2/racket/l10z18/solution.rkt b/Semestr 2/racket/l10z18/solution.rkt deleted file mode 100644 index 7adcea4..0000000 --- a/Semestr 2/racket/l10z18/solution.rkt +++ /dev/null @@ -1,409 +0,0 @@ -#lang racket - -;; Składnia abstrakcyjna -(struct const (val) #:transparent) -(struct var-expr (name) #:transparent) -(struct let-expr (id bound body) #:transparent) -(struct letrec-expr (id bound body) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct lambda-expr (arg body) #:transparent) -(struct app-expr (fun arg) #:transparent) - -(provide parse eval norm) - -(define (keyword s) - (member s '(true false null and or if cond else lambda let letrec))) - -(define (expr? e) - (match e - [(const n) (or (number? n) - (boolean? n) - (null? n) - (string? n))] - [(var-expr id) (symbol? id)] - [(let-expr x e1 e2 ) (and (symbol? x) - (expr? e1) - (expr? e2))] - [(letrec-expr x e1 e2) (and (symbol? x) - (expr? e1) - (expr? e2))] - [(if-expr eb et ef) (and (expr? eb) - (expr? et) - (expr? ef))] - [(lambda-expr x e) (and (symbol? x) - (expr? e))] - [(app-expr ef ea) (and (expr? ef) - (expr? ea))] - [_ false])) - -;; Parsowanie (zacytowane wyrażenie -> składnia abstrakcyjna) -(define (parse q) - (cond - [(number? q) (const q)] - [(string? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (const null)] - [(and (symbol? q) - (not (keyword q))) - (var-expr q)] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'let) - (list? (second q)) - (= (length (second q)) 2) - (symbol? (first (second q)))) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'letrec) - (list? (second q)) - (= (length (second q)) 2) - (symbol? (first (second q)))) - (letrec-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) - (= (length q) 4) - (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) - (pair? q) - (eq? (first q) 'and)) - (desugar-and (map parse (cdr q)))] - [(and (list? q) - (pair? q) - (eq? (first q) 'or)) - (desugar-or (map parse (cdr q)))] - [(and (list? q) - (>= (length q) 2) - (eq? (first q) 'cond)) - (parse-cond (cdr q))] - [(and (list? q) - (= (length q) 3) - (eq? (first q) 'lambda) - (list? (second q)) - (andmap symbol? (second q)) - (cons? (second q))) - (desugar-lambda (second q) (parse (third q)))] - [(and (list? q) - (>= (length q) 2)) - (desugar-app (parse (first q)) (map parse (cdr q)))] - [else (error "Unrecognized token:" q)])) - -(define (parse-cond qs) - (match qs - [(list (list 'else q)) - (parse q)] - - [(list (list q _)) - (error "Expected 'else' in last branch but found:" q)] - - [(cons (list qb qt) qs) - (if-expr (parse qb) (parse qt) (parse-cond qs))])) - -(define (desugar-and es) - (if (null? es) - (const true) - (if-expr (car es) (desugar-and (cdr es)) (const false)))) - -(define (desugar-or es) - (if (null? es) - (const false) - (if-expr (car es) (const true) (desugar-or (cdr es))))) - -(define (desugar-lambda xs e) - (if (null? xs) - e - (lambda-expr (car xs) (desugar-lambda (cdr xs) e)))) - -(define (desugar-app e es) - (if (null? es) - e - (desugar-app (app-expr e (car es)) (cdr es)))) - -;; Środowiska -(struct blackhole ()) -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (mcons x v) (environ-xs env)))) -(define (env-lookup x env) - (define (assoc-lookup xs) - (cond [(null? xs) - (error "Unknown identifier" x)] - [(eq? x (mcar (car xs))) - (let ((v (mcdr (car xs)))) - (if (blackhole? v) - (error "Jumped into blackhole at" x) - v))] - [else (assoc-lookup (cdr xs))])) - (assoc-lookup (environ-xs env))) -(define (env-update! x v env) - (define (assoc-update xs) - (cond [(null? xs) (error "Unknown identifier" x)] - [(eq? x (mcar (car xs))) - (set-mcdr! (car xs) v)] - [else (assoc-update (cdr xs))])) - (assoc-update (environ-xs env))) - -;; Domknięcia -(struct clo (arg body env)) - -;; Procedury wbudowane, gdzie -;; proc — Racketowa procedura którą należy uruchomić -;; args — lista dotychczas dostarczonych argumentów -;; pnum — liczba brakujących argumentów (> 0) -;; W ten sposób pozwalamy na częściową aplikację Racketowych procedur -;; — zauważmy że zawsze znamy pnum, bo w naszym języku arność -;; procedury jest ustalona z góry -(struct builtin (proc args pnum) #:transparent) - -;; Pomocnicze konstruktory procedur unarnych i binarnych -(define (builtin/1 p) - (builtin (lambda (x) (return (p x))) null 1)) -(define (builtin/2 p) - (builtin (lambda (x y) (return (p x y))) null 2)) - -;; Procedury -(define (proc? v) - (or (and (clo? v) - (symbol? (clo-arg v)) - (expr? (clo-body v)) - (environ? (clo-env v))) - (and (builtin? v) - (procedure? (builtin-proc v)) - (andmap value? (builtin-args v)) - (natural? (builtin-pnum v)) - (> (builtin-pnum v) 0)))) - -;; Definicja typu wartości -(define (value? v) - (or (number? v) - (boolean? v) - (null? v) - (string? v) - (and (cons? v) - (value? (car v)) - (value? (cdr v))) - (proc? v))) - -;; Środowisko początkowe (przypisujące procedury wbudowane ich nazwom) - -(define start-env - (foldl (lambda (p env) (env-add (first p) (second p) env)) - env-empty - `((+ ,(builtin/2 +)) - (- ,(builtin/2 -)) - (* ,(builtin/2 *)) - (/ ,(builtin/2 /)) - (~ ,(builtin/1 -)) - (< ,(builtin/2 <)) - (> ,(builtin/2 >)) - (= ,(builtin/2 =)) - (<= ,(builtin/2 <=)) - (>= ,(builtin/2 >=)) - (not ,(builtin/1 not)) - (cons ,(builtin/2 cons)) - (car ,(builtin/1 car)) - (cdr ,(builtin/1 cdr)) - (pair? ,(builtin/1 cons?)) - (null? ,(builtin/1 null?)) - (boolean? ,(builtin/1 boolean?)) - (number? ,(builtin/1 number?)) - (procedure? ,(builtin/1 (lambda (x) (or (clo? x) (builtin? x))))) - (string? ,(builtin/1 string?)) - (string-= ,(builtin/2 string=?)) - ;; and so on, and so on - ))) - -;; Efekt - -(define (effect-builtin/1 p) - (builtin p null 1)) -(define (effect-builtin/2 p) - (builtin p null 2)) -(define (effect-builtin/3 p) - (builtin p null 3)) - - -(define effect-env - (foldl (lambda (p env) (env-add (first p) (second p) env)) - start-env - `((flip ,(effect-builtin/3 (lambda (p x y) (list (cons p x) (cons (- 1 p) y))))) - (uniform ,(effect-builtin/1 (lambda (x) (let ((l (/ 1 (length x)))) - (map (lambda (x) (cons l x)) x))))) - ))) - -;; c to lista par (pstwo, wartość) -;; k to funkcja która przyjmuje wartość i coś z nią robi sobie i zwraca listę par (pstwo, wartość) - -(define (bind c k) - (append-map - (lambda (x) (let ((pstwo (car x)) - (val (cdr x))) - (map - (lambda (x) (cons (* pstwo (car x)) (cdr x))) - (k (cdr x))))) - c)) - -(define (return x) (list (cons 1 x))) - -;; Ewaluator -(define (eval-env e env) - (match e - [(const n) - (return n)] - - [(var-expr x) - (return (env-lookup x env))] - - [(let-expr x e1 e2) - (bind (eval-env e1 env) (lambda (v1) - (eval-env e2 (env-add x v1 env))))] - - [(letrec-expr f ef eb) - (let ((new-env (env-add f (blackhole) env))) - (bind (eval-env ef new-env) (lambda (vf) - (env-update! f vf new-env) - (eval-env eb new-env))))] - - [(if-expr eb et ef) - (bind (eval-env eb env) (lambda (vb) - (match vb - [#t (eval-env et env)] - [#f (eval-env ef env)] - [v (error "Not a boolean:" v)])))] - - [(lambda-expr x e) - (return (clo x e env))] - - [(app-expr ef ea) - (bind (eval-env ef env) (lambda (vf) - (bind (eval-env ea env) (lambda (va) - (match vf - [(clo x e env) - (eval-env e (env-add x va env))] - [(builtin p args nm) - (if (= nm 1) - (apply p (reverse (cons va args))) - (return (builtin p (cons va args) (- nm 1))))] - [_ (error "Not a function:" vf)])))))])) - -(define (eval e) - (eval-env e effect-env)) - - -;; Przykladowy program - -(define PROGRAM - '((if (choose true false) (lambda (x) x) (lambda (x) (+ x 1))) (choose 1 2))) - - -;; REPL — interpreter interaktywny (read-eval-print loop) - -;; dodajemy składnię na wiązanie zmiennych "na poziomie interpretera" -;; i komendę wyjścia "exit" ... -(struct letrec-repl (id expr)) -(struct let-repl (id expr)) -(struct exit-repl ()) - -;; ... a także rozszerzoną procedurę parsującą te dodatkowe komendy i -;; prostą obsługę błędów -(define (parse-repl q) - (with-handlers - ([exn? (lambda (exn) - (display "Parse error! ") - (displayln (exn-message exn)))]) - (cond - [(eq? q 'exit) (exit-repl)] - [(and (list? q) - (= 3 (length q)) - (eq? (first q) 'let)) - (let-repl (second q) (parse (third q)))] - [(and (list? q) - (= 3 (length q)) - (eq? (first q) 'letrec)) - (letrec-repl (second q) (parse (third q)))] - [else (parse q)]))) - -;; trochę zamieszania w procedurze eval-repl wynika z rudymentarnej -;; obsługi błędów: nie chcemy żeby błąd w interpretowanym programie -;; kończył działanie całego interpretera! -(define (eval-repl c env continue) - (define (eval-with-err e env) - (with-handlers - ([exn? (lambda (exn) - (display "Error! ") - (displayln (exn-message exn)))]) - (eval-env e env))) - (match c - [(exit-repl) - (void)] - - [(let-repl x e) - (let ((v (eval-with-err e env))) - (if (void? v) - (continue env) - (continue (env-add x v env))))] - - [(letrec-repl f e) - (let* ((new-env (env-add f (blackhole) env)) - (v (eval-with-err e new-env))) - (if (void? v) - (continue env) - (begin - (env-update! f v new-env) - (continue new-env))))] - - [_ - (let ((v (eval-with-err c env))) - (unless (void? v) - (displayln v)) - (continue env))])) - -;; I w końcu interaktywny interpreter -(define (repl) - (define (go env) - (display "FUN > ") - (let* ((q (read)) - (c (parse-repl q))) - (if (void? c) - (go env) - (eval-repl c env go)))) - (displayln "Welcome to the FUN functional language interpreter!") - (go start-env)) - - -(define prog '(if (flip 0.3 true false) "wygrana" "przegrana")) - - -(define (norm xs) - (define sum (lambda (xs) (foldl + 0 xs))) - (define carlist (lambda (xs) (map car xs))) - (define (iter xs res) - (cond - [(null? xs) res] - [(member (cdar xs) (map cdr res)) (iter (cdr xs) res)] - [else (let* ((cur (cdar xs)) - (pstwa (filter (lambda (x) (equal? (cdr x) cur)) xs))) - (iter (cdr xs) (cons (cons (sum (carlist pstwa)) cur) res)))])) - (iter xs null)) - - -(define DICE-MANY - '(letrec [from-to (lambda (x n) - (cons x - (if (= x n) - null - (from-to (+ 1 x) n))))] - (let [dice (lambda (x) (uniform (from-to 1 6)))] - (letrec [dice-many (lambda (n) (if (= n 0) - 0 - (+ (dice 0) (dice-many (- n 1)))))] - (dice-many (dice 0))))))
\ No newline at end of file diff --git a/Semestr 2/racket/l11/rozw.bak b/Semestr 2/racket/l11/rozw.bak deleted file mode 100644 index cda82ce..0000000 --- a/Semestr 2/racket/l11/rozw.bak +++ /dev/null @@ -1,2 +0,0 @@ -#lang racket - diff --git a/Semestr 2/racket/l11/rozw.rkt b/Semestr 2/racket/l11/rozw.rkt deleted file mode 100644 index e45e403..0000000 --- a/Semestr 2/racket/l11/rozw.rkt +++ /dev/null @@ -1,776 +0,0 @@ -#reader(lib"read.ss""wxme")WXME0109 ## -#| - This file uses the GRacket editor format. - Open this file in DrRacket version 7.6 or later to read it. - - Most likely, it was created by saving a program in DrRacket, - and it probably contains a program with non-text elements - (such as images or comment boxes). - - http://racket-lang.org/ -|# - 33 7 #"wxtext\0" -3 1 6 #"wxtab\0" -1 1 8 #"wximage\0" -2 0 8 #"wxmedia\0" -4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0" -1 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0" -1 0 68 -(0 - #"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr" - #"lib\"))\0" -) 1 0 16 #"drscheme:number\0" -3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0" -1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0" -1 0 93 -(1 - #"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni" - #"pclass-wxme.ss\" \"framework\"))\0" -) 0 0 43 #"(lib \"collapsed-snipclass.ss\" \"framework\")\0" -0 0 19 #"drscheme:sexp-snip\0" -0 0 29 #"drscheme:bindings-snipclass%\0" -1 0 101 -(2 - #"((lib \"ellipsis-snip.rkt\" \"drracket\" \"private\") (lib \"ellipsi" - #"s-snip-wxme.rkt\" \"drracket\" \"private\"))\0" -) 2 0 88 -(3 - #"((lib \"pict-snip.rkt\" \"drracket\" \"private\") (lib \"pict-snip.r" - #"kt\" \"drracket\" \"private\"))\0" -) 0 0 55 -#"((lib \"snip.rkt\" \"pict\") (lib \"snip-wxme.rkt\" \"pict\"))\0" -1 0 34 #"(lib \"bullet-snip.rkt\" \"browser\")\0" -0 0 25 #"(lib \"matrix.ss\" \"htdp\")\0" -1 0 22 #"drscheme:lambda-snip%\0" -1 0 29 #"drclickable-string-snipclass\0" -0 0 26 #"drracket:spacer-snipclass\0" -0 0 57 -#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0" -1 0 26 #"drscheme:pict-value-snip%\0" -0 0 45 #"(lib \"image-snipr.ss\" \"slideshow\" \"private\")\0" -1 0 38 #"(lib \"pict-snipclass.ss\" \"slideshow\")\0" -2 0 55 #"(lib \"vertical-separator-snip.ss\" \"stepper\" \"private\")\0" -1 0 18 #"drscheme:xml-snip\0" -1 0 31 #"(lib \"xml-snipclass.ss\" \"xml\")\0" -1 0 21 #"drscheme:scheme-snip\0" -2 0 34 #"(lib \"scheme-snipclass.ss\" \"xml\")\0" -1 0 10 #"text-box%\0" -1 0 32 #"(lib \"text-snipclass.ss\" \"xml\")\0" -1 0 1 6 #"wxloc\0" - 0 0 81 0 1 #"\0" -0 75 1 #"\0" -0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9 -#"Standard\0" -0 75 12 #"Courier New\0" -0 16 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24 -#"framework:default-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15 -#"text:ports out\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 119 34 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1 --1 2 15 #"text:ports err\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 204 204 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17 -#"text:ports value\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 --1 2 27 #"Matching Parenthesis Style\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 --1 2 1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 37 -#"framework:syntax-color:scheme:symbol\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -38 #"framework:syntax-color:scheme:keyword\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2 -38 #"framework:syntax-color:scheme:comment\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 204 221 170 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 37 -#"framework:syntax-color:scheme:string\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -35 #"framework:syntax-color:scheme:text\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -39 #"framework:syntax-color:scheme:constant\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 49 -#"framework:syntax-color:scheme:hash-colon-keyword\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -42 #"framework:syntax-color:scheme:parenthesis\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 178 178 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36 -#"framework:syntax-color:scheme:error\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 204 204 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 36 -#"framework:syntax-color:scheme:other\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 144 179 255 0 0 0 -1 -1 2 -16 #"Misspelled Text\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 -38 #"drracket:check-syntax:lexically-bound\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 50 163 255 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 28 -#"drracket:check-syntax:set!d\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 204 204 0 0 0 -1 -1 2 -37 #"drracket:check-syntax:unused-require\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 204 204 0 0 0 -1 -1 2 -36 #"drracket:check-syntax:free-variable\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 204 204 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 31 -#"drracket:check-syntax:imported\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 166 0 255 0 0 0 -1 -1 2 47 -#"drracket:check-syntax:my-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 50 -#"drracket:check-syntax:their-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 50 205 50 0 0 0 -1 -1 2 48 -#"drracket:check-syntax:unk-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2 -49 #"drracket:check-syntax:both-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 240 230 140 0 0 0 -1 -1 2 -26 #"plt:htdp:test-coverage-on\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 2 27 -#"plt:htdp:test-coverage-off\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 4 1 -#"\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 4 4 #"XML\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 2 37 #"plt:module-language:test-coverage-on\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2 -38 #"plt:module-language:test-coverage-off\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 0 36 -#"mrlib/syntax-browser:subtitle-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 100 149 237 0 0 0 -1 -1 0 -42 #"mrlib/syntax-browser:focused-syntax-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 50 205 50 0 0 0 -1 -1 4 1 -#"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 4 1 #"\0" -0 -1 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 191 255 0 0 0 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 191 255 0 0 0 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 152 251 152 0 0 0 --1 -1 4 32 #"widget.rkt::browser-text% basic\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 4 59 -#"macro-debugger/syntax-browser/properties color-text% basic\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 58 1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 190 190 190 0 0 0 -1 -1 2 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 0 0 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 255 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 185 220 113 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 155 255 155 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 116 116 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 18 67 155 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 30 70 190 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 75 135 185 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 208 208 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 116 116 255 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 125 255 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 143 15 223 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 165 0 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 141 19 5 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 244 194 71 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 127 0 0 0 -1 -1 4 -1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 86 86 86 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 255 255 255 0 31 31 -1 -1 -4 1 #"\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 0 -1 -1 - 0 475 0 28 3 12 #"#lang racket" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 7 #"require" -0 0 24 3 1 #" " -0 0 14 3 15 #"racket/contract" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 17 3 13 #";;; Zadanie 1" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 8 #"suffixes" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 3 #") (" -0 0 14 3 6 #"listof" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 5 #")))) " -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 2 #"if" -0 0 24 3 2 #" (" -0 0 14 3 5 #"null?" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 6 #" " -0 0 14 3 4 #"null" -0 0 24 29 1 #"\n" -0 0 24 3 7 #" (" -0 0 14 3 4 #"cons" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 2 #" (" -0 0 14 3 8 #"suffixes" -0 0 24 3 2 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 5 #")))))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 17 3 13 #";;; Zadanie 2" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 8 #"sublists" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 3 #") (" -0 0 14 3 6 #"listof" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 6 #")))) " -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 2 #"if" -0 0 24 3 2 #" (" -0 0 14 3 5 #"null?" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 7 #" (" -0 0 14 3 4 #"list" -0 0 24 3 1 #" " -0 0 14 3 4 #"null" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 7 #" (" -0 0 14 3 10 #"append-map" -0 0 24 29 1 #"\n" -0 0 24 3 8 #" (" -0 0 15 3 6 #"lambda" -0 0 24 3 2 #" (" -0 0 14 3 2 #"ys" -0 0 24 3 3 #") (" -0 0 14 3 4 #"list" -0 0 24 3 2 #" (" -0 0 14 3 4 #"cons" -0 0 24 3 2 #" (" -0 0 14 3 3 #"car" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 2 #") " -0 0 14 3 2 #"ys" -0 0 24 3 2 #") " -0 0 14 3 2 #"ys" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 8 #" (" -0 0 14 3 8 #"sublists" -0 0 24 3 2 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 5 #")))))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 17 3 13 #";;; Zadanie 3" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 17 #"autistic-identity" -0 0 24 3 1 #" " -0 0 14 3 1 #"x" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 2 #" " -0 0 14 3 1 #"x" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 6 #"create" -0 0 24 3 1 #" " -0 0 14 3 4 #"comb" -0 0 24 3 1 #" " -0 0 14 3 4 #"next" -0 0 24 3 1 #" " -0 0 14 3 3 #"beg" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 3 #") (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 2 #") " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 4 #" ((" -0 0 14 3 4 #"comb" -0 0 24 3 2 #" (" -0 0 14 3 4 #"next" -0 0 24 3 1 #" " -0 0 14 3 3 #"beg" -0 0 24 3 2 #") " -0 0 14 3 3 #"beg" -0 0 24 3 3 #")))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 7 #"compose" -0 0 24 3 1 #" " -0 0 14 3 2 #"bc" -0 0 24 3 1 #" " -0 0 14 3 2 #"ab" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 3 #") (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 3 #") (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"c" -0 0 24 3 3 #")))" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 15 3 6 #"lambda" -0 0 24 3 2 #" (" -0 0 14 3 1 #"x" -0 0 24 3 3 #") (" -0 0 14 3 2 #"bc" -0 0 24 3 2 #" (" -0 0 14 3 2 #"ab" -0 0 24 3 1 #" " -0 0 14 3 1 #"x" -0 0 24 3 4 #"))))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 5 #"ident" -0 0 24 3 1 #" " -0 0 14 3 1 #"f" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 2 #") " -0 0 14 3 1 #"a" -0 0 24 3 2 #") " -0 0 14 3 1 #"a" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 1 #"f" -0 0 24 3 1 #" " -0 0 14 3 8 #"identity" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 17 3 13 #";;; Zadanie 4" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 12 #"broken-contr" -0 0 24 3 1 #" " -0 0 14 3 1 #"x" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 1 #"b" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 12 #"broken-contr" -0 0 24 3 1 #" " -0 0 14 3 1 #"x" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 17 3 13 #";;; Zadanie 5" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 15 #"define/contract" -0 0 24 3 2 #" (" -0 0 14 3 9 #"foldl-map" -0 0 24 3 1 #" " -0 0 14 3 1 #"f" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 14 #"parametric->/c" -0 0 24 3 2 #" [" -0 0 14 3 1 #"F" -0 0 24 3 1 #" " -0 0 14 3 1 #"A" -0 0 24 3 1 #" " -0 0 14 3 1 #"L" -0 0 24 3 3 #"] (" -0 0 14 3 2 #"->" -0 0 24 3 2 #" (" -0 0 14 3 2 #"->" -0 0 24 3 1 #" " -0 0 14 3 1 #"L" -0 0 24 3 1 #" " -0 0 14 3 1 #"A" -0 0 24 3 2 #" (" -0 0 14 3 6 #"cons/c" -0 0 24 3 1 #" " -0 0 14 3 1 #"F" -0 0 24 3 1 #" " -0 0 14 3 1 #"A" -0 0 24 3 3 #")) " -0 0 14 3 1 #"A" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"L" -0 0 24 3 3 #") (" -0 0 14 3 6 #"cons/c" -0 0 24 3 2 #" (" -0 0 14 3 6 #"listof" -0 0 24 3 1 #" " -0 0 14 3 1 #"F" -0 0 24 3 2 #") " -0 0 14 3 1 #"A" -0 0 24 3 4 #"))) " -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 15 3 6 #"define" -0 0 24 3 2 #" (" -0 0 14 3 2 #"it" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #" " -0 0 14 3 2 #"ys" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 5 #" (" -0 0 14 3 2 #"if" -0 0 24 3 2 #" (" -0 0 14 3 5 #"null?" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 14 3 4 #"cons" -0 0 24 3 2 #" (" -0 0 14 3 7 #"reverse" -0 0 24 3 1 #" " -0 0 14 3 2 #"ys" -0 0 24 3 2 #") " -0 0 14 3 1 #"a" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 15 3 3 #"let" -0 0 24 3 3 #" [(" -0 0 14 3 1 #"p" -0 0 24 3 2 #" (" -0 0 14 3 1 #"f" -0 0 24 3 2 #" (" -0 0 14 3 3 #"car" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 2 #") " -0 0 14 3 1 #"a" -0 0 24 3 3 #"))]" -0 0 24 29 1 #"\n" -0 0 24 3 11 #" (" -0 0 14 3 2 #"it" -0 0 24 3 2 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 1 #"p" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 15 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 15 #" (" -0 0 14 3 4 #"cons" -0 0 24 3 2 #" (" -0 0 14 3 3 #"car" -0 0 24 3 1 #" " -0 0 14 3 1 #"p" -0 0 24 3 2 #") " -0 0 14 3 2 #"ys" -0 0 24 3 5 #")))))" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 2 #"it" -0 0 24 3 1 #" " -0 0 14 3 1 #"a" -0 0 24 3 1 #" " -0 0 14 3 2 #"xs" -0 0 24 3 1 #" " -0 0 14 3 4 #"null" -0 0 24 3 2 #"))" -0 0 diff --git a/Semestr 2/racket/l11/solution.bak b/Semestr 2/racket/l11/solution.bak deleted file mode 100644 index 3ae167a..0000000 --- a/Semestr 2/racket/l11/solution.bak +++ /dev/null @@ -1,18 +0,0 @@ -#lang racket - -(require racket/contract) - -(provide (contract-out [square square/c])) -(provide square/c) - -(define square/c (-> number? (not/c negative?))) - -(define (square x) (* x x)) - - -(define with-labels/c (parametric->/c [a b] (-> (-> a b)) - -(define (with-labels f xs) - (if (null? xs) - null - (cons (list (f (car xs)) (car xs)) (with-labels f (cdr xs)))))
\ No newline at end of file diff --git a/Semestr 2/racket/l11/solution.rkt b/Semestr 2/racket/l11/solution.rkt deleted file mode 100644 index 55e4ba6..0000000 --- a/Semestr 2/racket/l11/solution.rkt +++ /dev/null @@ -1,35 +0,0 @@ -#lang racket - -(provide (contract-out - [with-labels with-labels/c] - [foldr-map foldr-map/c] - [pair-from pair-from/c])) -(provide with-labels/c foldr-map/c pair-from/c) - - -(define with-labels/c (parametric->/c [a b] (-> (-> a b) (listof a) (listof (cons/c b (cons/c a null?)))))) - -(define (with-labels f xs) - (if (null? xs) - null - (cons (list (f (car xs)) (car xs)) (with-labels f (cdr xs))))) - - - -(define foldr-map/c (parametric->/c [x a f] (-> (-> x a (cons/c f a)) a (listof x) (cons/c (listof f) a)))) - -(define (foldr-map f a xs) - (define (it a xs ys) - (if (null? xs) - (cons ys a) - (let [(p (f (car xs) a))] - (it (cdr p) - (cdr xs) - (cons (car p) ys))))) - (it a (reverse xs) null)) - - -(define pair-from/c (parametric->/c [x fx gx] (-> (-> x fx) (-> x gx) (-> x (cons/c fx gx))))) - -(define (pair-from f g) - (lambda (x) (cons (f x) (g x))))
\ No newline at end of file diff --git a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep deleted file mode 100644 index 6d38ce0..0000000 --- a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("7.6" racket ("b51d3a36a64d34c7978bfc22f2a5fe674cee1cb6" . "8314027ed4c1c6fd9c412af77103e94790e59dd2") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo b/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo Binary files differdeleted file mode 100644 index ef91f9a..0000000 --- a/Semestr 2/racket/l11z20/compiled/drracket/errortrace/graph_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/l11z20/graph.bak b/Semestr 2/racket/l11z20/graph.bak deleted file mode 100644 index 9f4d79d..0000000 --- a/Semestr 2/racket/l11z20/graph.bak +++ /dev/null @@ -1,97 +0,0 @@ -#lang racket - -(provide bag^ graph^ simple-graph@ graph-search^ graph-search@) - -;; sygnatura dla struktury danych -(define-signature bag^ - ((contracted - [bag? (-> any/c boolean?)] - [empty-bag (and/c bag? bag-empty?)] - [bag-empty? (-> bag? boolean?)] - [bag-insert (-> bag? any/c (and/c bag? (not/c bag-empty?)))] - [bag-peek (-> (and/c bag? (not/c bag-empty?)) any/c)] - [bag-remove (-> (and/c bag? (not/c bag-empty?)) bag?)]))) - -;; sygnatura: grafy -(define-signature graph^ - ((contracted - [graph (-> list? (listof edge?) graph?)] - [graph? (-> any/c boolean?)] - [graph-nodes (-> graph? list?)] - [graph-edges (-> graph? (listof edge?))] - [edge (-> any/c any/c edge?)] - [edge? (-> any/c boolean?)] - [edge-start (-> edge? any/c)] - [edge-end (-> edge? any/c)] - [has-node? (-> graph? any/c boolean?)] - [outnodes (-> graph? any/c list?)] - [remove-node (-> graph? any/c graph?)] - ))) - -;; prosta implementacja grafów -(define-unit simple-graph@ - (import) - (export graph^) - - (define (graph? g) - (and (list? g) - (eq? (length g) 3) - (eq? (car g) 'graph))) - - (define (edge? e) - (and (list? e) - (eq? (length e) 3) - (eq? (car e) 'edge))) - - (define (graph-nodes g) (cadr g)) - - (define (graph-edges g) (caddr g)) - - (define (graph n e) (list 'graph n e)) - - (define (edge n1 n2) (list 'edge n1 n2)) - - (define (edge-start e) (cadr e)) - - (define (edge-end e) (caddr e)) - - (define (has-node? g n) (not (not (member n (graph-nodes g))))) - - (define (outnodes g n) - (filter-map - (lambda (e) - (and (eq? (edge-start e) n) - (edge-end e))) - (graph-edges g))) - - (define (remove-node g n) - (graph - (remove n (graph-nodes g)) - (filter - (lambda (e) - (not (eq? (edge-start e) n))) - (graph-edges g))))) - -;; sygnatura dla przeszukiwania grafu -(define-signature graph-search^ - (search)) - -;; implementacja przeszukiwania grafu -;; uzależniona od implementacji grafu i struktury danych -(define-unit graph-search@ - (import bag^ graph^) - (export graph-search^) - (define (search g n) - (define (it g b l) - (cond - [(bag-empty? b) (reverse l)] - [(has-node? g (bag-peek b)) - (it (remove-node g (bag-peek b)) - (foldl - (lambda (n1 b1) (bag-insert b1 n1)) - (bag-remove b) - (outnodes g (bag-peek b))) - (cons (bag-peek b) l))] - [else (it g (bag-remove b) l)])) - (it g (bag-insert empty-bag n) '())) - ) diff --git a/Semestr 2/racket/l11z20/graph.rkt b/Semestr 2/racket/l11z20/graph.rkt deleted file mode 100644 index ec19576..0000000 --- a/Semestr 2/racket/l11z20/graph.rkt +++ /dev/null @@ -1,100 +0,0 @@ -#lang racket - -(provide bag^ graph^ simple-graph@ graph-search^ graph-search@) - -;; sygnatura dla struktury danych -(define-signature bag^ - ((contracted - [bag? (-> any/c boolean?)] - [empty-bag (and/c bag? bag-empty?)] - [bag-empty? (-> bag? boolean?)] - [bag-insert (-> bag? any/c (and/c bag? (not/c bag-empty?)))] - [bag-peek (-> (and/c bag? (not/c bag-empty?)) any/c)] - [bag-remove (-> (and/c bag? (not/c bag-empty?)) bag?)]))) - -;; sygnatura: grafy -(define-signature graph^ - ((contracted - [graph (-> list? (listof edge?) graph?)] - [graph? (-> any/c boolean?)] - [graph-nodes (-> graph? list?)] - [graph-edges (-> graph? (listof edge?))] - [edge (-> any/c any/c edge?)] - [edge? (-> any/c boolean?)] - [edge-start (-> edge? any/c)] - [edge-end (-> edge? any/c)] - [has-node? (-> graph? any/c boolean?)] - [outnodes (-> graph? any/c list?)] - [remove-node (-> graph? any/c graph?)] - ))) - -;; prosta implementacja grafów -(define-unit simple-graph@ - (import) - (export graph^) - - (define (graph? g) - (and (list? g) - (eq? (length g) 3) - (eq? (car g) 'graph))) - - (define (edge? e) - (and (list? e) - (eq? (length e) 3) - (eq? (car e) 'edge))) - - (define (graph-nodes g) (cadr g)) - - (define (graph-edges g) (caddr g)) - - (define (graph n e) (list 'graph n e)) - - (define (edge n1 n2) (list 'edge n1 n2)) - - (define (edge-start e) (cadr e)) - - (define (edge-end e) (caddr e)) - - (define (has-node? g n) (not (not (member n (graph-nodes g))))) - - (define (outnodes g n) - (filter-map - (lambda (e) - (and (eq? (edge-start e) n) - (edge-end e))) - (graph-edges g))) - - (define (remove-node g n) - (graph - (remove n (graph-nodes g)) - (filter - (lambda (e) - (not (eq? (edge-start e) n))) - (graph-edges g))))) - -;; sygnatura dla przeszukiwania grafu -(define-signature graph-search^ - (search)) - -;; implementacja przeszukiwania grafu -;; uzależniona od implementacji grafu i struktury danych -(define-unit graph-search@ - (import bag^ graph^) - (export graph-search^) - (define (search g n) - (define (it g b l) - (cond - [(bag-empty? b) (reverse l)] - [(has-node? g (bag-peek b)) - (it (remove-node g (bag-peek b)) - (foldl - (lambda (n1 b1) (bag-insert b1 n1)) - (bag-remove b) - (outnodes g (bag-peek b))) - (cons (bag-peek b) l))] - [else (it g (bag-remove b) l)])) - (it g (bag-insert empty-bag n) '())) - ) - -;; otwarcie komponentu grafu -(define-values/invoke-unit/infer simple-graph@)
\ No newline at end of file diff --git a/Semestr 2/racket/l11z20/solution.bak b/Semestr 2/racket/l11z20/solution.bak deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/l11z20/solution.bak +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/l11z20/solution.rkt b/Semestr 2/racket/l11z20/solution.rkt deleted file mode 100644 index e3ad81f..0000000 --- a/Semestr 2/racket/l11z20/solution.rkt +++ /dev/null @@ -1,245 +0,0 @@ -#lang racket - -(require "graph.rkt") -(provide bag-stack@ bag-fifo@) - -;; struktura danych - stos -(define-unit bag-stack@ - (import) - (export bag^) - - (define (bag? b) - (and (cons? b) - (eq? (car b) 'stack))) - - (define empty-bag (cons 'stack null)) - - (define (bag-empty? b) - (null? (cdr b))) - - (define (bag-insert b val) - (cons 'stack (cons val (cdr b)))) - - (define (bag-peek b) - (cadr b)) - - (define (bag-remove b) - (cons 'stack (cddr b))) -) - -;; struktura danych - kolejka FIFO -(define-unit bag-fifo@ - (import) - (export bag^) - - (define (bag? b) - (and (list? b) - (eq? (length b) 3) - (eq? (first b) 'queue))) - - (define empty-bag - (list 'queue null null)) - - (define (bag-empty? b) - (and (null? (second b)) (null? (third b)))) - - (define (bag-insert b val) - (list 'queue (cons val (second b)) (third b))) - - (define (bag-peek b) - (let ((insq (second b)) - (popq (third b))) - (cond - [(null? popq) (last insq)] - [else (first popq)]))) - - (define (bag-remove b) - (let ((insq (second b)) - (popq (third b))) - (cond - [(null? popq) (list 'queue null (cdr (reverse insq)))] - [else (list 'queue insq (cdr popq))]))) -) - -;; otwarcie komponentów stosu i kolejki - -(define-values/invoke-unit bag-stack@ - (import) - (export (prefix stack: bag^))) - -(define-values/invoke-unit bag-fifo@ - (import) - (export (prefix fifo: bag^))) - -;; testy w Quickchecku -(require quickcheck) - -;; liczba zapytań na test quickchecka -(define TESTS 1000) - - -;; TESTY DO KOLEJKI - -;; xs to lista jakichś liczb, queries to rodzaj wykonywanych operacji -;; 0 - popuje na listę pops -;; 1 - insertuje na queue -;; jest nie ma nic na kolejce/stosie i dostajemy 0, to nic nie robimy -;; jesli queries albo xs są puste to po prostu kończymy obsługiwanie zapytań -;; na koncu sprawdzamy, czy (reverse pops) jest prefiksem xs - - -(define (check-queue xs queries) - (define (iter xs queries queue pops) - ;; (display queue) - ;; (newline) - (if (or (null? queries) (null? xs)) - (reverse pops) - (cond - [(and (eq? (car queries) 0) (not (fifo:bag-empty? queue))) - (iter xs (cdr queries) (fifo:bag-remove queue) (cons (fifo:bag-peek queue) pops))] - [else (iter (cdr xs) (cdr queries) (fifo:bag-insert queue (car xs)) pops)]))) - (define (is-prefix? xs ys) - (if (null? xs) - #t - (and (equal? (car xs) (car ys)) (is-prefix? (cdr xs) (cdr ys))))) - (is-prefix? (iter xs queries fifo:empty-bag null) xs)) - -;; sprawdzenie czy nasza funkcja testująca w ogóle działa -(define check-queue-test (lambda () (check-queue (list 1 2 3 4 5 6 7 8) (list 0 1 1 1 0 0 0 1 1 0 1 0 1 0 0)))) - -;; testowanie kolejki -(define-unit queue-tests@ - (import bag^) - (export) - - (quickcheck - (property ([xs (choose-list (choose-real -100000 100000) TESTS)] - [ops (choose-list (choose-integer 0 1) TESTS)]) - (check-queue xs ops)))) - -(invoke-unit queue-tests@ (import (prefix fifo: bag^))) - - -;; TESTY DO STOSU - -;; niestety tutaj nie jest tak kolorowo, na kolejce -;; dokładnie wiemy jaka jest koljeność popowanych, na stosie to dosyć dowolne. -;; Z drugiej strony jego implementacja jest dużo prostsza, więc testy też nie muszą -;; być bardzo rygorystyczne. - -(define (check-stack xs) - (define (insert-list stack xs) - (if (null? xs) - stack - (insert-list (stack:bag-insert stack (car xs)) (cdr xs)))) - (define (clear-stack stack pops) - (if (stack:bag-empty? stack) - pops - (clear-stack (stack:bag-remove stack) (cons (stack:bag-peek stack) pops)))) - (equal? xs (clear-stack (insert-list stack:empty-bag xs) null))) - - -;; testowanie stacka -(define-unit stack-tests@ - (import bag^) - (export) - (quickcheck - (property ([xs (choose-list (choose-real -100000 100000) TESTS)]) - (check-stack xs)))) - -(invoke-unit stack-tests@ (import (prefix stack: bag^))) - - - -;; testy kolejek i stosów -(define-unit bag-tests@ - (import bag^) - (export) - - ;; test przykładowy: jeśli do pustej struktury dodamy element - ;; i od razu go usuniemy, wynikowa struktura jest pusta - (quickcheck - (property ([s arbitrary-symbol]) - (bag-empty? (bag-remove (bag-insert empty-bag s))))) - - ;; Sprawdzenie własności wspólnych dla obu struktur - (quickcheck - (property ([s arbitrary-symbol]) - (equal? s (bag-peek (bag-insert empty-bag s))))) -) - -;; uruchomienie testów dla obu struktur danych - -(invoke-unit bag-tests@ (import (prefix stack: bag^))) -(invoke-unit bag-tests@ (import (prefix fifo: bag^))) - - - -;; TESTOWANIE PRZESZUKIWAŃ - -;; otwarcie komponentu grafu -(define-values/invoke-unit/infer simple-graph@) - -;; otwarcie komponentów przeszukiwania -;; w głąb i wszerz -(define-values/invoke-unit graph-search@ - (import graph^ (prefix stack: bag^)) - (export (prefix dfs: graph-search^))) - -(define-values/invoke-unit graph-search@ - (import graph^ (prefix fifo: bag^)) - (export (prefix bfs: graph-search^))) - -;; graf testowy -(define test-graph - (graph - (list 1 2 3 4) - (list (edge 1 3) - (edge 1 2) - (edge 2 4)))) - -(define test-graph2 - (graph (list 1) null)) - -(define test-graph3 - (graph (list 1 2 3 4 5 6 7 8 9 10) - (list (edge 1 2) - (edge 1 3) - (edge 2 3) - (edge 3 2) - (edge 3 5) - (edge 6 5) - (edge 5 7) - (edge 5 8) - (edge 7 9) - (edge 8 9) - (edge 9 10) - (edge 1 10) - (edge 10 1)))) - - -(define test-graph4 - (graph (list 1 2 3 4 5 6) - (list (edge 1 2) - (edge 2 3) - (edge 3 4) - (edge 4 5) - (edge 5 6)))) - -;; uruchomienie przeszukiwania na przykładowym grafie -(bfs:search test-graph 1) -(dfs:search test-graph 1) - -(bfs:search test-graph2 1) -(dfs:search test-graph2 1) - -(bfs:search test-graph3 1) -(dfs:search test-graph3 1) - -(bfs:search test-graph3 6) -(dfs:search test-graph3 6) - -(bfs:search test-graph4 1) -(dfs:search test-graph4 1) - - diff --git a/Semestr 2/racket/l13/oceny.txt b/Semestr 2/racket/l13/oceny.txt deleted file mode 100644 index 9f17cad..0000000 --- a/Semestr 2/racket/l13/oceny.txt +++ /dev/null @@ -1,18 +0,0 @@ -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 deleted file mode 100644 index b4094db..0000000 --- a/Semestr 2/racket/l13/rozw.rkt +++ /dev/null @@ -1,79 +0,0 @@ -#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 deleted file mode 100644 index 61804b3..0000000 --- a/Semestr 2/racket/l13/solution.rkt +++ /dev/null @@ -1,124 +0,0 @@ -#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 deleted file mode 100644 index 1dcfbfc..0000000 --- a/Semestr 2/racket/l13/zad6.rkt +++ /dev/null @@ -1,132 +0,0 @@ -#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 diff --git a/Semestr 2/racket/l14z22/solution.bak b/Semestr 2/racket/l14z22/solution.bak deleted file mode 100644 index 0d4f164..0000000 --- a/Semestr 2/racket/l14z22/solution.bak +++ /dev/null @@ -1,70 +0,0 @@ -#lang racket - -(require racklog) - -(provide solve) - -;; transpozycja tablicy zakodowanej jako lista list -(define (transpose xss) - (cond [(null? xss) xss] - ((null? (car xss)) (transpose (cdr xss))) - [else (cons (map car xss) - (transpose (map cdr xss)))])) - -;; procedura pomocnicza -;; tworzy listę n-elementową zawierającą wyniki n-krotnego -;; wywołania procedury f -(define (repeat-fn n f) - (if (eq? 0 n) null - (cons (f) (repeat-fn (- n 1) f)))) - -;; tworzy tablicę n na m elementów, zawierającą świeże -;; zmienne logiczne -(define (make-rect n m) - (repeat-fn m (lambda () (repeat-fn n _)))) - -;; predykat binarny -;; (%row-ok xs ys) oznacza, że xs opisuje wiersz (lub kolumnę) ys -(define %row-ok - (%rel () -;; TODO: uzupełnij! - )) - -;; TODO: napisz potrzebne ci pomocnicze predykaty - -;; funkcja rozwiązująca zagadkę -(define (solve rows cols) - (define board (make-rect (length cols) (length rows))) - (define tboard (transpose board)) - (define ret (%which (xss) - (%= xss board) -;; TODO: uzupełnij! - )) - (and ret (cdar ret))) - -;; testy -(equal? (solve '((2) (1) (1)) '((1 1) (2))) - '((* *) - (_ *) - (* _))) - -(equal? (solve '((2) (2 1) (1 1) (2)) '((2) (2 1) (1 1) (2))) - '((_ * * _) - (* * _ *) - (* _ _ *) - (_ * * _))) - -(equal? (solve '((4) (6) (2 2) (2 2) (6) (4) (2) (2) (2)) - '((9) (9) (2 2) (2 2) (4) (4))) - '((* * * * _ _) - (* * * * * *) - (* * _ _ * *) - (* * _ _ * *) - (* * * * * *) - (* * * * _ _) - (* * _ _ _ _) - (* * _ _ _ _) - (* * _ _ _ _))) - -;; TODO: możesz dodać własne testy - diff --git a/Semestr 2/racket/l14z22/solution.rkt b/Semestr 2/racket/l14z22/solution.rkt deleted file mode 100644 index 480c772..0000000 --- a/Semestr 2/racket/l14z22/solution.rkt +++ /dev/null @@ -1,87 +0,0 @@ -#lang racket - -(require racklog) - -(provide solve) - -;; transpozycja tablicy zakodowanej jako lista list -(define (transpose xss) - (cond [(null? xss) xss] - ((null? (car xss)) (transpose (cdr xss))) - [else (cons (map car xss) - (transpose (map cdr xss)))])) - -;; procedura pomocnicza -;; tworzy listę n-elementową zawierającą wyniki n-krotnego -;; wywołania procedury f -(define (repeat-fn n f) - (if (eq? 0 n) null - (cons (f) (repeat-fn (- n 1) f)))) - -;; tworzy tablicę n na m elementów, zawierającą świeże -;; zmienne logiczne -(define (make-rect n m) - (repeat-fn m (lambda () (repeat-fn n _)))) - -;; predykat binarny -;; (%row-ok xs ys) oznacza, że xs opisuje wiersz (lub kolumnę) ys -(define %row-ok - (%rel (xs ys zs n) - [(null null)] - [(xs (cons '_ ys)) - (%row-ok xs ys)] - [((cons n xs) ys) - (%stars ys n) - (%cut-first-n ys zs n) - (%row-ok xs zs)])) - - -(define %suffix - (%rel (xs ys x) - [(xs xs)] - [((cons x xs) ys) - (%suffix xs ys)])) - -(define %cut-first-n - (%rel (xs ys n yl) - [(xs xs 0)] - [(xs ys n) - (%suffix xs ys) - (%is #t (= (- (length xs) (length ys)) n))])) - - -;; usun n pierwszych elementow z xs -(define (suffix xs n) - (if (= n 0) - xs - (suffix (cdr xs) (- n 1)))) - - -;; sprawdza czy pierwsze n elementów listy to gwiazdki (dokladnie n) -(define %stars - (%rel (xs m n) - [(null 0)] - [((cons '_ xs) n) - (%is n 0)] - [((cons '* xs) n) - (%is m (- n 1)) - (%stars xs m)])) - -(define %board-ok - (%rel (xss xs yss ys) - [(null null)] - [((cons xs xss) (cons ys yss)) - (%row-ok xs ys) - (%board-ok xss yss)])) - -;; funkcja rozwiązująca zagadkę -(define (solve rows cols) - (define board (make-rect (length cols) (length rows))) - (define tboard (transpose board)) - (define ret (%which (xss) - (%= xss board) - (%board-ok rows board) - (%board-ok cols tboard))) - (and ret (cdar ret))) - - diff --git a/Semestr 2/racket/l15/kacp.bak b/Semestr 2/racket/l15/kacp.bak deleted file mode 100644 index ff2a2bc..0000000 --- a/Semestr 2/racket/l15/kacp.bak +++ /dev/null @@ -1,55 +0,0 @@ -#lang racket - -(define (run-concurrent . thunks) - (define threads (map thread thunks)) - (for-each thread-wait threads)) - -(define (random-sleep) - (sleep (/ (random) 100))) - -(define (with-random-sleep proc) - (lambda args - (random-sleep) - (apply proc args))) - -(define (make-serializer) - (define sem (make-semaphore 1)) - (lambda (proc) - (lambda args - (semaphore-wait sem) - (define ret (apply proc args)) - (semaphore-post sem) - ret))) - -(define (table) - (random-sleep) - (define forks (list (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1))) - (define (pick-fork i) - (random-sleep) - (semaphore-wait (list-ref forks i))) - (define (put-fork i) - (random-sleep) - (semaphore-post (list-ref forks i))) - (define (dispatch m) - (cond [(eq? m 'pick-fork) pick-fork] - [(eq? m 'put-fork) put-fork] - [else (error "Unknown request -- TABLE" - m)])) - dispatch) - -(define dtable (table)) - -(define (philosopher dining-table number) - (define my-turn (make-serializer)) - (define (eat) - (display number) - (newline) - ((dining-table 'pick-fork) number) - ((dining-table 'put-fork) number) - ((dining-table 'pick-fork) (modulo (+ number 1) 5)) - ((dining-table 'put-fork) (modulo (+ number 1) 5))) - (my-turn eat))
\ No newline at end of file diff --git a/Semestr 2/racket/l15/kacp.rkt b/Semestr 2/racket/l15/kacp.rkt deleted file mode 100644 index bd484f1..0000000 --- a/Semestr 2/racket/l15/kacp.rkt +++ /dev/null @@ -1,59 +0,0 @@ -#lang racket - -(define (run-concurrent . thunks) - (define threads (map thread thunks)) - (for-each thread-wait threads)) - -(define (random-sleep) - (sleep (/ (random) 100))) - -(define (with-random-sleep proc) - (lambda args - (random-sleep) - (apply proc args))) - -(define (make-serializer) - (define sem (make-semaphore 1)) - (lambda (proc) - (lambda args - (semaphore-wait sem) - (define ret (apply proc args)) - (semaphore-post sem) - ret))) - -(define (table) - (random-sleep) - (define forks (list (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1) - (make-semaphore 1))) - (define (pick-fork i) - (random-sleep) - (semaphore-wait (list-ref forks i))) - (define (put-fork i) - (random-sleep) - (semaphore-post (list-ref forks i))) - (define (dispatch m) - (cond [(eq? m 'pick-fork) pick-fork] - [(eq? m 'put-fork) put-fork] - [else (error "Unknown request -- TABLE" - m)])) - dispatch) - -(define dtable (table)) - -(define (philosopher dining-table number) - (define my-turn (make-serializer)) - (define (eat) - (display "Zaczynam ") - (display number) - (newline) - ((dining-table 'pick-fork) number) - ((dining-table 'put-fork) number) - ((dining-table 'pick-fork) (modulo (+ number 1) 5)) - ((dining-table 'put-fork) (modulo (+ number 1) 5)) - (display "Koncze ") - (display number) - (newline)) - (my-turn eat))
\ No newline at end of file diff --git a/Semestr 2/racket/l15/solution.bak b/Semestr 2/racket/l15/solution.bak deleted file mode 100644 index 03ab86a..0000000 --- a/Semestr 2/racket/l15/solution.bak +++ /dev/null @@ -1,7 +0,0 @@ -#lang racket - - - -(define (run-concurrent . thunks) - (define threads (map thread thunks)) - (for-each thread-wait threads))
\ No newline at end of file diff --git a/Semestr 2/racket/l15/solution.rkt b/Semestr 2/racket/l15/solution.rkt deleted file mode 100644 index 915502e..0000000 --- a/Semestr 2/racket/l15/solution.rkt +++ /dev/null @@ -1,85 +0,0 @@ -#lang racket - -(provide philosopher) - -;; Do debugu - -(define (run-concurrent . thunks) - (define threads (map thread thunks)) - (for-each thread-wait threads)) - -(define (random-sleep) - (sleep (/ (random) 100))) - -(define (with-random-sleep proc) - (lambda args - (random-sleep) - (apply proc args))) - -(define (make-serializer) - (define sem (make-semaphore 1)) - (lambda (proc) - (lambda args - (semaphore-wait sem) - (define ret (apply proc args)) - (semaphore-post sem) - ret))) - -(define (make-table) - (define forks (map (lambda (x) (make-semaphore 1)) '(0 1 2 3 4))) - (define (get-fork i) - (list-ref forks i)) - (define (pick-fork i) - (random-sleep) - (semaphore-wait (get-fork i))) - (define (put-fork i) - (random-sleep) - (semaphore-post (get-fork i))) - (define (dispatch m) - (cond [(eq? m 'pick-fork) pick-fork] - [(eq? m 'put-fork) put-fork] - [else (error "Unknown request -- MAKE-TABLE" m)])) - dispatch) - -;(define dining-table (make-table)) - -;(define (repeat proc n) -; (if (> n 0) -; (begin -; (proc) -; (repeat proc (- n 1))) -; #f)) -; -;(define (hungry nr x) -; (lambda () (repeat (lambda () (philosopher dining-table nr)) x))) - -;; Rozwiązanie: - -(define forks-sem (map (lambda (x) (make-semaphore 1)) '(0 0 0 0 0))) - -(define (get-fork i) - (list-ref forks-sem i)) - -(define (is-free? i) - (semaphore-try-wait? (get-fork i))) - -(define (put-fork dining-table i) - ((dining-table 'put-fork) i) - (semaphore-post (get-fork i))) - -(define (philosopher dining-table i) - (define left-fork i) - (define right-fork (modulo (+ i 1) 5)) - (define (loop) - (if (is-free? left-fork) - (if (is-free? right-fork) - (begin - ((dining-table 'pick-fork) left-fork) - ((dining-table 'pick-fork) right-fork) - (put-fork dining-table left-fork) - (put-fork dining-table right-fork)) - (loop)) - (begin - (semaphore-post (get-fork left-fork)) - (loop)))) - (loop))
\ No newline at end of file diff --git a/Semestr 2/racket/l7z12/solution.rkt b/Semestr 2/racket/l7z12/solution.rkt deleted file mode 100644 index 089dee4..0000000 --- a/Semestr 2/racket/l7z12/solution.rkt +++ /dev/null @@ -1,95 +0,0 @@ -#lang racket
-
-(provide (struct-out const)
- (struct-out binop)
- (struct-out var-expr)
- (struct-out let-expr)
- (struct-out pos)
- (struct-out var-free)
- (struct-out var-bound)
- annotate-expression)
-
-;; ---------------
-;; Jezyk wejsciowy
-;; ---------------
-
-(struct pos (file line col) #:transparent)
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct let-expr (loc id e1 e2) #:transparent)
-
-(define (expr? e)
- (match e
- [(const n) (number? n)]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(let-expr loc x e1 e2)
- (and (pos? loc) (symbol? x) (expr? e1) (expr? e2))]
- [_ false]))
-
-(define (make-pos s)
- (pos (syntax-source s)
- (syntax-line s)
- (syntax-column s)))
-
-(define (parse e)
- (let ([r (syntax-e e)])
- (cond
- [(number? r) (const r)]
- [(symbol? r) (var-expr r)]
- [(and (list? r) (= 3 (length r)))
- (match (syntax-e (car r))
- ['let (let* ([e-def (syntax-e (second r))]
- [x (syntax-e (first e-def))])
- (let-expr (make-pos (first e-def))
- (if (symbol? x) x (error "parse error!"))
- (parse (second e-def))
- (parse (third r))))]
- [op (binop op (parse (second r)) (parse (third r)))])]
- [else (error "parse error!")])))
-
-;; ---------------
-;; Jezyk wyjsciowy
-;; ---------------
-
-(struct var-free (id) #:transparent)
-(struct var-bound (pos id) #:transparent)
-
-(define (expr-annot? e)
- (match e
- [(const n) (number? n)]
- [(binop op l r) (and (symbol? op) (expr-annot? l) (expr-annot? r))]
- [(var-free x) (symbol? x)]
- [(var-bound loc x) (and (pos? loc) (symbol? x))]
- [(let-expr loc x e1 e2)
- (and (pos? loc) (symbol? x) (expr-annot? e1) (expr-annot? e2))]
- [_ false]))
-
-(struct environ (xs))
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (cons x v) (environ-xs env))))
-(define (env-lookup x env)
- (define (assoc-lookup xs)
- (cond [(null? xs) false]
- [(eq? x (car (car xs))) (cdr (car xs))]
- [else (assoc-lookup (cdr xs))]))
- (assoc-lookup (environ-xs env)))
-
-(define (annotate-expression-env e env)
- (match e
- [(const r) (const r)]
- [(binop op l r) (binop op (annotate-expression-env l env) (annotate-expression-env r env))]
- [(var-expr x) (let ((pos (env-lookup x env)))
- (if pos
- (var-bound pos x)
- (var-free x)))]
- [(let-expr loc x e1 e2) (let-expr loc x (annotate-expression-env e1 env) (annotate-expression-env e2 (env-add x loc env)))]))
-
-(define (annotate-expression e)
- (annotate-expression-env e env-empty))
-
-(define (test) (annotate-expression (parse #'(let [x 5] (let [x (* x y)] (+ x y))))))
diff --git a/Semestr 2/racket/l7z13/solution.rkt b/Semestr 2/racket/l7z13/solution.rkt deleted file mode 100644 index 0a0278a..0000000 --- a/Semestr 2/racket/l7z13/solution.rkt +++ /dev/null @@ -1,104 +0,0 @@ -#lang racket
-
-(provide (struct-out const) (struct-out binop) (struct-out var-expr) (struct-out let-expr) (struct-out var-dead) find-dead-vars)
-
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct var-dead (id) #:transparent)
-(struct let-expr (id e1 e2) #:transparent)
-
-(define (expr? e)
- (match e
- [(const n) (number? n)]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(var-dead x) (symbol? x)]
- [(let-expr x e1 e2) (and (symbol? x) (expr? e1) (expr? e2))]
- [_ false]))
-
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(symbol? q) (var-expr q)]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 3) (symbol? (first q)))
- (binop (first q)
- (parse (second q))
- (parse (third q)))]))
-
-; ---------------------------------- ;
-; Wyszukaj ostatnie uzycie zmiennych ;
-; ---------------------------------- ;
-
-(struct environ (xs))
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (cons x v) (environ-xs env))))
-(define (env-lookup x env)
- (define (assoc-lookup xs)
- (cond [(null? xs) (error "unbound identifier" x)]
- [(eq? x (car (car xs))) (cdr (car xs))]
- [else (assoc-lookup (cdr xs))]))
- (assoc-lookup (environ-xs env)))
-(define (env-erase x env)
- (define (assoc-lookup xs)
- (cond [(null? xs) (error "unbound identifier" x)]
- [(eq? x (caar xs)) (cdr xs)]
- [else (cons (car xs) (assoc-lookup (cdr xs)))]))
- (if (env-lookup x env)
- (environ (assoc-lookup (assoc-lookup (environ-xs env))))
- (environ (assoc-lookup (environ-xs env)))))
-
-
-(define (find-dead-vars-env e env)
- (match e
- [(const r) (cons (const r) env)]
- [(var-expr x) (if (env-lookup x env)
- (cons (var-expr x) env)
- (cons (var-dead x) (env-add x true env)))]
- [(binop op l r) (let* ((right-expr (find-dead-vars-env r env))
- (r (car right-expr))
- (env (cdr right-expr))
- (left-expr (find-dead-vars-env l env))
- (l (car left-expr))
- (env (cdr left-expr)))
- (cons (binop op l r) env))]
- [(let-expr x e1 e2) (let* ((right-expr (find-dead-vars-env e2 (env-add x false env)))
- (e2 (car right-expr))
- (env (env-erase x (cdr right-expr)))
- (left-expr (find-dead-vars-env e1 env))
- (e1 (car left-expr))
- (env (cdr left-expr)))
- (cons (let-expr x e1 e2) env))]))
-
-(define (find-dead-vars e)
- (car (find-dead-vars-env e env-empty)))
-
-
-(define (sample2) (find-dead-vars (let-expr 'x (const 3)
- (binop '+ (var-expr 'x)
- (let-expr 'x (const 5) (binop '+ (var-expr 'x) (var-expr 'x)))))))
-
-(define (test1) (find-dead-vars (parse '(let (x 3) (let (x (* x (+ x x))) (+ x x))))))
-(define (test2) (find-dead-vars (parse '(let (x 2) (let [x (let [x (+ x 2)] x)] x)))))
-(define (test3) (find-dead-vars (parse '(let [x 2] (+ (let [x (+ 2 x)] (* 3 x)) x)))))
-(define (test4) (find-dead-vars (parse '(let [x 2] (let [x (+ x 3)] (* x x))))))
-(define (test5) (find-dead-vars (parse '(let [x 2] (+ x (let [x (+ 2 x)] x))))))
-(define (test6) (find-dead-vars (parse '(let [x 2]
- (let [y (let [x (* x (+ x x))]
- (let [y (* x x)]
- (+ y 2)))]
- (+ x (* y y)))))))
-(define (test7) (find-dead-vars (parse '(let [x (let [x (let [x 2] (+ x x))] (+ x x))] (+ x x)))))
-;;; (define (test7) (find-dead-vars (parse '(let [x (let [x (let [x 2] (let (x 2) (+ x x)))] (+ x x))] (+ x x)))))
-(define (test8) (find-dead-vars (parse '(let [x 2] (let [x 2] (+ x x))))))
\ No newline at end of file diff --git a/Semestr 2/racket/l8z14/solution.bak b/Semestr 2/racket/l8z14/solution.bak deleted file mode 100644 index b51383a..0000000 --- a/Semestr 2/racket/l8z14/solution.bak +++ /dev/null @@ -1,155 +0,0 @@ -#lang racket - -; Do list.rkt dodajemy procedury -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) -(struct car-expr (e) #:transparent) -(struct cdr-expr (e) #:transparent) -(struct null-expr () #:transparent) -(struct null?-expr (e) #:transparent) -(struct app (f e) #:transparent) ; <------------------ !!! -(struct lam (id e) #:transparent) ; <------------------ !!! - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] - [(car-expr e) (expr? e)] - [(cdr-expr e) (expr? e)] - [(null-expr) true] - [(null?-expr e) (expr? e)] - [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! - [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (null-expr)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) - (null?-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) - (car-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) - (cdr-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!! - (parse-lam (second q) (third q))] - [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!! - (parse-app q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -(define (parse-app q) ; <----------------------------------------- !!! - (define (parse-app-accum q acc) - (cond [(= 1 (length q)) (app acc (parse (car q)))] - [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) - (parse-app-accum (cdr q) (parse (car q)))) - -(define (parse-lam pat e) ; <------------------------------------- !!! - (cond [(= 1 (length pat)) - (lam (car pat) (parse e))] - [else - (lam (car pat) (parse-lam (cdr pat) e))])) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs) #:transparent) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(struct clo (id e env) #:transparent) ; <------------------------- !!! - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))) - (null? v) - (clo? v))) ; <---------------------------------------------- !!! - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))] - [_ false])) ; <--------------------------------------- !!! - -(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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) - (eval-env e2 env))] - [(car-expr e) (car (eval-env e env))] - [(cdr-expr e) (cdr (eval-env e env))] - [(null-expr) null] - [(null?-expr e) (null? (eval-env e env))] - [(lam x e) (clo x e env)] ; <--------------------------------- !!! - [(app f e) ; <------------------------------------------------ !!! - (let ([vf (eval-env f env)] - [ve (eval-env e env)]) - (match vf [(clo x body fun-env) - (eval-env body (env-add x ve fun-env))]))])) - -(define (eval e) (eval-env e env-empty)) - -(define program - '(let [twice (lambda (f x) (f (f x)))] - (let [inc (lambda (x) (+ 1 x))] - (twice twice twice twice inc 1)))) - - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/l8z14/solution.rkt b/Semestr 2/racket/l8z14/solution.rkt deleted file mode 100644 index 59556cf..0000000 --- a/Semestr 2/racket/l8z14/solution.rkt +++ /dev/null @@ -1,201 +0,0 @@ -#lang racket - -; Do list.rkt dodajemy procedury -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(provide eval parse) - - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) -(struct car-expr (e) #:transparent) -(struct cdr-expr (e) #:transparent) -(struct null-expr () #:transparent) -(struct null?-expr (e) #:transparent) -(struct app (f e) #:transparent) ; <------------------ !!! -(struct lam (id e) #:transparent) ; <------------------ !!! -(struct apply-expr (f xs) #:transparent) - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] - [(car-expr e) (expr? e)] - [(cdr-expr e) (expr? e)] - [(null-expr) true] - [(null?-expr e) (expr? e)] - [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! - [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! - [(apply-expr f xs) (and (expr? f) (expr? xs))] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (null-expr)] - [(symbol? q) (var-expr q)] - [(and (> (length q) 0) (list? q) (eq? (first q) 'list)) - (parse-list (cdr q))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) - (null?-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'apply)) - (apply-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) - (car-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) - (cdr-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!! - (parse-lam (second q) (third q))] - [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!! - (parse-app q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - - -(define (parse-app q) ; <----------------------------------------- !!! - (define (parse-app-accum q acc) - (cond [(= 1 (length q)) (app acc (parse (car q)))] - [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) - (parse-app-accum (cdr q) (parse (car q)))) - -(define (parse-lam pat e) ; <------------------------------------- !!! - (cond [(= 1 (length pat)) - (lam (car pat) (parse e))] - [else - (lam (car pat) (parse-lam (cdr pat) e))])) - -(define (parse-list q) - (if (null? q) - (null-expr) - (cons-expr (parse (car q)) (parse-list (cdr q))))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs) #:transparent) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(struct clo (id e env) #:transparent) ; <------------------------- !!! - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))) - (null? v) - (clo? v))) ; <---------------------------------------------- !!! - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))] - [_ false])) ; <--------------------------------------- !!! - -(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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) - (eval-env e2 env))] - [(car-expr e) (car (eval-env e env))] - [(cdr-expr e) (cdr (eval-env e env))] - [(null-expr) null] - [(null?-expr e) (null? (eval-env e env))] - [(apply-expr e1 e2) - (let ([xs (eval-env e2 env)]) - (eval-env (eval-apply e1 (reverse xs)) env))] - [(lam x e) (clo x e env)] ; <--------------------------------- !!! - [(app f e) ; <------------------------------------------------ !!! - (let ([vf (eval-env f env)] - [ve (eval-env e env)]) - (match vf [(clo x body fun-env) - (eval-env body (env-add x ve fun-env))]))])) - -(define (eval-apply e xs) - (if (null? xs) - e - (app (eval-apply e (cdr xs)) (const (car xs))))) - -(define (eval e) (eval-env e env-empty)) - -;; testy wspólnie z Karolem Ochmanem - -(define program1 - '(apply (lambda (x y) (+ x y)) - (cons 1 (cons 2 null)))) -(define program2 - '(apply (lambda (x y z) (+ x (+ y z))) - (cons 1 (cons 2 null)))) -(define program3 - '(apply (lambda (x y) (lambda (z) (+ x (+ y z)))) - (cons 1 (cons 2 (cons 3 null))))) -(define program4 - '(apply (lambda (x y) (+ x y)) - (cons 1 (cons 2 (cons 3 null))))) -(define program5 - '(let [f (lambda (x y z) (+ z (+ x y)))] - (apply (f 3) (cons 1 (cons 2 null))))) -(define program6 - '(let [f (lambda (x) x)] - (apply (f 4) null))) -(define program7 - '(apply (lambda (q w e r t y u i o p a s d f g h j k l) 3) - (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 - (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 - (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 null))))))))))))))))))))) -(define program8 - '(apply (lambda (q w e r t y u i o p a s d f g h j k l) 3) - (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 (cons 1 - (cons 1 (cons 1 (cons 1 (cons 1 null)))))))))))))))
\ No newline at end of file diff --git a/Semestr 2/racket/l8z15/solution.bak b/Semestr 2/racket/l8z15/solution.bak deleted file mode 100644 index cdc84f9..0000000 --- a/Semestr 2/racket/l8z15/solution.bak +++ /dev/null @@ -1,187 +0,0 @@ -#lang racket
-
-; Do list.rkt dodajemy procedury
-;
-; Miejsca, ktore sie zmienily oznaczone sa przez !!!
-
-(provide parse eval)
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct let-expr (id e1 e2) #:transparent)
-(struct if-expr (eb et ef) #:transparent)
-(struct cons-expr (e1 e2) #:transparent)
-(struct car-expr (e) #:transparent)
-(struct cdr-expr (e) #:transparent)
-(struct null-expr () #:transparent)
-(struct null?-expr (e) #:transparent)
-(struct app (f e) #:transparent) ; <------------------ !!!
-(struct lam (id e) #:transparent) ; <------------------ !!!
-
-(define (expr? e)
- (match e
- [(const n) (or (number? n) (boolean? n))]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(let-expr x e1 e2)
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(if-expr eb et ef)
- (and (expr? eb) (expr? et) (expr? ef))]
- [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]
- [(car-expr e) (expr? e)]
- [(cdr-expr e) (expr? e)]
- [(null-expr) true]
- [(null?-expr e) (expr? e)]
- [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!!
- [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!!
- [_ false]))
-
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(eq? q 'true) (const true)]
- [(eq? q 'false) (const false)]
- [(eq? q 'null) (null-expr)]
- [(symbol? q) (var-expr q)]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))
- (null?-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))
- (cons-expr (parse (second q))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))
- (car-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))
- (cdr-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!!
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!!
- (parse-app q)]
- [(and (list? q) (eq? (length q) 3) (symbol? (first q)))
- (binop (first q)
- (parse (second q))
- (parse (third q)))]))
-
-(define (parse-app q) ; <----------------------------------------- !!!
- (define (parse-app-accum q acc)
- (cond [(= 1 (length q)) (app acc (parse (car q)))]
- [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))
- (parse-app-accum (cdr q) (parse (car q))))
-
-(define (parse-lam pat e) ; <------------------------------------- !!!
- (cond [(= 1 (length pat))
- (lam (car pat) (parse e))]
- [else
- (lam (car pat) (parse-lam (cdr pat) e))]))
-
-; ---------- ;
-; Srodowiska ;
-; ---------- ;
-
-(struct environ (xs) #:transparent)
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (cons x v) (environ-xs env))))
-(define (env-lookup x env)
- (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 ;
-; --------- ;
-
-(struct clo (id e env) #:transparent) ; <------------------------- !!!
-(struct odr (e env) #:transparent)
-
-(define (value? v)
- (or (number? v)
- (boolean? v)
- (and (pair? v) (value? (car v)) (value? (cdr v)))
- (null? v)
- (clo? v))) ; <---------------------------------------------- !!!
-
-(define (op->proc op)
- (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]
- ['= =] ['> >] ['>= >=] ['< <] ['<= <=]
- ['and (lambda (x y) (and x y))]
- ['or (lambda (x y) (or x y))]
- [_ false])) ; <--------------------------------------- !!!
-
-(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) (match (env-lookup x env)
- [(odr e env) (eval-env e env)]
- [f f])]
- [(if-expr eb et ef) (if (eval-env eb env)
- (eval-env et env)
- (eval-env ef env))]
- [(cons-expr e1 e2) (cons (odr e1 env)
- (odr e2 env))]
- [(car-expr e) (let ([p (eval-env e env)])
- (match (car p)
- [(odr e env) (eval-env e env)]))]
- [(cdr-expr e) (let ([p (eval-env e env)])
- (match (cdr p)
- [(odr e env) (eval-env e env)]))]
- [(null-expr) null]
- [(null?-expr e) (null? (eval-env e env))]
- [(lam x e) (clo x e env)] ; <--------------------------------- !!!
- [(app f e) ; <------------------------------------------------ !!!
- (let ([vf (eval-env f env)]
- [ve (odr e env)])
- (match vf [(clo x body fun-env)
- (eval-env body (env-add x ve fun-env))]))]))
-
-(define (eval e) (eval-env e env-empty))
-
-(define program
- '(let [twice (lambda (f x) (f (f x)))]
- (let [inc (lambda (x) (+ 1 x))]
- (twice twice twice twice inc 1))))
-
-
-;;; Testy wspólnie z Karolem Ochmanem
-
-(define (test-eval program) (eval (parse program)))
-
-(define program1
- '((lambda (x) (+ 3 3)) (/ 5 0)))
-(define program2
- '(let [if-fun (lambda (b t e) (if b t e))]
- (if-fun true 4 (/ 5 0))))
-(define program3
- '(car (cdr (cons 1 (cons 2 (cons 3 (cons 4 null)))))))
-(define program4
- '(car (cons (+ 3 4) (/ 5 0))))
-(define program5
- '(cons (+ 5 6) (- 4 3)))
-(define program6
- '(car (cdr (cdr (car (cons (cons (/ 0 0) (cons (/ 0 0) (cons 1 (/ 0 0)))) (cdr (cons (/ 0 0) null))))))))
-;;; (test-eval program)
-;;; (test-eval program1)
-;;; (test-eval program2)
-;;; (test-eval program3)
-;;; (test-eval program4)
-;;; (test-eval program5)
-;;; (test-eval program6)
\ No newline at end of file diff --git a/Semestr 2/racket/l8z15/solution.rkt b/Semestr 2/racket/l8z15/solution.rkt deleted file mode 100644 index 54b6cd3..0000000 --- a/Semestr 2/racket/l8z15/solution.rkt +++ /dev/null @@ -1,182 +0,0 @@ -#lang racket
-
-; Do list.rkt dodajemy procedury
-;
-; Miejsca, ktore sie zmienily oznaczone sa przez !!!
-
-(provide parse eval)
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct let-expr (id e1 e2) #:transparent)
-(struct if-expr (eb et ef) #:transparent)
-(struct cons-expr (e1 e2) #:transparent)
-(struct car-expr (e) #:transparent)
-(struct cdr-expr (e) #:transparent)
-(struct null-expr () #:transparent)
-(struct null?-expr (e) #:transparent)
-(struct app (f e) #:transparent) ; <------------------ !!!
-(struct lam (id e) #:transparent) ; <------------------ !!!
-
-(define (expr? e)
- (match e
- [(const n) (or (number? n) (boolean? n))]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(let-expr x e1 e2)
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(if-expr eb et ef)
- (and (expr? eb) (expr? et) (expr? ef))]
- [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]
- [(car-expr e) (expr? e)]
- [(cdr-expr e) (expr? e)]
- [(null-expr) true]
- [(null?-expr e) (expr? e)]
- [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!!
- [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!!
- [_ false]))
-
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(eq? q 'true) (const true)]
- [(eq? q 'false) (const false)]
- [(eq? q 'null) (null-expr)]
- [(symbol? q) (var-expr q)]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))
- (null?-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))
- (cons-expr (parse (second q))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))
- (car-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))
- (cdr-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!!
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!!
- (parse-app q)]
- [(and (list? q) (eq? (length q) 3) (symbol? (first q)))
- (binop (first q)
- (parse (second q))
- (parse (third q)))]))
-
-(define (parse-app q) ; <----------------------------------------- !!!
- (define (parse-app-accum q acc)
- (cond [(= 1 (length q)) (app acc (parse (car q)))]
- [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))
- (parse-app-accum (cdr q) (parse (car q))))
-
-(define (parse-lam pat e) ; <------------------------------------- !!!
- (cond [(= 1 (length pat))
- (lam (car pat) (parse e))]
- [else
- (lam (car pat) (parse-lam (cdr pat) e))]))
-
-; ---------- ;
-; Srodowiska ;
-; ---------- ;
-
-(struct environ (xs) #:transparent)
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (cons x v) (environ-xs env))))
-(define (env-lookup x env)
- (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 ;
-; --------- ;
-
-(struct clo (id e env) #:transparent) ; <------------------------- !!!
-(struct odr (e env) #:transparent)
-
-(define (value? v)
- (or (number? v)
- (boolean? v)
- (and (pair? v) (value? (car v)) (value? (cdr v)))
- (null? v)
- (clo? v))) ; <---------------------------------------------- !!!
-
-(define (op->proc op)
- (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]
- ['= =] ['> >] ['>= >=] ['< <] ['<= <=]
- ['and (lambda (x y) (and x y))]
- ['or (lambda (x y) (or x y))]
- [_ false])) ; <--------------------------------------- !!!
-
-(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) (match (env-lookup x env)
- [(odr e env) (eval-env e env)]
- [f f])]
- [(if-expr eb et ef) (if (eval-env eb env)
- (eval-env et env)
- (eval-env ef env))]
- [(cons-expr e1 e2) (cons (odr e1 env)
- (odr e2 env))]
- [(car-expr e) (let ([p (eval-env e env)])
- (match (car p)
- [(odr e env) (eval-env e env)]))]
- [(cdr-expr e) (let ([p (eval-env e env)])
- (match (cdr p)
- [(odr e env) (eval-env e env)]))]
- [(null-expr) null]
- [(null?-expr e) (null? (eval-env e env))]
- [(lam x e) (clo x e env)] ; <--------------------------------- !!!
- [(app f e) ; <------------------------------------------------ !!!
- (let ([vf (eval-env f env)]
- [ve (odr e env)])
- (match vf [(clo x body fun-env)
- (eval-env body (env-add x ve fun-env))]))]))
-
-(define (eval e) (eval-env e env-empty))
-
-
-;;; Testy wspólnie z Karolem Ochmanem
-
-(define (test-eval program) (eval (parse program)))
-
-(define program1
- '((lambda (x) (+ 3 3)) (/ 5 0)))
-(define program2
- '(let [if-fun (lambda (b t e) (if b t e))]
- (if-fun true 4 (/ 5 0))))
-(define program3
- '(car (cdr (cons 1 (cons 2 (cons 3 (cons 4 null)))))))
-(define program4
- '(car (cons (+ 3 4) (/ 5 0))))
-(define program5
- '(cons (+ 5 6) (- 4 3)))
-(define program6
- '(car (cdr (cdr (car (cons (cons (/ 0 0) (cons (/ 0 0) (cons 1 (/ 0 0)))) (cdr (cons (/ 0 0) null))))))))
-;;; (test-eval program)
-;;; (test-eval program1)
-;;; (test-eval program2)
-;;; (test-eval program3)
-;;; (test-eval program4)
-;;; (test-eval program5)
-;;; (test-eval program6)
\ No newline at end of file diff --git a/Semestr 2/racket/l9/zad4.rkt b/Semestr 2/racket/l9/zad4.rkt deleted file mode 100644 index 7b5e0bc..0000000 --- a/Semestr 2/racket/l9/zad4.rkt +++ /dev/null @@ -1,202 +0,0 @@ -#lang racket
-
-; Do fun.rkt dodajemy rekurencyjne let-y
-;
-; Miejsca, ktore sie zmienily oznaczone sa przez !!!
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct let-expr (id e1 e2) #:transparent)
-(struct letrec-expr (id e1 e2) #:transparent) ; <----------------- !!!
-(struct if-expr (eb et ef) #:transparent)
-(struct cons-expr (e1 e2) #:transparent)
-(struct car-expr (e) #:transparent)
-(struct cdr-expr (e) #:transparent)
-(struct null-expr () #:transparent)
-(struct null?-expr (e) #:transparent)
-(struct app (f e) #:transparent)
-(struct lam (id e) #:transparent)
-(struct citation (q) #:transparent)
-
-(define (expr? e)
- (match e
- [(const n) (or (number? n) (boolean? n))]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(let-expr x e1 e2)
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(letrec-expr x e1 e2) ; <------------------------------------ !!!
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(if-expr eb et ef)
- (and (expr? eb) (expr? et) (expr? ef))]
- [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]
- [(car-expr e) (expr? e)]
- [(cdr-expr e) (expr? e)]
- [(null-expr) true]
- [(null?-expr e) (expr? e)]
- [(app f e) (and (expr? f) (expr? e))]
- [(lam id e) (and (symbol? id) (expr? e))]
- [(citation q) true]
- [_ false]))
-
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(eq? q 'true) (const true)]
- [(eq? q 'false) (const false)]
- [(eq? q 'null) (null-expr)]
- [(symbol? q) (var-expr q)]
- [(and (list? q) (eq? 'quote (first q))) (citation (second q))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))
- (null?-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))
- (cons-expr (parse (second q))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))
- (car-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))
- (cdr-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'letrec)) ; <!!!
- (letrec-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda))
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->proc (car q))))
- (parse-app q)]
- [(and (list? q) (eq? (length q) 3) (symbol? (first q)))
- (binop (first q)
- (parse (second q))
- (parse (third q)))]))
-
-(define (parse-app q)
- (define (parse-app-accum q acc)
- (cond [(= 1 (length q)) (app acc (parse (car q)))]
- [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))
- (parse-app-accum (cdr q) (parse (car q))))
-
-(define (parse-lam pat e)
- (cond [(= 1 (length pat))
- (lam (car pat) (parse e))]
- [else
- (lam (car pat) (parse-lam (cdr pat) e))]))
-
-; ---------- ;
-; Srodowiska ;
-; ---------- ;
-
-(struct blackhole () #:transparent) ; <------------------------- !!!
-(struct environ (xs) #:transparent)
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (mcons x v) (environ-xs env)))) ; <-------------- !!!
-(define (env-lookup x env)
- (define (assoc-lookup xs)
- (cond [(null? xs) (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs))) ; <---------------------------- !!!
- (match (mcdr (car xs))
- [(blackhole) (error "Stuck forever in a black hole!")]
- [x x])]
- [else (assoc-lookup (cdr xs))]))
- (assoc-lookup (environ-xs env)))
-(define (env-update! x v xs) ; <---------------------------------- !!!
- (define (assoc-update! xs)
- (cond [(null? xs) (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs))) (set-mcdr! (car xs) v)]
- [else (env-update! x v (cdr xs))]))
- (assoc-update! (environ-xs xs)))
-
-; --------- ;
-; Ewaluacja ;
-; --------- ;
-
-(struct clo (id e env) #:transparent)
-
-(define (value? v)
- (or (number? v)
- (boolean? v)
- (and (pair? v) (value? (car v)) (value? (cdr v)))
- (null? v)
- (clo? v)
- (blackhole? v))) ; <---------------------------------------- !!!
-
-(define (op->proc op)
- (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]
- ['= =] ['> >] ['>= >=] ['< <] ['<= <=]
- ['and (lambda (x y) (and x y))]
- ['or (lambda (x y) (or x y))]
- [_ false]))
-
-(define (eval-env e env)
- (match e
- [(const n) n]
- [(citation q) q]
- [(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))]
- [(letrec-expr x e1 e2) ; <------------------------------------ !!!
- (let* ([new-env (env-add x (blackhole) env)]
- [v (eval-env e1 new-env)])
- (begin
- (env-update! x v new-env)
- (eval-env e2 new-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))]
- [(cons-expr e1 e2) (cons (eval-env e1 env)
- (eval-env e2 env))]
- [(car-expr e) (car (eval-env e env))]
- [(cdr-expr e) (cdr (eval-env e env))]
- [(null-expr) null]
- [(null?-expr e) (null? (eval-env e env))]
- [(lam x e) (clo x e env)]
- [(app f e)
- (let ([vf (eval-env f env)]
- [ve (eval-env e env)])
- (match vf [(clo x body fun-env)
- (eval-env body (env-add x ve fun-env))]))]))
-
-(define (eval e) (eval-env e env-empty))
-
-(define program
- '(letrec
- [fact (lambda (n) (if (= n 0) 1 (* n (fact (- n 1)))))]
- (letrec
- [even-odd
- (cons
- (lambda (x)
- (if (= x 0) true ((cdr even-odd) (- x 1))))
- (lambda (x)
- (if (= x 0) false ((car even-odd) (- x 1)))))]
- (let [even (car even-odd)]
- (let [odd (cdr even-odd)]
- (even (fact 6)))))))
-
-(define PROGRAM
- '(letrec [from-to (lambda (n k)
- (if (> n k)
- null
- (cons n (from-to (+ n 1) k))))]
- (letrec [sum (lambda (xs)
- (if (null? xs)
- 0
- (+ (car xs) (sum (cdr xs)))))]
- (sum (from-to 1 36)))))
-
-(define (test-eval) (eval (parse PROGRAM)))
\ No newline at end of file diff --git a/Semestr 2/racket/l9/zad7.rkt b/Semestr 2/racket/l9/zad7.rkt deleted file mode 100644 index 207162d..0000000 --- a/Semestr 2/racket/l9/zad7.rkt +++ /dev/null @@ -1,340 +0,0 @@ -#lang racket
-
-;; Składnia abstrakcyjna
-(struct const (val) #:transparent)
-(struct var-expr (name) #:transparent)
-(struct let-expr (id bound body) #:transparent)
-(struct letrec-expr (id bound body) #:transparent)
-(struct if-expr (eb et ef) #:transparent)
-(struct lambda-expr (arg body) #:transparent)
-(struct app-expr (fun arg) #:transparent)
-(struct display-expr (e) )
-
-(define (keyword s)
- (member s '(true false null and or if cond else lambda let letrec display read)))
-
-(define (expr? e)
- (match e
- [(const n) (or (number? n)
- (boolean? n)
- (null? n)
- (string? n))]
- [(var-expr id) (symbol? id)]
- [(let-expr x e1 e2 ) (and (symbol? x)
- (expr? e1)
- (expr? e2))]
- [(letrec-expr x e1 e2) (and (symbol? x)
- (expr? e1)
- (expr? e2))]
- [(if-expr eb et ef) (and (expr? eb)
- (expr? et)
- (expr? ef))]
- [(lambda-expr x e) (and (symbol? x)
- (expr? e))]
- [(app-expr ef ea) (and (expr? ef)
- (expr? ea))]
- [_ false]))
-
-;; Parsowanie (zacytowane wyrażenie -> składnia abstrakcyjna)
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(string? q) (const q)]
- [(eq? q 'true) (const true)]
- [(eq? q 'false) (const false)]
- [(eq? q 'null) (const null)]
- [(and (symbol? q)
- (not (keyword q)))
- (var-expr q)]
- [(and (list? q)
- (= (length q) 3)
- (eq? (first q) 'let)
- (list? (second q))
- (= (length (second q)) 2)
- (symbol? (first (second q))))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q)
- (= (length q) 3)
- (eq? (first q) 'letrec)
- (list? (second q))
- (= (length (second q)) 2)
- (symbol? (first (second q))))
- (letrec-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q)
- (= (length q) 4)
- (eq? (first q) 'if))
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(and (list? q)
- (pair? q)
- (eq? (first q) 'and))
- (desugar-and (map parse (cdr q)))]
- [(and (list? q)
- (pair? q)
- (eq? (first q) 'or))
- (desugar-or (map parse (cdr q)))]
- [(and (list? q)
- (>= (length q) 2)
- (eq? (first q) 'cond))
- (parse-cond (cdr q))]
- [(and (list? q)
- (= (length q) 3)
- (eq? (first q) 'lambda)
- (list? (second q))
- (andmap symbol? (second q))
- (cons? (second q)))
- (desugar-lambda (second q) (parse (third q)))]
- [(and (list? q)
- (>= (length q) 2))
- (desugar-app (parse (first q)) (map parse (cdr q)))]
- [else (error "Unrecognized token:" q)]))
-
-(define (parse-cond qs)
- (match qs
- [(list (list 'else q))
- (parse q)]
-
- [(list (list q _))
- (error "Expected 'else' in last branch but found:" q)]
-
- [(cons (list qb qt) qs)
- (if-expr (parse qb) (parse qt) (parse-cond qs))]))
-
-(define (desugar-and es)
- (if (null? es)
- (const true)
- (if-expr (car es) (desugar-and (cdr es)) (const false))))
-
-(define (desugar-or es)
- (if (null? es)
- (const false)
- (if-expr (car es) (const true) (desugar-or (cdr es)))))
-
-(define (desugar-lambda xs e)
- (if (null? xs)
- e
- (lambda-expr (car xs) (desugar-lambda (cdr xs) e))))
-
-(define (desugar-app e es)
- (if (null? es)
- e
- (desugar-app (app-expr e (car es)) (cdr es))))
-
-;; Środowiska
-(struct blackhole ())
-(struct environ (xs))
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (mcons x v) (environ-xs env))))
-(define (env-lookup x env)
- (define (assoc-lookup xs)
- (cond [(null? xs)
- (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs)))
- (let ((v (mcdr (car xs))))
- (if (blackhole? v)
- (error "Jumped into blackhole at" x)
- v))]
- [else (assoc-lookup (cdr xs))]))
- (assoc-lookup (environ-xs env)))
-(define (env-update! x v env)
- (define (assoc-update xs)
- (cond [(null? xs) (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs)))
- (set-mcdr! (car xs) v)]
- [else (assoc-update (cdr xs))]))
- (assoc-update (environ-xs env)))
-
-;; Domknięcia
-(struct clo (arg body env))
-
-;; Procedury wbudowane, gdzie
-;; proc — Racketowa procedura którą należy uruchomić
-;; args — lista dotychczas dostarczonych argumentów
-;; pnum — liczba brakujących argumentów (> 0)
-;; W ten sposób pozwalamy na częściową aplikację Racketowych procedur
-;; — zauważmy że zawsze znamy pnum, bo w naszym języku arność
-;; procedury jest ustalona z góry
-(struct builtin (proc args pnum))
-
-;; Pomocnicze konstruktory procedur unarnych i binarnych
-(define (builtin/1 p)
- (builtin p null 1))
-(define (builtin/2 p)
- (builtin p null 2))
-
-;; Procedury
-(define (proc? v)
- (or (and (clo? v)
- (symbol? (clo-arg v))
- (expr? (clo-body v))
- (environ? (clo-env v)))
- (and (builtin? v)
- (procedure? (builtin-proc v))
- (andmap value? (builtin-args v))
- (natural? (builtin-pnum v))
- (> (builtin-pnum v) 0))))
-
-;; Definicja typu wartości
-(define (value? v)
- (or (number? v)
- (boolean? v)
- (null? v)
- (string? v)
- (and (cons? v)
- (value? (car v))
- (value? (cdr v)))
- (proc? v)))
-
-;; Środowisko początkowe (przypisujące procedury wbudowane ich nazwom)
-
-(define start-env
- (foldl (lambda (p env) (env-add (first p) (second p) env))
- env-empty
- `((+ ,(builtin/2 +))
- (- ,(builtin/2 -))
- (* ,(builtin/2 *))
- (/ ,(builtin/2 /))
- (~ ,(builtin/1 -))
- (< ,(builtin/2 <))
- (> ,(builtin/2 >))
- (= ,(builtin/2 =))
- (<= ,(builtin/2 <=))
- (>= ,(builtin/2 >=))
- (not ,(builtin/1 not))
- (cons ,(builtin/2 cons))
- (car ,(builtin/1 car))
- (cdr ,(builtin/1 cdr))
- (pair? ,(builtin/1 cons?))
- (null? ,(builtin/1 null?))
- (boolean? ,(builtin/1 boolean?))
- (number? ,(builtin/1 number?))
- (procedure? ,(builtin/1 (lambda (x) (or (clo? x) (builtin? x)))))
- (string? ,(builtin/1 string?))
- (string-= ,(builtin/2 string=?))
- ;; and so on, and so on
- )))
-
-;; Ewaluator
-(define (eval-env e env)
- (match e
- [(const n)
- n]
-
- [(var-expr x)
- (env-lookup x env)]
-
- [(let-expr x e1 e2)
- (let ((v1 (eval-env e1 env)))
- (eval-env e2 (env-add x v1 env)))]
-
- [(letrec-expr f ef eb)
- (let* ((new-env (env-add f (blackhole) env))
- (vf (eval-env ef new-env)))
- (env-update! f vf new-env)
- (eval-env eb new-env))]
-
- [(if-expr eb et ef)
- (match (eval-env eb env)
- [#t (eval-env et env)]
- [#f (eval-env ef env)]
- [v (error "Not a boolean:" v)])]
-
- [(lambda-expr x e)
- (clo x e env)]
-
- [(app-expr ef ea)
- (let ((vf (eval-env ef env))
- (va (eval-env ea env)))
- (match vf
- [(clo x e env)
- (eval-env e (env-add x va env))]
- [(builtin p args nm)
- (if (= nm 1)
- (apply p (reverse (cons va args)))
- (builtin p (cons va args) (- nm 1)))]
- [_ (error "Not a function:" vf)]))]))
-
-(define (eval e)
- (eval-env e start-env))
-
-
-;; REPL — interpreter interaktywny (read-eval-print loop)
-
-;; dodajemy składnię na wiązanie zmiennych "na poziomie interpretera"
-;; i komendę wyjścia "exit" ...
-(struct letrec-repl (id expr))
-(struct let-repl (id expr))
-(struct exit-repl ())
-
-;; ... a także rozszerzoną procedurę parsującą te dodatkowe komendy i
-;; prostą obsługę błędów
-(define (parse-repl q)
- (with-handlers
- ([exn? (lambda (exn)
- (display "Parse error! ")
- (displayln (exn-message exn)))])
- (cond
- [(eq? q 'exit) (exit-repl)]
- [(and (list? q)
- (= 3 (length q))
- (eq? (first q) 'let))
- (let-repl (second q) (parse (third q)))]
- [(and (list? q)
- (= 3 (length q))
- (eq? (first q) 'letrec))
- (letrec-repl (second q) (parse (third q)))]
- [else (parse q)])))
-
-;; trochę zamieszania w procedurze eval-repl wynika z rudymentarnej
-;; obsługi błędów: nie chcemy żeby błąd w interpretowanym programie
-;; kończył działanie całego interpretera!
-(define (eval-repl c env continue)
- (define (eval-with-err e env)
- (with-handlers
- ([exn? (lambda (exn)
- (display "Error! ")
- (displayln (exn-message exn)))])
- (eval-env e env)))
- (match c
- [(exit-repl)
- (void)]
-
- [(let-repl x e)
- (let ((v (eval-with-err e env)))
- (if (void? v)
- (continue env)
- (continue (env-add x v env))))]
-
- [(letrec-repl f e)
- (let* ((new-env (env-add f (blackhole) env))
- (v (eval-with-err e new-env)))
- (if (void? v)
- (continue env)
- (begin
- (env-update! f v new-env)
- (continue new-env))))]
-
- [_
- (let ((v (eval-with-err c env)))
- (unless (void? v)
- (displayln v))
- (continue env))]))
-
-;; I w końcu interaktywny interpreter
-(define (repl)
- (define (go env)
- (display "FUN > ")
- (let* ((q (read))
- (c (parse-repl q)))
- (if (void? c)
- (go env)
- (eval-repl c env go))))
- (displayln "Welcome to the FUN functional language interpreter!")
- (go start-env))
\ No newline at end of file diff --git a/Semestr 2/racket/l9z16/solution.rkt b/Semestr 2/racket/l9z16/solution.rkt deleted file mode 100644 index 0af169d..0000000 --- a/Semestr 2/racket/l9z16/solution.rkt +++ /dev/null @@ -1,42 +0,0 @@ -#lang racket
-
-(provide lcons lnull lnull? lcar lcdr)
-
-
-(define (lcons x f) (mcons x f))
-
-(define lnull null)
-
-(define lnull? null?)
-
-(define (lcar xs) (mcar xs))
-
-(define (lcdr xs)
- (let ([x (mcdr xs)])
- (cond [(not (mpair? x)) (set-mcdr! xs (x))]))
- (mcdr xs))
-
-(define (from n)
- (lcons n (lambda () (from (+ n 1)))))
-
-(define nats
- (from 0))
-
-(define (lnth n xs)
- (cond [(= n 0) (lcar xs)]
- [else (lnth (- n 1) (lcdr xs))]))
-
-(define (lfilter p xs)
- (cond [(lnull? xs) lnull]
- [(p (lcar xs))
- (lcons (lcar xs) (lambda () (lfilter p (lcdr xs))))]
- [else (lfilter p (lcdr xs))]))
-
-(define (prime? n)
- (define (factors i)
- (cond [(>= i n) (list n)]
- [(= (modulo n i) 0) (cons i (factors (+ i 1)))]
- [else (factors (+ i 1))]))
- (= (length (factors 1)) 2))
-
-(define primes (lfilter prime? (from 2)))
\ No newline at end of file diff --git a/Semestr 2/racket/l9z17/solution.rkt b/Semestr 2/racket/l9z17/solution.rkt deleted file mode 100644 index 5e98036..0000000 --- a/Semestr 2/racket/l9z17/solution.rkt +++ /dev/null @@ -1,266 +0,0 @@ -#lang racket
-
-; Do programming.rkt dodajemy instrukcje
-
-(provide eval-while parse-while env-empty env-lookup)
-
-;;; We współpracy z Kacprem Soleckim
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-
-(struct const (val) #:transparent)
-(struct binop (op l r) #:transparent)
-(struct var-expr (id) #:transparent)
-(struct let-expr (id e1 e2) #:transparent)
-(struct letrec-expr (id e1 e2) #:transparent)
-(struct if-expr (eb et ef) #:transparent)
-(struct cons-expr (e1 e2) #:transparent)
-(struct car-expr (e) #:transparent)
-(struct cdr-expr (e) #:transparent)
-(struct null-expr () #:transparent)
-(struct null?-expr (e) #:transparent)
-(struct app (f e) #:transparent)
-(struct lam (id e) #:transparent)
-
-(define (expr? e)
- (match e
- [(const n) (or (number? n) (boolean? n) (string? n))]
- [(binop op l r) (and (symbol? op) (expr? l) (expr? r))]
- [(var-expr x) (symbol? x)]
- [(let-expr x e1 e2)
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(letrec-expr x e1 e2)
- (and (symbol? x) (expr? e1) (expr? e2))]
- [(if-expr eb et ef)
- (and (expr? eb) (expr? et) (expr? ef))]
- [(cons-expr e1 e2) (and (expr? e1) (expr? e2))]
- [(car-expr e) (expr? e)]
- [(cdr-expr e) (expr? e)]
- [(null-expr) true]
- [(null?-expr e) (expr? e)]
- [(app f e) (and (expr? f) (expr? e))]
- [(lam id e) (and (symbol? id) (expr? e))]
- [_ false]))
-
-(define (parse q)
- (cond
- [(number? q) (const q)]
- [(eq? q 'true) (const true)]
- [(eq? q 'false) (const false)]
- [(eq? q 'null) (null-expr)]
- [(string? q) (const q)]
- [(symbol? q) (var-expr q)]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?))
- (null?-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons))
- (cons-expr (parse (second q))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car))
- (car-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr))
- (cdr-expr (parse (second q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let))
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'letrec))
- (letrec-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if))
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda))
- (parse-lam (second q) (third q))]
- [(and (list? q) (pair? q) (not (op->proc (car q))))
- (parse-app q)]
- [(and (list? q) (eq? (length q) 3) (symbol? (first q)))
- (binop (first q)
- (parse (second q))
- (parse (third q)))]))
-
-(define (parse-app q)
- (define (parse-app-accum q acc)
- (cond [(= 1 (length q)) (app acc (parse (car q)))]
- [else (parse-app-accum (cdr q) (app acc (parse (car q))))]))
- (parse-app-accum (cdr q) (parse (car q))))
-
-(define (parse-lam pat e)
- (cond [(= 1 (length pat))
- (lam (car pat) (parse e))]
- [else
- (lam (car pat) (parse-lam (cdr pat) e))]))
-
-; ---------- ;
-; Srodowiska ;
-; ---------- ;
-
-(struct blackhole () #:transparent)
-(struct environ (xs) #:transparent)
-
-(define env-empty (environ null))
-(define (env-add x v env)
- (environ (cons (mcons x v) (environ-xs env))))
-(define (env-lookup x env)
- (define (assoc-lookup xs)
- (cond [(null? xs) (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs)))
- (match (mcdr (car xs))
- [(blackhole) (error "Stuck forever in a black hole!")]
- [x x])]
- [else (assoc-lookup (cdr xs))]))
- (assoc-lookup (environ-xs env)))
-(define (env-update! x v xs)
- (define (assoc-update! xs)
- (cond [(null? xs) (error "Unknown identifier" x)]
- [(eq? x (mcar (car xs))) (set-mcdr! (car xs) v)]
- [else (env-update! x v (cdr xs))]))
- (assoc-update! (environ-xs xs)))
-(define (env-update x v xs) ; <---------------------------------- !!!
- (define (assoc-update xs)
- (cond [(null? xs) (list (mcons x v))]
- [(eq? x (mcar (car xs))) (cons (mcons x v) (cdr xs))]
- [else (cons (car xs) (assoc-update (cdr xs)))]))
- (environ (assoc-update (environ-xs xs))))
-
-; --------- ;
-; Ewaluacja ;
-; --------- ;
-
-(struct clo (id e env) #:transparent)
-(struct let-var (v) #:transparent)
-
-(define (value? v)
- (or (number? v)
- (boolean? v)
- (string? v)
- (and (pair? v) (value? (car v)) (value? (cdr v)))
- (null? v)
- (clo? v)
- (blackhole? v)))
-
-(define (op->proc op)
- (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo]
- ['= =] ['> >] ['>= >=] ['< <] ['<= <=]
- ['and (lambda (x y) (and x y))]
- ['or (lambda (x y) (or x y))]
- ['eq? eq?]
- [_ false]))
-
-(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 (let-var (eval-env e1 env)) env))]
- [(letrec-expr x e1 e2)
- (let* ([new-env (env-add x (blackhole) env)]
- [v (eval-env e1 new-env)])
- (begin
- (env-update! x v new-env)
- (eval-env e2 new-env)))]
- [(var-expr x) (let ((f (env-lookup x env)))
- (if (let-var? f) (let-var-v f) f))]
- [(if-expr eb et ef) (if (eval-env eb env)
- (eval-env et env)
- (eval-env ef env))]
- [(cons-expr e1 e2) (cons (eval-env e1 env)
- (eval-env e2 env))]
- [(car-expr e) (car (eval-env e env))]
- [(cdr-expr e) (cdr (eval-env e env))]
- [(null-expr) null]
- [(null?-expr e) (null? (eval-env e env))]
- [(lam x e) (clo x e env)]
- [(app f e)
- (let ([vf (eval-env f env)]
- [ve (eval-env e env)])
- (match vf [(clo x body fun-env)
- (eval-env body (env-add x ve (merge-let-vars env fun-env)))]))]))
-
-(define (merge-let-vars env1 env2)
- (define (iter xs env)
- (if (null? xs)
- env
- (let ((cur-var (car xs)))
- (if (let-var? (mcdr cur-var))
- (iter (cdr xs) (env-add (mcar cur-var) (mcdr cur-var) env))
- (iter (cdr xs) env)))))
- (iter (reverse (environ-xs env2)) env1))
-
-(define (eval e) (eval-env e env-empty))
-
-; ---------------------------------------------------------------- !!!
-
-(struct skip () #:transparent)
-(struct assign (x e) #:transparent)
-(struct if-cmd (eb ct cf) #:transparent)
-(struct while (eb cb) #:transparent)
-(struct comp (c1 c2) #:transparent)
-
-(define (cmd? c)
- (match c
- [(skip) true]
- [(assign x e) (and (symbol? x) (expr? e))]
- [(if-cmd eb ct cf) (and (expr? eb) (cmd? ct) (cmd? cf))]
- [(while eb ct) (and (expr? eb) (cmd? ct))]
- [else false]))
-
-(define (parse-while q)
- (cond
- [(eq? q 'skip) (skip)]
- [(null? q) (skip)]
- [(and (list? q) (= (length q) 3) (eq? (second q) ':=))
- (assign (first q)
- (parse (third q)))]
- [(and (list? q) (= (length q) 4) (eq? (car q) 'if))
- (if-cmd (parse (second q))
- (parse-while (third q))
- (parse-while (fourth q)))]
- [(and (list? q) (= (length q) 3) (eq? (car q) 'while))
- (while (parse (second q))
- (parse-while (third q)))]
- [(and (list? q) (= (length q) 2))
- (comp (parse-while (first q))
- (parse-while (second q)))]
- [(and (list? q) (> (length q) 2))
- (comp (parse-while (first q))
- (parse-while (cdr q)))]
- [else (error "while parse error")]))
-
-(define (eval-while e env)
- (match e
- [(skip) env]
- [(assign x e)
- (env-update x (eval-env e env) env)]
- [(if-cmd eb ct cf)
- (if (eval-env eb env)
- (eval-while ct env)
- (eval-while cf env))]
- [(while eb cb)
- (if (eval-env eb env)
- (eval-while e (eval-while cb env))
- env)]
- [(comp c1 c2) (eval-while c2 (eval-while c1 env))]))
-
-; zakladamy, ze program startuje z pamiecia w ktorej
-; aktwna jest zmienna t
-(define WHILE_FACT
- '{(i := 1)
- (while (> t 0)
- {(i := (* i t))
- (t := (- t 1))})})
-
-(define (fact n)
- (let* ([init-env (env-add 't n env-empty)]
- [final-env
- (eval-while (parse-while WHILE_FACT) init-env)])
- (env-lookup 'i final-env)))
-
-(define prog1 '{(x := 5)
- (f := (let [x 50] (lambda (y) (+ x y))))
- (x := 10)
- (z := (f 0))})
\ No newline at end of file diff --git a/Semestr 2/racket/leftist.rkt b/Semestr 2/racket/leftist.rkt deleted file mode 100644 index 78319e4..0000000 --- a/Semestr 2/racket/leftist.rkt +++ /dev/null @@ -1,105 +0,0 @@ -#lang racket - -(provide make-elem elem-priority elem-val empty-heap heap-insert heap-merge heap-min heap-pop heap-empty?) - -(define (inc n) - (+ n 1)) - -;;; tagged lists -(define (tagged-list? len-xs tag xs) - (and (list? xs) - (= len-xs (length xs)) - (eq? (first xs) tag))) - -;;; ordered elements -(define (make-elem pri val) - (cons pri val)) - -(define (elem-priority x) - (car x)) - -(define (elem-val x) - (cdr x)) - -;;; leftist heaps (after Okasaki) - -;; data representation -(define leaf 'leaf) - -(define (leaf? h) (eq? 'leaf h)) - -(define (hnode? h) - (and (tagged-list? 5 'hnode h) - (natural? (caddr h)))) - -(define (make-hnode elem heap-a heap-b) - (if (< (rank heap-a) (rank heap-b)) - (list 'hnode elem (+ (rank heap-a) 1) heap-b heap-a) - (list 'hnode elem (+ (rank heap-b) 1) heap-a heap-b))) - -(define (hnode-elem h) - (second h)) - -(define (hnode-left h) - (fourth h)) - -(define (hnode-right h) - (fifth h)) - -(define (hnode-rank h) - (third h)) - -(define (hord? p h) - (or (leaf? h) - (<= p (elem-priority (hnode-elem h))))) - -(define (heap? h) - (or (leaf? h) - (and (hnode? h) - (heap? (hnode-left h)) - (heap? (hnode-right h)) - (<= (rank (hnode-right h)) - (rank (hnode-left h))) - (= (rank h) (inc (rank (hnode-right h)))) - (hord? (elem-priority (hnode-elem h)) - (hnode-left h)) - (hord? (elem-priority (hnode-elem h)) - (hnode-right h))))) - -(define (rank h) - (if (leaf? h) - 0 - (hnode-rank h))) - -;; operations - -(define empty-heap leaf) - -(define (heap-empty? h) - (leaf? h)) - -(define (heap-insert elt heap) - (heap-merge heap (make-hnode elt leaf leaf))) - -(define (heap-min heap) - (hnode-elem heap)) - -(define (heap-pop heap) - (heap-merge (hnode-left heap) (hnode-right heap))) - -(define (heap-merge h1 h2) - (cond - [(leaf? h1) h2] - [(leaf? h2) h1] - [else (let ((h1-min (heap-min h1)) - (h2-min (heap-min h2))) - (if (< (elem-priority h1-min) (elem-priority h2-min)) - (make-hnode h1-min (heap-merge (hnode-left h1) (hnode-right h1)) h2) - (make-hnode h2-min h1 (heap-merge (hnode-left h2) (hnode-right h2)))))])) - -;;; check that a list is sorted (useful for longish lists) -(define (sorted? xs) - (cond [(null? xs) true] - [(null? (cdr xs)) true] - [(<= (car xs) (cadr xs)) (sorted? (cdr xs))] - [else false])) diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.dep b/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.dep deleted file mode 100644 index 6e0cfbb..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("7.6" racket ("f0a57e86828cdab35eaad454d5deb80353172518" . "8314027ed4c1c6fd9c412af77103e94790e59dd2") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.zo b/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.zo Binary files differdeleted file mode 100644 index 748fec9..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/prop_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.dep b/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.dep deleted file mode 100644 index 0926afc..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("7.6" racket ("e0347fa7e89f59bc97c197db02b440f666222428" . "8314027ed4c1c6fd9c412af77103e94790e59dd2") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.zo b/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.zo Binary files differdeleted file mode 100644 index eccc7f7..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/props_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.dep b/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.dep deleted file mode 100644 index 9810b4c..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("7.6" racket ("ae3a6974cdd4582f480927d9968aad2f495b7fc4" . "33b0c09c14dce6a2115d810ac3d0f25a9dce3205") #"C:\\Users\\franc\\Documents\\lista5\\props.rkt" (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.zo b/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.zo Binary files differdeleted file mode 100644 index ca1ab20..0000000 --- a/Semestr 2/racket/lista5/compiled/drracket/errortrace/solution_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.dep b/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.dep deleted file mode 100644 index 0926afc..0000000 --- a/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.dep +++ /dev/null @@ -1 +0,0 @@ -("7.6" racket ("e0347fa7e89f59bc97c197db02b440f666222428" . "8314027ed4c1c6fd9c412af77103e94790e59dd2") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) diff --git a/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.zo b/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.zo Binary files differdeleted file mode 100644 index eccc7f7..0000000 --- a/Semestr 2/racket/lista5/julita/compiled/drracket/errortrace/props_rkt.zo +++ /dev/null diff --git a/Semestr 2/racket/lista5/julita/props.rkt b/Semestr 2/racket/lista5/julita/props.rkt deleted file mode 100644 index 204b108..0000000 --- a/Semestr 2/racket/lista5/julita/props.rkt +++ /dev/null @@ -1,52 +0,0 @@ -#lang racket - -(provide conj conj-left conj-right conj? - disj disj-left disj-right disj? - neg neg-subf neg? - var?) - - -(define (conj p q) - (list 'conj p q)) - -(define (conj-left f) - (second f)) - -(define (conj-right f) - (third f)) - -(define (conj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'conj (car t)))) - - -(define (disj p q) - (list 'disj p q)) - -(define (disj-left f) - (second f)) - -(define (disj-right f) - (third f)) - -(define (disj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'disj (car t)))) - - -(define (neg x) - (list 'neg x)) - -(define (neg-subf x) - (second x)) - -(define (neg? t) - (and (list? t) - (= 2 (length t)) - (eq? 'neg (car t)))) - - -(define (var? t) - (symbol? t)) diff --git a/Semestr 2/racket/lista5/julita/solution.bak b/Semestr 2/racket/lista5/julita/solution.bak deleted file mode 100644 index b3dda94..0000000 --- a/Semestr 2/racket/lista5/julita/solution.bak +++ /dev/null @@ -1,164 +0,0 @@ -#lang racket - -;;Praca grupowa: -;;Dawid Holewa -;;Julita Osman -;;Aleksandra Stępniewska - -(require "props.rkt") -(provide falsifiable-cnf?) - -;Ponieważ formuła w cnf to konjunkcja klauzul -;a klauzula to alternatywa literałów -;to formuła w tej postaci jest tautologią -;wtedy i tylko wtedy gdy -;wszystkie klauzule w niej występujace sa zawsze prawdziwe (też są tautologiami) -;w przeciwnym razie, formulę taką da się zanegować; -;zatem nasz pomysł polega na tym, aby -;1)sprawdzic czy formula jest tautologia -;2)jesli tak to zwracamy fałsz -;3)wpp. pierwsza z klauzul, która nie jest tautologia -;(zatem jest mozliwa do zanegowania i jednocześnie neguje cała formułe w cnf) -;"przesuwamy" na początek listy reprezentującej cnf - -;dodatkowo to czy klauzula jest tautologią nie musimy sprawdzać wykonując wartościowanie -;możemy skorzystać z własności alternatywy -;klauzula bedzię zawsze pawdziwa tylko jeśli conajmniej jedna ze zmiennych występuje jednoczesnie ze swoją negacją - -;Falsifiable, która sprawdza każde wartościowania -;sprawdza 2^(ilosc zmiennych w całym wyrażeniu) wartosciowań, -;podczas gdy -;falsifiable, która opiera się na strukturze cnf -;przechodzi po cnf, aż do napotkania pierwszej -;mozliwej do zanegowania klauzuli -;zatem w najroszym przypadku przejdziemy po całym cnf -;ale zawsze wartosciowania negujacego formule szukamy tylko dla jedenej klauzuli -;zauważmy,ze jeśli formuła jest tautologią to oszczędzamy bardzo dużo czasu nie rozpartując wszystkich wartosciowań, tylko wypisujac odrazu falsz - -;Ta druga jest więc efektywniejsza - -(define (lit? f);; a lub ~a - (or (var? f) ;;a - (and (neg? f);;~a - (var? (neg-subf f))))) - -(define (lit-pos v) - v) - -(define (lit-neg v) - (neg v)) - -(define (lit-var l) ;;a-->a ~a-->a - (if (var? l) - l - (neg-subf l))) - -(define (lit-pos? l) - (var? l)) - -(define (to-nnf f) - (cond - [(var? f) (lit-pos f)] - [(neg? f) (to-nnf-neg (neg-subf f))] - [(conj? f) (conj (to-nnf (conj-left f)) - (to-nnf (conj-right f)))] - [(disj? f) (disj (to-nnf (disj-left f)) - (to-nnf (disj-right f)))])) - -(define (to-nnf-neg f) - (cond - [(var? f) (lit-neg f)] - [(neg? f) (to-nnf (neg-subf f))] - [(conj? f) (disj (to-nnf-neg (conj-left f)) - (to-nnf-neg (conj-right f)))] - [(disj? f) (conj (to-nnf-neg (disj-left f)) - (to-nnf-neg (disj-right f)))])) - -(define (mk-cnf xss) - (cons 'cnf xss)) - -(define (clause? f) - (and (list? f) - (andmap lit? f))) - -(define (cnf? f) - (and (pair? f) - (eq? 'cnf (car f)) - (list? (cdr f)) - (andmap clause? (cdr f)))) - -(define (to-cnf f) - (define (join xss yss) - (apply append (map (lambda (xs) (map (lambda (ys) (append xs ys)) yss)) xss))) - - (define (go f) - (cond - [(lit? f) (list (list f))] - [(conj? f) (append (go (conj-left f)) - (go (conj-right f)))] - [(disj? f) (join (go (disj-left f)) - (go (disj-right f)))])) - (mk-cnf (go f))) - - -(define (contain-both-literals? claus) - (define (aux to-check) - (cond [(empty? to-check) #f] - [(neg? (car to-check)) - (if (memq (neg-subf (car to-check)) claus) - #t - (aux (cdr to-check)))] - [else (aux (cdr to-check))])) - (aux claus)) - - -;; sprawdza czy ktorakolwiek z klauzul z listy reprezentujacej cnf -;; zawiera chociaz jedną parę zmiennej i jej negacji -;; zwraca liste pusta jesli cnf jest tautologia -;; zwraca liste z pierwsza klauzule nie bedaca tautologia "przesunieta" na poczatek (possible-to-neg) -(define (has-both big-set) - (define (possible-to-neg big-set x) ;;przesuwa x-ty element listy big-set na poczatek - (define x-ty (list-ref big-set x)) - (append (list x-ty) (remove x-ty big-set))) - (define (aux iter big-set) - (if (= iter (length big-set)) - '() - (if (contain-both-literals? (list-ref big-set iter)) ;;sprawdzamy czy iter klauzula cnf ma wystapienie a i ~a jednoczesnie - (aux (+ iter 1) big-set) - (possible-to-neg big-set iter)))) - (aux 0 (cdr big-set))) ;;(cdr big-set) bo to cnf czyli pierwszy element listy to edykieta 'cnf - - -(define (falsifiable-cnf? t) - (define tt (to-cnf (to-nnf t))) - (define f (has-both tt)) - (if (empty? f) - #f - (find-valuation f))) - - -(define (valuate f sigma) - (define (insigma-proc lista result) - (cond [(null? lista) result] - [(insigma-proc (cdr lista) (append result (list (lit-var(caar lista)))))])) - ;; insigma ---> lista zmiennych z wartosciowania pierwszej klauzuli: - (define insigma (insigma-proc sigma '())) - (define (aux insigma otherclause sigma) - (cond [(null? otherclause) sigma] - [(if (memq (lit-var (car otherclause)) insigma) - (aux insigma (cdr otherclause) sigma) - (if(neg? (car otherclause)) - (aux (append insigma (list(car otherclause))) - (cdr otherclause) - (append sigma (list(list (lit-var(car otherclause)) 1)))) - (aux (append insigma (list(car otherclause))) - (cdr otherclause) - (append sigma (list(list (car otherclause) 0))))))])) - (if (empty? f) - sigma - (valuate (cdr f) - (aux insigma (car f) sigma)))) - -(define (find-valuation f) - (valuate f '())) - diff --git a/Semestr 2/racket/lista5/julita/solution.rkt b/Semestr 2/racket/lista5/julita/solution.rkt deleted file mode 100644 index da87bf9..0000000 --- a/Semestr 2/racket/lista5/julita/solution.rkt +++ /dev/null @@ -1,164 +0,0 @@ -#lang racket - -;;Praca grupowa: -;;Dawid Holewa -;;Julita Osman -;;Aleksandra Stępniewska - -(require "props.rkt") -(provide falsifiable-cnf?) - -;Ponieważ formuła w cnf to konjunkcja klauzul -;a klauzula to alternatywa literałów -;to formuła w tej postaci jest tautologią -;wtedy i tylko wtedy gdy -;wszystkie klauzule w niej występujace sa zawsze prawdziwe (też są tautologiami) -;w przeciwnym razie, formulę taką da się zanegować; -;zatem nasz pomysł polega na tym, aby -;1)sprawdzic czy formula jest tautologia -;2)jesli tak to zwracamy fałsz -;3)wpp. pierwsza z klauzul, która nie jest tautologia -;(zatem jest mozliwa do zanegowania i jednocześnie neguje cała formułe w cnf) -;"przesuwamy" na początek listy reprezentującej cnf - -;dodatkowo to czy klauzula jest tautologią nie musimy sprawdzać wykonując wartościowanie -;możemy skorzystać z własności alternatywy -;klauzula bedzię zawsze pawdziwa tylko jeśli conajmniej jedna ze zmiennych występuje jednoczesnie ze swoją negacją - -;Falsifiable, która sprawdza każde wartościowania -;sprawdza 2^(ilosc zmiennych w całym wyrażeniu) wartosciowań, -;podczas gdy -;falsifiable, która opiera się na strukturze cnf -;przechodzi po cnf, aż do napotkania pierwszej -;mozliwej do zanegowania klauzuli -;zatem w najroszym przypadku przejdziemy po całym cnf -;ale zawsze wartosciowania negujacego formule szukamy tylko dla jedenej klauzuli -;zauważmy,ze jeśli formuła jest tautologią to oszczędzamy bardzo dużo czasu nie rozpartując wszystkich wartosciowań, tylko wypisujac odrazu falsz - -;Ta druga jest więc efektywniejsza - -(define (lit? f);; a lub ~a - (or (var? f) ;;a - (and (neg? f);;~a - (var? (neg-subf f))))) - -(define (lit-pos v) - v) - -(define (lit-neg v) - (neg v)) - -(define (lit-var l) ;;a-->a ~a-->a - (if (var? l) - l - (neg-subf l))) - -(define (lit-pos? l) - (var? l)) - -(define (to-nnf f) - (cond - [(var? f) (lit-pos f)] - [(neg? f) (to-nnf-neg (neg-subf f))] - [(conj? f) (conj (to-nnf (conj-left f)) - (to-nnf (conj-right f)))] - [(disj? f) (disj (to-nnf (disj-left f)) - (to-nnf (disj-right f)))])) - -(define (to-nnf-neg f) - (cond - [(var? f) (lit-neg f)] - [(neg? f) (to-nnf (neg-subf f))] - [(conj? f) (disj (to-nnf-neg (conj-left f)) - (to-nnf-neg (conj-right f)))] - [(disj? f) (conj (to-nnf-neg (disj-left f)) - (to-nnf-neg (disj-right f)))])) - -(define (mk-cnf xss) - (cons 'cnf xss)) - -(define (clause? f) - (and (list? f) - (andmap lit? f))) - -(define (cnf? f) - (and (pair? f) - (eq? 'cnf (car f)) - (list? (cdr f)) - (andmap clause? (cdr f)))) - -(define (to-cnf f) - (define (join xss yss) - (apply append (map (lambda (xs) (map (lambda (ys) (append xs ys)) yss)) xss))) - - (define (go f) - (cond - [(lit? f) (list (list f))] - [(conj? f) (append (go (conj-left f)) - (go (conj-right f)))] - [(disj? f) (join (go (disj-left f)) - (go (disj-right f)))])) - (mk-cnf (go f))) - - -(define (contain-both-literals? claus) - (define (aux to-check) - (cond [(empty? to-check) #f] - [(neg? (car to-check)) - (if (memq (neg-subf (car to-check)) claus) - #t - (aux (cdr to-check)))] - [else (aux (cdr to-check))])) - (aux claus)) - - -;; sprawdza czy ktorakolwiek z klauzul z listy reprezentujacej cnf -;; zawiera chociaz jedną parę zmiennej i jej negacji -;; zwraca liste pusta jesli cnf jest tautologia -;; zwraca liste z pierwsza klauzule nie bedaca tautologia "przesunieta" na poczatek (possible-to-neg) -(define (has-both big-set) - (define (possible-to-neg big-set x) ;;przesuwa x-ty element listy big-set na poczatek - (define x-ty (list-ref big-set x)) - (append (list x-ty) (remove x-ty big-set))) - (define (aux iter big-set) - (if (= iter (length big-set)) - '() - (if (contain-both-literals? (list-ref big-set iter)) ;;sprawdzamy czy iter klauzula cnf ma wystapienie a i ~a jednoczesnie - (aux (+ iter 1) big-set) - (possible-to-neg big-set iter)))) - (aux 0 (cdr big-set))) ;;(cdr big-set) bo to cnf czyli pierwszy element listy to edykieta 'cnf - - -(define (falsifiable-cnf? t) - (define tt (to-cnf (to-nnf t))) - (define f (has-both tt)) - (if (empty? f) - #f - (find-valuation f))) - - -(define (valuate f sigma) - (define (insigma-proc lista result) - (cond [(null? lista) result] - [(insigma-proc (cdr lista) (append result (list (lit-var(caar lista)))))])) - ;; insigma ---> lista zmiennych z wartosciowania pierwszej klauzuli: - (define insigma (insigma-proc sigma '())) - (define (aux insigma otherclause sigma) - (cond [(null? otherclause) sigma] - [(if (memq (lit-var (car otherclause)) insigma) - (aux insigma (cdr otherclause) sigma) - (if(neg? (car otherclause)) - (aux (append insigma (list(car otherclause))) - (cdr otherclause) - (append sigma (list(list (lit-var(car otherclause)) true)))) - (aux (append insigma (list(car otherclause))) - (cdr otherclause) - (append sigma (list(list (car otherclause) false))))))])) - (if (empty? f) - sigma - (valuate (cdr f) - (aux insigma (car f) sigma)))) - -(define (find-valuation f) - (valuate f '())) - diff --git a/Semestr 2/racket/lista5/prop.rkt b/Semestr 2/racket/lista5/prop.rkt deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/lista5/prop.rkt +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/lista5/props.bak b/Semestr 2/racket/lista5/props.bak deleted file mode 100644 index 1a5659a..0000000 --- a/Semestr 2/racket/lista5/props.bak +++ /dev/null @@ -1,71 +0,0 @@ -#lang racket - -(provide var? - neg? - conj? - disj? - conj - disj - neg - conj-left - conj-right - disj-right - disj-left - neg-subf) -; (require "solution.rkt") - -(define (var? t) (symbol? t)) - -(define (neg? t) - (and (list? t) - (= 2 (length t)) - (eq? 'neg (car t)))) - -(define (conj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'conj (car t)))) - -(define (disj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'disj (car t)))) - -(define (lit? t) - (or (var? t) - (and (neg? t) - (var? (neg-subf t))))) - -(define (conj left right) - (list 'conj left right)) - -(define (disj left right) - (list 'disj left right)) - -(define (neg f) - (list 'neg f)) - -(define (conj-left f) - (if (conj? f) - (cadr f) - (error "Złe dane ze znacznikiem -- CONJ-LEFT" f))) - -(define (conj-right f) - (if (conj? f) - (caddr f) - (error "Złe dane ze znacznikiem -- CONJ-RIGHT" f))) - -(define (disj-left f) - (if (disj? f) - (cadr f) - (error "Złe dane ze znacznikiem -- DISJ-LEFT" f))) - -(define (disj-right f) - (if (disj? f) - (caddr f) - (error "Złe dane ze znacznikiem -- DISJ-RIGHT" f))) - -(define (neg-subf f) - (if (neg? f) - (cadr f) - (error "Złe dane ze znacznikiem -- NEG-FORM" f))) diff --git a/Semestr 2/racket/lista5/props.rkt b/Semestr 2/racket/lista5/props.rkt deleted file mode 100644 index 204b108..0000000 --- a/Semestr 2/racket/lista5/props.rkt +++ /dev/null @@ -1,52 +0,0 @@ -#lang racket - -(provide conj conj-left conj-right conj? - disj disj-left disj-right disj? - neg neg-subf neg? - var?) - - -(define (conj p q) - (list 'conj p q)) - -(define (conj-left f) - (second f)) - -(define (conj-right f) - (third f)) - -(define (conj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'conj (car t)))) - - -(define (disj p q) - (list 'disj p q)) - -(define (disj-left f) - (second f)) - -(define (disj-right f) - (third f)) - -(define (disj? t) - (and (list? t) - (= 3 (length t)) - (eq? 'disj (car t)))) - - -(define (neg x) - (list 'neg x)) - -(define (neg-subf x) - (second x)) - -(define (neg? t) - (and (list? t) - (= 2 (length t)) - (eq? 'neg (car t)))) - - -(define (var? t) - (symbol? t)) diff --git a/Semestr 2/racket/lista5/skrr/solution.bak b/Semestr 2/racket/lista5/skrr/solution.bak deleted file mode 100644 index 72c7f36..0000000 --- a/Semestr 2/racket/lista5/skrr/solution.bak +++ /dev/null @@ -1,135 +0,0 @@ -#lang racket - -(provide falsifiable-cnf?) -(require "props.rkt") - -(define (prop? f) - (or (var? f) - (and (neg? f) - (prop? (neg-subf f))) - (and (disj? f) - (prop? (disj-left f)) - (prop? (disj-right f))) - (and (conj? f) - (prop? (conj-left f)) - (prop? (conj-right f))))) - -(define (lit-var f) - (cond [(var? f) f] - [(neg? f) (neg-subf f)] - [else (error "Złe dane ze znacznikiem -- LIT-VAR" f)])) - -(define (free-vars f) - (cond [(null? f) null] - [(var? f) (list f)] - [(neg? f) (free-vars (neg-subf f))] - [(conj? f) (append (free-vars (conj-left f)) - (free-vars (conj-right f)))] - [(disj? f) (append (free-vars (disj-left f)) - (free-vars (disj-right f)))] - [else (error "Zła formula -- FREE-VARS" f)])) - -(define (gen-vals xs) - (if (null? xs) - (list null) - (let* - ((vss (gen-vals (cdr xs))) - (x (car xs)) - (vst (map (λ (vs) (cons (list x true) vs)) vss)) - (vsf (map (λ (vs) (cons (list x false) vs)) vss))) - (append vst vsf)))) - -(define (eval-formula f evaluation) - (cond [(var? f) - (let ((val (assoc f evaluation))) - (if (not val) - (error "Zmienna wolna nie wystepuje w wartościowaniu -- EVAL-FORMULA" f evaluation) - (cadr val)))] - [(neg? f) (not (eval-formula (neg-subf f) evaluation))] - [(disj? f) (or (eval-formula (disj-left f) evaluation) - (eval-formula (disj-right f) evaluation))] - [(conj? f) (and (eval-formula (conj-left f) evaluation) - (eval-formula (conj-right f) evaluation))] - [else (error "Zła formuła -- EVAL-FORMULA" f evaluation)])) - -(define (falsifiable-eval? f) - (let* ((evaluations (gen-vals (free-vars f))) - (results (map (λ (evaluation) (eval-formula f evaluation)) evaluations))) - (ormap false? results))) - -(define (nff? f) - (cond [(lit? f) true] - [(neg? f) false] - [(conj? f) (and (nff? (conj-left f)) - (nff? (conj-right f)))] - [(disj? f) (and (nff? (disj-left f)) - (nff? (disj-right f)))] - [else (error "Zła formuła -- NFF?" f)])) - -(define (convert-to-nnf f) - (cond [(lit? f) f] - [(neg? f) (convert-negation (neg-subf f))] - [(conj? f) (conj (convert-to-nnf (conj-left f)) - (convert-to-nnf (conj-right f)))] - [(disj? f) (disj (convert-to-nnf (disj-left f)) - (convert-to-nnf (disj-right f)))] - [else (error "Zła formuła -- CONVERT" f)])) - -(define (convert-negation f) - (cond [(lit? f) - (if (var? f) - (neg f) - (neg-subf f))] - [(neg? f) (convert-to-nnf (neg-subf f))] - [(conj? f) (disj (convert-negation (conj-left f)) - (convert-negation (conj-right f)))] - [(disj? f) (conj (convert-negation (disj-left f)) - (convert-negation (disj-right f)))] - [else (error "Zła formuła -- CONVERT-NEGATION" f)])) - -(define (clause? x) - (and (list? x) - (andmap lit? x))) - -(define (clause-empty? x) - (and (clause? x) - (null? x))) - -(define (cnf? x) - (and (list? x) - (andmap clause? x))) - -(define (flatmap proc seq) - (foldl append null (map proc seq))) - -(define (convert-to-cnf f) - (define (convert f) - (cond [(lit? f) (list (list f))] - [(conj? f) (append (convert-to-cnf (conj-left f)) - (convert-to-cnf (conj-right f)))] - [(disj? f) - (let ((clause-left (convert-to-cnf (disj-left f))) - (clause-right (convert-to-cnf (disj-right f)))) - (flatmap (λ (clause) - (map (λ (clause2) - (append clause2 clause)) clause-left)) - clause-right))])) - (convert (convert-to-nnf f))) - -(define (falsifiable-clause? clause) - (cond [(clause-empty? clause) true] - [(lit? (findf (λ (l) (equal? - l - (convert-to-nnf (neg (car clause))))) - clause)) false] - [else (falsifiable-clause? (cdr clause))])) - -(define (falsifiable-cnf? f) - (define (neg-value lit) - (if (var? lit) - (list lit false) - (list (neg-subf lit) true))) - (ormap (λ (clause) (if (falsifiable-clause? clause) - (map neg-value clause) - false)) - (convert-to-cnf f)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista5/skrr/solution.rkt b/Semestr 2/racket/lista5/skrr/solution.rkt deleted file mode 100644 index e8efbc9..0000000 --- a/Semestr 2/racket/lista5/skrr/solution.rkt +++ /dev/null @@ -1,88 +0,0 @@ -#lang racket - -(require "props.rkt") -(provide falsifiable-cnf?) - -(define (lit? f) - (or (var? f) - (and (neg? f) - (var? (neg-subf f))))) - -(define (lit-pos v) - v) - -(define (lit-neg v) - (neg v)) - -(define (lit-var l) - (if (var? l) - l - (neg-subf l))) - -(define (lit-pos? l) - (var? l)) - -(define (to-nnf f) - (cond - [(var? f) (lit-pos f)] - [(neg? f) (to-nnf-neg (neg-subf f))] - [(conj? f) (conj (to-nnf (conj-left f)) - (to-nnf (conj-right f)))] - [(disj? f) (disj (to-nnf (disj-left f)) - (to-nnf (disj-right f)))])) - -(define (to-nnf-neg f) - (cond - [(var? f) (lit-neg f)] - [(neg? f) (to-nnf (neg-subf f))] - [(conj? f) (disj (to-nnf-neg (conj-left f)) - (to-nnf-neg (conj-right f)))] - [(disj? f) (conj (to-nnf-neg (disj-left f)) - (to-nnf-neg (disj-right f)))])) - -(define (mk-cnf xss) - (cons 'cnf xss)) - -(define (clause? f) - (and (list? f) - (andmap lit? f))) - -(define (cnf? f) - (and (pair? f) - (eq? 'cnf (car f)) - (list? (cdr f)) - (andmap clause? (cdr f)))) - -(define (to-cnf f) - (define (join xss yss) - (apply append (map (lambda (xs) (map (lambda (ys) (append xs ys)) yss)) xss))) - (define (go f) - (cond - [(lit? f) (list (list f))] - [(conj? f) (append (go (conj-left f)) - (go (conj-right f)))] - [(disj? f) (join (go (disj-left f)) - (go (disj-right f)))])) - (mk-cnf (go f))) - -(define (clause-empty? x) - (and (clause? x) - (null? x))) - -(define (falsifiable-clause? clause) - (cond [(clause-empty? clause) true] - [(lit? (findf (λ (l) (equal? - l - (to-nnf (neg (car clause))))) - clause)) false] - [else (falsifiable-clause? (cdr clause))])) - -(define (falsifiable-cnf? f) - (define (neg-value lit) - (if (var? lit) - (list lit false) - (list (neg-subf lit) true))) - (ormap (λ (clause) (if (falsifiable-clause? clause) - (map neg-value clause) - false)) - (convert-to-cnf f)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista5/sol2.rkt b/Semestr 2/racket/lista5/sol2.rkt deleted file mode 100644 index d037472..0000000 --- a/Semestr 2/racket/lista5/sol2.rkt +++ /dev/null @@ -1,90 +0,0 @@ -#lang racket -(provide falsifiable-cnf?) (require "props.rkt") - - -(define (falsifiable-cnf? p) - ;literał - (define (lit? p) - (or (var? p) - (and (neg? p) (var? (neg-subf p))) - )) - - (define (lit-pos? p) - (if (lit? p) - (var? p) - (error "not a literal" p) - )) - - (define (lit-var p) - (cond - [(not (lit? p)) (error "not a literal" p)] - [(lit-pos? p) p] - [else (neg-subf p)] - )) - - (define (contr p) - (if (lit? p) - (if (neg? p) (neg-subf p) (neg p)) - (error "not a literal" p) - )) - - ;konwertowanie - (define (convert-to-cnf p) - (define (convert-to-nnf p) - (cond - [(lit? p) p] - [(and (neg? p) (conj? (neg-subf p))) - (let ((A (neg-subf p))) - (disj (convert-to-nnf (neg (conj-left A))) (convert-to-nnf (neg (conj-right A)))))] - [(and (neg? p) (disj? (neg-subf p))) - (let ((A (neg-subf p))) - (conj (convert-to-nnf (neg (disj-left A))) (convert-to-nnf (neg (disj-right A)))))] - [(and (neg? p) (neg? (neg-subf p))) (convert-to-nnf (neg-subf (neg-subf p)))] - [(conj? p) (conj (convert-to-nnf (conj-right p)) (convert-to-nnf (conj-left p)))] - [(disj? p) (disj (convert-to-nnf (disj-right p)) (convert-to-nnf (disj-left p)))] - [else (error "not a proposition" p)])) - - (define (flatmap proc seq) - (foldr append null (map proc seq))) - - (define (merge a b) - (flatmap (lambda (c) (map (lambda (c2) (append c c2)) b)) a)) - - (define (convert p) - (cond - [(lit? p) (list (list p))] - [(conj? p) (append (convert (conj-left p)) (convert (conj-right p)))] - [(disj? p) (let* ((L (convert (disj-left p))) (R (convert (disj-right p)))) - (merge L R))] - [else (error "it should never be here" p)] - )) - - (map (lambda (c) (remove-duplicates c)) (convert (convert-to-nnf p)))) - - ;prawdziwa funkcja - (define cnf (convert-to-cnf p)) - - (define (falsifiable-clause? c) - (cond - [(null? c) #t] - [(eq? #f (member (contr (car c)) c)) (falsifiable-clause? (cdr c))] - [else #f] - )) - - (define (falsified-clause c) - (if (null? c) - null - (cons (list (lit-var (car c)) (not (lit-pos? (car c)))) (falsified-clause (cdr c))) - )) - - (define (falsified-val p) - (cond - [(null? p) false] - [(falsifiable-clause? (car p)) (falsified-clause (car p))] - [else (falsified-val (cdr p))] - ) - ) - (falsified-val cnf)) - - -;złożoność wykładnicza tak jak falsible-eval ale często w praktyce szybsza jak nie ma za dużo alternatyw.
\ No newline at end of file diff --git a/Semestr 2/racket/lista5/solution.bak b/Semestr 2/racket/lista5/solution.bak deleted file mode 100644 index 72c7f36..0000000 --- a/Semestr 2/racket/lista5/solution.bak +++ /dev/null @@ -1,135 +0,0 @@ -#lang racket - -(provide falsifiable-cnf?) -(require "props.rkt") - -(define (prop? f) - (or (var? f) - (and (neg? f) - (prop? (neg-subf f))) - (and (disj? f) - (prop? (disj-left f)) - (prop? (disj-right f))) - (and (conj? f) - (prop? (conj-left f)) - (prop? (conj-right f))))) - -(define (lit-var f) - (cond [(var? f) f] - [(neg? f) (neg-subf f)] - [else (error "Złe dane ze znacznikiem -- LIT-VAR" f)])) - -(define (free-vars f) - (cond [(null? f) null] - [(var? f) (list f)] - [(neg? f) (free-vars (neg-subf f))] - [(conj? f) (append (free-vars (conj-left f)) - (free-vars (conj-right f)))] - [(disj? f) (append (free-vars (disj-left f)) - (free-vars (disj-right f)))] - [else (error "Zła formula -- FREE-VARS" f)])) - -(define (gen-vals xs) - (if (null? xs) - (list null) - (let* - ((vss (gen-vals (cdr xs))) - (x (car xs)) - (vst (map (λ (vs) (cons (list x true) vs)) vss)) - (vsf (map (λ (vs) (cons (list x false) vs)) vss))) - (append vst vsf)))) - -(define (eval-formula f evaluation) - (cond [(var? f) - (let ((val (assoc f evaluation))) - (if (not val) - (error "Zmienna wolna nie wystepuje w wartościowaniu -- EVAL-FORMULA" f evaluation) - (cadr val)))] - [(neg? f) (not (eval-formula (neg-subf f) evaluation))] - [(disj? f) (or (eval-formula (disj-left f) evaluation) - (eval-formula (disj-right f) evaluation))] - [(conj? f) (and (eval-formula (conj-left f) evaluation) - (eval-formula (conj-right f) evaluation))] - [else (error "Zła formuła -- EVAL-FORMULA" f evaluation)])) - -(define (falsifiable-eval? f) - (let* ((evaluations (gen-vals (free-vars f))) - (results (map (λ (evaluation) (eval-formula f evaluation)) evaluations))) - (ormap false? results))) - -(define (nff? f) - (cond [(lit? f) true] - [(neg? f) false] - [(conj? f) (and (nff? (conj-left f)) - (nff? (conj-right f)))] - [(disj? f) (and (nff? (disj-left f)) - (nff? (disj-right f)))] - [else (error "Zła formuła -- NFF?" f)])) - -(define (convert-to-nnf f) - (cond [(lit? f) f] - [(neg? f) (convert-negation (neg-subf f))] - [(conj? f) (conj (convert-to-nnf (conj-left f)) - (convert-to-nnf (conj-right f)))] - [(disj? f) (disj (convert-to-nnf (disj-left f)) - (convert-to-nnf (disj-right f)))] - [else (error "Zła formuła -- CONVERT" f)])) - -(define (convert-negation f) - (cond [(lit? f) - (if (var? f) - (neg f) - (neg-subf f))] - [(neg? f) (convert-to-nnf (neg-subf f))] - [(conj? f) (disj (convert-negation (conj-left f)) - (convert-negation (conj-right f)))] - [(disj? f) (conj (convert-negation (disj-left f)) - (convert-negation (disj-right f)))] - [else (error "Zła formuła -- CONVERT-NEGATION" f)])) - -(define (clause? x) - (and (list? x) - (andmap lit? x))) - -(define (clause-empty? x) - (and (clause? x) - (null? x))) - -(define (cnf? x) - (and (list? x) - (andmap clause? x))) - -(define (flatmap proc seq) - (foldl append null (map proc seq))) - -(define (convert-to-cnf f) - (define (convert f) - (cond [(lit? f) (list (list f))] - [(conj? f) (append (convert-to-cnf (conj-left f)) - (convert-to-cnf (conj-right f)))] - [(disj? f) - (let ((clause-left (convert-to-cnf (disj-left f))) - (clause-right (convert-to-cnf (disj-right f)))) - (flatmap (λ (clause) - (map (λ (clause2) - (append clause2 clause)) clause-left)) - clause-right))])) - (convert (convert-to-nnf f))) - -(define (falsifiable-clause? clause) - (cond [(clause-empty? clause) true] - [(lit? (findf (λ (l) (equal? - l - (convert-to-nnf (neg (car clause))))) - clause)) false] - [else (falsifiable-clause? (cdr clause))])) - -(define (falsifiable-cnf? f) - (define (neg-value lit) - (if (var? lit) - (list lit false) - (list (neg-subf lit) true))) - (ormap (λ (clause) (if (falsifiable-clause? clause) - (map neg-value clause) - false)) - (convert-to-cnf f)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista5/solution.rkt b/Semestr 2/racket/lista5/solution.rkt deleted file mode 100644 index 67964d8..0000000 --- a/Semestr 2/racket/lista5/solution.rkt +++ /dev/null @@ -1,140 +0,0 @@ -#lang racket - -(provide falsifiable-cnf?) -(require "props.rkt") - -(define (prop? f) - (or (var? f) - (and (neg? f) - (prop? (neg-subf f))) - (and (disj? f) - (prop? (disj-left f)) - (prop? (disj-right f))) - (and (conj? f) - (prop? (conj-left f)) - (prop? (conj-right f))))) - -(define (lit? t) - (or (var? t) - (and (neg? t) - (var? (neg-subf t))))) - -(define (lit-var f) - (cond [(var? f) f] - [(neg? f) (neg-subf f)] - [else (error "Złe dane ze znacznikiem -- LIT-VAR" f)])) - -(define (free-vars f) - (cond [(null? f) null] - [(var? f) (list f)] - [(neg? f) (free-vars (neg-subf f))] - [(conj? f) (append (free-vars (conj-left f)) - (free-vars (conj-right f)))] - [(disj? f) (append (free-vars (disj-left f)) - (free-vars (disj-right f)))] - [else (error "Zła formula -- FREE-VARS" f)])) - -(define (gen-vals xs) - (if (null? xs) - (list null) - (let* - ((vss (gen-vals (cdr xs))) - (x (car xs)) - (vst (map (λ (vs) (cons (list x true) vs)) vss)) - (vsf (map (λ (vs) (cons (list x false) vs)) vss))) - (append vst vsf)))) - -(define (eval-formula f evaluation) - (cond [(var? f) - (let ((val (assoc f evaluation))) - (if (not val) - (error "Zmienna wolna nie wystepuje w wartościowaniu -- EVAL-FORMULA" f evaluation) - (cadr val)))] - [(neg? f) (not (eval-formula (neg-subf f) evaluation))] - [(disj? f) (or (eval-formula (disj-left f) evaluation) - (eval-formula (disj-right f) evaluation))] - [(conj? f) (and (eval-formula (conj-left f) evaluation) - (eval-formula (conj-right f) evaluation))] - [else (error "Zła formuła -- EVAL-FORMULA" f evaluation)])) - -(define (falsifiable-eval? f) - (let* ((evaluations (gen-vals (free-vars f))) - (results (map (λ (evaluation) (eval-formula f evaluation)) evaluations))) - (ormap false? results))) - -(define (nff? f) - (cond [(lit? f) true] - [(neg? f) false] - [(conj? f) (and (nff? (conj-left f)) - (nff? (conj-right f)))] - [(disj? f) (and (nff? (disj-left f)) - (nff? (disj-right f)))] - [else (error "Zła formuła -- NFF?" f)])) - -(define (convert-to-nnf f) - (cond [(lit? f) f] - [(neg? f) (convert-negation (neg-subf f))] - [(conj? f) (conj (convert-to-nnf (conj-left f)) - (convert-to-nnf (conj-right f)))] - [(disj? f) (disj (convert-to-nnf (disj-left f)) - (convert-to-nnf (disj-right f)))] - [else (error "Zła formuła -- CONVERT" f)])) - -(define (convert-negation f) - (cond [(lit? f) - (if (var? f) - (neg f) - (neg-subf f))] - [(neg? f) (convert-to-nnf (neg-subf f))] - [(conj? f) (disj (convert-negation (conj-left f)) - (convert-negation (conj-right f)))] - [(disj? f) (conj (convert-negation (disj-left f)) - (convert-negation (disj-right f)))] - [else (error "Zła formuła -- CONVERT-NEGATION" f)])) - -(define (clause? x) - (and (list? x) - (andmap lit? x))) - -(define (clause-empty? x) - (and (clause? x) - (null? x))) - -(define (cnf? x) - (and (list? x) - (andmap clause? x))) - -(define (flatmap proc seq) - (foldl append null (map proc seq))) - -(define (convert-to-cnf f) - (define (convert f) - (cond [(lit? f) (list (list f))] - [(conj? f) (append (convert-to-cnf (conj-left f)) - (convert-to-cnf (conj-right f)))] - [(disj? f) - (let ((clause-left (convert-to-cnf (disj-left f))) - (clause-right (convert-to-cnf (disj-right f)))) - (flatmap (λ (clause) - (map (λ (clause2) - (append clause2 clause)) clause-left)) - clause-right))])) - (map (lambda (clause) (remove-duplicates clause)) (convert (convert-to-nnf f)))) - -(define (falsifiable-clause? clause) - (cond [(clause-empty? clause) true] - [(lit? (findf (λ (l) (equal? - l - (convert-to-nnf (neg (car clause))))) - clause)) false] - [else (falsifiable-clause? (cdr clause))])) - -(define (falsifiable-cnf? f) - (define (neg-value lit) - (if (var? lit) - (list lit false) - (list (neg-subf lit) true))) - (ormap (λ (clause) (if (falsifiable-clause? clause) - (map neg-value clause) - false)) - (convert-to-cnf f)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista5/xd.bak b/Semestr 2/racket/lista5/xd.bak deleted file mode 100644 index d814e10..0000000 --- a/Semestr 2/racket/lista5/xd.bak +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket - -(require "solution.rkt") - diff --git a/Semestr 2/racket/lista5/xd.rkt b/Semestr 2/racket/lista5/xd.rkt deleted file mode 100644 index 64ce78c..0000000 --- a/Semestr 2/racket/lista5/xd.rkt +++ /dev/null @@ -1,4 +0,0 @@ -#lang racket - -(require "solution.rkt") -(require "props.rkt") diff --git a/Semestr 2/racket/lista6/lista8/kappa.py b/Semestr 2/racket/lista6/lista8/kappa.py deleted file mode 100644 index f359d5c..0000000 --- a/Semestr 2/racket/lista6/lista8/kappa.py +++ /dev/null @@ -1,13 +0,0 @@ -import pylab
-
-a = int(input("podaj liczbe: "))
-b = int(input("podaj liczbe: "))
-
-x = range(-10, 11)
-y = []
-for i in x:
- y.append(a * i + b)
-pylab.plot(x, y)
-pylab.title('Wykres f(x) = a*x - b')
-pylab.grid(True)
-pylab.show()
diff --git a/Semestr 2/racket/lista6/lista8/zad1.bak b/Semestr 2/racket/lista6/lista8/zad1.bak deleted file mode 100644 index 0960f21..0000000 --- a/Semestr 2/racket/lista6/lista8/zad1.bak +++ /dev/null @@ -1,98 +0,0 @@ -#lang racket - -; Do let-env.rkt dodajemy wartosci boolowskie -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) ; <--------------------------------------- !!! - (and (expr? eb) (expr? et) (expr? ef))] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] ; <---------------------------- !!! - [(eq? q 'false) (const false)] ; <---------------------------- !!! - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(define (value? v) - (or (number? v) (boolean? v))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))])) - -(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))])) - -(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 diff --git a/Semestr 2/racket/lista6/lista8/zad1.rkt b/Semestr 2/racket/lista6/lista8/zad1.rkt deleted file mode 100644 index 1cd6b0b..0000000 --- a/Semestr 2/racket/lista6/lista8/zad1.rkt +++ /dev/null @@ -1,104 +0,0 @@ -#lang racket - -; Do let-env.rkt dodajemy wartosci boolowskie -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) ; <--------------------------------------- !!! - (and (expr? eb) (expr? et) (expr? ef))] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] ; <---------------------------- !!! - [(eq? q 'false) (const false)] ; <---------------------------- !!! - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'and)) - (if-expr (parse (second q)) - (parse (third q)) - (const false))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'or)) - (if-expr (parse (second q)) - (const true) - (parse (third q)))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(define (value? v) - (or (number? v) (boolean? v))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! - ['= =] ['> >] ['>= >=] ['< <] ['<= <=])) - -(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))])) - -(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 diff --git a/Semestr 2/racket/lista6/lista8/zad4.bak b/Semestr 2/racket/lista6/lista8/zad4.bak deleted file mode 100644 index 503099d..0000000 --- a/Semestr 2/racket/lista6/lista8/zad4.bak +++ /dev/null @@ -1,114 +0,0 @@ -#lang racket - -; Do boolean.rkt dodajemy pary -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) ; <------------------- !!! -(struct car-expr (e) #:transparent) ; <------------------- !!! -(struct cdr-expr (e) #:transparent) ; <------------------- !!! - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] ; <----------- !!! - [(car-expr e) (expr? e)] ; <---------------------------------- !!! - [(cdr-expr e) (expr? e)] ; <---------------------------------- !!! - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) ; <- !!! - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) ; <-- !!! - (car-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) ; <-- !!! - (cdr-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))])) - -(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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) ; <---------------- !!! - (eval-env e2 env))] - [(car-expr e) (car (eval-env e env))] ; <--------------------- !!! - [(cdr-expr e) (cdr (eval-env e env))])) ; <------------------- !!! - -(define (eval e) (eval-env e env-empty)) - -(define program - '(car (if true (cons 1 2) false))) - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad4.rkt b/Semestr 2/racket/lista6/lista8/zad4.rkt deleted file mode 100644 index 7934435..0000000 --- a/Semestr 2/racket/lista6/lista8/zad4.rkt +++ /dev/null @@ -1,118 +0,0 @@ -#lang racket - -; Do boolean.rkt dodajemy pary -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) ; <------------------- !!! -(struct car-expr (e) #:transparent) ; <------------------- !!! -(struct cdr-expr (e) #:transparent) ; <------------------- !!! -(struct is-pair (e) #:transparent) - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] ; <----------- !!! - [(car-expr e) (expr? e)] ; <---------------------------------- !!! - [(cdr-expr e) (expr? e)] ; <---------------------------------- !!! - [(is-pair e) (expr? e)] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) ; <- !!! - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'car)) ; <-- !!! - (car-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'cdr)) ; <-- !!! - (cdr-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'pair?)) - (is-pair (parse (second q)))])) - -(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))])) - -(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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) ; <---------------- !!! - (eval-env e2 env))] - [(car-expr e) (car (eval-env e env))] ; <--------------------- !!! - [(cdr-expr e) (cdr (eval-env e env))] ; <------------------- !!! - [(is-pair e) (cons? (eval-env e env))])) -(define (eval e) (eval-env e env-empty)) - -(define program - '(car (if true (cons 1 2) false))) - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad5.bak b/Semestr 2/racket/lista6/lista8/zad5.bak deleted file mode 100644 index 6f1f7b4..0000000 --- a/Semestr 2/racket/lista6/lista8/zad5.bak +++ /dev/null @@ -1 +0,0 @@ -#lang racket diff --git a/Semestr 2/racket/lista6/lista8/zad5.rkt b/Semestr 2/racket/lista6/lista8/zad5.rkt deleted file mode 100644 index 721f5bf..0000000 --- a/Semestr 2/racket/lista6/lista8/zad5.rkt +++ /dev/null @@ -1,151 +0,0 @@ -#lang racket - -; Do list.rkt dodajemy procedury -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct unop (op e) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) -(struct null-expr () #:transparent) -(struct null?-expr (e) #:transparent) -(struct app (f e) #:transparent) ; <------------------ !!! -(struct lam (id e) #:transparent) ; <------------------ !!! - - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] - [(null-expr) true] - [(null?-expr e) (expr? e)] - [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! - [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (null-expr)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) - (null?-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!! - (parse-lam (second q) (third q))] - [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!! - (parse-app q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (symbol? (first q))) - (unop (first q) (parse (second q)))])) - -(define (parse-app q) ; <----------------------------------------- !!! - (define (parse-app-accum q acc) - (cond [(= 1 (length q)) (app acc (parse (car q)))] - [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) - (parse-app-accum (cdr q) (parse (car q)))) - -(define (parse-lam pat e) ; <------------------------------------- !!! - (cond [(= 1 (length pat)) - (lam (car pat) (parse e))] - [else - (lam (car pat) (parse-lam (cdr pat) e))])) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs) #:transparent) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(struct clo (id e env) #:transparent) ; <------------------------- !!! - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))) - (null? v) - (clo? v))) ; <---------------------------------------------- !!! - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))] - ['not not] ['car car] ['cdr cdr] - [_ false])) ; <--------------------------------------- !!! - -(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))] - [(unop op e) ((op->proc op) (eval-env e 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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) - (eval-env e2 env))] - [(null-expr) null] - [(null?-expr e) (null? (eval-env e env))] - [(lam x e) (clo x e env)] ; <--------------------------------- !!! - [(app f e) ; <------------------------------------------------ !!! - (let ([vf (eval-env f env)] - [ve (eval-env e env)]) - (match vf [(clo x body fun-env) - (eval-env body (env-add x ve fun-env))]))])) - -(define (eval e) (eval-env e env-empty)) - -(define program - '(let [twice (lambda (f x) (f (f x)))] - (let [inc (lambda (x) (+ 1 x))] - (twice twice twice twice inc 1)))) - - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad6.bak b/Semestr 2/racket/lista6/lista8/zad6.bak deleted file mode 100644 index 721f5bf..0000000 --- a/Semestr 2/racket/lista6/lista8/zad6.bak +++ /dev/null @@ -1,151 +0,0 @@ -#lang racket - -; Do list.rkt dodajemy procedury -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct unop (op e) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) -(struct null-expr () #:transparent) -(struct null?-expr (e) #:transparent) -(struct app (f e) #:transparent) ; <------------------ !!! -(struct lam (id e) #:transparent) ; <------------------ !!! - - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] - [(null-expr) true] - [(null?-expr e) (expr? e)] - [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! - [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (null-expr)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) - (null?-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!! - (parse-lam (second q) (third q))] - [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!! - (parse-app q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (symbol? (first q))) - (unop (first q) (parse (second q)))])) - -(define (parse-app q) ; <----------------------------------------- !!! - (define (parse-app-accum q acc) - (cond [(= 1 (length q)) (app acc (parse (car q)))] - [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) - (parse-app-accum (cdr q) (parse (car q)))) - -(define (parse-lam pat e) ; <------------------------------------- !!! - (cond [(= 1 (length pat)) - (lam (car pat) (parse e))] - [else - (lam (car pat) (parse-lam (cdr pat) e))])) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs) #:transparent) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(struct clo (id e env) #:transparent) ; <------------------------- !!! - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))) - (null? v) - (clo? v))) ; <---------------------------------------------- !!! - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))] - ['not not] ['car car] ['cdr cdr] - [_ false])) ; <--------------------------------------- !!! - -(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))] - [(unop op e) ((op->proc op) (eval-env e 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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) - (eval-env e2 env))] - [(null-expr) null] - [(null?-expr e) (null? (eval-env e env))] - [(lam x e) (clo x e env)] ; <--------------------------------- !!! - [(app f e) ; <------------------------------------------------ !!! - (let ([vf (eval-env f env)] - [ve (eval-env e env)]) - (match vf [(clo x body fun-env) - (eval-env body (env-add x ve fun-env))]))])) - -(define (eval e) (eval-env e env-empty)) - -(define program - '(let [twice (lambda (f x) (f (f x)))] - (let [inc (lambda (x) (+ 1 x))] - (twice twice twice twice inc 1)))) - - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zad6.rkt b/Semestr 2/racket/lista6/lista8/zad6.rkt deleted file mode 100644 index c7ea9f0..0000000 --- a/Semestr 2/racket/lista6/lista8/zad6.rkt +++ /dev/null @@ -1,171 +0,0 @@ -#lang racket - -; Do list.rkt dodajemy procedury -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct unop (op e) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) -(struct cons-expr (e1 e2) #:transparent) -(struct null-expr () #:transparent) -(struct null?-expr (e) #:transparent) -(struct app (f e) #:transparent) ; <------------------ !!! -(struct lam (id e) #:transparent) ; <------------------ !!! - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] - [(unop op e) (and (symbol? op) (expr? e))] - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) - (and (expr? eb) (expr? et) (expr? ef))] - [(cons-expr e1 e2) (and (expr? e1) (expr? e2))] - [(null-expr) true] - [(null?-expr e) (expr? e)] - [(app f e) (and (expr? f) (expr? e))] ; <--------------------- !!! - [(lam id e) (and (symbol? id) (expr? e))] ; <----------------- !!! - [_ false])) - -(define (cedar? f) - (let ((letters (string->list (symbol->string f)))) - (and (> (length letters) 2) - (eq? (first letters) #\c) - (eq? (first (reverse letters)) #\r) - (andmap (lambda (x) (or (eq? x #\a) (eq? x #\d))) - (cdr letters))))) - -(define (get-cedar letters xs) - (cond [(eq? (car letters) #\r) xs] - [(eq? (car letters) #\a) (unop 'car (get-cedar (cdr letters) xs))] - [(eq? (car letters) #\d) (unop 'cdr (get-cedar (cdr letters) xs))])) - -(define (cedar f xs) - (let ((letters (string->list (symbol->string f)))) - (get-cedar (cdr (reverse letters)) xs))) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] - [(eq? q 'false) (const false)] - [(eq? q 'null) (null-expr)] - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 2) (eq? (first q) 'null?)) - (null?-expr (parse (second q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'cons)) - (cons-expr (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'lambda)) ; <!!! - (parse-lam (second q) (third q))] - [(and (list? q) (eq? (length q) 2) (symbol? (first q)) - (cedar? (first q))) - (cedar (first q) (parse (second q)))] - [(and (list? q) (pair? q) (not (op->proc (car q)))) ; <------- !!! - (parse-app q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))] - [(and (list? q) (eq? (length q) 2) (symbol? (first q))) - (unop (first q) (parse (second q)))])) - -(define (parse-app q) ; <----------------------------------------- !!! - (define (parse-app-accum q acc) - (cond [(= 1 (length q)) (app acc (parse (car q)))] - [else (parse-app-accum (cdr q) (app acc (parse (car q))))])) - (parse-app-accum (cdr q) (parse (car q)))) - -(define (parse-lam pat e) ; <------------------------------------- !!! - (cond [(= 1 (length pat)) - (lam (car pat) (parse e))] - [else - (lam (car pat) (parse-lam (cdr pat) e))])) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs) #:transparent) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(struct clo (id e env) #:transparent) ; <------------------------- !!! - -(define (value? v) - (or (number? v) - (boolean? v) - (and (pair? v) (value? (car v)) (value? (cdr v))) - (null? v) - (clo? v))) ; <---------------------------------------------- !!! - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))] - ['not not] ['car car] ['cdr cdr] - [_ false])) ; <--------------------------------------- !!! - -(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))] - [(unop op e) ((op->proc op) (eval-env e 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))] - [(cons-expr e1 e2) (cons (eval-env e1 env) - (eval-env e2 env))] - [(null-expr) null] - [(null?-expr e) (null? (eval-env e env))] - [(lam x e) (clo x e env)] ; <--------------------------------- !!! - [(app f e) ; <------------------------------------------------ !!! - (let ([vf (eval-env f env)] - [ve (eval-env e env)]) - (match vf [(clo x body fun-env) - (eval-env body (env-add x ve fun-env))]))])) - -(define (eval e) (eval-env e env-empty)) - -(define program - '(let [twice (lambda (f x) (f (f x)))] - (let [inc (lambda (x) (+ 1 x))] - (twice twice twice twice inc 1)))) - - -(define (test-eval) (eval (parse program)))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/lista8/zadanie.rkt b/Semestr 2/racket/lista6/lista8/zadanie.rkt deleted file mode 100644 index 0960f21..0000000 --- a/Semestr 2/racket/lista6/lista8/zadanie.rkt +++ /dev/null @@ -1,98 +0,0 @@ -#lang racket - -; Do let-env.rkt dodajemy wartosci boolowskie -; -; Miejsca, ktore sie zmienily oznaczone sa przez !!! - -; --------- ; -; Wyrazenia ; -; --------- ; - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) -(struct var-expr (id) #:transparent) -(struct let-expr (id e1 e2) #:transparent) -(struct if-expr (eb et ef) #:transparent) - -(define (expr? e) - (match e - [(const n) (or (number? n) (boolean? n))] ; <----------------- !!! - [(binop op l r) (and (symbol? op) (expr? l) (expr? r))] - [(var-expr x) (symbol? x)] - [(let-expr x e1 e2) - (and (symbol? x) (expr? e1) (expr? e2))] - [(if-expr eb et ef) ; <--------------------------------------- !!! - (and (expr? eb) (expr? et) (expr? ef))] - [_ false])) - -(define (parse q) - (cond - [(number? q) (const q)] - [(eq? q 'true) (const true)] ; <---------------------------- !!! - [(eq? q 'false) (const false)] ; <---------------------------- !!! - [(symbol? q) (var-expr q)] - [(and (list? q) (eq? (length q) 3) (eq? (first q) 'let)) - (let-expr (first (second q)) - (parse (second (second q))) - (parse (third q)))] - [(and (list? q) (eq? (length q) 4) (eq? (first q) 'if)) ; <--- !!! - (if-expr (parse (second q)) - (parse (third q)) - (parse (fourth q)))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) - (parse (second q)) - (parse (third q)))])) - -(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1)))) - -; ---------- ; -; Srodowiska ; -; ---------- ; - -(struct environ (xs)) - -(define env-empty (environ null)) -(define (env-add x v env) - (environ (cons (cons x v) (environ-xs env)))) -(define (env-lookup x env) - (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 ; -; --------- ; - -(define (value? v) - (or (number? v) (boolean? v))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /] ['% modulo] ; <----------- !!! - ['= =] ['> >] ['>= >=] ['< <] ['<= <=] - ['and (lambda (x y) (and x y))] - ['or (lambda (x y) (or x y))])) - -(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))])) - -(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 diff --git a/Semestr 2/racket/lista6/solution.bak b/Semestr 2/racket/lista6/solution.bak deleted file mode 100644 index 0805991..0000000 --- a/Semestr 2/racket/lista6/solution.bak +++ /dev/null @@ -1,27 +0,0 @@ -#lang racket - -(provide (struct-out complex) parse eval) - -(struct complex (re im) #:transparent) - -(define value? - complex?) - -;; Ponizej znajduje sie interpreter zwyklych wyrazen arytmetycznych. -;; Zadanie to zmodyfikowac go tak, by dzialal z liczbami zespolonymi. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /])) - -(define (eval e) - (match e - [(const n) n] - [(binop op l r) ((op->proc op) (eval l) (eval r))])) - -(define (parse q) - (cond [(number? q) (const q)] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) (parse (second q)) (parse (third q)))]))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/solution.rkt b/Semestr 2/racket/lista6/solution.rkt deleted file mode 100644 index 59bdecd..0000000 --- a/Semestr 2/racket/lista6/solution.rkt +++ /dev/null @@ -1,73 +0,0 @@ -#lang racket - -(provide (struct-out complex) parse eval) - -(struct complex (re im) #:transparent) - -(define value? - complex?) - -(define (comp-plus x y) - (let ((x-re (complex-re x)) - (x-im (complex-im x)) - (y-re (complex-re y)) - (y-im (complex-im y))) - (complex (+ x-re y-re) (+ x-im y-im)))) - -(define (comp-minus x y) - (let ((x-re (complex-re x)) - (x-im (complex-im x)) - (y-re (complex-re y)) - (y-im (complex-im y))) - (complex (- x-re y-re) (- x-im y-im)))) - -(define (comp-mult x y) - (let ((x-re (complex-re x)) - (x-im (complex-im x)) - (y-re (complex-re y)) - (y-im (complex-im y))) - (complex (- (* x-re y-re) (* x-im y-im)) (+ (* x-re y-im) (* x-im y-re))))) - -(define (comp-mod2 x) - (let ((x-re (complex-re x)) - (x-im (complex-im x))) - (complex (+ (* x-re x-re) (* x-im x-im)) 0))) - -(define (comp-mod x) - (let ((mod2 (comp-mod2 x)) - (x-re (complex-re x))) - (complex (sqrt x-re) 0))) - -(define (comp-div x y) - (let* ((mod2 (complex-re (comp-mod2 y))) - (x-re (complex-re x)) - (x-im (complex-im x)) - (y-re (complex-re y)) - (y-im (complex-im y)) - (real (+ (* x-re y-re) (* x-im y-im))) - (imag (- (* x-im y-re) (* x-re y-im)))) - (complex (/ real mod2) (/ imag mod2)))) - - -;; Ponizej znajduje sie interpreter zwyklych wyrazen arytmetycznych. -;; Zadanie to zmodyfikowac go tak, by dzialal z liczbami zespolonymi. - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (imaginary-unit? c) - (eq? c 'i)) - -(define (op->proc op) - (match op ['+ comp-plus] ['- comp-minus] ['* comp-mult] ['/ comp-div])) - -(define (eval e) - (match e - [(const n) n] - [(binop op l r) ((op->proc op) (eval l) (eval r))])) - -(define (parse q) - (cond [(number? q) (const (complex q 0))] - [(imaginary-unit? q) (const (complex 0 1))] - [(and (list? q) (eq? (length q) 3) (symbol? (first q))) - (binop (first q) (parse (second q)) (parse (third q)))]))
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/zad11/solution.bak b/Semestr 2/racket/lista6/zad11/solution.bak deleted file mode 100644 index f449481..0000000 --- a/Semestr 2/racket/lista6/zad11/solution.bak +++ /dev/null @@ -1,36 +0,0 @@ -#lang racket - -(provide (struct-out const) (struct-out binop) rpn->arith) - -;; ------------------------------- -;; Wyrazenia w odwr. not. polskiej -;; ------------------------------- - -(define (rpn-expr? e) - (and (list? e) - (pair? e) - (andmap (lambda (x) (or (number? x) (member x '(+ - * /)))) - e))) - -;; ---------------------- -;; Wyrazenia arytmetyczne -;; ---------------------- - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (arith-expr? e) - (match e - [(const n) (number? n)] - [(binop op l r) - (and (symbol? op) (arith-expr? l) (arith-expr? r))] - [_ false])) - -;; ---------- -;; Kompilacja -;; ---------- - -(define (rpn->arith e) - (error "TODO: Uzupelnij tutaj")) - -; Mozesz tez dodac jakies procedury pomocnicze i testy
\ No newline at end of file diff --git a/Semestr 2/racket/lista6/zad11/solution.rkt b/Semestr 2/racket/lista6/zad11/solution.rkt deleted file mode 100644 index a44afe4..0000000 --- a/Semestr 2/racket/lista6/zad11/solution.rkt +++ /dev/null @@ -1,58 +0,0 @@ -#lang racket - -(provide (struct-out const) (struct-out binop) rpn->arith) - -;; ------------------------------- -;; Wyrazenia w odwr. not. polskiej -;; ------------------------------- - -(define (rpn-expr? e) - (and (list? e) - (pair? e) - (andmap (lambda (x) (or (number? x) (member x '(+ - * /)))) - e))) - -;; ---------------------- -;; Wyrazenia arytmetyczne -;; ---------------------- - -(struct const (val) #:transparent) -(struct binop (op l r) #:transparent) - -(define (arith-expr? e) - (match e - [(const n) (number? n)] - [(binop op l r) - (and (symbol? op) (arith-expr? l) (arith-expr? r))] - [_ false])) - -;; ---------- -;; Kompilacja -;; ---------- - -(struct stack (xs)) - -(define empty-stack (stack null)) -(define (empty-stack? s) (null? (stack-xs s))) -(define (top s) (car (stack-xs s))) -(define (push a s) (stack (cons a (stack-xs s)))) -(define (pop s) (stack (cdr (stack-xs s)))) - -(define (op->proc op) - (match op ['+ +] ['- -] ['* *] ['/ /])) - -(define (eval-am e s) - (cond [(null? e) - (top s)] - [(number? (car e)) - (eval-am (cdr e) (push (const (car e)) s))] - [(symbol? (car e)) - (eval-am (cdr e) - (push (binop (car e) (top (pop s)) (top s)) - (pop (pop s))))])) - -(define (rpn->arith e) - (eval-am e empty-stack)) - - -; Mozesz tez dodac jakies procedury pomocnicze i testy
\ No newline at end of file diff --git a/Semestr 2/racket/luk.rkt b/Semestr 2/racket/luk.rkt deleted file mode 100644 index cc319a5..0000000 --- a/Semestr 2/racket/luk.rkt +++ /dev/null @@ -1,137 +0,0 @@ -#lang typed/racket
-
-; Do let-env.rkt dodajemy wartosci boolowskie
-;
-; Miejsca, ktore sie zmienily oznaczone sa przez !!!
-
-; --------- ;
-; Wyrazenia ;
-; --------- ;
-(provide parse typecheck)
-
-(define-type Value (U Boolean Real))
-(define-type Expr (U const binop var-expr let-expr if-expr))
-(define-type ArithSymbol (U '+ '- '* '/))
-(define-type LogicSymbol (U 'and 'or))
-(define-type CompSymbol (U '< '= '> '<= '>=))
-(define-type BinomSymbol (U ArithSymbol LogicSymbol CompSymbol))
-
-(define-type Binop-list (List BinomSymbol Any Any))
-(define-type Let-list (List 'let (List Symbol Any) Any))
-(define-type If-list (List 'if Any Any Any))
-
-(define-predicate Binop-list? Binop-list)
-(define-predicate Let-list? Let-list)
-(define-predicate If-list? If-list)
-
-(struct const ([val : Value]) #:transparent)
-(struct binop ([op : BinomSymbol] [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 Value? Value)
-(define-predicate Expr? Expr)
-(define-predicate BinomSymbol? BinomSymbol)
-(define-predicate ArithSymbol? ArithSymbol)
-(define-predicate LogicSymbol? LogicSymbol)
-(define-predicate CompSymbol? CompSymbol)
-(define-predicate BinomValue? BinomValue)
-
-
-
-(: parse (-> Any Expr))
-(define (parse q)
- (cond
- [(real? q) (const q)]
- [(eq? q 'true) (const true)] ; <---------------------------- !!!
- [(eq? q 'false) (const false)] ; <---------------------------- !!!
- [(symbol? q) (var-expr q)]
- [(Let-list? q)
- (let-expr (first (second q))
- (parse (second (second q)))
- (parse (third q)))]
- [(If-list? q) ; <--- !!!
- (if-expr (parse (second q))
- (parse (third q))
- (parse (fourth q)))]
- [(Binop-list? q)
- (binop (first q)
- (parse (second q))
- (parse (third q)))]
- [else (error "Blad parsowania" q)]))
-
-
-
-
-(define (test-parse) (parse '(let [x (+ 2 2)] (+ x 1))))
-
-; ---------- ;
-; Srodowiska ;
-; ---------- ;
-(define-type EType ( U 'real 'boolean ) )
-(define-type Env (Listof (Pairof Symbol EType)))
-(define-predicate Env? Env)
-(struct environ ([xs : Env]))
-
-(: env-empty environ)
-(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 (U EType #f)))
-(define (env-lookup x env)
- (: assoc-lookup (-> Env 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)))
-
-
-(: typecheck (-> Expr (U EType #f)))
-(define (typecheck q)
- (: give (-> Expr environ (U EType #f)))
- (define (give q envi)
- (cond
- [(const? q) (if (boolean? (const-val q)) 'boolean 'real)]
- [(var-expr? q) (env-lookup (var-expr-id q) envi)]
- [(let-expr? q)
- (let ([p (give (let-expr-e1 q) envi)]) (if (false? p) #f (give (let-expr-e2 q) (env-add (let-expr-id q) p envi))))]
- [(binop? q)
- (cond
- ([ArithSymbol? (binop-op q)] (if (and (eq? 'real (give (binop-l q) envi)) (eq? 'real (give (binop-r q) envi))) 'real #f))
- ([LogicSymbol? (binop-op q)] (if (and (eq? 'boolean (give (binop-l q) envi)) (eq? 'boolean (give (binop-r q) envi))) 'boolean #f))
- ([CompSymbol? (binop-op q)] (if (and (eq? 'real (give (binop-l q) envi)) (eq? 'real (give (binop-r q) envi))) 'boolean #f))
- [else #f])]
- [(if-expr? q)
- (if (and (eq? 'real (if-expr-eb q))
- (eq? (give (if-expr-et q) envi) (give (if-expr-ef q) envi)))
- (give (if-expr-et q) envi)
- #f)]
- [else #f]))
-
-
- (give q env-empty))
-
-
-
-(define program2
- '(if true
- (let [x 5] (+ 5 false))
- (/ 2 2)))
-
-(define program3
- '(let [x (+ 2 3)]
- (let [y (< 2 3)]
- (+ x y))))
-
-(define program4
- '(let [x (and true true)] x))
-
-(define wtf
- '(and true true))
-
-(typecheck (parse program2))
-(typecheck (parse program3))
-(typecheck (parse program4))
diff --git a/Semestr 2/racket/rac.rkt b/Semestr 2/racket/rac.rkt deleted file mode 100644 index 8300208..0000000 --- a/Semestr 2/racket/rac.rkt +++ /dev/null @@ -1,371 +0,0 @@ -#reader(lib"read.ss""wxme")WXME0109 ## -#| - This file uses the GRacket editor format. - Open this file in DrRacket version 7.6 or later to read it. - - Most likely, it was created by saving a program in DrRacket, - and it probably contains a program with non-text elements - (such as images or comment boxes). - - http://racket-lang.org/ -|# - 33 7 #"wxtext\0" -3 1 6 #"wxtab\0" -1 1 8 #"wximage\0" -2 0 8 #"wxmedia\0" -4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0" -1 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0" -1 0 68 -(0 - #"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr" - #"lib\"))\0" -) 1 0 16 #"drscheme:number\0" -3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0" -1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0" -1 0 93 -(1 - #"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni" - #"pclass-wxme.ss\" \"framework\"))\0" -) 0 0 43 #"(lib \"collapsed-snipclass.ss\" \"framework\")\0" -0 0 19 #"drscheme:sexp-snip\0" -0 0 29 #"drscheme:bindings-snipclass%\0" -1 0 101 -(2 - #"((lib \"ellipsis-snip.rkt\" \"drracket\" \"private\") (lib \"ellipsi" - #"s-snip-wxme.rkt\" \"drracket\" \"private\"))\0" -) 2 0 88 -(3 - #"((lib \"pict-snip.rkt\" \"drracket\" \"private\") (lib \"pict-snip.r" - #"kt\" \"drracket\" \"private\"))\0" -) 0 0 55 -#"((lib \"snip.rkt\" \"pict\") (lib \"snip-wxme.rkt\" \"pict\"))\0" -1 0 34 #"(lib \"bullet-snip.rkt\" \"browser\")\0" -0 0 25 #"(lib \"matrix.ss\" \"htdp\")\0" -1 0 22 #"drscheme:lambda-snip%\0" -1 0 29 #"drclickable-string-snipclass\0" -0 0 26 #"drracket:spacer-snipclass\0" -0 0 57 -#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0" -1 0 26 #"drscheme:pict-value-snip%\0" -0 0 45 #"(lib \"image-snipr.ss\" \"slideshow\" \"private\")\0" -1 0 38 #"(lib \"pict-snipclass.ss\" \"slideshow\")\0" -2 0 55 #"(lib \"vertical-separator-snip.ss\" \"stepper\" \"private\")\0" -1 0 18 #"drscheme:xml-snip\0" -1 0 31 #"(lib \"xml-snipclass.ss\" \"xml\")\0" -1 0 21 #"drscheme:scheme-snip\0" -2 0 34 #"(lib \"scheme-snipclass.ss\" \"xml\")\0" -1 0 10 #"text-box%\0" -1 0 32 #"(lib \"text-snipclass.ss\" \"xml\")\0" -1 0 1 6 #"wxloc\0" - 0 0 64 0 1 #"\0" -0 75 1 #"\0" -0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9 -#"Standard\0" -0 75 12 #"Courier New\0" -0 26 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24 -#"framework:default-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15 -#"text:ports out\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1 --1 2 15 #"text:ports err\0" -0 -1 1 #"\0" -1 0 -1 -1 93 -1 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17 -#"text:ports value\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 --1 2 27 #"Matching Parenthesis Style\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1 --1 2 1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 37 -#"framework:syntax-color:scheme:symbol\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 38 -#"framework:syntax-color:scheme:keyword\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 38 38 128 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2 -38 #"framework:syntax-color:scheme:comment\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 194 116 31 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 37 -#"framework:syntax-color:scheme:string\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 35 -#"framework:syntax-color:scheme:text\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 39 -#"framework:syntax-color:scheme:constant\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 41 128 38 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 49 -#"framework:syntax-color:scheme:hash-colon-keyword\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 42 -#"framework:syntax-color:scheme:parenthesis\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 132 60 36 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36 -#"framework:syntax-color:scheme:error\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 36 -#"framework:syntax-color:scheme:other\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 16 -#"Misspelled Text\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 -38 #"drracket:check-syntax:lexically-bound\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 81 112 203 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 28 -#"drracket:check-syntax:set!d\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 37 -#"drracket:check-syntax:unused-require\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36 -#"drracket:check-syntax:free-variable\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 31 -#"drracket:check-syntax:imported\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 68 0 203 0 0 0 -1 -1 2 47 -#"drracket:check-syntax:my-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 178 34 34 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 50 -#"drracket:check-syntax:their-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 116 0 0 0 0 -1 -1 2 48 -#"drracket:check-syntax:unk-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2 -49 #"drracket:check-syntax:both-obligation-style-pref\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 139 142 28 0 0 0 -1 -1 2 -26 #"plt:htdp:test-coverage-on\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 1 -#"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 2 27 -#"plt:htdp:test-coverage-off\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 4 1 -#"\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 4 4 #"XML\0" -0 70 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 2 37 #"plt:module-language:test-coverage-on\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 -1 -1 2 38 -#"plt:module-language:test-coverage-off\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 93 -1 -1 0 1 0 0 0 1 0 0 0 0 0 0 255 165 0 0 0 0 -1 -1 0 36 -#"mrlib/syntax-browser:subtitle-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 36 36 140 255 255 255 -1 --1 0 42 #"mrlib/syntax-browser:focused-syntax-color\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 34 139 34 255 255 255 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 4 1 #"\0" -0 -1 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 100 0 0 0 0 -1 --1 4 1 #"\0" -0 71 1 #"\0" -1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1 --1 2 1 #"\0" -0 70 1 #"\0" -1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 148 0 211 0 0 0 -1 --1 2 1 #"\0" -0 -1 1 #"\0" -1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1 --1 0 1 #"\0" -0 -1 1 #"\0" -0 12 -1 -1 -1 -1 -1 -1 0 0 1 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 2 1 #"\0" -0 -1 1 #"\0" -0 12 -1 -1 -1 -1 -1 -1 0 0 1 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0 --1 -1 2 1 #"\0" -0 -1 1 #"\0" -1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 200 0 0 0 0 0 -1 -1 4 1 -#"\0" -0 -1 1 #"\0" -1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 255 255 0 -1 -1 - 0 122 0 28 3 12 #"#lang racket" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 6 #"define" -0 0 24 3 2 #" (" -0 0 14 3 6 #"fringe" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 15 3 4 #"cond" -0 0 24 3 3 #" ((" -0 0 14 3 5 #"null?" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 2 #") " -0 0 14 3 4 #"null" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 10 #" ((" -0 0 14 3 3 #"not" -0 0 24 3 2 #" (" -0 0 14 3 5 #"pair?" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 4 #")) (" -0 0 14 3 4 #"list" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 14 3 4 #"else" -0 0 24 3 2 #" (" -0 0 14 3 6 #"append" -0 0 24 3 2 #" (" -0 0 14 3 6 #"fringe" -0 0 24 3 2 #" (" -0 0 14 3 3 #"car" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 2 #"))" -0 0 24 29 1 #"\n" -0 0 24 3 23 #" (" -0 0 14 3 6 #"fringe" -0 0 24 3 2 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 4 #"tree" -0 0 24 3 6 #"))))))" -0 0 24 29 1 #"\n" -0 0 24 29 1 #"\n" -0 0 24 3 1 #"(" -0 0 15 3 6 #"define" -0 0 24 3 2 #" (" -0 0 14 3 7 #"subsets" -0 0 24 3 1 #" " -0 0 14 3 1 #"s" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 3 #" (" -0 0 14 3 2 #"if" -0 0 24 3 2 #" (" -0 0 14 3 5 #"null?" -0 0 24 3 1 #" " -0 0 14 3 1 #"s" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 7 #" (" -0 0 14 3 4 #"list" -0 0 24 3 1 #" " -0 0 14 3 4 #"null" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 7 #" (" -0 0 15 3 3 #"let" -0 0 24 3 3 #" ((" -0 0 14 3 4 #"rest" -0 0 24 3 2 #" (" -0 0 14 3 7 #"subsets" -0 0 24 3 2 #" (" -0 0 14 3 3 #"cdr" -0 0 24 3 1 #" " -0 0 14 3 1 #"s" -0 0 24 3 4 #"))))" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 14 3 7 #"display" -0 0 24 3 1 #" " -0 0 14 3 1 #"s" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 14 3 7 #"newline" -0 0 24 3 1 #")" -0 0 24 29 1 #"\n" -0 0 24 3 9 #" (" -0 0 14 3 6 #"append" -0 0 24 3 1 #" " -0 0 14 3 4 #"rest" -0 0 24 3 2 #" (" -0 0 14 3 3 #"map" -0 0 24 3 2 #" (" -0 0 15 3 6 #"lambda" -0 0 24 3 2 #" (" -0 0 14 3 1 #"x" -0 0 24 3 3 #") (" -0 0 14 3 4 #"cons" -0 0 24 3 2 #" (" -0 0 14 3 3 #"car" -0 0 24 3 1 #" " -0 0 14 3 1 #"s" -0 0 24 3 2 #") " -0 0 14 3 1 #"x" -0 0 24 3 3 #")) " -0 0 14 3 4 #"rest" -0 0 24 3 5 #")))))" -0 0 24 29 1 #"\n" -0 0 24 3 2 #" " -0 0 diff --git a/Semestr 2/racket/solution.rkt b/Semestr 2/racket/solution.rkt deleted file mode 100644 index 3643668..0000000 --- a/Semestr 2/racket/solution.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket - -(provide heapsort) (require "leftist.rkt") - -(define (heapsort xs) - (define (create-heap xs res) - (if (null? xs) - res - (create-heap (cdr xs) (heap-insert (cons (car xs) (car xs)) res)))) - (define (heap-to-list h) - (if (heap-empty? h) - null - (cons (elem-val (heap-min h)) (heap-to-list (heap-pop h))))) - (heap-to-list (create-heap xs empty-heap)))
\ No newline at end of file |