Functional Programming Using Fsharp个人答案

haseetxwd

于 2016-05-22 19:10:46 发布

阅读量461

点赞数

文章标签：函数式编程

本文链接：https://blog.csdn.net/haseetxwd/article/details/51476388

版权

1

1.1

let g n = n + 4;;

1.2

let h (x, y) = System.Math.Sqrt (x * x + y * y);;

1.3

g 1;;
f (1, 2);;

1.4

let rec f = function
  | 0 -> 0
  | n -> n + f (n-1);;

1.5

let rec fibonacci = function
  | 0 -> 0
  | 1 -> 1
  | n -> fibonacci (n-1) + fibonacci (n-2);;

1.6

let rec sum = function
  | (m, 0) -> m
  | (m, n) -> m + n + sum(m, n-1);;

1.7

float*int
int
float
(float*int -> float)*(int -> int)

1.8

> let a = 5;;  
val a : int = 5  
> let f a = a + 1;;  
val f : a:int -> int  
> let g b = (f b) + a;;  
val g : b:int -> int  
> f 3;;  
val it : int = 4  
> g 3;;  
val it : int = 9

2

2.1

let f n = (n % 2 = 0) &&  (n % 3 = 0) && (n % 5 <> 0);;
f 24;;
f 27;;
f 29;;
f 30;;

2.2

let rec pow = function
  | (_, 0) -> ""
  | (s, n) -> s + pow(s, n-1);;

2.3

let isIthString (str, i, ch) = 
  if String.length str <= i 
  then false 
  else str.[i] = ch;;

2.4

let rec occFromIth (str, i, ch) = 
  if String.length str <= i
  then 0
  else if str.[i] = ch
       then i
       else occFromIth (str, i+1, ch);;

2.5

let rec occInString (str, i, ch, acc) =
  if String.length str <= i
  then acc
  else if str.[i] = ch
       then occInString (str, i+1, ch, acc+1)
       else occInString (str, i+1, ch, acc);;
let occInString (str, ch) = occInString (str, 0, ch, 0);;

2.6

let notDivisible(d, n) = if n % d = 0 then false else true;;

2.7

let rec test (a, b, c) = if a > b then true else notDivisible(a, c) && test(a+1, b, c);; 
let prime n = if n = 1 then true else test (2, n, n);;
let nextPrime n = if prime (n+1) then (n+1) else nextPrime (n+1);;

2.8

let rec bin = function
  | (n, 0) -> 1
  | (n, k) -> if n = k then 1 else bin (n-1, k-1) + bin(n-1, k);;

2.9

 1. int*int -> int
 2. when x = 0 in f(x, y)
 3. f(2, 3) = f(1, 6) = f(0, 12) = 12
 4. f(x, y) = x! * y

2.10

 5. bool*int -> int
 6. 
3.type error?

2.11

let Vat (n:int) x = x * (1.0 +(float n) / 100.0);;
let unVat (n:int) x = x / (1.0 +(float n) / 100.0);;

2.12

let rec minRec (f:int->int) n = if f n = 0  then n else f (n+1);;
let min (f:int->int) : int = minRec f 0;;

2.13

let curry f x y = f (x, y);;
let uncurry f (x, y) = f x y;;

3

3.1

Tuple

let timeTuple = function
  | (a, b, "AM") -> a * 60 + b
  | (a, b, "PM") -> (a + 12) * 60 + b
  | _            -> failwith "Neither AM or PM";;
let beforeTuple a b = timeTuple a < timeTuple b;;

Record

type Time = {hours:int; mimutes:int; f:string};;
let timeRecord {hours = a; mimutes = b; f = c } = 
  match c with
  | "AM" -> a * 60 + b
  | "PM" -> (a + 12) * 60 + b
  | _    -> failwith "Neither AM or PM";;
let beforeRecord a b = timeRecord a < timeRecord b;;

3.2

Tuple

