Yliopiston etusivulle Suomeksi Inte på svenska No english version available
Helsingin yliopisto Tietojenkäsittelytieteen laitos
 

Tietojenkäsittelytieteen laitos

Malliratkaisuja laskuharjoituksiin

1. laskarit

1.1

Varsin laaja esimerkki Scheme-laskusääntöjen käytännön toteutuksesta löytyy SICP:in osasta 4.1.

1.3


(define (potenssiin x p)
  (if (zero? p)
      1
      (if (odd? p)
          (* x (potenssiin x (- p 1)))
          (potenssiin (* x x) (/ p 2)))))
	

1.4


(define (korottaja p)
  (lambda (x) (potenssiin x p)))
	

1.5


(define (korottaja2 p)
  (if (zero? p)
      (lambda (x) 1)
      (if (odd? p)
          (let ((f (korottaja2 (- p 1))))
            (lambda (x) (* x (f x))))
          (let ((f (korottaja2 (/ p 2))))
            (lambda (x) (korottaja2 (* x x)))))))
	

1.6


(define (integroi f a b k)
  (let ((vali (/ (- b a) k)))
    (define (laske ala x askel)
      (if (= askel k)
          (+ ala (* vali (f x) 1/2))
          (laske (+ ala (* vali (f x))) (+ x vali) (+ askel 1))))
    (laske (* vali (f a) 1/2) (+ a vali) 1)))	
	

2. laskarit

2.1

Käytetään pientä lyhennemerkintää:


λx y z.t =def λx.λy.λz.t

Tämä lyhennemuoto ehkä paremmin ilmaisee ajatusta, että funktio joka palauttaa funktion on itse asiassa "kuritettu" tapa esittää funktio, joka ottaakin monta parametria. Seuraajafunktio saadaan suoraan Church-numeraalien määritelmästä:

succ =def λn s z.s (n s z)

Tai vaihtoehtoisesti (osoita ekvivalenssi!):

succ =def = λn s z.n s (s z)

Nyt voidaan edetä kahdella tavalla: joko käytetään jo löydettyjä numeerisia operaatioita ja manipuloidaan _lukuja_ niiden avulla, tai yritetään rakentaa "matalan tason" funktioita, joilla on oikeat ominaisuudet. Ensimmäinen lähestymistapa on selvempi, mutta tuottaa monimutkaisempia ratkaisuja, kun apuoperaatiot avataan:

add =def λm n.n succ m
mul =def λm n.n (add m) zero
pow =def λm n.n (mul m) (succ zero)

Toinen lähestymistapa tuottaa lyhyempiä ja kauniimpia mutta kryptisempiä termejä:

add =def λm n s z.m s (n s z)
mul =def λm n s.m (n s)
pow =def λm n.n m

Lisäksi add ja mul ovat kommutatiivisia, eli add m n = add n m ja mul m n = mul n m. Täten niiden määrittelyssäkin voidaan vaihtaa n:n ja m:n paikkaa. (Lisätehtävä: todista kommutatiivisuusyhtälöt ekstensionaalisuusperiaatteen avulla.)

2.2

Yhtäsuuruus nollan kanssa on helppo testata: käytetään vain funktiota, joka palauttaa valheen, jos sitä kutsutaan kertaakaan. Vain nolla-numeraalin kanssa sitä ei kutsuta yhtään kertaa, ja tällöin palautetaan totta:

nolla =def λn.n (λx.valhe) totta

Totuusarvo-operaatioilla voidaan taas edetä kahdella tavalla, joko "selkeästi":

ei =def λb.b valhe totta
ja =def λa b.a b valhe
tai =def λa b.a totta b

Tai sitten matalalla tasolla

ei =def λb p q.b q p
ja =def λa b p q.a (b p q) q
tai =def λa b p q.a p (b p q)

Nämäkin ovat tietysti ekvivalentit.

2.3

(define (cfi f n)
  (define (cfi-aux m a)
    (if (> m n)
        a
        (cfi-aux (+ m 1) (/ (+ (f m) a)))))
  (cfi-aux 1 0))

