Example: Training in the Cloud

#load "../lib/utils.fsx"

// Initialize client object to an MBrace cluster
let cluster = Config.GetCluster() 
let fs = cluster.Store.CloudFileSystem

let download (uri: string) = 
    cloud {
        let webClient = new WebClient()
        do! Cloud.Log "Begin file download" 
        let text = webClient.DownloadString(uri) 
        do! Cloud.Log "file downloaded" 
        // Partition the big text into smaller files 
        let! files = 
            text.Split('\n')
            |> Array.chunkBySize 10000
            |> Array.mapi (fun index lines -> 
                 local { 
                    fs.File.Delete(sprintf "text/%d.txt" index) 
                    let file = fs.File.WriteAllLines(path = sprintf "text/%d.txt" index, lines = lines) 
                    return file })
            |> Local.Parallel
        return files
    }

let downloadTask = download "http://norvig.com/big.txt" |> cluster.CreateProcess

downloadTask.ShowInfo()

let files = downloadTask.Result

(** Now, take a look at the sizes of the files. *) 
let fileSizesJob = 
    files
    |> Array.map (fun f -> CloudFile.GetSize f.Path)
    |> Cloud.ParallelBalanced
    |> cluster.CreateProcess 

fileSizesJob.Status
fileSizesJob.ShowInfo()

let fileSizes = fileSizesJob.Result

let regex = Regex("[a-zA-Z]+", RegexOptions.Compiled)
let wordCountJob = 
    files
    |> Array.map (fun f -> f.Path)
    |> CloudFlow.OfCloudFileByLine
    |> CloudFlow.collect (fun text -> regex.Matches(text) |> Seq.cast)
    |> CloudFlow.map (fun (m:Match) -> m.Value.ToLower()) 
    |> CloudFlow.countBy id 
    |> CloudFlow.toArray
    |> cluster.CreateProcess

wordCountJob.ShowInfo()

cluster.ShowProcesses()

let NWORDS = wordCountJob.Result |> Map.ofArray

let isKnown word = NWORDS.ContainsKey word 

(** Compute the 1-character edits of the word: *) 
let edits1 (word: string) = 
    let splits = [for i in 0 .. word.Length do yield (word.[0..i-1], word.[i..])]
    let deletes = [for a, b in splits do if b <> "" then yield a + b.[1..]]
    let transposes = [for a, b in splits do if b.Length > 1 then yield a + string b.[1] + string b.[0] + b.[2..]]
    let replaces = [for a, b in splits do for c in 'a'..'z' do if b <> "" then yield a + string c + b.[1..]]
    let inserts = [for a, b in splits do for c in 'a'..'z' do yield a + string c + b]
    deletes @ transposes @ replaces @ inserts |> Set.ofList

edits1 "speling"
edits1 "pgantom"

(** Compute the 1-character edits of the word which are actually words *) 
let knownEdits1 word = 
    let result = [for w in edits1 word do if Map.containsKey w NWORDS then yield w] |> Set.ofList
    if result.IsEmpty then None else Some result 

knownEdits1 "fantom"
knownEdits1 "pgantom"

(** Compute the 2-character edits of the word which are actually words *) 
let knownEdits2 word = 
    let result = [for e1 in edits1 word do for e2 in edits1 e1 do if Map.containsKey e2 NWORDS then yield e2] |> Set.ofList
    if result.IsEmpty then None else Some result 

knownEdits2 "pgantom"
knownEdits2 "quyck"


(** Find the best correction for a word, preferring 0-edit, over 1-edit, over 2-edit, and sorting by frequency. *) 
let findBestCorrection (word: string) = 
    let words = 
        if isKnown word then Set.ofList [word] 
        else 
            match knownEdits1 word with
            | Some words -> words
            | None ->
            match knownEdits2 word with
            | Some words -> words
            | None -> Set.ofList [word]

    words |> Seq.sortBy (fun w -> -NWORDS.[w]) |> Seq.head

// Examples
findBestCorrection "speling"
findBestCorrection "korrecter"
findBestCorrection "fantom"
findBestCorrection "pgantom"