F#: how to elegantly select and group discriminate

Question

Say I have a list of shapes:

type shape = 
| Circle of float
| Rectangle of float * float

let a = [ Circle 5.0; Rectangle (4.0, 6.0)]

How can I then test e.g. a Circle exists in a? I could create a function for each shape

let isCircle s = 
    match s with
    | Circle -> true
    | _ -> false
List.exists isCircle a

but I feel there must be a more elegant way in F#, other than having to define such a function for each shape type. Is there?

Related question is how to group a list of shapes, based on shape types:

a |> seq.groupBy( <shapetype? >)

Answer 1

If you're interested in the different categories of shapes, then it makes sense to define another type that exactly captures them:

type shapeCategory = Circular | Rectangular

let categorize = function
    | Circle _ -> Circular
    | Rectangle _ -> Rectangular

List.exists ((=) Circular) (List.map categorize a)

a |> Seq.groupBy(categorize)

Edit - as suggested by Brian, you can alternatively use active patterns instead of a new type. It works out pretty similarly for your examples, but would extend better to more complicated patterns, while the approach above may be better if you're code often works with the categories, and you want a nice union type for them instead of a Choice type.

let (|Circular|Rectangular|) = function 
    | Circle _ -> Circular
    | Rectangle _ -> Rectangular 

List.exists (function Circular -> true | _ -> false) a

let categorize : shape -> Choice<unit, unit> =  (|Circular|Rectangular|) 
a |> Seq.groupBy(categorize)

Answer 2

A more elegant solution could be the following:

let shapeExistsInList shapeType list =
    List.exists (fun e -> e.GetType() = shapeType) list

let circleExists = shapeExistsInList ((Circle 2.0).GetType()) a

However, I'm not very satisfied with this myself since you have to create an instance of the discriminated union for it to work.

Grouping by shape type could work in a similar fashion.

Answer 3

I want to add another solution that works with quotations for every union case, based on the one desco provided. Here it goes:

open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection

let rec isUnionCase = function
| Lambda (_, expr) | Let (_, _, expr) -> isUnionCase expr
| NewTuple exprs -> 
    let iucs = List.map isUnionCase exprs
    fun value -> List.exists ((|>) value) iucs
| NewUnionCase (uci, _) ->
    let utr = FSharpValue.PreComputeUnionTagReader uci.DeclaringType
    box >> utr >> (=) uci.Tag
| _ -> failwith "Expression is no union case."

Defined this way, isUnionCase works like desco has shown, but even on union cases that are empty or have more than one value. You can also enter a tuple of comma-separated union cases. Consider this:

type SomeType =
| SomeCase1
| SomeCase2 of int
| SomeCase3 of int * int
| SomeCase4 of int * int * int
| SomeCase5 of int * int * int * int

let list =
    [
        SomeCase1
        SomeCase2  1
        SomeCase3 (2, 3)
        SomeCase4 (4, 5, 6)
        SomeCase5 (7, 8, 9, 10)
    ]

list 
|> List.filter (isUnionCase <@ SomeCase4 @>)
|> printfn "Matching SomeCase4: %A"

list
|> List.filter (isUnionCase <@ SomeCase3, SomeCase4 @>)
|> printfn "Matching SomeCase3 & SomeCase4: %A"

The first isUnionCase I provided only worked for single case checks. I later added the expression check for NewTuple and thought you might like it. Just make sure that if you alter the code the precomputations still work, this is why iucs is defined outside of the returned anonymous function.

Answer 4

You can use the F# reflection library to get a value's tag:

let getTag (a:'a) = 
  let (uc,_) = Microsoft.FSharp.Reflection.FSharpValue.GetUnionFields(a, typeof<'a>)
  uc.Name

a |> Seq.groupBy getTag

Answer 5

you can combine F# reflection with quotations to get generic solution

type Shape = 
    | Circle of float
    | Rectangle of float * float

let isUnionCase (c : Expr<_ -> 'T>)  = 
    match c with
    | Lambdas (_, NewUnionCase(uci, _)) ->
        let tagReader = Microsoft.FSharp.Reflection.FSharpValue.PreComputeUnionTagReader(uci.DeclaringType)
        fun (v : 'T) -> (tagReader v) = uci.Tag
    | _ -> failwith "Invalid expression"

let a = 
    [ Circle 5.0; Rectangle (4.0, 6.0)] 
        |> List.filter (isUnionCase <@ Rectangle @>)
printf "%A" a