手計算で monad を理解してみる

去年の秋頃から、暇なときにちょこちょこ Haskell をいじっているけど実に面白い。

やっぱり一番おいしいところは、Monad をはじめとする計算のやり方なんだろうけど、一行に収まるくらいの短い式を書いて、手書きで計算してみると意外と理解に役立つ事に気がついた。

例えば、runCont (return "hello") (++"!") を計算すると "hello!" になるけど、たぶん慣れてる人には自明過ぎるようなこんな計算でも、初めての時は何だか分かったような分かってないようなあやふやな感じがする。

これをこんな風に手計算してみる。（関数等の定義は「All About Monads」のここを参考にした。）

runCont (return "hello") (++"!")
= runCont(Cont $ \k->k "hello")) (++"!") … ①
= (\k->k "hello")) (++"!") … runCont の定義より
= (++"!") "hello"
= "hello!" 

① return の定義、return a = Cont $ \k -> k a より

個人的には、これであやふやな感じが解消してスッキリする。

続けて更に Cont から別の例を出してみると、callCC なんかも下の定義だけだは、何がどうなるのかよく分からない。

callCC f = Cont $ \k -> runCont (f (\a -> Cont $ \_ -> k a)) k

この辺りのサンプルコードを読むと、使い方が何となく分かるが、どういう仕組みでそうなるのか腑に落ちずモヤモヤする。

例えば 「runCont (callCC (\ex -> do {ex "bye"; return "hi"})) (++"!") 」みたいな式で、なんで "hi!" にならないのか不思議だったりする。

こんなのも手で計算してみると、細かいところがはっきりする。

  runCont (callCC (\ex -> do {ex "bye"; return "hi"})) (++"!")
= runCont (callCC (\ex -> ex "bye" >>= (\f -> return "hi"))) (++"!")
= runCont (Cont $ \k ->　(\_ -> (k "bye")) k) (++"!") … (a)
= (\k ->　(\_ -> (k "bye")) k) (++"!")
= (\_ -> ((++"!") "bye")) (++"!")
= (++"!") "bye"
= "bye!"

(a)
callCC f = Cont $ \k->　runCont (f(\a-> Cont $ \_->k a)) k より

  callCC (\ex->ex "bye">>=(\f->return "hi"))
= Cont $ \k->　runCont ((\ex -> ex "bye">>=(\_ -> return "hi")) (\a-> Cont $ \_ -> k a)) k
= Cont $ \k->　runCont (((\a -> Cont $ \_ -> k a) "bye") >>= (\_ -> return "hi")) k
= Cont $ \k->　runCont ((Cont $ \_ -> k "bye") >>= (\_ -> return "hi")) k
= Cont $ \k->　runCont (Cont $ \_ -> (k "bye")) k … (b)
= Cont $ \k->　(\_ -> (k "bye")) k

(b)
(Cont c) >>= f = Cont $ \k' -> c (\a -> runCont (f a) k') より

  (Cont $ \_->k "bye") >>= (\_ -> return "hi")
= Cont $ \k' -> (\_ -> k "bye") (\a -> runCont (f a) k')
= Cont $ \_ -> (k "bye")

実は最初、遅延評価に変にこだわってしまって手こずっていたんだけど、参照透明なんだから好きな順序で計算しても結果は変わらないわけで、手計算のときは余り気にする必要が無いと開き直って簡単になった。

Haskell で平面ルービックキューブ

急に、ルービックキューブをプログラムで解いてみたい衝動にかられたが、手元にブツが無い。近所のコンビニにも無かったので、作ってみることにした。

以下のような方針

• 極力シンプルに。本物に近い操作感とか立体性とか別にいらないので、二次元の図形で表現する。
• 中央の小正方形は動かさない事にする。
• 操作はテキストボックスへの入力とする。色を表す文字一文字により、その色が中央となる面の回転を表し、小文字なら時計回り、大文字ならその逆とする。
• 現在、テキストボックスに入力されている文字列全体が反映された結果を描画する。
• 図形は中央に描画する。
• Haskell でやってみる

