merge sort

Gistが貼っ付けられるかテスト

functor適用するときtypeに直接record型を定義すると怒られる件

↑のpostで引っかかったので単純な形にして確認してみた。

• functor.ml (functorの定義)

komamitsu@carrot:~/lab/ocaml$ cat functor.ml
module type HogeType = sig
  type t
  val string_of_t : t -> string
end

module Make(Hoge : HogeType) = struct
  let print_t t = print_endline (Hoge.string_of_t t)
end

• functorSample.ml (functor適用)

module RecordSample = Functor.Make(
  struct
    type t = {x:int}
    let string_of_t t = string_of_int t.x
  end
)

let _ =
  RecordSample.print_t {x=4321}

これをコンパイルすると...

komamitsu@carrot:~/lab/ocaml$ ocamlc -o functorSample functor.ml functorSample.ml
File "functorSample.ml", line 1, characters 22-115:
Error: This functor has type
       functor (Hoge : Functor.HogeType) ->
         sig val print_t : Hoge.t -> unit end
       The parameter cannot be eliminated in the result type.
        Please bind the argument to a module identifier.

と怒られてしまう。

type tt = {x:int}
module RecordSample = Functor.Make(
  struct
    type t = tt
        :

とするとOK... 不思議だ...

2011-12-18 11:07 追記id:osiireさんからのコメントで気がついたけれど、functorSample.mlを以下のようにして、scope外で使わないようにしても同じエラーが出る...

module RecordSample = Functor.Make(
  struct
    type t = {x:int}
    let string_of_t t = string_of_int t.x
  end
)

A* search algorithm用のモジュールを書いてみた

仕事ではOCamlもA* search algorithmも全く使っていないのですが、自宅で気分転換/リハビリがてら何か書こうとすると、すぐOCamlでA* search algorithmを書いてしまいます。たまにダイクストラ法で何かgraphを探索するやつも書きます。毎回同じようなものを書くのは面倒なのでコア部分だけモジュール化してみました。A*はDijkstra法の拡張みたいなもんなのでそのままつかえそうですし。

astar.ml

module type RouteType = sig
  type pos
  type cost
  val add_cost: cost -> cost -> cost
  val cost_to_move : pos -> pos -> cost
  val compare_cost : cost -> cost -> int
  val heuristic : pos -> cost
  val next_routes : pos -> pos list
end

module Make(Route:RouteType) : sig
  val run : Route.pos -> Route.pos -> Route.cost ->
            (Route.pos * Route.pos option * Route.cost) list
end = struct
  type node = {pos:Route.pos; cost:Route.cost; score:Route.cost; prev:Route.pos option}

  let score prev now_pos =
    (Route.add_cost
      (Route.add_cost prev.cost (Route.cost_to_move prev.pos now_pos))
      (Route.heuristic now_pos)
    )

  let remove_minimum_score_node nodeset =
    let (minimum_opt, resultset) =
      List.fold_left
        (fun (candidate_opt, resultset) node ->
          match candidate_opt with
          | None -> (Some node, resultset)
          | Some candidate when Route.compare_cost candidate.score node.score > 0 ->
                 (Some node, candidate::resultset)
          | _ -> (candidate_opt, node::resultset)
        ) (None, []) nodeset
    in
    match minimum_opt with
    | None -> failwith "empty nodeset?"
    | Some minimum -> (minimum, resultset)

  let find_same_pos nodeset pos =
    List.fold_left
      (fun (found_node_opt, resultset) node ->
        if node.pos = pos then (Some node, resultset)
        else (found_node_opt, node::resultset)
      ) (None, []) nodeset

  let create_node pos score prev_node =
    { pos=pos;
      cost=Route.add_cost prev_node.cost (Route.cost_to_move prev_node.pos pos);
      score=score;
      prev=Some prev_node.pos }

  let sort closeset goal =
    let rec _sort prev sorted =
      let node = List.find (fun node -> node.pos = prev) closeset in
      let sorted = node::sorted in
      match node.prev with
      | Some prev -> _sort prev sorted 
      | None -> sorted
    in
    _sort goal []

  let result_of_node xs =
    List.map (fun x -> (x.pos, x.prev, x.cost)) xs

  let run start goal init_cost =
    let rec _run openset closeset =
      let (node, openset) = remove_minimum_score_node openset in
      let closeset = node::closeset in 
      if node.pos = goal then result_of_node (sort closeset goal)
      else (
        let openset =
          List.fold_left
            (fun openset next_pos ->   
              let score_of_next_pos = score node next_pos in
              match find_same_pos openset next_pos with
              (* check the same pos in openset *)
              | (None, openset) -> (   
                (* if none, check the same pos in closeset *)
                match find_same_pos closeset next_pos with
                | (None, closeset) ->  
                    (create_node next_pos score_of_next_pos node)::openset
                | (Some same_pos_node, closeset) when same_pos_node.score > score_of_next_pos ->
                      (create_node next_pos score_of_next_pos node)::openset
                | (_, closeset) -> openset
              )
              | (Some same_pos_node, openset) when same_pos_node.score > score_of_next_pos ->
                    (create_node next_pos score_of_next_pos node)::openset
              | (_, openset) -> openset
            ) openset (Route.next_routes node.pos)
        in
        _run openset closeset
      )
    in
    let start_node = {pos=start; cost=init_cost; score=Route.heuristic start; prev=None} in
    _run [start_node] []
  end

posは経路の位置、costは移動コストや評価値を表現できる型です。heuristicは当該位置から終点までのコスト、next_routesは当該位置から移動可能な位置を返す関数です。

このFunctorを用いてDijkstra法っぽいサンプルを解く場合は以下のような感じになります。
dijkstraSample.ml

type t = S | A | B | C | D | E | G

let routes =
  [
    (S, A, 3);
    (S, B, 10);
    (S, C, 12);
    (A, D, 10);
    (A, B, 2);
    (B, C, 3);
    (B, E, 7);
    (C, E, 3);
    (D, E, 1);
    (D, G, 3);
    (E, D, 1);
    (E, G, 5);
  ]

let string_of_point = function
    | S -> "S"
    | A -> "A"
    | B -> "B"
    | C -> "C"
    | D -> "D"
    | E -> "E"
    | G -> "G"

module GraphAstar =
  Astar.Make(
    struct
      type pos = t
      type cost = int

      let heuristic pos = 0

      let add_cost a b = a + b
      let cost_to_move prev_pos now_pos =
        let cost_opt =
          List.fold_left
            (fun candidate (src, dst, cost) ->
              if src = prev_pos && dst = now_pos
              then Some cost
              else candidate
            ) None routes in
        match cost_opt with None -> failwith "not found" | Some cost -> cost

      let compare_cost a b = compare a b

        let next_routes current =
          List.fold_left
            (fun next_points (src, dst, cost) ->
              if src = current
              then dst::next_points
              else next_points
            ) [] routes
    end
  )

let _ =
  let resultset = GraphAstar.run S G 0 in
  List.iter
    (fun (src, _, cost) ->
      Printf.printf "pos=%s, cost=%s\n"
        (string_of_point src)
        (string_of_int cost)
    ) resultset

実行させるとこう。

komamitsu@carrot:~/git/ocaml-libastar$ ocamlc -o dijkstraSample astar.ml dijkstraSample.ml
komamitsu@carrot:~/git/ocaml-libastar$ ./dijkstraSample 
pos=S, cost=0
pos=A, cost=3
pos=B, cost=5
pos=C, cost=8
pos=E, cost=11
pos=D, cost=12
pos=G, cost=15

A*向けっぽいサンプルの場合はこう。

let maze = [
  "S                #   ";
  "   ##  ####      # # ";
  " #  #  #  # ###### # ";
  " ####     #        # ";
  "     #     #    #### ";
  " ##### ########    # ";
  "              ##   # ";
  " ###########   ##### ";
  " #           ##      ";
  "## ###########  #####";
  "                    G";
  ]
let elm_in_maze x y = String.get (List.nth maze y) x

type position = {x:int; y:int}
let len_x = String.length (List.nth maze 0)
let len_y = List.length maze
let start = {x=0; y=0}
let goal = {x=len_x - 1; y=len_y - 1}

let string_of_pos pos = Printf.sprintf "(%d, %d)" pos.x pos.y
let string_of_cost = string_of_float

module MazeAstar= Astar.Make(
  struct
    type pos = position
    type cost = float

    let heuristic pos =
      sqrt (
        (float_of_int (goal.x - pos.x)) ** 2.0 +.
        (float_of_int (goal.y - pos.y)) ** 2.0
      )

    let add_cost a b = a +. b
    let cost_to_move prev_pos now_pos = 1.0
    let compare_cost a b = compare a b 

    let add_cost a b = a +. b
    let cost_to_move prev_pos now_pos = 1.0
    let compare_cost a b = compare a b 

    let next_routes current =
      List.fold_left
        (fun next_points (dx, dy) ->   
          let (x, y) = (current.x - dx, current.y - dy) in
          if x >= 0 && y >= 0 && x < len_x && y < len_y &&
            elm_in_maze x y != '#'
          then {x=x; y=y}::next_points 
          else next_points
        )
        [] [(0, -1); (0, 1); (-1, 0); (1, 0)]
  end
)

let _ =
  let resultset = MazeAstar.run start goal 0.0 in
  List.iter
    (fun ({x=x; y=y}, prev, cost) ->   
      String.set (List.nth maze y) x '.';
    ) resultset;
  List.iter (fun row -> print_endline row) maze

実行させるとこう。

komamitsu@carrot:~/git/ocaml-libastar$ ocamlc -o astarSample astar.ml astarSample.ml 
komamitsu@carrot:~/git/ocaml-libastar$ ./astarSample 
............     #...
   ##  ####.     #.#.
 #  #  #  #.######.#.
 ####     #........#.
     #     #    ####.
 ##### ########    #.
              ##   #.
 ###########   #####.
 #           ##......
## ########### .#####
               ......

まぁ、書いてみたものの自分で使うことは無さそうだなぁ...

https://github.com/komamitsu/ocaml-libastar

初Lwtでecho server

書いた。
https://gist.github.com/1362149

これ↓を参考に
https://github.com/avsm/ocaml-cohttpserver/blob/master/server/http_tcp_server.ml
適当に書き始めたのだけど、途中で「やばい徹底的にmonadicに書かないと動かないというかコンパイル通らない」と気がつき方向転換して何とか動いたのでした.

Lwt.pickがいいなぁとおもいました。

x86_64環境でのocaml-mysqlが上手く動かなかった件

先日から、AWS EC2上にFree usage tierのインスタンスを作って、CPU使うようなことはそちらで行おうとしています。まぁきっかけは節電なんですが、もともとEC2に興味があったので。

それはさておき、動かそうとしているのはMySQLをstorageとしたOCamlのプログラムなんですが、ocaml-mysqlライブラリをビルドして動かそうとしたらはまったのでメモを。

まず、./configureの結果なんですけども。

configure: checking libraries...
configure: checking for MySQL library...
checking for mysql_real_connect in -lmysqlclient... no
configure: checking in more locations...
checking for mysql_real_connect in -lmysqlclient... no

最初は気がつかなくって、見返してみたらnoのまま突き進んでいるという、ちゃんとエラーで止めてほしい系です。

でも、ldconfig -p でもlibmysqlclientは見えているので、変だなぁと。

で、そのままmakeすると-lmysqlclientを付けずにocaml-mysqlをbuildしてしまいます。

このまま、自分のプログラムをコンパイルすると

/home/ec2-user/arch/ocaml-mysql-1.1.0/mysql_stubs.c:199: undefined reference to `mysql_real_connect'

とか怒られまくります。

なので、ocaml-mysqlのmakeの際、Makefileに以下の一行を追加してやって解決。

LDFLAGS=-L/usr/lib64/mysql -lmysqlclient

りはびり（Ordシグネチャーとファンクターを使って独自のTreeモジュールを作る）

久しぶりにOCamlでも書いてみようかと思ったら、全然書けなくなっていたのでリハビリをすることに。

お題は @osiire さんの
http://d.hatena.ne.jp/osiire/20101101
のレベル3。

といってもこれまでの経験上、最初の「Ordシグネチャーとファンクターを使って独自のTreeモジュールを作る」っぽいことしかやったことがないので、実はリハビリと称してやったことがないことに挑戦させる作戦。

まぁ、ファンクタの記法どころかシグネチャの書き方さえ忘れているので、まずは本当にリハビリ。Set.mlのコードとかをカンニングしつつ。

module type OrderedType = sig
  type t
  val compare : t -> t -> int
end

module MakeTree (Ord : OrderedType) = struct
  type t = Lf | Br of t * Ord.t * t

  let init () = Lf

  let rec add tree x =
    match tree with
    | Lf -> Br (Lf, x, Lf)
    | Br (left, v, right) ->
        if Ord.compare x v < 0
        then Br ((add left x), v, right)
        else Br (left, v, (add right x))

  let tree_of_list l =
    List.fold_left (fun a x -> add a x) (init ()) l

  let list_of_tree tree =
    let rec loop tree l =
      match tree with
      | Lf -> l
      | Br (left, v, right) ->
          loop right ((loop left l) @ [v])
    in
    loop tree []
end

module IntTree =
  MakeTree (
    struct
      type t = int
      let compare a b = a - b
    end
  )

module FloatTree =
  MakeTree (
    struct
      type t = float
      let compare a b =
        if a = b then 0 else (if a < b then -1 else 1)
    end
  )

let _ =
  let int_tree =
    IntTree.tree_of_list [8; 2; 6; 1; 9; 3; 7; 4; 5] in
  List.iter (fun x -> Printf.printf "%d " x)
    (IntTree.list_of_tree int_tree);
  print_newline ()

let _ =
  let float_tree =
    FloatTree.tree_of_list [1.0; 3.5; 1.5; 4.0; 0.5; 2.5; 2.0; 3.0] in
  List.iter (fun x -> Printf.printf "%f " x)
    (FloatTree.list_of_tree float_tree);
  print_newline ()

でけたようにみえる。

komamitsu@onion:~/lab/ocaml/tree$ ocaml tree.ml 
1 2 3 4 5 6 7 8 9 
0.500000 1.000000 1.500000 2.000000 2.500000 3.000000 3.500000 4.000000 

オセロゲームを作ってみた

http://bitbucket.org/komamitsu/misc/src/tip/ocaml-reversi/

作ってみようかと思ったのは、ふと「ちゃんとゲーム木を実装したことが無いなぁ、特にαβカット周りは全然やったことない」と思ったからなのです。

できれば、min-maxの部分を切り分けておいてオセロ以外にも使えるといいなぁ、と考えていたのですが、恐らく放置されるような気がしています。

あと、オセロでどうすれば強い思考ルーチンになるか、あまり興味がなかったのでポカミスが多い、ぼんやりした子になっています。

最初はRubyで書き始めてみたのですが、想定していなかったデータ状態に陥る→修正→少し進んで別の想定していなかった状態に陥る、というループが回ってしまったので、ここはいっちょ型に定評のあるOCamlで実装してみようかと思いました。

実装している途中で気がついたのですが、行き当たりばったりで型を定義していると、とっても見通しの悪いコードになってしまうので、ちゃんと型の設計をすべきだなぁ、と。まぁ、結局見通しの悪いコードのままだったりしますけども。

とはいえ、そもそも型の正しい設計方法って良くわからないので道は遠いなあと思いました。多分、最初の3日間はtype宣言以外のコードは禁止されているのではないか、とか勝手に推測。