Problem 8 hetmanów

Dzisiaj rozwiązać nam przyszło klasyczne zadanie programistyczne: problem 8 hetmanów. Szablon kodu podany został w treści zadania, zaś do nas należy dopisanie trzech brakujących definicji: stałej empty-board, i dwóch procedur: safe? i adjoin-position.

W zadaniu korzystamy z kilku funkcji zdefiniowanych wcześniej. Są to filter, accumulate, flatmap i enumerate-interval.

Zaczniemy od implementacji zbioru pozycji na szachownicy. Na potrzeby zadania w zupełności wystarczy użycie pary liczb jako pozycji. Szachownica będzie zaś po prostu listą takich par.

(define empty-board nil)

(define (make-position row col) (cons row col))
(define position-row car)
(define position-column cdr)

Przy tej implementacji dodanie nowej pozycji do zbioru nie jest trudne:

;; Dodaj na szachownice hetmana w pozycji row/col.
(define (adjoin-position row col board)
(cons (make-position row col) board))

Implementacja procedury safe? wymaga trochę więcej zachodu. Dla wygody skorzystałem z kilku funkcji pomocniczych ze SRFI-1.

(require (only (lib "1.ss" "srfi") any every find for-each))

;; Zwroc #t jezeli obie pozycje leza w tej samej kolumnie.
(define (same-column? position-1 position-2)
(= (position-column position-1) (position-column position-2)))

;; Zwroc #t jezeli obie pozycje leza w tym samym wierszu.
(define (same-row? position-1 position-2)
(= (position-row position-1) (position-row position-2)))

;; Zwroc #t jezeli obie pozycje leza na tej samej przekatnej.
(define (same-diagonal? position-1 position-2)
(= (abs (- (position-column position-1)
(position-column position-2)))
(abs (- (position-row position-1)
(position-row position-2)))))

;; Zwroc #t jezeli obie pozycje posiadaja te same wspolrzedne.
(define (same-position? position-1 position-2)
(and (same-column? position-1 position-2)
(same-row? position-1 position-2)))

;; Zwroc #t jezeli na szachownicy stoi hetman w podanej pozycji.
(define (position-on-board? position board)
(any (lambda (board-position) (same-position? position board-position)) board))

;; Zwroc #t jezeli hetman postawiony w podanej kolumnie nie szachuje zadnego
;; z pozostalych na szachownicy.
(define (safe? col board)
;; Hetman znajdujacy sie w podanej kolumnie.
(define queen-added (find (lambda (position)
(= (position-column position) col))
board))
;; Zwroc #t jezeli podane dwa hetmany szachuja sie.
(define (in-check? queen-1 queen-2)
(or (same-row? queen-1 queen-2)
(same-column? queen-1 queen-2)
(same-diagonal? queen-1 queen-2)))
(every (lambda (other-queen)
(or (same-position? other-queen queen-added)
(not (in-check? other-queen queen-added))))
board))

W celu wizualizacji rozwiązań użyłem następujących funkcji:

;; Wyswietl rozwiazanie dla podanej szachownicy o boku k.
(define (display-board board k)
(for-each
(lambda (row)
(begin
(for-each
(lambda (col)
(display
(if (position-on-board? (make-position row col) board) "# " ". ")))
(enumerate-interval 1 k))
(newline)))
(enumerate-interval 1 k)))

;; Wyswietl wszystkie rozwiazania dla szachownicy o boku k.
(define (display-results k)
(for-each
(lambda (board)
(begin
(display-board board k)
(newline)))
(queens k)))

By zobaczyć rozwiązania dla standardowej szachownicy 8×8, wystarczy wykonać poniższe polecenie:

(display-results 8)

Matematycznie

Dzisiaj same konkrety - rozwiązania dla ćwiczeń kończących rozdział 1.2.2.

Ćwiczenie 1.11

Ćwiczenie proste, biorąc pod uwagę to, co opisywałem wcześniej. Należy funkcję f(n) zapisać jako procedurę obliczającą wartości za pomocą procesu iteracyjnego i rekurencyjnego. Definicja funkcji jest następująca:

f(n)=n dla n<3 i f(n) = f(n-1)+2f(n-2)+3f(n-3) dla n>=3

Wersja rekurencyjna:

(define (f n)
(cond ((< n 3) n)
(else (+ (f (- n 1))
(* 2 (f (- n 2)))
(* 3 (f (- n 3)))))))

Wersja iteracyjna:

(define (f n)
(define (f-iter a b c count)
(cond ((= count 2) c)
(else (f-iter b c (+ c (* 2 b) (* 3 a)) (- count 1)))))
(cond ((< n 3) n)
(else (f-iter 0 1 2 n))))

Ćwiczenie 1.12