let currencyTupleToValue (pounds, shaillings, pence) =  ((pounds * 20) + shaillings) * 12 + pence;;
let currencyValueToTuple value =
  let pence = value % 12
  let shaillings = (value / 12) % 20
  let pounds = value / (12 * 20)
  (pounds, shaillings, pence);;
let (.+.) a b = currencyValueToTuple (currencyTupleToValue a + currencyTupleToValue b);;
let (.-.) a b = currencyValueToTuple (currencyTupleToValue a - currencyTupleToValue b);;

Record

type currency = {pounds:int;shaillings:int;pence:int};;
let currencyRecordToValue {pounds = a;shaillings = b;pence = c} =  ((a * 20) + b) * 12 + c;;
let currencyValueToRecord value =
  let c = value % 12
  let b = (value / 12) % 20
  let a = value / (12 * 20)
  {pounds = a; shaillings = b; pence = c};;
let (.+.) a b = currencyValueToRecord (currencyRecordToValue a + currencyRecordToValue b);;
let (.-.) a b = currencyValueToRecord (currencyRecordToValue a - currencyRecordToValue b);;

3.3

let (.+.) (a:float, b) (c, d) = (a+c, b+d);;
let (.*.) (a:float, b) (c, d) = (ac-bd, bc+ad);;
let (.-.) (a:float, b) (c, d) = (a-c, b-d);;
let inverseComplex (a:float, b) = (a/(a * a + b * b), - b/(a * a + b * b));; 
let (./.) a b = if (a == 0.0 && b == 0.0) then failwith "both a and b are 0." else a .*. (inverseComplex b);;

3.5

type Solution = | TwoRoot of float * float
                | OneRoot of float
                | NoRoot;;

let solve(a, b, c) =
  let delta = b * b - 4 * a * c
  match delta with
  | 0            -> OneRoot of (-b) / (2 * a)
  | t when t > 0 -> TwoRoot of ((-b + sqrt delta)/(2 * a), (-b - sqrt delta)/(2 * a))
  | _            -> NoRoot;;

3.6

type AMPM = AM | PM;;
let timeTuple = function
  | (a, b, AM) -> a * 60 + b
  | (a, b, PM) -> (a + 12) * 60 + b;;

4

4.1

let upto n = 
  let rec uptoRec =
    function
    | (0, x) -> x
    | (n, x) -> uptoRec ((n-1), n::x)
  uptoRec(n, []);;

4.2

let rec downto1 n =
  match n with
  | 0 -> []
  | n -> n::downto1 (n-1);;

4.3

let evenN n = 
  let rec evenNRec =
    function
    | (0, x) -> x
    | (n, x) -> evenNRec ((n-1), (n*2)::x)
  evenNRec(n, []);;

4.4

let rec altsum = function
  | [] -> 0
  | x::xs -> if xs = [] then x  else x - List.head xs + altsum (List.tail xs);;

4.5

let rmodd x = 
  let rec rmRec n y =
    if n = 0
    then if y = []
         then []
         else List.head y::rmRec 1 (List.tail y)
    else if y = []
         then []
         else rmRec 0 (List.tail y)    
  rmRec 0 x;;

4.6

let rmeven x = 
  let rec rmRec n y =
    if n = 0
    then if y = []
         then []
         else List.head y::rmRec 1 (List.tail y)
    else if y = []
         then []
         else rmRec 0 (List.tail y)    
  rmRec 1 x;;

4.7

let rec occur x xs = 
  if xs = []
  then 0
  else if List.head xs = x
       then 1 + occur x (List.tail xs)
       else occur x (List.tail xs);;

Fuck!!!不知道4.5为什么模式匹配没成功

let rex occur x xs =
  match xs with
  | [] -> 0
  | y::ys -> if y = x
             then 1 + occur x ys
             else occur x ys;;

4.8

let split x =
  let rec splitRec (n, a, b, c) =
    match a with
    | [] -> (b, c)
    | y::ys -> if n = 0 
               then splitRec (1, ys, b@[y], c) 
               else splitRec (0, ys, b, c@[y])
  splitRec (0, x, [], []);;

4.9

