module DiscreteCashFlow =
struct
	type cash_flow = { value : float ; time : float }

	(************** 3.1 **************)
	(* Calculate the present value of discrete cash flows *)
	let rec cash_flow_pv_discrete (cash_flows:cash_flow list) (discount_rate:float) : float =
		let rate = 1. +. discount_rate in
		List.fold_left
			(fun accum flow -> accum +. flow.value /. rate ** flow.time)
			0. cash_flows
	
	(*  Example use:
		Project costs 100 now and pays out 75 for the next two years
		    
		let cash_flows = {value= -100.0; time=0.0}::{value=75.0; time=1.0}::{value=75.0; time=2.0}::[];;
		Printf.printf "Present Value %f\n" (cash_flow_pv_discrete cash_flows 0.1);;
	*)
	
	(************** 3.2 **************)
	(* Create an exception type *)
	exception IrrException of string;;

	module IrrDetail = 
	struct
		type point = { payoff : float ; rate : float };;
		let payoff rate cash_flows = 
			{ rate = rate ; payoff = cash_flow_pv_discrete cash_flows rate };;
			
		let find_bracket cash_flows iterations bottom top =
			let rec aux i b t = 
				if i == 0 || b.payoff *. t.payoff < 0. then
					(b,t)
				else if abs_float b.payoff < abs_float t.payoff then
					aux (i-1) (payoff (b.rate +. 1.6 *. (b.rate -. t.rate)) cash_flows) t
				else
					aux (i-1) b (payoff (t.rate +. 1.6 *. (t.rate -. b.rate)) cash_flows) 
			in let b,t = aux iterations bottom top in
				if b.payoff *. t.payoff > 0. then raise (IrrException "Find Bracket") ; 
				(b,t);;
	
		let find_zero cash_flows iterations accuracy b t =
			let b, t = min b t, max b t in
			let d = (t.rate -. b.rate) *. 0.5 in 
			let rec aux i d b = 
				if i < 0 then raise (IrrException "Find Zero") ;
				let m = payoff (b.rate +. d) cash_flows in
				let b = if m.payoff < 0. then m else b in
				if abs_float d < accuracy || abs_float b.payoff < accuracy then b
				else aux (i-1) (d *. 0.5) b
			in aux iterations d b;;
			
		(* Find the IRR given a discrete cash flow *)
		let rec cash_flow_irr_discrete ?(max_iterations=50) ?(accuracy=0.00005) (cash_flows : cash_flow list) : float = 
			let b, t = payoff 0.0 cash_flows, payoff 0.2 cash_flows in
			let b, t = find_bracket cash_flows max_iterations b t in
			let b = find_zero cash_flows max_iterations accuracy b t in
				b.rate;;
	end

	let cash_flow_irr_discrete = IrrDetail.cash_flow_irr_discrete;;
			
	(*  Example use:
	    Project costs 100 now and pays out 75 for the next two years
	
		let cash_flows = {value= -100.0; time=0.0}::{value=75.0; time=1.0}::{value=75.0; time=2.0}::[];;
		Printf.printf "Present Value %f\n" (cash_flow_pv_discrete cash_flows 0.05);;
		Printf.printf "Internal Rate of Return %f\n" (cash_flow_irr_discrete cash_flows);;
	*)
	
	(************** 3.3 **************)		
	(* simple function to determine sign of a float *)
	module UniqueIrrDetail = 
	struct
		let sign x = if x >= 0.0 then 1.0 else -1.0;;
		
		let rec count_sign_changes cash_flows changes last_sign =
			match cash_flows with
			  [] -> changes
			| h::t -> 
				let current_sign = (sign h.value) in
				let nchanges = (if current_sign != last_sign then changes+1 else changes) in
					count_sign_changes t nchanges current_sign;;
	
		let rec check_aggregate_cash_flows cash_flows aggregate changes = 
			match cash_flows with
			  [] -> changes
			| h::t -> 
				let new_aggregate = aggregate +. h.value in
				let nchanges = (if sign aggregate != sign new_aggregate then (changes+1) else changes) in
					check_aggregate_cash_flows t new_aggregate nchanges;;
	
		let cash_flow_unique_irr cash_flows = 
			match cash_flows with
			  [] -> false
			| h::t ->
				let sign_changes = count_sign_changes t 0 (sign h.value) in
					if sign_changes == 0 then 
						false
					else if sign_changes == 1 or (check_aggregate_cash_flows t h.value 0) <= 1 then
						true
					else
						false;; 
	end

	let cash_flow_unique_irr = UniqueIrrDetail.cash_flow_unique_irr;;
	(*  Example use: 
	
	    let cash_flows = {value= -100.0; time=0.0}::{value=75.0; time=1.0}::{value=75.0; time=2.0}::[];;
		Printf.printf "Unique IRR? %b\n" (cash_flow_unique_irr cash_flows);;	
	*)
	
	(************** 3.4 **************)
	(* Find the present value of cash flows that continuously compound *)
	let rec cash_flow_pv (cash_flows : cash_flow list) (r : float) : float = 
		List.fold_left
			(fun accum flow -> flow.value *. exp(r *. flow.time))
			0. cash_flows;;
	
	(*  Example use:
	    Project costs 100 now and pays out 75 for the next two years    
	   
	    let cash_flows = {value= -100.0; time=0.0}::{value=75.0; time=1.0}::{value=75.0; time=2.0}::[];;
		Printf.printf "Cash flow present value %f\n" (cash_flow_pv cash_flows 0.05);;
	*)
end