ITコンサルの日常

ITコンサル会社に勤務する普通のITエンジニアの日常です。

「ANSI Common Lisp」4章練習問題 - Haskell版

1. 正方の配列(大きさが(n n)の配列)を引数としてそれを90度、時計回りに回転させる関数を定義せよ。

Lispの時に手抜きした分、めちゃくちゃ時間かかりました。。

-- 数列を右回りに90度回転
quarterTurn :: [[a]] -> [[a]]
quarterTurn det = foldl makeDet [] det

-- 受け取ったリストを右回りに90度回転
rotate :: [a] -> [[a]]
rotate xs = map (\n -> [n]) xs

-- 受け取ったリストを回転させた数列に追加
makeDet :: [[a]] -> [a] -> [[a]]
makeDet [] ys = rotate ys
makeDet xs ys = map (\t -> fst t : snd t) $ myzip ys xs

-- リストとリストのリストを受け取ってタプルに変換
myzip :: [a] -> [[b]] -> [(a, [b])]
myzip [] [] = []
myzip (x:xs) (y:ys) = (x, y) : myzip xs ys

-- テストドライバ
main = do print $ quarterTurn ["ab","cd"]
          print $ quarterTurn ["abc","def"]

結果はこう。

["ca","db"]
["da","eb","fc"]

2. reduceを使って以下のものを定義せよ

(a) copy-list
myCopyList xs = foldr (:) [] xs

main = do print [1..3]
          print $ myCopyList [1..3]

結果はこう。

[1,2,3]
[1,2,3]
(b) reverse(リストが対象)
myCopyList xs = foldl (\a b -> b : a) [] xs

main = do print $ reverse [1..3]
          print $ myCopyList [1..3]

結果はこう。

[3,2,1]
[3,2,1]

3. それぞれのノードがデータをもち、3つまでの子がとれるようなツリーを表現するストラクチャを定義した上で、以下の関数を定義せよ。

とりあえずストラクチャを定義。

-- 3つのノードを持つ木構造を定義
data MyNode d l c r = Empty | MyNode d (MyNode d l c r) (MyNode d l c r) (MyNode
 d l c r)

-- データを定義
-- 1 --- 2
--    |
--    -- 3 --- 5
--    |     |
--    |     -- 6
--    |     |
--    |     -- 7
--    | 
--    -- 4
childNode7 = MyNode 7 Empty Empty Empty
childNode6 = MyNode 6 Empty Empty Empty
childNode5 = MyNode 5 Empty Empty Empty
childNode4 = MyNode 4 Empty Empty Empty
childNode3 = MyNode 3 childNode5 childNode6 childNode7
childNode2 = MyNode 2 Empty Empty Empty
rootNode = MyNode 1 childNode2 childNode3 childNode4

main = print $ showMyNode rootNode

-- MyNodeを表示する関数
showMyNode :: (Show d) => (MyNode d l c r) -> String
showMyNode Empty = "Empty"
showMyNode (MyNode d l c r) = "(" ++ (show d) ++ "," ++ (showMyNode l) ++ "," ++
 (showMyNode c) ++ "," ++ (showMyNode r) ++ ")"

-- MyNodeから左ノードを取り出す
leftNode :: (MyNode d l c r) -> (MyNode d l c r)
leftNode (MyNode d l c r) = l

-- MyNodeから中央ノードを取り出す
centerNode :: (MyNode d l c r) -> (MyNode d l c r)
centerNode (MyNode d l c r) = c

-- MyNodeから右ノードを取り出す
rightNode :: (MyNode d l c r) -> (MyNode d l c r)
rightNode (MyNode d l c r) = r

結果はこう。

"(1,(2,Empty,Empty,Empty),(3,(5,Empty,Empty,Empty),(6,Empty,Empty,Empty),(7,Empty,Empty,Empty)),(4,Empty,Empty,Empty))"

見づらいがまあ出来てそう。
Haskellのデータ定義とかすっ飛ばしたせいか、さっぱり理解してない。
こんなんでいいのだろうか。。

(a) このようなツリーをコピーする関数(コピーのノードがオリジナルのノードとeqlにならないように)
-- MyNodeをコピーする
copyMyNode :: (MyNode d l c r) -> (MyNode d l c r)
copyMyNode Empty = Empty
copyMyNode (MyNode d l c r) = MyNode d (copyMyNode l) (copyMyNode c) (copyMyNode r)

main = do print $ showMyNode rootNode
          print $ showMyNode $ copyMyNode rootNode

結果はこう。

