2012年11月4日日曜日

Domain-Driven Design の暗記事項（１）

この際、DDD本の見返しの、パターン関連図を暗記してしまおうと思う。

丸暗記ってそれ自体が批判される事が多いけど、広さ方向の知識に関しては暗記は有効だと自分は思う。もちろん深さ方向の知識のための、精読と実践も並行するのが前提だけど、両方やってく事で、知識の量が上手く増えていくと思うんだな。

つうわけで、2・3年前に JavaScript で書いた暗記用のツールを再利用してみた。問題データを<div>で書いて、これを JavaScript で読み込んでアプレット風のものに表示するようにしている。JavaScript 自体よりBlogger に組み込むのがちょっと苦心した覚えがある。

ちなみにIEについては、6で動かず、7以上でも色設定が想定通りにならないが、気にしないことにした。

DDD のパターン同士の関連を覚えてみる
{ "height":200, "width":400, "opacity":0.9, "start-color":"#000000", "start-bg-color":"#FEFFFE", "question-color":"#002200", "question-bg-color":"#FEFFFE", "statusbar-bg-color":"#FEFFFE", "statusbar-color":"#000000", "last-bg-color":"#FEFFFE", "last-color":"#002200", "answer-color":"#0044AA", "answer-bg-color":"#FEFFFE", "button-color":"#FEFFFE", "caption":"DDD のパターン同士の関連を覚えてみる", "caption-color":"#CCEEFF", }
*(1)* reduce cost of change with Conceptual Contours
Model-Driven Design
*(1)* simplify interpretation with Standalone Classes
Model-Driven Design
*(1)* express model through Intention-Revealing Interfaces
Model-Driven Design
*(1)* isolate domain with Layered Architecture
Model-Driven Design
*(1)* express model as Modules
Model-Driven Design
*(1)* express model as Entities
Model-Driven Design
*(1)* express model as Value Objects
Model-Driven Design
*(1)* express model as Services
Model-Driven Design
*(1)* model out loud Model-Driven Design
Ubiquitous Language
*(1)* make composition safe Assertions
Side-Effect-Free Functions
*(1)* make side effects explict with Assertions
Intention-Revealing Interfaces
*(1)* make safe and simple Side-Effect-Free Functions
Intention-Revealing Interfaces
*(5)* names enter Ubiquitous Language
Services
Value Objects
Entities
Modules
Bounded Context
*(2)* encapsulate with Factories
Value Objects
Aggregates
*(2)* encapsulate with Aggregates
Value Objects
Entities
*(1)* maintain integrity with Aggregates
Entities
*(2)* access with Repositories
Entities
Aggregates
*(2)* distill to Declarative Style
Generic Subdomains
Segregated Core
*(1)* point the way with Domain Vision Statement
Core Domain
*(1)* unencumber from Generic Subdomains
Core Domain
*(1)* repackage into Segregated Core
Core Domain
*(1)* emphasize in Ubiquitous Language
Core Domain
*(1)* relate disparate parts with Context Map
Core Domain
*(1)* concepts enter Core Domain
Evolving Order
*(1)* structure carried in Ubiquitous Language
Evolving Order
*(1)* keep unified by Continuous Integration
Bounded Context
*(2)* structure through Evolving Order
Context Map
Core Domain
Model-Driven Design reduce cost of change with *(1)*
Conceptual Contours
Model-Driven Design simplify interpretation with *(1)*
Standalone Classes
Model-Driven Design express model through *(1)*
Intention-Revealing Interfaces
Model-Driven Design isolate domain with *(1)*
Layered Architecture
Model-Driven Design express model as *(4)*
Modules
Entities
Value Objects
Services
Ubiquitous Language model out loud *(1)*
Model-Driven Design
Side-Effect-Free Functions make composition safe *(1)*
Assertions
Intention-Revealing Interfaces make side effects explict with *(1)*
Assertions
Intention-Revealing Interfaces make safe and simple *(1)*
Side-Effect-Free Functions
Services names enter *(1)*
Ubiquitous Language
Value Objects names enter *(1)*
Ubiquitous Language
Value Objects encapsulate with *(2)*
Factories
Aggregates
Entities names enter *(1)*
Ubiquitous Language
Entities encapsulate with *(1)*
Aggregates
Entities maintain integrity with *(1)*
Aggregates
Entities access with *(1)*
Repositories
Modules names enter *(1)*
Ubiquitous Language
Aggregates encapsulate with *(1)*
Factories
Aggregates access with *(1)*
Repositories
Generic Subdomains distill to *(1)*
Declarative Style
Segregated Core distill to *(1)*
Declarative Style
Core Domain point the way with *(1)*
Domain Vision Statement
Core Domain unencumber from *(1)*
Generic Subdomains
Core Domain repackage into *(1)*
Segregated Core
Core Domain emphasize in *(1)*
Ubiquitous Language
Core Domain relate disparate parts with *(1)*
Context Map
Core Domain structure through *(1)*
Evolving Order
Evolving Order concepts enter *(1)*
Core Domain
Evolving Order structure carried in *(1)*
Ubiquitous Language
Bounded Context names enter *(1)*
Ubiquitous Language
Bounded Context keep unified by *(1)*
Continuous Integration
Context Map structure through *(1)*
Evolving Order

覚えたら問題をもっと増やしていこうと思う。

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年8月12日日曜日

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

今年の正月に、Haskell で 平面ルービックキューブを書いてみた。「Haskell で平面ルービックキューブ」

この時は、Haskell の GUI コーディングはどんなものかと、Gtk2Hs を調べるついでに書いただけなので、シャッフルくらいできるようにしても良いなと思いつつ、放置していた。それを今日は書き足してみた。

====

シャッフルというのは、Esc キーを押すと、6面揃った状態から指定の回数分だけ、ランダムな面と方向で90度回転させるというもの。回数は起動時パラメータで指定する。

下の画像は、Escキーを押した直後。起動時に 3を渡しているので、3回かき回している。

これをよく見て、青を反時計回り(B)、赤を時計回り(r)、白を時計回り(w)と、3回操作すると 6面が揃う。

ソースはこんな感じになる（ブログに貼るにはチト長いが…）

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
import Control.Monad
import System
import System.Random

--図形と色
data SquareColor = G|R|W|Y|O|B deriving Show
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

initialSurface = 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 とウィンドウ操作
main = do
    currentSurfaceIORef <- newIORef initialSurface
    initialSurfaceIORef <- newIORef initialSurface

    initGUI
    Just xml     <- xmlNew "rcube.glade"
    window       <- xmlGetWidget xml castToWindow "window1"
    entry        <- xmlGetWidget xml castToEntry "entry1"
    drawingArea  <- xmlGetWidget xml castToDrawingArea "drawingarea1"

    onDestroy window mainQuit
    onExposeRect drawingArea (const $ do
        dw       <- widgetGetDrawWindow drawingArea
        gc       <- gcNew dw
        surface  <- readIORef currentSurfaceIORef
        size     <- widgetGetSize drawingArea
        drawCube dw gc size surface)
    onEditableChanged entry $ do
        seq      <- get entry entryText
        surface  <- readIORef initialSurfaceIORef
        writeIORef currentSurfaceIORef $ rotateAll surface seq
        widgetQueueDraw drawingArea
    onKeyPress entry (\event -> do
        if 65307 == Evt.eventKeyVal event
        then do
            args <- getArgs
            s <- shuffle $ read $ args!!0
            let shuffled = rotateAll initialSurface s
            writeIORef initialSurfaceIORef shuffled
            writeIORef currentSurfaceIORef shuffled
            widgetQueueDraw drawingArea
            entrySetText entry ""
            return True
        else return False)

    widgetShowAll window
    mainGUI
  where
    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
    shuffle n = replicateM n
              $ getStdRandom (randomR (0,11)) >>= (return.(!!) "rgbywoRGBYWO")

-- 回転操作
rotateAll p [] = p
rotateAll p (x:xs) = rotateAll (rotate p x) xs
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
onKeyPress の辺りを書き足した。Hackage がダウンしていてドキュメントが見られないというアクシデントがあったが、割と簡単に直感で書けてしまう。

投稿者 時刻: 0 件のコメント:
ラベル:

2012年8月7日火曜日

FizzBuzz をテストファーストで書いてみよう

なんとなく FizzBuzz をテストファーストで書いてみることにした。

====

Eclipse 上で JMockit を使ってやってみる。

仕様は、3の倍数なら Fizz、5の倍数なら Buzz、3と5の公倍数なら FizzBuzz、それ以外ならその整数自体を標準出力に書き出すというもの。範囲は 1 から 100 までにしよう。main() から実行する。

まずテストクラスから 

public class FizzBuzzTest {
  @Test public void main() {
    FizzBuzz.main(new String[0]);
  }
}
クラス FizzBuzz が存在しないので、エディタ上で赤い下線が引かれている。Ctrl+1 でクラス生成ダイアログを開いて、main() メソッド付きのクラスを自動作成する。 
public class FizzBuzz {
  /**
   * @param args
   */
  public static void main(String[] args) {
    // TODO Auto-generated method stub
  }
}
コンパイルが通ったら一応 JUnit を実行してグリーンになるのを確認。


次に、とりあえず一番最初に"1" が表示されることを確認したい。テストコードの方を以下のように書き換える。 

public class FizzBuzzTest {
  @Mocked("println(String)") PrintStream mock;
  @Test public void main() {
    new Expectations() {{
      mock.println("1");
    }};
    FizzBuzz.main(new String[0]);
  }
}
PrintStream をモックして、System.out.println()の呼び出しを確かめている。

これを実行すると、パラメータ"1"で呼ばれるはずの println() が呼ばれなかったという事で、赤になる。本体コードを以下のように直して、再実行。今度はグリーンになるので、JMockit を含めた疎通確認ができた。 
  public static void main(String[] args) {
    System.out.println("1");
  }


