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-31

L-99 (14)

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

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

P14

解答
;;; Maclisp - Common Lisp 
(defun dupli (list)
  (do ((l list (cdr l))
       (retlist '() (let ((item (car l)))
                      `(,@retlist ,item ,item))))
      ((null l) retlist)))

;;; Scheme
(define dupli 
  (lambda (ls)
    (let loop ((l ls) (r '()))
      (if (null? l)
	  r
	  (let ((item (car l)))
	    (loop (cdr l) `(,@r ,item ,item)))))))

何となく今回はTwenexのMaclisp上のemacs 165&ledit環境で

問題に挑戦してみた。といっても特にMaclisp特有のと

ころはなし。

Maclispにはendpはないみたいなので、nullを使用した

くらい。

2007-01-29

L-99 (10〜13の訂正)

| 23:33 | L-99 (10〜13の訂正) - わだばLisperになる を含むブックマーク はてなブックマーク - L-99 (10〜13の訂正) - わだばLisperになる

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

P10から13まで設問を良く読んでなくて適当に解釈し

て回答を作ってたことに気付きました(´▽`*)アハハ

P10は、P9で作成したPACKを使用して、ENCODEを作成せ

よとの問題でした。

ということで、

;; Common Lisp
(defun encode (list)
  (mapcar #'(lambda (l)
	      `(,(length l) ,(car l)))
	  (pack list)))
;; Scheme
(define encode
  (lambda (ls)
    (map (lambda (l)
	   `(,(length l) ,(car l)))
	 (pack ls)))) 

のように回答するのが筋みたいです。

P11は、アイテムに"(1 A)"のようなものがある場合、直

接"A"のような形式で出力せよ、とのことなので、

;; Common Lisp
(defun encode-modified (list)
  (mapcar #'(lambda (l)
	      (if (= (length l) 1)
		  (car l)
		`(,(length l) ,(car l))))
	  (pack list)))
;; Scheme
(define encode-modified
  (lambda (ls)
    (map (lambda (l)
	   (if (= (length l) 1)
	       (car l)
	       `(,(length l) ,(car l))))
	 (pack ls)))) 

のように答えるのが筋だったようです。

P12はP11の形式をデコードするデコーダーを作成せよと

のことでしたが、自分はP10の形式のものをデコードす

るという内容で答えてました。

ということで、自分がP13の答えとして書いた

decode-modifiedがP12の回答となります。

そして、P13の質問は、ENCODEをPACKのような関数を使

用しないで作成せよとのことだったので、P11で回答し

た内容がP13の回答になります。

という訳で、問題を先取りしたり、抜かしたり。

問題はちゃんと読むことにしよう。

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 '())))))

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

L-99 (12)

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

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

P12

解答
;;; Common Lisp
(defun decode (list)
  (labels ((expand (code)
	     (destructuring-bind (n item)
		 code
	       (if (= n 1)
		   `(,item)
		   (cons item (expand `(,(1- n) ,item)))))))
    (if (null list)
	'()
	(append (expand (car list)) (decode (cdr list))))))

;;; Scheme
(define decode
  (lambda (ls)
    (letrec ((expand
	      (lambda (code)
		(let ((n (car code))
		      (item (cadr code)))
		  (if (= n 1)
		      `(,item)
		      `(,item ,@(expand `(,(- n 1) ,item))))))))
	    (if (null? ls)
		'()
		`(,@(expand (car ls)) ,@(decode (cdr ls)))))))

ALUのLisp Programming Styleを眺めつつ

CLではdestructuring-bindを使ってみたりした。

2007-01-27

L-99 (11)

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

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

P11

解答
;;; Common Lisp
(defun encode-modified (list)
  (flet ((list-but-single (item count)
	   (if (= count 1)
	       item
	       (list count item))))
    (labels ((encode1 (l c a)
	       (cond ((null l) (cons (list-but-single a c) ()))
		     ((equal (car l) a) (encode1 (cdr l) (1+ c) (car l)))
		     ('t (cons (list-but-single a c)
			       (encode1 (cdr l) 1 (car l)))))))
      (encode1 list 0 (car list)))))

;; Common Lisp - doを使ってみた版
(defun encode-modified/do (list)
  (let ((r '())
	(c 0))
  (flet ((list-but-single (item count)
           (if (= count 1)
	       `(,item)
	     `((,count ,item)))))
    (do ((l list (cdr l))
	 (a (car list) (car l)))
	((null l) (append r (list-but-single a c)))
      (if (equal (car l) a)
	  (setq c (1+ c))
	(psetq c 1
	       r (append r (list-but-single a c))))))))

;;; Scheme
(define encode-modified
  (lambda (l)
    (let ((list-but-single 
	   (lambda (n l)
	     (if (= n 1)
		 `(,l)
		 `((,n ,l))))))
      (letrec ((encode1 
		(lambda (l xcar c item)
		  (cond ((null? l)
			 (append item (list-but-single c xcar)))
			((equal? (car l) xcar) 
			 (encode1 (cdr l) (car l) 
				  (+ c 1) item))
			(else 
			 (encode1 (cdr l) (car l) 
				  1 (append item (list-but-single c xcar))))))))
	(encode1 l (car l) 0 '())))))

何となく何がなんだか良く分からなくなってきた。

2007-01-24

L-99 (10)

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

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

P10

解答
;;; Common Lisp
(defun encode (l &optional (c 0) (a (car l)))
  (cond ((null l) 
	 `((,c ,a)))
	((equal (car l) a) 
	 (encode (cdr l) (1+ c) (car l)))
	('t (cons 
	     (list c a) 
	     (encode (cdr l) 1 (car l))))))

