Bugfree.dk – Ronnie Holm's blog

One aspect of many functional languages that’s always fascinated me is the ease with which you can express a recursive structure, such as a language, and have it evaluated. Suppose you want to define the grammar of a DSL of propositions, in F# you could do so using the discriminated union type:

type Proposition =
    | True
    | And of Proposition * Proposition
    | Or of Proposition * Proposition
    | Not of Proposition

In an object-oriented language like C#, this definition would be analogous to a hierarchy of classes. Proposition would be the base class of True, And, Or, and Not. Each would then have a constructor that accepts some number of arguments, e.g., the And constructor would accept a two-tuple, two propositions, making the Proposition type recursive. In C# you might even model the recursive relationship using the Composite pattern.

In F#, an instance of the Proposition type may be created using a constructor syntax that resembles that of a function call:

let p = And(Or(True, Not(True)), Not(Not(True)))

Now, because of the recursive nature of the Proposition type, instances of it form a parse tree-like structure:

                        And
                        /\
                       /  \
                      Or  Not
                      /\    \
                     /  \    \
                  True  Not  Not
                          \    \
                           \    \
                          True  True

Having a parse tree is not very useful in itself. What you need is some way to execute or evaluate it. Given the recursive nature of the grammar, it makes sense for the evaluator to be recursively defined as well. The evaluator would do pattern matching on the node type, deconstructing it into the parts needed to evaluate it. Since our language of propositions maps directly to the boolean operations of F#, it’s very simple to evaluate the parse tree:

let rec eval (p: Proposition) =
    match p with
    | True -> true
    | And(p1, p2) -> eval p1 && eval p2
    | Or (p1, p2) -> eval p1 || eval p2
    | Not(p1) -> not (eval p1)

let e = eval p // e : bool = true

The simple language of propositions doesn’t take into account operator precedence and associativity, variables, and so on. But the features of F# used here allow for more complicated languages to be expressed and evaluated directly. With C#, you’d often fallback to describing the grammar of more complex languages in Backus-Naur form and feeding it to a parser generator that would map the node types of the parse tree to classes and be able to form a valid parse tree of some input.

It’s been a while since I last took a serious look at F#. Back then I did a simple random fractal terrain generator which, even though the algorithm is simple, I found challenging to do. Nevertheless, functional programming is just one of those areas that I keep returning to. This time around I want to use the event receiver for versioning attachments in SharePoint lists to get familiar with object-oriented F#. Of course, translating a C# class to an F# class, the result will look like C# with different syntax and better type inference. The point here is to use classes in F# as a way to expose functionality to other .NET languages. In a real-world F# application the core logic would likely not be object-oriented.

namespace Dk.Bugfree

open System
open System.Globalization
open Microsoft.SharePoint

