(* oanda_show_candles.ml *)
open Lwt
open Cohttp
open Cohttp_lwt_unix

let api_token = "MY_TOKEN"

let base_url = "https://api-fxpractice.oanda.com/v1"

let rec write_to_stdout (body : string Lwt_stream.t) : unit Lwt.t =
  Lwt_stream.get body >>= fun stropt ->
  match stropt with
  | None -> return ()
  | Some str ->
     Lwt_io.write Lwt_io.stdout str >>= fun () ->
     write_to_stdout body

let candles (instrument : string) : unit Lwt.t =
  Client.get (Uri.add_query_params (Uri.of_string (base_url ^ "/candles"))
                                   [("instrument", [instrument]);
                                    ("count", ["5000"]);
                                    ("granularity", ["H1"])
             ])
             ~headers:(Header.of_list [("Authorization", "Bearer " ^ api_token);
                                       ("X-Accept-Datetime-Format", "UNIX");
                                       ("Content-Type", "x-www-form-urlencoded");
                                       ("Accept-Encoding", "gzip, deflate")])
  >>= fun (resp, body) ->
  let status = Response.status resp in
  if (Code.code_of_status status) <> 200
  then Cohttp_lwt_body.to_string body >>= fun (b) ->
       fail_with (Code.string_of_status status ^ "\n" ^ b)
  else write_to_stdout (Cohttp_lwt_body.to_stream body)

let () =
  catch (fun () -> candles "USD_JPY")
        (function
         | Failure msg -> print_endline msg; return ()
         | _ -> print_endline "unknown error"; return ())
  |> Lwt_main.run

(* oanda_candle_chart.ml *)
open Yojson.Basic.Util
open Gnuplot

type json = Yojson.Basic.json

let candles : json list =
  let json = Yojson.Basic.from_file "candles.json" in
  json |> member "candles" |> to_list

let avg_bid_of_candle (candle : json) : float =
  let highBid = candle |> member "highBid" |> to_number in
  let lowBid = candle |> member "lowBid" |> to_number in
  (highBid +. lowBid) /. 2.

let avg_ask_of_candle (candle : json) : float =
  let highAsk = candle |> member "highAsk" |> to_number in
  let lowAsk = candle |> member "lowAsk" |> to_number in
  (highAsk +. lowAsk) /. 2.

let time_of_candle (candle : json) : float =
  candle |> member "time" |> to_string |> float_of_string

let () =
  let bid_xys = BatList.map (fun c -> (time_of_candle c, avg_bid_of_candle c)) candles in
  let ask_xys = BatList.map (fun c -> (time_of_candle c, avg_ask_of_candle c)) candles in
  let gp = Gp.create () in
  Gp.plot_many gp
               [ Series.lines_xy bid_xys ~title:"Bid" ~color:`Blue
               ; Series.lines_xy ask_xys ~title:"Ask" ~color:`Red ];
  Gp.close gp

module P = Perceptron (struct
                        let dim = 8
                        let eta = 1.
                      end)

open Yojson.Basic.Util

type json = Yojson.Basic.json

let candle_to_point (candle : json) : vec =
  Vec.of_list [
      candle |> member "openBid" |> to_number;
      candle |> member "openAsk" |> to_number;
      candle |> member "highBid" |> to_number;
      candle |> member "highAsk" |> to_number;
      candle |> member "lowBid" |> to_number;
      candle |> member "lowAsk" |> to_number;
      candle |> member "closeBid" |> to_number;
      candle |> member "closeAsk" |> to_number
    ]

let candles =
  let json = Yojson.Basic.from_file "candles.json" in
  json |> member "candles" |> to_list

(* candlesのうち、最後の1つを除いたものを、パーセプトロンで分類できるベクトルにしたもの *)
let points = BatList.map candle_to_point (candles |> BatList.rev |> BatList.tl |> BatList.rev)

let categories_of_candles (candles : json list) : float list =
  let diff candle next =
    let lowAsk1 = candle |> member "lowAsk" |> to_number in
    let highAsk1 = candle |> member "highAsk" |> to_number in
    let highBid2 = next |> member "highBid" |> to_number in
    if (highBid2 -. (lowAsk1 +. highAsk1) /. 2.) > 0. then 1. else -1. in
  BatList.map2 diff
               (candles |> BatList.rev |> BatList.tl |> BatList.rev)
               (BatList.tl candles)
let categories = categories_of_candles candles

let training_points, production_points = BatList.split_at 4000 points
let training_categories, production_categories = BatList.split_at 4000 categories

let w = P.initial_hyp ()

let epoch (h : P.hyp) (ps : vec list) (cs : float list) : int * int =
  let round (ok, ng) point category =
    let category' = P.evaluate h point in
    P.round h point category;
    if category *. category' <= 0.
    then (ok, ng + 1)
    else (ok + 1, ng) in
  BatList.fold_left2 round (0, 0) ps cs

# let _ = epoch w training_points training_categories;;
- : int * int = (2758, 1242)

let rec times n action res =
  if n < 0 then failwith "n < 0!"
  else if n = 0 then res
  else let res' = action () in times (n - 1) action res'

# let _ = times 10000 (fun () -> epoch w training_points training_categories) (0, 0);;
- : int * int = (2863, 1137)
# let _ = times 10000 (fun () -> epoch w training_points training_categories) (0, 0);;
- : int * int = (2954, 1046)

let precision =
  let (n, m) = BatList.fold_left2
                 (fun (n, m) candle cat ->
                   let cat' = P.evaluate w candle in
                   if cat > 0. && cat' > 0. then (n + 1, m + 1)
                   else if cat' > 0. then (n, m + 1)
                   else (n, m))
                 (0, 0) test_points test_categories in
  float_of_int n /. float_of_int m

# precision;;
- : float = 0.877344877344877316

# BatList.fold_left (fun n x -> if P.evaluate w x > 0. then (n + 1) else n) 0 test_points;;
- : int = 693