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-04-03

L-99 (48)

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

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

P48

解答
;;; Common Lisp
(load "./make-truth-table")

(defun table (size expr)
  (mapcar #'(lambda (item)
	      `(,@item ,(apply expr item)))
	  (make-truth-table size)))

(defun pp-table (lst)
  (dolist (l lst)
    (format t "~{~A ~} -> ~{~A~}~%" (butlast l) (last l))))

;;; Scheme
(load "./make-truth-table")

(define table
  (lambda (size expr)
    (map (lambda (item)
	   `(,@item ,(apply expr item)))
	 (make-truth-table size #t #f))))

(define pp-table
  (lambda (lst)
    (let loop ((l lst))
      (if (null? l)
	  (values)
	  (let ((m (car l)))
	    (format #t "~A -> ~A~%" (drop-right m 1) (last m))
	    (loop (cdr l)))))))

P47は、与える論理式を中間記法で与えられるようにす

るという問題。これは自分の手に余るので、後回し後回

し。それで、P48は真理表のテーブルをリストで与える

ように拡張せよ、というもの。

ちょっとした疑問があって、それは問題では、[A,B,C]

というようにリストを与えるようになっているところ。

Prologでは、こういう表現で良いのかもしれないけれど、

真偽表なので、真か偽かの2値しか取らない筈であり、

要素の数が分かれば良いのではないかしらと思ったり。

そんな訳で、要素の数だけ指定するように作ってみた。


L-99 (46)

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

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

P46

解答
;;; Common Lisp
(defun nth-truth (size num &optional (true t) (false nil))
  (do* ((j size (1- j))
	(retlst '() `(,@retlst 
		    ,(if (evenp (floor num (expt 2 j))) true false))))
       ((zerop j) retlst)))

(defun make-truth-table (size &optional (true t) (false nil))
  (do ((i 0 (1+ i))
       (retlst '() `(,@retlst ,(nth-truth size i true false))))
      ((= i (expt 2 size)) retlst)))       

(defun table/3 (a b expr)
  (let ((size 2))
    (mapcar #'(lambda (pattern)
		(destructuring-bind (a b)
		    pattern
		  `(,a ,b ,(funcall expr a b))))
	    (make-truth-table size a b))))

(defun pp-table/3 (lst)
  (dolist (l lst)
    (destructuring-bind (a b c)	l
      (format t "~A ~A -> ~A~%" a b c))))

(defun and/2 (a b) 
  (if a b a))

(defun or/2 (a b)
  (if a a b))

(defun impl/2 (a b)
  (or/2 (not a) b))

(defun nand/2 (a b)
  (not (if a b a)))

(defun nor/2 (a b)
  (not (if a a b)))

(defun equ/2 (a b)
  (or/2 (and/2 a b)
	(and/2 (not a) (not b))))

(defun xor/2 (a b)
  (not (or/2 (and/2 a b)
	     (and/2 (not a) (not b)))))

;;; Scheme
(use util.match)

(define nth-truth
  (lambda (size num true false)
    (let loop ((j size)
	       (retlst '()))
      (if (zero? j)
	  retlst
	  (loop (- j 1) 
		`(,@retlst ,(if (even? (quotient num (expt 2 (- j 1))) )
				true 
				false)))))))

(define make-truth-table
  (lambda (size true false)
    (let loop ((i 0)
	       (retlst '()))
      (if (= i (expt 2 size))
	  retlst
	  (loop (+ i 1)
		`(,@retlst ,(nth-truth size i true false)))))))

(define table/3
  (lambda (a b expr)
    (let ((size 2))
      (map (lambda (pattern)
	     (match-let (((a b) pattern))
			`(,a ,b ,(expr a b))))
	   (make-truth-table size a b)))))

(define pp-table/3 
  (lambda (lst)
    (for-each (lambda (i)
		(match-let (((a b c) i))
			   (format #t "~A ~A -> ~A~%" a b c)))
	      lst)
    (values)))

(define (and/2 a b) 
  (if a b a))

(define (or/2 a b)
  (if a a b))

(define (impl/2 a b)
  (or/2 (not a) b))

(define (nand/2 a b)
  (not (if a b a)))

(define (nor/2 a b)
  (not (if a a b)))

(define (equ/2 a b)
  (or/2 (and/2 a b)
	(and/2 (not a) (not b))))

(define (xor/2 a b)
  (not (or/2 (and/2 a b)
	     (and/2 (not a) (not b)))))
;

今回から論理と符号化のセクション。番号も飛んで46番

から開始。implがなんだか良く分からなかったが、

Wikipediaを参照してなんとか作成。

ゲスト



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