type public ListAttachmentVersioningEventReceiver() =
    inherit SPItemEventReceiver()

    member private r.CustomVersion = "CustomVersion"
    member private r.ShadowLibrary = "ShadowLibrary"

    // override ItemAdded : properties:SPItemEventProperties -> unit
    override r.ItemAdded properties =
        base.ItemAdded properties
        r.SetCustomVersionLabel properties.ListItem
        r.CreateSnapshot properties

    // override ItemUpdated : properties:SPItemEventProperties -> unit
    override r.ItemUpdated properties =
        base.ItemUpdated properties
        let item = properties.ListItem

        if r.RollbackHappened item then
            r.RestoreSnapshot properties
            r.SetCustomVersionLabel item
            r.CreateSnapshot properties
        else
            r.CreateSnapshot properties
            r.SetCustomVersionLabel item

    // member private CreateSnapshot : properties:SPItemEventProperties -> unit
    member private r.CreateSnapshot properties =
        use site = properties.OpenWeb()
        let item = properties.ListItem
        let shadowLibrary = site.Lists.[r.ShadowLibrary] :?> SPDocumentLibrary
        let path = String.Format("Versions/{0}/{1}", item.ID, r.GetOfficialVersionLabel(item))
        let shadowFolder = r.CreateFolderPath shadowLibrary path

        item.Attachments |> Seq.cast |> Seq.iter (fun fileName ->
            let existingFile = item.ParentList.ParentWeb.GetFile(item.Attachments.UrlPrefix + fileName)
            let newFile = shadowFolder.Files.Add(fileName, existingFile.OpenBinaryStream())
            newFile.Item.Update())

    // member private RollbackHappened : item:SPListItem -> bool
    member private r.RollbackHappened item =
        let culture = CultureInfo.InvariantCulture
        let currentVersion = Single.Parse(r.GetOfficialVersionLabel(item), culture)
        let lastVersion = Single.Parse(r.GetCustomVersionLabel(item), culture)
        currentVersion > lastVersion + 1.0f

    // member private RestoreSnapshot : properties:SPItemEventProperties -> unit
    member private r.RestoreSnapshot properties =
        let item = properties.ListItem
        let restoreVersion = r.GetCustomVersionLabel item
        r.EventFiringEnabled <- false    

        item.Attachments |> Seq.cast |> Seq.map (fun fileName -> unbox<string> fileName) |> Seq.toList
                         |> Seq.iter (fun fileName -> item.Attachments.Delete(fileName))

        use site = properties.OpenWeb()
        let path = String.Format("Versions/{0}/{1}", item.ID, restoreVersion)
        let shadowLibrary = site.Lists.[r.ShadowLibrary] :?> SPDocumentLibrary
        let source = r.CreateFolderPath shadowLibrary path

        source.Files |> Seq.cast |> Seq.iter (fun file ->
            let unboxedFile = unbox<SPFile> file
            item.Attachments.Add(unboxedFile.Name, unboxedFile.OpenBinary()))

        item.SystemUpdate false
        r.EventFiringEnabled <- true

    // member private CreateFolderPath : list:SPDocumentLibrary -> path:string -> SPFolder
    member private r.CreateFolderPath list path : SPFolder =
        r.CreateFolderPathRecursive list.RootFolder (path.Split [|'/'|] |> Array.toList)

    // member private CreateFolderPathRecursive : folder:SPFolder -> pathComponents:string list -> SPFolder
    member private r.CreateFolderPathRecursive folder pathComponents =
        match pathComponents with
        | [] -> folder
        | head :: tail ->
            try
                let existingFolder = folder.SubFolders.[head]
                r.CreateFolderPathRecursive existingFolder tail
            with
                :? ArgumentException ->
                    let newFolder = folder.SubFolders.Add head
                    r.CreateFolderPathRecursive newFolder tail

    // member private SetCustomVersionLabel : item:SPListItem -> unit
    member private r.SetCustomVersionLabel item =
        r.EventFiringEnabled <- false
        item.[r.CustomVersion] <- r.GetOfficialVersionLabel item
        item.SystemUpdate false
        r.EventFiringEnabled <- true  

    // member private GetCustomVersionLabel : item:SPListItem -> string
    member private r.GetCustomVersionLabel item =
        item.[r.CustomVersion] :?> string

    // member private GetOfficialVersionLabel : item:SPListItem -> string
    member private r.GetOfficialVersionLabel item =
        item.Versions.[0].VersionLabel

A couple of things to note about the F# implementation: first, it hardly specifies any types. They’re inferred by the compiler. Where type names do appear, it’s mainly because they’re required to unbox elements of an IEnumerable collection. Secondly, F# has flexible self identifiers. Methods must explicitly specify the name of the this reference in C# and use it when accessing members. Thirdly, arguments to general .NET methods are passed as a tuple value, i.e., as comma-delimited arguments surrounded by parenthesis.

In Generating 2D random fractal terrains with C# I implemented 1D midpoint displacement in an imperative language. Since I’m currently making my way through Robert Pickering‘s Foundations of F#, in this post I want to redo it in F#.