さて、与えられた仕様をどうテストするか。まず 100個の数字ってとこからやってみる。実装としては、println() が呼ばれる度に、パラメータを List に溜め込んでおいて、後で調べる方式にしてみよう。こんなコードになる。 

  @Test public void main() {
    final List<String> texts = new ArrayList<>();
    new NonStrictExpectations() {{
      mock.println(anyString); result = new Delegate<PrintStream>() {
        void println(String x) { texts.add(x); }
      }; 
    }};
    FizzBuzz.main(new String[0]);
    assertEquals(100, texts.size());
}
Delegate ってのを使って、PrintStream#println(String) を書き換えて、受け取った文字列をローカルのリスト texts に溜め込むようにした。

実行すると赤くなるから、本体コードも以下のように直して、グリーンにしておく。 
  public static void main(String[] args) {
    for (int i = 1; i <= 100; i++)
      System.out.println("" + i);
  }


次に、数字と文字列の対応付けのあたりをやる。以下をチェックする。

始点の1・・・1 ⇨ "1"
3とその前後・・・2 ⇨ "2", 3 ⇨ "Fizz", 4 ⇨ "4"
5とその前後・・・4 ⇨ "4", 5 ⇨ "Buzz", 6 ⇨ "Fizz"
15とその前後・・・14 ⇨ "14", 15 ⇨ "FizzBuzz", 4 ⇨ "16"
終点の100・・・100 ⇨ "Buzz"
テストコードはこんな感じにしてみる。 
@SuppressWarnings("unused")
public class FizzBuzzTest {
  @Mocked("println(String)") PrintStream mock;
  @Test public void main() {
    final List<String> texts = new ArrayList<>();
    new NonStrictExpectations() {{
      mock.println(anyString); result = new Delegate<PrintStream>() {
        void println(String x) { texts.add(x); }
      }; 
    }};
    FizzBuzz.main(new String[0]);
    assertEquals(100, texts.size());

    FizzBuzzAssertion a = new FizzBuzzAssertion(texts);
    a.assertIt("1",      1);

    a.assertIt("2",      2);
    a.assertIt("Fizz",   3);
    a.assertIt("4",      4);
    a.assertIt("Buzz",   5);
    a.assertIt("Fizz",   6);
  
    a.assertIt("14",     14);
    a.assertIt("FizzBuzz",15);
    a.assertIt("16",     16);

    a.assertIt("Buzz",   100);
  }
  static class FizzBuzzAssertion {
    final List<String> actuals;
    FizzBuzzAssertion(List<String> actuals) { this.actuals = actuals; }
    void assertIt(String expected, int number) {
      assertEquals(expected, actuals.get(number - 1));
    }
  }
}
FizzBuzzAssertion クラスはコード重複を避けるために導入した。そうしないと、以下のようなコード重複が生じる。また、リストの数字と文字列の対応付けもずれて読みにくいので、これも解消した。 
assertEquals("1", texts.get(0));
assertEquals("2", texts.get(1));
assertEquals("Fizz", texts.get(2));
assertEquals("4", texts.get(3));
テストを実行すると赤になるので、本体コードを以下のように書き換える。 
  public static void main(String[] args) {
    for (int i = 1; i <= 100; i++) {
      System.out.println(
          0 == i % 15 ? "FizzBuzz":
          0 == i % 3 ?  "Fizz":
          0 == i % 5 ?  "Buzz":
          Integer.toString(i));
    }
  }
再実行してグリーンになるのを確認。これでテストコードと本体コードの TDD 終わり。

一応機能テストとして、本体コードの main を実行して、コンソールを目視確認しておく。問題なし。

====

こんな感じで、FizzBuzz 自体は屁だけど、テストファーストでやるとモッキングのテクが、若干必要になってくる。
投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年8月6日月曜日

システム例外を扱うテストコードを JMockit で書いてみる

外部のライブラリで発生した例外のハンドリングを、どうやってテストファーストで書くか。これを示してみる。

====

お題は、以下のようなもの。

java.io の API を使って、テキストファイルから最初の 1行目を読み込むメソッド loadText() があり、クラス ExceptionalFugafuga で定義されている。またテストコードも既に書いてある。ただし IOException 発生時のコードは未定のままになっている。

本体コード。 
public class ExceptionalFugafuga {
   public String loadText() {
      try (BufferedReader reader = new BufferedReader(new FileReader("fuga.txt"))) {
         return reader.readLine();
      } catch (IOException exep) {
         throw new AssertionError(); // ★ 後回しの暫定コード
      } 
  }
}
こっちはテストコード。 
public class ExceptionalFugafugaTest {
   @Mocked BufferedReader br = null;
   @Mocked FileReader reader= null;
   @Test public void loadText() throws Exception {
      new NonStrictExpectations() {{
         br.readLine(); result="the first line";
      }};
      assertEquals("the first line", new ExceptionalFugafuga().loadText());
   }
}
ここで、IOException をキャッチしたときの暫定コードを、"例外: "＋例外メッセージという文字列を返すように修正したい。これをテストファーストでやるとどうなるか。

まずテストコードから。
こんなテストメソッドを追加する。

@Test public void loadText_IOException() throws Exception {
  new Expectations() {{
    new FileReader("fuga.txt"); result = new IOException("はあこりゃこりゃ");
  }};
  assertEquals("例外: はあこりゃこりゃ", new ExceptionalFugafuga().loadText());
}
本体コードがまだそのままなので、テストが失敗して赤くなる。

で、AssertionError() を上げているところを "return "例外: " + exep.getMessage();"に変える。

再度実行し、今度はグリーンになる事を確認する。以上。

====

昔なら、テストメソッド loadText() の @Before とか @After で、実ファイル "fuga.txt" を作ったり消したりしていたところだけど、見ての通り、モックツールを使うとそういうのはいらなくなる。

例外に関しても同じようなことで、例外を発生させる状況を作りだすのではなく、単に例外を投げ上げる振る舞いに差し替えればいい。「Unit」としてテストするとは、本来はこうやって環境から隔離して実施するのものではなかったかと思う。同じやり方は DB例外 でも WebService 例外でも、なんでも応用が効く。

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年8月5日日曜日

現在時刻に依存する振る舞いのテスト・コーディング

「現在時刻が 17時台から 22時台までなら夕方(evening)とする」。

そんなメソッドを、Eclipse と JMockit を使ったテストファーストで書いてみる（こういった実行時に依存する条件を含むコードは、昔はテスト・コーディングが難しかったけど、ツールが進歩した最近はそうでもない）。

====

対象メソッドが CurrentTimeHogehoge クラスの isEvening() メソッドだとすると、テストクラスはこんな感じになるはず

public class CurrentTimeHogehogeTest {
  @Test public void isEvening() {
    assertTrue(CurrentTimeHogehoge.isEvening());
  }
}
この時点では CurrentTimeHogehoge クラスがまだ存在しないから、Eclipse のエディタ上で赤い下線が引かれている。その行で Ctrl+1 を押してクラス生成を選ぶとダイアログが開くから、ソースフォルダを適当に直して Finish。

エディタに戻ると、今度は isEvening() に赤い下線が移っているので、これも Ctrl+1 で 生成する（いちいちタイピングしない）。

コンパイルが通ったところで、こんなコードになっているはず。 

public class CurrentTimeHogehoge {
  public static boolean isEvening() {
    // TODO Auto-generated method stub
    return false;
  }
}
試しにテスト実行してみると失敗して赤くなるので、"return false" を "return true" に書き換えて、一旦グリーンにしておく。

続いて isEvening() の実装方針だけど、現在時刻を Calendar の get で取るって事で当たりを付ける。そうすると、テストコードは以下のような感じになる。

public class CurrentTimeHogehogeTest
  @Mocked("get") final Calendar cal = null;
  @Test public void isEvening() {
    new Expectations() {{
      Calendar mock = Calendar.getInstance(); 
      mock.get(Calendar.HOUR_OF_DAY); result = 17;
    }};
    assertTrue(CurrentTimeHogehoge.isEvening());
  }
}
cal を宣言する一行は、意味的にはフィールドの宣言と言うより、Calendar クラスの get メソッドを差し替えるという宣言になる。差し替える振る舞いは Expectations の中に記述していて、ここでは固定値17を返している。

ここでテスト実行してみて、赤になることをひとまず確認。呼ばれるはずのメソッド、Calendar#get() が 呼ばれなかったと、トレースされているはず。

本体コードの isEvening() は以下のように書き換える。とりあえず時間範囲の下側だけ判別するようにしている。 

  public static boolean isEvening() {
    Calendar cal = Calendar.getInstance();
    int hour = cal.get(Calendar.HOUR_OF_DAY);
    return 17 <= hour;
  }
実行するとテストがグリーンになる。

続いて、境界値である、16→偽, 17→真, 22→真, 23→偽 についてテスト・コーディングするわけだけど、コードが重複するのが明らかなので、あらかじめ重複部分を以下のようなメソッドとして切り出しておく。

  private void validateIsEvening (final int hour, final boolean result) {
    new Expectations() {{
      Calendar mock = Calendar.getInstance(); 
      mock.get(Calendar.HOUR_OF_DAY); result = hour;
    }};
    assertEquals(result, CurrentTimeHogehoge.isEvening());
  }
これを、パラメータを変えてテストメソッドから呼び出す。以下のようになる。
@Test public void isEvening() {
    validateIsEvening(16, false);
    validateIsEvening(17, true);
    validateIsEvening(22, true);
    validateIsEvening(23, false);
  }

実行するとテストが赤になるから、isEvening の最終行を "return 17 <= hour && hour <= 22"に直す。これでテストが成功する。

====

演習だから、テストコードと本体コードの切り替えがかなり小刻みだけど、実戦だったらもうちょいざっくりした感じになると思う

