Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-03-04

L-99 (28)

| 23:33 | L-99 (28) - わだばLisperになる を含むブックマーク はてなブックマーク - L-99 (28) - わだばLisperになる

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

P28

;; Common Lisp
;; a)
(defun lsort (list)
  (sort list #'(lambda (a b)
		 (< (length a) (length b)))))

;; b)
(load "./pack")
(load "./lsort")

(defun lfsort (list)
  (let ((lflist (lsort (pack (lsort list) #'(lambda (a b)
					      (= (length a) (length b)))))))
    (do ((l lflist (cdr l))
	 (retlist '() (if (= 1 (length (car l)))
			  `(,@retlist ,(caar l))
			  (do ((m (car l) (cdr m))
			       (retlist retlist `(,@retlist ,(car m))))
			      ((endp m) retlist)))))
	((endp l) retlist))))

(DEFUN PACK (LIST CMPFN)
  (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 (FUNCALL CMPFN (CAR L) (CADR L))
		 (CONSP (CDR L)))
	    (AND (SETQ PL (APPEND PL (LIST PART)))
		 (SETQ PART '())))
	(SETQ L (CDR L))
	(GO L)))

;; Scheme
;; a)
(define lsort
  (lambda (ls)
    (sort ls (lambda (a b)
	       (< (length a) (length b))))))

;; b)
(load "./lsort")
(load "./pack")

(define lfsort
  (lambda (ls)
    (let ((lflist (lsort (pack (lsort ls)
			       (lambda (a b)
				 (= (length a)
				    (length b)))))))
      (let loop ((l lflist)
		 (retlist '()))
	(if (null? l)
	    retlist
	    (loop (cdr l)
		  (if (= 1 (length (car l)))
		      `(,@retlist ,(caar l))
		      (let moop ((m (car l))
				  (retlist retlist))
			(if (null? m)
			    retlist
			    (moop (cdr m)
				   `(,@retlist ,(car m)))))))))))) 

(define pack
  (lambda (ls cmpfn)
      (letrec ((pack1 
		(lambda (l pl part)
		  (if (null? l)
		      pl
		      (if (cmpfn (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 '() '()))))

P27が解けないのでとばしてP28。これは既存のsortを使

えば比較的簡単に解けるが、sort自体を作れということ

なのか。sortから作るのは難しいので、とりあえず既存

のものを利用することにして回答。

以前に作ったpackを拡張して比較の為の関数を選択でき

るようにしてみたものを使用してみた。