// Code from Hansen and Rischel: Functional Programming using F#     16/12 2012
// Chapter 13: Asynchronous and parallel computations.               corrected 23/7 2013
// All examples except Section 13.5.                                 

// Section 13.3
// ------------

open System ;;
open System.Threading;;

let mutex = new Mutex();;

let f (n: int) () =
  for k in 1..2 do
    Thread.Sleep 50
    mutex.WaitOne() |> ignore
    printf "Thread %d gets mutex{\ttbsl}n" n
    Thread.Sleep 100
    printf "Thread %d releases mutex\n" n
    mutex.ReleaseMutex() |> ignore;;

let g() =
  let thread1 = Thread (f 1)
  let thread2 = Thread (f 2)
  thread1.Start()
  thread2.Start();;

g() ;;

// Section 13.4 Asynchronous computations
// --------------------------------------

open System ;; open System.Net;;  // Uri, WebClient
let downLoadDTUcomp =
  async {let webCl = new WebClient()
         let! html =
           webCl.AsyncDownloadString(Uri "http://www.dtu.dk")
         return html} ;;

let downloadComp url =
    let webCl = new WebClient()
    async {let! html = webCl.AsyncDownloadString(Uri url)
           return html};;

let downloadDTUcomp = downloadComp "http://www.dtu.dk";;

let downloadMScomp = downloadComp "http://www.microsoft.com";;

let downlArrayComp (urlArr: string[]) =
    Async.Parallel (Array.map downloadComp urlArr);;

let paralDTUandMScomp =
    downlArrayComp
        [|"http://www.dtu.dk"; "http://www.microsoft.com"|];;

Array.map (fun (s:string) -> s.Length)
          (Async.RunSynchronously paralDTUandMScomp);;

let parallelChildrenDTUandMS =
    async {let! compl1 = Async.StartChild downloadDTUcomp
           let! compl2 = Async.StartChild downloadMScomp
           let! html1 = compl1
           let! html2 = compl2
           return (html1,html2)};;


// Corrected 23-07-2013
// The following use of downloadWithConts do not treat use-bindings correctly. 
// See list of corrections

// open System.Threading;; 
// let okCon (s: string) = printf "Length = %d\n" (s.Length);;
// let exnCon _ = printf "Exception raised\n";;
// let canCon _ = printf "Operation cancelled\n";;
// let downloadWithConts url =
//     use ts = new CancellationTokenSource()
//     Async.StartWithContinuations
//         ((downloadComp url),okCon,exnCon,canCon,ts.Token)
//     ts;;

// downloadWithConts "http://www.microsoft.com" |> ignore;;

// downloadWithConts "ppp" |> ignore;;

// let ts = downloadWithConts "http://www.dtu.dk";;
// ts.Cancel();;

// These examples are replaced by:  

let okCon (s: string) = printf "Length = %d\n" (s.Length) 
let exnCon _ = printf "Exception raised\n" 
let canCon _ = printf "Operation cancelled\n"

Async.StartWithContinuations
    (downloadComp "http://www.microsoft.com",
     okCon, exnCon, canCon);;

Async.StartWithContinuations
    (downloadComp "ppp",
     okCon, exnCon, canCon);;

open System.Threading;; // CancellationTokenSource

let cancelExample() =
    use ts = new CancellationTokenSource()
    Async.StartWithContinuations
        (downloadComp "http://www.dtu.dk",
         okCon, exnCon, canCon, ts.Token)
    ts.Cancel();;  
cancelExample();;


// Section 13.6. Parallel computations.
// -----------------------------------

let isPrime =
    let rec testDiv a b c =
        a>b || c%a <> 0 && testDiv (a+1) b c
    function
    | 0 | 1 -> false
    | n     -> testDiv 2 (n-1) n;;

isPrime 51;;

isPrime 232012709;;

let gen = let generator = new System.Random()
          generator.Next;;

gen 100;;

gen 100;;

// Data parallelism

let bigArray = Array.init 5000000 (fun _ -> gen 10000);;

#time;;

Array.Parallel.map isPrime bigArray;;

Array.map isPrime bigArray;;

// A reference to the F# powerpack is needed when using PSeq
#r @"FSHARP.POWERPACK.Parallel.Seq"

open Microsoft.FSharp.Collections ;;

let bigSequence = Seq.init  5000000 (fun _ -> gen 10000);;

Seq.exists (fun i -> isPrime i && i>10000) bigSequence;;

PSeq.exists (fun i -> isPrime i && i>10000) bigSequence;;

// Task parallelism

type BinTree<'a> = | Leaf
                   | Node of BinTree<'a> * 'a * BinTree<'a>;;


let rec exists p t =
    match t with
    | Leaf                 -> false
    | Node(_,v,_) when p v -> true
    | Node(tl,_,tr)        -> exists p tl || exists p tr;;

let rec genTree n range =
    if n=0 then Leaf
    else let tl = genTree (n-1) range
         let tr = genTree (n-1) range
         Node(tl, gen range, tr);;

let t = genTree 25 10000;;

exists (fun n -> isPrime n && n>10000) t;;

open System.Threading.Tasks ;;
let rec parExists p t =
    match t with
    | Leaf                 -> false
    | Node(_,v,_) when p v -> true
    | Node(tl,_,tr)        ->
      let b1 = Task.Factory.StartNew(fun () -> parExists p tl)
      let b2 = Task.Factory.StartNew(fun () -> parExists p tr)
      b1.Result||b2.Result;;


parExists (fun n -> isPrime n && n>10000) t;;

let rec parExistsDepth p t n =
  if n=0 then exists p t
  else match t with
       | Leaf                 -> false
       | Node(_,v,_) when p v -> true
       | Node(tl,_,tr)        ->
           let b1 = Task.Factory.StartNew(
                        fun () -> parExistsDepth p tl (n-1))
           let b2 = Task.Factory.StartNew(
                        fun () -> parExistsDepth p tr (n-1))
           b1.Result||b2.Result;;

parExistsDepth (fun n -> isPrime n && n>10000) t 4;;

let swap (a: 'a[]) i j =
    let v = a.[i]
    a.[i] <- a.[j]
    a.[j] <- v;;


let rec partition (a:'a[]) v k1 k2 =
    if k2=k1-1 then k2                         //empty section
    else if a.[k2] >= v then partition a  v k1 (k2-1)
         else swap a k1 k2
              partition a v (k1+1) k2;;

let rec qsort a i j =
    if j-i>1 then let k = partition a a.[i] (i+1) (j-1)
                  swap a i k
                  qsort a i k
                  qsort a (k+1) j;;

let sort a = qsort a 0 (Array.length a);;

let a1 = [|1; -4; 0; 7; 2; 3|];;

sort a1;;

a1;;

let rec pqsort a i j depth =
    if j-i<= 1 then ()
    else if depth=0 then qsort a i j
        else let k = partition a a.[i] (i+1) (j-1)
             swap a i k
             let s1 = Task.Factory.StartNew
                        (fun () -> pqsort a i k (depth-1))
             let s2 = Task.Factory.StartNew
                        (fun () -> pqsort a (k+1) j (depth-1))
             Task.WaitAll[|s1;s2|];;

let parSort a d = pqsort a 0 (Array.length a) d;;

let a32   = Array.init 3200000 (fun _ -> gen 1000000000);;
let a32cp = Array.copy a32;;

sort a32;;

parSort a32cp 7;;