投稿者 時刻: 0 件のコメント:
ラベル: ,

JMockit で Hello World をテストファーストしてみよう

main() メソッドから System.out.println("Hello, World!") してるだけのコードをテストファーストで書くとどうなるか？

これを Eclipse と JMockit でやってみる。

====

まず、こんな感じで普通の JUnitコードを書く。 

public class HelloWorldTest {
   @Test public void test() {
      HelloWorld.main(new String [0]);
   }
}
この時点では、まだ HelloWorld クラスがないので、Eclipse のエディタ上では、HelloWorld の下に赤い下線が引かれている。そこにカーソルを移動して Ctrl+1 を押下してクラスの生成を選ぶとダイアログが開くので、main 生成にチェックをいれて Finish。こんなクラスが生成される。 
public class HelloWorld {
   /**
    * @param args
    */
   public static void main(String[] args) {
      // TODO Auto-generated method stub
   }
}
Eclipse での作業中はショートカットを活用すると無駄なタイピングをかなり削減できる。

コンパイルが通ったところで、一応、テスト実行してグリーンになることを確認しておく。


次に System.out の println メソッドに "Hello, World!"が渡される事を確認する。

これは JMockit を使うので、pom.xml に以下のように追記する。ただし、インストゥルメンテーションの都合上、<dependencies>の中で junit の前に書かれていなくてはならない。 

  <dependency>
   <groupId>com.googlecode.jmockit</groupId>
   <artifactId>jmockit</artifactId>
   <version>0.999.15</version>
  </dependency>

テストコードには以下のように追記する。

public class HelloWorldTest {
   @Mocked PrintStream mock;
   @Test public void test() throws Exception {
      new Expectations() {{
         mock.println("Hello, World!");
      }};
      HelloWorld.main(new String[0]);
   }
}

実行してみるとテストが失敗し、以下のような結果がトレースされる。 

mockit.internal.MissingInvocation: Missing invocation of:
java.io.PrintStream#println(String x)
with arguments: "Hello, World!"
on mock instance: java.io.PrintStream@15ebf57
・・・
呼ばれるはずのメソッドが呼ばれていないと、JMockit に指摘されている。

ここで main を以下のように書き換えて、再度テスト実行してみる。

   public static void main(String[] args) {
      System.out.println("test");
   }
失敗して、こんなメッセージがトレースされるが、さっきとメッセージが変わっている。 
mockit.internal.UnexpectedInvocation: Parameter "x" of java.io.PrintStream#println(String x) expected "Hello, World!", got "test"
・・・
今度は、"Hello, World!" を期待していたのに"test"が渡されたと言っている。

というわけで、おもむろに"test"を"Hello, World!"に書き換えて、テスト再実行。今度はグリーンになる。

実際のテスト・コーディングよりも、敢えてちょっと回りくどい感じでやってみた。

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年7月29日日曜日

二元の分割数の母関数

何日か悩んで、やっと二元の分割数の母関数が分かった。そもそも分割数も母関数もよく分かっておらず、骨が折れた。数学的素養のある人には難しくないのかもしれないが・・・ 
   ( 1 + b      + b^2    + … )
 * ( 1 + b^2    + b^4    + … )
 * ( 1 + b^3    + b^6    + … )
   … 
 * ( 1 +    w   +    w^2 + … )
 * ( 1 +   bw   + b^2w^2 + … )
 * ( 1 + b^2w   + b^4w^2 + … )
 * ( 1 + b^3w   + b^6w^2 + … )
   … 
 * ( 1 +    w^2 +    w^4 + … )
 * ( 1 +   bw^2 + b^2w^4 + … )
 * ( 1 + b^2w^2 + b^4w^4 + … )
 * ( 1 + b^3w^2 + b^6w^4 + … )
   … 
 * ( 1 +    w^3 +    w^6 + … )
 * ( 1 +   bw^3 + b^2w^6 + … )
 * ( 1 + b^2w^3 + b^4w^6 + … )
 * ( 1 + b^3w^3 + b^6w^6 + … )
   … 
   …

この多項式を計算して、bnwm の係数を調べれば、n 個の 黒玉(b) と m 個の 白玉(w) を分割するパターン数が得られる。

項の数が無限だから計算できないように思えるかもしれないが（自分も母関数をいろいろ調べるまではそうだった）、必要な部分は限られているので、元の式と計算途中の式から、範囲外の項は除外していけば計算できる。

試しに黒玉、白玉、ともに 3個までに限定して手計算してみると、以下のようになる。

1bb2b3 wbwb2wb3w w2bw2b2w2b3w2 w3bw3b2w3b3w3
1+b+b2+b3 1111
1+b2 1122
1+b3 1123
1+w+w2+w3 11231123 11231123
1+bw+b2w2+b3w3 11231235 12461247
1+b2w 11231246 12581259
1+b3w 11231247 125912510
1+w2 11231247 2371224917
1+bw2 11231247 24814251121
1+b2w2 11231247 24915251223
1+b3w2 11231247 24916251224
1+w3 11231247 24916361427
1+bw3 11231247 24916371529
1+b2w3 11231247 24916371630
1+b3w3 11231247 24916371631

例えば、黒玉3個、白玉1個は b3wの係数で7パターン、黒玉2個白玉2個ならb2w2の係数で9パターン、黒玉3個白玉3個ならb3w3の係数で31パターンとなり、手作業で調べた結果と一致する。

ここまで分かれば、任意の個数の黒玉白玉について、分割パターンの数を求めるプログラムを書くのはそう難しくない。Project Euler の Problem 181 がこれで解ける。

投稿者 時刻: 0 件のコメント:
ラベル:

2012年7月23日月曜日

So What テスト／Grandmother テスト

『So What』 といえば、1959 年にマイルスがモーダルなアプローチを完成させた金字塔。初めて譜面を見たメンバーから「コードが書いてないじゃないですか」と問われたマイルスは、「So What （だからどうした）？」と答えたという。

・・・という話ではなくて、プラグマティズムの話。藤井聡著『プラグマティズムの作法』から。

====
■ So What テスト

「So What ?」というシンプルな問いによって、ある仕事の意義と限界を測るというもの。この問いに対して口ごもっって答えにつまるようでは、その仕事が本当に価値があるか怪しいという事になる。

これは、ソフトウェア開発の現場でも有用だと思う。

あるツールやフレームワークやプラクティスなどをプロジェクトに取り入れようとしたとき、それは何のためなのか？ それによって、何がどうなるか？ 誰にとって何が嬉しいのか？

答えられるのが当たり前。そう思いたいけど、意外と現場ではそうじゃなかったりする。単なる流行りとか、スノビズムとか、権威主義とか、個人的趣味とか、自己顕示欲とか、そういった事でプロジェクトに何かが持ち込まれたり何かが決められたりする事がある。（技術が好きで勉強熱心なエンジニアもそういう病気にかかったりしがちだから面倒くさい。）

こうした良く考えてみると大した意味のない仕事に労力を使うことを、「So What ?」と問うてみる習慣によってかなり回避できるのではと思う。

また逆に、本来は非常に価値のある仕事を、「So What ?」に答えられないレベルの理解で始めてしまって、結局まともな効果が上がる前に、中途半端で打ちきる破目になる事もある。（で、自分たちの未熟さを棚に上げて、「やっぱあれはダメだった」的な薄っぺらい「経験談」が語られ始めるよくあるパターン。）

これらについても、まず最初から「So What ?」を意識することで、ブレずに方向性とモチベーションを維持できるようになると思う。

あと、プロジェクトで採用することになった物事についての「So what?」には、自分だけじゃなくプロジェクトのメンバにも答えられるようになってもらった方が良い。PMから各チームリーダ、技術的キーパーソンの辺りには、特に。

たまにプロジェクト外部の権力者から横槍が入ったりする事があるけど（「ディベロッパーテストはコスパが良くわからんから中止しようや？」等）、何を何のためにやろうとしていて、顧客や会社にとって何が嬉しいのか説明できるようにしてもらう必要がある（自身が PM なら言われる間でもなく必須）。説明に関しては、後述の Grandmother テストも関連する。

つうわけで、自分の仕事について「So what?」と自問する事、その答えをプロジェクトとして共有する事によって、いつの間にかプロジェクトが変な方向に迷走したり、いくら頑張っても不毛感に苛まれるといった事を避けられるんじゃないか、というのが So What テスト。

■ Grandmother テスト

著者によると、学会で「So What ？」を放った場合、専門用語をだらだら羅列しただけの、答えになっていない応答を威圧的な態度で返される事があるという。

こういった「不誠実な」態度は別にして、専門分野に浸っているうちに、ついつい高次の目的とどう繋がっているか見失いう事もままある。これについても、ソフトウェア開発の現場で散見されると思う。

それを防ぐための思考の道具が Grandmother テスト。お婆ちゃんでも分かるように、簡単で実感の伴った説明ができるかどうかを試すというもの。本当に有意義なアイデア／仕事ならば、専門家じゃなくても一般常識と生活感覚で理解できるはずだという考え方。

これを心がけることで、例えば、一見、技術的に高度でクールだけど、良く考えると何が嬉しいのか分からなくなってくるような状況にはまるのを予防できる。

====
つう事をいろいろ書いているうちに、自分も反省しなきゃならない事を、いろいろ思い出してきた… orz
自分も若い頃は、スキルを見せたいってのが半分以上の動機であんな事とか …
投稿者 時刻: 0 件のコメント:

2012年7月19日木曜日

『素数入門』を読んだ

Project Euler をやっているうちに、数論を勉強してみたくなって、この本を買ってみた。

LINK
『素数入門』

同じ著者による続編、『数論入門』での著者自身による前書きによると、「初等・初等整数論」って位置づけらしいけど、初等整数論の初級入門者な自分にはちょうど良い。

