Added new files.

Pascal J. Bourguignon [2015-06-11 13:08]
Added new files.
Filename
README
example-lisp.lisp
p47-scratch.lisp
p49-scratch.lisp
p50.lisp
p81.lisp
p82.lisp
p83.lisp
p84.lisp
p85.lisp
p91.lisp
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.
ViewGit