From c5fcf7179a83ef65c86c6a4a390029149e518649 Mon Sep 17 00:00:00 2001
From: Franciszek Malinka <franciszek.malinka@gmail.com>
Date: Tue, 5 Oct 2021 21:49:54 +0200
Subject: Duzy commit ze smieciami

---
 semestr-2/racket/l14z22/solution.bak | 70 ++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 semestr-2/racket/l14z22/solution.bak

(limited to 'semestr-2/racket/l14z22/solution.bak')

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
+
-- 
cgit v1.2.3