Project Euler でも見かける関数（オイラーのφ関数とか約数関数とか）が出てくるので、Project Eulerをやったことがある人には、けっこう面白いんじゃないだろうか。あと、こちとら一応プログラマなので、すぐにプログラムを書いて確認できる環境とスキルがあるのはラッキー。

全9章の真ん中の第5章で合同式が扱われているけど、ここをちゃんと理解するのがキーだと思った。合同式がちゃんと分からないと、後の章はほぼちんぷんかんぷんになる。つうか、欲を言えばだけど、もうちょい例題と問題を多くしてほしかった（特に合同式の割り算のあたり）。

9章あたりになると、結構むずかしくなる。フェルマーテストやカーマイケル数なんかは、一回読んだだけじゃ理解できなかった。

正直、読み急いでしまって問題を解くのをけっこう省いたが、「計算しながら理解する」のがこの本の趣向の一つでもあるので、やっぱやっといた方が良い（「計算」というか証明問題が多い気がするが）。実際に、計算してみないと、やはり腹落ちしない。そういうものなのだと思う。

投稿者 時刻: 0 件のコメント:
ラベル: , ,

2012年7月18日水曜日

GlassFish Server 3.1.2.2 を入れてみた

GlassFish Server 3.1.2.2 がリリースされたので入れてみた。

OSFedora 16
java version1.7.0_03-icedtea
  • ダウンロードサイトに行って、glassfish-3.1.2.2-ml.zip をダウンロードする
  • glassfish-3.1.2.2-ml.zip を適当なところに展開する
    → glassfish3 フォルダが生成される
  • glassfish/bin/ フォルダに移動して、startserv を実行する
    → ずらずらとログが吐かれて、正常に起動する
  • http://localhost:8080/ をブラウザで見てみる。
    → "Your server is now running"画面が表示される。
  • "go to the Administration Console."リンクから GlassFish 管理画面に移動する。
    → domain1 の初期状態が表示される
ほぼ問題なし。（※ ダウンロードサイトで、シェルスクリプトが提供されていて、GUIベースのインストーラらしいけど、うちの環境では動かなかった。別にいいけど。）
投稿者 時刻: 0 件のコメント:
ラベル:

2012年7月14日土曜日

手作業でハンガリー法 Hangarian Algorithm

project euler #345 に、割り当て問題の解き方で、名前だけ聞いたことのある「ハンガリー法（Hangarian Algorithm）」ってのが使えそうなので、勉強がてらやってみた。ほぼ手作業で。

====

下の表は、問題文中のサンプル。

753183439863　
49738356379973
28763343169583
627343773959943
767473103699303

#345 は最大値を求める問題なので、それぞれの値を1000から引いて、大小関係を逆転させておく。

993947817561137　
50361743792127
713937657831417
3736572274157
233527897301697

行ごとに、最小値を行の各要素から引く。下表のように各行に少なくとも一つ 0ができる。

8568106804240　
4765904108940
2965202404140
332616186016
029466468464

同様の操作を列ごとに行う。これで行で見ても列で見ても、最低一つの 0 ができた。

8565164944240　
4762962248940
296226544140
3323220016
0047868464

上から順に行を調べて、取り消されていない 0 がただ一個だけあれば、その 0 に仮決めの印をつける（ここでは白い太字）。仮決めした 0 と同じ列の他の行に 0 がもしあれば、取り消し印（ここでは取り消し線）をつける。

8565164944240　
4762962248940
296226544140
3323220016
0047868464

同じことを列に対して行う。つまり左から順に列を調べて、取り消されていない 0 が一個だけある列ならば、その0 に仮決め印をつけて、他の列の同じ行に 0 があれば、取り消し印をつける。

（この例では、行への操作と列への操作を一巡するだけで終わったが、もしまだ仮決めにも取り消しにもなっていない 0 が残っていれば、また行の操作からやり直す。）

8565164944240　
4762962248940
296226544140
3323220016
0047868464

仮決めの 0 を含まない行に印をつける。その行に取り消しの 0 があればその列に印をつける。さらにその列に仮決めの 0 があれば、その行に印をつける。その行に取り消しの 0 が・・・って感じで、やることが無くなるまで続ける。（言葉にすると変だけど、やってみると簡単）

8565164944240
4762962248940←
296226544140←
3323220016
0047868464
8565164944240
4762962248940←
296226544140←
3323220016
0047868464
↑
8565164944240←
4762962248940←
296226544140←
3323220016
0047868464
↑

印がついていない行と、印がついた列に色をつける。ただし重なっている部分が分かるようにする。ここでは重なっていない部分を橙色、重なった部分を赤の文字色にした。

8565164944240←
4762962248940←
296226544140←
3323220016
0047868464
↑

色がついていない部分の最小値（ここでは54）を見つけて、色がついていない値から減算し、重なっている値には加算する。色がついているけど重なっていない部分の値はそのまま。

できたら、いったん印とか色とかをクリアして、また印をつけるところからやり直す。各行、各列に一個ずつ 0 が決まったら終わり。

以下、もう一巡したところ。

8024624403700←
4222421708400←
24217203600←
3323220070
0047868518
↑

さらに一巡

6322922702000
2527206700←
2421720360170←
33232200240
0047868 688
↑↑

もっかい

63229234220072←
180005980
1701000288170
332322720312
0055068 760

さらに半巡して、つまり、無色の値の最小値（72）を、それぞれの無色の値から減算したところで、やっと全ての行と列に 0 が揃った。

5602202701280　
180005980
1701000288170
332322720312
0055068760

0 になっている部分の位置関係を、そっくりそのままもとの表に当てはめると、問題文どおりの値が得られる。

　　　　863　
　383　　　
　　343　　
　　　959　
767　　　　

====
euler #345 だと 15×15 のマトリクスだけど、試しに手作業（＋Excel）でやってみたら、6 巡か 7 巡で、2時間以上かかったけど、まあ一応正答がでた。正直、ハンガリー法のやり方がよくわかっていなかったのでやたらと時間がかかったが、手でやった分、なんか身についた気がする。

Youtube にもハンガリー法の実演動画がたくさんあるけど、下記リンクのインドの大学の講義が、インド訛りをのぞけば一番懇切丁寧で参考になった。 Lec-16 Assignment Problem - Hungarian Algorithm

この問題は、手作業でできてしまったので、コーディングはまた今度にすることにしたけど、project euler の thread を見ると、なんだか各人各様でかなり異なるアイデアで解いている。そのうち調べて見ようと思う。特に DP を使っているやり方とか。
投稿者 時刻: 0 件のコメント:
ラベル:

2012年7月8日日曜日

ちょっとBABOK でも勉強してみようかと

PMP の期限が切れて、suspended になってしまった。

60 PDUを稼がないとならないので、とりあえず見つけたのが ネットラーニングの BABOK 講座。これで 40PDU。

キャンペーン期間に申し込めたので 34,930 円で済んだが、今現在、価格を見てみると、49,900円になっている。ラッキーだった。

PMBOK が「どのように（HOW）」プロジェクトを回していくかに着目しているのに対して、BABOK はそれ以前に 「何のために（WHY）」「何を（WHAT）」を提供するかに着目した知識体系。

思えば、「何を、何のために」作ってるのか分からないまま開発が進められて、もの凄く残念な事になったプロジェクトもあったなあ（遠い目）・・・

特にベンチャー系の開発だと、新製品開発なのか受託開発なのかよく分からない変なプロジェクトが何かの拍子に立ち上がる事があって、ステークホルダー間で思惑がバラバラなまま、誰がどんな風に使って何が嬉しいのか分からないモノを開発する事になっちゃったりする事がある。

今、8章あるうちの2章までやったけど、資料はなかなかよくできている。できれば BABOK 日本語版も入手したいところだが、6,000円 もするので躊躇してしまう。とりあえず、講座で提供されている資料を当てにする事にする。

せっかくだから、単に PDU を稼ぐだけじゃなくて、現場に持って帰れるノウハウというかヒントが得られたら良いと思う。

あと4、5日で終える予定だけど、まだ 20 PDU足りないのでなんとかせねばならない。できればアジャイル関連で安いものがあれば良いのだけど。

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年6月17日日曜日

『列島強靭化論』を読んだ

ミッションクリティカルなシステムでは、普通は何らかの冗長構成を採って、サーバーが一台落ちたりハードディスクが一個壊れたりしても何ともないようになっている。落ちたら困る度合いに応じてお金を掛けて、一台ですむところを冗長化したりその他の安全のための工夫をしている。まあ、何てことない普通の話だと思う。

プログラマとして藤井聡教授の『列島強靭化論』を読むと、こうした冗長化などの考えを日本の国土に対して適用し、「日本」というシステムの Availability（可用性）を高めようというアイデアが見えてくる。ついこの間、自民党の国土強靭化基本法案が提出されたところなので、元ネタと思われるこれを読んでみた。

LINK

システム開発者として意訳すると、曰く、日本というシステムは言うまでもなく日本人にとってもの凄くクリティカルなのだけど、にもかかわらずアーキテクチャとして余りにも脆弱である。ここで、もちろん Single Point of Failure は東京圏なわけだけど、30年以内に直下型地震が 70%以上の確率で起きる事が既に分かっている。

異音を立て始めたハードディスクを何の冗長化もなくミッションクリティカルなシステムに使ってるようなもので、これは恐ろしい。

つうわけで、東京に集まっている経済機能、都市機能を、太平洋ベルトに入らない日本海側や九州、北海道の諸都市にも分散しようという話だけど、システム屋ならすんなり納得できるんじゃないだろうか。クリティカルなシステムに冗長性を与えようって話だから、むしろ言われる前にやっておけと。

しかも藤井教授によると、そのためのインフラ整備の公共事業がデフレ・ギャップ解消／経済成長にも役立つから一石二鳥。それに先立つ東北の復興も加えると一石三鳥という事になる。10年で200兆って事だけど、通読するとそれほど法外なお金じゃない事も分かり易く説かれている。

