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-02-18

L-99 (26)

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

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

P26

解答
;; Common Lisp
(defun combination (n list)
  (cond ((zerop n)
	 '())
	((= (length list) n)
	 `(,list))
	((= n 1)
	 (mapcar #'(lambda (i) (cons i ()))
		 list))
	('t
	 `(,@(mapcar #'(lambda (i) `(,(car list) ,@i))
		     (combination (1- n) (cdr list)))
	     ,@(combination n (cdr list))))))

;; Scheme
(define combination
  (lambda (n lis)
    (cond ((zero? n)
	   '())
	  ((= (length lis) n)
	   `(,lis))
	  ((= n 1)
	   (map (lambda (i) `(,i))
		lis))
	  (else
	   `(,@(map (lambda (i) `(,(car lis) ,@i))
		    (combination (- n 1) (cdr lis)))
	     ,@(combination n (cdr lis)))))))

L-99のサイトに接続できないので、オリジナルのP-99の

サイトの問題を掲載。

ここに来て急激に難しい。バックトラッキングしてみよ

うとあるが、どういう感じでバックトラッキングして良

いのか分からないので、普通に回答。

L-99が終ったらPrologで、P-99にも挑戦してみようと思

うのだった。

2007-02-17

L-99 (25)

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

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

P25

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

(defun rnd-permu (list)
  (rnd_select list (length list)))

;; Scheme
(load "./p23")

(define rnd_permu 
  (lambda (lis)
    (rnd_select lis (length lis))))

2007-02-13

L-99 (24)

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

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

P24

解答
;; Common Lisp
(load "./p22")
(load "./p23")

(defun lotto-select (n rng)
  (rnd_select (range 1 rng) n))

;; Scheme
(load "./p22")
(load "./p23")

(define lotto-select
  (lambda (n r)
    (rnd_select (range 1 r) n)))

2007-02-12

L-99 (23)

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

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

P23

解答
;; Common Lisp
(defun split (list n)
  (do ((l list (cdr l))
       (c 0 (1+ c))
       (retlist '() (if (< c n)
			`(,@retlist ,(car l))
			(return `(,retlist ,l)))))
      ((endp l) retlist)))