"(1,(2,Empty,Empty,Empty),(3,(5,Empty,Empty,Empty),(6,Empty,Empty,Empty),(7,Empty,Empty,Empty)),(4,Empty,Empty,Empty))"
"(1,(2,Empty,Empty,Empty),(3,(5,Empty,Empty,Empty),(6,Empty,Empty,Empty),(7,Empty,Empty,Empty)),(4,Empty,Empty,Empty))"
(b) オブジェクトとこのようなツリーを引数として、オブジェクトがツリーのノードのデータフィールドにeqlであるときに真を返す関数
-- MyNodeから値を検索する
findMyNode :: (Show a, Show d) => a -> (MyNode d l c r) -> Bool
findMyNode _ Empty = False
findMyNode a (MyNode d l c r) = if ((show a) == (show d)) then True
                                else (findMyNode a l) || (findMyNode a c) || (fi
ndMyNode a r)

main = do print $ showMyNode rootNode
          print $ showMyNode $ copyMyNode rootNode
          print $ findMyNode 5 rootNode
          print $ findMyNode 8 rootNode

大分ムリヤリですが、結果はこう。

True
False

MyNodeのdを型クラスEqに縛れれば良いのかと思うのですが、そういうことって出来ないんですかね。
MyNode自体をEqに縛ることは、もちろんできますが。

「若き数学者のアメリカ」読了

若き数学者のアメリカ (新潮文庫)

若き数学者のアメリカ (新潮文庫)

若くして数学者としてアメリカへ渡った、著者の体験を綴った物語。
これからアメリカに行って何かをしようという人には、かなり役立つと思います。


「英語が通じるだろうか。。」といった不安や心細さから始まり、日本人であることを意識しすぎてなかなかアメリカという国に溶けこめなかったのが、段々とアメリカに融合していく様は、読んでいてかなり面白かったです。
アメリカコンプレックスみたいなものは、やっぱりあるものなのですね。
パールハーバーに行ったシーンは、露骨に愛国心と反骨心が出てて面白かったです。


あと、ラスベガスのシーンね。
どっぷりハマってましたが、分かるなあ。
ギャンブルはほどほどにね。と。


興味深かったのは9章の

彼ら(アメリカの学生)が日本の学生に比べて知識においてはかなり見劣りするのに、精神的にははるかに成熟しているように思われるのは、面白い現象だ。
...
この差が教育によるところは明らかである。どちらの教育にも一長一短はあるが、一つだけ感ずることは、知識というものは、必要になれば学校で教わらなくとも自然に身についてくるものであるのに反し、論理的な思考方法とか表現方法は、若い時に身につけないと後になってはなかなかむずかしいということだ。

というところ。


なんとなく今でもそういう傾向にあるように思いますが、教育による差だけではなくて、人種のるつぼアメリカと単一民族日本の違いも大きいのではないかと思います。


先日、医療現場への外国人労働者受け入れがニュースになってましたが、
外国人労働者受け入れ…生活できる仕組み必要の記事に書かれているように、

「世界から高度人材の受け入れを」「『海外に出る国際化』だけでなく『迎え入れる国際化』を」

「迎え入れる国際化」って重要じゃないかと思うのです。
若い頃からいろんな人(まあ、日本人の中にもいろんな人いますが、もっと広い意味で)と接触すれば、いわゆるマッチョも増えるのではないかなあと思います。


ヴェネツィアの宿」も日本人が海外で活躍する物語でしたが、僕的にはこちらの方が読みやすかったです。おすすめ。

「ANSI Common Lisp」4章練習問題

1. 正方の配列(大きさが(n n)の配列)を引数としてそれを90度、時計回りに回転させる関数を定義せよ。

ちょ。いきなり難しいなあ。
思いっきり手続き言語っぽいが、とりあえずできた。

(defun quarter-turn (arr2d)
  (let ((arr2d-dimensions (array-dimensions arr2d)))
    (let ((result-arr (make-array (reverse arr2d-dimensions))))
      (do ((i 0 (+ i 1)))
          ((> i (- (first arr2d-dimensions) 1)) result-arr)
        (do ((j 0 (+ j 1)))
            ((> j (- (second arr2d-dimensions) 1)) result-arr)
          (setf (aref result-arr j (- (first arr2d-dimensions) i 1)) (aref arr2d
 i j)))))))

