From c5fcf7179a83ef65c86c6a4a390029149e518649 Mon Sep 17 00:00:00 2001 From: Franciszek Malinka Date: Tue, 5 Oct 2021 21:49:54 +0200 Subject: Duzy commit ze smieciami --- Semestr 2/racket/l11z20/solution.rkt | 245 ----------------------------------- 1 file changed, 245 deletions(-) delete mode 100644 Semestr 2/racket/l11z20/solution.rkt (limited to 'Semestr 2/racket/l11z20/solution.rkt') 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) - - -- cgit v1.2.3