結果から示すと、以下が実際の様子。まず初期表示

初期表示

赤い面を時計回りに2回、青い面を時計回りに1回、赤い面を反時計まわりに1回、青い面を反時計まわりに1回、それぞれ90度回転させた結果。

コードは以下のような感じになる。

module Main where

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade
import Graphics.UI.Gtk.Gdk.GC
import Graphics.UI.Gtk.Gdk.Drawable
import Graphics.UI.Gtk.Gdk.Events as Evt
import Data.IORef

--図形
data SquareColor = G|R|W|Y|O|B
color G = Color 0x0000 0xE000 0x0000
color R = Color 0xE000 0x0000 0x0000
color W = Color 0xFFFF 0xFFFF 0xFFFF
color Y = Color 0xFFFF 0xFFFF 0x0000
color O = Color 0xF000 0x5000 0x0000
color B = Color 0x0000 0x0000 0xD000

initialState = map (replicate 9) [G,R,W,Y,O,B]

v60    = (18, -10)
v120   = (18,  10)
v180   = (0,   21)
angles = [[(-108,-30), v120,v180],
          [(-108,-30), v60, v120],
          [(-54,   0), v60, v180],
          [(0,   -30), v60, v180],
          [(0,    33), v60, v120],
          [(54,  -60), v120,v180]]
allParas = concatMap createParas angles 
createParas v = map toPara $
    map (\n -> dupV v n) [0..2] >>= (\x -> map (\n ->dupH x n) [0..2])
toPara = (\[(ox,oy), (x1,y1), (x2,y2)] ->
  [(ox,oy), (ox+x1-1, oy+y1-1),
  (ox+x1+x2-2, oy+y1+y2-2),(ox+x2-1, oy+y2-1)])
dupH = (\[(ox,oy), v1@(x1,y1), v2] n -> [(ox+x1*n, oy+y1*n), v1, v2])
dupV = (\[(ox,oy), v1, v2@(x2,y2)] n -> [(ox+x2*n, oy+y2*n), v1, v2])

centering _ [] = []
centering size (angle: angles) =
  (map (centeringPoint size) angle): (centering size angles)

centeringPoint (w, h) (x, y) = (x + (div w 2), y + (div h 2))

--ウィンドウ操作
main = do
    initGUI
    surfaceIORef <- newIORef initialState
    Just xml     <- xmlNew "rcube.glade"

    window       <- xmlGetWidget xml castToWindow "window1"
    onDestroy window mainQuit

    drawingArea  <- xmlGetWidget xml castToDrawingArea "drawingarea1"
    onExposeRect drawingArea (const $ do
        dw       <- widgetGetDrawWindow drawingArea
        gc       <- gcNew dw
        surface  <- readIORef surfaceIORef
        size     <- widgetGetSize drawingArea
        drawCube dw gc size surface)

    entry        <- xmlGetWidget xml castToEntry "entry1"
    onEditableChanged entry $ do 
        n <- get entry entryText
        writeIORef surfaceIORef $ rotateAll initialState n
        widgetQueueDraw drawingArea

    widgetShowAll window
    mainGUI
  where
    rotateAll p [] = p
    rotateAll p (x:xs) = rotateAll (rotate p x) xs
 
    drawCube d g size x = do
      drawParas d g (foldl (++) [] x) $ centering size allParas
    drawParas d g _ [] = return ()
    drawParas d g (x:xs) (p: ps) = do
      gcSetValues g $ newGCValues { foreground = color x }
      drawPolygon d g True p
      drawParas d g xs ps

