Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
Experiments with fusable functional vectors in Standard ML
- Loading branch information
Showing
12 changed files
with
381 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
local | ||
$(SML_LIB)/basis/basis.mlb | ||
in | ||
vec/vec.mlb | ||
AmrPut.sml | ||
AmrPutVec.sml | ||
AmrPutVecTest.sml | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,70 @@ | ||
functor AmrPutVec(V : VEC) = | ||
struct | ||
|
||
fun curry f x y = f(x,y) | ||
|
||
(* Pointwise manipulation of vectors-slices and scalars *) | ||
infix ^*^ ^+^ -^ *^ | ||
|
||
fun v1 ^*^ v2 = V.map2 (curry op*) v1 v2 | ||
fun v1 ^+^ v2 = V.map2 (curry op+) v1 v2 | ||
fun c -^ v = V.map (fn x => c - x) v | ||
fun c *^ v = V.map (fn x => c * x) v | ||
|
||
fun pmax v c = V.map (fn x => Real.max(x, c)) v | ||
fun ppmax v1 v2 = V.map2 (curry Real.max) v1 v2 | ||
|
||
fun vtail v = V.dr 1 v | ||
fun vinit v = V.tk (V.length v - 1) v | ||
|
||
fun binom expiry = | ||
let (* standard econ parameters *) | ||
val strike = 100.0 | ||
val bankDays = 252 | ||
val s0 = 100.0 | ||
val r = 0.03 val alpha = 0.07 val sigma = 0.20 | ||
|
||
val n = expiry*bankDays | ||
val dt = real expiry / real n | ||
val u = Math.exp(alpha*dt+sigma* Math.sqrt dt) | ||
val d = Math.exp(alpha*dt-sigma* Math.sqrt dt) | ||
val stepR = Math.exp(r*dt) | ||
val q = (stepR-d)/(u-d) | ||
val qUR = q/stepR val qDR = (1.0-q)/stepR | ||
|
||
val uPow = V.tabulate (n+1) (fn i => Math.pow(u, real i)) | ||
val uPow = V.memoize uPow | ||
val dPow = V.tabulate (n+1) (fn i => Math.pow(d, real (n-i))) | ||
val dPow = V.memoize dPow | ||
|
||
val st = s0 *^ (uPow ^*^ dPow) | ||
val finalPut = pmax (strike -^ st) 0.0 | ||
|
||
(* for (i in n:1) { | ||
St<-S0*u.pow[1:i]*d.pow[i:1] | ||
put[1:i]<-pmax(strike-St,(qUR*put[2:(i+1)]+qDR*put[1:i])) | ||
} | ||
*) | ||
fun prevPut (i, put) = | ||
let val st = s0 *^ ((V.tk i uPow) ^*^ (V.dr (n+1-i) dPow)) | ||
val put = V.memoize put | ||
in ppmax(strike -^ st) ((qUR *^ vtail put) ^+^ (qDR *^ vinit put)) | ||
end | ||
val first = V.foldl prevPut finalPut (V.tabulate n (fn i => n-i)) | ||
|
||
in V.sub (first, 0) | ||
end | ||
|
||
(* Expected results for binom: | ||
expiry price | ||
1 6.74543295135838 | ||
8 13.94568883837488 | ||
16 16.22259138591852 | ||
30 17.65370590709356 | ||
64 18.42993156506373 | ||
128 18.573732615311993 | ||
*) | ||
|
||
|
||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,13 @@ | ||
(* | ||
structure AP = AmrPutVec(Fvec) | ||
structure AP = AmrPutVec(ListVec) | ||
*) | ||
structure AP = AmrPut | ||
|
||
fun pr n = | ||
let val _ = print ("AmrPut.binom(" ^ Int.toString n ^ ") = ") | ||
val r = AP.binom n | ||
in print (Real.toString r ^ "\n") | ||
end | ||
|
||
val _ = List.app pr [1,8,16,30,64,128] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,19 @@ | ||
|
||
#MLKITLIB=$(HOME)/mlkit-4.3.6 | ||
#MLCOMP=SML_LIB=$(MLKITLIB)/lib/mlkit $(MLKITLIB)/bin/mlkit | ||
MLCOMP=mlton | ||
|
||
UTEST_FILES=$(shell ls utest/*.{sig,sml,mlb}) | ||
VEC_FILES=$(shell ls vec/*.{sig,sml,mlb}) | ||
.PHONY: all | ||
all: runvec | ||
|
||
runvec: $(VEC_FILES) $(UTEST_FILES) | ||
$(MLCOMP) -output $@ vec/vec.mlb | ||
|
||
AmrPutVec: AmrPutVec.sml AmrPutVecTest.sml $(VEC_FILES) $(UTEST_FILES) | ||
$(MLCOMP) -output $@ AmrPutVec.mlb | ||
|
||
clean: | ||
find . -name MLB | xargs rm -rf | ||
rm -f runvec apl AmrPutVec *~ vec/*~ utest/*~ |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,6 @@ | ||
local | ||
$(SML_LIB)/basis/basis.mlb | ||
in | ||
utest.sig | ||
utest.sml | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,9 @@ | ||
(* Auxiliary functions for test cases *) | ||
|
||
signature UTEST = sig | ||
val start : string -> string -> unit | ||
val finish : unit -> unit | ||
val tst : string -> (unit -> bool) -> unit | ||
val tstopt : string -> (unit -> string option) -> unit | ||
val all : string -> ('a -> bool) -> 'a list -> unit | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,45 @@ | ||
structure UTest :> UTEST = struct | ||
|
||
val counts = {ok=ref 0, wrong=ref 0, exn=ref 0} | ||
fun incr l = | ||
let val r = l counts | ||
in r := !r + 1 | ||
end | ||
fun ok() = (incr #ok; "OK") | ||
fun wrong s = (incr #wrong; if s = "" then "WRONG" else "WRONG - " ^ s) | ||
fun exn() = (incr #exn; "EXN") | ||
fun check f = | ||
(case f () of SOME s => wrong s | ||
| NONE => ok()) | ||
handle e => (exn() ^ General.exnMessage e) | ||
|
||
fun tst0 s s' = print (s ^ " \t" ^ s' ^ "\n") | ||
fun tstopt s f = tst0 s (check f) | ||
fun tst s f = tst0 s (check (fn x => if f() then NONE else SOME"")) | ||
fun all s f xs = | ||
tst s (fn() => List.all f xs) | ||
|
||
val data : (string*string) option ref = ref NONE | ||
fun start f s = | ||
(data := SOME (f,s); | ||
#ok counts := 0; | ||
#wrong counts := 0; | ||
#exn counts := 0; | ||
print ("[File " ^ f ^ ": Testing " ^ s ^ "...]\n")) | ||
|
||
fun finish () = | ||
let val ok = ! (#ok counts) | ||
val wrong = ! (#wrong counts) | ||
val exn = ! (#exn counts) | ||
in | ||
case !data of | ||
NONE => print "[Test not properly started]\n" | ||
| SOME (f,s) => | ||
(print ("[Finished testing file " ^ f ^ " - " ^ s ^ "]\n"); | ||
if wrong = 0 andalso exn = 0 then | ||
print ("[Successfully ran all " ^ Int.toString ok ^ " tests]\n") | ||
else | ||
print ("[Failure during tests - ok: " ^ Int.toString ok ^ ", wrong: " ^ Int.toString wrong ^ ", exn: " ^ Int.toString exn ^ "]\n") | ||
) | ||
end | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,81 @@ | ||
(* Fusable vectors *) | ||
|
||
structure Fvec :> VEC = struct | ||
|
||
type 'a t = int * (int -> 'a) | ||
|
||
fun fromList (l:'a list) : 'a t = | ||
let val a = Vector.fromList l | ||
in (Vector.length a, fn i => Vector.sub(a,i)) | ||
end | ||
|
||
fun map f (n,g) = (n, f o g) | ||
|
||
fun fmap a v = map (fn f => f v) a | ||
|
||
fun iter (n,e,f) = | ||
let fun loop (i,a) = | ||
if i >= n then a | ||
else loop (i+1, f(i,a)) | ||
in loop(0,e) | ||
end | ||
|
||
fun iter' (n,e,f) = | ||
let fun loop (i,a) = | ||
if i <= 0 then a | ||
else let val i2 = i-1 | ||
in loop (i2, f(i2,a)) | ||
end | ||
in loop(n,e) | ||
end | ||
|
||
fun foldl f e (n,g) = iter(n,e, fn (i,a) => f(g i,a)) | ||
fun foldr f e (n,g) = iter'(n,e, fn (i,a) => f(g i,a)) | ||
|
||
fun emp _ = raise Fail "impossible" | ||
fun empty () = (0, emp) | ||
|
||
fun tk n (a as (m,g)) = | ||
if n >= m then a | ||
else (n,g) | ||
|
||
fun dr n (m,g) = | ||
if n >= m then empty() | ||
else (m-n,fn i => g(i+n)) | ||
|
||
fun tabulate n f = (n,f) | ||
|
||
fun list a = foldr (op ::) nil a | ||
|
||
fun length (n,_) = n | ||
|
||
fun map2 f (n1,f1) (n2,f2) = | ||
if n1 <> n2 then raise Fail "map2 applied to vectors of different lengths" | ||
else (n1,fn i => f(f1 i)(f2 i)) | ||
|
||
fun single x = fromList [x] | ||
|
||
fun eq beq (a1,a2) = | ||
length a1 = length a2 andalso | ||
(foldl(fn (x,a) => x andalso a) true | ||
(map2 (fn x => fn y => beq(x,y)) a1 a2)) | ||
|
||
fun concat (n1,f1) (n2,f2) = | ||
(n1+n2, fn i => if i < n1 then f1 i else f2 (i-n1)) | ||
|
||
fun flatten v = | ||
let val len = foldl (fn (a,l) => length a + l) 0 v | ||
val f = foldr (fn ((n,f),g) => | ||
fn i => if i < n then f i else g (i-n)) emp v | ||
in (len,f) | ||
end | ||
|
||
fun sub ((n,f),i) = | ||
if i > n-1 orelse i < 0 then raise Subscript | ||
else f i | ||
|
||
fun memoize (n,f) = | ||
let val v = Vector.tabulate(n,f) | ||
in (n, fn i => Vector.sub(v,i)) | ||
end | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,42 @@ | ||
structure ListVec : VEC = struct | ||
type 'a t = 'a list | ||
|
||
fun eq beq (nil,nil) = true | ||
| eq beq (x::xs, y::ys) = beq(x, y) andalso eq beq (xs,ys) | ||
| eq beq _ = false | ||
|
||
val empty = fn () => [] | ||
val single = fn x => [x] | ||
|
||
fun dr 0 l = l | ||
| dr n [] = [] | ||
| dr n (x::l) = dr (n-1) l | ||
|
||
fun tk 0 l = [] | ||
| tk n [] = [] | ||
| tk n (x::l) = x :: tk (n-1) l | ||
|
||
val list = fn x => x | ||
val fromList = fn x => x | ||
open List | ||
val concat = fn x => fn y => x @ y | ||
fun map2 f _ nil = nil | ||
| map2 f nil _ = nil | ||
| map2 f (x::xs) (y::ys) = f x y :: map2 f xs ys | ||
fun fmap gs x = | ||
let fun loop [] = [] | ||
| loop (g::gs) = g x :: loop gs | ||
in loop gs | ||
end | ||
fun tabulate n f = | ||
let fun gen x = if x >= n then [] | ||
else f x :: gen (x+1) | ||
in gen 0 | ||
end | ||
fun flatten nil = nil | ||
| flatten (x::xs) = x @ flatten xs | ||
|
||
val sub = List.nth | ||
|
||
val memoize = fn x => x | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,55 @@ | ||
(* Simple unit tests for the vector library *) | ||
|
||
functor Test(structure V : VEC | ||
val name : string) = struct | ||
|
||
open UTest | ||
|
||
val () = start "test_vec.sml" ("structure " ^ name) | ||
|
||
local | ||
val is_debug = false | ||
in | ||
fun debug s = if is_debug then print s | ||
else () | ||
end | ||
|
||
fun tsta s f = | ||
tst s (fn () => | ||
let val (a1 : int V.t,a2) = f() | ||
in V.eq (op =) (a1, a2) | ||
end) | ||
|
||
val a0 = V.tabulate 3 (fn x => x) | ||
val a1 = V.map (fn x => x + 1) a0 | ||
val _ = tsta "map1" (fn () => (a1, V.fromList[1,2,3])) | ||
|
||
val _ = tsta "concat" (fn () => (V.concat a0 a1, V.fromList[0,1,2,1,2,3])) | ||
|
||
val _ = tsta "tk0" (fn () => (V.tk 0 a1, V.empty())) | ||
val _ = tsta "tk1" (fn () => (V.tk 2 a1, V.fromList[1,2])) | ||
val _ = tsta "tk2" (fn () => (V.tk 3 a1, a1)) | ||
val _ = tsta "dr0" (fn () => (V.dr 0 a1, a1)) | ||
val _ = tsta "dr1" (fn () => (V.dr 1 a1, V.fromList[2,3])) | ||
val _ = tsta "dr2" (fn () => (V.dr 3 a1, V.empty())) | ||
|
||
val _ = tsta "map2" (fn () => (V.map2 (fn x => fn y => x * y) a0 a1, V.fromList[0,2,6])) | ||
|
||
val f2 = V.fromList[fn x => x * x, fn x => x + x] | ||
val _ = tsta "fmap" (fn () => (V.fmap f2 5, V.fromList[25,10])) | ||
val _ = tsta "empty" (fn () => (V.empty(), V.fromList[])) | ||
val _ = tsta "single" (fn () => (V.single 8, V.fromList[8])) | ||
val _ = tst "length" (fn () => V.length a0 = 3 andalso V.length(V.empty()) = 0) | ||
val _ = tst "list" (fn () => V.list a1 = [1,2,3]) | ||
val _ = tst "foldl" (fn () => V.foldl (op +) 0 a1 = 6) | ||
val _ = tsta "flatten" (fn () => (V.flatten(V.fromList[a0,a1,V.empty(),a1]), V.fromList[0,1,2,1,2,3,1,2,3])) | ||
|
||
val () = finish() | ||
|
||
end | ||
|
||
local | ||
structure X = Test(structure V = ListVec val name = "ListVec") | ||
structure Y = Test(structure V = Fvec val name = "Fvec") | ||
in | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,10 @@ | ||
local | ||
$(SML_LIB)/basis/basis.mlb | ||
in | ||
vec.sig | ||
list_vec.sml | ||
fvec.sml | ||
(* ../utest/utest.mlb | ||
test_vec.sml | ||
*) | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,23 @@ | ||
(* Basic vectors *) | ||
|
||
signature VEC = sig | ||
type 'a t | ||
val eq : ('a * 'a -> bool) -> 'a t * 'a t -> bool | ||
val single : 'a -> 'a t | ||
val empty : unit -> 'a t | ||
val fromList : 'a list -> 'a t | ||
val tk : int -> 'a t -> 'a t | ||
val dr : int -> 'a t -> 'a t | ||
val length : 'a t -> int | ||
val foldl : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b | ||
val foldr : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b | ||
val map : ('a -> 'b) -> 'a t -> 'b t | ||
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t | ||
val fmap : ('a -> 'b) t -> 'a -> 'b t | ||
val list : 'a t -> 'a list | ||
val concat : 'a t -> 'a t -> 'a t | ||
val flatten : 'a t t -> 'a t | ||
val tabulate : int -> (int -> 'a) -> 'a t | ||
val sub : 'a t * int -> 'a | ||
val memoize : 'a t -> 'a t | ||
end |