Strictly compute and memoize in discriminated unions, in F# - f#

I have a discriminated union, such as
type Dish =
| Eggs
| Spam of Dish
This is basically a linked list, without any content, e.g. Spam(Spam(Spam(Eggs))). I want to strictly perform a computation on this structure, such as counting the length, and memorize the result. In a normal type, I'd use class-local let bindings, but those aren't available in discriminated unions.
One way to do this would be,
type Count = int
type Dish =
| Eggs
| Spam of Dish * Count
But this is really messy, when the data I need is easily computable, but I still hope there is a better way (without using external mutable constructs).

One option is making the union cases private to hide the cached length.
//the 'guts' of Dish -- entirely hidden
type private DishImpl =
| Eggs
| Spam of DishImpl
// Dish wrapper type -- implementation hidden
type Dish =
private
| Dish of DishImpl * int
with
// O(1), just get the 'length' field
member x.Length = let (Dish(_, len)) = x in len
static member Eggs() = Dish(Eggs, 1)
static member Spam(Dish(dish, len)) = Dish(Spam dish, len + 1)
let eggs = Dish.Eggs()
let spam = Dish.Spam(eggs)
printfn "%d" eggs.Length //outputs: 1
printfn "%d" spam.Length //outputs: 2
To do it up right, create an accompanying module with let-bound functions and active patterns for destructuring.

If you tolerate a bit internal mutable state, here is a memoize function which creates a dictionary per function:
let memoize f =
let dict = Dictionary()
fun n ->
match dict.TryGetValue(n) with
| (true, v) -> v
| _ ->
let res = f(n)
dict.Add(n, res)
res
// This function results in a warning though
let rec length = memoize (function Eggs -> 0 | Spam d -> 1 + length d)
The approach isn't that bad since the mutable dictionary is hidden.
A purely functional approach could be using Map to hold values and a kind of State computation expression to hide Map values passing around. Please refer to this snippet to see how a memoize computation expression looks like.

There is also Memo Functions, Polytypically! by Ralph Hinze (2000). Adapting to F#:
type Dish =
| Eggs
| Spam of Dish
type DishTable<'T> =
{
Eggs : Lazy<'T>
Spam : Lazy<DishTable<'T>>
}
let rec tabulate (f: Dish -> 'T) : DishTable<'T> =
{
Eggs = lazy f Eggs
Spam = lazy tabulate (f << Spam)
}
let rec lookup (table: DishTable<'T>) (dish: Dish) : 'T =
match dish with
| Eggs -> table.Eggs.Value
| Spam x -> lookup table.Spam.Value x
let memo (f: Dish -> 'T) : (Dish -> 'T) =
lookup (tabulate f)
let rec len x =
match x with
| Eggs -> 0
| Spam x -> 1 + len x
let l2 = memo len

This is what I came up with. It's not true memoization because it counts eagerly when you call mem, but might work for your needs.
type Dish =
| Eggs
| Spam of Dish
| Memo of Dish * int
with
member d.length =
match d with
| Eggs -> 1
| Spam d -> 1 + d.length
| Memo (d, i) -> i
member d.mem =
match d with
| Eggs -> Memo(d, d.length)
| Spam d2 -> Memo(d, d.length)
| Memo(d2, i) -> d // no need to memo it again
let x = Spam (Spam(Spam Eggs))
let m = x.mem
x.length // val it : int = 4
m.length // val it : int = 4

Note that in your case, literally the only interesting property of a value of your type is its length, so you might as well just use integers as your representation instead:
let Eggs = 0
let Spam n = 1 + n
let (|Eggs|Spam|) = function
| 0 -> Eggs
| n -> Spam(n-1)
let length = id
// example usage
let dish = Spam(Spam(Eggs))
let l = length dish
let kind =
match dish with
| Eggs -> "Eggs"
| Spam(Eggs) -> "One Spam"
| Spam(Spam _) -> "At least two Spams"
If your real question is how to do this for a more interesting type, then one approach would be to create mutually recursive types, one of which is annotated:
type 'a AnnotatedDish = { dish : 'a Dish; value : 'a }
and 'a Dish =
| Eggs
| Spam of 'a AnnotatedDish
// "smart" constructors, given that you want to annotate with length
let eggs = { dish = Eggs; value = 0 }
let spam d = { dish = Spam d; value = 1 + d.value }
let length { value = l } : int = l
// active patterns
let (|Eggs|Spam|) = function
| { dish = Eggs } -> Eggs
| { dish = Spam d } -> Spam d
// example usage
let dish = spam(spam(eggs))
let l = length dish
let kind =
match dish with
| Eggs -> "Eggs"
| Spam(Eggs) -> "One Spam"
| Spam(Spam _) -> "At least two Spams"

After reviewing the answers, I've decided to go with a model that seems the least obtrusive to me. I've used a modified object to demonstrate how it would work in a slightly more complex scenario.
type StackDef<'a>(v : 'a, s : Stack<'a>) =
member val Length = s.Length + 1
member val Inner = v, s
and Stack<'a> =
| Empty
| Stack of StackDef<'a>
member this.Length =
match this with
| Empty -> 0
| Stack(def) -> def.Length
let Stack (v, s) = Stack(StackDef(v, s))
let (|Stack|Empty|) = function | Empty -> Empty | Stack(sd) -> Stack(sd.Inner)
//...
let example = Stack(1, Stack(2, Stack(3, Empty))).Length
It doesn't contain any external mutable state.
The discriminated union Dish (or in the example, Stack) continues to exist.
The field length doesn't appear in the union definition at all, nor is it provided by any constructor, just as it should be.
The memoized data is associated with the instance, as it should be.
However, having thought about it, by using a static weaver such as Afterthought it might be possible to replace any method such as:
Stack<'a> =
| Empty
| Stack of 'a * Stack<'a>
[<Lazy>] //custom attribute that would work with a static weaver
member this.Length =
match this with
| Empty -> 0
| Stack(_, s) -> s.Length + 1
With a private readonly Lazy<int> __length initialized in the constructor with a delegate that executes the above code, and change the actual content of the method to simply invoking __length.Value.
While F# doesn't allow union types to contain fields, possibly for very valid reasons, I highly doubt the IL would have such restrictions.
In fact, it would be possible to do a lot of things using some IL manipulation. Maybe it's something to think about.

Related

F# Extract value within Discriminated Union without matching

I have the following Discriminated Union (DU) declaration:
type Book =
| Dictionary of string[]
| Novel of int[]
| Comics of bool[]
An example:
let x = Dictionary [|"a"; "b"|]
How can I extract the length of the array inside without doing pattern matching and without caring about the data type of the array (in this case: string, int, bool). Note: I have no control over the DU declaration; as a result, I can't write new member method within Book, like getArrayLength()
Of course, we can do it in some way as followed:
match x with
| Dictionary (x: _[]) -> x |> Array.length
| Novel (x: _[]) -> x |> Array.length
| Comics (x: _[]) -> x |> Array.length
But typing x |> Array.length a lot is incovenient. This is a simple example, but we can think of a general problem:
type Animal =
| Dog of DogClass
| Cat of CatClass
| Cow of CowClass
...
... and DogClass, CatClass, etc. may share something. We want to get that shared thing. E.g. those classes inherit from AnimalClass, within which there is countLegs() method. Suppsed there are many animals, pattern matching for all of them while the code block after -> is almost the same. I love the principle DRY (Don't Repeat Yourself).
Is there any convenient way to tackle such problem?
==
EDITED 21.10.2019
I was also looking for some syntax like:
let numEles =
match x with
| _ (arr: _[]) -> x |> Array.Length
| _ -> failwith "No identifiers with fields as Array."
let numLegs =
match anAnimall with
| _ (animal: ?> Animal) -> animal.countLegs()
| _ -> failwith "Can't count legs because of not being an animal."
I think this still follows the spirit of matching, but seem like this approach is not supported.
Realistically, there's no getting around pattern matching here. DUs were, in a way, built for it. Since you don't control the type, you can always add a type extension:
type Book with
member this.Length =
match this with
| Dictionary d -> d.Length
| Novel n -> n.Length
| Comics c -> c.Length
let x = Dictionary [|"a"; "b"|]
printfn "%d" x.Length // Prints 2
Though it's also equally valid to define a Book module with a length function on it if you prefer that:
module Book =
let length b =
match b with
| Dictionary d -> d.Length
| Novel n -> n.Length
| Comics c -> c.Length
let x = Dictionary [|"a"; "b"|]
printfn "%d" (x |> Book.length) // prints 2
But you'll need to write a pattern match expression on the Book type at least once. The fact that every case is made up of data that all has the same property doesn't really help the fact that you need to still identify every case individually.

Can one set default values for Discriminated Union types?

I implemented a Discriminated Union type that would be used to select a function:
type BooleanCombinator =
| All
| Some
| None
| AtLeast of int
| MoreThan of int
| NotMoreThan of int
| LessThan of int
| ExactlyOne
| ExactlyTwo
| AllButOne
| AllButTwo
let boolToInt (b: bool) : int = if b then 1 else 0
let combineBooleans (combinator : BooleanCombinator)
(bools : bool list)
: bool =
let n = List.sumBy boolToInt bools
match combinator with
| BooleanCombinator.All -> List.forall id bools
| BooleanCombinator.Some -> bools |> List.exists id
| BooleanCombinator.None -> bools |> List.exists id |> not
| BooleanCombinator.AtLeast i -> n >= i
| BooleanCombinator.MoreThan i -> n > i
| BooleanCombinator.NotMoreThan i -> n <= i
| BooleanCombinator.LessThan i -> n < i
| BooleanCombinator.ExactlyOne -> n = 1
| BooleanCombinator.ExactlyTwo -> n = 2
| BooleanCombinator.AllButOne -> n = bools.Length - 1
| BooleanCombinator.AllButTwo -> n = bools.Length - 2
This looked Ok to me but the compiler started to look at all instances of Some and None as belonging to this DU, instead of the Option DU.
I do not want to go through all of my code replacing Some with Option.Some and None with Option.None.
Is there a way to tell the compiler that unqualified Some and None are actually Option.Some and Option.None?
Or should I just give different names to these DU cases, like AtLeastOne and ExactlyZero
The general rule for resolving name collisions in F# is "last declaration wins". Because your custom DU is declared after Option, its constructors Some and None win over those of Option.
But this rule offers a way to fix the problem: you just need to "reassert" the declarations after your custom DU:
type Bogus = Some of int | None
let g = function Some _ -> 42 | None -> 5
let x = Some 42
let inline Some a = Option.Some a
let inline None<'a> = Option.None : 'a option
let (|Some|None|) = function | Option.Some a -> Some a | Option.None -> None
let f = function Some _ -> 42 | None -> 5
let y = Some 42
If you inspect the types of g, x, f, and y in the above code:
> g
g : Bogus -> int
> f
f : 'a option -> int
> x
Bogus
> y
int option
The function g and value x were inferred to have type Bogus -> int and Bogus respectively, because Some and None in their bodies refer to Bogus.Some and Bogus.None.
The function f and value y were inferred to have Option-related types, because Some and None in their bodies refer to the Some function and the (|Some|None|) active pattern that I defined just above.
Of course, this is a rather hacky way to restore status quo. This will convince the compiler, but humans will still have a hard time reading your code. I suggest you rename the cases of your DU instead.
You can mark your DU with [<RequireQualifiedAccess>] attribute.
This means that you will be required to qualify the case name with the type whenever you use it in the code - which is something you do now anyway in your match expression.
That way an unqualified Some would still be resolved to mean Option.Some, despite the fact that you reuse the name.
It's a useful technique to know when you want to use a snappy name for a DU case - like None, Yes, Failure etc. - that by itself would be ambiguous or confusing to the reader (or the compiler, for that matter).

How do I separate case ids from case values on a Discriminated Union?

I want to build a dictionary from a list of items.
An item has the following definition:
type Item =
| A of TotalPrice * Special
| B of TotalPrice * Special
| C of TotalPrice
| D of TotalPrice
I want the keys of the dictionary to map to the case ids:
| A
| B
| C
| D
I would then have the values for the case id be a list.
How do I separate the case ids from the case values?
Example:
let dictionary = items |> List.map (fun item -> item) // uh...
Appendix:
module Checkout
(*Types*)
type UnitPrice = int
type Qty = int
type Special =
| ThreeForOneThirty
| TwoForFourtyFive
type TotalPrice = { UnitPrice:int ; Qty:int }
type Item =
| A of TotalPrice * Special
| B of TotalPrice * Special
| C of TotalPrice
| D of TotalPrice
(*Functions*)
let totalPrice (items:Item list) =
let dictionary = items |> List.map (fun item -> item) // uh...
0
(*Tests*)
open FsUnit
open NUnit.Framework
[<Test>]
let ``buying 2 A units, B unit, A unit = $160`` () =
// Setup
let items = [A ({UnitPrice=50; Qty=2} , ThreeForOneThirty)
B ({UnitPrice=30; Qty=1} , TwoForFourtyFive)
A ({UnitPrice=50; Qty=1} , ThreeForOneThirty)]
items |> totalPrice |> should equal 160
Your data is badly defined for your use case. If you want to refer to the kinds of items by themselves, you need to define them by themselves:
type ItemKind = A | B | C | D
type Item = { Kind: ItemKind; Price: TotalPrice; Special: Special option }
Then you can easily build a dictionary of items:
let dictionary = items |> List.map (fun i -> i.Kind, i) |> dict
Although I must note that such dictionary may not be possible: if the items list contains several items of the same kind, some of them will not be included in the dictionary, because it can't contain multiple identical keys. Perhaps I didn't understand what kind of dictionary you're after.
If you want to create the dictionary with keys like A, B, C and D you will fail because A and B are constructors with type TotalPrice * Special -> Item and C and D are constructors of type TotalPrice -> Item. Dictionary would have to make a decision about type of keys.
Getting DU constructor name should be doable by reflection but is it really necessary for your case?
Maybe different type structure will be more efficient for your case, ie. Fyodor Soikin proposal.
Maybe the following will clarify somewhat why datastructure and code is no good, and as such also clarify that this mainly is not related to FP as indicated in some of the comments et al.
My guess is that the question is related to "how can this be grouped", and lo and behold, there is in fact a groupBy function!
(*Types*)
type UnitPrice = int
type Qty = int
type Special =
| ThreeForOneThirty
| TwoForFourtyFive
type TotalPrice = { UnitPrice:int ; Qty:int }
type Item =
| A of TotalPrice * Special
| B of TotalPrice * Special
| C of TotalPrice
| D of TotalPrice
let items = [A ({UnitPrice=50; Qty=2} , ThreeForOneThirty)
B ({UnitPrice=30; Qty=1} , TwoForFourtyFive)
A ({UnitPrice=50; Qty=1} , ThreeForOneThirty)]
let speciallyStupidTransformation =
function
| ThreeForOneThirty -> 34130
| TwoForFourtyFive -> 2445
let stupidTransformation =
function
| A (t,s) -> "A" + (s |> speciallyStupidTransformation |> string)
| B (t,s) -> "B" + (s |> speciallyStupidTransformation |> string)
| C (t) -> "C"
| D(t) -> "D"
let someGrouping = items |> List.groupBy(stupidTransformation)
val it : (string * Item list) list =
[("A34130",
[A ({UnitPrice = 50;
Qty = 2;},ThreeForOneThirty); A ({UnitPrice = 50;
Qty = 1;},ThreeForOneThirty)]);
("B2445", [B ({UnitPrice = 30;
Qty = 1;},TwoForFourtyFive)])]
Yeah its still a bad idea. But its somewhat grouped uniquely, and may be misused further to aggregate some sums or whatever.
Adding some more code for that, like the following:
let anotherStupidTransformation =
function
| A(t,_) -> (t.UnitPrice, t.Qty)
| B(t,_) -> (t.UnitPrice, t.Qty)
| C(t) -> (t.UnitPrice, t.Qty)
| D(t) -> (t.UnitPrice, t.Qty)
let x4y x y tp q =
if q%x = 0 then y*q/x else tp/q*(q%x)+(q-q%x)/x*y
let ``34130`` = x4y 3 130
let ``2445`` = x4y 2 45
let getRealStupidTotal =
function
| (s, (tp,q)) ->
(s|> List.ofSeq, (tp,q))
|> function
| (h::t, (tp,q)) ->
match t |> List.toArray |> System.String with
| "34130" -> ``34130`` tp q
| "2445" -> ``2445`` tp q
| _ -> tp
let totalPrice =
items
|> List.groupBy(stupidTransformation)
|> List.map(fun (i, l) -> i,
l
|> List.map(anotherStupidTransformation)
|> List.unzip
||> List.fold2(fun acc e1 e2 ->
((fst acc + e1) * e2, snd acc + e2) ) (0,0))
|> List.map(getRealStupidTotal)
|> List.sum
val totalPrice : int = 160
might or might not yield some test cases correct.
For the above testdata as far as I can read the initial code at least is ok. The sum does get to be 160...
Would I use this code anywhere? Nope.
Is it readable? Nope.
Is it fixable? Not without changing the way the data are structured to avoid several of the stupid transformations...

Unable to resolve error regarding "option" when retrieving value from tuple

I just don't understand what the compiler is trying to tell me here:
let someCard = getFirstCard hand
Error:
This expression was expected to have type
Card * Card
but here has type
(Card * Card) option
I then tried this:
let getFirstCard (hand:Card*Card) = function
| card1, card2 -> Some(card1)
But I get the same error.
I just don't get the Options template.
I continue to struggle with this.
My code is below:
type Suit = | Spades| Clubs | Diamonds | Hearts
type Face = | Two | Three | Four | Five
| Six | Seven | Eight | Nine | Ten
| Jack | Queen | King | Ace
type Card = {Face:Face; Suit:Suit}
type Deal = | Hand of Card * Card
| Hit of Card
let private suits = [Spades; Clubs; Diamonds ; Hearts]
let private faces = [Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;
Jack; Queen; King; Ace]
let deck = [for suit in suits do
for face in faces do
yield {Face=face; Suit=suit}]
let hitPlayer (deck:Card list) =
(deck.Head, deck.Tail)
let shuffle xs =
let swap i j (array : _[]) =
let tmp = array.[i]
array.[i] <- array.[j]
array.[j] <- tmp
let rnd = System.Random()
let xArray = Seq.toArray xs
let n = Array.length xArray
for i in [0..(n-2)] do
let j = rnd.Next(i, n-1)
swap i j xArray
xArray |> Seq.toList
let deal = function
| card1::card2::remaining -> Some(card1, card2), remaining
| _ -> None, [];;
let getFirstCard (hand:Card*Card) = function
| card1, card2 -> card1
let hand, deckRemaining = deal (shuffle deck);;
let someCard = getFirstCard hand
The getFirstCard function has the type Card * Card -> 'a * 'b -> 'a (which, BTW, looks strange, to say the least). It does, however, expect its first parameter to be of the type Card * Card.
hand, on the other hand (pun intended), has the type (Card * Card) option. This means that it may contain a Card * Card value, but it also may not. You'll need to tell your program how to deal with both cases.
As we've discussed before, the Option type is an 'elevated world', and the most appropriate strategy is to stay in that elevated world until you can deal with all cases. Here's one way to do it:
let someCard = hand |> Option.map getFirstCard
This still doesn't work because of the weird implementation of getFirstCard.
Looking at the implementation of getFirstCard, though, I get the impression that what you attempt to do is to get the first card out of a tuple of cards. This, however, can be written as:
let getFirstCard (card1, card2) = card1
That function is already built into F#, although there's nothing wrong with giving it a domain-specific name. In that case, though, I'd suggest aliasing it instead:
let getFirstCard = fst
Given one of the two above definitions of getFirstCard, the expression
let someCard = hand |> Option.map getFirstCard
gives you a someCard value of the type Card option. You'll notice that we've stayed in the 'elevated' Option world.
Specifically, though, someCard has this value:
> someCard;;
val it : Card option = Some {Face = King;
Suit = Clubs;}
You'll note that it isn't just King of Clubs, but Some King of Clubs.
Try this :
let getFirstCard (hand) =
match hand with
| Some(x) -> Some (fst x)
|_ -> None
let hand, deckRemaining = deal (shuffle deck);;
let someCard = getFirstCard hand
It compiles & runs for me.
Actually, function getFirstCard could be renamed as a generic fun on tuples :
let getFirstOfTupleOption tup =
match tup with
| Some (x) -> Some (fst x)
| _ -> None
Alternatively, you may want explicit type restriction on your domain with :
let getFirstCard (hand:(Card*Card) option) =
match hand with
| Some(x) -> Some (fst x)
|_ -> None

Conversion between types in discriminated unions

I have a function, which can returns different types, and I use discriminated union for this. What I need, is to have conversion from one type in discriminated union to another type.
Also some of the types can be convertable to all other types (String), but some of the types can be converted only to String (MyCustomType)
For this I've added member method ConvertTo to the ResultType:
type MyTypes =
| Boolean = 1
| Integer = 2
| Decimal = 3
| Double = 4
| String = 5
| MyCustomType = 6
type ResultType =
| Boolean of bool
| Integer of int
| Decimal of decimal
| Double of double
| String of string
| MyCustomType of MyCustomType
with
member this.ConvertTo(newType: MyTypes) =
match this with
| ResultType.Boolean(value) ->
match newType with
| MyTypes.Boolean ->
this
| MyTypes.Integer ->
ResultType.Integer(if value then 1 else 0)
...
| ResultType.MyCustomType(value) ->
match newType with
| MyTypes.MyCustomType ->
this
| MyTypes.String ->
ResultType.String(value.ToString())
| _ ->
failwithf "Conversion from MyCustomType to %s is not supported" (newType.ToString())
I don't like such construction, because if I add more types, this requires me to do many changes: MyTypes, ResultType and also in several places in the ConvertTo member function.
Can anybody suggest better solution for such types conversion?
Thanks in advance
With a slightly different design, it is possible to exploit System.Convert.ChangeType and the fact that the constructors of discriminated unions are actually functions:
// statically typed wrapper for System.Convert.ChangeType
let conv a : 'T = System.Convert.ChangeType(a, typeof<'T>) :?> 'T
type MyCustomType() = class end
type ResultType =
| Boolean of bool
| Integer of int
| Decimal of decimal
| Double of double
| String of string
| MyCustomType of MyCustomType
with
member this.ConvertTo (newType:'T->ResultType) =
match this with
| Boolean b -> newType( conv b )
| Integer i -> newType( conv i )
| Decimal d -> newType( conv d )
| Double d -> newType( conv d )
| String s -> newType( conv s )
| MyCustomType m ->
if typeof<'T> <> typeof<string> then
raise (new System.InvalidCastException("MyCustomType can only be converted to String"))
else
String (m.ToString())
let i = Integer 42
let b = i.ConvertTo Boolean
printfn "%A" b
let d = i.ConvertTo Decimal
printfn "%A" d
let d2 = i.ConvertTo Double
printfn "%A" d2
let s = i.ConvertTo String
printfn "%A" s
//let mi = i.ConvertTo MyCustomType // throws InvalidCastException
let m = MyCustomType (new MyCustomType())
let sm = m.ConvertTo String
printfn "%A" sm
//let im = m.ConvertTo Integer // throws InvalidCastException
EDIT: Once you add more custom types, this will not help much.
Maybe you should make your custom types implement IConvertible. Then you can remove the special case code from ConvertTo and completely rely on System.Convert.ChangeType.
You would still have to extend every custom type's ToObject implementation whenever you add a new custom type. Whether that really is better than a central ConvertTofunction is debatable.
Why are you wanting to do type conversion to begin with? Discriminated Unions are a good way of hiding type information until you need it and abstract complexity away. Generally you have a match statement in a function that consumes this type and then you only cast if you need to.
If you're trying to make some type of parser or language engine then you have no choice but to define all the cast or at least their error states. If you wouldn't mind elaborating on why / what you would use this for, maybe I could suggest another approach.
An aside: F# and .NET in general doesn't support overloading of return types.

Resources