#:g1: L-99 (9)

L-99 9問目に挑戦 - L-99:Ninety-Nine Lisp Problems

P09

解答
;;; Common Lisp
(DEFUN PACK (LIST)
  (PROG (L PL PART)
	(SETQ L LIST)
	(SETQ PL '())
	(SETQ PART '())
     L	(COND ((NULL L) (RETURN PL)))
	(SETQ PART (CONS (CAR L) PART))
        (OR (AND (EQUAL (CAR L) (CADR L))
		 (CONSP (CDR L)))
	    (AND (SETQ PL (APPEND PL (LIST PART)))
		 (SETQ PART '())))
	(SETQ L (CDR L))
	(GO L)))
;; doを使ってみた版
(defun pack/do (list)
  (flet ((repeatp (l)
	   (and (equal (car l) (cadr l)) (consp (cdr l)))))
    (do ((l list (cdr l))
	 (pl '() (if (repeatp l) pl (append pl (list (cons (car l) part)))))
	 (part '() (if (repeatp l) (cons (car l) part) '())))
	((null l) pl))))
;;; Scheme
(define pack
  (lambda (ls)
      (letrec ((pack1 
		(lambda (l pl part)
		  (if (null? l)
		      pl
		      (if (equal? (list-ref l 0 '()) ;Gauche拡張
				  (list-ref l 1 '()))
			  (pack1 (cdr l) pl (cons (car l) part))
			  (pack1 (cdr l) (append pl (list (cons (car l) part))) '()))))))
	(pack1 ls '() '()))))

何となく無茶苦茶に書いてる気がするが、変なところが
分かるようになるまでひたすら書き続けることとする。