（藤井教授はデフレ解消をもの凄く重視しているけど、この辺りは学者によって賛否両論あるらしい。自分は藤井教授の考えに一理あると思う。まあ、新聞なんかでは単に「公共事業は悪」ってイメージだけの批判もあったようだけど、そういうのは論外。）

震災直後の1ヶ月で書き上げたとの事で、妙に臨場感があって、読むと当時の気分が蘇ってくる。

終章が面白い。もしも日本人が本書で提示された「強靭化」を日本の国土に対して施さなかった場合、この「不作為の罪」によって、どんな風に日本が終わってしまうかというストーリーが提示というか予言されている。これがもの凄くリアル。

発行から１年以上たった今、デフレ下では絶対ダメと本書で厳禁されていたはずの消費増税も肯定されてしまいそうな勢いだし、TPPも交渉参加だし、これは悪い方の予言が当たって、「30年以内に70%の確率」で日本終了のお知らせって事になっちゃうかもしれん・・・

投稿者 時刻: 0 件のコメント:
ラベル:

2012年6月16日土曜日

余りが１になる割り算から元の数を求める方法

1000003 × B ÷ 1000000 = q 余り 1 となる最小のBは何か？

これを素朴に求めると、B＝1から開始して初めて余りが 1になるまでBをインクリメントするような事になるが、ずっと効率的なやり方があったのでメモっておく。

以下、euler 134 のネタバレあり

==== ==== ==== ====

project euler に、与えられた素数 p1, p2 について、末尾が p1 で、なおかつ p2 で割りきれる数 S をもの凄く大量に計算する問題があった。

合同式で書くとこうなる

S ≡ 0 (mod p2)
S ≡ p1 (mod m) (m はp1を越える最小の10の正数乗)

実は合同式自体あまり詳しくないので、"連立 合同"でググってみると、連立合同式の解法を紹介しているサイトがあった。

これをよく読んで、上の問題に当てはめてみると、 

  S ≡ p1*p2*B (mod p2*m)
  ただし、B は p2*B ≡ 1 (mod m) を満たす整数)
を解けば良い事がわかる。

試しにやってみると、 
p1 = 19, p2 = 23
23*B ≡ 1 (mod 100) より、B = 87
(19 × 23 × 87) ÷ (23 × 100) = 16 余り 1219
答え： 1219
となり、一応計算できてることが分かる。

ただし困ったのが、B を求めるやり方で、素朴にやると以下のようになるけど（Haskell） 

ghci> find (\a ->1==mod (23*a) 100) [1..]
Just 87
これだと冒頭であげた1000000近辺の数だとかなり時間がかかる。

そこで更に調べてみると、「逆元（inverse）」なるものを求める方法があって、どうやらこれが使えそう。

ググりまわって Wikipedia でこの擬似コードを見つけた

remainder[1] := f(x)
remainder[2] := a(x)
auxiliary[1] := 0
auxiliary[2] := 1
i := 2
while remainder[i] > 1
    i := i + 1
    remainder[i] := remainder(remainder[i-2] / remainder[i-1])
    quotient[i] := quotient(remainder[i-2] / remainder[i-1])
    auxiliary[i] := -quotient[i] * auxiliary[i-1] + auxiliary[i-2]
inverse := auxiliary[i]
これを、以下のように解釈して、表計算ソフトに打ち込んでみる。
nraq
1m0-
2p21-
・・・
iMOD(ri-2, ri-1) = - qi * ai-1 + ai-2 = DIV( ri-2, ri-1)
で、r が1 になったときの a が求める数字らしい。

試しに 1000003 でやってみると以下のようになる。

10000000
10000031
100000000
311
1-333333333333

-333333 が負数になっているので、mod (-333333,1000000)としてみると 666667 が得られる。 1000003 × 666667 ＝ 666669000001で、確かに 1000000 で割ると余りが 1 になる事が分かる。

もの凄く計算量が減ってる。ははは、これは面白い。

上の問題に戻って、p1 = 999983, p2 = 1000003 としてみると、mod (999983 * 1000003 * 666667) (1000003000000) = 666662999983 となり、1000003 で割りきれて末尾が 999983 になる数が確かに得られた。

上手く行きそうなので、表計算ソフトに書いた事を以下のような Haskell コードに置き換えてみる。 

inverse a m = mod (f m 0 0 a 1 0) m where
    f 1  a  _  _  _  _  = a
    f r1 a1 q1 r2 a2 q2 = f r a q r1 a1 q1
      where r = mod r2 r1
            q = div r2 r1
            a = -q*a1 + a2
euler 134 に適用してみると、1秒で正答が得られた。（ちなみに「余り１になるB」をインクリメントしながら計算すると、4時間くらいかかった。）

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年6月13日水曜日

ピタゴラス数の小ネタ

今までプログラマやってきて特に気にすることもなかったけど、project euler を始めてみるとピタゴラス数に関連する問題に出会うことがある。で、いろいろ調べてみると、ちょっと面白いネタというか Tips が見つかった。


■ 原始ピタゴラス数の無限リスト
このサイトで原始ピタゴラス数（primitive Pythagorean triple (PPT)）を次々に生成する行列が紹介されている。こんな行列。 
（ -1　 -2　 2）
（ -2 　-1　 2）
（ -2　 -2　 3）
この行列に符号を3通りに変えたピタゴラス数を掛けると、子のピタゴラス数が3つ生成される。例えば(3,4,5)から始めると以下のようになる。
(-1 -2 2) (-3)   ( 5)
(-2 -1 2) ( 4) = (12) 
(-2 -2 3) ( 5)   (13)

(-1 -2 2) ( 3)   (15)
(-2 -1 2) (-4) = ( 8) 
(-2 -2 3) ( 5)   (17)

(-1 -2 2) (-3)   (21)
(-2 -1 2) (-4) = (20) 
(-2 -2 3) ( 5)   (29)
算出された子のピタゴラス数から、さらに３つずつの孫を作ることができ、これを再帰的に繰り返すとピタゴラス数の無限リストを作ることができる。Haskell で書くとこんな感じになる。 
pyt1 (a,b,c) = ((-1)*a+(-2)*b+2*c,(-2)*a+(-1)*b+2*c,(-2)*a+(-2)*b+3*c)
pyt2 (a,b,c) = [pyt1(-a,b,c), pyt1(-a,-b,c), pyt1(a,-b,c)]
pyt3 ts = ts ++ pyt3 (concatMap pyt2 ts)
以下のような結果になる。
ghci< pyt3 [(3,4,5)]
[(3,4,5),(5,12,13),(21,20,29),(15,8,17),(7,24,25),(55,48,73),(45,28,53),(39,80,89),(119,120,169),(77,36,85),(33,56,65),(65,72,97),(35,12,37),(9,40,41),(105,88,137),(91,60,109),(105,208,233),(297,304,425),(187,84,205),(95,168,193),(207,224,305),(117,44,125),(57,176,185),(377,336,505),(299,180,349),(217,456,505),(697,696,985),(459,220,509),(175,288,337),(319,360,481),(165,52,173),(51,140,149),(275,252,373),(209,120,241),(115,252,277),(403,396,565),(273,136,305),(85,132,157),(133,156,205),(63,16,65),(11,60,61),(171,140,221),(153,104,185),(203,396,445),(555,572,797),・・・



■ 高さ＝底辺の二等辺三角形に漸近する漸化式
このサイトでは、ピタゴラス数を直角二等辺三角形に近づけていく漸化式が紹介されていた。直角を構成する辺 a と b の差を1に こんな式。
an+2 = 6*an+1 - an + 2  a1 = 3, a2 = 20
cn+2 = 6*bn+1 - bn - 2  b1 = 4, b2 = 21
cn+2 = 6*bn+1 - cn      c1 = 5, c2 = 29
で、ここから類推して高さ＝底辺の二等辺三角形（の片側の三角形）に漸近する漸化式もきっとあるだろうなと思って探してみた（きっかけは euler 138）。

まず直角を構成する2辺のうち長い辺と短い方を二倍したものとの差が1であるものを何個か探す。これは上述の無限リストに対して、条件に合うものをフィルタリングした。以下のようなものが見つかった（これ以上は数が大きくなりすぎて難しい）。
(15,8,17)
(273,136,305)
(4895,2448,5473)
(87841,43920,98209)
(1576239,788120,1762289)
(28284465,14142232,31622993)
(507544127,253772064,567451585)
(9107509825,4553754912,10182505537)
で見つかったピタゴラス数から連立方程式を立ててこれを解いた。手で計算するのは面倒なので、ネット上の連立方程式を解くプログラムを使った。例えば、斜辺ならこんな式を解けば良い。
305*x + 17y + z = 5473
5473*x + 305*y + z= 98209
98209*x + 5473*y + z =1762289

解）x=18, y=-1, z=0
で、c1 = 17, c2 = 305, cn+2 = 18*cn+1 - cn という漸化式が得られる。Haskell で書くとこうなる。
l = 17:305:zipWith (\a b->18*b-a) l (tail l)
同様に、直角を構成する2辺についても漸化式が得られる。 a1 = 15, a2 = 273, an+3 = 17*an+2 + 17*an+1 - an (bも同様)

試しに20番目の要素を見てみると、a= 10151021471800938910964641, b = 5075510735900469455482320, c = 11349187026003431978487841)で、a2 + b2 = c2, 1 = |2b-a| が確かに成立する。

==== ==== ==== ====

さっき problem 138 を解いて、euler project を150問解いた事になる。簡単な問題を選んでやってきたが、そろそろ難しくなってきた。かなり頑張ったけど、まだ半分にも至ってないのか…

投稿者 時刻: 0 件のコメント:
ラベル: ,