Zadanie polega na napisaniu procedury obliczającej elementy trójkąta Pascala. Nie sprecyzowano czy funkcja ma zwracać pojedyncze elementy, czy całe trójkąty, stworzyłem więc trzy funkcje: pascal-number oblicza wartość n-tej liczby w podanym wierszu trójkąta Pascala, pascal-row oblicza cały n-ty wiersz (zwracając listę liczb), zaś pascal-triangle oblicza cały trójkąt o zadanej wysokości (zwracając listę wierszy).

(define (pascal-number r n)
(if (or (= n 1)
(= n r))
1
(+ (pascal-number (- r 1) (- n 1))
(pascal-number (- r 1) n))))

(define (make-list-by-iterate iters-num function)
(define (iter i)
(if (> i iters-num)
()
(cons (function i)
(iter (+ i 1)))))
(iter 1))

(define (pascal-row n)
(make-list-by-iterate n
(lambda (x) (pascal-number n x))))

(define (pascal-triangle n)
(make-list-by-iterate n
(lambda (x) (pascal-row x))))

Warto zwrócić uwagę na funkcję pomocniczą make-list-by-iterate, która buduje listę z wartości zwracanych podanej funkcji wywoływanej kolejno z argumentem od 1 do iters-num. Budowanie n-tego wiersza (pascal-row) jest niczym więcej jak wywołaniem pascal-number n razy. Budowanie trójkąta Pascala o wysokości n (pascal-triangle) polega zaś na stworzeniu kolejnych jego wierszy, od pierwszego aż do n-tego.

Ćwiczenie 1.13

Obecność tego ćwiczenia wybitnie świadczy o tym, że Wizard Book jest książką pomocną w nauczaniu Informatyki, a nie zwykłym podręcznikiem do programowania. Autorzy proszą nas bowiem o przeprowadzenie matematycznego dowodu.

Udowodnij, że Fib(n) jest liczbą całkowitą najbliższą (phi^n)/sqrt(5), gdzie phi = (1 + sqrt(5))/2.
Wskazówka: Niech psi = (1 - sqrt(5))/2. Korzystając z definicji liczb Fibonacciego, udowodnij przez indukcję, że Fib(n) = (phi^n - psi^n)/sqrt(5).

Dzięki wskazówce rozwiązanie jest dość proste. Zanim przejdziemy do dowodu, przypomnijmy sobie definicję ciągu Fibonacciego i własności liczby phi i psi.

Fib(n) = Fib(n-1) + Fib(n-2)
phi^2 = phi + 1
psi^2 = psi + 1

Możemy już przejść do pierwszego kroku indukcyjnego. Sprawdzamy, czy teza zachodzi dla n równego zero i jeden.

Fib(0)

Fib(1)

Wyniki są poprawne, więc przechodzimy do kroku drugiego. Założenie (dla n>0):

Fib(n-1)=(phi^(n-1) - psi^(n-1))/sqrt(5)
Fib(n)=(phi^n - psi^n)/sqrt(5)

Teza:

Fib(n)=(phi^(n+1) - psi^(n+1))/sqrt(5)

Dowód:

Fib(n+1)=Fib(n)+Fib(n-1)
(phi^n - psi^n)/sqrt(5) + (phi^(n-1) - psi^(n-1))/sqrt(5)
(phi^n + phi^(n-1) - psi^n - psi^(n-1))/sqrt(5)
((phi^(n-1))(phi+1) - (psi^(n-1))(psi+1))/sqrt(5)
(phi^(n+1) - psi^(n+1))/sqrt(5)

Skoro wiemy już ile równe jest Fib(n), to by udowodnić, że jest ona najbliższą liczbą całkowitą dla (phi^n)/sqrt(5), należy dowieść nierówności:

|Fib(n)-(phi^n/sqrt(5))| <= 1/2

Ta oczywiście upraszcza się do postaci:

|(phi^n - psi^n)/sqrt(5) - (phi^n/sqrt(5))| <= 1/2
|(- psi^n)/sqrt(5)| <= 1/2

Lewa część wyrażenia dąży do zera zaczynając od 0.447 dla n równego zero, nierówność jest więc zawsze spełniona. Formalnie należałoby jeszcze zapisać na to dowód, jest on jednak trywialny, a mi już znudziło się wklepywanie tych wzorów. ;-) W ten oto sposób rozwiązaliśmy ćwiczenie 1.13.

Uczymy się dodawać

Przeglądając archiwa pewnego lispowego bloga natrafiłem na ciekawe zadanko. Do tego bloga pewnie jeszcze wrócimy, a tymczasem zajmijmy się samym zadaniem:

Zdefiniuj rekurencyjne funkcje LIST+ i (*) LIST- wykonujące operacje “pisemnego” dodawania i odejmowania liczb reprezentowanych przez listy cyfr dziesiętnych, np.:

(LIST+ '(1 2 3) '(6 8)) ==> (1 9 1)

(*) (LIST- '(1 9 1) '(6 8)) ==> (1 2 3)

Zadanie nie jest trudne, ale zanim przedstawię swoje rozwiązanie, kilka słów dotyczących definiowania funkcji w Scheme. Do tej pory wykorzystywałem następujący model:

(define ( )
)

Często jednak zdarza się, że podczas pisania jednej funkcji piszemy dla niej funkcje pomocnicze. Na potrzeby funkcji merge-sort powstały np. right-half, split, czy slice. Definiowanie każdej funkcji w globalnej przestrzeni nazw jest wygodne podczas eksperymentowania, bo można dowolnie zmieniać i przenosić definicje. Jeżeli jednak nasza funkcja jest częścią większego programu, dobrym zwyczajem jest ukrywać wszystkie szczegóły, udostępniając na zewnątrz tylko prosty i zwarty interface. Technikę tę nazywa się black-box abstraction, jako że dany kawałek kodu możemy traktować jako “czarną skrzynkę” - interesuje nas tylko to, jakie wartości przyjmuje na wejściu i jakie wartości zwraca. W związku z tym, że możemy każdą z tych “czarnych skrzynek” oddzielnie przetestować i wymienić w razie potrzeby, ich stosowanie znacznie ułatwia rozwijanie i debugowanie kodu. W Scheme procedury, oprócz kombinacji zwracających wartość, mogą zawierać serię pomocniczych definicji. Wzór definicji funkcji wygląda więc teraz następująco:

(define ( )

)

W taki właśnie sposób zdefiniowałem ogólną metodę list-op, która wykonuje działania “słupkami”, od jedności do najbardziej znaczących cyfr zadanych liczb.

(define (list-op operator)
(define (list-parse L1 L2 carry)
(define (safe-car L)
(if (null? L)
0
(car L)))

(define (safe-cdr L)
(if (null? L)
()
(cdr L)))

(define partial-result
(+ (operator (safe-car L1) (safe-car L2)) carry))

(define current-digit
(modulo partial-result 10))

(define new-carry
(if (< partial-result 0)
(- (quotient partial-result 10) 1)
(quotient partial-result 10)))

(cons current-digit
(if (and (null? L1)
(null? L2))
()
(list-parse (safe-cdr L1)
(safe-cdr L2)
new-carry))))

(lambda (L1 L2)
(cut-zeros (reverse (list-parse (reverse L1)
(reverse L2)
0)))))

(define (cut-zeros L)
(if (or (null? L)
(not (zero? (car L))))
L
(cut-zeros (cdr L))))

(define list+ (list-op +))
(define list- (list-op -))

Prócz tego, że funkcja lisp-op wykorzystuje black-box abstraction, jest ona również tzw. higher-order function, tzn. funkcją, która przyjmuje na wejściu funkcję i zwraca jako wartość inną funkcję. Funkcje te szczegółowo przedstawia pan Sussman w wykładzie 2a.

Funkcję cut-zeros zostawiłem na zewnątrz, bo przyda mi się ona do zdefiniowania funkcji mnożącej dwie zadane liczby reprezentowane jako listy cyfr. Implementację uczyniłem najprostszą na ile to było możliwe. Skoro potrafimy już dodawać i odejmować, mnożenie zdefiniować można następująco:

