neingeist

heute nichts in der kategorie: “was ein neingeist gerne auf seinen schreibtisch stellen würde”. (via jojo)

I hate Movable Type. Struggling with the comment spam (about certain drugs helping men be men again, you know), I tried to install the SCode plugin; with the effect that now no comments can be posted anymore. I suspect that it’s the braindead BSD philosophy that lead to two broken Perl versions on bl0rg.net. One is the antique 5.00503, the other one is Perl 5.8. Thanks, BSD, now I know why you use a helldemon as your mascot.

Maybe I should enhance BKNR‘s blogging features, when I have more time learning Lisp, but then again… BKNR is just another bastard love child of Manuel, a knight of just that punk BSD philosophy, I can already hear his demonic laughter.

Und noch ein wenig Lisp-Code, diesmal eine Übungsaufgabe für meine Vorlesung Kognitive Systeme. Es ging darum, das Wort mit der größten Ähnlichkeit zu *word-from* aus der Liste *words-to* herauszufinden. Höherer Score bedeutet hier eine höhere Ähnlichkeit, in den Vorlesungen Info II und Info IV war das andersherum definiert (Editierabstand) und die Matrix anders initialisiert.

(defparameter *word-from* "DAABBCADBBA")
(defparameter *words-to* '("DDABCBA" "BAAATTCDBA" "DAABCCACBBA" "DAABBAABB" "AABDBCDBBC"))
(defparameter *word-to* nil)
(defparameter *matrix* nil)

(defun run ()
(declare (special *word-to*))
(dolist (*word-to* *words-to*)
(setf *matrix* (make-array (list (1+ (length *word-from*)) (1+ (length *word-to*))) :initial-element nil))
(init-matrix)
(do-score)
(show-matrix)))

(defun init-matrix ()
(dotimes (x (array-dimension *matrix* 0))
(setf (aref *matrix* x 0) 0))
(dotimes (y (array-dimension *matrix* 1))
(setf (aref *matrix* 0 y) 0)))

(defun show-matrix ()
(format t "        ")
(dotimes (x (length *word-from*))
(format t "~G   " (subseq *word-from* x (1+ x))))
(format t "~%")
(dotimes (y (array-dimension *matrix* 1))
(if (zerop y)
(format t "  ")
(format t "~G " (subseq *word-to* (1- y) y)))
(dotimes (x (array-dimension *matrix* 0))
(format t "~3D " (aref *matrix* x y)))
(format t "~%"))
(format t "~%"))

(defun score (x y)
(apply #'max
(list           (if (equal (subseq *word-from* (1- x) x)
(subseq *word-to* (1- y) y))
(+ (aref *matrix* (1- x) (1- y)) 2)
(+ (aref *matrix* (1- x) (1- y)) -1))
(+ (aref *matrix* (1- x) y) -3)
(+ (aref *matrix* x (1- y)) -2))))

(defun do-score ()
(loop for y from 1 to (length *word-to*) do
(loop for x from 1 to (length *word-from*) do
(setf (aref *matrix* x y) (score x y)))))

Another toy problem from the ITA software page is the Add-A-Gram:

An “add-a-gram”
is a sequence of words formed by starting with a 3-letter word, adding
a letter and rearranging to form a 4-letter word, and so on. For example,
here are add-a-grams of the words “CREDENTIALS” and “ANACHRONISM”:

ail + s =
sail + n =
nails + e =

aliens + t =
salient + r =
entrails + c =
clarinets + e =
interlaces + d =
CREDENTIALS (length 11)

(…) given the dictionary found
here (1.66MB), what is the longest add-a-gram?

Running my code to get the longst add-a-gram is left as an exercise to the reader 😉 I also did some basic performance testing and compared the results
of my Lisp version to those of the versions on the site in
Perl
and Python. Looks like Lisp isn’t so slow after all. Timings and Lisp code follow:
(more…)

Another nice toy problem I found on

the career page of ITA Software (which has some more problems for breakfast 😉 is the “Nine Nines” problem:

Combining nine 9s with any number of the operators +, -, *, /, (, ) , what is the smallest positive integer that cannot be expressed?

I already had a look on
the Lisp solution by Luke Gorrie by way of the Small-cl-src
mailing list, a mailing list intended for small Common Lisp source snippets, so my solution might look a little like his. But I tried not to copy his code, maybe that’s the reason why mine is quite a bit slower (actually, it’s a lot slower…). I guess
it’s because of my excessive use of lists and the pushnew statement instead of
a hash table, as he uses one. Maybe the Lisp wizards in the neighbourhood will enlighten me sometime, and I’ll post a new faster version.

(defun nines (n)
"Gives the solution to the n-nines problem."
(let ((solutions (make-array (1+ n) :initial-element nil)))
(setf (aref solutions 1) '(9))
(do ((k 2 (1+ k)))
((> k n))
(format t "solve for ~G ~%" k)
(solve solutions k))
(find-first-missing-integer solutions n)))

(defun solve (solutions n)
"Find all possible combinations for n nines, using the already
calculated combinations of 1 to n-1 nines"

(do ((k 1 (1+ k)))
((> k (/ n 2)))
(format t "inner loop ~G ~G ~%" n k)
(dolist (solution (combine (aref solutions k) (aref solutions (- n k))))
(pushnew solution (aref solutions n)))))

(defun find-first-missing-integer (solutions n)
"Find the first missing integer, our solution."

(do ((k 1 (1+ k)))
((not (member k (aref solutions n))) k)))

(defun combine (a b)
"Gives arithmetic combinations of the members of a and b"

(let ((foo nil))
(dolist (x a)
(dolist (y b)
(pushnew (+ x y) foo)
(pushnew (abs (- x y)) foo)
(pushnew (* x y) foo)
(unless (zerop y) (pushnew (/ x y) foo))
(unless (zerop x) (pushnew (/ y x) foo))))
foo))

Other solutions which I found on the web: Luke’s Haskell version, Karl Zilles’ port to ML and Nicolas Minutillo’s solution in Java (22 pages!).

One of my favorite problems when I try new programming languages is the Knight’s Tour. The goal is to move a knight on a chess board in a way that each square of the chess board is visited exactly once. The naive approach is to use simple backtracing, but a better way was found in the 19th century by H. C. Warnsdorff. This is an implementation of his algorithm. I hope the Lisp code is not too embarassing.

(defun start-tour (position)
(let ((board (make-array '(8 8))))
(move position board 1)))

(defun move (position board n)
(setf (aref board (car position) (cadr position)) n)
;;  (print-board board)
;;  (print (evaluate-possible-moves position board))
;;  (format t "~%")
(cond ((= n 64) (print-board board))
((null (possible-moves position board)) 'failed-dead-end)
((< n 64) (move (best-move position board) board (+ n 1)))))

(defun best-move (position board)
(car (evaluate-possible-moves position board)))

(defun evaluate-possible-moves (position board)
;;  (print position)
;;  (format t "~%")
(sort (mapcar #'(lambda (x) (append x (list (length (possible-moves x board)))))
(possible-moves position board))
#'(lambda (triple-a triple-b) (< (caddr triple-a) (caddr triple-b)))))

(defun print-board (board)
(do ((x 0 (+ x 1)))
((= x 8))
(do ((y 0 (+ y 1)))
((= y 8))
(format t "~2D " (aref board x y)))
(format t "~%"))
(format t "~%"))

(defun on-board-p (position)
(and (>= (car position) 0)
(<= (car position) 7)
(>= (cadr position) 0)
(<= (cadr position) 7)))

(defun visited-p (position board)
(> (aref board (car position) (cadr position)) 0))

(defun possible-moves (position board)
(remove-if #'(lambda (x) (visited-p x board)) (moves position)))

(defun moves (position)
(let ((x (car position))
(y (cadr position)))
(remove-if-not #'on-board-p
`((,(+ x 1) ,(+ y 2))
(,(+ x 1) ,(- y 2))
(,(- x 1) ,(+ y 2))
(,(- x 1) ,(- y 2))
(,(+ x 2) ,(+ y 1))
(,(+ x 2) ,(- y 1))
(,(- x 2) ,(+ y 1))
(,(- x 2) ,(- y 1))))))

I deciced to give Lisp a try and currently I’m struggling with a lot of parentheses and a lot of lambdas. Anyway, for the first day (or night) I’m really proud of this beauty: 🙂

;; Problem 3-9 (without tolerance)
(defun rightp (a b c)
(let ((longest-side-square (expt (car (sort (list a b c) '>)) 2))
(shorter-side-square-sum (apply '+ (mapcar (lambda (x) (expt x 2))
(cdr (sort (list a b c) '>))))))
(= longest-side-square shorter-side-square-sum)))

Thanks to Manuel of the BKNR project for their htmlize.lisp code!