2.4

(define (cfie f n)
  (define (cfie-aux m a)
    (if (> m n)
        a
        (let ((result (f m)))
          (if (not (number? result))
              #f
              (let ((sum (+ result a)))
                (if (zero? sum)
                    #t
                    (cfie-aux (+ m 1) (/ sum))))))))
  (cfie-aux 1 0))

2.5

(define (ack m n)
  (if (zero? m) 
      (+ n 1)
      (ack (- m 1) (if (zero? n) 
                       1 
                       (ack m (- n 1))))))

2.6

Vaikka jatkeita voikin hyvin käyttää virhetilanteiden käsittelyyn, ei se ole ainoa tapa. Yleinen Scheme-idiooma on palauttaa #f kun suoritus epäonnistuu. Koska and-lauseke suorittaa sen kunkin osalausekkeen yksi kerrallaan niin kauan kuin mikään ei palauta #f:ää, voi sitä hyvin käyttää virhekäsittelyyn:

(define (ackl1 m n l)
  (if (zero? l)
      #f
      (if (zero? m) 
          (+ n 1)
          (let ((nn (if (zero? n) 1 (ackl1 m (- n 1) (- l 1)))))
            (and nn (ackl1 (- m 1) nn (- l 1)))))))

Jatkeet ovat kuitenkin ehkä se, mitä tehtävässä haettiin takaa:

