From: Glenn M. Lewis
Subject: Programming challenge
Date: 
Message-ID: <zZ2ag.3256$G95.2497@tornado.socal.rr.com>
Hi all!

	I'm another Ruby fanatic attempting to learn CL (and hopefully
later, genetic programming).

	I came across a very cool hardware design challenge in a magazine
and the author summarized the whole thing at this website:

http://www.pldesignline.com/howto/showArticle.jhtml;?articleID=187202855

	I was thinking that there must be an excellent way to write a
program that solves this problem using Common Lisp, but I haven't been
able to do so yet.

	Does anyone want to try coming up with a CL solution?

	Thanks!
-- Glenn

From: Glenn M. Lewis
Subject: Re: Programming challenge
Date: 
Message-ID: <1K3ag.3334$G95.1617@tornado.socal.rr.com>
Sorry to reply to my own post... I should have included this earlier.
Here is what I have so far... comments are welcome, as I'm a total
CL newbie:

(defun golden-solution (a b c)
   (values (not a) (not b) (not c)))
(defun bad-solution (a b c)
   (values a b c))
(defun test-func (func)
   (cond
     ((not (equal (funcall func nil nil nil) (values  t   t   t ))) nil)
     ((not (equal (funcall func nil nil  t ) (values  t   t  nil))) nil)
     ((not (equal (funcall func nil  t  nil) (values  t  nil  t ))) nil)
     ((not (equal (funcall func nil  t   t ) (values  t  nil nil))) nil)
     ((not (equal (funcall func  t  nil nil) (values nil  t   t ))) nil)
     ((not (equal (funcall func  t  nil  t ) (values nil  t  nil))) nil)
     ((not (equal (funcall func  t   t  nil) (values nil nil  t ))) nil)
     ((not (equal (funcall func  t   t   t ) (values nil nil nil))) nil)
     (t t)))
(test-func #'golden-solution)
T
(test-func #'bad-solution)
NIL

-- Glenn

Glenn M. Lewis wrote:
> Hi all!
> 
>     I'm another Ruby fanatic attempting to learn CL (and hopefully
> later, genetic programming).
> 
>     I came across a very cool hardware design challenge in a magazine
> and the author summarized the whole thing at this website:
> 
> http://www.pldesignline.com/howto/showArticle.jhtml;?articleID=187202855
> 
>     I was thinking that there must be an excellent way to write a
> program that solves this problem using Common Lisp, but I haven't been
> able to do so yet.
> 
>     Does anyone want to try coming up with a CL solution?
> 
>     Thanks!
> -- Glenn
From: Tayssir John Gabbour
Subject: Re: Programming challenge
Date: 
Message-ID: <1147719680.590046.307390@j55g2000cwa.googlegroups.com>
Glenn M. Lewis wrote:
> Sorry to reply to my own post... I should have included this earlier.
> Here is what I have so far... comments are welcome, as I'm a total
> CL newbie:
>
> (defun golden-solution (a b c)
>    (values (not a) (not b) (not c)))
> (defun bad-solution (a b c)
>    (values a b c))

Note that you get a spurious result:

CL-USER> (equal (golden-solution nil nil nil) (values t nil nil))
T


The reason is that VALUES returns "multiple (return) values." When
something like EQUAL compares things, it only compares the first return
value. (Zero return values is treated as nil.)

You might try something like the following:

(defparameter *test-truth-table*
  '(((nil nil nil) -> ( t   t   t ))
    ((nil nil  t ) -> ( t   t  nil))
    ((nil  t  nil) -> ( t  nil  t ))
    ((nil  t   t ) -> ( t  nil nil))
    (( t  nil nil) -> (nil  t   t ))
    (( t  nil  t ) -> (nil  t  nil))
    (( t   t  nil) -> (nil nil  t ))
    (( t   t   t ) -> (nil nil nil))))

(defun test-func (func)
  (loop for (params -> result) in *test-truth-table*
        always (equal (apply func params) result)))


;;; Tests

(defun golden-solution (a b c)
   (list (not a) (not b) (not c)))
(defun bad-solution-1 (a b c)
   (list a b c))
(defun bad-solution-2 (a b c)
   (list (not a) b c))
(defun bad-solution-3 (a b c)
   (list a b (not c)))

