(* Programming Languages I - SML Lab I *)
(* Local definition of variable y *)
fun f x =
let
val y = x + 1
in
x + y
end
(* Local definition of function g *)
fun f' x =
let
fun g y = y + 1
in
g x
end
(* Replace local function g with an anonymous function *)
fun f'' x = (fn y => y + 1) x
(* Different scopes of m *)
val m = 2
val r =
let
val m = 3
val n = m * m
in
m * n
end * m
(* Lexical scope *)
val x1 = 1
fun ff y1 = x1 + y1
val x1 = 2
val y1 = 3
val z = ff x1+y1
(* Lexical scope + HO *)
val x2 = 1
fun fff y2 =
let
val x2 = y2+1
in
fn z2 => x2 + y2 + z2
end
val x2 = 3
val g = fff 4
val y2 = 5
val z2 = g 6
(* Factorial as we'd write it in a language like C *)
fun fact n =
if n = 0 then 1
else n * fact (n -1)
(* Factorial with pattern matching on the argument *)
(* Order matters !!! *)
fun fact' n =
case n of 0 => 1
| _ => n * fact' (n - 1)
(* Factorial with pattern matching on the function's definition *)
(* Order matters !!! *)
fun fact'' 0 = 1
| fact'' n = n * fact'' (n - 1)
(* Trace of function calls of fact'' 5
(fact'' 5)
5 * (fact'' 4)
5 * 4 * (fact'' 3)
5 * 4 * 3 * (fact'' 2)
5 * 4 * 3 * 2 * (fact'' 1)
5 * 4 * 3 * 2 * 1 * (fact'' 0)
5 * 4 * 3 * 2 * 1 * 1
5 * 4 * 3 * 2 * 1
5 * 4 * 3 * 2
5 * 4 * 6
5 * 24
120
*)
(* Factorial as a tail recursive function *)
fun fact_h 0 acc = acc
| fact_h n acc = fact_h (n - 1) (n * acc)
fun fact2 n = fact_h n 1
(* Trace of function calls of fact2 5 (Tail recursion)
fact2 5
fact_h 5 1
fact_h 4 5
fact_h 3 20
fact_h 2 60
fact_h 1 120
fact_h 0 120
120
*)
(* Define fact_h as a local function *)
fun fact2' n =
let
fun aux 0 acc = acc
| aux n acc = aux (n - 1) (n * acc)
in
aux n 1
end
(* Other functions written as tail recursive *)
(* Length of a list *)
fun len [] = 0
| len (x::t) = 1 + len t
(* mporousame kai _ anti x: anonymous variable *)
fun len' l =
let
fun aux [] acc = acc
| aux (_::t) acc = aux t (acc + 1)
in
aux l 0
end
(* Sum of a list *)
fun suml 0 = 0
| suml n = 1 + suml (n - 1)
fun sumli [] = 0
| sumli (x::t) = x + sumli t
fun suml' l =
let
fun aux [] acc = acc
| aux (x::t) acc = aux t (x + acc)
in
aux l 0
end
(* Higher-order functions *)
(* Auxiliary functions to get the double and the square of a number *)
fun double x = 2 * x
fun square x = x * x
(* Get the quadruple and the fourth power of a number *)
fun quad x = double (double x)
fun fourth x = square (square x)
(* Use a higher-order function to abstract the double application *)
fun applyTwice f x = f (f x)
fun quad' x = applyTwice double x
fun fourth' x = applyTwice square x
(* Define square locally *)
fun fourth'' x =
let
fun square y = y * y
in
applyTwice square x
end
(* Replace square with an anononymous function *)
fun fourth''' x = applyTwice (fn y => y * y) x
(* Currying - Partial application *)
(* Note that vfourth and vquad are variables -- functions are first-class citizen *)
val vfourth = applyTwice (fn x => x * x)
val vquad = applyTwice (fn y => 2 * y)
(* Side effects - I/O *)
let
val x = 42
val () = print ("Value of x is " ^ (Int.toString x) ^ "\n")
in
x+1
end
(* Folding *)
(* Sum and concat of a list *)
fun sum l =
case l of [] => 0
| x::xs => x + (sum xs)
fun concat l =
case l of [] => ""
| x::xs => x ^ (concat xs)
(* Rewrite using tail recursion *)
fun sum' acc l =
case l of [] => acc
| x::xs => sum' (acc+x) xs
fun concat' acc l =
case l of [] => acc
| x::xs => concat' (acc^x) xs
(* Abstract the walking of the list and define foldl *)
fun foldl f acc l =
case l of [] => acc
| x::xs => foldl f (f (x, acc)) xs
(* Rewrite sum and concat using foldl *)
fun sum'' l = foldl (fn (x, acc) => acc + x) 0 l
fun concat'' l = foldl (fn (x, acc) => acc ^ x) "" l
(* foldr is similar but walks the list from end to start *)
fun foldr f acc l =
case l of [] => acc
| x::xs => f (x, (foldr f acc xs))
(* Replace anonymous function with library operators *)
val sum''' = foldl Int.+ 0
val concat''' = foldr String.^ ""
(* Examples of some functions from the List structure of the SML library using foldl/foldr *)
(* Possibly not the most efficient implementation when using foldr !!! *)
(* length l :returns the number of elements in the list l. *)
fun length l = foldl (fn (_, acc) => acc + 1) 0 l
(* rev l : returns a list consisting of l's elements in reverse order. *)
fun rev l = foldl List.:: [] l
(* map f l : applies f to each element of l from left to right, returning the list of results. *)
fun map f l = foldr (fn (x, acc) => (f x)::acc) [] l (* PROSOXH: thelei foldr gia na min anstistrepsei ti lista *)
(* app f l : applies f to the elements of l, from left to right. *)
fun app f l = foldl (fn (x, _) => f x) () l
(* filter f l : applies f to each element x of l, from left to right, and returns the list of those x *)
(* for which f x evaluated to true, in the same order as they occurred in the argument list. *)
fun filter f l = foldr (fn (x, acc) => if f x then x::acc else acc) [] l
(* Exercises *)
(* Perfect Numbers *)
fun factors 1 = [1]
| factors n =
let
fun aux 1 acc = 1::acc
| aux x acc =
case n mod x of 0 => aux (x - 1) (x::acc)
| _ => aux (x - 1) acc
in
aux (n div 2) []
end
fun is_perfect n =
n = sum (factors n)
(* Another way to write factors using List.filter *)
fun factors' n =
let
fun range 0 acc = acc
| range n acc = range (n - 1) (n::acc)
in
List.filter (fn x => (n mod x) = 0) (range (n div 2) [])
end
val perfects = filter is_perfect [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15];
fun countup_from1 (x:int) =
let fun count (from:int) =
if from=x
then x::[]
else from :: count(from+1)
in
count 1
end
fun perfects_up_to_x x = filter is_perfect (countup_from1 x)
(* kai length: posa uparxoun *)
(* PowerSet *)
(* Use map *)
fun powerset_naive [] = [[]]
| powerset_naive (h::t) =
let
fun cons h t = h :: t
in
(map (cons h) (powerset_naive t)) @ (powerset_naive t) (* dyo fores upologizw to idio !!! *)
end
fun powerset [] = [[]]
| powerset (h::t) =
let
fun cons h t = h :: t
val pst = powerset t (* akrivos upologismos: mia fora ! *)
in
(map (cons h) pst) @ pst
end
(* Use foldl *)
fun powerset' [] = [[]]
| powerset' (h::t) = foldl (fn (x, xs) => (h::x)::x::xs) [] (powerset' t)
(* K-elements combinations *)
fun kcombs 0 _ = [[]] (* Base case *)
| kcombs _ [] = [] (* Cover cases when k > length of list *)
| kcombs k (h::t) = (map (fn xs => h :: xs) (kcombs (k-1) t)) @ kcombs k t