Catamorphism examples. Related blog post: http://fsharpforfunandprofit.com/posts/recursive-types-and-folds-1b/

RecursiveTypesAndFold-1b.fsx

(*
RecursiveTypesAndFold-1b.fsx

Related blog post: http://fsharpforfunandprofit.com/posts/recursive-types-and-folds-1b/
*)
 
// ==============================================
// PART 1b - Catamorphism examples
// ==============================================



// ==============================================
// FileSystemExample
// ==============================================

module FileSystemExample = 

    type FileSystemItem =
        | File of File
        | Directory of Directory
    and File = {name:string; fileSize:int}
    and Directory = {name:string; dirSize:int; subitems:FileSystemItem list}

    // ---------------------------------
    // Sample data
    // ---------------------------------

    let readme = File {name="readme.txt"; fileSize=1}
    let config = File {name="config.xml"; fileSize=2}
    let build  = File {name="build.bat"; fileSize=3}
    let src = Directory {name="src"; dirSize=10; subitems=[readme; config; build]}
    let bin = Directory {name="bin"; dirSize=10; subitems=[]}
    let root = Directory {name="root"; dirSize=5; subitems=[src; bin]}


    // ---------------------------------
    // define "cata"
    // ---------------------------------

    let rec cataFS fFile fDir item :'r = 
        let recurse = cataFS fFile fDir 
        match item with
        | File file -> 
            fFile file
        | Directory dir -> 
            let listOfRs = dir.subitems |> List.map recurse 
            fDir (dir.name,dir.dirSize,listOfRs) 

    (*
    // case constructor
    File  : File -> FileSystemItem

    // function parameter to handle File case 
    fFile : File -> 'r

    // case constructor (Directory as record)
    Directory : Directory -> FileSystemItem

    // case constructor (Directory unpacked as tuple)
    Directory : (string,int,FileSystemItem list) -> FileSystemItem
    // replace with 'r ===> ~~~~~~~~~~~~~~          ~~~~~~~~~~~~~~

    // function parameter to handle Directory case 
    fDir :      (string,int,'r list            ) -> 'r
    *)

    (*
    val cataFS :
        fFile : (File -> 'r) ->
        fDir  : (string * int * 'r list -> 'r) -> 
        // input value
        FileSystemItem -> 
        // return value
        'r
    *)

    // ---------------------------------
    // Define and test "totalSize" 
    // ---------------------------------

    let totalSize fileSystemItem =
        let fFile (file:File) = 
            file.fileSize
        let fDir (name,size,subsizes) = 
            (List.sum subsizes) + size
        cataFS fFile fDir fileSystemItem

    readme |> totalSize  // 1
    src |> totalSize     // 16 = 10 + (1 + 2 + 3)
    root |> totalSize    // 31 = 5 + 16 + 10

    // ---------------------------------
    // Define and test "largestFile" 
    // ---------------------------------

    // largest file
    let largestFile fileSystemItem =

        // helper to provide a default if missing
        let ifNone deflt opt =
            defaultArg opt deflt 

        // helper to get the size of a File option
        let fileSize fileOpt = 
            fileOpt 
            |> Option.map (fun file -> file.fileSize)
            |> ifNone 0

        // handle File case
        let fFile (file:File) = 
            Some file

        // handle Directory case
        let fDir (name,size,subfiles) = 
            match subfiles with
            | [] -> 
                None  // empty directory
            | subfiles -> 
                // find the biggest File option using the helper
                subfiles 
                |> List.maxBy fileSize  

        // call the catamorphism
        cataFS fFile fDir fileSystemItem

    readme |> largestFile  
    // Some {name = "readme.txt"; fileSize = 1}

    src |> largestFile     
    // Some {name = "build.bat"; fileSize = 3}

    bin |> largestFile     
    // None

    root |> largestFile    
    // Some {name = "build.bat"; fileSize = 3}


// ==============================================
// ProductExample
// ==============================================

module ProductExample = 

    type Product =
        | Bought of BoughtProduct 
        | Made of MadeProduct 
    and BoughtProduct = {
        name : string 
        weight : int 
        vendor : string option }
    and MadeProduct = {
        name : string 
        weight : int 
        components:Component list }
    and Component = {
        qty : int
        product : Product }

    // ---------------------------------
    // Sample data
    // ---------------------------------


    let label = 
        Bought {name="label"; weight=1; vendor=Some "ACME"}
    let bottle = 
        Bought {name="bottle"; weight=2; vendor=Some "ACME"}
    let formulation = 
        Bought {name="formulation"; weight=3; vendor=None}
    
    let shampoo = 
        Made {name="shampoo"; weight=10; components=
        [
        {qty=1; product=formulation}
        {qty=1; product=bottle}
        {qty=2; product=label}
        ]}
    
    let twoPack = 
        Made {name="twoPack"; weight=5; components=
        [
        {qty=2; product=shampoo}
        ]}

    // ---------------------------------
    // define "cata"
    // ---------------------------------

    (*
    // case constructor
    Bought  : BoughtProduct -> Product

    // function parameter to handle Bought case 
    fBought : BoughtProduct -> 'r

    // case constructor
    Made  : MadeProduct -> Product

    // case constructor (MadeProduct unpacked as tuple)
    Made  : (string,int,Component list) -> Product

    // case constructor (Component unpacked as tuple)
    Made  : (string,int,(int,Product) list) -> Product
    //  replace with 'r ===> ~~~~~~~           ~~~~~~~

    // function parameter to handle Made case 
    fMade : (string,int,(int,'r) list)      -> 'r
    *)

    let rec cataProduct fBought fMade product :'r = 
        let recurse = cataProduct fBought fMade 

        // Converts a Component into a (int * 'r) tuple
        let convertComponentToTuple comp =
            (comp.qty,recurse comp.product)

        match product with
        | Bought bought -> 
            fBought bought 
        | Made made -> 
            let componentTuples =  // (int * 'r) list
                made.components 
                |> List.map convertComponentToTuple 
            fMade (made.name,made.weight,componentTuples) 

    // ---------------------------------
    // Define and test "productWeight" 
    // ---------------------------------

    let productWeight product =

        // handle Bought case
        let fBought (bought:BoughtProduct) = 
            bought.weight

        // handle Made case
        let fMade (name,weight,componentTuples) = 
            // helper to calculate weight of one component
            let componentWeight (qty,weight) =
                qty * weight
            // add up the weights of all components
            let totalComponentWeight = 
                componentTuples 
                |> List.sumBy componentWeight 
            // and add the weight of the Made case too
            totalComponentWeight + weight

        // call the catamorphism
        cataProduct fBought fMade product

    label |> productWeight    // 1
    shampoo |> productWeight  // 17 = 10 + (2x1 + 1x2 + 1x3)
    twoPack |> productWeight  // 39 =  5 + (2x17)

    // ---------------------------------
    // Define and test "mostUsedVendor" 
    // ---------------------------------

    type VendorScore = {vendor:string; score:int}

    // helpers to get data from a VendorScore 
    let vendor vs = vs.vendor
    let score vs = vs.score

    let mostUsedVendor product =

        let fBought (bought:BoughtProduct) = 
            // set score = 1 if there is a vendor
            bought.vendor
            |> Option.map (fun vendor -> {vendor = vendor; score = 1} )
            // => a VendorScore option
            |> Option.toList
            // => a VendorScore list

        let fMade (name,weight,subresults) = 
            // subresults are a list of (qty * VendorScore list)

            // helper to get sum of scores
            let totalScore (vendor,vendorScores) =
                let totalScore = vendorScores |> List.sumBy score
                {vendor=vendor; score=totalScore}

            subresults 
            // => a list of (qty * VendorScore list)
            |> List.collect snd  // ignore qty part of subresult
            // => a list of VendorScore 
            |> List.groupBy vendor 
            // second item is list of VendorScore, reduce to sum
            |> List.map totalScore 
            // => list of VendorScores 

        // call the catamorphism
        cataProduct fBought fMade product
        |> List.sortByDescending score  // find highest score
        // return first, or None if list is empty
        |> List.tryHead

    label |> mostUsedVendor    
    // Some {vendor = "ACME"; score = 1}

    formulation |> mostUsedVendor  
    // None

    shampoo |> mostUsedVendor  
    // Some {vendor = "ACME"; score = 2}

    twoPack |> mostUsedVendor  
    // Some {vendor = "ACME"; score = 2}