(test-func #'golden-solution)
(test-func #'bad-solution-1)
(test-func #'bad-solution-2)
(test-func #'bad-solution-3)


Tayssir
From: Glenn M. Lewis
Subject: Re: Programming challenge
Date: 
Message-ID: <IU4ag.3102$9W5.2042@tornado.socal.rr.com>
Very cool!  Thanks for the information, Tayssir!
Now, how would I go about getting CL to come up with
an equation that solves the original problem?
Is the only way to do this with genetic programming?

-- Glenn

Tayssir John Gabbour wrote:
> Note that you get a spurious result:
> 
> CL-USER> (equal (golden-solution nil nil nil) (values t nil nil))
> T
> ...
From: Rainer Joswig
Subject: Re: Programming challenge
Date: 
Message-ID: <C08E99C0.3C735%joswig@lisp.de>
Am 15.05.2006 20:27 Uhr schrieb "Glenn M. Lewis" unter <······@noSpam.com>
in ···················@tornado.socal.rr.com:

> Sorry to reply to my own post... I should have included this earlier.
> Here is what I have so far... comments are welcome, as I'm a total
> CL newbie:
> 
> (defun golden-solution (a b c)
>    (values (not a) (not b) (not c)))
> (defun bad-solution (a b c)
>    (values a b c))
> (defun test-func (func)
>    (cond
>      ((not (equal (funcall func nil nil nil) (values  t   t   t ))) nil)
>      ((not (equal (funcall func nil nil  t ) (values  t   t  nil))) nil)
>      ((not (equal (funcall func nil  t  nil) (values  t  nil  t ))) nil)
>      ((not (equal (funcall func nil  t   t ) (values  t  nil nil))) nil)
>      ((not (equal (funcall func  t  nil nil) (values nil  t   t ))) nil)
>      ((not (equal (funcall func  t  nil  t ) (values nil  t  nil))) nil)
>      ((not (equal (funcall func  t   t  nil) (values nil nil  t ))) nil)
>      ((not (equal (funcall func  t   t   t ) (values nil nil nil))) nil)
>      (t t)))
> (test-func #'golden-solution)
> T
> (test-func #'bad-solution)
> NIL

(defun golden-solution (a b c)
  (values (not a) (not b) (not c)))

(defun bad-solution (a b c)
  (values a b c))

(defun test-func (func input-output-table)
  (every (lambda (test)
           (destructuring-bind (input output) test
             (equal (multiple-value-list (apply func input))
                    output)))
         input-output-table))

(defparameter *input-output-table*
  '(((nil nil nil) ( t   t   t ))
    ((nil nil  t ) ( t   t  nil))
    ((nil  t  nil) ( t  nil  t ))
    ((nil  t   t ) ( t  nil nil))
    (( t  nil nil) (nil  t   t ))
    (( t  nil  t ) (nil  t  nil))
    (( t   t  nil) (nil nil  t ))
    (( t   t   t ) (nil nil nil))))

(test-func #'golden-solution *input-output-table*)


> 
> -- Glenn
> 
> Glenn M. Lewis wrote:
>> Hi all!
>> 
>>     I'm another Ruby fanatic attempting to learn CL (and hopefully
>> later, genetic programming).
>> 
>>     I came across a very cool hardware design challenge in a magazine
>> and the author summarized the whole thing at this website:
>> 
>> http://www.pldesignline.com/howto/showArticle.jhtml;?articleID=187202855
>> 
>>     I was thinking that there must be an excellent way to write a
>> program that solves this problem using Common Lisp, but I haven't been
>> able to do so yet.
>> 
>>     Does anyone want to try coming up with a CL solution?
>> 
>>     Thanks!
>> -- Glenn
From: Rob Warnock
Subject: Re: Programming challenge
Date: 
Message-ID: <iKKdnYl269KH1vTZnZ2dnUVZ_sOdnZ2d@speakeasy.net>
Glenn M. Lewis <······@noSpam.com> wrote:
+---------------
| I came across a very cool hardware design challenge in a magazine
| and the author summarized the whole thing at this website:
|    http://www.pldesignline.com/howto/showArticle.jhtml;?articleID=187202855
| I was thinking that there must be an excellent way to write a
| program that solves this problem using Common Lisp...
+---------------

Solving that *particular* problem is completely uninteresting (IMHO),
since the author gives away the entire trick... twice! However, a
slight generalization of George Harper's and Hadar Agam's "counting
the ones" solutions looks somewhat interesting:

    CLAIM [not proven, but "obvious" from the above paper]:
    Given a black box with N input signals (x0, x1, ... xN-1), it is
    possible to produce N output signals (not-x0, not-x1, ... not-xN-1)
    which are the logical inverses of the corresponding inputs
    [as bitmasks, (ASSERT (EQL not-X (LOGNOT X)))] if the black
    box contains *only* AND gates, OR gates, and not more than
    (CEILING (LOG N 2)) NOT gates [inverters].

    PROBLEM: Given N > 1, print a set of logic equations for a black
    box satisfying the above claim. Intermediate equations [that is,
    internal variables not visible outside the black box] are permitted.

    [Hint: You probably need at least (* 2 (CEILING (LOG N 2))) of them.]

Though... I would expect most of the time would be spent thinking
about the problem and very little coding, so I'm not sure even this
is very much of a "programming challenge" -- it's more of a math/logic
"brain teaser".


-Rob

-----
Rob Warnock			<····@rpw3.org>
627 26th Avenue			<URL:http://rpw3.org/>
San Mateo, CA 94403		(650)572-2607
From: Glenn M. Lewis
Subject: Re: Programming challenge
Date: 
Message-ID: <t2dag.3661$uM4.2522@tornado.socal.rr.com>
Hi Rob!

	Very interesting information... thanks!  Note that the author
gives away several different solutions, yet it might be interesting to
write a solver that generates yet other solutions.  Or maybe only
interesting to see those solutions for CL newbies like myself.  :-)

-- Glenn

Rob Warnock wrote:
> Glenn M. Lewis <······@noSpam.com> wrote:
> Solving that *particular* problem is completely uninteresting (IMHO),
> since the author gives away the entire trick... twice! However, a
> slight generalization of George Harper's and Hadar Agam's "counting
> the ones" solutions looks somewhat interesting:
>
> ...[cool claim deleted]...
>
> Though... I would expect most of the time would be spent thinking
> about the problem and very little coding, so I'm not sure even this
> is very much of a "programming challenge" -- it's more of a math/logic
> "brain teaser".
> 
> 
> -Rob
> 
> -----
> Rob Warnock			<····@rpw3.org>
> 627 26th Avenue			<URL:http://rpw3.org/>
> San Mateo, CA 94403		(650)572-2607
> 
From: Frank Buss
Subject: Re: Programming challenge
Date: 
Message-ID: <1o6w5ie5pjp3c$.ztec8vf585m1.dlg@40tude.net>
Glenn M. Lewis wrote:

> 	I'm another Ruby fanatic attempting to learn CL (and hopefully
> later, genetic programming).
> 
> 	I came across a very cool hardware design challenge in a magazine
> and the author summarized the whole thing at this website:
> 
> http://www.pldesignline.com/howto/showArticle.jhtml;?articleID=187202855

Nice challenge. I'm not specialized in FPGA-based DSP designs, so I needed
to write my own CL tester to test the equations from the article:

CL-USER > (test)
abc: 000, not abc: 111, test: ok
abc: 001, not abc: 110, test: ok
abc: 010, not abc: 101, test: ok
abc: 011, not abc: 100, test: ok
abc: 100, not abc: 011, test: ok
abc: 101, not abc: 010, test: ok
abc: 110, not abc: 001, test: ok
abc: 111, not abc: 000, test: ok
all tests completed ok

(defun test ()
  (let ((vars (make-hash-table :test 'equal))
        (all-tests t))
    (loop for a from 0 to 1 do
          (loop for b from 0 to 1 do
                (loop for c from 0 to 1 do
                      (setf (gethash "a" vars) a)
                      (setf (gethash "b" vars) b)
                      (setf (gethash "c" vars) c)
                      (loop for equation in '("p1=!(a&b+a&c+b&c)"
                                              "p2=!(((a+b+c)&p1)+a&b&c)"
                                              "na=((b+c+p2)&p1)+b&c&p2"
                                              "nb=((a+c+p2)&p1)+a&c&p2"
                                              "nc=((a+b+p2)&p1)+a&b&p2") do
                            (with-input-from-string (stream equation)
                              (eval-equation stream vars)))
                      (let* ((na (gethash "na" vars))
                             (nb (gethash "nb" vars))
                             (nc (gethash "nc" vars))
                             (test (and (= a (logxor na 1))
                                        (= b (logxor nb 1))
                                        (= c (logxor nc 1)))))
                        (format t
                                "abc: ~a~a~a, not abc: ~a~a~a, test: ~a~%"
                                a b c na nb nc
                                (if test "ok" "failed"))
                        (setf all-tests (and all-tests test))))))
    (format t (if all-tests
                  "all tests completed ok"
                "one or more tests failed"))))


(defun eval-equation (stream vars)
  (let ((var (parse-var stream)))
    (expect stream #\=)
    (let ((result (eval-or stream vars)))
      (setf (gethash var vars) result))))

(defun eval-or (stream vars)
  (let ((value (eval-and stream vars)))
    (loop while (check-char stream #\+) do
          (setf value (logior (eval-and stream vars) value)))
    value))

(defun eval-and (stream vars)
  (let ((value (eval-unary stream vars)))
    (loop while (check-char stream #\&) do
          (setf value (logand (eval-unary stream vars) value)))
    value))

(defun eval-unary (stream vars)
  (if (check-char stream #\!)
      (logxor (eval-primary stream vars) 1)
    (eval-primary stream vars)))

(defun eval-primary (stream vars)
  (if (check-char stream #\()
      (let ((value (eval-or stream vars)))
        (expect stream #\))
        value)
    (let ((c (peek-char t stream nil nil)))
      (if (digit-char-p c)
          (parse-num stream)
        (let ((var (parse-var stream)))
          (gethash var vars))))))

(defun expect (stream char)
  (unless (check-char stream char)
    (error (format nil "~a expected" char))))

(defun check-char (stream char)
  (let ((c (peek-char t stream nil nil)))
    (when (and c (char= c char))
      (read-char stream))))

(defun parse-var (stream)
  (let ((string (make-array 0 :element-type 'base-char
                            :fill-pointer 0 :adjustable t)))
    (with-output-to-string (out string)
      (loop for c = (peek-char nil stream nil nil) do
            (unless (and c (alphanumericp c)) (loop-finish))
            (write-char c out)
            (read-char stream)))
    string))

(defun parse-num (stream)
  (let ((number-string (make-array 0 :element-type 'base-char
                                   :fill-pointer 0 :adjustable t)))
    (with-output-to-string (out number-string)
      (loop for c = (peek-char nil stream nil nil) do
            (unless (and c (digit-char-p c)) (loop-finish))
            (write-char c out)
            (read-char stream)))
    (parse-integer number-string)))

-- 
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Glenn M. Lewis
Subject: Re: Programming challenge
Date: 
Message-ID: <Qn7ag.3578$G95.2780@tornado.socal.rr.com>
Wow!  Very cool evaluation code, Frank!!!

Is it possible to come up with a CL program
that would actually *solve* (find a working
solution to) the problem... not just verify
that a particular solution actually works?

I would like it to pump out an equation that solves the problem.
It sounds like an application for genetic programming... I can't
think of any other way.

-- Glenn

Frank Buss wrote:
> Nice challenge. I'm not specialized in FPGA-based DSP designs, so I needed
> to write my own CL tester to test the equations from the article:
 >...
From: Rainer Joswig
Subject: Re: Programming challenge
Date: 
Message-ID: <C08ECB2C.3C798%joswig@lisp.de>
Am 15.05.2006 23:36 Uhr schrieb "Frank Buss" unter <··@frank-buss.de> in
·······························@40tude.net:

...

> (defun test ()
>   (let ((vars (make-hash-table :test 'equal))
>         (all-tests t))
>     (loop for a from 0 to 1 do
>           (loop for b from 0 to 1 do
>                 (loop for c from 0 to 1 do
>                       (setf (gethash "a" vars) a)
>                       (setf (gethash "b" vars) b)
>                       (setf (gethash "c" vars) c)
>                       (loop for equation in '("p1=!(a&b+a&c+b&c)"
>                                               "p2=!(((a+b+c)&p1)+a&b&c)"
>                                               "na=((b+c+p2)&p1)+b&c&p2"
>                                               "nb=((a+c+p2)&p1)+a&c&p2"
>                                               "nc=((a+b+p2)&p1)+a&b&p2") do
>                             (with-input-from-string (stream equation)
>                               (eval-equation stream vars)))

You are parsing and evaluating the strings over and over. With
little effort you can parse the forms into a Lisp function and
compile it. Once.

> (defun parse-var (stream)
>   (let ((string (make-array 0 :element-type 'base-char
>                             :fill-pointer 0 :adjustable t)))
>     (with-output-to-string (out string)
>       (loop for c = (peek-char nil stream nil nil) do
>             (unless (and c (alphanumericp c)) (loop-finish))
>             (write-char c out)
>             (read-char stream)))
>     string))

Why create an array?

Wouldn't

(with-output-to-string (out)
  (loop for c = (peek-char nil stream nil nil)
     while (and c (alphanumericp c)) do
     (write-char c out)
     (read-char stream)))

be sufficient? WITH-OUTPUT-TO-STRING generates the string by default...
From: Frank Buss
Subject: Re: Programming challenge
Date: 
Message-ID: <xa3g8yc2e668.6334yhbmxy1v.dlg@40tude.net>
Rainer Joswig wrote:

> You are parsing and evaluating the strings over and over. With
> little effort you can parse the forms into a Lisp function and
> compile it. Once.

You are right, but speed is not important for 8 test runs only.

> Why create an array?
> 
> Wouldn't
> 
> (with-output-to-string (out)
>   (loop for c = (peek-char nil stream nil nil)
>      while (and c (alphanumericp c)) do
>      (write-char c out)
>      (read-char stream)))
> 
> be sufficient? WITH-OUTPUT-TO-STRING generates the string by default...

Looks like I've made the mistake again to copy a sample from the clhs:

http://www.lisp.org/HyperSpec/Body/mac_with-output-to-string.html

Note for me: Read the description and never use clhs example code :-)

-- 
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de