Report.ml

August 8, 2013

Содержание

Структура для представления результата тестирования стратегий (отчёта). Загрузка данных из файлов.

1 Интерфейс

  (* file: report.mli *)

  (* Виды операций в отчёте
     -------------------------------------------------------------------------- *)

  type op =
    [ `Buy | `Sell | `Close | `SL | `TP | `CloseAtStop | `Modify ]


  val op_to_string: op -> string
    (** Получение строкового представления операции. *)

  val op_of_string: string -> op
    (** Распознавание операции из строкового представления. *)


  (* Отчёт
     -------------------------------------------------------------------------- *)

  type row =
    {
      time: CalendarLib.Calendar.t;
      op: op;
      order_id: int;
      asset: string;
      size: float;
      price: float;
      profit: float option;
      balance: float option;
    }

  type t = row list


  val read_rm_csv: filename: string -> t
    (** Загрузка отчёта из .csv файла, выдаваемого ReportManager. *)

  val read_mt_html: filename: string -> asset: string -> t
    (** Загрузка отчёта из .html файла, выдаваемого механизмом тестирования
        стратегий, встроенным в MetaTrader. *)

2 Реализация

  (* file: report.ml *)

  open CalendarLib
  open Nethtml


  (* Утилиты
     -------------------------------------------------------------------------- *)

  let parse_time s : Calendar.t =
    Printer.Calendar.from_fstring "%Y.%m.%d %T" (s ^ ":00")

  let maybe_float s =
    try
      Some (float_of_string s)
    with _ ->
      None


  (* Виды операций в отчёте
     -------------------------------------------------------------------------- *)

  type op =
    [ `Buy | `Sell | `Close | `SL | `TP | `CloseAtStop | `Modify ]

  let op_of_string = function
    | "buy" -> `Buy
    | "sell" -> `Sell
    | "close" -> `Close
    | "close at stop" -> `CloseAtStop
    | "s/l" -> `SL
    | "t/p" -> `TP
    | "modify" -> `Modify
    | op ->
        failwith (Printf.sprintf "Unknown op: %s" op)

  let op_to_string = function
    | `Buy -> "buy"
    | `Sell -> "sell"
    | `Close -> "close"
    | `CloseAtStop -> "close at stop"
    | `SL -> "s/l"
    | `TP -> "t/p"
    | `Modify -> "modify"


  (* Отчёт
     -------------------------------------------------------------------------- *)

  type row =
    {
      time: Calendar.t;
      op: op;
      order_id: int;
      asset: string;
      size: float;
      price: float;
      profit: float option;
      balance: float option;
    }

  type t = row list


  <<read_rm_csv>>
  <<read_mt_html>>

2.1 Загрузка отчёта ReportManager

Пояснения:

  1. У отчёта есть заголовок (header), который следует пропустить.
  2. Поля profit и balance могут быть пусты.
  (* ref: read_rm_csv *)

  type csv = string list list

  let read_csv (ch: in_channel) : csv =
    let lines = ref [] in
    try
      while true do
        let line = input_line ch in
        lines := String.split_on_char ',' line :: !lines
      done;
      assert false
    with End_of_file ->
      List.rev !lines

  let read_rm_csv ~filename : t =
    let data = Misc.with_open_in filename read_csv in
    match data with
      | [] ->
          failwith "read_rm_csv: Invalid CSV"
      | header :: rows ->
          rows |> List.map (function
            | [ _; time; op; oid; size; price; profit; balance; symbol ] ->
                {
                  time = parse_time time;
                  op = op_of_string op;
                  order_id = int_of_string oid;
                  asset = symbol;
                  size = float_of_string size;
                  price = float_of_string price;
                  profit = maybe_float profit;
                  balance = maybe_float balance;
                }
            | _ ->
                failwith "read_rm_csv: Invalid row data")

2.2 Загрузка отчёта MetaTrader

Парсим HTML в дерево и собираем строки таблицы, обходя документ в глубину. Первая строка нужной таблицы – заголовок, который следует пропустить.

  (* ref: read_mt_html *)

    (* ref: collect_rows *)
  
    (* Обход документа в глубину, с посещением всех узлов *)
    let rec iter_elements f (d: Nethtml.document) =
      match d with
        | Element ((_, _, children) as el) ->
            f el; children |> List.iter (iter_elements f)
        | _ -> ()
  
    let read_cell (d: Nethtml.document) : string =
      match d with
        | Element ("td", _, [ Data s ]) -> s
        | _ -> ""
  
    let collect_rows (html: Nethtml.document list) : (string list) list =
      Misc.collect (fun push ->
        html |> List.iter (iter_elements (function
          | ("tr", attrs, children) ->
              if (List.assoc_opt "align" attrs) = Some "right" then
                push (children |> List.map read_cell)
          | _ -> ())))
    (* ref: scan_row *)
  
    let scan_row asset row : row =
      let row' = if List.length row > 9 then row else row @ [ "" ] in
      match row' with
        | [ _; time; op; oid; size; price; _; _; profit; balance ] ->
            {
              time = parse_time time;
              op = op_of_string op;
              order_id = int_of_string oid;
              asset = asset;
              size = float_of_string size;
              price = float_of_string price;
              profit = maybe_float profit;
              balance = maybe_float balance;
            }
        | _ ->
            failwith "read_mt_html: Invalid row data"

  let read_mt_html ~filename ~asset : t =
    let s = Misc.read_file_contents filename in
    new Netchannels.input_string s
    |> Nethtml.parse
    |> collect_rows
    |> List.tl (* Отбрасывание заголовка *)
    |> List.map (scan_row asset)

Интересные нам данные находятся в строках <tr align=right> ... </tr>. Ищем эти строки (collect_rows) и выдираем данные из ячеек таблицы (read_cell):

  (* ref: collect_rows *)

  (* Обход документа в глубину, с посещением всех узлов *)
  let rec iter_elements f (d: Nethtml.document) =
    match d with
      | Element ((_, _, children) as el) ->
          f el; children |> List.iter (iter_elements f)
      | _ -> ()

  let read_cell (d: Nethtml.document) : string =
    match d with
      | Element ("td", _, [ Data s ]) -> s
      | _ -> ""

  let collect_rows (html: Nethtml.document list) : (string list) list =
    Misc.collect (fun push ->
      html |> List.iter (iter_elements (function
        | ("tr", attrs, children) ->
            if (List.assoc_opt "align" attrs) = Some "right" then
              push (children |> List.map read_cell)
        | _ -> ())))

Поля profit и balance могут быть пусты; при этом количество ячеек строки таблицы (<td>) уменьшается на одну (а не на две):

  (* ref: scan_row *)

  let scan_row asset row : row =
    let row' = if List.length row > 9 then row else row @ [ "" ] in
    match row' with
      | [ _; time; op; oid; size; price; _; _; profit; balance ] ->
          {
            time = parse_time time;
            op = op_of_string op;
            order_id = int_of_string oid;
            asset = asset;
            size = float_of_string size;
            price = float_of_string price;
            profit = maybe_float profit;
            balance = maybe_float balance;
          }
      | _ ->
          failwith "read_mt_html: Invalid row data"
comments powered by Disqus