-- 回転操作
g2r [g,r,w,y,o,b] = [r6 o,r3 g,r3 w,r3 r,y,   r9 b]
r2g [o,g,w,r,y,b] = [r9 g,r9 r,r9 w,y,   r6 o,r3 b]
w2r [g,r,w,y,o,b] = [r9 g,w,   r3 o,r3 y,r3 b,r6 r] 
r2w [g,w,o,y,b,r] = [r3 g,r6 r,w,   r9 y,r9 o,r9 b] 
y2r [g,r,w,y,o,b] = [r9 w,y,   o,   r3 b,r3 g,r9 r]
r2y [w,y,o,b,g,r] = [r9 g,r3 r,r3 w,y,   o,   r9 b]
o2r [g,r,w,y,o,b] = [r6 b,r6 o,r6 y,r6 w,r6 r,r6 g]
r2o [b,o,y,w,r,g] = [r6 g,r6 r,r6 w,r6 y,r6 o,r6 b]
b2r [g,r,w,y,o,b] = [r9 y,b,   r9 o,r3 g,r3 w,r]
r2b [y,b,o,g,w,r] = [r9 g,r,   r9 w,r3 y,r3 o,b]
rotate [(g1:g2:g3:gs), [r1,r2,r3,r4,r5,r6,r7,r8,r9],
        (w1:w2:w3:ws), (y1:y2:y3:ys),
        o,              (b1:b2:b3:bs)] 'r' =
       [(w1:w2:w3:gs), [r7,r4,r1,r8,r5,r2,r9,r6,r3],
        (y1:y2:y3:ws), (b1:b2:b3:ys),
        o,              (g1:g2:g3:bs)]
rotate [(g1:g2:g3:gs), [r1,r2,r3,r4,r5,r6,r7,r8,r9],
        (w1:w2:w3:ws), (y1:y2:y3:ys),
        o,             (b1:b2:b3:bs)] 'R' =
       [(b1:b2:b3:gs), [r3,r6,r9,r2,r5,r8,r1,r4,r7],
        (g1:g2:g3:ws), (w1:w2:w3:ys),
        o,             (y1:y2:y3:bs)]
rotate p 'g' =r2g (rotate (g2r p) 'r')
rotate p 'G' =r2g (rotate (g2r p) 'R')
rotate p 'w' =r2w (rotate (w2r p) 'r')
rotate p 'W' =r2w (rotate (w2r p) 'R')
rotate p 'y' =r2y (rotate (y2r p) 'r')
rotate p 'Y' =r2y (rotate (y2r p) 'R')
rotate p 'o' =r2o (rotate (o2r p) 'r')
rotate p 'O' =r2o (rotate (o2r p) 'R')
rotate p 'b' =r2b (rotate (b2r p) 'r')
rotate p 'B' =r2b (rotate (b2r p) 'R')
rotate p _ = p
r3 [s1,s2,s3,s4,s5,s6,s7,s8,s9] = [s7,s4,s1,s8,s5,s2,s9,s6,s3]
r6 x = r3 $ r3 x
r9 x = r6 $ r3 x

画面定義は、GtkWindow に GtkVBox を置いて、その上側に GtkDrawingArea、下側に GtkEntryを置いたものを、Glade 3.8.1 で適当に作っておく。

====

一応、ルービックキューブにはなったが、遊ぶにはシャッフルする機能を追加する必要がある。あと、そもそもの目的だった、解く方のコードも書こうと思うのだけど、なんかここまでの作業で変にコーディング欲が充足されてしまって、当初のモチベーションが既に半減してしまった。なんだかなあ。

====

--2012/08/12 追記：シャッフルできるようにした

s/UT/UnitTest/

このブログで今まで UnitTest について書いた投稿には、「UT」というラベルを付けていたが、これを今日、「UnitTest」に付け替えた。

最初は何の気なしに「UT」としてしまっていたけど、最近は、なんだか見れば見るほどウォーターフォール文化における単体テストを表す略号に見えてきて、本来語りたい事とのズレが大きく感じられるようになってきた。

ちなみに本文では、だいたい UnitTest とパスカルケースで書いてきたつもり。これは、ウォータフォールの単体テストと区別するためであると同時に、本家 wiki の仕様に合わせてリスペクトを表明しているからでもあったりする。

ところで、ウォーターフォール色が強い組織・現場では、未だに「実装フェーズ」の直後に「単体テストフェーズ」を設けて、そこで初めて JUnitコード を書き始めるような残念な開発が、特に反省されることもなく日々実践されている。

