(* 
  fxengine
    A high fast foreign exchange arbitrage transaction calculator.
  Author: Mike Siley
  Copyright 2004 all rights reserved.

  TODO:
  change floats to ints and mult by 100000 then convert back
    for more effecient and accurate transactions.
  setup a test spreadsheet.

*)

open Printf;;
open Hashtbl;;
open Str;;

(*
    Utility functions
*)

(* print_array array string -> () *)
let print_array lst = 
    Array.iter (printf "%s ") lst; 
    print_newline ()
;;

(* print_table array list string -> () *)
let print_table tbl = 
    List.iter print_array tbl
;;


(*
    Permutation functions for 
    creating a table of all possible transactions

    Algorithm credited to Hugo Steinhaus (January 1887-February 1972)
    see http://web.usna.navy.mil/~wdj/book/node156.html for details.
*)

(* insert a' -> int -> array -> array *)
let insert v n a = 
    let len = (Array.length a) in
    let new_a = Array.make (len+1) "" in
    let i = ref 0 in
        for j=0 to len do
            begin
            if j = n then new_a.(j) <- v
            else          
                begin
                new_a.(j) <- a.(!i);
                i := !i + 1
                end
            end    
        done;
        new_a
;;

(* expand list array -> list array *)
let expand tbl = 
    let n = (Array.length (List.nth tbl 0)) in 
    let ncopy a = 
        let lst = ref [] in
        for i=0 to n do
            lst := (Array.copy a)::!lst
        done;
        !lst
    in
      List.concat ((List.map ncopy) tbl) 
;;
 
(* weave 'a -> list array -> list array *)
let weave v tbl = 
    let len = (Array.length (List.nth tbl 0))+1 in
    let idx = ref 0 in
    List.map (fun a ->
                  let na = insert v (!idx) a in
                      idx := !idx + 1;
                      if !idx = len then idx := 0 else ();
                na
             ) tbl
;;

(* permute_step 'a -> list array -> list array *)
let permute_step v tbl = weave v (expand tbl);;

(* permute list string -> list array *)
let permute lst = 
    let tbl = ref [[||]] in 
    let () = List.iter (fun v -> 
                            tbl := (permute_step v (!tbl));
                       ) lst
    in !tbl
;;


(* 
    Currency Transaction functions.
*)


(* fx_record: record of the exchange rate between two currencies *)
type fx_record = {sym_from:string; sym_to:string; rate:float};;  


let make_fx_records rate_table trans_array = 
    let last_idx = (Array.length trans_array)-2 
    and records = ref [] 
    and product = ref 1.0 in
    for idx = 0 to last_idx do
        let sym_from = trans_array.(idx) 
        and sym_to   = trans_array.(idx+1) in
        let rate = try rate_table sym_from sym_to with Not_found -> 1.0 in
            records := {sym_from = sym_from;
                        sym_to   = sym_to;
                        rate     = rate
                       }::!records;
        product := !product *. rate
    done;
    (List.rev (!records), ((!product -. 1.0) *. 100.0))
;;


(* Main *)

let main ic fx_filter fx_formatter = 
    let first_line = ref true 
    and not_eof = ref false
    and sep = Str.regexp " "
    and symbols = ref []

    (* currency fx transaction rate hashtable 'ctbl' *)
    and ctbl = Hashtbl.create 10 in
        let ctbl_add = Hashtbl.add ctbl 
        and fx_rate c1 c2 = Hashtbl.find ctbl (c1 ^ c2)
    in

    let () = 
    (* read in currency data file *)
    while !not_eof = false do
        let line = try input_line ic with End_of_file -> not_eof := true; "" in 
        (* first line of file contains currency symbols wanted *)
        if !first_line then
            begin
                symbols := Str.split sep line;
                first_line := false
            end
        else 
            (* load currency fx table *)
            if !not_eof = false then
                let record = Str.split sep line in
                let fxrec   = List.nth record 0 
                and rate = float_of_string (List.nth record 1) 
                in 
                let () = ctbl_add fxrec rate in ()
            else ()
    done
    in

    (* calculate fx arbitrage transactions *)
    let start = List.nth (!symbols) 0 
    and tbl = permute (!symbols)
    and filter_trans s tbl = 
        List.filter (fun a -> s = a.(0)) tbl
    in
    let trans = filter_trans start tbl in
    let full_trans = List.map (fun a -> 
                               Array.concat [ a; [|start|] ]
                              ) trans
    in
    let records = List.map (make_fx_records fx_rate) full_trans 
    in List.iter fx_formatter 
                (* sort in ascending order *)
                (List.sort (fun fx_a fx_b -> 
                            let prod_a = snd fx_a 
                            and prod_b = snd fx_b
                            in if prod_a > prod_b then -1
                               else if prod_a < prod_b then 1
                               else 0
                           )
                 (fx_filter records))
;;

(* opts: -e (eleminate redundent) -p (positive results only) -h (html output) *)

let fx_std_formatter fxchain =
    let fxrecs = fst fxchain 
    and product = snd fxchain in
    List.iter (fun fxr -> 
                   printf " (%s, %s) = %f " 
                   fxr.sym_from fxr.sym_to fxr.rate
              ) fxrecs;
    printf "-> %f\n" product              
;;

let fx_html_formatter fxchain =
    let fxrecs = fst fxchain 
    and product = snd fxchain in
    let to_syms = List.map (fun fxr -> fxr.sym_to) fxrecs in
    let first_sym = (List.nth fxrecs 0).sym_from in
    let sep = " &rarr; " in
    let syms = String.concat sep (first_sym::to_syms) in
    let tag = if product > 0.0 then "pos" 
              else "neg"
    in
    printf "<div class=%s> %s = %f %%</div>\n" tag syms product              
;;

let fx_redundent_filter records = 
    let products = ref [] in
    List.filter (fun r -> 
                    let prod = snd r in
                    if (List.mem prod (!products)) then
                        false
                    else
                        let () = products := prod::!products in
                        true
                 ) records
;;

let fx_no_filter records = records;;

let fx_pos_filter records = 
    List.filter (fun r -> (snd r) > 0.0) records
;;

let args = Array.to_list Sys.argv;;

if List.length(args) > 1 then
    let fx_filter = if List.mem "-p" args then fx_pos_filter
                    else if List.mem "-e" args then fx_redundent_filter
                    else fx_no_filter
    in 
    let args = List.filter (fun arg -> 
                                not (List.mem arg ["-p"; "-e"])
                           ) args
                        
    in    
    let ic = open_in (List.nth args 1) in
    main ic fx_filter fx_html_formatter
else ()
;;