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 (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を参照してなんとか作成。