1 people like it.

Inclusive choice type: left value, right value, or both values

F#'s Choice type is exclusive. The "Both" type defined here allows for the possibility that both values are present. This allows us to zip together sequences of unequal length. Based on Haskell's "These" type and corresponding alignment functions. (See http://hackage.haskell.org/package/these-0.8/docs/Data-These.html and http://hackage.haskell.org/package/these-0.8/docs/Data-Align.html)

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
/// Inclusive choice type based on Haskell's "These" type.
type Both<'left, 'right> =
    | Left of 'left
    | Right of 'right
    | Both of ('left * 'right)

module Both =

    /// Zips two sequences together, producing a new sequence that
    /// is the same length as the *longer* of the two inputs.
    let align lefts rights =

        let pad items =
            seq {
                yield! items |> Seq.map Some
                yield! Seq.initInfinite (fun _ -> None)
            }

        Seq.zip (pad lefts) (pad rights)
            |> Seq.takeWhile (fun (leftOpt, rightOpt) ->
                leftOpt.IsSome || rightOpt.IsSome)
            |> Seq.map (function
                | (Some left, None) -> Left left
                | (None, Some right) -> Right right
                | (Some left, Some right) -> Both (left, right)
                | (None, None) -> failwith "Impossible")

    /// Splits a sequence of boths into its component parts.
    let unalign boths =
        boths
            |> Seq.map (function
                | Left left -> Some left, None
                | Right right -> None, Some right
                | Both (left, right) -> Some left, Some right)

    /// Aligns and combines two sequences.
    let malign (+) lefts rights =
        align lefts rights
            |> Seq.map (function
                | Left left -> left
                | Right right -> right
                | Both (left, right) -> left + right)

[<EntryPoint>]
let main argv =

    assert(
        let actual =
            Both.align [1; 2; 3] [4; 5]
                |> Seq.toList
        let expected =
            [
                Both (1, 4)
                Both (2, 5)
                Left 3
            ]
        actual = expected)

    assert(
        let actual =
            Both.unalign [
                Both (1, "one")
                Left 2
                Both (3, "three")
                Right "four"
            ] |> Seq.toList
        let expected =
            [
                Some 1, Some "one"
                Some 2, None
                Some 3, Some "three"
                None, Some "four"
            ]
        actual = expected)

    assert(
        let actual =
            Both.malign (+) [1; 2; 3] [4; 5]
                |> Seq.toList
        let expected = [5; 7; 3]
        actual = expected)

    0
union case Both.Left: 'left -> Both<'left,'right>
union case Both.Right: 'right -> Both<'left,'right>
Multiple items
union case Both.Both: ('left * 'right) -> Both<'left,'right>

--------------------
type Both<'left,'right> =
  | Left of 'left
  | Right of 'right
  | Both of ('left * 'right)

Full name: Script.Both<_,_>


 Inclusive choice type based on Haskell's "These" type.
val align : lefts:seq<'a> -> rights:seq<'b> -> seq<Both<'a,'b>>

Full name: Script.Both.align


 Zips two sequences together, producing a new sequence that
 is the same length as the *longer* of the two inputs.
val lefts : seq<'a>
val rights : seq<'b>
val pad : (seq<'c> -> seq<'c option>)
val items : seq<'c>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
union case Option.Some: Value: 'T -> Option<'T>
val initInfinite : initializer:(int -> 'T) -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.initInfinite
union case Option.None: Option<'T>
val zip : source1:seq<'T1> -> source2:seq<'T2> -> seq<'T1 * 'T2>

Full name: Microsoft.FSharp.Collections.Seq.zip
val takeWhile : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.takeWhile
val leftOpt : 'a option
val rightOpt : 'b option
property Option.IsSome: bool
val left : 'a
val right : 'b
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val unalign : boths:seq<Both<'a,'b>> -> seq<'a option * 'b option>

Full name: Script.Both.unalign


 Splits a sequence of boths into its component parts.
val boths : seq<Both<'a,'b>>
val malign : op_Addition:('a -> 'a -> 'a) -> lefts:seq<'a> -> rights:seq<'a> -> seq<'a>

Full name: Script.Both.malign


 Aligns and combines two sequences.
val rights : seq<'a>
val right : 'a
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val main : argv:string [] -> int

Full name: Script.main
val argv : string []
val actual : Both<int,int> list
Multiple items
union case Both.Both: ('left * 'right) -> Both<'left,'right>

--------------------
module Both

from Script

--------------------
type Both<'left,'right> =
  | Left of 'left
  | Right of 'right
  | Both of ('left * 'right)

Full name: Script.Both<_,_>


 Inclusive choice type based on Haskell's "These" type.
val toList : source:seq<'T> -> 'T list

Full name: Microsoft.FSharp.Collections.Seq.toList
val expected : Both<int,int> list
val actual : (int option * string option) list
val expected : (int option * string option) list
val actual : int list
val expected : int list
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/7Wj
Posted:5 years ago
Author:Brian Berns
Tags: choice , zip