2012年5月2日水曜日

Pell方程式を解くための実装メモ

Project Euler をやってると、Pell方程式 X2-DY2=1 に関連する問題をたまに見かける。これを解くとき、連分数を使うやり方がよく使われるようだけど、半分位の手数で解が得られるやり方がここで紹介されていたので、Haskell で実装してみた。

■ やり方
だいたいこんな感じ
g-1=0g0=0gn+1 = -gn + knhn
h-1=0h0=1hn+1 = (D - gn+12)/hn
k-1=0k0=[√D]kn+1 = [(k0 + gn)/hn]
x-1=0x0=1xn+1 = gnyn + hnyn-1
y-1=0y0=0yn+1 = yn-1 + knyn
で、gn とgn+1 で同じ値が連続したら、
X = (xn2 + Dyn2)/hn
Y = 2xnyn/hn
hn とhn+1 で同じ値が連続したら、
X' = (xnxn+1 + Dynyn+1)/hn
Y' = (xnyn+1 + xn+1yn)/hn
X = X'2 + DY'2
Y = 2X'Y'

■ 例
D = 23の場合
nghkxy
-100001
001410
147141
232351
3371194
24 = (52 + 23*12)/2
5 = 2*5*1/2
D = 29の場合
nghkxy
-100001
001510
154251
2351112
32511613
70 = (11*16 + 29*2*3)/5
13 = (11*3 + 16*2)/5
9801 = 702 + 29*132
1820 = 2*70*13

■ コード
pell d=pell' d (0,0,0,0,1) (0,1,floor(sqrt(fromIntegral d)),1,0) 
  where 
   pell' d (g,h,k,x,y) n@(gn,hn,kn,xn,yn)
    | g'== gn    = let xr = div (xn^2 + d*yn^2) hn
                       yr = div (2*xn*yn) hn
                   in (xr, yr)
    | h'== hn    = let xr = div (x'*xn + d*y'*yn) hn
                       yr = div (x'*yn + xn*y') hn
                   in (xr^2 + d*yr^2, 2*xr*yr)
    | otherwise  = pell' d n (g',h',k',x',y')
    where k0 = floor$sqrt$fromIntegral d
          g' = (-gn) + kn*hn
          h' = div (d - g'^2) hn
          k' = div (k0 + g') h'
          y' = y + kn*yn
          x' = g'*y' + h'*yn

■ 結果
ghci> let isNotSquare n= (round . sqrt $ fromIntegral n) ^ 2 /= n
ghci> mapM_ (\n->print$(n,pell n)) $filter isNotSquare [2..15]
(2,(3,2))
(3,(2,1))
(5,(9,4))
(6,(5,2))
(7,(8,3))
(8,(3,1))
(10,(19,6))
(11,(10,3))
(12,(7,2))
(13,(649,180))
(14,(15,4))
(15,(4,1))
ghci> maximumBy (\a b->(on compare (snd.snd))a b )$ map (\n->(n,pell n)) $filter isNotSquare [2..2000]
(1621,(6298101812493732343034974500091457815529942308667051412857352310169665125001,156429324369979112128445583345098338627552043874824108399177922442751050500))
Problem 66 で、D≦1000でXが最大になるものを求める問題があるけど、D≦10000でもすぐに答えが出てくる。

投稿者 時刻: 0 件のコメント:
ラベル:

2012年3月27日火曜日

ブルートフォース癖

ガウスがちっちゃい頃の逸話で、先生が算数の時間に、生徒達に１から100までの合計を計算させて、その間に雑用か何かを片付けようとしてたら、ガウスが101 * 50 = 5050と瞬時に答えをだしたので先生が驚いたってのを聞いたことがある。

プログラマたるもの大いに見習わなきゃならんなと常々思っていたけど、最近、Project Euler を始めてみて、かなり自分にブルートフォース癖があるのに気づいて反省。

例えば Problem 169 の以下のような問題がある（それほど難しくないと言われている）。

Define f(0)=1 and f(n) to be the number of different ways n can be expressed as a sum of integer powers of 2 using each power no more than twice.

For example, f(10)=5 since there are five different ways to express 10:

    1 + 1 + 8
    1 + 1 + 4 + 4
    1 + 1 + 2 + 2 + 4
    2 + 4 + 4
    2 + 8

What is f(10^25)?

これを解くのに、可能な手をそれぞれ試行してからルールに合わないものをふるい落とすなんてやり方（試行回数を減らす工夫はしてるつもりだけど）だと、いつまで経っても終わらない。

途中の計算結果をキャッシュでもしてみようかとも思ったけど、もうそんなのは止めておこうと思い至り、初めから再考する事にした。

で、改めてよく考えてみると、「1」を使わない部分の合計を x としたとき、n が奇数ならば必ず「x + 1」の形になる。ここで x 部分のバリーション数は f (n div 2) で、これが即ち f(n)と等しいということが分かる。

次に n が偶数のときを考えると、表記法のバリエーションは「x」か「x + 1 + 1」のいずれかのパターンに分類され、前者の表記法の数は f (n div 2) で、後者は f ((n-2) div 2)となるから、f (n) = f (n div 2) + f ((n-2) div 2)となる。

