Hindley Milner Type Inference in F# - f#

Can somebody explain step by step type inference in following F# program:
let rec sumList lst =
match lst with
| [] -> 0
| hd :: tl -> hd + sumList tl
I specifically want to see step by step how process of unification in Hindley Milner works.

Fun stuff!
First we invent a generic type for sumList:
x -> y
And get the simple equations:
t(lst) = x;
t(match ...) = y
Now you add the equation:
t(lst) = [a] because of (match lst with [] ...)
Then the equation:
b = t(0) = Int; y = b
Since 0 is a possible result of the match:
c = t(match lst with ...) = b
From the second pattern:
t(lst) = [d];
t(hd) = e;
t(tl) = f;
f = [e];
t(lst) = t(tl);
t(lst) = [t(hd)]
Guess a type (a generic type) for hd:
g = t(hd); e = g
Then we need a type for sumList, so we'll just get a meaningless function type for now:
h -> i = t(sumList)
So now we know:
h = f;
t(sumList tl) = i
Then from the addition we get:
Addable g;
Addable i;
g = i;
t(hd + sumList tl) = g
Now we can start unification:
t(lst) = t(tl) => [a] = f = [e] => a = e
t(lst) = x = [a] = f = [e]; h = t(tl) = x
t(hd) = g = i /\ i = y => y = t(hd)
x = t(lst) = [t(hd)] /\ t(hd) = y => x = [y]
y = b = Int /\ x = [y] => x = [Int] => t(sumList) = [Int] -> Int
I skipped some trivial steps, but I think you can get how it works.

Related

How to sum adjacent numbers of same sign using List.fold in F#

Let's say I have a list in F# like this: [5,-2, -6, 7, -2, 2, 14, 2]
I want to write a function that will use List.fold to return a new list such as [5, -8, 7, -2, 18]
My template looks like this:
let sumAdjacentOfSameSign (lst :int list) : int list =
let f x y =
if x.Length = 0 then
[y]
elif System.Math.Sign(x) = System.Math.Sign(y) then ...
else y :: x
List.fold f [] lst
I need to fill in the ... part but can't quite say how.
Making the fewest changes to your code, I would do this:
let sumAdjacentOfSameSign (lst :int list) : int list =
let f (x : int list) (y : int) =
if x.Length = 0 then
[y]
elif System.Math.Sign(x.Head) = System.Math.Sign(y) then
(x.Head + y) :: x.Tail
else y :: x
List.fold f [] lst
|> List.rev // note that you have to reverse the resulting list
But I would suggest simplifying f to:
let f (x : int list) (y : int) =
match x with
| head :: tail when
System.Math.Sign(head) = System.Math.Sign(y) ->
(head + y) :: tail
| _ -> y :: x

How to make a lazy computational workflow?

