aboutsummaryrefslogtreecommitdiff
path: root/Semestr 2/racket/l14z22
diff options
context:
space:
mode:
authorFranciszek Malinka <franciszek.malinka@gmail.com>2021-02-25 14:42:55 +0100
committerFranciszek Malinka <franciszek.malinka@gmail.com>2021-02-25 14:42:55 +0100
commit9477dbe667f250ecd23f8fc0d56b942191526421 (patch)
treea4b50c9a726f415f835f5311c11c5d66e95f688c /Semestr 2/racket/l14z22
parent1968c1e590077bd51844eacfac722d7963848cb8 (diff)
Stare semestry, niepoukladane
Diffstat (limited to 'Semestr 2/racket/l14z22')
-rw-r--r--Semestr 2/racket/l14z22/solution.bak70
-rw-r--r--Semestr 2/racket/l14z22/solution.rkt87
2 files changed, 157 insertions, 0 deletions
diff --git a/Semestr 2/racket/l14z22/solution.bak b/Semestr 2/racket/l14z22/solution.bak
new file mode 100644
index 0000000..0d4f164
--- /dev/null
+++ b/Semestr 2/racket/l14z22/solution.bak
@@ -0,0 +1,70 @@
+#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
new file mode 100644
index 0000000..480c772
--- /dev/null
+++ b/Semestr 2/racket/l14z22/solution.rkt
@@ -0,0 +1,87 @@
+#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)))
+
+