ここまでを問題文にある f(0)=1 を考慮してまとめると以下の様になる。 
n = 0     ⇒ f(n) = 1
n ∈ odd  ⇒ f(n) = f(n')
n ∈ even ⇒ f(n) = f(n') + f(n'-1)
※ n' = n div 2

うん、本当は、この辺りまで公式化してから、さて実装はどうしようかと考えるべきなんだよなあ。

改めて「分析」ってやっぱ大事だなと思う。実際の開発現場では、重量プロセスで必死になって大量にドキュメントを書いてるくせして、「分析」が全然なされてなされてなかったりするし、下手糞なアジャイルもどきの開発でも、「後でなんぼでもリファクタできるから」的なノリで実装を進めて、変な方向にはまり込んで引き返せなくなったりもする。ちゃんと分析しようやと。

話を戻すと、実は上の公式をそのまんま実装しても、二重再帰が含まれてるのでものすごく遅い。だから、ここからが実装の話になるけど、これを防ぐには、一回の f(n) の計算で f(n) とf(n-1)の両方を返すようにすれば良い。以下の表を観察すると規則性が見えてくる。

1 2 3456789101112
f(n) 121323143525
f(n-1)112132314352

n が奇数のとき f(n-1) は f(n')+f(n'-1) になっていて、偶数ならば f(n-1) は f(n'-1)になっている。例えば、f(9-1)=f(8)=f(4)+f(4-1)で、f(10-1)=f(9)=f(5)+f(5-1)。ここまで分かれば、f(n) と f(n-1)を同時に返して末尾再帰させるコードを簡単に書ける。自分書いた4行ばかりの Haskellコードは、実行すると瞬時に正答が算出された（二重再帰版は未だに帰ってこない）。

投稿者 時刻: 0 件のコメント:
ラベル:

2012年3月12日月曜日

Monoid をちょっと調べてみる自習

Monoid というのが、なんか地味っぽいけどよく使われているみたいなので、調べてみる。

◆ Data.Monoid

ghci で :i Monoidとやると、Data.Monoid で定義されているインスタンスがたくさん表示されてくるので、ソースを見ながら一個ずつ調べてみる。（「⇨」の左辺に ghci への入力、右辺に ghci の出力を書いてみた）

■ Any、All

Bool値をとる Monoid。 
mempty::Any ⇨ Any {getAny = False}
Any False `mappend` Any False `mappend` Any True ⇨ Any {getAny = True}
mconcat [Any False, Any True, Any False] ⇨ Any {getAny = True}
All はこれの反対で、類推は容易。

■ Ordering

これがちょっとおもしろい。LT、EQ、GTの三つの値があって、EQ の優先度が低く、LT と GTでは早い者勝ちという感じ。 
mempty::Ordering ⇨ EQ
mconcat [LT,LT] ⇨ LT, mconcat [LT,EQ] ⇨ LT, mconcat [LT,GT] ⇨ LT
mconcat [EQ,GT] ⇨ GT, mconcat [EQ,EQ] ⇨ EQ, mconcat [EQ,GT] ⇨ GT
mconcat [GT,LT] ⇨ GT, mconcat [GT,EQ] ⇨ GT, mconcat [GT,GT] ⇨ GT
mconcat [EQ,EQ,GT,LT] ⇨ GT

■ ()

() は、mempty、mappend、mconcat ともに ()

■ [a]

これも大体想像通り。mconcat では空リストが無くなる。 
mempty::[Int] ⇨ []
[3] `mappend` [1,4] ⇨ [3,1,4]
mconcat [[3,1],[],[4]] ⇨ [3,1,4]

■ First a、Last a

First は Maybe a 型の値を持つ Monoid で、Nothing 以外の値で早い者勝ち。Last はその逆。 
mempty::First Int ⇨ First {getFirst = Nothing}
mconcat[mempty, First Nothing, First (Just 27), mempty, First (Just 18)]
  ⇨ First {getFirst = Just 27}
mempty::Last Int ⇨ Last {getLast = Nothing}
Last (Just 27) `mappend` Last (Just 18) ⇨ Last {getLast = Just 18}
Last (Just 27) `mappend` mempty `mappend` Last (Just 18) `mappend` Last Nothing
  ⇨ Last {getLast = Just 18}

■ Endo a

なんだか endomorphism というものに関係があるらしい。wikipedia を引くと自己準同型とか自己射なるものの事らしいけど、正直、今のところよくからない。まあソースを読めば関数の合成に関係がある事はなんとなくわかるけど・・・ 
instance Monoid (Endo a) where
    mempty = Endo id
    Endo f `mappend` Endo g = Endo (f . g)
appEndo (Endo (*2) `mappend` mempty `mappend` Endo (+1)) 3 ⇨ 8
appEndo (mconcat [Endo (+3), Endo (+1), Endo (+4)]) 3 ⇨ 11
Foldable のソースでも使われていたりする。

■ Sum a、Product a …（a は Num）

文字通り、Sum が足し算で、Product が掛け算。 
mempty::Sum Int ⇨ Sum {getSum = 0}
Sum 3 `mappend` Sum 1 `mappend` Sum 4 ⇨ Sum {getSum = 8}
getSum $mconcat [Sum 3, Sum 1, Sum 4] ⇨ 8
mempty::Product Int ⇨ Product {getProduct = 1}
Product 3 `mappend` Product 1 `mappend` Product 4 ⇨ Product {getProduct = 12}
mconcat [Product 3, Product 1, Product 4] ⇨ Product {getProduct = 12}

■ Maybe a …（a は Monoid）

中身が Monoid の Maybe が Monoid になるつう事なんだろうか。 
Just [2,7] `mappend` Just [1,8] ⇨ Just [2,7,1,8]
Just EQ `mappend` Just LT ⇨ Just LT
Nothing `mappend` (Just $Sum 1) ⇨ Just (Sum {getSum = 1})
Nothing `mappend` Just GT ⇨ Just GT

■ Dual a …（a は Monoid）

なんかひっくり返すらしい。「双対」というものに関係がありそうだけど、詳細はよくわからない。Foldable の foldl の実装で使われてた。 
mempty::Dual [Int] ⇨ Dual {getDual = []}
Dual [3,1] `mappend` Dual [4,1] ⇨ Dual {getDual = [4,1,3,1]}
mconcat [Dual [3], Dual [1], Dual [4]] ⇨ Dual {getDual = [4,1,3]}

■ (a -> b) …（b が Monoid）

Monoid を返す関数を Monoid として扱うって事か。 
:t mempty::Monoid b =>(Int->b)
   ⇨ mempty::Monoid b =>(Int->b) :: Monoid b => Int -> b
 
(mempty::(a->String)) 333 ⇨ ""
(mempty::(a->())) "hello" ⇨ ()
((:"!") `mappend` (:"?")) '@' = "@!@?"
((compare 1) `mappend` (compare 10)) 5 ⇨ LT
(((\a b->[a + b]) `mappend` (\a b->[a * b])) 3) 10 ⇨ [13,30]

■ (a, b...) …（a から最大 e まで Monoid）

Monoid を値に持つタプルを Monoid として見て、縦に並べて計算する感じ。
5個分まで定義。 
mempty:: (String, Maybe (Sum Int)) ⇨ ("",Nothing)
("Hello, ", Sum 0.3) `mappend` ("World!", Sum 0.014)
   ⇨ ("Hello, World!",Sum {getSum = 0.314})
(GT, Sum 0.3) `mappend` mempty ⇨ (GT, Sum {getSum = 0.3})

◆ 試しに書いてみる

mconcat はデフォルト実装があるので、mempty と mappend だけ書けばいいらしい（参考URL）。

ただし Monoid law に気をつける必要がある。 
mempty `mappend` x = x
x `mappend` mempty = x
(x `mappend` y) `mappend` z = x `mappend` (y `mappend` z)

とりあえず「範囲」を Monoidとして書いてみた。

mappend は 両方の範囲を含む最小の範囲とした。左辺が右辺より大きくなる Range も作れてしまうが、両辺ともに mempty でない場合の mappend で正規化するようにした。（mempty をふくむ mappend でこれをやると Monoid law が成立しなくなる）

data Range a = NullRange | Range (a, a) deriving (Show, Read, Eq)

instance Ord a => Monoid (Range a) where
    mempty                        = NullRange
    NullRange `mappend` range     = range
    range     `mappend` NullRange = range
    range1    `mappend` range2    =
        let Range (l1, r1) = canonicalize range1
            Range (l2, r2) = canonicalize range2
        in  Range (min l1 l2, max r1 r2)
        where canonicalize (Range (l,r)) =
          Range (min l r, max l r)
GHCI に読ませてちょっと試してみる。 
ghci> mempty::Range Int
NullRange
ghci> Range (3, 6) `mappend` Range (4, 10)
Range (3,10)
ghci> mconcat [Range (2,8), NullRange, Range (13,5), Range (5,5)]
Range (2,13)
でさらに、Writer に Monoid の制約があるので、これと組み合わせて使ってみる。 
printRange :: (Ord a, Show a) => (Range a) ->WriterT (Range a) IO ()
printRange range = do
    tell range
    liftIO $ print range

main = runWriterT $ do
    printRange $ Range ('g', 'u')
    printRange $ Range ('l', 'r')
    printRange $ Range ('t', 'w')
printRange は、受け取った範囲を標準出力に書き出しながら、Writer にも出力する関数。これを連続的に実行すると、最終的に「ログ」の部分は全ての範囲を含む最小の範囲になる。 
ghci> :main
Range ('g','u')
Range ('l','r')
Range ('t','w')
((),Range ('g','w'))

◆ 雑感

Endo Monoid のところで、どうやら自己射／自己準同型というものに関係があるらしいと書いたけど、そもそも Monoid からして（もちろん Monad も）圏論周辺の数学用語らしいので、普通に Haskell を使う分には数学は不要とは言うけど、やっぱりある程度理解しておく必要はあるのかなと思う。
投稿者 時刻: 0 件のコメント:
ラベル:

2012年3月3日土曜日

Haskell で三目並べ (２)

前回のつづきで三目並べ。
マシン側の指し手の選択を、少しだけ知的にしてみる。

以前の記事で、ルール言語の Drools を使って、下記のようなルールで三目並べを書いた。
  1. 後一手で列が完成する盤面なら、その列を完成して終了。
  2. ユーザが後一手で一列完成できる盤面なら、それをブロックする。
  3. 後一手で二方向の王手が作れる盤面なら、それを作る。
  4. ユーザが後一手で二方向の王手が作れる盤面なら、ブロックする。
  5. 中央が空いていたら、そこに置く。
  6. 相手が角を取っていて対角が空いていたら、そこに置く。
  7. 角が空いていたらそこに置く。
  8. 空いているマスがあったら、そこに置く。
これを Haskell で書いてみたい。（参考wiki）

◆ 方針

前回の暫定実装した、マシンの指し手を選択する関数をこんな風に書き換えてみる。 
machinesTurn :: StateT Board IO Int
machinesTurn = do
    board <- get
    let idx = fromJust $ select board
    updateBoard Machine idx
    return idx
  where
    select = 
        findWinPos       <||>
        findBlockPos     <||>
        findForkPos      <||>
        findForkBlockPos <||>
        tryCenter        <||>
        findAnyBlank
    f1 <||> f2 = mplus <$> f1 <*> f2
select 以下に並べられた findWinPos から findAnyBlank までの関数は、盤面 Board を取って、指し手を Maybe Intとして返すもの。

これらの関数そのものを「(->) r」というタイプの Applicative とみなして合成する演算子を、<||> として定義した。MonadPlus としての Maybe の振る舞いを利用している。

結果として合成された select 関数は、ある関数に盤面を与えて、指し手が得られたらそれを返し、ダメなら次の関数に盤面を与えるという計算を数珠つなぎにしたものになる。 ※((->) r)を Functor や Applicative として扱う手法はこのあたりの記事に詳しい。Applicative 一般の入門としても、超絶わかりやすく解説されている。

◆ コード全体

findWinPos 〜 findAnyBlank の実装は以下のようなものになる（前回書いた部分も含めて全部晒してしまうことにした）。 
import Control.Monad.State
import Control.Applicative
import Data.List
import Data.Functor.Identity
import Control.Monad.List
import Data.Maybe
import qualified Data.List.Utils as LU
import System

data Mark = User|Machine|Blank deriving Eq
instance Show Mark where
  show User    = "U"
  show Machine = "M"
  show Blank   = " "

type Board = [Mark]

main :: IO ()
main = do
    args <- getArgs
    let machineFirst = 0 < length args && "m"==args!!0
    evalStateT (play machineFirst) initialBoard >>= putStrLn

initialBoard :: Board
initialBoard = take 9 $ repeat Blank

printBoard :: Board -> IO ()
printBoard board =
    putStrLn $ unlines $ LU.join ["-+-+-"] $ map showRow [0..2]
  where
    showRow row = [LU.join "|" $ map show $ cells row]
    cells   row = take 3 $ snd $ splitAt (row * 3) board

play :: Bool -> StateT Board IO String
play isMachinesTurn = do
    if isMachinesTurn then machinesTurn
                      else usersTurn
    board <- get
    liftIO $ printBoard board
    case judge board of
        Nothing     -> (play $ not isMachinesTurn)
        Just result -> return result

judge :: Board -> Maybe String
judge board
    | wonBy User board                 = return "won by user."
    | wonBy Machine board              = return "won by machine."
    | Nothing == elemIndex Blank board = return "drawn."
    | otherwise                        = Nothing

wonBy :: Mark -> Board -> Bool
wonBy mark board = any threeInRow rows
  where
    threeInRow indices = all (mark==) $ rowStates indices
    rowStates indices  = map (board!!) indices

rows :: [[Int]]
rows = [[0,3,6],[1,4,7],[2,5,8],
        [0,1,2],[3,4,5],[6,7,8],
        [0,4,8],[2,4,6]]

updateBoard :: Mark -> Int -> StateT Board IO ()
updateBoard mark pos = get >>= put.(update mark pos)

update :: Mark -> Int -> Board -> Board
update mark pos board =
    let (f, (x:xs)) = splitAt pos board in f ++ (mark:xs)

usersTurn :: StateT Board IO Int
usersTurn = do
    position <- liftIO getDigit
    board    <- get
    if Blank /= board!!position
        then (liftIO $putStrLn "wrong position") >> usersTurn
        else updateBoard User position >> return position
  where
    getDigit = do
        ch <- getChar
        putStrLn ""
        if elem ch ['0'..'8']
            then return (read [ch])
            else putStrLn "wrong input" >> getDigit

machinesTurn :: StateT Board IO Int
machinesTurn = do
    board <- get
    let idx = fromJust $ select board
    updateBoard Machine idx
    return idx
  where
    select =
      findWinPos       <||>
      findBlockPos     <||>
      findForkPos      <||>
      findForkBlockPos <||>
      tryCenter        <||>
      findAnyBlank
    f1 <||> f2 = mplus <$> f1 <*> f2

findWinPos :: Board -> Maybe Int
findWinPos   = findWinPos' Machine

findBlockPos :: Board -> Maybe Int
findBlockPos = findWinPos' User

findWinPos' :: Mark -> Board -> Maybe Int
findWinPos' mark board =
    ff ([mark, mark, Blank], 2) `mplus`
    ff ([mark, Blank, mark], 1) `mplus`
    ff ([Blank, mark, mark], 0)
  where
    ff (css, idx) = do findPattern css board >>= return.(!!idx)

findForkPos      :: Board -> Maybe Int
findForkPos      = findForkPos' Machine

findForkBlockPos :: Board -> Maybe Int
findForkBlockPos = findForkPos' User

findForkPos':: Mark -> Board -> Maybe Int
findForkPos' mark brd = do
    let posibles = elemIndices Blank brd
    idx <- findIndex (\pos->containsFork (update mark pos brd)) posibles
    return $ posibles!!idx
  where
    containsFork  b = (2<=) $ length $ findTwoInARow b
    findTwoInARow b = findIndices (matchTwoInARow b) rows
    matchTwoInARow b row =
        let stts = map (b!!) row
        in 2 == (countState mark stts) && 1 == (countState Blank stts)

findOppositeCorner :: Board -> Maybe Int
findOppositeCorner brd = do
    let pairs = [(0,8), (8,0), (2,6), (6,2)]
    r' <- findIndex (\(f,s)-> brd!!f==User && brd!!s==Blank) pairs
    return $ snd $ pairs!!r'

findBlankCorner :: Board -> Maybe Int
findBlankCorner = findBlankCell [0, 2, 8, 6]

findBlankCell   :: [Int] -> Board -> Maybe Int
findBlankCell candidate board =
    findIndex ((Blank==).(board!!)) candidate
    >>= return.(candidate!!)

findAnyBlank :: Board -> Maybe Int
findAnyBlank board = elemIndex Blank board

tryCenter     :: Board -> Maybe Int
tryCenter brd = if Blank == brd!!4 then Just 4 else Nothing

findPattern :: [Mark] -> Board -> Maybe [Int]
findPattern pattern board = do
    idx <- elemIndex pattern $ map (\row->map (\idx->board!!idx) row) rows
    return $ rows!!idx

countState :: Mark -> [Mark] -> Int
countState state cells = length $elemIndices state cells

◆ まとめ

  • 実は、上のアルゴリズムではユーザ先手で 0, 8, 6 と指すと、ユーザが勝ってしまう。三目並べはちゃんとやると引き分けになるんだけど、ちょっと手抜きをしている（ユーザのフォークをマシンが防ぐ辺り）。三目並べ自体が目的ではないので、割愛した。
  • 少し書いては直し、また書いては直しと常時リファクタしているが、コンパイルが通るだけで、感覚的には JUnit で 6割くらいのコード・カバレッジがあるくらいの安定感がある。この 150行弱のコードだと、デグレ的な事は一回も起きなかった。
  • 上で少し触れたサイト、「Learn You a Haskell for Great Good!」の、Functor 〜 Applicative 〜 Monado の解説(この順序で説明されている）が、ものすごくわかりやすくて感動。
投稿者 時刻: 0 件のコメント:
ラベル:

Haskell で三目並べ (1)

Haskell の Monad transformer が大体わかってきたので、State と IO を組み合わせる練習コードを書いてみる。題材として、三目並べ（Tic-Tac-Toe）を選んでみた。

こんな仕様でやってみる。
  • コンソールアプリとする
  • 実行時引数で"m"を渡したらマシン、でなければユーザの先手
  • 0から8の文字で位置を指定する（左上が0、Enter不要）。
  • 不正入力時、その旨表示して再入力を促す。
  • マシン／ユーザ双方の指し手の後に盤面を表示する。
  • 決着が着いたら、結果を表示する

====

◆ 盤面の表現

盤面は九つのマスから成り、それぞれ U(ユーザ)か M(マシン)か空のいずれかの状態 
data Mark = User|Machine|Blank deriving Eq
instance Show Mark where
  show User    = "U"
  show Machine = "M"
  show Blank   = " "

type Board = [Mark]

initialBoard :: Board
initialBoard = take 9 $ repeat Blank
下記のような関数で、盤面を文字列化してコンソールに表示できる。（LU は Data.List.Utilsのエイリアス） 
printBoard :: Board -> IO ()
printBoard board =
    putStrLn $ unlines $ LU.join ["-+-+-"] $ map showRow [0..2]
  where
    showRow row = [LU.join "|" $ map show $ cells row]
    cells   row = take 3 $ snd $ splitAt (row * 3) board
タテ、ヨコ、ナナメの列を表すためのインデクスの配列は以下のように書いた。計算で導出することもできるけど、却ってわかりにくかったの明示的な定数として書き直した。 
rows :: [[Int]]
rows = [[0,3,6],[1,4,7],[2,5,8],
        [0,1,2],[3,4,5],[6,7,8],
        [0,4,8],[2,4,6]]

◆ ゲームの流れの表現

main は、先手を判別してゲームを開始し、結果を表示する。 
main :: IO ()
main = do
    args <- getArgs
    let machineFirst = 0 < length args && "m"==args!!0
    evalStateT (play machineFirst) initialBoard >>= putStrLn

play が実際のゲームを進行する関数で、状態としての盤面を保持しながらユーザ入力を受け付けたりする。というわけで型としては State Board と IO を組み合わせた StateTになっている。

ユーザの指し手とマシンの指し手を交互に取得しながら、盤面の状態を更新・再表示した上で勝敗を判定。決着が着けばこれを結果とし、着かなければ play に再帰するという形になる。 
play :: Bool -> StateT Board IO String
play isMachinesTurn = do
    if isMachinesTurn then machinesTurn
                      else usersTurn
    board <- get
    liftIO $ printBoard board
    case judge board of
        Nothing     -> (play $ not isMachinesTurn)
        Just result -> return result

judge :: Board -> Maybe String
judge board
    | wonBy User board                 = return "won by user."
    | wonBy Machine board              = return "won by machine."
    | Nothing == elemIndex Blank board = return "drawn."
    | otherwise                        = Nothing

wonBy :: Mark -> Board -> Bool
wonBy mark board = any threeInRow rows
  where
    threeInRow indices = all (mark==) $ rowStates indices
    rowStates indices  = map (board!!) indices

◆ ユーザの指し手の取得

標準入力から一文字取得して、指し手を得る。既にマークのあるマスに置こうとしたり、0〜8以外のキーを押下するとエラー。問題なければ盤面を更新して、得られた指し手を結果とする。 
usersTurn :: StateT Board IO Int
usersTurn = do
    position <- liftIO getDigit
    board    <- get
    if Blank /= board!!position
        then (liftIO $putStrLn "wrong position") >> usersTurn
        else updateBoard User position >> return position
  where
    getDigit = do 
        ch <- getChar
        putStrLn ""
        if elem ch ['0'..'8']
            then return (read [ch])
            else putStrLn "wrong input" >> getDigit
盤面の更新はこんな関数を使う。update 関数は、後で 非Monad な文脈でも使えるように切り出した。 
updateBoard :: Mark -> Int -> StateT Board IO ()
updateBoard mark pos = get >>= put.(update mark pos)

update :: Mark -> Int -> Board -> Board
update mark pos board =
    let (f, (x:xs)) = splitAt pos board in f ++ (mark:xs)

◆ マシンの指し手の決定（暫定）

長くなってきたので、詳細は後で別に書くことにして、盤上左上から開いているマスを探して見つかり次第返すだけの暫定実装で、とりあえず動かしてみる。 
machinesTurn :: StateT Board IO Int
machinesTurn = do
    board <- get
    let idx = fromJust $ elemIndex Blank board
    updateBoard Machine idx
    return idx
ここまでのコードを、適切に import 文を追加した上で一個のファイルにまとめて、ghci に読ませると、プロンプトから下のように実行できる。 
ghci> :main
0
U| | 
-+-+-
 | | 
-+-+-
 | | 

U|M| 
-+-+-
 | | 
-+-+-
 | | 

4
U|M| 
-+-+-
 |U| 
-+-+-
 | | 

U|M|M
-+-+-
 |U| 
-+-+-
 | | 

8
U|M|M
-+-+-
 |U| 
-+-+-
 | |U

won by user.
ghci>

◆ ここまでのまとめ

まあ、マシン側の指し手が全く勝つ気も守る気もない暫定実装だけど、ここまででも一応、対話的に入力を受け付けながら状態を管理していくやり方が、だいたいわかった。もっと上達した後に見直したら、いろいろツッコミどころがあるんだろうけど、とりあえず先に進んでみる。
投稿者 時刻: 0 件のコメント:
ラベル:

2012年2月18日土曜日

手計算で 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")

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

投稿者 時刻: 0 件のコメント:
ラベル:

2012年1月7日土曜日

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 追記：シャッフルできるようにした
投稿者 時刻: 0 件のコメント:
ラベル:

2012年1月5日木曜日

s/UT/UnitTest/

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

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

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

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

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

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

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

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

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

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

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

投稿者 時刻: 0 件のコメント:
ラベル:

2012年1月1日日曜日

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>

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

投稿者 時刻: 0 件のコメント:
ラベル: