five-problems-in-CL.lisp

;;; Five programming problems every Software Engineer should be able to
;;; solve in less than 1 hour

;;; Problem 1 (SUM)
;;; Write three functions that compute the sum of the numbers in a given
;;; list using a for-loop, a while-loop, and recursion.

(defun sum-r    (l &optional (s 0)) (if(null l) s (sum-r (cdr l)(+ (car l) s))))
(defun sum-for  (l) (loop for i in l sum i))
(defmacro while (xs &body body)
  (let ((rec (gensym)))
    `(labels ((,rec () (unless (endp ,xs) (progn ,@body) (,rec))))
       (,rec ))))
(defun sum-while (l)
  (let ((s 0))
    (while l (incf s (pop l)))
    s))

(defun sum (l) (apply #'+ l))

;;; Problem 2 (RIFFLE)
;;; Write a function that combines two lists by alternatingly taking
;;; elements. For example: given the two lists [a, b, c] and [1, 2, 3],
;;; the function should return [a, 1, b, 2, c, 3].

(defun riffle (xs ys) (mapcan #'list xs ys))

;;; Problem 3 (FIBS)
;;; Write a function that computes the list of the first 100 Fibonacci
;;; numbers. By definition, the first two numbers in the Fibonacci
;;; sequence are 0 and 1, and each subsequent number is the sum of the
;;; previous two. As an example, here are the first 10 Fibonnaci numbers:
;;; 0, 1, 1, 2, 3, 5, 8, 13, 21, and 34.

(defun fibs (n)
  (assert (plusp n))
  (case n
    (1 (list 0))
    (2 (list 0 1))
    (t (nconc (fibs 2)
              (loop for n2 = 0 then n1
                    for n1 = 1 then x
                    for x  = (+ n1 n2)
                    for i  = (- n 2) then (1- i)
                    while (plusp i)
                    collect x)))))

;;; Problem 4 (MAXIMIZE-INTS)
;;; Write a function that given a list of non negative integers, arranges
;;; them such that they form the largest possible number. For example,
;;; given [50, 2, 1, 9], the largest formed number is 95021.

(defvar *test4a* '(50 2 1 9))   ; => (9 50 2 1)
(defvar *test4b* '(420 42 423)) ; => (42 423 420)

;; the following usrs an simple exhaustive approach, though DP might be preferable

(defun permute (xs &optional (n (length xs)))
  (if (zerop n)
      '(())
      (mapcan (lambda (x)
                (mapcar (lambda (ys) (cons x ys))
                        (permute (remove x xs :count 1) (1- n))))
              xs)))

(defun zip-attr (ints)
  (cons ints (apply #'concatenate 'string (mapcar #'princ-to-string ints))))

(defun maximize-ints (ints)
  (caar (sort (mapcar #'zip-attr (permute ints)) #'string> :key #'cdr)))

;;; Problem 5 (MAKE-EXPRS=100)
;;; Write a program that outputs all possibilities to put + or - or
;;; nothing between the numbers 1, 2, ..., 9 (in this order) such that the
;;; result is always 100. For example: 1 + 2 + 34 – 5 + 67 – 8 + 9 = 100.

(defun % (x y) (+ (* 10 x) y))

(defvar *ops*    '(% + -))
(defvar *digits* '(1 2 3 4 5 6 7 8 9))

(defun normalize-expr (xs)      ; adhoc parser
  (let ((st '()))
    (labels ((shift   (x) (push x st))
             (reduce% (x) (pop st) (push (% (pop st) x) st))
             (reduce- ( )
               (let ((st2 (reverse st)))
                 (setq st '())
                 (loop (when (null st2) (return))
                       (let ((x (pop st2)))
                         (if (not (eq x '-))
                             (push x st)
                             (progn (push '+ st) (push (- (pop st2)) st)))))
                 st)))
      (loop (when (null xs) (return))
            (let ((tok (pop xs)))
              (assert (or (member tok *ops*) (member tok *digits*)))
              (if (and (numberp tok) (eq (car st) '%))
                  (reduce% tok)
                  (shift tok))))
      (remove '+ (reverse (reduce-))))))

(defun iterate-seqs (xs n)
  (labels ((add1 (ys)    (mapcar (lambda (x) (cons x ys)) xs))
           (rec  (i acc) (if (zerop i) acc (rec (1- i) (mapcan #'add1 acc)))))
    (rec (1- n) (mapcar #'list xs))))

(defun make-exprs ()
  (loop for ops in (iterate-seqs *ops* 8)
        collect (normalize-expr (cdr (RIFFLE (cons nil ops) *digits*)))))

(defun make-exprs=100 ()
  (remove-if-not (lambda (c) (= (SUM c) 100))
                 (make-exprs)))