そういう現場でも、理論的には後付けテストはダメなんだと言う事が、何かの拍子に認知され始めて、一応名目上は「実装・UTフェーズ」みたいに、前後関係をボヤかした感じになったりするのだけど、いかんせんプログラマの意識が「テストの事なんか後で考える」のままだから、実質的には何も変わらないし進歩もない。

泳ぎの真似を陸上でどれだけやったところで泳げるようになんかならないように、後付けテストなんか何年やってもテスト・ファーストで書けるようには全然ならない。

だからそろそろ、現場の開発チームで指導的な立場にある人は、「できればなるべく差し支えない範囲でTDD推奨」みたいな感じではなく、そろそろ「TDD必須」って宣言すべきだと思う。

本当に、一度できるようになったら、というか、できるようになってみないと「テストを先に書く」方がその逆よりも、工数、品質、仕事の面白さなど、どれをとっても格段に優れているという認識は成立しないのだろうと、つくづく思う。

とはいっても、「やってみればテストファーストの方が速い事が分かるよ」なんてやんわりと言って聞かせたところで、どうせ一向に浸透しないのはもう分かった。つう事は、山本五十六も「やってみせ、いって聞かせて、させてみて、 褒めてやらねば人は動かじ」なんて言っているとおり、まずは横に座って実演するところから始めなければならない事になるらしい（やっぱ結局XPに戻ってくる事になるのか…）。

高跳びでも、背中を下に向けた方がその逆より高く跳べるという事に、フォスベリーが記録を出すまでは、だれも気づかなかった。だから、まず「やってみせ」から始めないとダメなのだろう。やってみせる事なしに「言って聞かせて」も結局効果がないし、「させてみせ」も、結局ちょっと目を離したスキにうやむやになってしまう。

・・・つう事を考えているのだけど、本当に残念で仕方が無いが、今の現場では直接コードを書いて実演できるような立ち位置ではなかったりする。次の現場こそは、まずは絶対に、自分で「やってみせ」るところから始められる、実装メインのロールでプロジェクトに参画したい。

Haskell でソケット通信をやってみる

Haskell で ソケットを使ったクライアント-サーバ通信をやってみる。

Haskell を使ったネットワーク・プログラミングの入り口が分かればいいので、クライアントから受け取った文字列をひっくり返して返すだけの、簡単なお題とする。

まず、サーバはこんな感じ。

import Network
import System.IO 

main :: IO ()
main = withSocketsDo $ do 
    hSetBuffering stdout NoBuffering
    server `catch` (const $ putStrLn "Exception caught.")
    putStrLn "Connection closed."

server :: IO ()
server = do
    sock <- listenOn (PortNumber 8001)
    repeats (receive sock)
    sClose sock

repeats :: Monad m => m Bool -> m () 
repeats x =
    x >>= (\x' -> if x' then (return ()) else repeats x)

receive :: Socket -> IO Bool
receive sock = do
    (h,host,port) <- accept sock
    hSetBuffering h LineBuffering
    msg <- hGetLine h           
    putStrLn msg 
    hPutStrLn h $ reverse msg 
    return $ null msg

クライアントはこんな感じ。

import Network
import System.IO 

sendMessage msg = withSocketsDo $ do 
        hSetBuffering stdout NoBuffering 
        h <- connectTo "127.0.0.1" (PortNumber 8001)
        hSetBuffering h LineBuffering
        hPutStrLn h msg
        hGetLine h >>= putStrLn
        hClose h

実行は GHCi でやってみる。
以下、サーバ側

ghci> :load server.hs
[1 of 1] Compiling Main             ( server.hs, interpreted )
Ok, modules loaded: Main.
ghci> main
Loading package bytestring-0.9.1.10 ... linking ... done.
 ・・・略・・・
Loading package network-2.3.0.7 ... linking ... done.
hello
1234

Connection closed.
ghci> 

以下、クライアント側

