;;; coin-change problem in common-lisp

cc.lisp

;;; coin-change problem in common-lisp

(defun remove-first (e l)
  (cond ((null l) '())
	(t (if (equal e (car l))
	       (cdr l)
	       (cons (car l) (remove-first e (cdr l)))))))

(remove-if (lambda (e) (equal e 1)) '(1 1 2 3 4))
;; (2 3 4)
(remove-first 1 '(1 1 2 3 4))
;; (1 2 3 4)

(defun partial (f &rest pre)
  (lambda (&rest post) (apply f (append pre post))))

(funcall (partial #'equal 1) 1)

(defun tri (a b c)
  (+ a b c))

(funcall (partial #'+ 1 2) 3 4 5)

(defun cc (s p l)
  (cond ((null l) '(()))
	((zerop s) (list p))
	((< s 0) '())
	(t (mapcar (lambda (c)
		     (let ((others (remove-first (lambda (k) (eq c k)) l)))
		       (mapcar (lambda (_) (cons c _))
			     (cc (- s c) c others))))
		   l))))

(cc 2 nil '(2 1))

(defun cc (s l)
  (cond ((null l) '())
	((< s 0) '())
	((zerop s) '(()))
	(t (mapcar (lambda (c)
		     (mapcar (partial #'cons c)
			     (cc (- s c) (remove-first (partial #'eq c) l))))
		   l))))

(cc 2 '())
(cc 2 '(3))
(cc 2 '(1 1))

;; (funcall (partial #'cons 1) '(2 3 4))

(defun cc (s l)
  (cond ((null l) '())
	(t (mapcar
	    (lambda (c)
	      (let ((d (- s c)))
		(cond ((= 0 d) (list c))
		      ((< d 0) '())
		      (t (mapcar (partial #'cons c)
				 (cc d
				     (remove-first (partial #'eq c) l)))))))
	    l))))

(remove-first 1 '(2 3 1 2 3 1))

(cc 2 '(1 3))

(defun cc (n l)
  "coin change"
  (cond ((null l) '())
	(t (remove-if
	    #'null
	    (mapcar (lambda (c)
		      (cond ((> c n) '())
			    ((= c n) c)
			    ((< c n) (let ((aug (partial #'cons c))
					   (others (partial #'eq c)))
				       (cc (- n c) (remove-first others l))))))
		    l)))))

(cc 2 '())
(cc 1 '())
(cc 1 '(1))
(cc 1 '(1 1))
(cc 1 '(1 1 1))
(cc 3 '(1 1 1))
(cc 2 '(1 1))
(cc 2 '(3 4 5 1 1))
(cc 3 '(3 4 5 1 1))

(defun cc (n l)
  (cond ((null l) '())
	(t (let ((h (car l))
		 (_ (cdr l)))
	     (cond ((> h n) (cc n _))
		   ((= h n) (cons (list h) (cc n _)))
		   ((< h n)
		    (let ((d (- n h)))
		      (mapcar (partial #'cons h) (cc d _)))))))))

(cc 1 '())
(cc 1 '(1))
(cc 1 '(1 1))
(cc 1 '(2 1))
(cc 2 '(2 1))
(cc 2 '(2 1 1))
(cc 3 '(3 2 1 2 1))

;; now the structure is alright but the linearity is wrong

(defun flatten-1 (l)
  (apply #'concatenate 'list l))

(defun flatten-1 (l)
  (cond ((null l) '())
	((atom (car l)) (cons (car l) (flatten-1 (cdr l))))
	(t (append (car l) (flatten-1 (cdr l))))))

(flatten-1 '((1 2 3) 4 (5) (6 7)))
(flatten-1 '((1 2 3) ((4)) (5) (6 7)))

(defun cc (n l)
  (cond ((null l) '())
	(t (let ((sub
		   (mapcar
		    (lambda (h)
		      (let ((others (remove-first h l)))
			(cond ((> h n)
			       ;; (cc n others) ;;; FAIL
			       '())
			      ((= h n) (list (list h)))
			      ((< h n)
			       (let ((d (- n h)))
				 (mapcar (partial #'cons h) (cc d others)))))))
		    l)))
	     (flatten-1 (remove-if #'null sub))))))

;; the one above seems ok

(cc 2 '())
(cc 2 '(3 1 1 2))
(cc 3 '(3 1 1 1 2))