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を拡張して比較の為の関数を選択でき

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

L-99 (27)

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

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

P27

解答
;; Common Lisp
(load "./combination")

(defun group3 (list)
  (let ((retlist '()))
    (dolist (l (combination 2 list) retlist)
      (let ((diff (set-difference list l)))
	(dolist (m (combination 3 diff))
	  (setq retlist `(,@retlist (,l ,m  ,(set-difference diff m)))))))))

難しくて解けない!。一つ一つ細かく手順を踏んで解い

て行けば良いのかもしれないが、考えている最中で頭が、

お花畑に散歩に出掛けてしまう。set-differenceを使わ

くても良いような方法が思いつかない。

このgroup3を一般化した、groupという問題もあるが、

良い方法が考えつかないので、後で挑戦することにした!

Schemeはset-differenceがないので、これまた後回し!

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20070304