ghci> :load client.hs
[1 of 1] Compiling Main             ( client.hs, interpreted )
Ok, modules loaded: Main.
ghci> sendMessage "hello"
Loading package bytestring-0.9.1.10 ... linking ... done.
 ・・・略・・・
Loading package network-2.3.0.7 ... linking ... done.
olleh
ghci> sendMessage "1234"
4321
ghci> sendMessage ""
ghci> 

思ったより難しくない。次は、マルチスレッド化かなあ。

WYDKYDK が読めたよ！ ﾜｰｲヾ(´ρ`)ﾉ゛ﾜｰｲ

Alistair Cockburn の本に出てくる変な綴りの言葉。意味は分かるけどなんて発音するのか、ずっと分からなかったけど、何の気に無しにググってたら見付けた。

なんかソフトウェア開発とは全然関係ない、オレゴン州の自治会か何かの議事録らしき文書だけど、WYDKYDK ("wid-kee-dik")とある。カタカナにするとウィドキーディクみたいな感じだろうか。

綴りが珍しいのは略語だからで、もとはこんな文。

What you don't know you don't know

簡単な英語だけど、構文が分からない人が意外と多い。順を追って見てみると、

You don't know it.
あなたはそれを知らない

↓

What you don't know.
あなたが知らないもの

↓

You don't know you don't know it.
あなたはそれを知らないという事を知らない

↓

What you don't know you don't know.
あなたが知らないという事を知らないもの

といった感じで、入れ子になってたりして、プログラマには親和性が高い気がするんだが。

ところで、現場ではこの WYDKYDK への認識が足りない人が、例えば WBS を作ったり作らせたりすると、困った事になる。

「これだけ詳細化したんだから、見積りは正確なはずだ」なんて思考様式なんだけど、そもそも認識されていない事を詳細化しようもないし、予測に組み込みようもない。

正解は、何らかの形で現実に実行してみて「知らない事」を「知らなかった事」に変えていく事なんだけど、下手な人はこの当たり前の事ができず、日程にバッファを組み込むといった程度の、稚拙な手に走ってしまう。 まあ現場ごとの文化とか、プロジェクトごとの事情とかもあるけどね。

小事の思案と割れ窓理論

葉隠と言えば、「武士道といふは死ぬ事と見付けたり…別に仔細なし。胸すわって進むなり。」で有名だけど、正直、自分みたいな「すくたれもの」には難しい。

だけど実は葉隠には、そんなムリなやつばかりじゃなくて、普通に実践的なアドバイスも結構ある。

『大事の思案は軽くすべし。／小事の思案は重くすべし。』

これについて自分は、やっぱり開発者で飯を食っているせいか、前半をリスク管理の問題、後半を品質管理の問題と捉えてしまう。

前半の『大事の思案』がなぜ軽いかについては、非常にクリティカルな事態に関しては、いざというときに判断に迷って対応が遅れたりしないように、普段から方針を定めておいて、即断即決できるように備えておくべきだという解釈になる。

後半の『小事の思案』がなぜ重いかについては、三島由紀夫が葉隠入門の中で、アリの穴から堤防が崩れるように、瑣末なことを軽んじる事によって生活の体系や重大な思想までもが台無しになると解説している。

で、もちろん前半も後半もどちらも大事なんだけど、どちらかというと自分なんかには後半の方が、より切実にピンと来る。（管理の比重が大きい人は前者かもしれない。）

例えば、コーディング規約なんかみたいなものでも、「ぎりぎり読めりゃいいじゃん」みたいに適当にしないで、きっちり律儀に守ってかないといけない。と自分は思う。

そこを疎かにするから、規約違反の放置->->内部品質の低下->->外部品質の低下->->製品品質の低下 ってな感じで、結局、また地獄になってくんじゃないかと。

で、この小さい事こそ大事ってのを、別角度から現代風に理論化したのが、割れ窓理論だと思う。

一般には、ジュリアーニ市長の時代にニューヨーク市が治安を回復したときにベースになった理論として有名なアレだけど、Wikipedia によるとこうなる

「建物の窓が壊れているのを放置すると、誰も注意を払っていないという象徴になり、やがて他の窓もまもなく全て壊される」

ささいに見える Duplicate code の放置が、コピペだらけの巨大な糞コードの山に繋がっていくという、まあ、ありがちなあれと同じじゃないだろうか。

で、この割れ窓理論をベースにした政策が「ゼロトレランス」だけど、開発現場に当てはめてみると、さしずめ Refactoring Mercilessly といったところか。

なんて事を考えていると、例えば、「途中return は是か非か」みたいな、一見不毛でアホらしい事についてムキになって議論するのも、けっこう大事というか、度を越さない範囲ならむしろ健全だとも思えてくる。もちろん自分もわりとムキになる方だ。

Spring 3.1 の Cache Abstraction

Spring 3.1 が GA になった。最後に Spring を触ったのはこれを書いたときだから、もう2年近く前になるけど、こんときは 3.0 が出た頃だった。あんまり進んでなかったのかも。

いろいろググってみると、キャッシュがどうかしたとか書いてあるので、寝る前にちょっと試してみる。

package spring.trial1.ex1;

import java.util.HashMap;
import java.util.Map;

import org.springframework.cache.annotation.Cacheable;
import org.springframework.context.ApplicationContext;
import org.springframework.context.support.ClassPathXmlApplicationContext;

class Bar {
   Map<Integer, String> map = new HashMap<>();
   {
      map.put(1, "one");
      map.put(2, "two");
   }
   @Cacheable("bar")
   public String findString(int key) {
      System.out.printf("findString(%d) called%n", key);
      return map.get(key);
   }
}

public class Foo {
   public static void main(String[] args) {
   ApplicationContext ctx = new ClassPathXmlApplicationContext(
         "applicationContext.xml");
   Bar bean = ctx.getBean(Bar.class);

   System.out.println(bean.findString(1));
   System.out.println(bean.findString(2));
   System.out.println(bean.findString(3));
   System.out.println(bean.findString(1));
   System.out.println(bean.findString(2));
   System.out.println(bean.findString(3));
   }
}

<?xml version="1.0" encoding="UTF-8"?>
<beans xmlns="http://www.springframework.org/schema/beans"
  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:cache="http://www.springframework.org/schema/cache"
  xmlns:p="http://www.springframework.org/schema/p"
  xsi:schemaLocation="http://www.springframework.org/schema/beans http://www.springframework.org/schema/beans/spring-beans.xsd
                http://www.springframework.org/schema/cache http://www.springframework.org/schema/cache/spring-cache.xsd">
  <cache:annotation-driven />

  <bean id="cacheManager" class="org.springframework.cache.support.SimpleCacheManager">
    <property name="caches">
      <set>
        <bean
          class="org.springframework.cache.concurrent.ConcurrentMapCacheFactoryBean"
          p:name="bar" />
      </set>
    </property>
  </bean>
  <bean id="bar" class="spring.trial1.ex1.Bar"/>
</beans>

pom.xml の dependency に spring-context 3.1.0.RELEASE と、cglib 2.2.2 を指定して、ビルド→実行したら、以下のような結果が得られる。 （既に Maven Central に入ってるらしく、特に repository を指定したり、ローカルリポジトリに入れたりとかしなくても、普通に 3.1 がダウンロードされる。）

findString(1) called
one
findString(2) called
two
findString(3) called
null
one
two
null

findString の 中身が呼ばれるのは最初だけで、2回め以降はキャッシュが使われているらしいのが分かる。

■ 雑感

JavaConfig/JSR-330 で xml を書かずに済むようになったと思ってたけど、この <cache:annotation-driven> に関しては、やり方が分からない。

仕方なく、昔ながらのapplicationContext.xml を書いてしまった。もしかすると、ちゃんとしたやり方があるのかもしれないけど、部分的にアノテーションで部分的にXMLみたいにマジでなるとしたら、結構イヤかも。