(quarter-turn #2a((a b) (c d)))
(quarter-turn #2a((a b c) (d e f)))

結果はこう。

* 
QUARTER-TURN
* 
#2A((C A) (D B))
* 
#2A((D A) (E B) (F C))
* 

2. reduceを使って以下のものを定義せよ

(a) copy-list
(defun my-copy-list (lst)
  (reduce #'cons lst :from-end t :initial-value nil))

(copy-list '(a b c))
(my-copy-list '(a b c))

短い。やっぱりreduce威力絶大な感じ。
結果はこう。

* 
MY-COPY-LIST
* 
(A B C)
* 
(A B C)
* 
(b) reverse(リストが対象)
(defun my-reverse (lst)
  (reduce #'(lambda (x y) (cons y x)) lst :initial-value nil))

(reverse '(a b c))
(my-reverse '(a b c))

結果はこう。

* 
MY-REVERSE
* 
(C B A)
* 
(C B A)
* 

3. それぞれのノードがデータをもち、3つまでの子がとれるようなツリーを表現するストラクチャを定義した上で、以下の関数を定義せよ。

とりあえずストラクチャを定義。

(defstruct my-node elt (l nil) (c nil) (r nil))

; 1 --- 2
;    |
;    -- 3 --- 5
;    |     |
;    |     -- 6
;    |     |
;    |     -- 7
;    | 
;    -- 4
(setf root-node (make-my-node :elt 1))
(setf (my-node-l root-node) (make-my-node :elt 2))
(setf (my-node-c root-node) (make-my-node :elt 3))
(setf (my-node-r root-node) (make-my-node :elt 4))

(setf center-node (my-node-c root-node))
(setf (my-node-l center-node) (make-my-node :elt 5))
(setf (my-node-c center-node) (make-my-node :elt 6))
(setf (my-node-r center-node) (make-my-node :elt 7))

root-node

結果はこう。

#S(MY-NODE
     :ELT 1
     :L #S(MY-NODE :ELT 2 :L NIL :C NIL :R NIL)
     :C #S(MY-NODE
             :ELT 3
             :L #S(MY-NODE :ELT 5 :L NIL :C NIL :R NIL)
             :C #S(MY-NODE :ELT 6 :L NIL :C NIL :R NIL)
             :R #S(MY-NODE :ELT 7 :L NIL :C NIL :R NIL))
     :R #S(MY-NODE :ELT 4 :L NIL :C NIL :R NIL))

わりと見やすい形で表示される。

(a) このようなツリーをコピーする関数(コピーのノードがオリジナルのノードとeqlにならないように)
(defun copy-my-node (node)
  (if node
     (let ((copy-node (make-my-node :elt (my-node-elt node))))
        (setf (my-node-l copy-node) (copy-my-node (my-node-l node)))
        (setf (my-node-c copy-node) (copy-my-node (my-node-c node)))
        (setf (my-node-r copy-node) (copy-my-node (my-node-r node)))
        copy-node)
     nil))

(copy-my-node root-node)
(format t "(eql root-node copy-node) = ~A~%" (eql root-node (copy-my-node root-n
ode)))

結果はこう。

#S(MY-NODE
     :ELT 1
     :L #S(MY-NODE :ELT 2 :L NIL :C NIL :R NIL)
     :C #S(MY-NODE
             :ELT 3
             :L #S(MY-NODE :ELT 5 :L NIL :C NIL :R NIL)
             :C #S(MY-NODE :ELT 6 :L NIL :C NIL :R NIL)
             :R #S(MY-NODE :ELT 7 :L NIL :C NIL :R NIL))
     :R #S(MY-NODE :ELT 4 :L NIL :C NIL :R NIL))
* (eql root-node copy-node) = NIL
NIL
(b) オブジェクトとこのようなツリーを引数として、オブジェクトがツリーのノードのデータフィールドにeqlであるときに真を返す関数
(defun find-my-node (obj node)
  (if node
     (if (eql obj (my-node-elt node))
        T
        (or (find-my-node obj (my-node-l node))
            (find-my-node obj (my-node-c node))
            (find-my-node obj (my-node-r node))))
     nil))

(find-my-node 5 root-node)
(find-my-node 8 root-node)

結果はこう。

* 
T
* 
NIL
* 

4. BSTを引数として、要素を最大から最小まで並べて返す関数を定義せよ。

bst-traverseを改造(3行目と5行目を入れ替える)するだけ。超簡単でびびった。

(defstruct node elt (l nil) (r nil))

(defun bst-insert (obj bst <)
  (if (null bst)
    (make-node :elt obj)
    (let ((elt (node-elt bst)))
      (if (eql obj elt)
        bst
        (if (funcall < obj elt)
          (make-node
            :elt elt
            :l   (bst-insert obj (node-l bst) <)
            :r   (node-r bst))
          (make-node
            :elt elt
            :r   (bst-insert obj (node-r bst) <)
            :l   (node-l bst)))))))

(defun bst-traverse (fn bst)
  (when bst
    (bst-traverse fn (node-r bst))
    (funcall fn (node-elt bst))
    (bst-traverse fn (node-l bst))))

(setf nums nil)
(dolist (x '(5 8 4 2 1 9 6 7 3))
   (setf nums (bst-insert x nums #'<)))

nums
(bst-traverse #'princ nums)

結果はこう。

* 
#S(NODE
     :ELT 5
     :L #S(NODE
             :ELT 4
             :L #S(NODE
                     :ELT 2
                     :L #S(NODE :ELT 1 :L NIL :R NIL)
                     :R #S(NODE :ELT 3 :L NIL :R NIL))
             :R NIL)
     :R #S(NODE
             :ELT 8
             :L #S(NODE :ELT 6 :L NIL :R #S(NODE :ELT 7 :L NIL :R NIL))
             :R #S(NODE :ELT 9 :L NIL :R NIL)))
* 987654321
NIL
* 

5. bst-adjoinを定義せよ。この関数はbst-insertと同じ引数を取るが、ツリーにeqlとなるものがないときに限ってそのオブジェクトを挿入する。

試しに現状のbst-insertで重複要素を入れてみる。

(setf nums nil)
(dolist (x '(5 8 4 2 1 9 6 7 3 7))
   (setf nums (bst-insert x nums #'<)))

nums

結果はこう。

#S(NODE
     :ELT 5
     :L #S(NODE
             :ELT 4
             :L #S(NODE
                     :ELT 2
                     :L #S(NODE :ELT 1 :L NIL :R NIL)
                     :R #S(NODE :ELT 3 :L NIL :R NIL))
             :R NIL)
     :R #S(NODE
             :ELT 8
             :L #S(NODE :ELT 6 :L NIL :R #S(NODE :ELT 7 :L NIL :R NIL))
             :R #S(NODE :ELT 9 :L NIL :R NIL)))

あれ? 7を重複要素として入れてみたつもりが、重複してません。
bst-insertを良く見てみると、

      (if (eql obj elt)
        bst

の判定が入っているので、既に考慮が入っているということですね。
なーんだ。

で、訳注見てみると、

この関数は実質的にbst-insertと同じになる (原著者ホームページ参照)。

とのことで、同じみたいです。


逆に、この判定をはずしたバージョンで試してみる。

(defun bst-insert (obj bst <)
  (if (null bst)
    (make-node :elt obj)
    (let ((elt (node-elt bst)))
        (if (funcall < obj elt)
          (make-node
            :elt elt
            :l   (bst-insert obj (node-l bst) <)
            :r   (node-r bst))
          (make-node
            :elt elt
            :r   (bst-insert obj (node-r bst) <)
            :l   (node-l bst))))))

結果はこう。

#S(NODE
     :ELT 5
     :L #S(NODE
             :ELT 4
             :L #S(NODE
                     :ELT 2
                     :L #S(NODE :ELT 1 :L NIL :R NIL)
                     :R #S(NODE :ELT 3 :L NIL :R NIL))
             :R NIL)
     :R #S(NODE
             :ELT 8
             :L #S(NODE
                     :ELT 6
                     :L NIL
                     :R #S(NODE
                             :ELT 7
                             :L NIL
                             :R #S(NODE :ELT 7 :L NIL :R NIL)))
             :R #S(NODE :ELT 9 :L NIL :R NIL)))

>=の場合右ノードに入れることになるので、この場合では正しい結果ですね。

6. ハッシュ表の内容は、キー・値の各ペアを要素(k,v)で保持する連想リストによって記述できる。以下の関数を定義せよ。

(a) 連想リストを引数として対応するハッシュ表を返す。
(b) ハッシュ表を引数として対応する連想リストを返す。
; 連想リストをハッシュ表に変換する
(defun assoc-list-to-hashtable (al)
  (if al
    (let ((result (make-hash-table)))
      (mapcar #'(lambda (lst) (setf (gethash (car lst) result) (last lst))) al)
      result)
    nil))

; ハッシュ表を連想リストに変換する
(defun hashtable-to-assoc-list (ht)
  (if ht
    (let ((result nil))
      (maphash
        #'(lambda (k v)
          (if (consp v)
            (setf result (cons (list k (car v)) result))
            (setf result (cons (list k v) result))))
        ht)
      result)
    nil))

; ハッシュ表を表示する(デバッグ用)
(defun print-hashtable (ht)
  (maphash #'(lambda (k v) (format t "~A = ~A~%" k v)) ht))

; 連想リストを表示する(デバッグ用)
(defun print-assoc-list (al)
  (mapcar #'(lambda (lst) (format t "~A = ~A~%" (car lst) (last lst))) al))

(setf ht (assoc-list-to-hashtable '(("+" "plus") ("-" "minus"))))
(print-hashtable ht)
(print-assoc-list (hashtable-to-assoc-list ht))

結果はこう。

* Warning:  Declaring HT special.

#<EQL hash table, 2 entries {5801D9D5}>
* + = (plus)
- = (minus)
NIL
* - = (minus)
+ = (plus)
(NIL NIL)