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-05-11

L-99 (80)

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

L-99 P80に挑戦 - L-99:Ninety-Nine Lisp Problems

|-`)どういう訳かド鬱になってきた。なんにもしたくな

い。

きっと引きこもりっきりで体を動かしてない所為だと推

測。

軽快な運動をしつつプログラミングできたら結構良い感

じなんじゃないかと思うんだけど、どうなんだろう。

そして問題もややこしくなってきて、さらにやる気が出

ないが、しかし粘着に遂行するぞ。

80番台は、グラフ(ネットワーク)の問題。

今回のお題は、グラフを色々な方式で表現し、それを相

互に変換してみようという内容。

形式は、基本的に

1) edge-clause形式

2) graph-term形式

3) adjacency-list形式

4) human-friendly形式

と4つあり、これらに

1) 無向グラフ版

2) 有向グラフ版

3) 名札つき有向グラフ版

がある。

とりあえず、量が多いので少しずつ解答して行くことにした。

今回は、Common Lisp版の無向グラフ版。

残りの問題:'(27 55 58-60 63 66 80-94 96-99)

P80

解答
;; Common Lisp
(load ./flatten)

(defun graph-term->edge-clause (expr)
  (cadr expr))

(defun edge-clause->graph-term (expr)
  `(,(sort (delete-duplicates
	 (reduce #'(lambda (ret item) `(,(car item) ,(cadr item) ,@ret))
		 expr :initial-value '() ))
	#'(lambda(a b)
	    (string< (string a) (string b))))
     ,expr))

(defun graph-term->adjacency-list (expr)
  `(,@(mapcar #'(lambda (item)
		  `(,item 
		    ,(delete nil
			     (delete-duplicates 
			      (flatten 
			       (mapcar #'(lambda (lst)
					   (delete item
						   (if (member item lst)
						       lst
						       nil)))
				       (cadr expr)))))))
	      (car expr))))

(defun adjacency-list->graph-term (expr)
  `(,(mapcar #'car expr)
     ,(sort
       (delete-duplicates
	(reduce #'(lambda (retlst i)		
		    `(,@retlst ,@(mapcar #'(lambda (j)
					     (sort `(,(car i) ,j)
						   #'(lambda(a b)
						       (string< (string a) (string b)))))
					 (cadr i))))
		expr :initial-value '() ) 
	:test #'equal) 
       #'(lambda(a b) (string< (string (car a)) (string (car b)))))))

(defun graph-term->human-friendly (expr)
  (sort `(,@(mapcar #'(lambda (item)
			(concatenate 'string (string (car item)) "-" (string (cadr item))))
		    (cadr expr))
	    ,@(mapcar #'string
		      (set-difference (car expr) (flatten (cadr expr)))))
	#'string<))

(defun human-friendly->graph-term (expr)
  (flet ((string-split/- (strlst)
	   (mapcar #'(lambda (item)
		       (let ((pos (position #\- (coerce item 'list))))
			 (if pos
			     `(,(subseq item 0 pos)
				,(subseq item (1+ pos)))
			     item)))
		   strlst)))
    (let ((item-list (mapcar #'(lambda (item)
				 (if (listp item)
				     `(,(read-from-string (car item)) 
					,(read-from-string (cadr item)))
				     (read-from-string item)))
			     (string-split/- expr))))
      `(,(delete-duplicates (flatten item-list)) ,(delete-if-not #'listp item-list)))))

ゲスト



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