In erste Linie ging es mir um die Memoisation einer Funktion von einem rekursiven Typ-Parameter (z.B. List). Ausserdem wollte ich die polymorphe memoization-Funktion in F# umsetzen.
Das Ergebnis sieht dann folgend aus.
//function with some long computations.
// val boolFunc : bool-> int list
let boolFunc b =
match b with
| true ->
printfn "call boolFunc: true part."
List.init 1000 (fun i -> i * i)
|false ->
printfn "call boolFunc: false part."
List.init 1000 (fun i-> -1 * i * i)
// function of list type artgument.
// val testListFunc : bool list -> int list
let testListFunc l = List.map boolFunc l |> List.concat
// val memoizedFunc : (bool list -> int list)
let memoizedFunc = memoization testListFunc
let test = (memoizedFunc [true;false;false;]) @ (memoizedFunc [true;false;false;])
printfn "run %A" testcall boolFunc: true part.
call boolFunc: false part.
call boolFunc: false part.
run [0; 1; 4; 9; 16; 25; 36; 49; 64; 81; 100; 121; 144; 169; 196; 225; 256; 289;
324;
361; 400; 441; 484; 529; 576; 625; 676; 729; 784; 841; 900; 961; 1024; 1089;
1156; 1225; 1296; 1369; 1444; 1521; 1600; 1681; 1764; 1849; 1936; 2025; 2116;
2209; 2304; 2401; 2500; 2601; 2704; 2809; 2916; 3025; 3136; 3249; 3364; 3481;
3600; 3721; 3844; 3969; 4096; 4225; 4356; 4489; 4624; 4761; 4900; 5041; 5184;
5329; 5476; 5625; 5776; 5929; 6084; 6241; 6400; 6561; 6724; 6889; 7056; 7225;
7396; 7569; 7744; 7921; 8100; 8281; 8464; 8649; 8836; 9025; 9216; 9409; 9604;
9801; ...]
Hier ist meine Implementierung. Als Kommentare habe ich einfach die Zitate aus dem Artikel verwendet.
// TypeMemo.fs
// from http://research.microsoft.com/en-us/um/people/simonpj/papers/assoc-types/fun-with-type-funs/typefun.pdf.
// chapter "3.1 Type-directed memoization".
namespace TypeMemoization
module TypeMemo =
type IFromTable<'a,'w > =
abstract inline fromTable : 'a->'w
let inline fromTable t = (t :> IFromTable<_,_>).fromTable
// "we can memoise any function from Bool by storing its two
// return values as a lazy pair. This lazy pair is the memo table."
type BoolTable<'w> =
| BTable of Lazy<'w> * Lazy<'w>
interface IFromTable<bool,'w> with
member inline x.fromTable b =
match x with
| BTable(x,y) -> if b then x.Force() else y.Force()
let inline boolToTable f =
BTable (lazy(f true), lazy(f false))
//"memoise functions from any sum type, such as the type Either."
type Either<'a,'b>=
|Left of 'a
|Right of 'b
// "We can memoise a function from Either a b by storing a lazy pair of a
// memo table from a and a memo table from b. That is, we take advantage
// of the isomorphism between the function type Either a b -> w and the
// product type (a -> w, b -> w)."
type DiscriminatedUnionTable<'a,'b,'w> =
| STable of IFromTable<'a,'w> * IFromTable<'b,'w>
interface IFromTable<Either<'a,'b>,'w> with
member inline x.fromTable e =
match x, e with
| STable (t,_), Left v -> t.fromTable v
| STable (_,t), Right v -> t.fromTable v
let inline discriminatedUnionToTable f fa fb =
STable (fa (f<<Left),fb (f<<Right))
// "Dually, we can memoise functions from the product type (a,b) by storing a memo table
// from a whose entries are memo tables from b."
type ProductTable<'a,'b,'w> =
| PTable of IFromTable<'a, IFromTable<'b,'w>>
interface IFromTable<('a*'b),'w> with
member inline x.fromTable p =
match x, p with
| PTable t,(a,b)-> (t.fromTable a).fromTable b
let inline productToTable f fa fb =
PTable ((fa (fun a -> fb (fun b -> f (a, b)) :> IFromTable<_,_> )) :> IFromTable<_,_>)
// "A list is a combination of a sum, a product, and recursion.
// Since a list is either empty or not, ListTable<'a,'w> is represented by a pair, whose first component is the result of applying
// the memoised function f to the empty list, and whose second component
// memoises applying f to non-empty lists."
type ListTable<'a,'w> =
| LTable of Lazy<'w> * IFromTable<'a, IFromTable<'a list, 'w>>
interface IFromTable<'a list,'w> with
member inline x.fromTable l =
match x, l with
| LTable(t, _), [] -> t.Force()
| LTable(_, t), x :: xs -> fromTable (fromTable t x ) xs
let rec listToTable f fa =
LTable (lazy(f []), fa (fun x -> listToTable (fun xs -> f (x::xs)) fa :> IFromTable<_,_>) :> IFromTable<_,_>)
let inline flip1 f a b c = f c a bFür jeden Typ, den wir als Funktions-Typ-Parameter später benutzen wollen, sollte eine statische Operatorüberladung im MemoTable-Typ definiert werden. Hier bediene ich den Operatorüberladung-Trick als Ersatz für Type Class in F#. type MemoTable = MemoTable with
static member (|>|) (MemoTable, f) =
productToTable f (flip1 discriminatedUnionToTable boolToTable boolToTable) boolToTable
static member (|>|) (MemoTable, f) =
productToTable f boolToTable (flip1 discriminatedUnionToTable boolToTable boolToTable)
static member (|>|) (MemoTable, f) =
productToTable f boolToTable boolToTable
static member (|>|) (MemoTable, f) =
discriminatedUnionToTable f (flip1 productToTable boolToTable boolToTable) boolToTable
static member (|>|) (MemoTable, f) =
discriminatedUnionToTable f boolToTable boolToTable)
static member (|>|) (MemoTable, f) =
discriminatedUnionToTable f boolToTable (flip1 discriminatedUnionToTable boolToTable boolToTable)
static member (|>|) (MemoTable, f) =
boolToTable f
// functions from recursive types, like lists
static member (|>|) (MemoTable, (f:(bool list->'a))) =
listToTable f ((|>|) MemoTable ) |> fromTable
static member (|>|) (MemoTable, (f:((bool*bool) list->'a))) =
listToTable f ((|>|) MemoTable ) |> fromTable
static member (|>|) (MemoTable, (f:(Either<bool,bool> list->'a))) =
listToTable f ((|>|) MemoTable ) |> fromTable
static member (|>|) (MemoTable, (f:((Either<bool,bool> * bool) list->'a))) =
listToTable f ((|>|) MemoTable ) |> fromTable
let inline memoization f = MemoTable |>| f
Wie man sieht, sind die vier letzten Methoden redundant. Versuchen wir mal mit "inline" und lassen die Typangabe weg.
Geht leider nicht. Dann ändern wir die Funktion ein bisschen ...
und es kompiliert. Jetzt gibt es einen kleinen Nachteil auf der Aufrufer-Seite, dass bei der Memoisation von Funktionen mit einem List-Parameter stets MemoTable als "dummy" Parameter angegeben werden soll.
Ein paar Tests.
// Script.fsx
#load "TypeMemo.fs"
open TypeMemoisation.TypeMemo
open System
let boolFunc1 b =
match b with
| true ->
printfn "call boolFunc1: true part. Value = 10"
10
|false ->
printfn "call boolFunc1: false part. Value = -10"
-10
//function with long computations.
// val boolFunc : boo l-> int list
let boolFunc b =
match b with
| true ->
printfn "call boolFunc: true part"
List.init 1000 (fun i->i*i)
|false ->
printfn "call boolFunc: false part"
List.init 1000 (fun i-> -1*i*i)
let eitherFunc e =
match e with
| Left a ->
printfn "call eitherFunc: Left %A" a
((boolFunc a)|>List.sum) *(-2)
| Right b ->
printfn "call eitherFunc: Right %A" b
((boolFunc b)|>List.sum) * 2
let eitherFunc1 e =
match e with
| Left a ->
printfn "call eitherFunc: Left %A" a
((boolFunc a)|>List.sum) *(-2)
| Right b ->
printfn "call eitherFunc: Right %A" b
(eitherFunc b) * 2
let productFunc p =
let x=
printfn "call productFunc: first"
(boolFunc1 (fst p))-3
let y =
printfn "call productFunc: second "
(boolFunc1 (snd p))*2
x + y
let productEitherFunc (e, b) =
let x =
printfn "call productEitherFunc: first %A" e
(eitherFunc e)-3
let y =
printfn "call productEitherFunc second %A" b
(boolFunc1 b) * 2
x+y
//function of list type artgument.
let rec listFuncTest l =
match l with
|[] ->
printfn "listFuncTest Empty"
0
|x :: xs ->
printfn "listFuncTest %A" x
((boolFunc x)|>List.sum) + listFuncTest xs
let inline memoizationSimpleType f =
memoization f |> fromTable
// val memoizedFunc : (bool -> int)
let memoizedFunc = memoizationSimpleType boolFunc1
// val memoizedFunc1 : (Either<bool,bool> -> int)
let memoizedFunc1 = memoizationSimpleType eitherFunc
// val memoizedFunc2 : (bool * bool -> int)
let memoizedFunc2 = memoizationSimpleType productFunc
// val memoizedFunc3 : (Either<bool,bool> * bool -> int)
let memoizedFunc3 = memoizationSimpleType productEitherFunc
// val memoizedFunc4 : (Either<bool, Either<bool, bool>> -> int)
let memoizedFunc4 = memoizationSimpleType eitherFunc1
printfn "test (Either<bool,bool> -> int): "
let runSimple1= memoizedFunc1 (Left true) + memoizedFunc1 (Left true)
printfn "runSimple1 %A" runSimple1
printfn "-------------------------------------------------------"
printfn "test (bool * bool -> int): "
let runSimple2= memoizedFunc2 (false, true) + memoizedFunc2 (false, true)
printfn "runSimple2 %A" runSimple2
printfn "-------------------------------------------------------"
printfn "test (Either<bool,bool> * bool -> int): "
let runSimple3= memoizedFunc3 (Left true, false) + memoizedFunc3 (Left true, false)
printfn "runSimple3 %A" runSimple3
printfn "-------------------------------------------------------"
let rec listFunc g l =
match l with
|[] ->
printfn "call listFunc: Empty"
0
|x :: xs ->
printfn "call listFunc: %A" x
(g x) + listFunc g xs
printfn "test (bool * bool list -> int): "
let memoTest1 = memoization (listFunc productFunc) MemoTable
let run1 = (memoTest1 [(true,false);(false,true)]) + (memoTest1 [(true,false);(false,true)])
printfn "run1 %A" run1
printfn "-------------------------------------------------------"
printfn "test (Either<bool,bool> * list -> int): "
let memoTest2 = memoization (listFunc eitherFunc) MemoTable
let run2= (memoTest2 [Left true; Right false]) + (memoTest2 [Left true; Right false])
printfn "run2 %A" run2type MemoTable =
| MemoTable
with
static member
( |>| ) : MemoTable:MemoTable * f:(Either<bool,bool> * bool -> 'a) ->
ProductTable<Either<bool,bool>,bool,'a>
static member
( |>| ) : MemoTable:MemoTable * f:(bool * Either<bool,bool> -> 'a) ->
ProductTable<bool,Either<bool,bool>,'a>
static member
( |>| ) : MemoTable:MemoTable * f:(bool * bool -> 'a) ->
ProductTable<bool,bool,'a>
static member
( |>| ) : MemoTable:MemoTable * f:(Either<(bool * bool),bool> -> 'a) ->
DiscriminatedUnionTable<(bool * bool),bool,'a>
static member
( |>| ) : MemoTable:MemoTable * f:(Either<bool,bool> -> 'a) ->
DiscriminatedUnionTable<bool,bool,'a>
static member
( |>| ) : MemoTable:MemoTable *
f:(Either<bool,Either<bool,bool>> -> 'a) ->
DiscriminatedUnionTable<bool,Either<bool,bool>,'a>
static member
( |>| ) : MemoTable:MemoTable * f:(bool -> 'a) -> BoolTable<'a>
static member
( |>| ) : MemoTable:MemoTable * f:('a list -> 'b) ->
( ^_arg1 -> 'c list -> 'b)
when ( ^_arg1 or ('a -> IFromTable<'c list,'b>)) : (static
member
( |>| ) : ^_arg1 *
('a ->
IFromTable<'c list,
'b>)
->
^d) and
^d :> IFromTable<'c,IFromTable<'c list,'b>>
end
val inline memoization :
^a -> ^_arg6
when (MemoTable or ^a) : (static member ( |>| ) : MemoTable * ^a ->
^_arg6)
test (Either<bool,bool> -> int):
call eitherFunc: Left true
call boolFunc: true part
runSimple1 -1331334000
-------------------------------------------------------
test (bool * bool -> int):
call productFunc: first
call boolFunc1: false part. Value = -10
call productFunc: second
call boolFunc1: true part. Value = 10
runSimple2 14
-------------------------------------------------------
test (Either<bool,bool> * bool -> int):
call productEitherFunc: first Left true
call eitherFunc: Left true
call boolFunc: true part
call productEitherFunc second false
call boolFunc1: false part. Value = -10
runSimple3 -1331334046
-------------------------------------------------------
test (bool * bool list -> int):
call listFunc: (true, false)
call productFunc: first
call boolFunc1: true part. Value = 10
call productFunc: second
call boolFunc1: false part. Value = -10
call listFunc: (false, true)
call productFunc: first
call boolFunc1: false part. Value = -10
call productFunc: second
call boolFunc1: true part. Value = 10
call listFunc: Empty
run1 -12
-------------------------------------------------------
test (Either<bool,bool> * list -> int):
call listFunc: Left true
call eitherFunc: Left true
call boolFunc: true part
call listFunc: Right false
call eitherFunc: Right false
call boolFunc: false part
call listFunc: Empty
run2 1632299296
val boolFunc1 : bool -> int
val boolFunc : bool -> int list
val eitherFunc : TypeMemoisation.TypeMemo.Either<bool,bool> -> int
val eitherFunc1 :
TypeMemoisation.TypeMemo.Either<bool,
TypeMemoisation.TypeMemo.Either<bool,bool>> ->
int
val productFunc : bool * bool -> int
val productEitherFunc :
TypeMemoisation.TypeMemo.Either<bool,bool> * bool -> int
val listFuncTest : bool list -> int
val inline memoizationSimpleType :
^a -> ('c -> 'd)
when (TypeMemoisation.TypeMemo.MemoTable or ^a) : (static member ( |>| ) : TypeMemoisation.TypeMemo.MemoTable *
^a
->
^b) and
^b :> TypeMemoisation.TypeMemo.IFromTable<'c,'d>
val memoizedFunc : (bool -> int)
val memoizedFunc1 : (TypeMemoisation.TypeMemo.Either<bool,bool> -> int)
val memoizedFunc2 : (bool * bool -> int)
val memoizedFunc3 :
(TypeMemoisation.TypeMemo.Either<bool,bool> * bool -> int)
val memoizedFunc4 :
(TypeMemoisation.TypeMemo.Either<bool,
TypeMemoisation.TypeMemo.Either<bool,bool>> ->
int)
val runSimple1 : int = -1331334000
val runSimple2 : int = 14
val runSimple3 : int = -1331334046
val listFunc : ('a -> int) -> 'a list -> int
val memoTest1 : ((bool * bool) list -> int)
val run1 : int = -12
val memoTest2 : (TypeMemoisation.TypeMemo.Either<bool,bool> list -> int)
val run2 : int = 1632299296
Seltsamerweise funktioniert es in F#-Interactive und im Release-Modus, aber im Debug bekomme ich folgende Fehlermeldung.
Keine Kommentare:
Kommentar veröffentlichen