Factorial using only Algebraic Data Types and Pattern Matching

type Nat = Zero | Succ of Nat

let one = Succ Zero

let two = Succ (Succ Zero)

let three = Succ (Succ (Succ Zero))

let rec add x y = match x with

                  | Zero -> y

                  | Succ x -> Succ (add x y)

let rec mul x y = match y with

                  | Zero -> Zero

                  | Succ Zero -> x

                  | Succ y -> add x (mul x y)

let rec fac n = match n with

                | Zero -> Succ Zero

                | Succ x -> mul n (fac x)

open FsCheck

// Addition properties

Check.Quick (fun x y -> (add x y) = (add y x))

Check.Quick (fun x y z -> (add x (add y z)) = (add (add x y) z))

Check.Quick (fun x -> (add x Zero) = x)

// Multiplication properties

Check.Quick (fun x y -> (mul x y) = (mul y x))

Check.Quick (fun x y z -> (mul x (mul y z)) = (mul (mul x y) z))

Check.Quick (fun x -> (mul x one) = x)

Composing Contracts Part 4: Sample Usage

Composing contracts: an adventure in financial engineering
http://research.microsoft.com/en-us/um/people/simonpj/papers/financial-contracts/contracts-icfp.htm

open System

open ContractDataTypes

open Contracts

let t1 = Date(DateTime.Today.AddSeconds(10.0))

// zero-coupon bond

let c1 = zcb t1 10.0 USD

let ret = eval c1

ret.Subscribe(printf "%A")

Console.ReadLine ()

Composing Contracts Part 3: Sample Implementation

module Contracts

open System

open System.Linq

open ContractDataTypes

let date s = Date (DateTime.Parse s)

let one c = One c

let scale k c = Scale(k, c)

let konst x = rx { return x }

let (==*) l r = rx { let! x = l

                     let! y = r

                     return x = y }

let obsTime = rx { let! x = Observable.Interval(TimeSpan.FromSeconds(1.0))

                   return Date(DateTime.Today.AddSeconds (float x)) }

let at t = obsTime ==* (konst t)

let cWhen t c = When (t, c)

// zero-coupon bond

let zcb t x k = cWhen (at t) (scale (konst x) (one k))

let rec eval c = match c with

                 | When (t, c) -> rx { let! x = t

                                       if x then

                                            return! (eval c)  }

                 | Scale (k, c) -> rx { let! x = k

                                        let! y = eval c

                                        return x * y }

                 | One c -> match c with

                            | GBP -> rx { return Money (1.0, GBP) }

                            | USD -> rx { return Money (0.675310643, GBP) }

Composing Contracts Part 2: Signatures

module Contracts

open System

open ContractDataTypes

val date: String -> Date

val one : Currency -> Contract

val scale : IObservable<double> -> Contract -> Contract

val konst : 'a -> IObservable<'a>

val (==*) : IObservable<'a> -> IObservable<'a> -> IObservable<bool> when 'a : equality

val obsTime : IObservable<Date>

val at: Date -> IObservable<bool>

val cWhen: IObservable<bool> -> Contract -> Contract

// zero-coupon bond

val zcb : Date -> Double -> Currency -> Contract

val eval: Contract -> IObservable<Money>

Composing Contracts Part 1: Data Types

module ContractDataTypes

open System

open System.Linq

type Date = Date of DateTime

type Days = Days of TimeSpan

type Currency = GBP | USD

type Money = Money of float * Currency

    with static member (*) (k, Money (v, c)) = Money (k * v, c)

type Contract = | One of Currency

                | Scale of (IObservable<double> * Contract)

                | When of (IObservable<bool> * Contract)

type RxBuilder() =

    member this.Bind(m:IObservable<'a>, f:'a -> IObservable<'b>) =

        Observable.SelectMany(m, new Func<'a, IObservable<'b>> (f))

    member this.Return x = Observable.Return x

    member this.ReturnFrom x = x

    member this.Zero() = Observable.Empty()

let rx = RxBuilder()

Monad State Transformer

This is an attempt to write a State Monad Transformer.
I haven't been able to make it generic and according to
Brian McNamara "this will never be possible in any .NET language"


 http://cs.hubfs.net/forums/thread/13974.aspx

type StateT<'a, 'b, 'state> = StateT of ('state -> Parser<'a * 'state, 'b>)

type StateTBuilder (p:ParserMonad) =

    // a -> m a

    member this.Return a = StateT (fun s -> p.Return(a, s))

    //  m a -> (a -> m b) -> m b

    member this.Bind (m, f) =  StateT (fun s -> p {  let! (v, s') = let (StateT f) = m in f s

                                                     let (StateT f') = f v

                                                     return! f' s' })

let statefulParser = StateTBuilder(parser)

let getState = StateT (fun s -> parser.Return(s, s))

let setState s = StateT (fun _ -> parser.Return((), s))

let lift c = StateT (fun s -> parser.Bind (c, (fun x -> parser.Return (x, s))))

let Execute m s = let (StateT f) = m in

                  parser { let! (x,_) = f s

                           return x  }

SplitAt (Alternate definition)

let rec splitAt n xs = match (n, xs) with

                       | 0, xs -> ([], xs)

                       | _, [] -> ([], [])

                       | n, x::xs -> let (xs', xs'') = splitAt (n - 1) xs in

                                     (x::xs', xs'')

C# SplitEvery

private static IEnumerable<IEnumerable<T>> SplitEvery<T>(this IEnumerable<T> xs, int n)

{

    return xs.Unfold(ys => ys.Take(n), ys => ys.Any(), ys => ys.Skip(n));

}

private static IEnumerable<T> Unfold<T>(this T x, Func<T, T> h, Func<T, bool> p, Func<T, T> t)

{

    for (var i = x; p(i); i = t(i))

        yield return h(i);

}

SplitEvery (New version, no explicit recursion)

open System.Linq

let repeat x = Seq.initInfinite (fun _ -> x)

let scan = Seq.scan

let iterate f x = scan (fun l _ -> f l) x (repeat x)

let any = Enumerable.Any

let take n = fun xs -> Enumerable.Take (xs, n)

let skip n = fun xs -> Enumerable.Skip (xs, n)

let unfold h p t =  iterate t >> Seq.takeWhile p >> Seq.map h 

let splitAt n = unfold (take n) any (skip n)

C# Permutations (using Rx System.Interactive)

public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> xs)

{

    if (!xs.Any())

        return EnumerableEx.Return(Enumerable.Empty<T>());

    else

        return from zs in Permutations(xs.Skip(1))

               from i in Enumerable.Range(0, zs.Count() + 1)

               select zs.Take(i).Concat(EnumerableEx.Return(xs.First())).Concat(zs.Skip(i));                  

}