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-05-29

L-99 (27)

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

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

久々の更新。先に進めないので、後回しにしていたP27に挑戦。

残りの問題:'(55 58-60 63 66 80-94 96-99)

P27

解答
;; Lisp Machine Lisp
;; -----------------------------------------------------------------------------
(defun group (lst pat)
  (group-rpat lst (reverse pat)))

(defun group-rpat (lst pat)
  (if (> (apply #'+ pat) (length lst))
      (error "foo!")
    (cond ((null pat) () )
	  ((= (length lst) (car pat)) `(,lst))
	  ((= 1 (length pat)) 
	   (sep2 lst (car pat)))
	  ('t (sep2s (group-rpat lst (cdr pat)) (car pat))))))

(defun sep2 (lst num)
  (let ((front (combination num lst)))
    (mapcar #'(lambda (item) 
		`(,item ,(setdiff lst item)))
	    front)))

(defun sep2s (lsts num)
  (do ((l lsts (cdr l))
       (retlst () ))
      ((null l) retlst)
    (setq retlst 
	  `(,@retlst 
	    ,@(mapcar #'(lambda (item)
			     (if (cadr item)
				 `(,@(butlast (car l)) ,(car item) ,(cadr item)) 
				 `(,@(butlast (car l)) ,(car item))))
		   (sep2 (car (last (car l))) num))))))

;; Utils (from Maclisp LSETS.LSP)
(defun y-x+z (y x z &aux y-x)
  (mapc #'(lambda (xx) (or (memq xx x) (push xx y-x))) y)
  (nreconc y-x z))

(defun setdiff (x y)
  (if (dolist (xx y)
	(let ((res (memq xx x)))
	  (and res (return xx))))
      (y-x+z x y () )
    x))

;; Common Lisp
;; -----------------------------------------------------------------------------
(defun group (lst pat)
  (group-rpat lst (reverse pat)))

(defun group-rpat (lst pat)
  (if (> (apply #'+ pat) (length lst))
      (error "foo!")
      (cond ((endp pat) '()	)
	    ((= (length lst) (car pat)) `(,lst))
	    ((= 1 (length pat)) 
	     (sep2 lst (car pat)))
	    ('t (sep2s (group-rpat lst (cdr pat)) (car pat))))))

(defun sep2 (lst num)
  (let ((front (combination num lst)))
    (map 'list #'(lambda (item) 
		   `(,item ,(set-difference lst item)))
	 front)))

(defun sep2s (lsts num)
  (do ((l lsts (cdr l))
       (retlst '()))
      ((endp l) retlst)
    (setq retlst 
	  `(,@retlst 
	    ,@(map 'list #'(lambda (item)
			     (if (cadr item)
				 `(,@(butlast (car l)) ,(car item) ,(cadr item)) 
				 `(,@(butlast (car l)) ,(car item))))
		   (sep2 (car (last (car l))) num))))))

;; Scheme
;; -----------------------------------------------------------------------------
(define (group lst pat)
  (group-rpat lst (reverse pat)))

(define (group-rpat lst pat)
  (if (> (apply + pat) (length lst))
      '()
      (cond ((null? pat) 
	     '() )
	    ((= (length lst) (car pat))
	     `(,lst))
	    ((= 1 (length pat)) 
	     (sep2 lst (car pat)))
	    (else 
	     (sep2s (group-rpat lst (cdr pat)) (car pat))))))

(define (sep2 lst num)
  (if (> num (length lst))
      '()
      (let ((front (combination num lst)))
	(map  (lambda (item) 
		`(,item ,(lset-difference eq? lst item)))
	      front))))

(define (sep2s lsts num)
  (let frob ((l lsts)
	     (retlst '() ))
    (if (null? l)
	retlst
	(frob (cdr l)
	      `(,@retlst 
		,@(map (lambda (item)
			 `(,@(drop-right (car l) 1) ,@(remove null? item)))
		       (sep2 (last (car l)) num)))))))

2007-05-23


.2

| 23:00 | .2 - わだばLisperになる を含むブックマーク はてなブックマーク - .2 - わだばLisperになる

(;´Д`)「こ、ここは?」

( -人-)「ジャンク屋という所は情報を集めるのに便利なのでな。ここに住み込みをさせてもらっている。こいつをCommon Lispの記録回路に取り付けろ。MaclispDOを参考に開発した」

(;´Д`)『こ、こんな古い物を。父さん、酸素欠乏性にかかって』

( -人-)「すごいぞ、Common Lispの戦闘力は数倍に跳ね上がる。持って行け、そしてすぐ取り付けて試すんだ」

(;´Д`)「はい。でも父さんは?」

( -人-)「研究中の物がいっぱいある。また連絡はとる。ささ、行くんだ」

(;´Д`)「うん」「父さん、僕、くにで母さんに会ったよ」.......

(defmacro old-style-do (&body body)
  (cond ((and (atom (car body)) (not (null (car body)))) ;First format (1969)
	 `(do ((,(car body) ,(cadr body) ,(caddr body)))
	      (,(cadddr body))
	   . ,(cddddr body)))
	((not (cadr body))			;Third format (1973)
	 `(prog ,(mapcar #'(lambda (spec) `(,(car spec) ,(cadr spec))) (car body))
	    . ,(cddr body)))
	('t				;Second format (1972) - Current Format
	 `(do . ,body))))
  
;; Usage
(old-style-do i 0 (1+ i)		;First Format
	      (= i 10)
	      (print "foo"))

(do ((i 0 (1+ i)))			;Second fomat
    ((= i 10) 'foo)
  (print "foo"))

(old-style-do ((i 0) (j 1)) nil		;Third Format
	   l  (and (= i 10) (return (values "PROG! PROG! PROG!" i j)))
	      (print "foo")
	      (setq i (1+ i))
	      (go l))

2007-05-21

TAOの!!

| 01:53 | TAOの!! - わだばLisperになる を含むブックマーク はてなブックマーク - TAOの!! - わだばLisperになる

Lispの問題集を解くのも行き詰まって来てしまったので、何か他のことをしようと思い立ち、関数やマクロを組んで遊んでみることにした。

ちょっと変ったところということで、マニュアルが公開されているマルチパラダイムなTAO Lispの関数を真似てつくってみることに。

色々変った関数があるけれども、今回は、自己代入式の`!!'を真似てみる。

C等の、i++とか、i += 2などに該当するのだろうか。

http://www.nue.org/nue/tao-manual/tao-0.txt:マニュアルを眺める限りでは、

(!!cons !x y)

のように使用し、

(setq x (cons x y))

の結果と同じ様子。

!がついた変数に式の結果が代入されることになるらしい。

色々考えてみたけれど、マークを付ける方法が思い付かなかったので、selfというquoteの別名マクロを作成して、自己代入式のマクロで展開される際にcarがselfかどうかで判断してみることにした。

そして、TAOでは、!!や、!を使用しているけれども、リーダーマクロをどういう風に組んだら実現できるのか、さっり検討も付かず、また、!や、!!を使うと、通常の環境に影響するので、'!!'は'☺'で'!'は'☞'という風にUnicodeで一文字のリーダーマクロにしてみた。

(let ((a '(1 2 3) )
      (b '(a b c)))
  (☺cons ☞a b)
  (values a b))
=> ((1 2 3) a b c), (a b c)

(let ((a '(1 2 3) )
      (b '(a b c)))
  (☺append ☞a b)
  (values a b))
=> (1 2 3 a b c), (a b c)

(let ((i 64) )
  (☺1+ ☞i))
=> 65

(let ((i 11)
      (j 22) )
  (☺(lambda(m n) (* n m 33)) ☞i j)
  (values i j))
=>7986, 22

(let ((i '(4 64 8 77) )
      (j '(77 1 1024 4)))
  (☺(lambda(l m) (remove-duplicates `(,@l ,@m))) ☞i j)
  (values i j))
=> (64 8 77 1 1024 4), (77 1 1024 4)

という感じ。

(defmacro self (var)
  `(quote ,var))

(defmacro selfass (fn &rest args)
  "<説明>
 形式 : (!!func arg1 arg2 ... !argI ... argN)
上式は (setq argI (func arg1 arg2 ... argI ... argN)) と同じ。
自己代入式を作る。関数 func を arg1 ... argN を引数として実行し、
結果を argI に代入する。"
  (let ((self (dolist (item args)
		(and (listp item)
		     (eq 'self (car item))
		     (return (cadr item)))))
	(vars (mapcar #'(lambda (item)
			  (if (and (listp item) (eq 'self (car item)))
			      (cadr item)
			      item))
		      args)))
    `(setf ,self (,fn ,@vars))))

(set-macro-character #\☞
 		     #'(lambda (stream char)
			 (declare (ignore char))
			 (list 'self (read stream t nil t))))

(set-macro-character #\☺
 		     #'(lambda (stream char)
			 (declare (ignore char))
			 'selfass))

2007-05-19

L-99 (80) (4)

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

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

P80の続き。Scheme版。

もう何が何だか良く分からないけど、これでP80も落着

としよう!

SRFI-42の内包表記とか使ってみようと思ったりもした

んだけども。

解答
;; Scheme
;; -----------------------------------------------------------------------------
;; utility
(define (flatten lst)
  (cond ((null? lst) '() )
	((not (pair? lst)) `(,lst))
	(else `(,@(flatten (car lst))
		,@(flatten (cdr lst))))))

(define (sort-by-symbol-name lst pos-fn)
  (sort lst
	(lambda (a b)
	  (string<? (symbol->string (pos-fn a)) (symbol->string (pos-fn b))))))

;; -----------------------------------------------------------------------------
;; Graph Term
;; 1)
(define (graph-term->edge-clause expr)
  (cadr expr))

;; 2) DIRECTED
(define graph-term->arc-clause/directed graph-term->edge-clause)

;; 3) LABELLED
(define graph-term->arc-clause/labelled graph-term->edge-clause)

;; 1)
(define (edge-clause->graph-term expr)
  `(,(sort-by-symbol-name
      (delete-duplicates
       (fold append '() expr))
      identity)
    ,expr))

;; 2) DIRECTED
(define arc-clause->graph-term/directed arc-clause->graph-term/labelled)

;; 3) LABELLED
(define (arc-clause->graph-term/labelled expr)
  `(,(sort-by-symbol-name
      (delete-duplicates
       (fold (lambda (item retlst) `(,@(drop-right item 1) ,@retlst))
	     '() expr))
      identity)
    ,expr))

;; -----------------------------------------------------------------------------
;; Adjacency List
;; 1)
(define (graph-term->adjacency-list expr)
  `(,@(map (lambda (item)
	     `(,item 
	       ,(remove null?
			(delete-duplicates 
			 (flatten 
			  (map (lambda (lst)
				 (remove (cut eq? item <>)
					 (if (memq item lst)
					     lst
					     '() )))
			       (cadr expr)))))))
	   (car expr))))

;; 2) DIRECTED
(define (graph-term->adjacency-list/directed expr)
  (map (lambda (item) `(,item ,(get-direction item (cadr expr))))
       (car expr)))

(define (get-direction from dist-lst)
  (fold (lambda (item retlst)
	  (if (eq? from (car item))
	      `(,@retlst ,(cadr item))
	      retlst))
	'() dist-lst))

;; 3) LABELLED
(define (graph-term->adjacency-list/labelled expr)
  (map (lambda (item)
	 `(,item ,(get-direction/labelled item (cadr expr))))
       (car expr)))
                      
(define (get-direction/labelled from dist-lst)
  (fold (lambda (item retlst)
	  (if (eq? from (car item))
	      `(,@retlst (,(cadr item) ,(caddr item)))
	      retlst))
	'() dist-lst))

;; 1)
(define (adjacency-list->graph-term expr)
  `(,(map car expr)
    ,(sort-by-symbol-name
      (delete-duplicates
       (fold (lambda (item retlst)
	       `(,@retlst 
		 ,@(map (lambda (j)
			  (sort-by-symbol-name `(,(car item) ,j) identity))
			(cadr item))))
	     '() expr))
      car)))

;; 2) DIRECTED
(define adjacency-list->graph-term/directed adjacency-list->graph-term)

;; 3) LEBELLED
(define (adjacency-list->graph-term/labelled expr)
  `(,(map car expr)
    ,(fold (lambda (item retlst)
                 `(,@retlst ,@(fold (lambda (num ret)
                                          (if (not (null? num))
                                              `(,@ret (,(car item) ,@num))
					      ret))
                                      '() (cadr item))))
             '() expr)))

;; -----------------------------------------------------------------------------
;; Human Friendly

;; 1)
(define (graph-term->human-friendly expr)
  (graph-term->human-friendly-aux expr "-"))

(define (graph-term->human-friendly-aux expr separater)
  (sort `(,@(map (lambda (item)
		   (string-append (symbol->string (car item)) 
				  separater 
				  (symbol->string (cadr item))))
		 (cadr expr))
	  ,@(map symbol->string
		 (lset-difference eq? (car expr) (flatten (cadr expr)))))
	string<?))

;; 2) DIRECTED
(define (graph-term->human-friendly/directed expr)
  (graph-term->human-friendly-aux expr ">"))

;; 3) LABELLED
(define (graph-term->human-friendly/labelled expr)
  (sort `(,@(map (lambda (item)
		   (match-let (((a b c) item))
			      (format #f "~A>~A/~A" a b c)))
		 (cadr expr))
	  ,@(map symbol->string
		 (lset-difference eq? (car expr) (flatten (cadr expr)))))
	string<?))

;; 1)
(define (human-friendly->graph-term expr)
  (human-friendly->graph-term-aux expr string-split/-))

(define (human-friendly->graph-term-aux expr split-fn)
  (let ((item-list 
	 (map (lambda (item)
		(if (null? (cdr item))
		    (string->symbol (car item))
		    `(,(string->symbol (car item)) 
		      ,(string->symbol (cadr item)))))
	      (split-fn expr))))
    `(,(delete-duplicates (flatten item-list)) 
      ,(remove (lambda (i) (not (pair? i))) item-list))))

(define (string-split/- strlst)
  (map (lambda (item) (string-split item #\-))
       strlst))

;; 2) DIRECTED
(define (human-friendly->graph-term/directed expr)
  (human-friendly->graph-term-aux expr string-split/>))

(define (string-split/> strlst)
  (map (lambda (item) (string-split item #\>))
       strlst))

;; 3) LABELLED
(define (human-friendly->graph-term/labelled expr)
  (let ((item-list 
	 (map (lambda (item)
		(if (null? (cdr item))
		    (string->symbol (car item))
		    (match-let (((from to label) item))
			       `(,(string->symbol from)
				 ,(string->symbol to)
				 ,(string->number label)))))
	      (string-split/labelled expr))))
    `(,(delete-duplicates
	(fold (lambda (item retlst)
		(if (pair? item) 
		    `(,@retlst ,@(drop-right item 1) )
		    `(,@retlst ,item)))
	      '() item-list))
      ,(remove (lambda (item) (not (pair? item))) item-list))))

(define (string-split/labelled strlst)
  (map (lambda (str)
	 (if (string-scan str #\/)
	     (match-let (((from to-label) (string-split str #\>)))
			(match-let (((to label) (string-split to-label #\/)))
				   `(,from ,to ,label)))
	     `(,str)))
       strlst))
;

2007-05-17

L-99 (80) (3)

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

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

P80の続き。Lisp Machine Lisp版。

使ってるLisp Machine Lispのバージョンの違いについ

て気になって色々寄り道してしまい、なかなか完成せず。

その寄り道で、Lisp関数の歴史について深追いしてみた。

なかなか面白いので、年表的にまとめてみた。

reduceとか、set-differenceなどは、後期のLisp

Machine Lispにも存在するらしい。しかし、後期は

Common Lispとかなり混ざってしまっていて、Lisp

Machine Lispが起源なのかは良く分からない。

自分が使ってるCADR System 78.48は、Lisp Machine

Manualで言うと、第4版より前のもののようなので、色々

な関数が存在していない様子。

解答
;; Lisp Machine Lisp
;; -----------------------------------------------------------------------------
;;; utility

(defun flatten (list)
  (flatten-aux list '() ))

(defun flatten-aux (list acc)
  (cond ((null list) acc)
	((listp (car list)) 
	 (flatten-aux (cdr list) (append acc (flatten-aux (car list) '()))))
	(t 
	 (flatten-aux (cdr list) (append acc (list (car list))))))))

(defun -set-difference (lst1 lst2)
  (let ((retlst '()))
    (dolist (item lst1)
      (or (memq item lst2)
	  (setq retlst (cons item retlst))))
    (nreverse retlst)))

(defun -remove-duplicates (lst)
  (do ((l lst (cdr l))
       (retlst '() ))
      ((null l) (nreverse retlst))
    (or (member (car l) retlst)
	(setq retlst (cons (car l) retlst)))))

;; -----------------------------------------------------------------------------
;; graph-term <=> edge-clause

;; 1)
(defun graph-term->edge-clause (expr)
  (cadr expr))

;; 2) DIRECTED
(deff graph-term->arc-clause//directed 'graph-term->edge-clause)

;; 3) LABELLED
(deff graph-term->arc-clause//labelled 'graph-term->edge-clause)

;; 1)
(defun edge-clause->graph-term (expr)
  `(,(sort
       (-remove-duplicates
	(let ((retlst '()))
	  (dolist (item expr)
	    (setq retlst (append item retlst)))
	  (nreverse retlst)))
      #'(lambda(a b) (string-lessp (string a) (string b))))
    ,expr))

;; 2) DIRECTED
(deff arc-clause->graph-term//directed 'arc-clause->graph-term//labelled)

;; 3) LABELLED
(defun arc-clause->graph-term//labelled (expr)
  `(,(sort 
      (-remove-duplicates
	(let ((retlst '()))
	  (dolist (item expr)
	    (setq retlst `(,@(butlast item) ,@retlst)))
	  (nreverse retlst)))
      #'(lambda(a b) (string-lessp (string a) (string b))))
    ,expr))

;; -----------------------------------------------------------------------------
;; graph-term <=> adjacency-list

;; 1)
(defun graph-term->adjacency-list (expr)
  `(,@(mapcar #'(lambda (item)
		  `(,item 
		    ,(remove nil
			     (-remove-duplicates 
			      (flatten 
			       (mapcar #'(lambda (lst)
					   (remove item
						   (if (member item lst)
						       lst
						       nil)))
				       (cadr expr)))))))
	      (car expr))))

;; 2) DIRECTED
(defun graph-term->adjacency-list//directed (expr)
  (mapcar #'(lambda (item) `(,item ,(get-direction item (cadr expr))))
          (car expr)))

(defun get-direction (from dist-lst)
  (let ((retlst '()))
    (dolist (item dist-lst)
      (and (eq from (car item))
	   (setq retlst `(,@retlst ,(cadr item)))))
    (nreverse retlst)))

;; 3) LABELLED
(defun graph-term->adjacency-list//labelled (expr)
  (mapcar #'(lambda (item)
              `(,item ,(get-direction//labelled item (cadr expr))))
          (car expr)))
                       
(defun get-direction//labelled (from dist-lst)
  (let ((retlst '()))
    (dolist (item dist-lst)
      (and (eq from (car item))
	   (setq retlst `(,@retlst (,(cadr item) ,(caddr item))))))
    (nreverse retlst)))

;; 1)
(defun adjacency-list->graph-term (expr)
  `(,(mapcar #'car expr)
    ,(sort
       (-remove-duplicates
	 (let ((retlst '()))
	   (dolist (item expr)
	     (setq retlst 
		   `(,@retlst 
		     ,@(mapcar 
			 #'(lambda (j)
			     (sort `(,(car item) ,j)
				   #'(lambda(a b)
				       (string-lessp (string a) (string b)))))
			 (cadr item)))))
	   (nreverse retlst)))
       #'(lambda(a b) (string-lessp (string (car a)) (string (car b)))))))

;; 2) DIRECTED
(defun adjacency-list->graph-term//directed (expr)
  `(,(mapcar #'car expr)
    ,(let ((retlst '()))
       (dolist (item expr)
	 (setq retlst 
	       (if item
		   `(,@retlst ,@(mapcar #'(lambda (i) `(,(car item) ,i)) 
					(cadr item))))))
       retlst)))

;; 3) LEBELLED
(defun adjacency-list->graph-term//labelled (expr)
  `(,(mapcar #'car expr)
    ,(let ((retlst '()))
       (dolist (item expr)
	 (setq retlst
	       `(,@retlst 
		 ,@(let ((ret '()))
		     (dolist (num (cadr item))
		       (setq ret (if num
				     `(,@ret (,(car item) ,@num))
				   ret)))
		     ret))))
       retlst)))

;; -----------------------------------------------------------------------------
;; graph-term <=> human-friendly

;; 1)
(defun graph-term->human-friendly (expr)
  (sort `(,@(mapcar #'(lambda (item)
			(string-append (string (car item)) "-" (string (cadr item))))
		    (cadr expr))
	    ,@(mapcar #'string
		      (-set-difference (car expr) (flatten (cadr expr)))))
	#'string-lessp))

;; 2) DIRECTED
(defun graph-term->human-friendly//directed (expr)
  (sort `(,@(mapcar #'(lambda (item) 
                        (format nil "~A>~A" (car item) (cadr item)))
		    (cadr expr))
          ,@(mapcar #'string
                    (-set-difference (car expr) (flatten (cadr expr)))))
	#'string-lessp))

;; 3) LABELLED
(defun graph-term->human-friendly//labelled (expr)
  (sort `(,@(mapcar #'(lambda (item) (format nil "~{~A>~A//~A~}" item))
		    (cadr expr))
          ,@(mapcar #'string
                    (-set-difference (car expr) (flatten (cadr expr)))))
	#'string-lessp))

;; 1)
(defun human-friendly->graph-term (expr)
  (human-friendly->graph-term-aux expr #'string-split//-))

(defun human-friendly->graph-term-aux (expr split-fn)
  (let ((item-list (mapcar #'(lambda (item)
			       (if (listp item)
				   `(,(read-from-string (car item)) 
				     ,(read-from-string (cadr item)))
				 (read-from-string item)))
			   (funcall split-fn expr))))
    `(,(-remove-duplicates (flatten item-list)) ,(rem-if-not #'listp item-list))))

(defun string-split//- (strlst)
  (mapcar #'(lambda (item)
	      (let ((pos (string-search #/- item)))
		(if pos
		    `(,(substring item 0 pos)
		      ,(substring item (1+ pos)))
		  item)))
	  strlst))

;; 2) DIRECTED
(defun human-friendly->graph-term//directed (expr)
  (human-friendly->graph-term-aux expr #'string-split//>))

(defun string-split//> (strlst)
  (mapcar #'(lambda (item)
	      (let ((pos (string-search #/> item)))
		(if pos
		    `(,(substring item 0 pos)
		      ,(substring item (1+ pos)))
		  item)))
	  strlst))

;; 3) LABELLED
(defun human-friendly->graph-term//labelled (expr)
  (let ((item-list (mapcar #'(lambda (item)
			       (if (listp item)
				   (mapcar #'read-from-string item)
				 (read-from-string item)))
                             (string-split//labelled expr))))
    `(,(-remove-duplicates 
	 (let ((retlst '()))
	   (dolist (item item-list)
	     (setq retlst `(,@retlst ,@(if (listp item) 
					   (butlast item) 
					 `(,item)))))
	   retlst))
      ,(rem-if-not #'listp item-list))))

(defun string-split//labelled (strlst)
  (mapcar #'(lambda (item)
	      (let ((>pos (string-search #/> item))
		    (//pos (string-search #// item)))
		(if >pos 
		    `(,(substring item 0 >pos)
		      ,(substring item (1+ >pos) //pos)
		      ,(substring item (1+ //pos)))
		  item)))
	  strlst))

2007-05-14

L-99 (80) (2)

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

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

P80の続き。だいぶ重複も多い気がするし、まとめるべ

きなんだろうけども、まとめる気力がないので、とりあ

えず、このままで(ノ´∀`*)

今回は、Common Lisp版の有向グラフ版と、名札付き有

向グラフ版。

Lisp Machine LispとScheme版は、また後で。

解答
;; Common Lisp
(load ./flatten)

;; -----------------------------------------------------------------------------
;; DIRECTED
;; graph-term <=> arc-clause
(defun graph-term->arc-clause/directed (expr)
  (cadr expr))

(defun arc-clause->graph-term/directed (expr)
  `(,(sort
      (delete-duplicates
       (reduce #'xappend
               expr :initial-value '() ))
      #'(lambda(a b) (string< (string a) (string b))))
    ,expr))

(defun xappend (lst1 lst2)
  (append lst2 lst1))

;; -----------------------------------------------------------------------------
;; adjacency-list <=> graph-term
(defun adjacency-list->graph-term/directed (expr)
  `(,(mapcar #'car expr)
    ,(reduce #'(lambda (retlst item)
                 (if item
                     `(,@retlst ,@(mapcar #'(lambda (i) `(,(car item) ,i)) 
                                          (cadr item)))
                   retlst))
             expr :initial-value '() )))

(defun graph-term->adjacency-list/directed (expr)
  (mapcar #'(lambda (item) `(,item ,(get-direction item (cadr expr))))
          (car expr)))

(defun get-direction (from dist-lst)
  (reduce #'(lambda (retlst item)
              (if (eql from (car item))
                  `(,@retlst ,(cadr item))
                retlst))
          dist-lst :initial-value '() ))

;; -----------------------------------------------------------------------------
;; directed-graph-term <=> human-friendly
(defun graph-term->human-friendly/directed (expr)
  (sort `(,@(mapcar #'(lambda (item) 
                        (format nil "~A>~A" (car item) (cadr item)))
		    (cadr expr))
          ,@(mapcar #'string
                    (set-difference (car expr) (flatten (cadr expr)))))
	#'string<))

(defun human-friendly->graph-term/directed (expr)
  (flet ((splitter (strlst)
           (mapcar #'(lambda (item)
                       (let ((pos (position #\> (coerce item 'list))))
                         (if pos
                             `(,(subseq item 0 pos)
                               ,(subseq item (1+ pos)))
                           item)))
                   strlst)))
    (let ((item-list (mapcar #'(lambda (item)
                                 (if (listp item)
                                     (mapcar #'read-from-string item)
                                   (read-from-string item)))
                             (splitter expr))))
      `(,(delete-duplicates (flatten item-list)) 
        ,(delete-if-not #'listp item-list)))))

;; -----------------------------------------------------------------------------
;; LABELLED
;; graph-term <=>arc-clause
(defun graph-term->arc-clause/labelled (expr)
  (cadr expr))

(defun arc-clause->graph-term/labelled (expr)
  `(,(sort 
      (delete-duplicates
       (reduce #'(lambda (ret item) `(,@(butlast item) ,@ret))
               expr :initial-value '() ))
      #'(lambda(a b) (string< (string a) (string b))))
    ,expr))

;; -----------------------------------------------------------------------------
;; adjacency-list <=> graph-term/labelled
(defun adjacency-list->graph-term/labelled (expr)
  `(,(mapcar #'car expr)
    ,(reduce #'(lambda (retlst item)
                 `(,@retlst ,@(reduce #'(lambda (ret num)
                                          (if num
                                              `(,@ret (,(car item) ,@num))
                                            ret))
                                      (cadr item) :initial-value '() )))
             expr :initial-value '() )))

(defun graph-term->adjacency-list/labelled (expr)
  (mapcar #'(lambda (item)
              `(,item ,(get-direction/labelled item (cadr expr))))
          (car expr)))
                       
(defun get-direction/labelled (from dist-lst)
  (reduce #'(lambda (retlst item)
              (if (eql from (car item))
                  `(,@retlst (,(cadr item) ,(caddr item)))
                retlst))
          dist-lst :initial-value '() ))

;; -----------------------------------------------------------------------------
;; graph-term <=> human-friendly
(defun graph-term->human-friendly/labelled (expr)
  (sort `(,@(mapcar #'(lambda (item) (format nil "~{~A>~A/~A~}" item))
		    (cadr expr))
          ,@(mapcar #'string
                    (set-difference (car expr) (flatten (cadr expr)))))
	#'string<))

(defun human-friendly->graph-term/labelled (expr)
  (labels ((splitter (strlst)
             (mapcar #'(lambda (item)
                         (let ((>pos (position #\> (coerce item 'list)))
                               (/pos (position #\/ (coerce item 'list))))
                           (if >pos 
                               `(,(subseq item 0 >pos)
                                 ,(subseq item (1+ >pos) /pos)
                                 ,(subseq item (1+ /pos)))
                             item)))
                     strlst)))
    (let ((item-list (mapcar #'(lambda (item)
                                 (if (listp item)
                                     (mapcar #'read-from-string item)
                                   (read-from-string item)))
                             (splitter expr))))
      `(,(delete-duplicates 
          (reduce #'(lambda (retlst item)
                      `(,@retlst ,@(if (listp item) (butlast item) `(,item))))
                  item-list :initial-value '() )) 
        ,(delete-if-not #'listp item-list)))))

2007-05-11

L-99 (80)

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

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

|-`)どういう訳かド鬱になってきた。なんにもしたくな

い。

きっと引きこもりっきりで体を動かしてない所為だと推

測。

軽快な運動をしつつプログラミングできたら結構良い感

じなんじゃないかと思うんだけど、どうなんだろう。

そして問題もややこしくなってきて、さらにやる気が出

ないが、しかし粘着に遂行するぞ。

80番台は、グラフ(ネットワーク)の問題。

今回のお題は、グラフを色々な方式で表現し、それを相

互に変換してみようという内容。

形式は、基本的に

1) edge-clause形式

2) graph-term形式

3) adjacency-list形式

4) human-friendly形式

と4つあり、これらに

1) 無向グラフ版

2) 有向グラフ版

3) 名札つき有向グラフ版

がある。

とりあえず、量が多いので少しずつ解答して行くことにした。

今回は、Common Lisp版の無向グラフ版。

残りの問題:'(27 55 58-60 63 66 80-94 96-99)

P80

解答
;; Common Lisp
(load ./flatten)

(defun graph-term->edge-clause (expr)
  (cadr expr))

(defun edge-clause->graph-term (expr)
  `(,(sort (delete-duplicates
	 (reduce #'(lambda (ret item) `(,(car item) ,(cadr item) ,@ret))
		 expr :initial-value '() ))
	#'(lambda(a b)
	    (string< (string a) (string b))))
     ,expr))

(defun graph-term->adjacency-list (expr)
  `(,@(mapcar #'(lambda (item)
		  `(,item 
		    ,(delete nil
			     (delete-duplicates 
			      (flatten 
			       (mapcar #'(lambda (lst)
					   (delete item
						   (if (member item lst)
						       lst
						       nil)))
				       (cadr expr)))))))
	      (car expr))))

(defun adjacency-list->graph-term (expr)
  `(,(mapcar #'car expr)
     ,(sort
       (delete-duplicates
	(reduce #'(lambda (retlst i)		
		    `(,@retlst ,@(mapcar #'(lambda (j)
					     (sort `(,(car i) ,j)
						   #'(lambda(a b)
						       (string< (string a) (string b)))))
					 (cadr i))))
		expr :initial-value '() ) 
	:test #'equal) 
       #'(lambda(a b) (string< (string (car a)) (string (car b)))))))

(defun graph-term->human-friendly (expr)
  (sort `(,@(mapcar #'(lambda (item)
			(concatenate 'string (string (car item)) "-" (string (cadr item))))
		    (cadr expr))
	    ,@(mapcar #'string
		      (set-difference (car expr) (flatten (cadr expr)))))
	#'string<))

(defun human-friendly->graph-term (expr)
  (flet ((string-split/- (strlst)
	   (mapcar #'(lambda (item)
		       (let ((pos (position #\- (coerce item 'list))))
			 (if pos
			     `(,(subseq item 0 pos)
				,(subseq item (1+ pos)))
			     item)))
		   strlst)))
    (let ((item-list (mapcar #'(lambda (item)
				 (if (listp item)
				     `(,(read-from-string (car item)) 
					,(read-from-string (cadr item)))
				     (read-from-string item)))
			     (string-split/- expr))))
      `(,(delete-duplicates (flatten item-list)) ,(delete-if-not #'listp item-list)))))

2007-05-07

L-99 (68)

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

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

だんだん解けそうなのがなくなってきてしまった。問題

が解けないと面白くないじゃないか。

今回のお題は、a)二分木を行きがけ順(preorder)と、通り

がけ順(in-order)の二通りの文字列表現にする。b)は意

図が良く分からない。c)はin-orderとpreorderの文字列

によって一意に構造が特定できるので、それから木構造

を生成する。d)はDifference listを使ってみる。

それと、同じノード名を使用した場合の動作についての

考察

bとdはいまいち良く分からないので、aとcを解答。

同じノード名を使用した場合、一意に構造が特定できな

いので、プログラムによって動作が異なってくると思う。

残りの問題:'(27 55 58-60 63 66 80-94 96-99)

P68

;; LISP Machine LISP
(load "string-join.lisp")

(defun preorder (tree)
  (string-join (preorder-aux tree)))

(defun preorder-aux (tree)
  (if tree
      `(,(string (car tree)) 
	,@(preorder-aux (cadr tree)) 
	,@(preorder-aux (caddr tree)))
    '("") ))

(defun inorder (tree)
  (string-join (inorder-aux tree)))

(defun inorder-aux (tree)
  (if tree
      `(,@(inorder-aux (cadr tree)) 
	,(string (car tree)) 
	,@(inorder-aux (caddr tree)))
    '("") ))

(defun snull (str)
  (if (and (stringp str) (string-equal str ""))
      ""
    nil))

(defun disassemble-tree-string (pre in)
  (if (or (snull pre) (snull in))
      ""
    (let* ((root (aref pre 0))
	   (left-in   (substring in  0 (string-search root in)))
	   (left-pre  (substring pre 1 (1+ (string-length left-in))))
	   (right-in  (substring in  (1+ (string-search root in))))
	   (right-pre (substring pre (1+ (string-length left-in)))))
      (values (string root) left-in left-pre right-in right-pre))))

(defun pre+in->tree (pre in)
  (if (or (snull pre) (snull in))
      '()
    (multiple-value-bind (root left-in left-pre right-in right-pre) 
	(disassemble-tree-string pre in)
      `(,(read-from-string root)
	,(pre+in->tree left-pre left-in)
	,(pre+in->tree right-pre right-in)))))

;; Common Lisp
(load "./string-join")

(defun preorder (tree)
  (labels ((frob (tree)
	     (if tree
		 `(,(string (car tree)) ,@(frob (cadr tree)) ,@(frob (caddr tree)))
		 '(""))))
    (string-join (frob tree))))

(defun inorder (tree)
  (labels ((frob (tree)
	     (if tree
		 `(,@(frob (cadr tree)) ,(string (car tree)) ,@(frob (caddr tree)))
		 '(""))))
    (string-join (frob tree))))

(defun snull (str)
  (if (and (stringp str) (string= str ""))
      ""
      nil))

(defun disassemble-tree-string (pre in)
  (if (or (snull pre) (snull in))
      ""
      (let* ((root (char pre 0))
	     (left-in   (subseq in  0 (position root in)))
	     (left-pre  (subseq pre 1 (1+ (length left-in))))
	     (right-in  (subseq in  (1+ (position root in))))
	     (right-pre (subseq pre (1+ (length left-in)))))
	(values (string root) left-in left-pre right-in right-pre))))

(defun pre+in->tree (pre in)
  (if (or (snull pre) (snull in))
      '()
      (multiple-value-bind (root left-in left-pre right-in right-pre) (disassemble-tree-string pre in)
	`(,(read-from-string root)
	   ,(pre+in->tree left-pre left-in)
	   ,(pre+in->tree right-pre right-in))))) 

;; Scheme
(define (preorder tree)
  (letrec ((frob 
	    (lambda (tree)
	      (if (null? tree)
		  '("")
		  `(,(symbol->string (car tree)) ,@(frob (cadr tree)) ,@(frob (caddr tree)))))))
    (string-join (frob tree) "")))

(define (inorder tree)
  (letrec ((frob 
	    (lambda (tree)
	      (if (null? tree)
		  '("")
		  `(,@(frob (cadr tree)) ,(symbol->string (car tree)) ,@(frob (caddr tree)))))))
    (string-join (frob tree) "")))

(define (disassemble-tree-string pre in)
  (if (or (string-null? pre) (string-null? in))
      ""
      (let* ((len       (string-length in))
	     (root      (substring pre 0 1))
	     (left-in   (substring in  0 (string-scan in root)))
	     (left-pre  (substring pre 1 (+ 1 (string-length left-in))))
	     (right-in  (substring in  (+ 1 (string-scan in root))   len))
	     (right-pre (substring pre (+ 1 (string-length left-in)) len)))
	(values root left-in left-pre right-in right-pre))))

(define (pre+in->tree pre in)
  (if (or (string-null? pre) (string-null? in))
      '()
      (receive (root left-in left-pre right-in right-pre) (disassemble-tree-string pre in)
	       `(,(string->symbol root)
		 ,(pre+in->tree left-pre left-in)
		 ,(pre+in->tree right-pre right-in)))))
;

2007-05-03

L-99 (69)

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

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

難しいのは飛して今回は、P69に挑戦。

しかし、段々煮詰って来てしまい、どれもややこしくなっ

てきた。

またもや、文字列表現とリスト表現の変換がお題。

SchemeはもうすこしSchemeらしいスタイルにしたいとこ

ろ。

残りの問題:'(27 55 58-60 63 66 68 80-94 96-99)

P69

解答
;; LISP Machine LISP
(defun tree<=>dotstring (list-or-string)
  (if (stringp list-or-string)
      (dotstring->tree list-or-string)
    (tree->dotstring list-or-string)))

(defun tree->dotstring (tree)
  (string-join (tree->dotstring-aux tree)))

(defun tree->dotstring-aux (tree)
  (if tree
      `(,(string (car tree)) 
	,@(tree->dotstring-aux (cadr tree))
	,@(tree->dotstring-aux (caddr tree)))
    '(".")))

(defun string-join (strs &optional (delim ""))
  (if strs
      (let ((retstr (car strs)))
	(do ((s (cdr strs) (cdr s))
	     (retstr retstr (string-append retstr delim (car s))))
	    ((null s) retstr)))
    ""))

(defun dotstring->tree (str)
  (if (string-equal "" str)
      '()
    (let ((root (substring str 0 1)))
      (if (string-equal root ".")
	  '()
	(multiple-value-bind (l r) (tree-string>get-children str)
	  `(,(read-from-string root)
	    ,(dotstring->tree l)
	    ,(dotstring->tree r)))))))

(defun tree-string>get-boundary (str)
  (let ((point 1))
    (dotimes (i (1- (string-length str)))
      (if (not (string-equal "." (substring str i (1+ i))))
	  (setq point (+ 1 point))
	(setq point (- point 1)))
      (if (zerop point)
	  (return i)))))

(defun tree-string>get-children (str)
  (let ((rootless (substring str 1)))
    (values 
      (substring rootless 0 (1+ (tree-string>get-boundary rootless)))  
      (substring rootless (1+ (tree-string>get-boundary rootless))))))

;; Common Lisp
(defun tree<=>dotstring (list-or-string)
  (if (stringp list-or-string)
      (dotstring->tree list-or-string)
      (tree->dotstring list-or-string)))

(defun tree->dotstring (tree)
  (labels ((frob (tree)
	     (if tree
		 `(,(string (car tree)) ,@(frob (cadr tree)) ,@(frob (caddr tree)))
		 '("."))))
    (string-join (frob tree))))

(defun string-join (strs &optional (delim ""))
  (if strs
      (reduce #'(lambda (retstr s) (concatenate 'string retstr delim s))
	      strs)
      ""))

(defun dotstring->tree (str)
  (if (string= "" str)
      '()
      (let ((root (subseq str 0 1)))
	(if (string= root ".")
	    '()
	    (multiple-value-bind (l r) (tree-string>get-children str)
	      `(,(read-from-string (subseq str 0 1))
		 ,(dotstring->tree l)
		 ,(dotstring->tree r)))))))

(defun tree-string>get-boundary (str)
  (let ((point 1))
    (dotimes (i (1- (length str)))
      (if (string/= "." (subseq str i (1+ i)))
	  (setq point (+ 1 point))
	  (setq point (- point 1)))
      (if (zerop point)
	  (return i)))))

(defun tree-string>get-children (str)
  (let ((rootless (subseq str 1)))
    (values 
     (subseq rootless 0 (1+ (tree-string>get-boundary rootless)))  
     (subseq rootless (1+ (tree-string>get-boundary rootless)))))) 

;; Scheme
(define (tree<=>dotstring list-or-string)
  (if (string? list-or-string)
      (dotstring->tree list-or-string)
      (tree->dotstring list-or-string)))

(define (tree->dotstring tree)
  (letrec ((frob 
	    (lambda (tree)
	      (if (null? tree)
		  '(".")
		  `(,(symbol->string (car tree)) 
		    ,@(frob (cadr tree))
		    ,@(frob (caddr tree)))))))
    (string-join (frob tree) "")))

(define (dotstring->tree str)
  (if (string=? "" str)
      '()
      (let ((root (substring str 0 1)))
	(if (string=? root ".")
	    '()
	    (receive (l r) (tree-string>get-children str)
		     `(,(string->symbol root)
		       ,(dotstring->tree l)
		       ,(dotstring->tree r)))))))

(define (tree-string>get-boundary str)
  (let/cc exit
    (let ((point 1))
      (dotimes (i (- (string-length str) 1))
	       (if (not (string=? "." (substring str i (+ 1 i))))
		   (set! point (+ 1 point))
		   (set! point (- point 1)))
	       (if (zero? point)
		   (exit i))))))

(define (tree-string>get-children str)
  (let* ((len (string-length str))
	 (rootless (substring str 1 len))
	 (boundary (+ 1 (tree-string>get-boundary rootless))))
    (values 
     (substring rootless 0 boundary)
     (substring rootless boundary (- len 1)))))

すべての音階を求める

| 02:33 | すべての音階を求める - わだばLisperになる を含むブックマーク はてなブックマーク - すべての音階を求める - わだばLisperになる

あまりやる気が出ないので、前々から自分が知りたいと

思っていた問題に挑戦してみることにした。

中学生の頃から、12音の組み合わせで可能なすべての音

階を求める方法が知りたかった。色々頭をひねって考え

たり全部書き出してみたりしたけれど、いまいちぱっと

しなかった。

音階の総数自体は、エドモン・コステールの「和声の変

貌」という音楽理論書によれば、351らしい。

本当にそうなのか、それを全部書き出してみるのが今回

の課題。

音階を、0と1の組み合わせの12ビットで表現するなら、

2の12乗である4096より多くはないが、問題は、重複を

いかに取り除くかということで、これが良く分からなかっ

た。

具体的に説明すると、上記の4096の組み合わせの中には、

ハ長調の音階とト長調の音階と…という風に12の重複が

ある。

では、12で割れば良いかというと、大体妥当な数字には

なるけれど、そうも行かない。

ということでコンピュータ様の得意な力ずくでの総当た

りで書き出してみることにした。

まず、音階は数字として、例えば、長音階ならば、

101010110101と2進数で表現する。

これは、10進数では、2741になる。

これを12通り移調(循環シフト)させると

(2741 1387 2774 1453 2906 1717 3434 2773 1451 2902 1709 3418)

となるので、この中から一番小さいものを選ぶ。

この手順を、0〜4095まで繰り返し、重複を削除する。

プログラムとしては、非常に適当だけど

(mapcar #'(lambda (n)
	    (format nil "~12,'0b" n))
	(remove-duplicates
	 (do ((i 0 (1+ i))
	      (retlst '() (cons (apply #'min
				       (mapcar #'(lambda (n)
						   (mod (logior (ash i n)
								(ash i (- (- 12 n))))
							(expt 2 12)))
					       '(0 1 2 3 4 5 6 7 8 9 10 11)))
				retlst)))
	     ((= i 4096) retlst))))

のようなものを作成した。

これで352通りの組み合わせを得ることができた。一つ

多いのは、音がない0も勘定しているためなので、351の

組み合わせということになる。

いやー、長らく知りたかっただけにすっきりした(*´д`*)

そして利用価値はないけれども記念に書き出し。

ちょっと見辛いけれども、

101010110101
b.a.g.fe.d.c

という風に眺めると分かりやすいかもしれない。

"000000000000" "000000000001" "000000000011" "000000000101" "000000000111"
"000000001001" "000000001011" "000000001101" "000000001111" "000000010001"
"000000010011" "000000010101" "000000010111" "000000011001" "000000011011"
"000000011101" "000000011111" "000000100001" "000000100011" "000000100101"
"000000100111" "000000101001" "000000101011" "000000101101" "000000101111"
"000000110001" "000000110011" "000000110101" "000000110111" "000000111001"
"000000111011" "000000111101" "000000111111" "000001000001" "000001000011"
"000001000101" "000001000111" "000001001001" "000001001011" "000001001101"
"000001001111" "000001010001" "000001010011" "000001010101" "000001010111"
"000001011001" "000001011011" "000001011101" "000001011111" "000001100001"
"000001100011" "000001100101" "000001100111" "000001101001" "000001101011"
"000001101101" "000001101111" "000001110001" "000001110011" "000001110101"
"000001110111" "000001111001" "000001111011" "000001111101" "000001111111"
"000010000101" "000010000111" "000010001001" "000010001011" "000010001101"
"000010001111" "000010010001" "000010010011" "000010010101" "000010010111"
"000010011001" "000010011011" "000010011101" "000010011111" "000010100011"
"000010100101" "000010100111" "000010101001" "000010101011" "000010101101"
"000010101111" "000010110001" "000010110011" "000010110101" "000010110111"
"000010111001" "000010111011" "000010111101" "000010111111" "000011000011"
"000011000101" "000011000111" "000011001001" "000011001011" "000011001101"
"000011001111" "000011010001" "000011010011" "000011010101" "000011010111"
"000011011001" "000011011011" "000011011101" "000011011111" "000011100011"
"000011100101" "000011100111" "000011101001" "000011101011" "000011101101"
"000011101111" "000011110001" "000011110011" "000011110101" "000011110111"
"000011111001" "000011111011" "000011111101" "000011111111" "000100010001"
"000100010011" "000100010101" "000100010111" "000100011001" "000100011011"
"000100011101" "000100011111" "000100100011" "000100100101" "000100100111"
"000100101001" "000100101011" "000100101101" "000100101111" "000100110011"
"000100110101" "000100110111" "000100111001" "000100111011" "000100111101"
"000100111111" "000101000101" "000101000111" "000101001001" "000101001011"
"000101001101" "000101001111" "000101010011" "000101010101" "000101010111"
"000101011001" "000101011011" "000101011101" "000101011111" "000101100011"
"000101100101" "000101100111" "000101101001" "000101101011" "000101101101"
"000101101111" "000101110011" "000101110101" "000101110111" "000101111001"
"000101111011" "000101111101" "000101111111" "000110001101" "000110001111"
"000110010011" "000110010101" "000110010111" "000110011001" "000110011011"
"000110011101" "000110011111" "000110100101" "000110100111" "000110101001"
"000110101011" "000110101101" "000110101111" "000110110011" "000110110101"
"000110110111" "000110111001" "000110111011" "000110111101" "000110111111"
"000111000111" "000111001001" "000111001011" "000111001101" "000111001111"
"000111010011" "000111010101" "000111010111" "000111011001" "000111011011"
"000111011101" "000111011111" "000111100101" "000111100111" "000111101001"
"000111101011" "000111101101" "000111101111" "000111110011" "000111110101"
"000111110111" "000111111001" "000111111011" "000111111101" "000111111111"
"001001001001" "001001001011" "001001001101" "001001001111" "001001010011"
"001001010101" "001001010111" "001001011011" "001001011101" "001001011111"
"001001100101" "001001100111" "001001101011" "001001101101" "001001101111"
"001001110011" "001001110101" "001001110111" "001001111011" "001001111101"
"001001111111" "001010010101" "001010010111" "001010011011" "001010011101"
"001010011111" "001010100111" "001010101011" "001010101101" "001010101111"
"001010110011" "001010110101" "001010110111" "001010111011" "001010111101"
"001010111111" "001011001011" "001011001101" "001011001111" "001011010011"
"001011010101" "001011010111" "001011011011" "001011011101" "001011011111"
"001011100111" "001011101011" "001011101101" "001011101111" "001011110011"
"001011110101" "001011110111" "001011111011" "001011111101" "001011111111"
"001100110011" "001100110101" "001100110111" "001100111011" "001100111101"
"001100111111" "001101001101" "001101001111" "001101010101" "001101010111"
"001101011011" "001101011101" "001101011111" "001101100111" "001101101011"
"001101101101" "001101101111" "001101110101" "001101110111" "001101111011"
"001101111101" "001101111111" "001110011101" "001110011111" "001110101011"
"001110101101" "001110101111" "001110110101" "001110110111" "001110111011"
"001110111101" "001110111111" "001111001111" "001111010101" "001111010111"
"001111011011" "001111011101" "001111011111" "001111101011" "001111101101"
"001111101111" "001111110101" "001111110111" "001111111011" "001111111101"
"001111111111" "010101010101" "010101010111" "010101011011" "010101011111"
"010101101011" "010101101111" "010101110111" "010101111011" "010101111111"
"010110101111" "010110110111" "010110111011" "010110111111" "010111010111"
"010111011011" "010111011111" "010111101111" "010111110111" "010111111011"
"010111111111" "011011011011" "011011011111" "011011101111" "011011110111"
"011011111111" "011101110111" "011101111111" "011110111111" "011111011111"
"011111111111" "111111111111"