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

L-99 (41)

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

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

P41

解答
;;; Common Lisp

(defun goldbach-list (start end)
  (mapcar #'goldbach
	  (remove-if #'(lambda (item)
			 (or (< item 6)
			     (oddp item)))
		     (range start end))))

(defun goldbach-list/limit (start end limit)
    (remove-if #'(lambda (item) 
		   (< (car item) limit))
	       (goldbach-list start end)))

(defun pp-goldbach-list (lst)
  (mapc #'(lambda (item)
	    (destructuring-bind (a b)
		item
	      (format t "~d = ~d + ~d~%" (+ a b) a b)))
	lst))

;;; Scheme

(use srfi-1)

(define (goldbach-list start end)
  (map goldbach
       (remove (lambda (item)
		 (or (< item 6) (odd? item)))
	       (range start end))))


(define (goldbach-list/limit start end limit)
  (remove (lambda (item) (< (car item) 50))
	  (goldbach-list start end)))

(use util.match)

(define (pp-goldbach-list lst)
  (for-each (lambda (item)
	      (match-let (((a b) item))
			 (format #t "~D = ~D + ~D~%"  (+ a b) a b)))
	    lst)
  lst)

今回のお題は、指定した範囲内の偶数に前回のgoldbach

関数を適用して、リストを返す?関数の作成

リストを取って結果をリストでかえすgoldbach-listと、

下限を指定してある、goldbach-list/limitと、専用の

清書用の関数pp-goldbach-listを作ってみた。

(pp-goldbach-list (goldbach-list 1 2000))

とすれば問題と同じように出力される。

2007-03-29

L-99 (40)

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

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

P40

解答
;;; Common Lisp

;; prog版
(LOAD "./is-prime")
(LOAD "./next-prime")

(DEFUN GOLDBACH (N)
  (AND (EVENP N)
       (> N 3)
       (PROG (I J)
	  (SETQ I 2)
  L	  (SETQ J (- N I))
	  (AND (IS-PRIME J)
	       (RETURN-FROM GOLDBACH `(,I ,J)))
	  (SETQ I (NEXT-PRIME I))
	  (GO L))))

;; 突如On Lispの非決定性の章のchoose-bindを使ってみた版
(defun goldbach/amb (n)
  (choose-bind x (prime-list 2 (floor n 2))
    (if (is-prime (- n x))
	`(,x ,(- n x))
	(fail))))

;;; Scheme

(load "./is-prime")
(load "./next-prime")

;; 折角なので、前回のprime-listを使ってみた版
 (define goldbach
   (lambda (n)
     (if (even? n)
	 (let ((plist (prime-list 3 (/ n 2))))
	   (let/cc return
		   (for-each (lambda (i)
			  (and-let* ((j (- n i))
				     ((is-prime j)))
				    (return `(,i ,j))))
			plist)))
	 #f)))

;; Common Lispのprog版をそのまま訳した版
(define (goldbach n)
  (and (even? n)
       (> n 3)
       (let loop ((i 2))
	 (let ((j (- n i)))
	   (if (is-prime j)
	       `(,i ,j)
	       (loop (next-prime i)))))))

「6以上の任意の偶数は、二つの奇素数の和で表すこと

ができる」というのが、ゴルドバッハ予想らしい。

ということで、任意の偶数を素数+素数という形式に分

解する関数を作成。

2007-03-25

L-99 (39)

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

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

P39

解答
;; Common Lisp
(load "is-prime")

(defun prime-list (start end)
  (do ((i start (1+ i))
       (retlist '() (if (is-prime i) 
			`(,@retlist ,i)
			retlist)))
      ((= i end) retlist)))

;; -- rangeを使用してみた版
(load "is-prime")
(load "range")

(defun prime-list (start end)
  (remove-if-not #'is-prime
		 (range start end)))

;; -- 関数を引数に取れるようにrangeを変更して、そ
;;    れに次の素数を探してくるような関数を適用して
;;    みた版
(defun prime-list (start end)
  (range start end #'next-prime))

(defun next-prime (n)
  (do ((i (1+ n) (1+ i)))
      ((is-prime i) i)))

(defun range (start end &optional (pred #'1+))
  (do ((i (funcall pred (1- start)) (funcall pred i))
       (retlist '() `(,@retlist ,i)))
      ((> i end) retlist)))

;; Scheme
(load "is-prime")

(define prime-list 
  (lambda (start end)
    (let loop ((i start)
	       (retlist '()))
      (if (= i end)
	  retlist
	  (loop (+ i 1)
		(if (is-prime i)
		    `(,@retlist ,i)
		    retlist))))))

指定された範囲内の素数のリストを返す関数を作成する

のが今回のお題。

何の捻りもなく作成。

2007-03-24

L-99 (38)

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

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

P38

解答
;; Common Lisp
(load "totient-phi")
(load "phi")

(macrolet ((1000-times-time (func)
	     (format t "~a: ================" `,func)
	     `(time 
	       (dotimes (i 998 ,func)
		 ,func))))
  (1000-times-time (phi 10090))
  (1000-times-time (totient-phi 10090)))

;; Scheme
(load "totient-phi")
(load "phi")

(let-syntax ((1000-times-time 
	      (syntax-rules ()
		((_ func)
		 (begin
		   (print ";" 'func ":================")
		   (time (let loop ((i 0))
			   (when (< i 1000)
				 func
				 (loop (+ 1 i))))))))))
  (1000-times-time (phi 10090))
  (1000-times-time (totient-phi 10090)))

P34の実装と、P37の実装の効率を比べてみよう、という

お題。

比較結果は、

(PHI 10090): ================
Evaluation took:
  1.78 seconds of real time
  1.291522 seconds of user run time
  0.022033 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  458,512 bytes consed.
(TOTIENT-PHI 10090): ================
Evaluation took:
  5.893 seconds of real time
  4.627227 seconds of user run time
  0.047596 seconds of system run time
  0 calls to %EVAL
  0 page faults and
  0 bytes consed.

で、工夫したものの方が3倍強速い模様。

Gaucheだと、7倍位違う模様。

比較作業中、P34とP37の結果が違うことが判明。

良く調べてみるとL-99の問題の式は、

phi(m) = (p1 - 1) * p1**(m1 - 1) [html]+[/html] (p2...

と足し算になっている。

オリジナルのP-99のサイトを参照してみると、L-99の誤

植で、本当は掛け算で、

phi(m) = (p1 - 1) * p1**(m1 - 1) [html]*[/html] (p2...

が正しい模様。

ということで、P37も修正しました。

2007-03-22

L-99 (37)

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

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

P37

解答
;; Common Lisp
(load "prime-factors-mult")

(defun phi (m)
  (apply #'*
	 (mapcar #'(lambda (list) 
		     (destructuring-bind (p m)
			 list
		       (* (1- p) (expt p (1- m)))))
		 (prime-factors-mult m))))

;; Scheme
(use util.match)
(load "prime-factors-mult")

(define phi
  (lambda (m)
    (let loop ((ls (prime-factors-mult m))
	       (retval 1))
      (if (null? ls)
	  retval
	  (loop (cdr ls)
		(* retval (match-let (((p m) (car ls)))
				     (* (- p 1) (expt p (- m 1))))))))))

前に作成したφ関数の進化版を実装するのが今回のお題。

前回の問題は、今回の前振りだった様子。

scheme版は、mapだと面白くないかなと思って、無理に

ループにしてみた。

L-99 (36)

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

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

P36

解答
;; Common Lisp
(load "prime-factors")

(defun prime-factors-mult (n)
  (do ((l (prime-factors n) (cdr l))
       (c 1 (if (eql (car l) prevl)
		(1+ c)
		1))
       (retlist '() (if (eql (car l) prevl)
			retlist
			`(,@retlist (,prevl ,c))))
       (prevl (gensym) (car l)))
      ((endp l) (cdr `(,@retlist (,prevl ,c))))))

;; Scheme
(use srfi-8)
(load "prime-factors")

(define prime-factors-mult
  (lambda (n)
    (let loop ((l (prime-factors n))
	       (c 1)
	       (retlist ())
	       (prevl #f))
      (if (null? l)
	  (cdr `(,@retlist (,prevl ,c)))
	  (receive (c1 retlist1)
		   (if (eqv? (car l) prevl)
		       (values (+ 1 c) retlist)
		       (values 1 `(,@retlist (,prevl ,c))))
		   (loop (cdr l)
			 c1
			 retlist1
			 (car l)))))))

今回のお題は、素因数分解の結果を、(3 3 5 7)という

形式ではなく、((3 2) (5 1) (7 1) )のように素数と出

現回数で構成されたリストにして返すというもの。

P12のencodeと、P35のprime-factorsの合成という感じ。

2007-03-20

L-99 (35)

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

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

P35

解答
;; Common Lisp
(load "is-prime")

(defun prime-factors (n)
  (flet ((next-prime (n)
	   (do ((i (1+ n) (1+ i)))
	       ((is-prime i) i))))
    (labels ((prime-factors1 (n i)
	       (multiple-value-bind (q r)
		   (floor n i)
		 (cond ((< n 2)
			`(,n))
		       ((zerop r)
			(if (= q 1)
			    `(,i)
			    `(,i ,@(prime-factors1 q i))))
		       ('t 
			(prime-factors1 n (next-prime i)))))))
      (prime-factors1 n 2))))

;; Scheme
(load "is-prime")

(define prime-factors
  (lambda (n)
    (let ((next-prime
	   (lambda (n)
	     (let loop ((i (+ n 1)))
	       (if (is-prime i)
		   i
		   (loop (+ i 1)))))))
      (letrec ((prime-factors1
		(lambda (n i)
		  (let ((q (quotient n i))
			(r (remainder n i)))
		    (cond ((< n 2)
			   `(,n))
			  ((zero? r)
			   (if (= q 1)
			       `(,i)
			       `(,i ,@(prime-factors1 q i))))
			  (else
			   (prime-factors1 n (next-prime i))))))))
	(prime-factors1 n 2)))))

今回は素因数分解する関数の作成が課題。色々なアルゴ

リズムはあれど、実装できないので、単純に力ずくで割

り算していくだけの方式で作成。

自分で作っていて自分でも良く分からないものがで

きた。力ずく故に

(prime-factors 99999999999)⇒(3 3 21649 513239)

位で結果が出るまでにしばらく時間がかかる。

まあ、良しとして先に進もう(´Д`)

2007-03-11

L-99 (34)

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

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

P34

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

(defun totient-phi (m)
  (do ((i (1- m) (1- i))
       (r 0 (if (coprime m i)
		(1+ r)
		r)))
      ((zerop i) r)))

;; Scheme
(load "./coprime")

(define (totient-phi m)
  (let loop ((n m)
	     (c (- m 1))
	     (acc 0))
    (if (zero? c)
	acc
	(loop m 
	      (- c 1) 
	      (if (coprime n c)
		  (+ acc 1)
		  acc)))))

;; Ruby
load "coprime.rb"

def totient_phi(n)
  i = n
  r = 0
  until i < 1
    r += 1 if coprime(n, i)
    i -= 1
  end
  r
end

オイラーってEulerと綴ることを初めて知った。

Wikipediaによれば、トーティエント関数とは、正の整

数nに対して、1からnまでの互いに素である数の個数だ

そうな。φ関数とも呼ぶらしい。とりあえず関数の意味

はさっぱり分からないが、互いに素な個数を勘定するよ

うに作った。

L-99 (33)

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

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

P33

解答
;; Common Lisp
(defun coprime (m n)
  (if (= 1 (abs (gcd m n)))
      t
      nil))

;; Scheme
(define coprime
  (lambda (m n)
    (if (= 1 (abs (gcd m n)))
	#t
	#f)))

;; Ruby
load "my_gcd"

def coprime(m, n)
  return true if my_gcd(m, n).abs == 1
  nil
end

coprimeとは「互いに素」であることを言うらしい。

1と-1以外で共通する約数を持たないかどうかを調べれ

ば良いらしいので、そういう風に作ってみた。

Rubyは書き方が分からない。しかし、Common Lispも

Schemeも書き方は分かっていないので、まあ良し。

2007-03-09

L-99 (32)

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

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

P32

解答
;; Common Lisp
(defun my-gcd (m n)
  (if (zerop n)
      m
      (my-gcd m (mod m n))))

;; Scheme
(define my-gcd
  (lambda (m n)
    (if (zero? n)
	m
	(my-gcd m (modulo m n))))) 

;; Dylan
define method my-gcd (m :: <integer>, n :: <integer>)
 => result :: <integer>;
  if (zero?(n))
    m;
  else
    my-gcd(n, modulo(m, n));
  end;
end;

;; Ruby
def my_gcd(m, n)
  return m if n == 0
  my_gcd(n, m % n)
end

;; Perl
sub my_gcd {
    my ($m, $n) = @_;
    return $m if ($n == 0);
    my_gcd($n, $m % $n);
}

;; Python
def my_gcd(m, n):
    if n == 0:
        return m
    else:
        return my_gcd(n, m % n)

ユークリッドの互除法を使えとあるので、互除法そのま

まの回答。意味なく他の言語でも書いてみる。

2007-03-07

L-99 (31)

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

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

P31

解答
;; Common Lisp
(defun is-prime (n)
  (cond ((< n 2) nil)
	((= n 2) t)
	((= n 3) t)
	((zerop (mod n 2)) nil)
	('t (do ((i 3 (+ i 2))
		 (fin n (multiple-value-bind (quotient remainder)
			    (floor n i)
			  (if (zerop remainder) 
			      (return nil)
			      quotient))))
		((> i fin) t)))))

;; Scheme
(define is-prime
  (lambda (n)
    (call/cc
     (lambda (return)
       (cond ((< n 2) #f)
	     ((= n 2) #t)
	     ((= n 3) #t)
	     ((zero? (modulo n 2)) #f)
	     (else (let loop ((i 3)
			      (fin n))
		     (if (> i fin)
			 #t
			 (loop (+ i 2)
			       (if (zero? (remainder n i))
				   (return #f)
				   (quotient n i))))))))))) 

28問目でリスト操作篇は終了し、番号が抜けて31問目か

ら算術篇突入。

今回は、与えられた数が素数であるかを判定する関数を

作成するのが問題。

色々アルゴリズムはあるようだけれども理解できないの

で、単純に割切れるかどうかを力ずくで確認することに

して、思い付きでちょっと工夫してみた。

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がないので、これまた後回し!