I'm trying to write a computational workflow which would allow a computation which can produce side effects like log or sleep and a return value
A usage example would be something like this
let add x y =
compute {
do! log (sprintf "add: x = %d, y= %d" x y)
do! sleep 1000
let r = x + y
do! log (sprintf "add: result= %d" r)
return r
}
...
let result = run (add 100 1000)
and I would like the side effects to be produced when executeComputation is called.
My attempt is
type Effect =
| Log of string
| Sleep of int
type Computation<'t> = Computation of Lazy<'t * Effect list>
let private bind (u : 'u, effs : Effect list)
(f : 'u -> 'v * Effect list)
: ('v * Effect list) =
let v, newEffs = f u
let allEffects = List.append effs newEffs
v, allEffects
type ComputeBuilder() =
member this.Zero() = lazy ((), [])
member this.Return(x) = x, []
member this.ReturnFrom(Computation f) = f.Force()
member this.Bind(x, f) = bind x f
member this.Delay(funcToDelay) = funcToDelay
member this.Run(funcToRun) = Computation (lazy funcToRun())
let compute = new ComputeBuilder()
let log msg = (), [Log msg]
let sleep ms = (), [Sleep ms]
let run (Computation x) = x.Force()
...but the compiler complains about the let! lines in the following code:
let x =
compute {
let! a = add 10 20
let! b = add 11 2000
return a + b
}
Error FS0001: This expression was expected to have type
'a * Effect list
but here has type
Computation<'b> (FS0001)
Any suggestions?
The main thing that is not right with your definition is that some of the members of the computation builder use your Computation<'T> type and some of the other members use directly a pair of value and list of effects.
To make it type check, you need to be consistent. The following version uses Computation<'T> everywhere - have a look at the type signature of Bind, for example:
let private bind (Computation c) f : Computation<_> =
Computation(Lazy.Create(fun () ->
let u, effs = c.Value
let (Computation(c2)) = f u
let v, newEffs = c2.Value
let allEffects = List.append effs newEffs
v, allEffects))
type ComputeBuilder() =
member this.Zero() = Computation(lazy ((), []))
member this.Return(x) = Computation(lazy (x, []))
member this.ReturnFrom(c) = c
member this.Bind(x, f) = bind x f
member this.Delay(funcToDelay:_ -> Computation<_>) =
Computation(Lazy.Create(fun () ->
let (Computation(r)) = funcToDelay()
r.Value))

Return a list from recursive function

I'm trying to return a list from a function, but I'm getting an error that says that an unit was expected instead. Also, I would like to know if this code appears to be structured correctly in general.
code:
let rec calculateVariants (attList: NewProductAttributeInfo list) (activeCount: int)
(currentList: (int * NewProductAttributeInfo) list) =
// group attribute list by category id
let attGrouped = attList |> List.groupBy (fun x -> x.AttributeCategoryId)
// define mutable list
let mutable stageList = currentList
// begin iteration
for catId,details in attGrouped do
for d in details do
if activeCount = 0
then stageList <- (activeCount,d) :: stageList
let groupLength = attGrouped.Length
if (activeCount + 1) <= groupLength
then
let selectCat,selectDetails = attGrouped.[activeCount + 1]
selectDetails
|> List.filter (fun x ->
stageList
|> List.exists (fun (x') ->
not(x' = (activeCount,x))))
|> (fun x ->
match x with
| [] -> ()
| head :: tail ->
stageList <- (activeCount, head) :: stageList
let currentCategory = activeCount + 1
calculateVariants attList currentCategory stageList
)
stageList // <-- error Unit expected
if .. then .. else should return the same type on both branches. If you omit else branch then compiler assuming that it returns unit. Add else branch returning list.
Edit:
Given your problem description, the easiest way would be something like this:
type NewProductAttributeInfo = {AttributeCategoryId: string; AttributeId: string}
let products = [ { AttributeCategoryId = "Size"; AttributeId = "S"};
{ AttributeCategoryId = "Mat"; AttributeId = "Linen" };
{ AttributeCategoryId = "Mat"; AttributeId = "Poliester" };
{ AttributeCategoryId = "Color"; AttributeId = "White" };
{ AttributeCategoryId = "Color"; AttributeId = "Green" };
{ AttributeCategoryId = "Mat"; AttributeId = "Linen" };
{ AttributeCategoryId = "Mat"; AttributeId = "Cotton" };
{ AttributeCategoryId = "Mat"; AttributeId = "Poliester" };
{ AttributeCategoryId = "Size"; AttributeId = "XL" } ]
let group list =
list
|> Set.ofList // Provides uniqueness of attribute combinations
|> Seq.groupBy (fun x -> x.AttributeCategoryId) // Grouping by CatId
|> List.ofSeq
let res = group products
Result:
val it : (string * seq<NewProductAttributeInfo>) list =
[("Color", seq [{AttributeCategoryId = "Color";
AttributeId = "Green";}; {AttributeCategoryId = "Color";
AttributeId "White";}]);
("Mat",
seq
[{AttributeCategoryId = "Mat";
AttributeId = "Cotton";}; {AttributeCategoryId = "Mat";
AttributeId = "Linen";};
{AttributeCategoryId = "Mat";
AttributeId = "Poliester";}]);
("Size", seq [{AttributeCategoryId = "Size";
AttributeId = "S";}; {AttributeCategoryId = "Size";
AttributeId = "XL";}])]
This is the solution that I came with. It works, but I'm sure it can be optimized quite a bit. I have a duplicate issue that is solved with the Set.ofList function externally after this code runs, which I'm still working on.
type NewProductAttributeInfo = {
AttributeId : string;
AttributeCategoryId : string
}
let rec private returnVariant (curIdx: int) (listLength: int)
(attList: (int * NewProductAttributeInfo * NewProductAttributeInfo) list)
(curList: NewProductAttributeInfo list) =
match curList with
| x when x.Length = listLength -> curList
| x ->
let attTup =
attList
|> List.filter (fun x' ->
let idx1,att1,att2' = x'
idx1 >= curIdx && not(curList
|> List.exists (fun x'' ->
x'' = att2'))
)
let idx1,att1,att2 = attTup |> List.head
let newList = curList # [att2]
returnVariant idx1 newList.Length attList newList
let rec calculateVariants (attList: NewProductAttributeInfo list)
(currentList: (int * NewProductAttributeInfo * NewProductAttributeInfo) list) =
// group attribute list by category id
let attGrouped = attList |> List.groupBy (fun x -> x.AttributeCategoryId)
let (firstGroupCatId,firstGroupDetails) = attGrouped.[0]
match currentList with
| [] ->
let rawVariants = [for nxt in 0 .. (attGrouped.Length - 1) do
if nxt > 0
then
// begin iteration
for d in firstGroupDetails do
let _,det = attGrouped.[nxt]
for det' in det do
yield (nxt, d, det')
]
calculateVariants attList rawVariants
| x ->
let groupLength = x |> List.groupBy (fun (idx,d0,nxtD) -> idx)
|> List.length |> ((+)1)
let sortedGroup = x |> List.sortBy (fun (x,y,z) -> x)
if groupLength > 2
then // below is the block that generates the duplicates
[for att in sortedGroup do
for attCompare in sortedGroup do
let idx1,att1,att2 = att
let idx2,attC1,attC2 = attCompare
if idx2 > idx1 && att2 <> attC2
then
let idString =
returnVariant idx2 groupLength x [att1; att2; attC2]
|> List.map (fun nl -> nl.AttributeId)
yield String.concat "," idString
]
else
[
for att in sortedGroup do
let idx1,att1,att2 = att
let idString =
returnVariant idx1 groupLength x [att1; att2]
|> List.map (fun nl -> nl.AttributeId)
yield String.concat "," idString
]

Time complexity O() of two two part functions

What would the time complexity be of these two algorithms?
let rec fol f a = function
| [] -> a
| x::xs -> fol f (f a x) xs;;
let mergelist xs = List.fol (#) [] xs
and
let rec folB f xs a =
match xs with
| [] -> a
| y::ys -> f y (folB f ys a);;
let mergelist2 xs = List.folB (#) xs []
and how would i be able to test it my self?
Should return something like
mergelist [[1;2];[];[3];[4;5;6]];;
val it : int list = [1; 2; 3; 4; 5; 6]
Here is a quick&dirty snippet of how you can compare the two operations with n lists of length 3 each:
let rec fol f a = function
| [] -> a
| x::xs -> fol f (f a x) xs;;
let rec folB f xs a =
match xs with
| [] -> a
| y::ys -> f y (folB f ys a);;
let compareThemFor n =
let testList = List.replicate n [1;2;3]
let count = ref 0
let myCons x xs =
incr count
x :: xs
let myApp ys =
List.foldBack myCons ys
let mergelist = fol myApp []
mergelist testList |> ignore
let countA = !count
count := 0
let mergelist2 xs = folB myApp xs []
mergelist2 testList |> ignore
let countB = !count
(countA, countB)
and this is what you will get:
> compareThemFor 2;;
val it : int * int = (3, 6)
> compareThemFor 3;;
val it : int * int = (9, 9)
> compareThemFor 4;;
val it : int * int = (18, 12)
> compareThemFor 5;;
val it : int * int = (30, 15)
> compareThemFor 6;;
val it : int * int = (45, 18)
as you can see the second is far better and I hope the comments above helps you understand why.
Just in case here is the n=3 version for mergelist:
mergelist [[1;2;3];[3;4;5];[6;7;8]]
{ second case in `fol` with `x=[1;2;3]` and `xs=[[3;4;5];[6;7;8]]` }
= fol (#) ([] # [1;2;3]) [[3;4;5];[6;7;8]] // one # of 0 elements = 0 operations
{ second case in `fol` with `x=[3;4;5]` and `xs=[[6;7;8]]` }
= fol (#) ([1;2;3] # [3;4;5]) [[6;7;8]] // one # of 3 elements = 3 operations
{ second case in `fol` with `x=[6;7;8]` and `xs=[]` }
= fol (#) ([1;2;3;3;4;5] # [6;7;8]) [] // one # of 6 elements = 6 operations
{ first case }
= [1;2;3;3;4;5;6;7;8] // 0+3+(3+3)=9 Operations Total
please note that you prepend [1,2,3] multiple times ...

Alternative approach to avoid "Incomplete pattern match" warning

I have written a function that takes an array as input and returns an array of equal size as output. For example:
myFunc [| "apple"; "orange"; "banana" |]
> val it : (string * string) [] =
[|("red", "sphere"); ("orange", "sphere"); ("yellow", "oblong")|]
Now I want to assign the results via a let binding. For example:
let [|
( appleColor, appleShape );
( orangeColor, orangeShape );
( bananaColor, bananaShape )
|] =
myFunc [| "apple"; "orange"; "banana" |]
Which works great...
> val orangeShape : string = "sphere"
> val orangeColor : string = "orange"
> val bananaShape : string = "oblong"
> val bananaColor : string = "yellow"
> val appleShape : string = "sphere"
> val appleColor : string = "red"
...except it produces a warning:
warning FS0025: Incomplete pattern matches on this expression. For example, the value '[|_; _; _; _|]' may indicate a case not covered by the pattern(s).
The source and reason for the warning has already been covered, I'm just looking for a succinct work-around. This function call occurs near the top of my function, and I don't like the idea of putting the entire function body inside a match:
let otherFunc =
match myFunc [| "apple"; "orange"; "banana" |] with
| [|
( appleColor, appleShape );
( orangeColor, orangeShape );
( bananaColor, bananaShape )
|] ->
// ... the rest of my function logic
| _ -> failwith "Something impossible just happened!"
That just smells bad. I don't like the idea of ignoring the warning either - goes against my better judgment. Are there any other options open to me, or do I just need to find a different approach entirely?
One possibility if you expect this kind of calling pattern to be frequent is to make wrappers that act on the sizes of tuples you expect, e.g.
myFunc3 (in1,in2,in3) =
match myFunc [|in1;in2;in3|] with
[|out1;out2;out3|] -> out1, out2, out3
_ -> failwith "Internal error"
etc. But all it does is move the ugly code to a standard place, and writing out the wrappers will be inconvenient.
I don't think there's any better option with this API, because there's no way to tell the compiler that myFunc always returns the same number of elements it is passed.
Another option might be to replace myFunc with an IDisposable class:
type MyClass() =
let expensiveResource = ...
member this.MyFunc(v) = ...calculate something with v using expensiveResource
interface IDisposable with
override this.Dispose() = // cleanup resource
and then use it in a block like
use myClass = new MyClass()
let appleColor, appleShape = myClass.MyFunc(apple)
...
Adapting #Ganesh's answer, here's a primitive way to approach the problem:
let Tuple2Map f (u, v)
= (f u, f v)
let Tuple3Map f (u, v, w)
= (f u, f v, f w)
let Tuple4Map f (u, v, w, x)
= (f u, f v, f w, f x)
Example:
let Square x = x * x
let (a,b) = Tuple2Map Square (4,6)
// Output:
// val b : int = 36
// val a : int = 16
But I guess something even more primitive would be this:
let Square x = x * x
let (a,b) = (Square 4, Square 6)
And if the function name is too long, e.g.
// Really wordy way to assign to (a,b)
let FunctionWithLotsOfInput w x y z = w * x * y * z
let (a,b) =
(FunctionWithLotsOfInput input1 input2 input3 input4A,
FunctionWithLotsOfInput input1 input2 input3 input4B)
We can define temporary function
let FunctionWithLotsOfInput w x y z = w * x * y * z
// Partially applied function, temporary function
let (a,b) =
let f = (FunctionWithLotsOfInput input1 input2 input3)
(f input4A, f input4B)

Resources