let rec zip = function
  | (x::xs, y::ys) -> (x, y)::zip(xs, ys)
  | ([], []) -> []
  | ([], _) | (_, []) -> failwith "Not Equal";;

4.10

let rec prefix = function
  | (x::xs, y::ys) -> if x = y then true && prefix (xs, ys) else false
  | ([], _)        -> true
  | (_, [])        -> false;;

4.11

let rec count = function
  | (x::xs, y) -> if x = y then 1 + count(xs, y) else count(xs, y)
  | ([], y)    -> 0;;
let rec insert = function
  | (x::xs, y) -> if y > x then x::y::xs else x::insert(xs, y)
  | ([], y)    -> [y];;
let rec intersect = function
  | (x::xs, y::ys) when x < y -> intersect(xs, y::ys)
  | (x::xs, y::ys) when x > y -> intersect(x::xs, ys)
  | (x::xs, y::ys) -> x::intersect(xs, ys) 
  | ([], _)        -> []
  | (_, [])        -> [];;
let rec plus = function
  | (x::xs, y::ys) when x < y -> x::plus(xs, y::ys)
  | (x::xs, y::ys) when x > y -> y::plus(x::xs, ys)
  | (x::xs, y::ys) -> x::y::plus(xs, ys) 
  | ([], y)        -> y
  | (x, [])        -> x;;
let rec minus = function
  | (x::xs, y::ys) when x < y -> x::minus(xs, y::ys)
  | (x::xs, y::ys) when x > y -> minus(x::xs, ys)
  | (x::xs, y::ys) -> minus(xs, ys)
  | ([], _) -> []
  | (x, []) -> x;;

4.12

let rec sum = function
  | (p, x::xs) -> if (p x) then x + sum(p, xs) else sum(p, xs)
  | (p, []) -> 0;;
sum((fun n -> n > 0), [-1;1]);;

4.13

let smallest x =
  let rec smallestRec = function
    | (x, y::ys) -> if x < y then smallestRec(x, ys) else smallest(y, ys)
    | (x, [])    -> x
  smallestRec(List.head x, x);;
let rec delete = function
  | (a, x::xs) when a = x -> xs
  | (a, x::xs) -> x::delete(a, xs)
  | (a, [])    -> [];;
let sort = function
  | [] -> []
  | x  -> (smallest x)::delete(smallest x, x);;

4.15

let revrev = function
  let rec rev = function
    | x::xs -> xs@[x]
    | []    -> []
  | x::xs -> xs@[rev x]
  | [] -> [];;

4.16

f:int*int list -> int list
g:(a’* a’) list -> (a’ * a’) list
h: a’ list -> a’ list
1.int list
2.(a’ * a’) list
3.a’ list

4.17

a’ list -> a’ list

4.19

let rec areNb m c1 c2 =
  match m with
  | [] -> false
  | (a, b)::mm when ((a=c1 && b=c2) || (a=c2 && b=c1)) -> true
  | (a, b)::mm -> areNb mm  c1  c2;;

5

5.1

let filter p x = List.foldBack (fun x y -> if (p x) then x::y else y) x [];;

5.2

let revrev a = 
  let rev = List.fold (fun x y -> y::x) []
  List.fold (fun x y -> (rev y)::x) [] a;;       
revrev [[1;2];[3;4;5]];;

5.3

let sum p x = List.fold (fun x y -> if p y then x + y else x) 0 x;;

5.4

let downto1 f n e = 
  if n > 0
  then List.foldBack (fun x y -> f x y) [1..(n-1)]  (f n e)
  else e;;

let factorial n = downto1 (fun x y -> x * y) n 1;;

let build g n = downto1  (fun x y -> (g x)::y) n [];;

factorial 10;;

build id 10;;

5.7

立即求值就是麻烦啊，在每一次let绑定时就进行求值

let rec bin = function
  | (n, 0) -> 1
  | (n, k) -> if n = k then 1 else bin (n-1, k-1) + bin(n-1, k);;