;; Common Lisp - doを使ってみた版
(defun encode/do (list)
  (do ((l list (cdr l))
       (c 0 (1+ (if (equal (car l) a) c 0)))
       (a (car list) (car l))
       (r '() (if (equal (car l) a) 
		  r
		(append r `((,c ,a))))))
      ((null l) (append r `((,c ,a))))))

;;; Scheme
(define encode
  (lambda (l)
    (letrec ((encode1 
	      (lambda (l c a la)
		(if (null? l)
		    la
		    (if (equal? (car l) a)
			(encode1 (cdr l) (+ c 1) (car l) la)
			(encode1 (cdr l) 1 (car l) (append la `((,c ,a)))))))))
      (encode1 l 0 (car l) '()))))

今回CLは関数内関数ではなくて、ラムダリストパラメータ

を使ってみた。

2007-01-21

L-99 (9)

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

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

P09

解答
;;; 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 '() '()))))

何となく無茶苦茶に書いてる気がするが、変なところが

分かるようになるまでひたすら書き続けることとする。

2007-01-17

L-99 (8)

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

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

P08

解答
;;; Common Lisp
(defun compress (list)
  (if (consp list)
    (if (and (equal (car list) (cadr list))
	     (consp (cdr list)))
      (compress (cdr list))
      (append (list (car list))
	      (compress (cdr list))))))

;; doを使ってみた版
(defun compress (list)
  (do ((l list (cdr l))
       (ret '() (if (and (consp (cdr l))
			 (equal (car l) (cadr l)))
		  ret
		  (append ret (list (car l))))))
      ((null l) ret)))

;;; Scheme
(define compress
  (lambda (l)
    (let ((clcar
	   (lambda (l)
	     (if (pair? l)
		 (car l)
		 '())))
	  (clcadr
	   (lambda (l)
	     (if (pair? l)
		 (if (pair? (cdr l))
		     (cadr l))
		 '()))))
      (letrec ((compress1
		(lambda (l)
		  (if (pair? l)
		      (if (and (pair? (cdr l))
			       (equal? (clcar l) (clcadr l)))
			  (compress1 (cdr l))
			  (append (list (car l))
				  (compress1 (cdr l))))
		      '()))))
	(compress1 l)))))

Scheme版が妙に長いのは、Common Lispのcarとcadrと同

じように、(car '())としたときにnilが返るような

clcarと、clcadrを定義してみたため。Gaucheだと拡張

機能で、(list-ref ls 1 '())のように書けるらしい。

なんとなく補助関数を全部関数の中に無理に纏めて書い

たりするのは変だったりするんだろうと思ったりはして

いる冬。

2007-01-15

L-99 (7)

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

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

P07

解答
;; Common Lisp
(DEFUN MY-FLATTEN (LIST)
  (PROG (L A)
	(SETQ L LIST)
	(SETQ A '())
    L	(COND ((NULL L) (RETURN A)))
	(SETQ A (APPEND A (IF (CONSP (CAR L))
			      (MY-FLATTEN (CAR L))
			    (LIST (CAR L)))))
	(SETQ L (CDR L))
	(GO L)))

;; Scheme
(define my-flatten 
  (lambda (ls)
    (letrec ((my-flatten1
	      (lambda (l r)
		(if (null? l)
		    r
		    (if (pair? (car l))
			(my-flatten1 (cdr l) (append r (my-flatten1 (car l) '())))
			(my-flatten1 (cdr l) (append r (list (car l)))))))))
      (my-flatten1 ls '()))))

flatten難しい…。手続的にしろ再帰的にしろ、どっち

も中途半端に仕上がりました。

2007-01-14

L-99 (6)

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

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

問題
P06 Find out whether a list is a palindrome.
解答
;; Common Lisp
(defun palindromep (list)
  (cond ((equal list (reverse-a-list list)) t) ;P05
	(t nil)))

;; Scheme
(define palindrome?
  (lambda(l)
    (if (equal? l (reverse l))
	#t
	#f)))

2007-01-11

L-99 (5)

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

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

問題
P05 Reverse a list.
解答
;; Common Lisp
(DEFUN REVERSE-A-LIST (LIST)
  (PROG (L RL)
	(PSETQ L LIST
	       RL '())
L	(COND ((NULL L) (RETURN RL)))
        (PSETQ L (CDR L)
	       RL (CONS (CAR L) RL))
	(GO L)))

;; Scheme
(define (reverse-a-list ls)
  (let rev ((l ls) 
	    (rl '()))
    (if (null? l)
	rl
	(rev (cdr l) 
	     (cons (car l) rl)))))

...

2007-01-08

L-99 (4)

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

引き続き今回もL-99:Ninety-Nine Lisp Problems

70年代のLispのソースを参考に意味無くPROGを使ってみ

ています。

P04

解答
;; Common Lisp
(DEFUN NUMBER-OF-ELEMENTS (LIST)
  (PROG (N L)
	(SETQ N 0)
	(SETQ L LIST)
L	(COND ((NULL L) (GO X)))
        (PSETQ N (1+ N)
	       L (CDR L))
	(GO L)
X	(RETURN N)))

;; Scheme
(define number-of-element 
  (lambda (ls)
    (if (null? ls)
	0
	(+ 1 (number-of-element (cdr ls))))))

2007-01-04

L-99 (3)

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

今回もL-99: Ninety-Nine Lisp Problems

P03

解答:
;; Common Lisp
(DEFUN ELEMENT-AT (LIST K)
  (PROG (L C)
        (SETQ L LIST
              C K)
L       (AND (= C 1) (GO X))
        (PSETQ C (1- C)
               L (CDR L))
        (GO L)
X       (RETURN (CAR L))))

;; Scheme
(define element-at
  (lambda (ls k)
    (if (= k 1)
        (car ls)
        (element-at (cdr ls) (- k 1)))))

2007-01-03

L-99 (2)

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

今回もL-99: Ninety-Nine Lisp Problems


問題
P02 Find the last but one box of a list.
解答:
;; Common Lisp
(defun my-but-last (list)
  (loop for l on list when (null (cddr l))
	do (return l)))

;; Scheme
(define my-but-last
  (lambda (ls)
    (if (null? (cddr ls))
	ls
	(my-but-last (cdr ls)))))

L-99 (1)

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

ちょっと前にdel.icio.usのLispタグのとこに集中的に登録されたL-99: Ninety-Nine Lisp Problemsというページ。どっかの有名サイトで紹介でもされたんだろうか。

問題も99問完成してないようではあるけれども、とりあえず、挑戦してみる。もとはProlog用らしい。

問題:

P01 (*) Find the last box of a list.

解答:

  • Common Lisp
(defun my-last (list)
  (do ((l list (cdr l)))
      ((null (cdr l)) l)))

  • scheme
(define (my-last ls)
  (if (null? (cdr ls))
      ls
      (my-last (cdr ls))))

  • Zsh(無理矢理)
my-last()
{
    read car cdr
    
    if [ -z $cdr ] 
    then
	echo $car
    else
	echo $cdr|my-last
    fi
}

echo {001..450}|my-last
=>450

2007-01-02

勉強するよ.25

| 22:00 | 勉強するよ.25 - わだばLisperになる を含むブックマーク はてなブックマーク - 勉強するよ.25 - わだばLisperになる

紫藤さんのもうひとつの Scheme 入門の実習をすることの3回目

今回は、 3. リストを作ろう に挑戦

例によって練習問題をやってみるだけだったり。


;;  練習問題 1
;; 処理系が次のように表示するデータ構造を cons で作ってください。

;;    1. ("hi" . "everybody")
(cons "hi" "everybody")

;;    2. (0)
(cons 0 '())

;;    3. (1 10 . 100)
(cons 1 (cons 10 100))

;;    4. (1 10 100)
(cons 1 (cons 10 (cons 100 '())))

;;    5. (#\I "saw" 3 "girls")
(cons #\I (cons "saw" (cons 3 (cons "girls" '()))))

;;    6. ("Sum of" (1 2 3 4) "is" 10) 
(cons "Sum of" (cons '(1 2 3 4) (cons "is" (cons 10 '()))))


;;  練習問題 2
;; 次の値を求めてください。

;;    1. (car '(0))
0

;;    2. (cdr '(0))
()

;;    3. (car '((1 2 3) (4 5 6)))
(1 2 3)

;;    4. (cdr '(1 2 3 . 4))
(2 3 . 4)

;;    5. (cdr (cons 3 (cons 2 (cons 1 '())))) 
(2 1)