fork download
copy 
  1. type request = string * string * string (* リクエスト. 銘柄id,期間from,期間toの三つ組 *)
  2. ;;
  3. let code (c,_,_) = c
  4.  
  5. type quote = { price:int; } (* 銘柄の値段．実際には、他にも多くの情報が含まれている *)
  6. ;;
  7.  
  8. type response = {
  9.     req: request; (* どのリクエストに対するレスポンスか *)
  10.     body: quote; (* レスポンスの内容 *)
  11.     seq:int; (* レスポンス中、何番目のメッセージか *)
  12.     total:int; (* 応答メッセージの総数 *)
  13.   }
  14. ;;
  15.  
  16. (* 受信途中のレスポンスのバッファを次の連想テーブル(Map)で構成する。
  17.    OCamlのMapは、キーの型と比較関数をMap.Makeに渡せば得られる *)
  18. module M = Map.Make (
  19.     struct 
  20.       type t = request (* リクエスト型をキーとして *)
  21.       let compare = Pervasives.compare (* 何か適当に比較してもらう *)
  22.     end)
  23. ;;
  24.  
  25. (* レスポンスを保持するバッファ。 一息で書いたのでやたら複雑な型だが、
  26.    リクエストをキー(上記)として、受信途中のレスポンスをペア (int * quote option array) で保持する。
  27.    このペアは (受信済みメッセージ数, 銘柄データの配列) という意味だ。
  28.    - 未受信のメッセージをNoneで埋めておきたいがため option 型の配列になっている。
  29.    - 同じキーをもつ複数のレスポンスを同時に扱う格納するため、リストにしてある。
  30.    - グローバル変数なのは醜いけれど、クロージャに入れればすぐになんとかなる
  31. *)
  32. let buf : (int * quote option array) list M.t ref = ref M.empty
  33. ;;
  34.  
  35. (* 株価のリストをデータベースに保存する. ダミーで画面への出力関数にしてある *)
  36. let save (code:string) (quotes:quote option list) : unit = 
  37.   print_string (code ^ " ");
  38.   List.iter begin function
  39.   | Some q -> Printf.printf "%d;" q.price
  40.   | None -> failwith "impossible"
  41.   end quotes;
  42.   print_newline ()
  43. ;;
  44.  
  45. (*
  46.    メッセージrをバッファに格納する。 レスポンス全体が得られたら、saveで保存する。
  47. *)
  48. let receive_quote (r:response) : unit  =
  49.   if r.total=1 then save (code r.req) [Some r.body] (* 総レコードが1件のみであればすぐに保存 *) 
  50.   else begin
  51.     let map = !buf in
  52.     (* このリクエストに対するレスポンスのリスト(更新前) *)
  53.     let all = try M.find r.req map with Not_found -> [] in
  54.  
  55.     (* バッファに新しいレスポンスを追加 *)
  56.     let newentry () =
  57.       let arr = Array.make r.total None in (* レスポンス全体をNoneで初期化 *)
  58.       arr.(r.seq) <- Some r.body;
  59.       buf := M.add r.req ((1, arr)::all) map (* 1つ受信しましたよとバッファを更新 *)
  60.     in
  61.  
  62.     (* レスポンスのリストを走査し適切な位置に格納 / レスポンス全体が満たされたら保存 *)
  63.     let rec addentry rest = function
  64.       | [] -> newentry () (* 受信ずみレスポンスなし. 新しいレスポンスを追加する *)
  65.       | (cnt, arr) as y::ys -> (* 受信ずみレスポンスあり *)
  66.         match arr.(r.seq) with (* 当該の連番は受信済みか *)
  67.         | None ->
  68.             arr.(r.seq) <- Some r.body; (* レスポンスの該当する連番を満たす *)
  69.             if cnt+1=r.total then begin
  70.               (* レスポンス全体が満たされた. 保存後、この配列をバッファから除く *)
  71.               save (code r.req) (Array.to_list arr) (* 保存 *);
  72.               buf := M.add r.req (List.rev_append rest ys) map (* yの削除によりバッファを更新 *)
  73.             end else
  74.               (* また足りない．受信済み数をインクリメントしバッファを更新 *)
  75.               buf := M.add r.req (List.rev_append rest ((cnt+1, arr)::ys)) map
  76.         | Some q -> (* このレスポンスでは格納済み. 次のレスポンスを見る *) 
  77.             addentry (y::rest) ys
  78.     in 
  79.     addentry [] all
  80.   end
  81. ;;
  82.  
  83.  
  84. let test = 
  85.   let a="A","1","4" and b = "B","1","2" in
  86.   let resps = [
  87.    {req=a; body={price=1100}; total=4; seq=0};
  88.    {req=a; body={price=1098}; total=4; seq=1};
  89.    {req=a; body={price=1100}; total=4; seq=0};
  90.    {req=b; body={price=910}; total=2; seq=0};
  91.    {req=a; body={price=1098}; total=4; seq=1};
  92.    {req=a; body={price=1081}; total=4; seq=2};
  93.    {req=a; body={price=1081}; total=4; seq=2};
  94.    {req=a; body={price=1120}; total=4; seq=3};
  95.    {req=b; body={price=940}; total=2; seq=1};
  96.    {req=a; body={price=1120}; total=4; seq=3};
  97.   ] in
  98.   List.iter receive_quote resps
  99.  
Success #stdin #stdout 0.01s 2736KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
A 1100;1098;1081;1120;
B 910;940;
A 1100;1098;1081;1120;
https://ideone.com/6tUYa
language:
OCaml (ocamlopt 4.05.0)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!