let allSubsets n k = 
  if n <= k 
  then failwith "n <= k" 
  else
    let array = [1..n]
    let num = bin(n, k)
    let rec subset n = function
      | x::xs when n > 0 -> x::(subset (n-1) xs)
      | _                -> []
    let rec subsets n x =
      let headList = List.head x
      let tailList = List.tail x
      if n <= 0
      then []
      else (subset k x)::(subsets (n-1) (tailList@[headList])) 
    subsets num array;;
allSubsets 3 2;;
allSubsets 3 1;;
allSubsets 3 0;;

6

6.2

type Fexpr = | Const of float
             | X
             | Add of Fexpr * Fexpr
             | Sub of Fexpr * Fexpr
             | Mul of Fexpr * Fexpr
             | Div of Fexpr * Fexpr
             | Sin of Fexpr
             | Cos of Fexpr
             | Log of Fexpr
             | Exp of Fexpr;;

let rec RPN = function
  | Const x -> string x + " " 
  | X  -> "x "
  | Add(fe1, fe2) -> (RPN fe1) + (RPN fe2) + "+ "
  | Sub(fe1, fe2) -> (RPN fe1) + (RPN fe2) + "- "
  | Mul(fe1, fe2) -> (RPN fe1) + (RPN fe2) + "* "
  | Div(fe1, fe2) -> (RPN fe1) + (RPN fe2) + "/ "
  | Sin fe -> RPN fe + "sin "
  | Cos fe -> RPN fe + "cos "
  | Log fe -> RPN fe + "log "
  | Exp fe -> RPN fe + "exp ";;
RPN (Sin(Mul(X, X)));;

6.4

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

let leafVals x = 
  let rec leafValsRec = function
    | Leaf a -> [a]
    | Node (a, _, b) -> (leafValsRec a) @ (leafValsRec b) 
  Set.oflist (leafValsRec x);;

let nodeVals x = 
  let rec nodeValsRec = function
    | Leaf a -> []
    | Node (a, b, c) -> (nodeValsRec a) @ [b] @ (nodeValsREc c)
  Set.oflist (nodeValsRec x);;

let vals x = (leafVals x, nodeVals x);;

6.5

type AncTree = 
  | Unspec
  | Info of AncTree * string * AncTree;;

let rec maleAnc = 
  let rec FAnc = function
    | Unspec -> []
    | Info (a, x, b) -> x::(FAnc a)@(maleAnc b)
  function
  | Unspec -> []
  | Info (a, x, b) -> (FAnc a)@(maleAnc b);;
let rec femaleAnc =
  let rec MAnc = function
    | Unspec -> []
    | Info (a, x, b) -> x::(femaleAnc a)@(MAnc b)
  function
  | Unspec -> []
  | Info (a, x, b) -> (female a)@(MAnc b);;

6.6

type BinTree<'a when 'a: comparison> =
  | Leaf
  | Node of BinTree<'a> * 'a * BinTree<'a>;;
let rec add x t  = 
  match t with
  | Leaf                     -> Node (Leaf, x, Leaf)
  | Node(tl, a, tr) when x<a -> Node (add x tl, a,tr)
  | Node(tl, a, tr) when x>a -> Node (tl, a, add x tr)
  | _                        -> t;;

let rec delete x t = 
  let rec conjunction x = fucntion
    | Leaf -> tl
    | Node (tl, a,tr) -> Node (conjunction x tl, a, tr)
  match t with
  | Leaf                      -> Leaf
  | Node (tl, a, tr) when x<a -> Node (delete x tl, a, tr)
  | Node (tl, a, tr) when x>a -> Node (tl, a, delete x tr)
  | Node (Leaf, a, Leaf)      -> Leaf
  | Node (Leaf, a, tr)        -> tr
  | Node (tl, a, Leaf)        -> tl
  | Node (tl, a, tr)          -> conjunction(tl, tr);;

6.7

type PropositionExp =
  | Proposition of string
  | Negation of Propostion
  | Conjunction of Proposition * Proposition
  | Disjunction of Proposition * Proposition

6.8

