Posted 2007-01-21 13:45:00 GMT
L-99 9問目に挑戦 - L-99:Ninety-Nine Lisp Problems
解答 ;;; 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 '() '()))))