// Examples from chapter 2 "Program Structure" of the book
// F# for Scientists
//
// (C) Flying Frog Consultancy Ltd., 2007

#light

/// 2
module ProgramStructure =

  /// 2.1
  module Nesting =
    let ipow3 x =
      let sqr x = x * x
      x * sqr x

  /// 2.2
  module Factoring =
  
    /// 2.2.1
    module FactoringOutCommonSubexpressions =
      let f1 x = (x - 1.0 - (x - 1.0) * (x - 1.0)) ** (x - 1.0)

      f1 5.0

      let f2 x =
        let a = x - 1.0
        (a - a * a) ** a
      
      f2 5.0

    /// 2.2.2
    module FactoringOutHigherOrderFunctions =
      module Unfactored =
        let rec sum_range l u =
          if l = u then 0 else l + sum_range (l + 1) u

        let rec product_range l u =
          if l = u then 1 else l * product_range (l + 1) u

        product_range 1 6

      let rec fold_range f l u accu =
        if l = u then accu else fold_range f (l + 1) u (f l accu)

      let sum_range l u = fold_range ( + ) l u 0
      let product_range l u = fold_range ( * ) l u 1

      product_range 1 6

      let list_init n f = fold_range (fun i t -> f i :: t) 0 n []
      list_init 5 (fun i -> i * i)
      
      List.init 5 (fun i -> i * i)
      
      [ for i in 0 .. 4 ->
          i * i ]

    module OfSeq =
      let fold_range f l u accu =
        Seq.fold (fun accu x -> f x accu) accu {l .. u-1}

  /// 2.3
  module Modules =
    module FloatRange =
      type t = {l: float; u: float}

      let make l u =
        if u >= l then {l=l; u=u} else invalid_arg "FloatRange.make"

      let mem x r =
        r.l <= x && x < r.u

      let order a b =
        if a.l < b.u then b, a else a, b

      let union a b =
        let a, b = order a b
        if a.u < b.l then [a; b] else
        [make (min a.l b.l) (max a.u b.u)]

      let inter a b =
        let a, b = order a b
        if a.u < b.l then [] else
        [make (max a.l b.l) (min a.u b.u)]

    let a, b = FloatRange.make 1. 3., FloatRange.make 2. 5.

    FloatRange.union a b
    FloatRange.inter a b

  /// 2.4
  module Objects =
  
    /// 2.4.1
    module Augmentations =
      type vec2 = {x: float; y: float} with
        member r.Length = sqrt(r.x * r.x + r.y * r.y)

      {x = 3.0; y = 4.0}.Length

    /// 2.4.1.1
    module GettersAndSetters =
      type vec2 = { mutable x: float; mutable y: float } with
        member r.Length
          with get() = sqrt(r.x * r.x + r.y * r.y)
          and set len =
            let s = len / r.Length
            r.x <- s * r.x
            r.y <- s * r.y

      let r = {x = 3.0; y = 4.0}
      r.Length <- 1.0
      r

    /// 2.4.1.2
    module Indexing =
      type vec2 = { mutable x: float; mutable y: float } with
        member r.Item
          with get d =
            match d with
            | 0 -> r.x
            | 1 -> r.y
            | _ -> invalid_arg "vec2.get"
          and set d v =
            match d with
            | 0 -> r.x <- v
            | 1 -> r.y <- v
            | _ -> invalid_arg "vec2.set"

      let r = { x = 4.0; y = 4.0 }
      r.[0] <- 3.0
      r

    /// 2.4.1.3
    module OperatorOverloading =
      type vec2 = {x: float; y: float} with
        static member ( + ) (a, b) =
          { x = a.x + b.x; y = a.y + b.y }
      
      { x = 2.0; y = 3.0 } + { x = 3.0; y = 4.0 }

    /// 2.4.2
    module Classes =

      /// 2.4.2.1
      module ExplicitConstructors =
        type vec2 =
          val private x_ : float
          val private y_ : float
          
          new(x) = { x_ = x; y_ = 0.0 }
          new(x, y) = { x_ = x; y_ = y }
          
          member r.x = r.x_
          member r.y = r.y_
          member r.Length =
            sqrt(r.x * r.x + r.y * r.y)

        //vec2(3.).x_
        vec2(3.).y
        vec2(3., 4.).y
        vec2(3., 4.).Length

      /// 2.4.2.2
      module ImplicitConstructor =
        type vec2(x : float, y : float) =
          member r.x = x
          member r.y = y
          member r.Length =
            sqrt(r.x * r.x + r.y * r.y)
        
        vec2(3., 4.).y
        vec2(3., 4.).Length

  /// 2.5
  module FunctionalDesignPatterns =
    
    /// 2.5.1
    module Combinators =

      let apply_2 f =
        f << f

      apply_2 (( * ) 2) 5

      let apply_4 f =
        apply_2 apply_2 f

      apply_4 (( * ) 2) 5
      
      let rec nest n f x =
        match n with
        | 0 -> x
        | n -> nest (n - 1) f (f x)
        
      nest 3 (( * ) 2) 1
      
      let rec y f x =
        f (y f) x

      let factorial factorial = function
        | 0 -> 1
        | n -> n*factorial(n-1)

      y factorial 5
      y (factorial >> fun f n -> printf "%d\n" n; f n) 5
      
      let time f x =
        let t = System.Diagnostics.Stopwatch()
        t.Start()
        try f x finally
        printf "Took %dms\n" t.ElapsedMilliseconds
      
      time (fun () -> [1 .. 1000000]) ()