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-01-28

L-99 (13)

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

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

P13

解答
;;; Common Lisp
(defun decode-modified (list)
  (flet ((nomalize (item)
	   (if (atom item)
	       `(1 ,item)
	       item)))
    (labels ((expand (code)
	     (destructuring-bind (n item)
		 (nomalize code)
	       (if (= n 1)
		   `(,item)
		   `(,item ,@(expand `(,(1- n) ,item)))))))
      (if (endp list)
	  '()
	  `(,@(expand (car list)) ,@(decode-modified (cdr list)))))))

;; LOOPとDOLISTを使ってみた版
(defun decode-modified/loop (list)
  (flet ((nomalize (item)
	   (if (atom item)
	       `(1 ,item)
	       item)))
    (labels ((expand (code)
	       (destructuring-bind (n item)
		   (nomalize code)
		 (loop for i to n 
		       for l = '() then (cons item l)
		       finally (return l)))))
      (let ((r '()))
	(dolist (l list (append r l))
	  (setq r (append r (expand l))))))))

;; DOを使ってみた版
(defun decode-modified/do (list)
  (flet ((nomalize (item)
	   (if (atom item)
	       `(1 ,item)
	       item)))
    (labels ((expand (code)
	       (destructuring-bind (n item)
		   (nomalize code)
 		 (do ((i 0 (1+ i))
 		      (r '() `(,@r ,item)))
		     ((= i n) r)))))
      (do ((l list (cdr l))
	   (r '() `(,@r ,@(expand (car l)))))
	  ((endp l) r)))))

;; PROGですこんにちは版
(DEFUN DECODE-MODIFIED/PROG (LIST)
   (PROG (RETLIST EXP ITEM CODE N I)
	 (SETQ RETLIST '())
L	 (COND ((ENDP LIST) (GO X)))
	 (SETQ I 0)
	 (SETQ EXP '())
	 (SETQ CODE (CAR LIST))
	 (SETQ CODE (COND ((ATOM CODE) `(1 ,CODE)) ;NOMALIZE
			  ('T CODE)))
	 (SETQ N (CAR CODE))
	 (SETQ ITEM (CADR CODE))
EXP	 (COND ((= I N) (GO ML)))
	 (SETQ EXP `(,@EXP ,ITEM))
	 (SETQ I (1+ I))
	 (GO EXP)
ML       (SETQ RETLIST `(,@RETLIST ,@EXP))
	 (SETQ LIST (CDR LIST))
	 (GO L)
X	 (RETURN RETLIST)))


;; なんとなくmapしてみた版
(defun decode-modified/map (list)
  (flet ((nomalize (item)
	   (if (atom item)
	       `(1 ,item)
	       item)))
    (labels ((expand (code)
	       (destructuring-bind (n item)
		   (nomalize code)
 		 (do ((i 0 (1+ i))
 		      (r '() `(,@r ,item)))
		     ((= i n) r)))))
      (let ((retlist '()))
	(mapc #'(lambda (l) 
		  (setf retlist `(,@retlist ,@(expand l))))
	      list)
	retlist))))

;;; Scheme
(define decode-modified 
  (lambda (ls)
    (let ((nomalize 
	   (lambda (item)
	     (if (pair? item)
		 item
		 `(1 ,item)))))
      (letrec ((expand
		(lambda (l r)
		  (let ((c (car (nomalize l)))
			(item (cadr (nomalize l))))
		    (if (zero? c)
			r
			(expand (list (- c 1) item)
				`(,@r ,item))))))
	       (loop 
		(lambda (l r)
		  (if (null? l)
		      r
		      (loop (cdr l)
			    `(,@r ,@(expand (car l) '())))))))
	(loop ls '())))))

暇だったので、色々変形して遊んでみた。