(define (ackl2 m n l)
  (call-with-current-continuation 
   (lambda (k)
     (define (aux m n l)
       (if (zero? l)
           (k #f)
           (if (zero? m) 
               (+ n 1)
               (ackl2 (- m 1) 
                    (if (zero? n) 
                        1 
                        (ackl2 m (- n 1) (- l 1)))
                    (- l 1)))))
     (aux m n l))))

3. laskarit

3.1

(define (latista l)
  (let aux ((l l)
            (rest '()))
    (cond ((pair? l) (aux (car l) (aux (cdr l) rest)))
          ((null? l) rest)
          (else (cons l rest)))))

3.2

(define (lomita l1 l2)
  (cond ((null? l1) l2)
        ((null? l2) l1)
        ((< (car l1) (car l2)) (cons (car l1) (lomita (cdr l1) l2)))
        (else (cons (car l2) (lomita l1 (cdr l2))))))

3.3

(define (split-alternate l)
  (let aux ((l l)
            (a1 '())
            (a2 '()))
    (cond ((null? l) (cons a1 a2))
          ((null? (cdr l)) (cons (cons (car l) a1) a2))
          (else (aux (cddr l) (cons (car l) a1) (cons (cadr l) a2))))))

(define (merge-sort l)
  (cond ((null? l) '())
        ((null? (cdr l)) l)
        (else (let ((parts (split-alternate l)))
                (lomita (merge-sort (car parts)) 
                        (merge-sort (cdr parts)))))))

3.4

(define (split-pivot l)
  (let ((pivot (car l)))
    (let aux ((l (cdr l))
              (small '())
              (big '()))
    (cond ((null? l) (if (null? big)
                         (cons small (list pivot))
                         (cons (cons pivot small) big)))
          ((<= (car l) pivot) (aux (cdr l) (cons (car l) small) big))
          (else (aux (cdr l) small (cons (car l) big)))))))

(define (quick-sort l)
  (cond ((null? l) '())
        ((null? (cdr l)) l)
        (else (let ((parts (split-pivot l)))
                (append (quick-sort (car parts)) (quick-sort (cdr parts)))))))

3.5

(define (generic-sort split join l)
  (let sort ((l l))
    (cond ((null? l) '())
          ((null? (cdr l)) l)
          (else (let ((parts (split l)))
                  (join (sort (car parts)) (sort (cdr parts))))))))

(define (merge-sort-2 l) (generic-sort split-alternate lomita l))

(define (quick-sort-2 l) (generic-sort split-pivot append l))

3.6

(Matti Nykäsen ratkaisu)

(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 "unknown expression type -- DERIV" exp))))

(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) ; (list '+ a1 a2))
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))
  
(define (make-product m1 m2) ; (list '* 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 (sum? x)
  (and (pair? x) (eq? (car x) '+)))

(define (addend s) (cadr s))

(define (augend s) ; (caddr s))
  (if (null? (cdddr s))
      (caddr s)
      (cons '+ (cddr s))))

(define (product? x)
  (and (pair? x) (eq? (car x) '*)))

(define (multiplier p) (cadr p))

(define (multiplicand p) ; (caddr p))
  (if (null? (cdddr p))
      (caddr p)
      (cons '* (cddr p))))

4. laskarit

4.1

(define (luku->numerot n)
  (cond ((not (integer? n)) #f)
        ((negative? n) #f)
        ((zero? n) '(0))
        (else 
         (let loop ((n n) 
                    (rest '()))
           (if (zero? n)
               rest
               (loop (quotient n 10) (cons (remainder n 10) rest)))))))

(define (numerot->luku l)
  (let loop ((l l) (n 0))
    (cond ((null? l) n)
          ((not (pair? l)) #f)
          (else (let ((x (car l)))
                  (and (integer? x)
                       (>= x 0)
                       (<= x 9)
                       (loop (cdr l) (+ (* n 10) (car l)))))))))

4.2

(define (palindromi? l)
  (equal? l (reverse l)))

(define (palindromoi n)
  (let ((l (luku->numerot n)))
    (cond ((not l) #f)
          ((palindromi? l) n)
          (else (palindromoi (+ n (numerot->luku (reverse l))))))))

4.3

(define lukusanat
  '((1 (yk si))
    (2 (kak si))
    (3 (kol me))
    (4 (nel jä))
    (5 (vii si))
    (6 (kuu si))
    (7 (seit se män))
    (8 (kah dek san))
    (9 (yh dek sän))
    (10 (kym me nen) (kym men tä))
    (100 (sa ta) (sa taa))
    (1000 (tu hat) (tu hat ta))
    (1000000 (mil joo na) (mil joo naa))))
   
(define (etsi-luku n)
  (let loop ((l (cdr lukusanat))
             (x (car lukusanat)))
    (if (or (null? l) (< n (caar l)))
        x
        (loop (cdr l) (car l)))))

(define (sano n)
  (cond 
   ((zero? n) '())
   ((and (> n 10) (< n 20)) (append (sano (- n 10)) '(tois ta)))
   (else (let* ((lukusana (etsi-luku n))
                (kanta (car lukusana))
                (kerroin (quotient n kanta)))
           (if (= kerroin 1)
               (append (cadr lukusana) (sano (- n kanta)))
               (append (sano kerroin) 
                       (caddr lukusana) 
                       (sano (- n (* kanta kerroin)))))))))

4.4

(define-syntax stream-cons
  (syntax-rules ()
    ((_ a b) (cons a (delay b)))))

(define (stream-cdr s) (force (cdr s)))

(define (stream-car s) (car s))

(define (stream-null? s) (null? s))

(define null-stream '())

(define (lazy-merge s1 s2)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        ((< (stream-car s1) (stream-car s2))
         (stream-cons (stream-car s1) (lazy-merge (stream-cdr s1) s2)))
        (else
         (stream-cons (stream-car s2) (lazy-merge s1 (stream-cdr s2))))))

4.5

(define (lazy-map f s)
  (if (stream-null? s)
      null-stream
      (stream-cons (f (stream-car s)) (lazy-map f (stream-cdr s)))))

4.6

(define (stream-uniq s)
  (if (stream-null? s)
      s
      (stream-cons 
       (stream-car s)
       (let loop ((n (stream-car s))
                  (s (stream-cdr s)))
         (cond ((stream-null? s) null-stream)
               ((eq? n (stream-car s)) (loop n (stream-cdr s)))
               (else (stream-cons (stream-car s) 
                                  (loop (stream-car s) 
                                        (stream-cdr s)))))))))
            
(define (multiplier x)
  (lambda (y) (* x y)))

(define hamming
  (stream-uniq
   (stream-cons 1 (lazy-merge 
                   (lazy-map (multiplier 2) hamming)
                   (lazy-merge 
                    (lazy-map (multiplier 3) hamming)
                    (lazy-map (multiplier 5) hamming))))))

(define (stream-take s n)
  (if (zero? n)
      '()
      (cons (stream-car s) (stream-take (stream-cdr s) (- n 1)))))

5. laskarit

5.1


(define henkilon-nimi car)
(define henkilon-ihastukset cdr)

(define (etsi-indeksi nimi lista)
  (let loop ((i 0) (l lista))
    (cond ((null? l) #f)
          ((eq? (caar l) nimi) i)
          (else (loop (+ i 1) (cdr l))))))

(define miehen-nimi car)
(define miehen-ihastukset cadr)
(define (aseta-miehen-ihastukset! mies ihastukset)
  (set-car! (cdr mies) ihastukset))
(define miehen-indeksi caddr)
(define naisen-nimi car)
(define naisen-suosiot cadr)
(define naisen-kavaljeeri caddr)
(define (aseta-naisen-kavaljeeri! nainen mies)
  (set-car! (cddr nainen) mies))
(define (suosio-aste nainen mies)
   (vector-ref (naisen-suosiot nainen) (miehen-indeksi mies)))
(define (lahteeko? nainen mies)
  (and nainen
       (suosio-aste nainen mies)
       (or (not (naisen-kavaljeeri nainen))
           (< (suosio-aste nainen mies)
              (suosio-aste nainen (naisen-kavaljeeri nainen))))))

(define (muodosta-parit mlista nlista)
  (let* ((luo-nainen 
          (lambda (henkilo)
            (let* ((n (length mlista))
                   (suosiot (make-vector n #f)))
              (let loop ((i 0) (l (henkilon-ihastukset henkilo)))
                (if (null? l)
                    (list (henkilon-nimi henkilo) suosiot #f)
                    (let ((idx (etsi-indeksi (car l) mlista)))
                      (if idx 
                          (vector-set! suosiot idx i))
                      (loop (+ i 1) (cdr l))))))))
         (naiset 
          (map luo-nainen nlista))
         (etsi-nainen 
          (lambda (nimi) (assoc nimi naiset)))
         (miehet
          (let loop ((l mlista) (i 0))
            (if (null? l)
                '()
                (let ((henkilo (car l)))
                  (cons (list (henkilon-nimi henkilo) 
                              (map etsi-nainen (henkilon-ihastukset henkilo))
                              i)
                        (loop (cdr l) (+ i 1))))))))
    (let jatka-hakua ((hakijat miehet))
      (if (null? hakijat)
          (let loop ((parit '()) (l naiset))
            (if (null? l) 
                (reverse parit)
                (let* ((nainen (car l))
                       (kavaljeeri (naisen-kavaljeeri nainen)))
                  (if (not kavaljeeri)
                      (loop parit (cdr l))
                      (loop (cons (list (miehen-nimi kavaljeeri)
                                        (naisen-nimi nainen))
                                  parit)
                            (cdr l))))))
          (let ((mies (car hakijat)))
            (let kokeile-seuraavia ((ihastukset (miehen-ihastukset mies)))
              (if (null? ihastukset)
                  (jatka-hakua (cdr hakijat))
                  (let ((nainen (car ihastukset)))
                    (if (lahteeko? nainen mies)
                        (let ((vanha-kavaljeeri (naisen-kavaljeeri nainen)))
                          (aseta-miehen-ihastukset! mies (cdr ihastukset))
                          (aseta-naisen-kavaljeeri! nainen mies)
                          (jatka-hakua 
                           (if vanha-kavaljeeri
                               (cons vanha-kavaljeeri (cdr hakijat))
                               (cdr hakijat))))
                        (kokeile-seuraavia (cdr ihastukset)))))))))))

5.2

(define (leikkaus j1 j2)
  (cond ((null? j1) '())
        ((member (car j1) j2) 
         (cons (car j1) (leikkaus (cdr j1) j2)))
        (else (leikkaus (cdr j1) j2))))

(define (ainaisparit miehet naiset)
  (leikkaus (muodosta-parit miehet naiset)
            (map (lambda (x) (list (cadr x) (car x)))
                 (muodosta-parit naiset miehet))))

(define miehet '((a 1 2 3 4)
                 (b 2 3 1 4)
                 (c 3 1 2 4)
                 (d 1 2 3)))
(define naiset '((1 c b a)
                 (2 b a c)
                 (3 a c b)
                 (4 a b c d)))

5.4

(define (unify-shell)
  (let ((prompt-1 (begin
                    (display       "Anna termi (tai <eof&rt; jos loppu)? ")
                    (read))))
    (if (eof-object? prompt-1)
        (begin
          (newline)
          (display "Loppu."))
        (let* ((prompt-2 (begin
                          (display "Anna toinen? ")
                          (read)))
               (tulos (unify prompt-1 prompt-2 binding:empty)))
          (if unify-trace-flag
              (begin
                (newline)
                (newline)))
          (display "Tulos: ")
          (display (if tulos
                       (binding:expand prompt-1 tulos)
                       "ei onnistunut!"))
          (newline)
          (unify-shell)))))

5.5

(define (foldr f n l)
  (if (null? l) 
      n 
      (f (car l) (foldr f n (cdr l)))))

(define (cart-prod-2 l1 l2)
  (apply append (map (lambda (x) (map (lambda (y) (cons x y)) l2)) l1)))

(define (cart-prod . lists)
  (foldr cart-prod-2 '(()) lists))

5.6

(define (uusi-pankki paaoma)
  (define (avaa-tili alkusaldo)
    (define saldo 0)
    (define (muuta-saldoa! muutos)
      (let* ((vanha-velka (min 0 saldo))
             (uusi-saldo (+ saldo muutos))
             (uusi-velka (min 0 uusi-saldo))
             (uusi-paaoma (+ paaoma (- vanha-velka) uusi-velka)))
        (if (negative? uusi-paaoma)
            (error "Pääoma ylitetty!"))
        (set! paaoma uusi-paaoma)
        (set! saldo uusi-saldo)
        uusi-saldo))
    (muuta-saldoa! alkusaldo)
    muuta-saldoa!)
  (if (negative? paaoma)
      (error "Ei saa perustaa velkaista pankkia!"))
  avaa-tili)

6. laskarit

6.1

(define (remove k al)
  (cond ((null? al) al)
        ((eq? (caar al) k) (cdr al))
        (else (cons (car al) (remove k (cdr al))))))

(define (try-paths graph froms to)
  (cond 
   ((null? froms) (cons #f graph))
   ((eq? (car froms) to) (cons (list to) graph))
   (else
    (let ((v (assoc (car froms) graph)))
      (if v
          (let* ((rest-graph (remove (car froms) graph))
                 (ret (try-paths rest-graph (cdr v) to))
                 (path (car ret))
                 (return-graph (cdr ret)))
            (if path
                (cons (cons (car froms) path) return-graph)
                (try-paths return-graph (cdr froms) to)))
          (try-paths graph (cdr froms) to))))))

(define (has-path-from graph from to)
  (let ((v (assoc from graph)))
    (and v
         (car (try-paths graph (cdr v) to)))))

6.2

(define (insertions i l)
  (if (null? l)
      (list (list i))
      (cons (cons i l) (map (lambda (x) (cons (car l) x))
                            (insertions i (cdr l))))))

(define (permutations l)
  (if (null? l)
      '(())
      (apply append (map (lambda (p) (insertions (car l) p))
                         (permutations (cdr l))))))

(define (filter p l)
  (cond ((null? l) l)
        ((p (car l)) (cons (car l) (filter p (cdr l))))
        (else (filter p (cdr l)))))

(define (legal-configuration? l)
  (let ((baker (car l))
        (cooper (cadr l))
        (fletcher (caddr l))
        (miller (cadddr l))
        (smith (list-ref l 4)))
    (not (or (= baker 5)
             (= cooper 1)
             (= fletcher 1)
             (= fletcher 5)
             (<= miller cooper)
             (= (abs (- smith fletcher)) 1)
             (= (abs (- fletcher cooper)) 1)))))

(define answer 
  (map (lambda (l) (map cons '(baker cooper fletcher miller smith) l))
       (filter legal-configuration? (permutations '(1 2 3 4 5)))))

6.3

p(o,Y,Y).
p(s(X),Y,s(Z)) :- p(X,Y,Z).

m(o,_,o).
m(s(X),Y,Z) :- p(Q,Y,Z), m(X,Y,Q).

6.4

father(X,Y):-
	daughter(Y,_,X),
father(X,Y):-
	son(Y,_,X).

parent(X,Y):-
	mother(X,Y).
parent(X,Y):-
	father(X,Y).

siblings(X,Y):-
	parent(Z,X),
	parent(Z,Y).

cousins(X,Y):-
	parent(Z,X),
	parent(U,Y),
	siblings(Z,U).

6.5

carrier(Mother) :- 
	son(Boy,Mother,_),
	ill(Boy).

carrier(Woman) :-
	daughter(Woman,_,Father),
	ill(Father).

carrier(Mother) :-
	daughter(Woman,Mother,Father),
	well(Father),
	carrier(Woman).

7. laskarit

7.1

conc([],Y,Y).
conc([X|Xs],Y,[X|Zs]) :- conc(Xs,Y,Zs).

%% a) X esiintyy Y:ssä
p(X,Y) :- conc(_,[X|_],Y). 

%% b) X on listan Y toisiksi viimeinen jäsen
q(X,Y) :- conc(_,[X,_],Y). 

%% c) X esiintyy kaksi kertaa Y:ssä
r(X,Y) :- conc(_,[X|Z],Y), p(X,Z). 

%% d) Z on lista, joka saadaan lisäämällä Y:hyn johonkin kohtaan X
s(X,Y,Z) :- conc(Y1,Y2,Y), conc(Y1,[X|Y2],Z).

%% e) Z on lista, joka saadaan poistamalla Y:n jostain kohdasta X
t(X,Y,Z) :- conc(P,[X|Q],Y), conc(P,Q,Z).

7.2

list23(l(X),[X]).
list23(b(Tl,_,Tr),L):-
	list23(Tl,Ll),
	list23(Tr,Lr),
	conc(Ll,Lr,L).
list23(t(Tl,_,Tm,_,Tr),L):-
	list23(Tl,Ll),
	list23(Tm,Lm),
	list23(Tr,Lr),
	conc(Ll,Lm,Ln),
	conc(Ln,Lr,L).
list23(e,[]).

7.3

permutation([],[]).
permutation([X|Xs],Y):-
	permutation(Xs,Z),
	s(X,Z,Y).

letter(Writer,Writer,Other,Others):-
	not(Other=Others).
letter(Writer,Writers,Other,Other):-
	not(Writer=Writers).

liars(Betty,Ethel,Joan,Kitty,Mary):-
	permutation([1,2,3,4,5],[Betty,Ethel,Joan,Kitty,Mary]),
	letter(Betty,3,Kitty,2),
	letter(Ethel,1,Joan,2),
	letter(Joan,3,Ethel,5),
	letter(Kitty,2,Mary,4),
	letter(Mary,4,Betty,1).

7.4

onko(x(T),T).
onko(ja(F,G),tosi):- onko(F,tosi), onko(G,tosi).
onko(ja(F,G),vale):- onko(tai(ei(F),ei(G)),tosi).
onko(tai(F,_),tosi):- onko(F,tosi).
onko(tai(_,G),tosi):- onko(G,tosi).
onko(tai(F,G),vale):- onko(ja(ei(F),ei(G)),tosi).
onko(ei(F),tosi):- onko(F,vale).
onko(ei(F),vale):- onko(F,tosi).
onko(impl(F,G),T) :- onko(tai(ei(F),G),T).
onko(ekv(F,G),T) :- onko(ja(impl(F,G),impl(G,F)),T).

7.5

queens(Board,Solution):-
	queens(Board,Board,Solution).
queens(_,0,[]).
queens(Brd,Row,[sq(Row,Col)|Sol]) :-
	Row>0,
	Row1 is Row-1,
	queens(Brd,Row1,Sol),
	between(1,Brd,Col),
	not(threats(sq(Row,Col),Sol)).

threats(Square1,Squares) :- member(Square2,Squares), threat(Square1,Square2).

threat(sq(_,Col),sq(_,Col)).

threat(sq(Row1,Col1),sq(Row2,Col2)) :- abs(Row1-Row2)=:=abs(Col1-Col2).

7.6

parents(X,Y,Z) :- daughter(X,Y,Z).
parents(X,Y,Z) :- son(X,Y,Z).
parent(X,Y) :- parents(Y,X,_).
parent(X,Y) :- parents(Y,_,X).
siblings(X,Y) :- parents(X,U,V), parents(Y,U,V), not(X=Y).
cousins(X,Y):- parent(Z,X), parent(U,Y), siblings(Z,U).

8. laskarit

8.1

child(X,Mother,Father) :- son(X,Mother,Father).
child(X,Mother,Father) :- daughter(X,Mother,Father).

% a)

family(M,D,C) :- bagof(X,child(X,M,D),C).

% b)

sum([],0).
sum([X|XS],I+X) :- sum(XS,I).

average(List,Sum/Len) :- sum(List,Sum), length(List,Len).

familySize(R) :- 
	findall(Child,family(_,_,Child),ChildLists),
	maplist(length,ChildLists,Lengths),
	average(Lengths,Avg),
	R is Avg.

% c)

isCarrier(Y) :- setof(X,carrier(X),Y).

8.2

Nykäsen malliratkaisu (hieman siistittynä). Jos ymmärrät tämän, ymmärrät Prologia.

emptyQueue(q(X,X)).
enQueue(q(H,[A|As]),A,q(H,As)).
deQueue(q(H,_),_,_) :- var(H), !, fail.
deQueue(q([A|As],T),A,q(As,T)).

"Perinteisempi" ratkaisu, funktionaalinen jono. Tämä ei aivan täytä tehtävän ehtoja (reverse käy listan läpi), mutta tasoitettu aikavaatimus on silti vakio.

emptyQueue(q([],[])).
enQueue(q(H,T),X,q([X|H],T)).
deQueue(q(H,[X|T]),X,q(H,T)).
deQueue(q(H,[]),X,q([],T)) :- reverse(H,[X|T]).

8.3

tc(t,bool,_) :- !.
tc(f,bool,_).
tc(C,int,_) :- integer(C).
tc(V,T,[(V,S)|_]) :- !, S=T.
tc(V,T,[_|Env]) :- tc(V,T,Env).
tc(if(Test,Then,Else),T,Env) :-
	tc(Test,bool,Env),
	tc(Then,T,Env),
	tc(Else,T,Env).
tc(app(F,X),T,Env) :-
	tc(F,fun(S,T),Env),
	tc(X,S,Env).
tc(lambda(V,X),fun(S,T),Env) :- 
	!, atom(V),
	tc(X,T,[(V,S)|Env]).
% operaattorit esitetään funktioina, joten niitä täytyy käyttää
% "kuritettuna": ((+ x) y)
topenv([(+,fun(int,fun(int,int))),
	(-,fun(int,fun(int,int))),
	(*,fun(int,fun(int,int))),
	(/,fun(int,fun(int,int))),
	(=,fun(int,fun(int,bool))),
	(<,fun(int,fun(int,bool)))]).

Lauri Alanko
Last modified: Tue Dec 10 17:14:10 EET 2002