The first step along the way is the maxDisplacements function that, given a number of splits of line segments, returns a list of maximum displacements. Here list comprehension comes in handy as a way to generate maximum displacements where the next is half of that of the previous, starting with 0.5:

    let maxDisplacements n = [for i in 1 .. n -> 2.0**(float)(-i)]

Next is the composeCoordinates function whose job it is to infer the x coordinates from the y coordinates. When splitting line segments, as defined later by the split function, only y coordinates need to be dealt with. But for displaying the result as a list of points, e.g., as input to a graphing program, composeCoordinates generates the (x, y) coordinate pairs given a list of y coordinates. Again list comprehension is used to uniformly distribute the x coordinates in the range 0 to 1. Next, the x and y coordinates are fused using the build-in zip function, i.e., [x1; x2] and [y1; y2] become [(x1, y1); (x2, y2)].

    let composeCoordinates (ys : list<float>) =
        let dx = 1.0 / (float)(ys.Length - 1)
        let xs = [for x in 0 .. ys.Length - 1 -> (float)x * dx]
        List.zip xs ys

Now for the crux of the fractal generation process: the split function. As is customary with functional languages, looping is done using recursion and split is no exception. Passing in a list of y coordinates, a maximum displacement as generated by maxDisplacements, and a random number generator, split is defined as:

    let rec split (ys : list<float>) displacement (random : Random) =
        match ys with
        | a :: b :: tail ->
            let m = b - a / 2.0
            let r = random.NextDouble() * displacement
            a :: a + m + r :: split (b :: tail) displacement random
        | a -> a

Using pattern matching, an if-then-else construct on steroids, split examines its input of y coordinates to determine if the inductive or the base case of the recursive implementation needs to be invoked. The first pattern matches a list starting with elements a and b following by zero or more elements. In case this pattern matches, a new list is returned. It’s composed of the original a element, a new displaced element, the original b element, and split applied to the original list with its first element removed. Removing one element at a time, at some point only one element is left in the list in which case the base case is invoked. When this happens, all the original line segments have been split in two.

Finally, the main function ties together the previous ones. Given an initial line segment, the number of times to apply split to it, and a random number generator, the actual splitting is done using the build-in fold_left function. fold_left is an example of fun with folds and a function that is itself recursively defined to make looping implicit.

    let main() =
        let initial = [0.0; 0.0]
        let splits = 8
        let r = new Random()
        let ys = List.fold_left (fun s d -> split s d r) initial (maxDisplacements splits)
        print_any (composeCoordinates ys)

While initially hard to grog, the use of fold_left becomes clearer when applied to a list of integers to compute their product. Of the three arguments to fold_left the first is a function defined by a lambda expression (here the predefined multiplication operator is also applicable but less explicit). The second argument is the initial value of an accumulator. And finally, the third argument is the list to work on.

    List.fold_left (fun x y -> x * y) 1 [1;2;3]
    List.fold_left (*) 1 [1;2;3]

What fold_left does is recursively call itself passing along the first argument as is. The second argument is the new value of the accumulator, computed by passing to the function of the first argument the original value of the accumulator and the first element of the list. That way it’s up to the function passed as the first argument to decide what operation to apply to the elements in the list. The third argument is the original list with the first element removed. The recursive chain of calls with their arguments then takes on this form:

    List.fold_left (fun 1 1 -> 1 * 1) 1 [1;2;3]
    List.fold_left (fun 1 2 -> 1 * 2) 1 [2;3]
    List.fold_left (fun 2 3 -> 2 * 3) 2 [3]

Within the main function the first argument to fold_left is a lambda expression that applies the split function to a list. The second argument, the accumulator, isn’t a scalar like with the product example, but a list of line segments to be passed to split. Finally, the third argument is the maximum displacement list. And so for the original line segment to be split n times, n maximum displacements must be provided by the maxDisplacements function.