Структура для представления результата тестирования стратегий (отчёта). Загрузка данных из файлов.
(* 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. *)
(* 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>>
Пояснения:
header), который следует пропустить.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")
Парсим 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"