type Fexpr = | Const of float
             | X
             | Add of Fexpr * Fexpr
             | Sub of Fexpr * Fexpr
             | Mul of Fexpr * Fexpr
             | Div of Fexpr * Fexpr
             | Sin of Fexpr
             | Cos of Fexpr
             | Log of Fexpr
             | Exp of Fexpr;;

type Stack = int List;;
type Instruction = | ADD | SUB | MUL | DIV | SIN
                   | COS | LOG | EXP | PUSH of float;;

let intpInstr a b =
  match (a, b) with
  | (x::xs::xss, ADD)  -> (xs + x)::xss
  | (x::xs::xss, SUB)  -> (xs - x)::xss
  | (x::xs::xss, MUL)  -> (xs * x)::xss
  | (x::xs::xss, DIV)  -> (xs / x)::xss
  | (x::xs, SIN)       -> (System.Math.Sin x)::xs
  | (x::xs, COS)       -> (System.Math.Cos x)::xs
  | (x::xs, LOG)       -> (System.Math.Log x)::xs
  | (x::xs, EXP)       -> (System.Math.Exp x)::xs
  | (x, PUSH a)        -> a::x
  | _                  -> failwith "Matching Fail";;

let intpProg = List.fold intpInstr [];;

let trans (fe, x) =
  let rec transRec(fe, stack) =
    match fe with
    | Const z -> PUSH z::stack
    | X  -> PUSH x::stack
    | Add(fe1, fe2) -> transRec(fe1,transRec(fe2, ADD::stack))
    | Sub(fe1, fe2) -> transRec(fe1,transRec(fe2, SUB::stack))
    | Mul(fe1, fe2) -> transRec(fe1,transRec(fe2, MUL::stack))
    | Div(fe1, fe2) -> transRec(fe1,transRec(fe2, DIV::stack))
    | Sin fe -> transRec(fe, SIN::stack)
    | Cos fe -> transRec(fe, COS::stack)
    | Log fe -> transRec(fe, LOG::stack)
    | Exp fe -> transRec(fe, EXP::stack)
  transRec(fe, []);;


let ins = trans(Sin(Sub(Const 2.0, X)), 1.0);;
intpProg ins;;

6.9

type Name = string;;
type Incoming = float;;
type Department = Depart of Name * Incoming * Department list;;

let rec fun3 (Depart(a, b, c)) = (a, b)::(List.collect fun3 c);;

let fun3Fold = 
  let rec fun3FoldAux f e (Depart(a, b, c)) =
    List.fold (fun3FoldAux f) (f e (a,b)) c
  fun3FoldAux (fun a x -> x::a) [];;

//val fun3FoldAux : f:('a -> Name * Incoming -> 'a) -> e:'a -> Department -> 'a
//val fun3Fold : (Department -> (Name * Incoming) list)
//fun3FoldAux (fun a x -> x::a);;
//val it : ((Name * Incoming) list -> Department -> (Name * Incoming) list)

let fun4 x = List.sum (List.map snd (fun3 x));;
//let fun4 = List.sum << List.map snd << fun3;;

let myfst (Depart(a,_,_)) = a;;
let fun5 = List.map (fun x -> (myfst x, fun4 x)) ;;

let format (Depart(a, b, c)) = string a + "    " + string b;;

6.10

type ExprTree = 
  | Const of int
  | Ident of string 
  | Minus of ExprTree
  | Sum   of ExprTree * ExprTree
  | Diff  of ExprTree * ExprTree
  | Prod  of ExprTree * ExprTree
  | Let   of string * ExprTree * ExprTree
  | IFTE  of BoolExp * ExprTree * ExprTree

and BoolExp =
  | True
  | False
  | Negation    of BoolExp
  | Conjunction of BoolExp * BoolExp
  | Disjunction of BoolExp * BoolExp
  | LessThan of ExprTree * ExprTree
  | MoreThan of ExprTree * ExprTree
  | Equal of ExprTree * ExprTree
  | LessThanEqual of ExprTree * ExprTree
  | MoreThanEqual of ExprTree * ExprTree;;



