Skip to content

Instantly share code, notes, and snippets.

@latkin

latkin/README.md

Last active August 29, 2015 14:12
Download ZIP

Revisions

  1. latkin revised this gist Dec 27, 2014. 2 changed files with 1 addition and 3 deletions.
    2 changes: 1 addition & 1 deletion README.md
    View file
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,3 @@
    Backing code and examples for two different mini-frameworks adding extended imperative-style `for` loops in F#.

    Discussed in blog post here.
    Discussed in blog post [here](http://latkin.org/blog/2014/12/26/nested-looping-to-programmatic-depth-in-f/).
    2 changes: 0 additions & 2 deletions a_nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,5 +1,3 @@
    // see link for more details

    #nowarn "25"

    /// The body of each nested loop needs to return one of these actions.
  2. latkin revised this gist Dec 27, 2014. 1 changed file with 26 additions and 14 deletions.
    40 changes: 26 additions & 14 deletions usage.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,15 @@
    // simple example of using the nestedFor function
    nestedFor {
    Depth = 3; InitialRange = { Min=0; Max=1 }
    GetNextRange = fun _ -> { Min=0; Max=1 }
    Body = function
    | { Depth=3; Indexes=idxs } ->
    printfn "%A" (List.rev idxs)
    Continue
    | _ -> Descend
    }

    // helper for upcoming examples. Checks if an int is prime.
    let isPrime = function
    | 1 -> false
    | 2 | 3 -> true
    @@ -13,16 +25,8 @@ let isPrime = function
    v <- v + 2
    go

    nestedFor {
    Depth = 3; InitialRange = { Min=0; Max=1 }
    GetNextRange = fun _ -> { Min=0; Max=1 }
    Body = function
    | { Depth=3; Indexes=idxs } ->
    printfn "%A" (List.rev idxs)
    Continue
    | _ -> Descend
    }

    // finds the first m pairs of prime numbers that sum to a given number n
    // standard F# for loop
    let primePairs n m =
    let mutable count = 0
    for i = 2 to n/2 do
    @@ -34,6 +38,8 @@ let primePairs n m =
    printfn "%d + %d" i j
    count <- count + 1

    // finds the first m pairs of prime numbers that sum to a given number n
    // uses 'imperative' computation expression
    let primePairsImperative n m =
    let count = ref 0
    imperative {
    @@ -44,10 +50,12 @@ let primePairsImperative n m =
    if isPrime j then
    printfn "%d + %d" i j
    count := !count + 1
    if count >= m then
    if !count >= m then
    return ()
    }

    // finds the first m triples of prime numbers that sum to a given number n
    // uses 'imperative' computation expression
    let primeTriplesImperative n m =
    let count = ref 0
    let result = ref []
    @@ -62,11 +70,13 @@ let primeTriplesImperative n m =
    if isPrime k then
    result := [i; j; k] :: !result
    count := !count + 1
    if count >= m then
    if !count >= m then
    return ()
    }
    result

    // finds the first m triples of prime numbers that sum to a given number n
    // uses 'nestedFor' function
    let primeTriplesNested n m =
    let count = ref 0
    let result = ref []
    @@ -83,13 +93,15 @@ let primeTriplesNested n m =
    if isPrime k then
    result := [i; j; k] :: !result
    count := !count + 1
    if count >= m then
    if !count >= m then
    Return
    else Continue
    else Continue
    }
    result

    // finds the first m k-tuples of prime numbers that sum to a given number n
    // uses 'nestedFor' function
    let primeKTuplesNested n m k =
    let count = ref 0
    let result = ref []
    @@ -107,7 +119,7 @@ let primeKTuplesNested n m k =
    if isPrime j then
    result := (j :: i :: prev) :: !result
    count := !count + 1
    if count >= m then
    if !count >= m then
    Return
    else Continue
    else Continue
  3. latkin revised this gist Dec 27, 2014. 2 changed files with 116 additions and 1 deletion.
    2 changes: 1 addition & 1 deletion README.md
    View file
    Original file line number Diff line number Diff line change
    @@ -1,3 +1,3 @@
    Backing code for two different mini-frameworks adding extended imperative-style `for` loops in F#.
    Backing code and examples for two different mini-frameworks adding extended imperative-style `for` loops in F#.

    Discussed in blog post here.
    115 changes: 115 additions & 0 deletions usage.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,115 @@
    let isPrime = function
    | 1 -> false
    | 2 | 3 -> true
    | n ->
    if n % 2 = 0 then false else
    if (n+1) % 6 <> 0 && (n-1) % 6 <> 0 then false else
    let q = (int<<floor<<sqrt<<float) n
    let mutable v = 3
    let mutable go = true
    while v < q && go do
    if n % v = 0 then
    go <- false
    v <- v + 2
    go

    nestedFor {
    Depth = 3; InitialRange = { Min=0; Max=1 }
    GetNextRange = fun _ -> { Min=0; Max=1 }
    Body = function
    | { Depth=3; Indexes=idxs } ->
    printfn "%A" (List.rev idxs)
    Continue
    | _ -> Descend
    }

    let primePairs n m =
    let mutable count = 0
    for i = 2 to n/2 do
    if (count >= m) || not (isPrime i) then
    ()
    else
    let j = n - i
    if isPrime j then
    printfn "%d + %d" i j
    count <- count + 1

    let primePairsImperative n m =
    let count = ref 0
    imperative {
    for i = 2 to n/2 do
    if not (isPrime i) then
    do! continue
    let j = n - i
    if isPrime j then
    printfn "%d + %d" i j
    count := !count + 1
    if count >= m then
    return ()
    }

    let primeTriplesImperative n m =
    let count = ref 0
    let result = ref []
    imperative {
    for i = 2 to n/3 do
    if not (isPrime i) then
    do! continue
    for j = i to (n - i)/2 do
    if not (isPrime j) then
    do! continue
    let k = n - i - j
    if isPrime k then
    result := [i; j; k] :: !result
    count := !count + 1
    if count >= m then
    return ()
    }
    result

    let primeTriplesNested n m =
    let count = ref 0
    let result = ref []
    nestedFor {
    Depth = 2; InitialRange = { Min = 2; Max = n/3 }
    GetNextRange = fun { Prev = (prev :: _ ) } ->
    { Min=prev; Max = (n - prev)/2 }
    Body = function
    | { Indexes = [i] } ->
    if not (isPrime i) then Continue else Descend
    | { Indexes = [j; i] } ->
    if not (isPrime j) then Continue else
    let k = n - i - j
    if isPrime k then
    result := [i; j; k] :: !result
    count := !count + 1
    if count >= m then
    Return
    else Continue
    else Continue
    }
    result

    let primeKTuplesNested n m k =
    let count = ref 0
    let result = ref []
    let finalDepth = k - 1
    nestedFor {
    Depth = finalDepth; InitialRange = { Min = 2; Max = n/k }
    GetNextRange = fun { Prev = (prev :: _ ) as p } ->
    { Min = prev; Max = (n - (List.sum p))/2 }
    Body = function
    | { Depth = d; Indexes = i :: _ } when d < finalDepth ->
    if not (isPrime i) then Continue else Descend
    | { Depth = d; Indexes = i :: prev } when d = finalDepth ->
    if not (isPrime i) then Continue else
    let j = n - i - (List.sum prev)
    if isPrime j then
    result := (j :: i :: prev) :: !result
    count := !count + 1
    if count >= m then
    Return
    else Continue
    else Continue
    }
    result
  4. latkin revised this gist Dec 26, 2014. 1 changed file with 2 additions and 2 deletions.
    4 changes: 2 additions & 2 deletions a_nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -13,8 +13,8 @@ type LoopAction = Break | Continue | Return | Descend
    /// e.g. for i1 = 0 to 10 do
    /// // here Depth is 1, Indexes is [i1]
    /// for i2 = 0 to 10 do
    /// // here Depth is 2, Indexes is [i2; i1]
    /// for i2 = 0 to 10 do
    /// // here Depth is 2, Indexes is [i2; i1]
    /// for i3 = 0 to 10 do
    /// // here Depth is 3, Indexes is [i3; i2; i1]
    type LoopInput = { Depth : int; Indexes : int list }

  5. latkin revised this gist Dec 26, 2014. 1 changed file with 8 additions and 10 deletions.
    18 changes: 8 additions & 10 deletions a_nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -11,9 +11,11 @@ type LoopAction = Break | Continue | Return | Descend
    /// Depth indicates the current level of nesting, Indexes bundles up
    /// all of the loop counter values up through the current level of nesting.
    /// e.g. for i1 = 0 to 10 do
    /// // here Indexes is [i1]
    /// // here Depth is 1, Indexes is [i1]
    /// for i2 = 0 to 10 do
    /// // here Indexes is [i2; i1]
    /// // here Depth is 2, Indexes is [i2; i1]
    /// for i2 = 0 to 10 do
    /// // here Depth is 3, Indexes is [i3; i2; i1]
    type LoopInput = { Depth : int; Indexes : int list }

    /// Simple specification to indicate the range over which the loop
    @@ -39,11 +41,7 @@ type LoopConfig = {

    /// Nested 'for' loops to programmatic deptch
    let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange; Body = body } =
    let rec loop currDepth minStack maxStack prevIdxs =
    // maintain the hierarchy of indexes in a list
    let currMin :: minTail = minStack
    let currMax :: maxTail = maxStack

    let rec loop currDepth (currMin :: minTail as minStack) (currMax :: maxTail as maxStack) prevIdxs =
    // a loop's index has run to the end
    if currMin > currMax then
    ascendOrReturn currDepth prevIdxs minTail maxTail
    @@ -66,15 +64,15 @@ let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange;
    // go down to a new level of nesting
    | Descend ->
    let newDepth = currDepth + 1
    if newDepth >= maxDepth then invalidOp "Attempted to descend beyond specified depth" else
    if newDepth > maxDepth then invalidOp "Attempted to descend beyond specified depth" else
    // obtain the loop range that should be used in this new level
    let newRange = getRange { Depth = newDepth; Prev = newIndexes }
    loop newDepth (newRange.Min::(currMin+1)::minTail) (newRange.Max::maxStack) newIndexes

    // pop up one level of nesting, or return if already at level 0
    and ascendOrReturn currDepth prevIdxs minTail maxTail =
    if currDepth = 0 then () else
    if currDepth = 1 then () else
    let _::idxTail = prevIdxs
    loop (currDepth - 1) minTail maxTail idxTail

    loop 0 [range.Min] [range.Max] [
    loop 1 [range.Min] [range.Max] []
  6. latkin revised this gist Dec 26, 2014. 4 changed files with 86 additions and 79 deletions.
    3 changes: 3 additions & 0 deletions README.md
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,3 @@
    Backing code for two different mini-frameworks adding extended imperative-style `for` loops in F#.

    Discussed in blog post here.
    80 changes: 80 additions & 0 deletions a_nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,80 @@
    // see link for more details

    #nowarn "25"

    /// The body of each nested loop needs to return one of these actions.
    /// Break/Continue/Return behave as normal, Descend simply signals that
    /// the next nesting should start
    type LoopAction = Break | Continue | Return | Descend

    /// The body of each nested loop gets this information as input.
    /// Depth indicates the current level of nesting, Indexes bundles up
    /// all of the loop counter values up through the current level of nesting.
    /// e.g. for i1 = 0 to 10 do
    /// // here Indexes is [i1]
    /// for i2 = 0 to 10 do
    /// // here Indexes is [i2; i1]
    type LoopInput = { Depth : int; Indexes : int list }

    /// Simple specification to indicate the range over which the loop
    /// counter should run. e.g. for i = Min to Max do
    type LoopRange = { Min : int; Max : int }

    /// When asked to compute the new counter range, this is the
    /// input information. The current level of nesting, and the bundle
    /// of index values from previous levels of nesting.
    type RangeInput = { Depth : int; Prev : int list }

    /// Input to the main looping function.
    type LoopConfig = {
    /// Specifies how deep to nest the loops
    Depth : int
    /// Specifies the range for the level-0, outermost loop
    InitialRange : LoopRange
    /// Specifies the function used to compute min and max for new nested loops
    GetNextRange : RangeInput -> LoopRange
    /// Specifies the function used as the body for all loops
    Body : LoopInput -> LoopAction
    }

    /// Nested 'for' loops to programmatic deptch
    let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange; Body = body } =
    let rec loop currDepth minStack maxStack prevIdxs =
    // maintain the hierarchy of indexes in a list
    let currMin :: minTail = minStack
    let currMax :: maxTail = maxStack

    // a loop's index has run to the end
    if currMin > currMax then
    ascendOrReturn currDepth prevIdxs minTail maxTail
    else

    // update the bundle of indexes 'active' for this iteration
    let newIndexes = currMin::prevIdxs

    // invoke the body of the loop
    match body {Depth = currDepth; Indexes = newIndexes} with
    // return from the entire thing
    | Return -> ()

    // break out of this nesting depth, up to the previous depth
    | Break -> ascendOrReturn currDepth prevIdxs minTail maxTail

    // keep going in this depth, don't do further nesting
    | Continue -> loop currDepth ((currMin+1)::minTail) maxStack prevIdxs

    // go down to a new level of nesting
    | Descend ->
    let newDepth = currDepth + 1
    if newDepth >= maxDepth then invalidOp "Attempted to descend beyond specified depth" else
    // obtain the loop range that should be used in this new level
    let newRange = getRange { Depth = newDepth; Prev = newIndexes }
    loop newDepth (newRange.Min::(currMin+1)::minTail) (newRange.Max::maxStack) newIndexes

    // pop up one level of nesting, or return if already at level 0
    and ascendOrReturn currDepth prevIdxs minTail maxTail =
    if currDepth = 0 then () else
    let _::idxTail = prevIdxs
    loop (currDepth - 1) minTail maxTail idxTail

    loop 0 [range.Min] [range.Max] [
    4 changes: 3 additions & 1 deletion imperativeBuilder.fs → b_imperativeBuilder.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,4 +1,6 @@
    // from http://tomasp.net/blog/imperative-ii-break.aspx/
    // taken from
    // http://tomasp.net/blog/imperative-i-return.aspx/ and
    // http://tomasp.net/blog/imperative-ii-break.aspx/

    open System.Collections.Generic

    78 changes: 0 additions & 78 deletions nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,78 +0,0 @@
    #nowarn "25"
    module ForLoop =
    /// The body of each nested loop needs to return one of these actions.
    /// Break/Continue/Return behave as normal, Descend simply signals that
    /// the next nesting should start
    type LoopAction = Break | Continue | Return | Descend

    /// The body of each nested loop gets this information as input.
    /// Depth indicates the current level of nesting, Indexes bundles up
    /// all of the loop counter values up through the current level of nesting.
    /// e.g. for i1 = 0 to 10 do
    /// // here Indexes is [i1]
    /// for i2 = 0 to 10 do
    /// // here Indexes is [i2; i1]
    type LoopInput = { Depth : int; Indexes : int list }

    /// Simple specification to indicate the range over which the loop
    /// counter should run. e.g. for i = Min to Max do
    type LoopRange = { Min : int; Max : int }

    /// When asked to compute the new counter range, this is the
    /// input information. The current level of nesting, and the bundle
    /// of index values from previous levels of nesting.
    type RangeInput = { Depth : int; Prev : int list }

    /// Input to the main looping function.
    type LoopConfig = {
    /// Specifies how deep to nest the loops
    Depth : int
    /// Specifies the range for the level-0, outermost loop
    InitialRange : LoopRange
    /// Specifies the function used to compute min and max for new nested loops
    GetNextRange : RangeInput -> LoopRange
    /// Specifies the function used as the body for all loops
    Body : LoopInput -> LoopAction
    }

    /// Nested 'for' loops to programmatic deptch
    let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange; Body = body } =
    let rec loop currDepth minStack maxStack prevIdxs =
    // maintain the hierarchy of indexes in a list
    let currMin :: minTail = minStack
    let currMax :: maxTail = maxStack

    // a loop's index has run to the end
    if currMin > currMax then
    ascendOrReturn currDepth prevIdxs minTail maxTail
    else

    // update the bundle of indexes 'active' for this iteration
    let newIndexes = currMin::prevIdxs

    // invoke the body of the loop
    match body {Depth = currDepth; Indexes = newIndexes} with
    // return from the entire thing
    | Return -> ()

    // break out of this nesting depth, up to the previous depth
    | Break -> ascendOrReturn currDepth prevIdxs minTail maxTail

    // keep going in this depth, don't do further nesting
    | Continue -> loop currDepth ((currMin+1)::minTail) maxStack prevIdxs

    // go down to a new level of nesting
    | Descend ->
    let newDepth = currDepth + 1
    if newDepth >= maxDepth then invalidOp "Attempted to descend beyond specified depth" else
    // obtain the loop range that should be used in this new level
    let newRange = getRange { Depth = newDepth; Prev = newIndexes }
    loop newDepth (newRange.Min::(currMin+1)::minTail) (newRange.Max::maxStack) newIndexes

    // pop up one level of nesting, or return if already at level 0
    and ascendOrReturn currDepth prevIdxs minTail maxTail =
    if currDepth = 0 then () else
    let _::idxTail = prevIdxs
    loop (currDepth - 1) minTail maxTail idxTail

    loop 0 [range.Min] [range.Max] []
  7. latkin created this gist Dec 26, 2014.
    50 changes: 50 additions & 0 deletions imperativeBuilder.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,50 @@
    // from http://tomasp.net/blog/imperative-ii-break.aspx/

    open System.Collections.Generic

    type ImperativeResult<'T> =
    | ImpValue of 'T
    | ImpJump of int * bool
    | ImpNone

    type Imperative<'T> = unit -> ImperativeResult<'T>

    type ImperativeBuilder() =
    member x.Combine(a, b) = (fun () ->
    match a() with
    | ImpNone -> b()
    | res -> res)
    member x.Delay(f:unit -> Imperative<_>) = (fun () -> f()())
    member x.Return(v) : Imperative<_> = (fun () -> ImpValue(v))
    member x.Zero() = (fun () -> ImpNone)
    member x.Run<'T>(imp) =
    match imp() with
    | ImpValue(v) -> v
    | ImpJump _ -> failwith "Invalid use of break/continue!"
    | _ when typeof<'T> = typeof<unit> -> Unchecked.defaultof<'T>
    | _ -> failwith "No value has been returend!"
    member x.CombineLoop(a, b) = (fun () ->
    match a() with
    | ImpValue(v) -> ImpValue(v)
    | ImpJump(0, false) -> ImpNone
    | ImpJump(0, true)
    | ImpNone -> b()
    | ImpJump(depth, b) -> ImpJump(depth - 1, b))
    member x.For(inp:seq<_>, f) =
    let rec loop(en:IEnumerator<_>) =
    if not(en.MoveNext()) then x.Zero() else
    x.CombineLoop(f(en.Current), x.Delay(fun () -> loop(en)))
    loop(inp.GetEnumerator())
    member x.While(gd, body) =
    let rec loop() =
    if not(gd()) then x.Zero() else
    x.CombineLoop(body, x.Delay(fun () -> loop()))
    loop()
    member x.Bind(v:Imperative<unit>, f : unit -> Imperative<_>) = (fun () ->
    match v() with
    | ImpJump(depth, kind) -> ImpJump(depth, kind)
    | _ -> f()() )

    let imperative = new ImperativeBuilder()
    let break = (fun () -> ImpJump(0, false))
    let continue = (fun () -> ImpJump(0, true))
    78 changes: 78 additions & 0 deletions nestedFor.fs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,78 @@
    #nowarn "25"
    module ForLoop =
    /// The body of each nested loop needs to return one of these actions.
    /// Break/Continue/Return behave as normal, Descend simply signals that
    /// the next nesting should start
    type LoopAction = Break | Continue | Return | Descend

    /// The body of each nested loop gets this information as input.
    /// Depth indicates the current level of nesting, Indexes bundles up
    /// all of the loop counter values up through the current level of nesting.
    /// e.g. for i1 = 0 to 10 do
    /// // here Indexes is [i1]
    /// for i2 = 0 to 10 do
    /// // here Indexes is [i2; i1]
    type LoopInput = { Depth : int; Indexes : int list }

    /// Simple specification to indicate the range over which the loop
    /// counter should run. e.g. for i = Min to Max do
    type LoopRange = { Min : int; Max : int }

    /// When asked to compute the new counter range, this is the
    /// input information. The current level of nesting, and the bundle
    /// of index values from previous levels of nesting.
    type RangeInput = { Depth : int; Prev : int list }

    /// Input to the main looping function.
    type LoopConfig = {
    /// Specifies how deep to nest the loops
    Depth : int
    /// Specifies the range for the level-0, outermost loop
    InitialRange : LoopRange
    /// Specifies the function used to compute min and max for new nested loops
    GetNextRange : RangeInput -> LoopRange
    /// Specifies the function used as the body for all loops
    Body : LoopInput -> LoopAction
    }

    /// Nested 'for' loops to programmatic deptch
    let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange; Body = body } =
    let rec loop currDepth minStack maxStack prevIdxs =
    // maintain the hierarchy of indexes in a list
    let currMin :: minTail = minStack
    let currMax :: maxTail = maxStack

    // a loop's index has run to the end
    if currMin > currMax then
    ascendOrReturn currDepth prevIdxs minTail maxTail
    else

    // update the bundle of indexes 'active' for this iteration
    let newIndexes = currMin::prevIdxs

    // invoke the body of the loop
    match body {Depth = currDepth; Indexes = newIndexes} with
    // return from the entire thing
    | Return -> ()

    // break out of this nesting depth, up to the previous depth
    | Break -> ascendOrReturn currDepth prevIdxs minTail maxTail

    // keep going in this depth, don't do further nesting
    | Continue -> loop currDepth ((currMin+1)::minTail) maxStack prevIdxs

    // go down to a new level of nesting
    | Descend ->
    let newDepth = currDepth + 1
    if newDepth >= maxDepth then invalidOp "Attempted to descend beyond specified depth" else
    // obtain the loop range that should be used in this new level
    let newRange = getRange { Depth = newDepth; Prev = newIndexes }
    loop newDepth (newRange.Min::(currMin+1)::minTail) (newRange.Max::maxStack) newIndexes

    // pop up one level of nesting, or return if already at level 0
    and ascendOrReturn currDepth prevIdxs minTail maxTail =
    if currDepth = 0 then () else
    let _::idxTail = prevIdxs
    loop (currDepth - 1) minTail maxTail idxTail

    loop 0 [range.Min] [range.Max] []