(defun remove-at (list n)
  (destructuring-bind (1st 2nd)
      (split list (1- n))
    (values `(,@1st ,@(cdr 2nd)) (car 2nd))))

(defun rnd_select (list n)
  (labels ((rnd_select1 (l c retlist)
	     (if (zerop c)
		 retlist
		 (multiple-value-bind (rest item) 
		     (remove-at l (1+ (random (length l))))
		   (rnd_select1 rest 
				(1- c) 
				`(,item ,@retlist))))))
    (rnd_select1 list n '())))

;; Scheme
(use srfi-27)
(use util.match)

(define split
  (lambda (ls n)
    (letrec ((split1
	      (lambda (l c rl)
		(call/cc
		 (lambda (return)
		   (if (null? l)
		       rl
		       (split1 (cdr l) 
			       (+ c 1)
			       (if (< c n)
				   `(,@rl ,(car l))
				   (return `(,rl ,l))))))))))
      (split1 ls 0 '()) )))

(define remove-at
  (lambda (l n)
    (match-let (((1st 2nd) (split l (- n 1))))
	       (values 
		`(,@1st ,@(cdr 2nd)) (car 2nd)))))

(define rnd_select
  (lambda (ls n)
    (let rnd_select1 ((l ls) (c n) (rl '()))
      (if (zero? c)
	  rl
	  (call-with-values 
	      (lambda () (remove-at l (+ 1 (random-integer (length l)))))
	    (lambda (rest item)
	      (rnd_select1 rest (- c 1) `(,item ,@rl))))))))

問題のヒントを読むとP20のremove-atを使ってみよう、

とある。がしかし、L-99のremove-atを見てみても、

remove-atが使えるとはあまり思えず。

L-99の元になったP-99のサイトのremove-atをみてみた

ところP-99のremove-atは取り除くアイテムと残りのリ

ストの2値を返すようになっていたので、remove-atを使っ

てみよという意味にも納得。

remove-atも多値を返すように変更してみて回答を作成

してみた。splitもなんとなく改訂。

L-99 (22)

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

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

P22

解答
;; Common Lisp
(defun range (start end)
  (loop for i from start to end
        collect i))

;; Scheme
(define range
  (lambda (s e)
    (let renge1 ((c s) (rl '()))
      (if (> c e)
	  rl
	  (renge1 (+ c 1) `(,@rl ,c))))))

L-99 (21)

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

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

P21

解答
;; Common Lisp
(defun insert-at (item list n)
  (do ((l list (cdr l))
       (c 1 (1+ c))
       (retlist '() (if (= c n)
			(return `(,@retlist ,item ,@l))
			`(,@retlist ,(car l)))))
      ((endp l) retlist)))

;; Scheme
(define insert-at
  (lambda (itm ls n)
    (call/cc
     (lambda (return)
       (let loop ((l ls) 
		  (c 1) 
		  (rl '()))
	 (cond ((null? l) 
		rl)
	       ((= c n) 
		(return `(,@rl ,itm ,@l)))
	       (else
		(loop (cdr l) 
		      (+ c 1) 
		      `(,@rl ,(car l))))))))))

これを作ってる最中に今迄作成した解答の無駄な部分に

気が付いた。

今回のinsert-atや、splitなどは、結果が判明した時点

で残りのCDRをくっつけて返せば良かったではないか。

ということで、returnとか、call/ccを使ってみた。

2007-02-10

L-99 (20)

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

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

P20

解答
;;; Common Lisp
(defun remove-at (list n)
  (do ((l list (cdr l))
       (c 1 (1+ c))
       (retlist '() (if (= c n)
			retlist
			`(,@retlist ,(car l)))))
      ((endp l) retlist)))

;;PROG版
(DEFUN REMOVE-AT (LIST N)
  (PROG (L C RETLIST)
     (SETQ L LIST)
     (SETQ C 1)
     (SETQ RETLIST '())
L    (COND ((NULL L) (GO XIT)))
     (OR (= C N)
	 (SETQ RETLIST (CONS (CAR L) RETLIST)))
     (SETQ C (1+ C))
     (SETQ L (CDR L))
     (GO L)
XIT  (RETURN (NREVERSE RETLIST))))

;; Scheme
(define (remove-at ls n)
  (let remove-at1 ((l ls) (c 1) (retlist '()))
    (cond ((null? l) 
	   retlist)
	  ((= c n) 
	   (remove-at1 (cdr l) 
		       (+ c 1) 
		       retlist))
	  (else 
	   (remove-at1 (cdr l) 
		       (+ c 1) 
		       `(,@retlist ,(car l)))))))

2007-02-07

L-99 (19)

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

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

P19

解答
;; Common Lisp
(defun rotate (list n)
  (destructuring-bind (1st 2nd)
      (split list 
	     (if (plusp n) 
		 n 
		 (+ (length list) n)))
    `(,@2nd ,@1st)))

;; Scheme
(define rotate
  (lambda (ls n)
    (let rotate1 ((l ls) 
		  (p (if (positive? n) 
			 n 
			 (+ (length ls) n)))
		  (c 0)
		  (1st '())
		  (2nd '()))
      (cond ((null? l) 
	     `(,@2nd ,@1st))
	    ((< c p) 
	     (rotate1 (cdr l) p (+ c 1) `(,@1st ,(car l)) 2nd))
	    (else 
	     (rotate1 (cdr l) p (+ c 1) 1st `(,@2nd ,(car l))))))))

Scheme版は問題を良く読まずsplitを使わないで作った

もの。とはいえ、内部的な構造は大体同じ。

2007-02-05

L-99 (18)

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

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

P18

解答
;; Common Lisp
(defun slice (list start end)
  (do ((l list (cdr l))
       (c 1 (1+ c))
       (retlist '() (if (<= start c end)
			`(,@retlist ,(car l))
			retlist)))
      ((or (endp l) (> c end)) retlist)))

;; Scheme
(define slice 
  (lambda (ls s e)
    (let slice1 ((l ls) (c 1) (rl '()))
      (cond ((or (null? l) (> c e)) rl)
	    ((<= s c e) 
	     (slice1 (cdr l) (+ c 1) `(,@rl ,(car l))))
	    (else
	     (slice1 (cdr l) (+ c 1) rl))))))

2007-02-04

L-99 (17)

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

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

P17

解答
;; Common Lisp
(defun split (list n)
  (do ((l list (cdr l))
       (c 0 (1+ c))
       (retlist '(() ()) 
		(let ((first  (car retlist))
		      (second (cadr retlist)))
		  (if (< c n)
		      `((,@first ,(car l)) ,second)
		      `(,first (,@second ,(car l)))))))
      ((endp l) retlist)))

;; Scheme
(define split
  (lambda (ls n)
    (letrec ((split1
	      (lambda (l p c rl)
		(if (null? l)
		    rl
		    (split1 (cdr l) 
			    p 
			    (+ c 1)
			    (let ((1st (car rl))
				  (2nd (cadr rl)))
			      (if (< c p)
				  `((,@1st ,(car l)) ,2nd)
				  `(,1st (,@2nd ,(car l))))))))))
      (split1 ls n 0 '(() ())))))

doばかり使っていたら、なんとなくdoに親近感が湧いて

きてしまった。末尾再帰で書くのとdoでbodyを使わない

で書くのとは感覚的に似ている気がする。

2007-02-03

L-99 (16)

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

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

P16

解答
;; Common Lisp
(defun drop (list n)
  (prog ((l list) (c n) (retlist '()))
L      (and (endp l) (return retlist))
       (multiple-value-setq (c retlist)
	 (if (= c 1)
	     (values n retlist)
	   (values (1- c) `(,@retlist ,(car l)))))
       (setq l (cdr l))
       (go L)))

;; Scheme
(define drop
  (lambda (ls n)
    (letrec ((drop1
	      (lambda (ls rls init c)
		(cond ((null? ls) 
		       rls)
		      ((= c 1)
		       (drop1 (cdr ls) rls init init))
		      (else 
		       (drop1 (cdr ls) `(,@rls ,(car ls)) init (- c 1)))))))
      (drop1 ls '() n n)))) 

意味なくmultiple-value-setqを使ってみた。

2007-02-01

L-99 (15)

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

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

P15

;;; Common Lisp
(defun repli (list n)
  (do ((l list (cdr l))
       (retlist '() `(,@retlist ,@(make-list n :initial-element (car l)))))
      ((endp l) retlist)))

;;; Scheme
(define repli
  (lambda (ls n)
    (let loop ((l ls) (r '()))
      (if (null? l)
          r
          (loop (cdr l)
                `(,@r ,@(make-list n (car l))))))))

make-listが使えそうだったので使ってみた。