blob: 0d4f164ec5cdb08a271e00eae3ea770ffbb89271 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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
|