let rec eval t env =
  match t with
  | Const n      -> n
  | Ident s      -> Map.find s env
  | Minus t      -> - (eval t env)
  | Sum(t1,t2)   -> eval t1 env + eval t2 env
  | Diff(t1,t2)  -> eval t1 env - eval t2 env
  | Prod(t1,t2)  -> eval t1 env * eval t2 env
  | Let(s,t1,t2) -> let v1 = eval t1 env
                    let env1 = Map.add s v1 env
                    eval t2 env1
  | IFTE (a,b,c) -> if boolValue a env then eval b env else eval c env
and  boolValue t env =
  match t with
  | True                 -> true
  | False                -> false
  | Negation x           -> not (boolValue x env)
  | Conjunction (x, y)   -> (boolValue x env) && (boolValue y env)
  | Disjunction (x, y)   -> (boolValue x env) || (boolValue y env)
  | LessThan (x, y)      -> (eval x env)  < (eval y env)
  | MoreThan (x, y)      -> (eval x env)  > (eval y env)
  | Equal (x, y)         -> (eval x env)  = (eval y env)
  | LessThanEqual (x, y) -> (eval x env) <= (eval y env)
  | MoreThanEqual (x, y) -> (eval x env) >= (eval y env);;

6.11

let t1 = Node(1,[t2; t3; t4]);;
let rec depthFirstFold f e (Node(x,ts)) =
  List.fold (depthFirstFold f) (f e x) ts;;

>>depthFirstFold (fun a x -> x::a) [] t1
->List.fold (depthFirstFold f) [1] [t2;t3;t4]
->List.fold (depthFirstFold f) (depthFirstFold f [1] t2) [t3;t4]
->List.fold (depthFirstFold f) (depthFirstFold f [1] Node(2,[t5])) [t3;t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f) [2;1] [t5]) [t3;t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f [2;1] t5) []) [t3;t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f [2;1] Node(5,[])) []) [t3;t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f) (List.fold (depthFirstFold f) [5;2;1] [])) []) [t3;t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f) [5;2;1] []) [t3;t4]
->List.fold (depthFirstFold f) (depthFirstFold f [5;2;1] t3) [t4]
->List.fold (depthFirstFold f) (depthFirstFold f [5;2;1] Node(3,[])) [t4]
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f) [3;5;2;1] []) [t4]
->List.fold (depthFirstFold f) [3;5;2;1] [t4]
->List.fold (depthFirstFold f) (depthFirstFold f [3;5;4;1] t4) []
->List.fold (depthFirstFold f) (depthFirstFold f [3;5;4;1] Node(4,[])) []
->List.fold (depthFirstFold f) (List.fold (depthFirstFold f) [4;3;5;2;1] []) []
->List.fold (depthFirstFold f) [4;3;5;2;1] []
->[4;3;5;2;1]

7

7.1

