Pascal J. Bourguignon [2015-06-11 13:08]
diff --git a/README b/README
new file mode 100644
index 0000000..de2219f
--- /dev/null
+++ b/README
@@ -0,0 +1,15 @@
+From: Paul Rubin <no.email@nospam.invalid>
+Subject: Re: Exercises please
+Newsgroups: comp.lang.lisp
+Date: Tue, 27 Jan 2015 19:30:15 -0800 (28 minutes, 27 seconds ago)
+Organization: A noiseless patient Spider
+Message-ID: <87zj934m60.fsf@jester.gateway.sonic.net>
+
+Helmut Jarausch <hjarausch@gmail.com> writes:
+> Would anybody please recommend online exercises for learning Lisp?
+
+Not Lisp specific but projecteuler.net is nice if you like
+mathematically oriented exercises, and rubyquiz.com is good if you want
+less mathematical ones. Rubyquiz is intended for Ruby and some of the
+items are Ruby-specific, but lots of them are nice for other languages
+too.
diff --git a/example-lisp.lisp b/example-lisp.lisp
new file mode 100644
index 0000000..2a9f446
--- /dev/null
+++ b/example-lisp.lisp
@@ -0,0 +1,154 @@
+;;;;**************************************************************************
+;;;;FILE: example-lisp.lisp
+;;;;LANGUAGE: Common-Lisp
+;;;;SYSTEM: Common-Lisp
+;;;;USER-INTERFACE: NONE
+;;;;DESCRIPTION
+;;;;
+;;;; An example grammar for the recusive descent parser generator.
+;;;; The actions are written in Lisp, to generate a lisp parser.
+;;;;
+;;;;AUTHORS
+;;;; <PJB> Pascal Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;; 2006-09-10 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;; GPL
+;;;;
+;;;; Copyright Pascal Bourguignon 2006 - 2006
+;;;;
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License
+;;;; as published by the Free Software Foundation; either version
+;;;; 2 of the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be
+;;;; useful, but WITHOUT ANY WARRANTY; without even the implied
+;;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;;; PURPOSE. See the GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with this program; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Boston, MA 02111-1307 USA
+;;;;**************************************************************************
+
+
+(defpackage "EXAMPLE"
+ (:use "COMMON-LISP" "COM.INFORMATIMAGO.RDP")
+ (:export "PARSE-EXAMPLE"))
+(in-package "EXAMPLE")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Example Language
+;;; taken from: http://en.wikipedia.org/wiki/Recursive_descent_parser
+;;;
+
+(defgrammar example
+ :terminals ((ident "[A-Za-z][A-Za-z0-9]*")
+ ;; real must come first to match the longest first.
+ (real "^\\([-+]\\?[0-9]\\+\\.[0-9]\\+\\([Ee][-+]\\?[0-9]\\+\\)\\?\\)")
+ (integer "[-+]\\?[0-9]\\+"))
+ :start program
+ :rules ((--> factor
+ (alt ident
+ number
+ (seq "(" expression ")" :action $2))
+ :action $1)
+ (--> number (alt integer real) :action $1)
+ (--> term
+ factor (rep (alt "*" "/") factor)
+ :action `(,$1 . ,$2))
+ (--> expression
+ (opt (alt "+" "-"))
+ term
+ (rep (alt "+" "-") term :action `(,$1 ,$2))
+ :action `(+ ,(if $1 `(,$1 ,$2) $2) . ,$3))
+ (--> condition
+ (alt (seq "odd" expression
+ :action `(oddp ,$2))
+ (seq expression
+ (alt "=" "#" "<" "<=" ">" ">=")
+ expression
+ :action `(,$2 ,$1 ,$3)))
+ :action $1)
+ (--> statement
+ (opt (alt (seq ident ":=" expression
+ :action `(setf ,$1 ,$3))
+ (seq "call" ident
+ :action `(call ,$2))
+ (seq "begin" statement
+ (rep ";" statement
+ :action $2)
+ "end"
+ :action `(,$2 . ,$3))
+ (seq "if" condition "then" statement
+ :action `(if ,$2 ,$4))
+ (seq "while" condition "do" statement
+ :action `(while ,$2 ,$4))))
+ :action $1)
+ (--> block
+ (opt "const" ident "=" number
+ (rep "," ident "=" number
+ :action `(,$2 ,$4))
+ ";"
+ :action `((,$2 ,$4) . ,$5))
+ (opt "var" ident
+ (rep "," ident :action $2)
+ ";"
+ :action `(,$2 . ,$3))
+ (rep "procedure" ident ";" block ";"
+ :action `(procedure ,$2 ,$4))
+ statement
+ :action `(block ,$1 ,$2 ,$3 ,$4))
+ (--> program
+ block "." :action $1)))
+
+
+
+(defpackage "EXAMPLE-WITHOUT-ACTION"
+ (:use "COMMON-LISP" "COM.INFORMATIMAGO.RDP")
+ (:export "PARSE-EXAMPLE-WITHOUT-ACTION"))
+(in-package "EXAMPLE-WITHOUT-ACTION")
+
+(defgrammar example-without-action
+ :terminals ((ident "[A-Za-z][A-Za-z0-9]*")
+ ;; real must come first to match the longest first.
+ (real "^\\([-+]\\?[0-9]\\+\\.[0-9]\\+\\([Ee][-+]\\?[0-9]\\+\\)\\?\\)")
+ (integer "[-+]\\?[0-9]\\+"))
+ :start program
+ :rules ((--> factor
+ (alt ident
+ number
+ (seq "(" expression ")")))
+ (--> number (alt integer real))
+ (--> term
+ factor (rep (alt "*" "/") factor))
+ (--> expression
+ (opt (alt "+" "-"))
+ term
+ (rep (alt "+" "-") term))
+ (--> condition
+ (alt (seq "odd" expression)
+ (seq expression
+ (alt "=" "#" "<" "<=" ">" ">=")
+ expression)))
+ (--> statement
+ (opt (alt (seq ident ":=" expression)
+ (seq "call" ident)
+ (seq "begin" statement
+ (rep ";" statement)
+ "end")
+ (seq "if" condition "then" statement)
+ (seq "while" condition "do" statement))))
+ (--> block
+ (opt "const" ident "=" number
+ (rep "," ident "=" number) ";")
+ (opt "var" ident (rep "," ident) ";")
+ (rep "procedure" ident ";" block ";")
+ statement)
+ (--> program
+ block ".")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/p47-scratch.lisp b/p47-scratch.lisp
new file mode 100644
index 0000000..10f3d38
--- /dev/null
+++ b/p47-scratch.lisp
@@ -0,0 +1,110 @@
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (defstruct sexp-scanner
+;; sexp
+;; current-cell
+;; stack)
+;;
+;; ;; '(a and (not b)) --> a, and, "(", not, b, ")", $EOF
+;;
+;; (defun scan-sexp (sexp-scanner)
+;; (if )
+;; )
+;;
+;;
+;; (defun make-sexp-scanner (sexp)
+;; "Returns a scanner function")
+
+
+(defun parse-term (iexpr)
+ "
+Parses: term := variable | constant | 'not' term | infix .
+Returns the parsed expression converted to prefix, and the rest (unparsed tokens).
+"
+ (let ((token (first iexpr)))
+ (cond
+ ((eql token 'true) (values token (rest iexpr)))
+ ((eql token 'fail) (values token (rest iexpr)))
+ ((eql token 'not)
+ (if (endp (rest iexpr))
+ (error "Missing a term after 'not'")
+ (multiple-value-bind (term rest) (parse-term (rest iexpr))
+ (values `(not ,term) rest))))
+ ((symbolp token) (values token (rest iexpr)))
+ ((atom token) (error "Invalid atom ~A in the infix iexpr." iexpr))
+ (t
+ (multiple-value-bind (expr rest) (parse-infix token)
+ (assert (endp rest) () "Remains unparsed tokens: ~A" rest)
+ (values expr (rest iexpr)))))))
+
+
+(defun parse-infix (iexpr)
+ "
+Parses: infix := '(' term | term { op term } ')' .
+ op := 'and' | 'or' | 'nand' | 'nor' | 'xor' | 'impl' | 'equ' .
+Returns the parsed expression converted to prefix, and the rest (unparsed tokens).
+Note: In the returned prefix expression, all operators are binary, right associative.
+"
+ (assert (listp iexpr))
+ (multiple-value-bind (left rest) (parse-term iexpr)
+ (if (endp rest)
+ (values left rest)
+ (let ((op (first rest)))
+ (case op
+ ((and or nand nor xor impl equ)
+ (multiple-value-bind (right rest) (parse-infix (rest rest))
+ (values `(,op ,left ,right) rest)))
+ (otherwise
+ (error "Invalid operator '~A'" op)))))))
+
+
+(defun infix-to-prefix (iexpr)
+ "
+term := variable | constant | 'not' term | infix .
+infix := '(' term | term { op term } ')' .
+"
+ (multiple-value-bind (expr rest) (parse-infix iexpr)
+ (assert (endp rest) () "Remains unparsed tokens: ~A" rest)
+ expr))
+
+
+(defun test/infix-to-prefix ()
+ (assert (equal
+ (mapcar (lambda (iexpr) (handler-case (infix-to-prefix iexpr)
+ (error (err) (princ err) (terpri) :error)))
+ '((a-variable)
+ (true)
+ (fail)
+ (not a-variable)
+ (not true)
+ (not fail)
+ (not not not true)
+ (a and b)
+ (a and b and c and d)
+ (a and b or not c and not d or e and not not f or g and h or not not not i)
+ ((a and b) or (c and d))
+ ((a or not (b and c)))
+ (a and (b or not c) and (not d or e) and (not not f or g) and (h or not not not i))
+ (a and 42)
+ (a + b)
+ (a and not)
+ (not a b)))
+ '(A-VARIABLE
+ TRUE
+ FAIL
+ (NOT A-VARIABLE)
+ (NOT TRUE)
+ (NOT FAIL)
+ (NOT (NOT (NOT TRUE)))
+ (AND A B)
+ (AND A (AND B (AND C D)))
+ (AND A (OR B (AND (NOT C) (OR (NOT D) (AND E (OR (NOT (NOT F)) (AND G (OR H (NOT (NOT (NOT I)))))))))))
+ (OR (AND A B) (AND C D))
+ (OR A (NOT (AND B C)))
+ (AND A (AND (OR B (NOT C)) (AND (OR (NOT D) E) (AND (OR (NOT (NOT F)) G) (OR H (NOT (NOT (NOT I))))))))
+ :ERROR :ERROR :ERROR :ERROR)))
+ :success)
+
+;; (test/infix-to-prefix)
+;; --> :SUCCESS
diff --git a/p49-scratch.lisp b/p49-scratch.lisp
new file mode 100644
index 0000000..52f329a
--- /dev/null
+++ b/p49-scratch.lisp
@@ -0,0 +1,18 @@
+
+
+;; Here is a version giving the codes as integers:
+
+(defun gray (n)
+ (let ((result (make-array (expt 2 n))))
+ (setf (aref result 0) 0
+ (aref result 1) 1)
+ (loop
+ :for i :from 2 :to n
+ :do )
+ (if (= 1 n)
+ (list 0 1)
+ (let ((gray-1 (gray (1- n))))
+ (nconc gray-1
+ (mapcar (lambda (code) (dpb 1 (byte 1 (1- n)) code))
+ (reverse gray-1)))))))
+
diff --git a/p50.lisp b/p50.lisp
index 1640bae..9d393b0 100644
--- a/p50.lisp
+++ b/p50.lisp
@@ -24,7 +24,7 @@ P50 (***) Huffman code.
The algorithm described in:
\"A Method for the Construction of Minimum-Redundancy Codes\"
David A. Huffman, Procedings of the I.R.E.
-http://compression.ru/download/articles/huff/huffman_1952_minimum-redundancy-codes.pdf
+<http://compression.ru/download/articles/huff/huffman_1952_minimum-redundancy-codes.pdf>
is:
compute huffman code:
diff --git a/p81.lisp b/p81.lisp
index d8959c3..f953795 100644
--- a/p81.lisp
+++ b/p81.lisp
@@ -57,4 +57,5 @@ infinite number of them… "
;; ((P M ((P Q :WEIGHT 9) (M Q :WEIGHT 7) (P M :WEIGHT 5))) ((P M) (P Q M)))
;; NIL
+
;;;; THE END ;;;;
diff --git a/p82.lisp b/p82.lisp
new file mode 100644
index 0000000..426c830
--- /dev/null
+++ b/p82.lisp
@@ -0,0 +1,19 @@
+#-(and) "
+P82 (*) Cycle from a given node
+
+ Write a predicate cycle(G,A,P) to find a closed path (cycle) P
+ starting at a given node A in the graph G. The predicate should
+ return all cycles via backtracking.
+
+"
+(load "p80.lisp")
+(load "p81.lisp")
+
+
+(defmethod cycle ((g graph) node)
+ "Return a list of all the cycles passing by NODE."
+
+ )
+
+
+;;;; THE END ;;;;
diff --git a/p83.lisp b/p83.lisp
new file mode 100644
index 0000000..135b20c
--- /dev/null
+++ b/p83.lisp
@@ -0,0 +1,27 @@
+#-(and)"
+P83 (**) Construct all spanning trees
+
+ Write a predicate s-tree(Graph,Tree) to construct (by
+ backtracking) all spanning trees of a given graph. With this
+ predicate, find out how many spanning trees there are for the
+ graph depicted to the left. The data of this example graph can be
+ found in the file p83.dat. When you have a correct solution for
+ the s-tree/2 predicate, use it to define two other useful
+ predicates: is-tree(Graph) and is-connected(Graph). Both are
+ five-minutes tasks!
+"
+
+(load "p80.lisp")
+
+(defparameter *p83-example-graph*
+ (make-edge-graph '((a b) (a d)
+ (b c) (b e)
+ (c e)
+ (d e) (d f) (d g)
+ (e h)
+ (f g)
+ (g h))))
+
+
+
+
diff --git a/p84.lisp b/p84.lisp
new file mode 100644
index 0000000..bba87d0
--- /dev/null
+++ b/p84.lisp
@@ -0,0 +1,24 @@
+#-(and)"
+P84 (**) Construct the minimal spanning tree
+
+ Write a predicate ms-tree(Graph,Tree,Sum) to construct the minimal
+ spanning tree of a given labelled graph. Hint: Use the algorithm
+ of Prim. A small modification of the solution of P83 does the
+ trick. The data of the example graph to the right can be found in
+ the file p84.dat.
+"
+
+(load "p80.lisp")
+
+(defparameter *p84-example-graph*
+ (make-weighted-edge-graph '((a b 5) (a d 3)
+ (b c 2) (b e 4)
+ (c e 6)
+ (d e 7) (d f 4) (d g 3)
+ (e h 5)
+ (f g 4)
+ (g h 1))))
+
+
+
+
diff --git a/p85.lisp b/p85.lisp
new file mode 100644
index 0000000..6c46203
--- /dev/null
+++ b/p85.lisp
@@ -0,0 +1,11 @@
+#-(and)"
+P85 (**) Graph isomorphism
+
+ Two graphs G1(N1,E1) and G2(N2,E2) are isomorphic if there is a
+ bijection f: N1 -> N2 such that for any nodes X,Y of N1, X and Y
+ are adjacent if and only if f(X) and f(Y) are adjacent.
+
+ Write a predicate that determines whether two graphs are
+ isomorphic. Hint: Use an open-ended list to represent the function
+ f.
+"
diff --git a/p91.lisp b/p91.lisp
new file mode 100644
index 0000000..adc786d
--- /dev/null
+++ b/p91.lisp
@@ -0,0 +1,35 @@
+
+#|
+
+From: Daniel Torrido <danieltorridoverdeu@gmail.com>
+Subject: Re: Exercises please
+Newsgroups: comp.lang.lisp
+Date: Tue, 27 Jan 2015 21:02:57 +0100 (7 hours, 52 minutes, 56 seconds ago)
+Organization: None (http://example.com)
+Message-ID: <87k308dma6.fsf@example.com>
+
+Helmut Jarausch <hjarausch@gmail.com> writes:
+
+> Am Dienstag, 27. Januar 2015 15:40:06 UTC+1 schrieb informatimago:
+> Many thanks Pascal, that is exactly what I was looking for.
+>
+>> and my solutions (still incomplete):
+>> http://www.informatimago.com/develop/lisp/l99/index.html
+> Some links are broken, e.g., p91-p99.
+> Is that what you mean by "incomplete"?
+
+ About p91: P91 (**) Knight's tour
+ Another famous problem is this one: How can a knight jump on an NxN
+ chessboard in such a way that it visits every square exactly once?
+
+I seem to recall that someone proved that the following heuristic solves the
+problem, move the knight always to the square that has fewer neigbours,
+a neigbour of a square is a square that is not visited and that you can
+move to it in one move. That algorithms don't use backtracking. The
+origin of the 99 problems is for teaching programming in Prolog where
+backtracking allow you to formulate solution to problems easily.
+
+|#
+
+
+;; therefore, let's implement both algorithms.