with-input-from-string - evaluating lisp object from string

Well, to be precise I just want to convert string representation of a list such as "(1 2 3 4)" into a list object and with-input-from-string is the way to go. It basically opens a character stream from string and "read" can be used to read from this stream.

(with-input-from-string (in "(1 2 3 4)")
  (read in)) 

make-change and make-best-change

This is one of the challenges presented on this page.
1. make-change
Find denominations of a given amount in given coins. Define your function to take the number of cents and an optional list of the available coins, largest to smallest, e.g., (make-change 72 '(25 10 1)). The default list should be (25 10 5 1).You can assume that the coins are such that the simple greedy algorithm will get the answer with the fewest coins.
Solution:

(defun make-change (amount &optional (coins '(25 10 5 1)))
  (labels ((make-change-iter (amount coins result)
           (cond ((null coins)
                  (apply #'values (nreverse result)))
                 ((= amount 0)
                  (make-change-iter amount 
                                    (cdr coins) (cons 0 result)))
                 (t 
                  (make-change-iter
                   (mod amount (car coins))
                   (cdr coins)
                   (push (floor amount (car coins)) result))))))
    (make-change-iter amount coins nil))) 

2. make-best-change
make-change may fail to find the best answer for certain sets of coins, where best means "uses the fewest coins." For example, if there are no nickels, then (make-change 30 '(25 10 1)) will return 1 quarter and 5 pennies, which is 6 coins, but 3 dimes would be better.
Define make-best-change to take the same arguments as make-change. make-best-change should return an answer that leaves the least amount of cents unaccounted for. If there's more than such answer, it should return a solution that uses the fewest coins.
Solution:

(defun make-best-change (amount &optional (coins '(25 10 5 1)))
  (apply #'values
         (butlast
          (reduce #'(lambda (x y)
                      (cond ((< (car (last x)) (car (last y))) x)
                            ((> (car (last x)) (car (last y))) y)
                            ((< (sum-list (butlast x))
                                (sum-list (butlast y))) x)
                            (t y)))
                  (make-all-change amount coins)))))
;sum elements of a list
(defun sum-list (nums)
  (reduce #'+ nums))
;this returns a list of all the possible changes with
;remaining amount appended at last of each list.
(defun make-all-change (amount coins)
  (cond ((= amount 0) `(,(make-list 
                       (1+ (length coins)) :initial-element 0)))
        ((null coins) `((,amount)))
        ((< amount (car coins))
         (mapcar #'(lambda (x) (cons 0 x))
                 (make-all-change amount (cdr coins))))
        (t (append
            (mapcar
             #'(lambda (x) (incf (car x)) x)
             (make-all-change (- amount (car coins)) coins))
            (mapcar #'(lambda (x) (cons 0 x))
                    (make-all-change amount (cdr coins))))))) 

best practices: adding 1 in lisp

Instead of (+ 1 x), we should better use (1+ x) if we just want to use the value. And if we want to update x also then we should use (incf x). I don't know whats the exact logic, but probably its the conciseness.
It also seems aligned with what is said in PAIP, "Using the most specific form possible makes it easier for your reader to understand your intent."

nested defun caveat

I just got to know that nested defun is not really the solution for local functions in lisp. Let me clarify it with an example, if I am to write a tail recursive definition of factorial in lisp, this is how I thought it will be done...

(defun factorial (n)
 (defun fact-iter (n result)
   (if (= n 0) result
       (fact-iter (- n 1) (* result n))))
 (fact-iter n 1)) 

I used nested defun so that I could hide the detail about fact-iter, but in Lisp it seems no matter where defun is executed it'll put that binding in global environment i.e. fact-iter will be put in global environment once we execute factorial which I wanted to hide.
Instead labels are used for local function in lisp and here is the "correct" version of above program.

(defun factorial (n)
 (labels ((fact-iter (n result)
            (if (= n 0) result
                (fact-iter (- n 1) (* result n)))))
   (fact-iter n 1))) 

list-of macro

I stumbled on this page and started to solve the problems, Here is solution to the ex7.
list-of is a macro that simplifies collecting lists of values of expressions. Though this description is long, and the macro is powerful, it's actually quite simple and can be implemented with relatively little code.

The general syntax is

(LIST-OF exp generator-or-filter generator-or-filter ...)

It's easiest to explain by starting with simple examples.

> (list-of (1+ x) (x :in '(1 2 3)))
(2 3 4)
 

exp is (1+ x) and (x :in '(1 2 3)) is a generator. A generator is anything that has the form (variable :in list). This generator generates three values for x, namely 1, 2, and 3. list-of returns a list of the value of (1+ x) for those three values of x.

> (list-of (1+ x) (x :in '(1 2 3)) (oddp x))
(2 4)

The exp and generator are as before, but now I've added the filter (oddp x). A filter is any expression that doesn't look like a generator. The filter says "keep only those values of x that are odd." Hence, list-of only collects values for (1+ x) equal to 1 and 3.

That's it. Any number of generators and filters can be given. They are applied from left to right. If there are two generators, the second repeats itself for every value created by the first, e.g.,

> (setq l '(a b))
(A B)
> (list-of (list x y) (x :in l) (y :in ))
((A A) (A B) (B A) (B B))
 

Likewise, the filters apply in order.

> (setq l '(1 2 3 4))
(1 2 3 4)
> (list-of (list x y) (x :in l) (oddp x) (y :in l) (evenp y))
((1 2) (1 4) (3 2) (3 4))
 

This collects (list x y) for every x in l that is odd and every y in l that is even. Notice that

> (list-of (list x y) (x :in l) (y :in l) (oddp x) (evenp y))
((1 2) (1 4) (3 2) (3 4))
 

returns the same answer, but does more work. Trace oddp to see the difference.

One special case that follows naturally:

• (list-of exp) simply returns a list of exp.

Note: It'd be more direct to write "the list of x in l that are odd" as

(list-of (x :in l) (oddp x))

rather than

(list-of x (x :in l) (oddp x))

Define list-of so that if no initial expression to collect is given, it uses the variable of the first generator.

Solution:

(defmacro list-of (&rest args)
 ;functions to deal with generator forms
 (defun generator? (x) (and (listp x)(eq (cadr x) :in)))
 (defun var-generator (x) (car x))
 (defun list-generator (x) (caddr x))
 ;following function generates appropriate code given
 ;the expression and list of generators-filters
 (defun generate-code (exp gfs)
   (let ((code (gensym)))
     (defun recurse (gfs)
       (cond ((null gfs) `(push ,exp ,code))
             ((generator? (car gfs))
              `(dolist (,(var-generator (car gfs))
                         ,(list-generator (car gfs)))
                 ,(recurse (cdr gfs))))
             (t `(if ,(car gfs) ,(recurse (cdr gfs))))))
     `(let ((,code nil))
        ,(recurse gfs) (nreverse ,code))))
 ;extracting exp and list of generators-filters; then calling
 ;generate-code for code generation.
 (let ((exp (car args))
       (generators-filters (cdr args)))
   (if (generator? (car args))
       (progn (setf exp (var-generator (car args)))
              (setf generators-filters args)))
   (generate-code exp generators-filters))) 

tconc structure

I stumbled on this page and started to solve the problems, Here is solution to the ex6.

Adding elements to the end of a list is usually inefficient in Lisp:

• (append list (list item)) is the worst possible approach, because list gets copied every time a new item is added. If you use this form to build a list N long, you'll have done N squared cons's. Imagine doing that for a simple 100-element list!
• (nconc list (list item)) doesn't cons, but still gets very slow as the list gets long, because Lisp has to cdr all the way to the end of the list in order to find the last cons cell to modify.

A classic solution is to create a data structure called a tconc structure (for "tail concatenate"), which holds two pointers to the same list:

• a head pointer to the whole list, and
• a tail pointer to the last cons cell of that list.

With this data structure, you can add new elements to the end of the list with just a few quick operations, no matter how long the list is, and you can still get the whole list whenever you need it.

Therefore, your job is to:

• Define (make-tconc [ list ]) to return a tconc structure pointing to list. If no list is given, a tconc structure for an empty list should be returned.
• Define (tconc tconc-structure [item item ...]) to add the items, if any, to the end of the list pointed to by tconc-structure, update tconc-strcture appropriately, and return the new value of the internal list.
• Define (tconc-list tconc-structure list ) to add the items in list to the end of the internal list.

Note that you can get the internal list at any time with (tconc tconc-structure).

> (setq tc (make-tconc))

> (tconc tc 1)
(1)
> (tconc tc 2 3)
(1 2 3)
> (tconc tc)
(1 2 3)

Each successive call to tconc should be efficient, no matter how long the internal list has grown. One test of your tconc structure is that it always obeys the following rule:
(eq (last head-pointer) tail-pointer)

Solution:

(defstruct (tconc (:constructor create-tconc))
"a tail concatenate list for easy append"
(head nil) (tail nil))
(defun make-tconc (&optional l)
(let ((tc (create-tconc)))
 (apply #'tconc tc l)
 tc))
(defun tconc (tconc-structure &rest items)
(unless (null items)
 (if (null (tconc-head tconc-structure))
     (setf (tconc-head tconc-structure) items)
     (setf (cdr (tconc-tail tconc-structure)) items))
 (setf (tconc-tail tconc-structure) (last items)))
(tconc-head tconc-structure))
(defun tconc-list (tconc-structure &optional l)
(apply #'tconc tconc-structure l)) 

collect-numbers function

I stumbled on this page and started to solve the problems, Here is solution to the ex5.

Define (collect-numbers s-exp) to return a list of all the numbers in the s-expression s-exp. s-exp may be an atom, a list, or a list of s-expressions.

> (collect-numbers 1)
(1)
> (collect-numbers 'a)
NIL
> (collect-numbers '(1 (b (2 c) ((3)))))
(1 2 3)

Solution:

(defun collect-numbers (s-exp)
(if (atom s-exp)
 (if (numberp s-exp) (list s-exp) nil)
 (mapcan #'collect-numbers s-exp))) 

delete-car function

I stumbled on this page and started to solve the problems, Here is solution to the ex4.

Define (delete-car list) to modify and return list with the first element of list deleted.

> (setq l (list 'a 'b 'c))
(A B C)
> (delete-car l)
(B C)
> L
(B C)

Solution:

(defun delete-car (l)
 (setf (car l) (cadr l))
 (let ((tmp (cddr l)))
   (setf (cdr l) tmp))
 (if (equal l '(())) nil l))

make-balance function

I stumbled on this page and started to solve the problems, Here is solution to the ex3.
Define (make-balance initial-balance) to return a function that takes 0 or 1 arguments. If that function is called with 0 arguments, it returns the current balance. If called with 1 argument, which should be a number, it adds that number to the current balance, and returns the new balance.

> (setq bal (make-balance 100))
<>
> (funcall bal 10)
110
> (funcall bal -50)
60
> (funcall bal)
60

Solution:

(defun make-balance (bal)
 (let ((balance bal))
   #'(lambda (&optional (amt 0))
       (setf balance (+ amt balance))))) 

key-if macro

I stumbled on this page and started to solve the problems, Here is solution to the ex2.

Define the macro key-if to have the form

(KEY-IF test
:THEN exp1 exp2 ...
:ELSE exp3 exp4 ...)

This does about the same thing as:

(COND (test exp exp ...)
   (T else-exp else-exp ...))

Almost everything is optional in key-if except the test. Here are some legal forms and their results:

> (key-if (> 3 1) :then 'ok)
OK
> (key-if (<> (key-if (> 3 1) :else 'oops)
NIL
> (key-if (> 3 1) :then)
NIL
> (key-if (> 3 1) :else 'oops :then 'ok)
OK
> (key-if (> 3 1) :else 'oops :then (print 'hi) 'ok)
HI
OK

Solution:

(defmacro key-if (test &rest args)
 (defun extract-then-else (exp)
   (defun iter (exp then-list else-list flag)
     (cond
       ((null exp) (values (nreverse then-list) (nreverse else-list)))
       ((eq :then (car exp)) (iter (cdr exp)
                                   then-list
                                   else-list t))
       ((eq :else (car exp)) (iter (cdr exp)
                                   then-list
                                   else-list nil))
       (t (if (null flag)
              (iter (cdr exp) then-list (cons (car exp)
                                              else-list) flag)
              (iter (cdr exp) (cons (car exp) then-list)
                    else-list flag)))))
   (iter exp nil nil nil))
 (multiple-value-bind (then else) (extract-then-else args)
   `(cond (,test ,(cons 'progn then))
          (t ,(cons 'progn else))))) 

has-number-p

I stumbled on this page and started to solve the problems, Here is solution to the ex1 .
Define (has-number-p s-exp) to return true if the s-expression is or contains a number.

> (has-number-p 1)
T
> (has-number-p 'a)
NIL
> (has-number-p '(a (b (c d) ((3)))))
T

Solution:
(defun has-number-p (s-exp)
(if (atom s-exp)
    (if (numberp s-exp) t nil)
    (some #'has-number-p s-exp)))

apache httpd configuration for a domain and its subdomain

I basically wanted to serve different pages from xyz.in and m.xyz.in with separate logs for both, Here is what I had to put at the end of httpd.conf

NameVirtualHost *:80
<VirtualHost *:80>
    DocumentRoot /var/www/html/pcmm/
    ServerName www.xyz.in
    CustomLog /var/log/httpd/access_log combined
</VirtualHost>

<VirtualHost *:80>
    DocumentRoot /var/www/html/mobilemm/
    ServerName m.xyz.in
    CustomLog /var/log/httpd/m_access_log combined
</VirtualHost>

First virtual host becomes the default, so if a request comes for xyz.in or www.xyz.in or any other subdomain(except m.xyz.in) then its served from the first vhost or else from the later one, we can put as many vhosts as we wish. More information is available here .

Configuring Portable AllegroServe

I'm working with PCL (Practical Common Lisp). Chapter 26 is about web programming with AllegroServe. I have been using gnu clisp + emacs to follow the examples given in the book.

Here are the steps I had to take to configure portable allegroserve to run code example in this chapter.
I'm using Fedora 9 but this should be ok for any redhat distro.

1. Downloaded portable allegroserve from cvs using the instructions given here.


2. gnu clisp doesn't play well as it doesn't support multithreading, so I had to install sbcl . Its available in Fedora yum repository, so I just needed to say "yum -y install sbcl"


3. Since I'm using emacs, so I had to do
   "ln -s /usr/bin/sbcl /usr/bin/lisp" so that emacs starts sbcl when we call "M-x run-lisp"


4. At last just call (load "/path/to/portableaserve/INSTALL.lisp") in sbcl REPL.

This worked.