module Vector
type Vector = { x: float, y: float}
let (~-.) ({x, y} = {-x, -y}
let (+.)  ({x1, y1}) ({x2, y2}) = {x1+x2, y1+y2}
let (-.)  ({x1, y1}) ({x2, y2}) = {x1-x2, y1-y2}
let (*.)  a ({x, y})            = {a*x, a*y}
let (&.)  ({x1, y1}) ({x2, y2}) = x1 * x2 + y1 * y2
let norm  ({x, y})              = sqrt(x*x + y*y)
let make  (x, y)                = {x, y}
let coord ({x,y})               = (x, y)

8

8.1

Environment Store
//let mutable x = 1
x |-> loc1 loc1:1
//let mutable y = (x, 2)
y |-> loc2 loc2:(1, 2)
//let z = y
z |-> 1
//x.a <- 7
loc1:7

8.3

Environment Store
//let x = {a = 1}
x |-> {a |-> loc1} loc1:1
//let y = {b = x.a; x = x}
y |-> {b |-> loc2, loc2:1
c |-> loc3} loc3:{a |-> loc1}
//x.a <- 3
loc1:3

8.5

let gcd a b =
  let mutable m = a
  let mutable n = b
  while m <> 0 do
    let t = n % m
    n <- m
    m <- t
  n;;
gcd 12 22;;

8.6

let fibonacci n =
  if n <= 1
  then n
  else let mutable i = 1
       let mutable x1 = 0
       let mutable x2 = 1
       let mutable temp = Unchecked.defaultof<int>
       while i < n do
         temp <- x1 + x2
         x1 <- x2
         x2 <- temp
         i <- i + 1
       temp;;
fibonacci 4;;

8.9

open System.Collections.Generic

type ListTree<'a> = Node of 'a * (ListTree<'a> list);;

let depthFirst ltr =
  let mutable result = []
  let remains = Queue<ListTree<'a>>()
  remains.Enqueue ltr
  while (remains.Count <> 0) do
    let (Node (x, tl)) = remains.Dequeue()
    List.iter (remains.Enqueue) tl
    result <- x::result
  List.rev result;;

let depthFirstFold f e tl =
  let mutable result = e
  let remains = Queue<ListTree<'a>>()
  remains.Enqueue tl
  while (remains.Count <> 0) do
    let (Node (x, tl)) = remains.Dequeue()
    List.iter (remains.Enqueue) tl
    result <- f e x
  result;;

9

9.2

let rec gcd (m, n) = 
  if (m <> 0)
  then gcd(n % m, m)
  else n;;

let f(n, m) = (n % m, m)
let p(n, m) = m <> 0
let h(n, m) = n

9.3

let sum(m, n) = 
  let sumRec(m, n, acc) =
    if n = 0
    then acc
    else sumRec(m, n-1, m + n + acc)
  sumRec(m, n, 0);;

9.4

let length x =
  let rec lengthRec(x, acc) = 
    match x with
    | []    -> acc
    | x::xs -> length(xs, acc + 1)
  length(x, 0);;

9.6

let fact_CPS n =
  let rec factRec n c =
    if n = 0
    then c 1
    else factRec (n-1) (fun x -> c(n * x))
  factRec n id;;
fact_CPS 3;;

9.7

let rec fibA n n1 n2 = 
  if n <= 1
  then n2
  else fibA (n-1) n2 (n1+n2);;
fibA 5 0 1;;
let rec fibC n c =
  if n <= 1
  then c n
  else fibC (n-1) (fun n1 -> fibC (n-2) (fun n2 -> c (n1 + n2)));;
fibC 5 id;;

9.8

type BinTree<'a> = 
  | Leaf
  | Node of BinTree<'a> * 'a * BinTree<'a>;;
let rec countA acc t =
  match t with
  | Leaf -> acc
  | Node(tl, a, tr) ->
    let ex = countA (acc+1) tr
    countA ex tl;;

9.10

let rec bigListC n c=
  if n = 0 then c []
  else bigListC (n-1) (fun res -> c(1::res));;
let rec bigListK n k=
  if n = 0 then k []
  else bigListK (n-1) (fun res -> 1::k(res));;
bigListC 130000 id;;
bigListK 130000 id;;

9.12

let rec preOrderC t c =
  match t with
  | Leaf -> c []
  | Node(tl, a, tr) -> preOrderC tl (fun v1 -> preOrderC t2 (fun v2 -> c (a::(v1@v2))));;

11

11.1

let nat = Seq.initInfinite (fun i -> i * 2 + 1);;
Seq.item 5 nat;;

11.2

let rec fact = function
  | 0 -> 1
  | n -> n * fact (n-1);;
let nat = Seq.initInfinite (fun i -> fact i);;

11.3

let cons x sq = Seq.append (Seq.singleton x) sq;;
let rec factor sq = 
  Seq.delay (fun () ->
                 let p = Seq.item 0 sq
                 let x = Seq.item 1 sq
                 if x <= 1
                 then cons 1 (factor (Seq.skip 1 sq))
                 else cons (p * x) (factor (cons (p*x) (Seq.skip 2 sq))));;
factor (Seq.initInfinite(fun i -> if i <= 1 then 0 else i-1));;