(define (list* L1 L2)
(if (null? (cut-zeros L2))
()
(list+ L1 (list* L1 (list- L2 '(1))))))

Jak widać, pomnożyć liczbę a przez b to znaczy pomnożyć a przez b-1 i dodać do wyniku a. Jeżeli zaś b jest zerem, to wynikiem mnożenia jest lista pusta (u nas będąca synonimem zera). Implementację dzielenia pozostawiam jako ćwiczenie dla czytelnika. ;-)

Sortowanie

W poprzednim wpisie rozwiązywałem zadanie 1.3 z Wizard Booka. Polegało ono na napisaniu funkcji o trzech argumentach, która zwraca sumę kwadratów dwóch większych z nich. Zastanawiałem się również nad zadaniem uogólnionym, tzn. o funkcji przyjmującą dowolną ilość argumentów, która zwraca sumę kwadratów n największych z nich. Nie potrafiłem jednak wówczas wyobrazić sobie implementacji sortowania listy. Okazało się jednak, że znowu nie myślałem rekurencyjnie.

Przyjąłem bowiem, że jeżeli mam zaimplementować sortowanie, to powinienem zacząć od jednej z prostszych metod, jak np. sortowanie bąbelkowe (ang. bubble sort). Mimo usilnych prób nie potrafiłem jednak stworzyć niczego, co byłoby przejrzyste i proste. Zagnieżdżone iteracje, indeksowanie tablic i zamiana elementów - elementy idealnie pasujące do programowania imperatywnego w świecie zamkniętych nawiasów wyglądają co najmniej dziwnie.

Wreszcie dzisiaj, w trakcie podróży pociągiem, przypomniałem sobie o rekurencyjnych metodach sortowania. W przeciągu godziny na stronach notesu udało mi się zapisać w Scheme implementację algorytmu sortowania przez scalanie (ang. merge sort). Do szczęścia potrzebne były mi w zasadzie dwie rzeczy. Pierwsza to łączenie dwóch posortowanych list w jedną posortowaną. Implementacja okazała się całkiem prosta. Przede wszystkim, jeżeli któraś z list jest pusta, to wynik równy jest drugiej liście. W przeciwnym wypadku budujemy nową listę. Na jej szczyt wkładamy mniejszy z pierwszych elementów obu list, a resztę budujemy rekurencyjnie wywołując siebie. Lista, z której zdjęto pierwszy element zostaje oczywiście go w tym wywołaniu pozbawiona.

(define (merge L1 L2)
(cond ((null? L1) L2)
((null? L2) L1)
((< (car L1) (car L2)) (cons (car L1)
(merge L2
(cdr L1))))
(else (cons (car L2)
(merge L1
(cdr L2))))))

Operator cons tworzy parę z dwóch zadanych obiektów. Jego zagnieżdżone wywołania mogą służyć do tworzenia list. Np. lista (1 2 3) może być skonstruowana za pomocą wywołania (cons 1 (cons 2 (cons 3 ()))).

Należy się też słowo sprostowania. Ostatnim razem do sprawdzania, czy lista jest pusta zdefiniowałem własną funkcję empty?. Dzisiaj w otchłaniach dokumentacji dowiedziałem się o funkcji null?, która robi dokładnie to samo.

Poprawność działania funkcji merge możemy łatwo sprawdzić.

(merge '(1 2 3 4 5) '(2 4 6))
(1 2 2 3 4 4 5 6)

Przy pomocy apostrofu w zapisie '(1 2 3 4 5) informujemy interpreter, by nie wykonywał następującej po nim kombinacji. W tym przypadku jest to zwięźlejszy sposób na zapisanie (list 1 2 3 4).

Drugą rzeczą kluczową przy implementacji merge sort jest podział listy na dwie części. To zadanie uogólniłem do funkcji zwracającej dowolny kawałek listy zawarty pomiędzy zadanymi indeksami (czyli coś na wzór pythonowej metody slice).

; (head L): zwroc liste bez ostatniego elementu
(define (head L)
(if (= (length L) 1)
()
(cons (car L)
(head (cdr L)))))

(define (slice L start end)
(if (= start 0)
(if (> end (- (length L) 1))
L
(slice (head L) start end))
(slice (cdr L) (- start 1) (- end 1))))

Przykładowo więc dla listy (7 11 13 17 19 23) użycie

(slice L 0 2)

zwróci (7 11) (czyli element pierwszy i drugi), zaś

(slice L 2 5)

zwróci (13 17 19) (elementy od trzeciego do szóstego).

Na podstawie tej funkcji z łatwością możemy już podzielić listę na dwie części.

(define (split L index)
(list (slice L 0 index)
(slice L index (length L))))

Funkcja split dzieli listę w miejscu wskazanym przez indeks i zwraca listę, której pierwszym elementem jest lewa część zadanej listy, a drugim elementem prawa część. W merge sort będziemy dzielić listę dokładnie w połowie, dlatego warto zdefiniować do tego oddzielną funkcję:

(define (split-half L)
(split L (quotient (length L) 2)))

Lewą i prawą część listy uzyskujemy więc w ten sposób:

(define (left-half L)
(car (split-half L)))

(define (right-half L)
(cadr (split-half L)))

(cadr L) jest skrótowym zapisem dla kombinacji (car (cdr L)).
I to już wszystko, co jest potrzebne do zapisania algorytmu merge sort.

(define (merge-sort L)
(if (< (length L) 2)
L
(merge (merge-sort (left-half L))
(merge-sort (right-half L)))))

Czy to nie było proste? ;-)

Ostateczne rozwiązanie uogólnionego zadania 1.3 wygląda więc następująco:

; (max L n): zwroc n najwiekszych elementow z listy L
(define (max L n)
(slice (reverse (merge-sort L)) 0 n))

(define (square x)
(* x x))

(define (sum-of-squares L)
(if (null? L)
0
(+ (square (car L))
(sum-of-squares (cdr L)))))

(define (fun L n)
(sum-of-squares (max L n)))

« Wcześniejsze wpisy ·