open System.Collections
open System.Collections.Generic

// LazyList dataType + Monoid Structure
type LazyList<'T> =   Empty
                    | Cons of 'T * (unit -> LazyList<'T>)
                    | Delay of (unit -> LazyList<'T>)
                    | Combine of LazyList<'T> * LazyList<'T> with
        interface IEnumerable<'T> with
            member self.GetEnumerator() =
                // tail-recursive enumeration 
                let rec toSeq stack = 
                    match stack with
                    | [] -> Seq.empty
                    | head :: tail ->
                        match head with
                        | Empty -> toSeq tail
                        | Cons (value, rest) -> seq { yield value; yield! toSeq <| rest () :: tail }
                        | Delay f -> toSeq <| f () :: tail
                        | Combine (first, second) -> toSeq <| first :: second :: tail
                (toSeq [self]).GetEnumerator() 
        interface IEnumerable with 
            member self.GetEnumerator() = (self :> IEnumerable<'T>).GetEnumerator() :> _ 

// Monoid Comprehension
type LazyListBuilder() = 
    member self.Yield value = Cons (value, fun () -> Empty)
    member self.YieldFrom value = value
    member self.Combine(first, second) = Combine (first, second) 
    member self.Delay f = Delay f
    member self.Zero() = Empty

let lazyList = new LazyListBuilder()


// Example
#time
type Tree<'T> = Empty | Branch of 'T * Tree<'T> * Tree<'T>

let rec createBalancedTree n = 
    if n <= 0 then Empty
    else Branch (n, createBalancedTree (n - 1), createBalancedTree (n - 1))

let rec createLeftSpinedTree n acc = 
    if n <= 0 then acc
    else createLeftSpinedTree (n - 1) (Branch (n, acc, Empty))

let tree = createBalancedTree 20
let leftSpinedTree = createLeftSpinedTree 100000 Empty

// Seq test
let rec flattenToSeq tree =
    match tree with
    | Empty -> Seq.empty
    | Branch (value, left, right) -> 
        seq { yield value; yield! flattenToSeq left; yield! flattenToSeq right }

tree
|> flattenToSeq
|> Seq.length 

leftSpinedTree
|> flattenToSeq
|> Seq.length 

// LazyList test
let rec flattenToLazyList tree =
    match tree with
    | Empty -> LazyList.Empty 
    | Branch (value, left, right) -> 
        lazyList { yield value; yield! flattenToLazyList left; yield! flattenToLazyList right }

tree
|> flattenToLazyList
|> Seq.length 

leftSpinedTree
|> flattenToLazyList
|> Seq.length 

#time
[ for i in {1..1000000} do
        yield i * 2; yield i * 3; yield i * 4; yield i * 5 ]
 
[| for i in {1..1000000} do
        yield i * 2; yield i * 3; yield i * 4; yield i * 5 |]
 
 
seq { for i in {1..1000000} do
        yield i * 2; yield i * 3; yield i * 4; yield i * 5 } |> Seq.iter ignore

type FuncList<'a> = 'a list -> 'a list

type FuncListBuilder() =
    member self.Combine (first : FuncList<'a>, second : FuncList<'a>) : FuncList<'a>  = (first << second) 
    member self.Zero() : FuncList<'a> = id
    member self.Yield (value : 'a) : FuncList<'a> = fun tail -> value :: tail
    member self.YieldFrom (value : FuncList<'a>) : FuncList<'a> = value
    member self.For (list : FuncList<'a>, f : 'a -> FuncList<'b>) : FuncList<'b> =
        fun tail -> [] |> list |> List.map f |> List.fold (fun acc value -> self.Combine(acc, value)) (self.Zero()) <| tail
    member self.Delay ( f : unit -> FuncList<'a>) : FuncList<'a> = f ()
 
let funcList = new FuncListBuilder()
let toFuncList (list : 'a list) : FuncList<'a> = list |> List.fold (fun acc value -> funcList { yield! acc; yield value }) id


 
[] |> funcList  { for i in toFuncList [1..1000000] do
                    yield i * 2; yield i * 3; yield i * 4; yield i * 5 }

open System
open System.Threading
 
type ShouldRetry = ShouldRetry of (RetryCount * LastException -> bool * RetryDelay)
and RetryCount = int
and LastException = exn
and RetryDelay = TimeSpan
type RetryPolicy = RetryPolicy of ShouldRetry
   
type RetryPolicies() =
    static member NoRetry () : RetryPolicy =
        RetryPolicy( ShouldRetry (fun (retryCount, _) -> (retryCount < 1, TimeSpan.Zero)) )
    static member Retry (currentRetryCount : int , intervalBewteenRetries : RetryDelay) : RetryPolicy =
        RetryPolicy( ShouldRetry (fun (retryCount, _) -> (currentRetryCount < retryCount, intervalBewteenRetries)))
    static member Retry (currentRetryCount : int) : RetryPolicy =
        RetryPolicies.Retry(currentRetryCount, TimeSpan.Zero)
 
type RetryResult<'a> =
    | RetrySuccess of 'a
    | RetryFailure of exn
   
// Reader + Exception Monad DataType
type Retry<'a> = Retry of (RetryPolicy -> RetryResult<'a>)
 
type RetryBuilder() =
    member self.Return (value : 'a) : Retry<'a> = Retry (fun retryPolicy -> RetrySuccess value)
 
    member self.Bind (retry : Retry<'a>, bindFunc : 'a -> Retry<'b>) : Retry<'b> =
        Retry (fun retryPolicy ->
            let (Retry retryFunc) = retry
            match retryFunc retryPolicy with
            | RetrySuccess value ->
                let (Retry retryFunc') = bindFunc value
                retryFunc' retryPolicy
            | RetryFailure exn -> RetryFailure exn )
 
    member self.Delay (f : unit -> Retry<'a>) : Retry<'a> =
        Retry (fun retryPolicy ->
            let mutable resultCell : option<RetryResult<'a>> = None
            let mutable lastExceptionCell : exn = null
            let (RetryPolicy(ShouldRetry shouldRetry)) = retryPolicy
            let mutable canRetryCell : bool = true
            let mutable currentRetryCountCell : int = 0
            while canRetryCell do
                try
                    let (Retry retryFunc) = f ()
                    let result = retryFunc retryPolicy
                    resultCell <- Some result
                    canRetryCell <- false
                with e ->
                    lastExceptionCell <- e
                    currentRetryCountCell <- 1 + currentRetryCountCell
                    match shouldRetry(currentRetryCountCell, lastExceptionCell) with
                    | (true, retryDelay) ->
                        canRetryCell <- true
                        Thread.Sleep(retryDelay)
                    | (false, _) -> canRetryCell <- false
 
            match resultCell with
            | Some result -> result
            | None -> RetryFailure lastExceptionCell )
 
[<AutoOpen>]
module Retry =
    let retry = new RetryBuilder()
    // override default policy
    let retryWithPolicy (retryPolicy : RetryPolicy) (retry : Retry<'a>) =
        Retry (fun _ -> let (Retry retryFunc) = retry in retryFunc retryPolicy)

    let run (retry : Retry<'a>) (retryPolicy : RetryPolicy) : RetryResult<'a> =
        let (Retry retryFunc) = retry
        retryFunc retryPolicy

// DivByzero example
let rnd = System.Random()
let example = 
    retry {
        let! a = retry { return 1 / rnd.Next(0, 2) }
        let! b = retry { return 2 / rnd.Next(0, 2) }
        // override default policy
        let! c = retryWithPolicy (RetryPolicies.NoRetry()) (retry { return 3 / rnd.Next(0, 2) })

        return a * b * c
    }

run example (RetryPolicies.Retry 1)

type StateContMonad<'s, 'a, 'r> = StateContMonad of ('s -> ('s -> 'a -> 'r) -> 'r)
type StateContBuilder() =
    member self.Return value = StateContMonad (fun state k -> k state value)
    member self.Bind(StateContMonad contStateMonad, f) = StateContMonad (fun state k -> contStateMonad state (fun state' value -> let (StateContMonad contMonad') = f value in contMonad' state' k))
    member self.Delay( f : unit -> StateContMonad<'s, 'a, 'r> ) = StateContMonad (fun state k -> let (StateContMonad contStateMonad) = f () in contStateMonad state k)
 
let memo = new StateContBuilder()
 
// val Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
let rec Y f value = f (Y f) value
 
// val check : 'a -> StateContMonad<Map<'a,'r>,'r option,'r> when 'a : comparison
let check (value : 'a) : StateContMonad<Map<'a, 'r>, option<'r>, 'r> = StateContMonad (fun map k -> k map (Map.tryFind value map))
// val store : 'a * 'r -> StateContMonad<Map<'a,'r>,unit,'r> when 'a : comparison
let store (argument : 'a, result : 'r) : StateContMonad<Map<'a, 'r>, unit, 'r> = StateContMonad (fun map k -> k (Map.add argument result map) ())
 
// val memoize : ('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b> when 'a : comparison
let memoize f argument =
    memo {
        let! checkResult = check argument
        match checkResult with
        | Some result -> return result
        | None ->
            let! result = f argument
            do! store (argument, result)
            return result
    }
 
// val execute : (('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> 'b when 'a : comparison
let execute f n = let (StateContMonad contStateMonad) = Y (memoize << f) n in contStateMonad Map.empty (fun _ value -> value)
 
// val big : int -> BigInteger
let big (value : int) = new System.Numerics.BigInteger(value)
 
// val fib : (BigInteger -> StateContMonad<'a,BigInteger,'b>) -> BigInteger -> StateContMonad<'a,BigInteger,'b>
let fib f n =
    if n = big 0 then memo { return big 0 }
    elif n = big 1 then memo { return big 1 }
    else
        memo {
            let! nMinus1Fib = f (n - big 1)
            let! nMinus2Fib = f (n - big 2)
            return nMinus1Fib + nMinus2Fib
        }
 
execute fib (big 100000)

let memoize f = 
	let cache = new Dictionary<_, _>()	
	(fun x -> match cache.TryGetValue(x) with
                  | true, y -> y
	          | _       -> let v = f(x)
                                       cache.Add(x, v)
                                       v)

type StateMonad<'a, 's> = StateMonad of ('s -> ('a * 's))
 
type StateBuilder() =
    member self.Return value = StateMonad (fun state -> (value, state))
    member self.Bind (StateMonad stateMonad, f) = StateMonad (fun state -> let value, state' = stateMonad state in let (StateMonad stateMonad') = f value in stateMonad' state')
 
let memo = new StateBuilder()
 
// val Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b
let rec Y f value = f (Y f) value
 
// val check : 'a -> StateMonad<'r option,Map<'a,'r>> when 'a : comparison
let check (value : 'a) : StateMonad<option<'r>, Map<'a, 'r>> = StateMonad (fun map -> (Map.tryFind value map, map))
// val store : 'a * 'r -> StateMonad<unit,Map<'a,'r>> when 'a : comparison
let store (argument : 'a, result : 'r) : StateMonad<unit, Map<'a, 'r>> = StateMonad (fun map -> ((), Map.add argument result map))
 
// val memoize :('a -> StateMonad<'b,Map<'a,'b>>) -> 'a -> StateMonad<'b,Map<'a,'b>> when 'a : comparison
let memoize f argument =
    memo {
        let! checkResult = check argument
        match checkResult with
        | Some result -> return result
        | None ->
            let! result = f argument
            do! store (argument, result)
            return result
    }
 
// val execute : (('a -> StateMonad<'b,Map<'a,'b>>) -> 'a -> StateMonad<'b,Map<'a,'b>>) -> 'a -> 'b when 'a : comparison
let execute f n = let (StateMonad stateMonad) = Y (memoize << f) n in fst (stateMonad Map.empty)
 
// val fib : (int -> StateMonad<int,'a>) -> int -> StateMonad<int,'a>
let fib f n =
    if n = 0 then memo { return 0 }
    elif n = 1 then memo { return 1 }
    else
        memo {
            let! nMinus1Fib = f (n - 1)
            let! nMinus2Fib = f (n - 2)
            return nMinus1Fib + nMinus2Fib
        }
   
execute fib 1000

type Atom<'a when 'a : not struct>(value : 'a) =
    let refCell = ref value
    
    let rec swap f = 
        let currentValue = !refCell
        let result = Interlocked.CompareExchange<'a>(refCell, f currentValue, currentValue)
        if obj.ReferenceEquals(result, currentValue) then ()
        else Thread.SpinWait 20; swap f
        
    member self.Value with get() = !refCell
    member self.Swap (f : 'a -> 'a) = swap f
        
    

let atom value = 
    new Atom<_>(value)
    
let (!) (atom : Atom<_>) =  
    atom.Value
    
let swap (atom : Atom<_>) (f : _ -> _) =
    atom.Swap f

let counter = atom (fun () -> 0)

let listOfIncrementAsync = [ for _ in [1..1000000] -> async { swap counter (fun f -> (fun result () -> result + 1) <| f()) } ]

listOfIncrementAsync |> Async.Parallel |> Async.Run |> ignore 

printfn "%d" ((!counter)()) //1000000

	public class Thunk<T>
	{
		private Func<T> func;

		public T Value
		{
			get { return func(); }
		}

		public Thunk(Func<T> computeFunc)
		{
			this.func = () => { func = ((Func<T, Func<T>>)(value => () => value))(computeFunc()); return func(); };
		}
	}

public class Thunk<T>
{
	private T value;
	private bool flag = false;
	private Func<T> func;

	public T Value
	{
		get
		{
			if(!flag)
			{				
				value = func();
				flag = true;
			}
			return value;	
		}
	}

	public Thunk(Func<T> func)
	{
		this.func = func;
	}
}

public static class PatternMatch
{
    public static Func<Func<TValue, TResult>, Func<TValue, TResult>> With<TValue, TResult>(Func<TValue, bool> condition, Func<TValue, TResult> action)
    {
        return With(value => value, condition, action);
    }
    public static Func<Func<TValue, TResult>, Func<TValue, TResult>> With<TValue, TResult>(this Func<Func<TValue, TResult>, Func<TValue, TResult>> withFunc, Func<TValue, bool> condition, Func<TValue, TResult> action)
    {
        return continuation => withFunc(value => condition(value) ? action(value) : continuation(value));
    }
    public static Func<TValue, TResult> Else<TValue, TResult>(this Func<Func<TValue, TResult>, Func<TValue, TResult>> withFunc, Func<TValue, TResult> elseFunc)
    {
        return withFunc(elseFunc);
    }
}

Example:

var pattern = PatternMatch.With<int, string>(value => value == 1, value => "One ")
                              .With(value => value == 2, value => "Two ")
                              .With(value => value == 3, value => "Three ")
                              .Else(_ => "Else");

Console.WriteLine(pattern(1));

Καλό Σάββατο σε όλους μας.

	    var mouseMoveObservable = Observable.Merge(new Control[] { this, recordButton, stopButton, playButton }
                                                    		.Select(control => Observable.FromEvent<MouseEventArgs>(control, "MouseMove")));

            ReplaySubject<TimeInterval<IEvent<MouseEventArgs>>> replayObservable = null;
            Observable.FromEvent<EventArgs>(recordButton, "Click").ObserveOnWindowsForms().Subscribe(_ =>
            {
                stopButton.Enabled = true; recordButton.Enabled = false;
                replayObservable = mouseMoveObservable.TimeInterval().Record();
                replayObservable.ObserveOnWindowsForms().Subscribe(time => this.Text = String.Format("{0},{1}", time.Value.EventArgs.X, time.Value.EventArgs.Y));
            });

            Observable.FromEvent<EventArgs>(stopButton, "Click").ObserveOnWindowsForms().Subscribe(_ =>
            {
                replayObservable.Dispose();
                stopButton.Enabled = false; playButton.Enabled = true;
            });
            
            Observable.FromEvent<EventArgs>(playButton, "Click").ObserveOnWindowsForms().Subscribe(_ =>
            {
                playButton.Enabled = false;
                var playObservable = replayObservable.ToEnumerable()
                                     .Aggregate(Observable.Return(new Unit()),
                                                (accObservable, timeMouse) => accObservable.Delay(timeMouse.Interval)
                                                                                            .ObserveOnWindowsForms()                                                                                            
                                                                                            .Do(__ => Cursor.Position = ((Control)timeMouse.Value.Sender).PointToScreen(new Point(timeMouse.Value.EventArgs.X, timeMouse.Value.EventArgs.Y))));
                playObservable.Subscribe(value => { }, () => recordButton.Enabled = true);
            });