From: david
Subject: newfen.lisp version 0.02
Date: Tue, 03 Mar 2009 20:34:52 +0000
Message-ID: <e7c55ba6-c0ad-458e-9de5-56a4425b26e5@r36g2000vbp.googlegroups.com> please look at my new working code. thanks to all who helped
me get this far.
(defclass chessboard ()
((board-position :accessor state
:initform (make-array '(8 8) :initial-element '0))))
(defmethod put-piece ((board chessboard) x y p)
(setf (aref (state board) x y) p))
(defun empty-cell-p (cell) (eql 0 cell))
(defmethod print-board-to-string ((board chessboard))
(with-output-to-string (*standard-output*)
(flet ((columns ()
(format t " | A | B | C | D | E | F | G | H | ~
%"))
(line ()
(format t "----+----+----+----+----+----+----+----+----+----~
%")))
(loop :for i :from 7 :downto 0
:initially (terpri) (columns) (line)
:do (loop :for j :from 0 :below 8
:initially (format t " ~2D |" (1+ i))
:for cell = (aref (state board) j i)
:do (if (empty-cell-p cell)
(princ " |")
(format t " ~2A |" cell))
:finally (format t " ~2D ~%" (1+ i)) (line))
:finally (columns)))))
(defmethod print-object ((board chessboard) stream)
(print-unreadable-object (board stream :identity t :type t)
(let ((*print-readably* nil))
(format stream " ~A" (print-board-to-string board))))
board)
(defun get-four-unique-random-numbers ()
(loop
:with results = '()
:for alea = (random 64)
:while (< (length results) 4)
:do (pushnew alea results)
:finally (return results)))
(defun rank-file (position)
(multiple-value-bind (quotient remainder)
(truncate position 8)
(list quotient remainder)))
(defun reverse-rank-file (lst)
(let ((x (first lst))
(y (second lst)))
(+ y (* 8 x))))
(defun get-positions ()
(mapcar #'cons '(wk wn wb bk) (get-four-unique-random-numbers)))
(defun neighbor (x)
(list (1- x) x (1+ x)))
(defun bad-squares (wk)
"bad-squares is bad because it doesn't care about edge cases."
(let ((column-neighbors (neighbor (second wk))))
(loop for x in (neighbor (first wk))
append (loop for y in column-neighbors
collect (list x y)))))
(defun legal-position()
(let* ((lst (get-positions))
(wk (rank-file (cdr (assoc 'wk lst))))
(bk (rank-file (cdr (assoc 'bk lst)))))
(if (not (member (reverse-rank-file bk)
(mapcar #'reverse-rank-file (bad-squares wk))))
lst (legal-position))))
(defun numberify-position ()
(let ((lst (legal-position)))
(loop for i in '(wk wn wb bk)collect
(cdr (assoc i lst)))))
(defun random-chessboard ()
"Returns a fresh random chessboard with pieces wk wb wn and bk."
(let ((chessboard (make-instance 'chessboard)))
(mapc #'(lambda (pos piece)
(put-piece chessboard (first pos)
(second pos) piece))
(mapcar #'rank-file (numberify-position)) '(wk wb wn bk))
chessboard)) From: david
Subject: Re: newfen.lisp version 0.02
Date: Tue, 03 Mar 2009 23:40:01 +0000
Message-ID: <66f275ce-5c1d-4f38-aaed-4e556c1a5729@r27g2000vbp.googlegroups.com> now i have a function:
CL-USER> (make-fenlist)
((8) (BK 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
which is almost there. i need to convert make-fenlist
result to a string "8/k7/6N1/8/8/8/5B2/K7"
so now i need to distinguish between upper and lower case.
i don't know how to do this. please help?
(defclass chessboard ()
((board-position :accessor state
:initform (make-array '(8 8) :initial-element '0))))
(defmethod put-piece ((board chessboard) x y p)
(setf (aref (state board) x y) p))
(defun empty-cell-p (cell) (eql 0 cell))
(defmethod print-board-to-string ((board chessboard))
(with-output-to-string (*standard-output*)
(flet ((columns ()
(format t " | A | B | C | D | E | F | G | H | ~
%"))
(line ()
(format t "----+----+----+----+----+----+----+----+----+----~
%")))
(loop :for i :from 7 :downto 0
:initially (terpri) (columns) (line)
:do (loop :for j :from 0 :below 8
:initially (format t " ~2D |" (1+ i))
:for cell = (aref (state board) j i)
:do (if (empty-cell-p cell)
(princ " |")
(format t " ~2A |" cell))
:finally (format t " ~2D ~%" (1+ i)) (line))
:finally (columns)))))
(defmethod print-object ((board chessboard) stream)
(print-unreadable-object (board stream :identity t :type t)
(let ((*print-readably* nil))
(format stream " ~A" (print-board-to-string board))))
board)
(defun get-four-unique-random-numbers ()
(loop
:with results = '()
:for alea = (random 64)
:while (< (length results) 4)
:do (pushnew alea results)
:finally (return results)))
(defun rank-file (position)
(multiple-value-bind (quotient remainder)
(truncate position 8)
(list quotient remainder)))
(defun reverse-rank-file (lst)
(let ((x (first lst))
(y (second lst)))
(+ y (* 8 x))))
(defun get-positions ()
(mapcar #'cons '(wk wn wb bk) (get-four-unique-random-numbers)))
(defun neighbor (x)
(list (1- x) x (1+ x)))
(defun bad-squares (wk)
"bad-squares is bad because it doesn't care about edge cases."
(let ((column-neighbors (neighbor (second wk))))
(loop for x in (neighbor (first wk))
append (loop for y in column-neighbors
collect (list x y)))))
(defun legal-position()
(let* ((lst (get-positions))
(wk (rank-file (cdr (assoc 'wk lst))))
(bk (rank-file (cdr (assoc 'bk lst)))))
(if (not (member (reverse-rank-file bk)
(mapcar #'reverse-rank-file (bad-squares wk))))
lst (legal-position))))
(defun numberify-position ()
(let ((lst (legal-position)))
(loop for i in '(wk wn wb bk)collect
(cdr (assoc i lst)))))
(defun random-chessboard ()
"Returns a fresh random chessboard with pieces wk wb wn and bk."
(let ((chessboard (make-instance 'chessboard)))
(mapc #'(lambda (pos piece)
(put-piece chessboard (first pos)
(second pos) piece))
(mapcar #'rank-file (numberify-position)) '(wk wb wn bk))
chessboard))
(defun compress (x)
(if (consp x)
(compr (car x) 1 (cdr x))
x))
(defun compr (elt n lst)
(if (null lst)
(list (n-elts elt n))
(let ((next (car lst)))
(if (eql next elt)
(compr elt (+ n 1) (cdr lst))
(cons (n-elts elt n)
(compr next 1 (cdr lst)))))))
(defun n-elts (elt n)
(if (> n 1)
n elt))
(defun make-fenlist ()
(let* ((a (random-chessboard))
(b (reverse (loop for j from 0 to 7
collect (loop for i from 0 to 7
collect (aref (state a) i j)))))
(c (subst 1 0 (mapcar #'compress b))))
c)) From: Chris Riesbeck
Subject: Re: newfen.lisp version 0.02
Date: Wed, 04 Mar 2009 19:10:41 +0000
Message-ID: <71821iFjie64U1@mid.individual.net> david wrote:
> now i have a function:
>
> CL-USER> (make-fenlist)
> ((8) (BK 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
>
> which is almost there. i need to convert make-fenlist
> result to a string "8/k7/6N1/8/8/8/5B2/K7"
>
> so now i need to distinguish between upper and lower case.
> i don't know how to do this. please help?
The symbols are all upper case. The first character of the symbol name,
B or W, tells you what case to print the second letter. E.g.,
(defun piece-char (piece)
(let ((ch (char (symbol-name piece) 1)))
(if (char= #\B (char (symbol-name piece) 0))
(char-downcase ch)
ch)))
>
> (defclass chessboard ()
> ((board-position :accessor state
> :initform (make-array '(8 8) :initial-element '0))))
>
> (defmethod put-piece ((board chessboard) x y p)
> (setf (aref (state board) x y) p))
>
> (defun empty-cell-p (cell) (eql 0 cell))
>
> (defmethod print-board-to-string ((board chessboard))
> (with-output-to-string (*standard-output*)
> (flet ((columns ()
> (format t " | A | B | C | D | E | F | G | H | ~
> %"))
> (line ()
> (format t "----+----+----+----+----+----+----+----+----+----~
> %")))
> (loop :for i :from 7 :downto 0
> :initially (terpri) (columns) (line)
> :do (loop :for j :from 0 :below 8
> :initially (format t " ~2D |" (1+ i))
> :for cell = (aref (state board) j i)
> :do (if (empty-cell-p cell)
> (princ " |")
> (format t " ~2A |" cell))
> :finally (format t " ~2D ~%" (1+ i)) (line))
> :finally (columns)))))
>
> (defmethod print-object ((board chessboard) stream)
> (print-unreadable-object (board stream :identity t :type t)
> (let ((*print-readably* nil))
> (format stream " ~A" (print-board-to-string board))))
> board)
>
> (defun get-four-unique-random-numbers ()
> (loop
> :with results = '()
> :for alea = (random 64)
> :while (< (length results) 4)
> :do (pushnew alea results)
> :finally (return results)))
>
> (defun rank-file (position)
> (multiple-value-bind (quotient remainder)
> (truncate position 8)
> (list quotient remainder)))
>
> (defun reverse-rank-file (lst)
> (let ((x (first lst))
> (y (second lst)))
> (+ y (* 8 x))))
>
> (defun get-positions ()
> (mapcar #'cons '(wk wn wb bk) (get-four-unique-random-numbers)))
>
> (defun neighbor (x)
> (list (1- x) x (1+ x)))
>
> (defun bad-squares (wk)
> "bad-squares is bad because it doesn't care about edge cases."
> (let ((column-neighbors (neighbor (second wk))))
> (loop for x in (neighbor (first wk))
> append (loop for y in column-neighbors
> collect (list x y)))))
>
> (defun legal-position()
> (let* ((lst (get-positions))
> (wk (rank-file (cdr (assoc 'wk lst))))
> (bk (rank-file (cdr (assoc 'bk lst)))))
> (if (not (member (reverse-rank-file bk)
> (mapcar #'reverse-rank-file (bad-squares wk))))
> lst (legal-position))))
>
> (defun numberify-position ()
> (let ((lst (legal-position)))
> (loop for i in '(wk wn wb bk)collect
> (cdr (assoc i lst)))))
>
> (defun random-chessboard ()
> "Returns a fresh random chessboard with pieces wk wb wn and bk."
> (let ((chessboard (make-instance 'chessboard)))
> (mapc #'(lambda (pos piece)
> (put-piece chessboard (first pos)
> (second pos) piece))
> (mapcar #'rank-file (numberify-position)) '(wk wb wn bk))
> chessboard))
>
> (defun compress (x)
> (if (consp x)
> (compr (car x) 1 (cdr x))
> x))
>
> (defun compr (elt n lst)
> (if (null lst)
> (list (n-elts elt n))
> (let ((next (car lst)))
> (if (eql next elt)
> (compr elt (+ n 1) (cdr lst))
> (cons (n-elts elt n)
> (compr next 1 (cdr lst)))))))
>
> (defun n-elts (elt n)
> (if (> n 1)
> n elt))
>
> (defun make-fenlist ()
> (let* ((a (random-chessboard))
> (b (reverse (loop for j from 0 to 7
> collect (loop for i from 0 to 7
> collect (aref (state a) i j)))))
> (c (subst 1 0 (mapcar #'compress b))))
> c))
> From: Thomas A. Russ
Subject: Re: newfen.lisp version 0.02
Date: Thu, 05 Mar 2009 00:11:48 +0000
Message-ID: <ymi4oy8ltff.fsf@blackcat.isi.edu> Chris Riesbeck <··············@gmail.com> writes:
> david wrote:
> > now i have a function:
> > CL-USER> (make-fenlist)
> > ((8) (BK 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
> > which is almost there. i need to convert make-fenlist
> > result to a string "8/k7/6N1/8/8/8/5B2/K7"
> > so now i need to distinguish between upper and lower case.
> > i don't know how to do this. please help?
>
> The symbols are all upper case. The first character of the symbol name,
> B or W, tells you what case to print the second letter. E.g.,
>
> (defun piece-char (piece)
> (let ((ch (char (symbol-name piece) 1)))
> (if (char= #\B (char (symbol-name piece) 0))
> (char-downcase ch)
> ch)))
Or, alternately, one could choose to make the symbols have the proper
case and then not have to worry about case conversion at all:
((8) (|Bk| 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
Then you just need:
(defun fen-char (piece)
(char (symbol-name piece) 1))
--
Thomas A. Russ, USC/Information Sciences Institute From: Thomas A. Russ
Subject: Re: newfen.lisp version 0.02
Date: Thu, 05 Mar 2009 00:18:24 +0000
Message-ID: <ymi1vtclt4f.fsf@blackcat.isi.edu> Chris Riesbeck <··············@gmail.com> writes:
> david wrote:
> > now i have a function:
> > CL-USER> (make-fenlist)
> > ((8) (BK 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
> > which is almost there. i need to convert make-fenlist
> > result to a string "8/k7/6N1/8/8/8/5B2/K7"
> > so now i need to distinguish between upper and lower case.
> > i don't know how to do this. please help?
>
> The symbols are all upper case. The first character of the symbol name,
> B or W, tells you what case to print the second letter. E.g.,
>
> (defun piece-char (piece)
> (let ((ch (char (symbol-name piece) 1)))
> (if (char= #\B (char (symbol-name piece) 0))
> (char-downcase ch)
> ch)))
Or, alternately, one could choose to make the symbols have the proper
case and then not have to worry about case conversion at all:
((8) (|Bk| 7) (6 WN 1) (8) (8) (8) (5 WB 2) (WK 7))
Then you just need:
(defun fen-char (piece)
(char (symbol-name piece) 1))
Or, if you want more control over the transformation, you could provide
translations and store them either in some central data structure such
as an association list (ALIST):
(defvar *fen-chars*
'((BK . "k") (BQ . "q") (BB . "b") (BK . "k") (BR . "r") (BP . "p")
(WK . "K") (WQ . "Q") (WB . "B") (WK . "K") (WR . "R") (WP . "P")))
and then use
(defun fen-char (piece)
(cdr (assoc piece *fen-chars*)))
or else you could use the symbol PLIST and attach the information
directly to the symbol:
(setf (get 'bk :fen-char) "k")
....
(get piece :fen-char)
--
Thomas A. Russ, USC/Information Sciences Institute