Commit 35586d56 authored by Dan Grossman's avatar Dan Grossman
Browse files

import unit 2 lecture code from 21au

parent 8dc4210b
(* CSE 341, Lecture 5 *)
(*#utop_prompt_dummy
let _ = UTop.set_show_box false
*)
(* records *)
(* records have the same "expressive power" as tuples, just with
* user-defined field names and different syntax for building and using
* but our first time making our own new type (!)
*)
type lava_lamp =
{ height : float
; color_liquid : string
; color_lava : string
}
let my_lamp1 =
{ height = 13.5 +. 1.0
; color_liquid = "bl" ^ "ue"
; color_lava = "" ^ "green" ^ ""
}
let my_lamp2 = { height = 14.4; color_liquid = my_lamp1.color_liquid; color_lava = "x" }
let a = my_lamp1.height
let b = my_lamp1.color_liquid
let c = my_lamp1.color_lava
let concat_liquid_colors ((lamp1 : lava_lamp), (lamp2 : lava_lamp)) =
lamp1.color_liquid ^ " " ^ lamp2.color_liquid
let epsilon = 0.0001
let same_height (lamp1, lamp2) =
Float.abs (lamp1.height -. lamp2.height) < epsilon
(* variant types *)
(* first a couple very simple ones that are just enumerations of possibilities *)
type si_unit =
| Second
| Meter
| Kilogram
| Ampere
| Kelvin
| Mole
| Candela
let ss = [Second; Meter; Second]
let string_of_si_unit (u : si_unit) : string =
match u with
| Second -> "second"
| Meter -> "meter"
| Kilogram -> "kilogram"
| Ampere -> "ampere"
| Kelvin -> "kelvin"
| Mole -> "mole"
| Candela -> "candela"
let sa = string_of_si_unit Ampere
type si_prefix =
| Giga
| Mega
| Kilo
| Milli
| Micro
| Nano
let scale p =
match p with
| Giga -> 1e9
| Mega -> 1e6
| Kilo -> 1e3
| Milli -> 1e-3
| Micro -> 1e-6
| Nano -> 1e-9
let sg = scale Giga
(* Now variant types where one or more constructors carry [typed] data,
which is much more interesting and powerful
*)
type silly =
| A of int * bool * (string list)
| Foo of string
| Pizza
let silly_over_silly s =
match s with
| A(x,y,z) -> List.hd z
| Foo s2 -> s2 ^ s2
| Pizza -> "ham and pineapple"
type shape =
| Circle of float * float * float (* center-x, center-y, radius *)
| Rectangle of float * float * float * float (* x1,y1,x2,y2 (opposite corners) *)
| Triangle of float * float * float * float * float * float (* x1,y1,x2,y2,x3,y3 *)
let area s =
match s with
| Circle (x,y,radius) -> Float.pi *. radius *. radius
| Rectangle (x1,y1,x2,y2) -> Float.abs ((x2 -. x1) *. (y2 -. y1))
| Triangle (x1,y1,x2,y2,x3,y3) ->
let a = x1 *. (y2 -. y3) in
let b = x2 *. (y3 -. y1) in
let c = x3 *. (y1 -. y2) in
Float.abs ((a +. b +. c) /. 2.0)
let well_formed s =
area s > epsilon
let num_straight_sides s =
(* will soon learn better style than these variable names *)
match s with
| Circle (x,y,r) -> 0
| Rectangle (a,b,c,d) -> 4
| Triangle (x1,x2,x3,x4,x5,x6) -> 3
let max_point s =
let rec highest ps = (* local function assumes non-empty list *)
if List.tl ps = [] then
List.hd ps
else
let tl_ans = highest (List.tl ps) in
if snd tl_ans > snd (List.hd ps) then
tl_ans
else
List.hd ps
in
match s with
| Circle (x,y,radius) -> (x, y +. radius)
| Rectangle (x1,y1,x2,y2) -> highest [(x1,y1);(x2,y2)] (* any pt on top edge ok *)
| Triangle (x1,y1,x2,y2,x3,y3) -> highest [(x1,y1);(x2,y2);(x3,y3)]
(* variants can be recursive, describing recursive data structures like trees *)
type expr =
| Constant of int
| Negate of expr
| Add of expr * expr
| Mul of expr * expr
let rec eval e =
match e with
| Constant i -> i
| Negate e1 -> - (eval e1)
| Add (e1, e2) -> (eval e1) + (eval e2)
| Mul (e1, e2) -> (eval e1) * (eval e2)
let rec max_const (e: expr) : int =
let max (x,y) = if x > y then x else y in
match e with
| Constant i -> i
| Negate e1 -> max_const e1
| Add (e1, e2) -> max (max_const e1, max_const e2)
| Mul (e1, e2) -> max (max_const e1, max_const e2)
let rec has_const_not_under_add e =
match e with
| Constant i -> true
| Negate e1 -> has_const_not_under_add e1
| Add (e1,e2) -> false
| Mul (e1, e2) -> has_const_not_under_add e1 || has_const_not_under_add e2
let rec number_of_adds e =
match e with
| Constant i -> 0
| Negate e1 -> number_of_adds e1
| Add (e1, e2) -> 1 + number_of_adds e1 + number_of_adds e2
| Mul (e1, e2) -> number_of_adds e1 + number_of_adds e2
let example_exp = Add (Constant 19, Negate (Constant 4))
let example_ans = eval example_exp
let example_addcount = number_of_adds (Mul (example_exp,example_exp))
(* CSE 341, Lecture 6 *)
(*#utop_prompt_dummy
let _ = UTop.set_show_box false
*)
(* first example variant type carried over from lecture 5 *)
(* variants can be recursive, describing recursive data structures like trees *)
type expr =
| Constant of int
| Negate of expr
| Add of expr * expr
| Mul of expr * expr
let rec eval e =
match e with
| Constant i -> i
| Negate e1 -> - (eval e1)
| Add (e1, e2) -> (eval e1) + (eval e2)
| Mul (e1, e2) -> (eval e1) * (eval e2)
let rec max_const (e: expr) : int =
let max (x,y) = if x > y then x else y in
match e with
| Constant i -> i
| Negate e1 -> max_const e1
| Add (e1, e2) -> max (max_const e1, max_const e2)
| Mul (e1, e2) -> max (max_const e1, max_const e2)
let rec has_const_not_under_add e =
match e with
| Constant i -> true
| Negate e1 -> has_const_not_under_add e1
| Add (e1,e2) -> false
| Mul (e1, e2) -> has_const_not_under_add e1 || has_const_not_under_add e2
let rec number_of_adds e =
match e with
| Constant i -> 0
| Negate e1 -> number_of_adds e1
| Add (e1, e2) -> 1 + number_of_adds e1 + number_of_adds e2
| Mul (e1, e2) -> number_of_adds e1 + number_of_adds e2
let example_exp = Add (Constant 19, Negate (Constant 4))
let example_ans = eval example_exp
let example_addcount = number_of_adds (Mul (example_exp,example_exp))
(* same features already used can almost define option *)
type int_option = NoInt | OneInt of int
let rec sum_int_options1 xs =
if xs = [] then
0
else
match List.hd xs with
| NoInt -> sum_int_options1 (List.tl xs)
| OneInt i -> i + sum_int_options1 (List.tl xs)
let test1 = sum_int_options1 [NoInt; OneInt 7; NoInt; OneInt 2; OneInt 1]
(* in fact, we /can/ define our own polymorphic variant types *)
type 'a my_option = MyNone | MySome of 'a
let rec sum_int_options2 xs =
if xs = [] then
0
else
match List.hd xs with
| MyNone -> sum_int_options2 (List.tl xs)
| MySome i -> i + sum_int_options2 (List.tl xs)
let test2 = sum_int_options2 [MyNone; MySome 7; MyNone; MySome 2; MySome 1]
(* indeed, the option type constructor is not "built in" at all; just in standard library *)
(* type 'a option = None | Some of 'a *)
(* from now on, use pattern-matching for options *not* the previous
way we showed to use them *)
let rec sum_int_options3 xs =
if xs = [] then
0
else
match List.hd xs with
| None -> sum_int_options3 (List.tl xs)
| Some i -> i + sum_int_options3 (List.tl xs)
let test3 = sum_int_options3 [None; Some 7; None; Some 2; Some 1]
(* similarly, we can define our own polymorphic list type *)
type 'a my_list = Empty | Cons of 'a * ('a my_list)
let rec sum_int_options4 xs =
match xs with
| Empty -> 0
| Cons(x,xs') ->
match x with
| None -> sum_int_options4 xs'
| Some i -> i + sum_int_options4 xs'
let test4 = sum_int_options4 (Cons(None, Cons (Some 7, Cons (None, Cons (Some 2, Cons (Some 1, Empty))))))
(* this is exactly how built-in lists are defined /except/ special syntax [] and ::
* So yes, we can patter-match with those constructors and should no longer use = [],
List.hd, or List.tl (!!)
*)
let rec sum_int_options5 xs =
match xs with
| [] -> 0
| x::xs' ->
match x with
| None -> sum_int_options5 xs'
| Some i -> i + sum_int_options5 xs'
let test5 = sum_int_options5 [None; Some 7; None; Some 2; Some 1]
(* spoiler alert: nested patterns can make this even more concise
we aren't /quite/ there yet, but this is the style we expect on hw2
*)
let rec sum_int_options6 xs =
match xs with
| [] -> 0
| None::xs' -> sum_int_options6 xs'
| (Some i)::xs' -> i + sum_int_options6 xs'
let test6 = sum_int_options6 [None; Some 7; None; Some 2; Some 1]
(* pattern-matching is the normal ML way to use lists; let's revisit prior functions *)
let rec length xs =
match xs with
| [] -> 0
| x::xs' -> 1 + length xs'
let rec append (xs,ys) =
match xs with
| [] -> ys
| x::xs' -> x :: append (xs',ys)
let rec concat ss =
match ss with
| [] -> ""
| s::ss' -> s ^ concat ss'
(* pattern-matching for each-of types (tuples shown; records can also be pattern-matched)*)
(* terrible style never used: one-arm match expressions *)
let sum_triple1 tr =
match tr with
(x,y,z) -> x + y + z
(* appropriate style: let expression syntax is /actually/
let p = e1 in e2 *)
let sum_triple2 tr =
let (x,y,z) = tr in
x+y+z
(* even better when useful: can put a pattern right in the function binding:
let rec f p = e
*)
let sum_triple3 (x,y,z) =
x+y+z
(* in fact, thanks to a convenient fib, that's what we have done since lecture 2 !!! *)
(* and one more nested-patterns spoiler *)
let rec sum_pairs xs =
match xs with
| [] -> 0
| (x,y)::xs' -> x + y + (sum_pairs xs')
(* cute example of expressiveness of functions actually taking one tuple *)
let rotate_left (x,y,z) = (y,z,x)
let rotate_right tr = rotate_left (rotate_left tr)
(* just as never use one-branch match expressions with each-of patterns,
it is also usually bad style to use let expressions with one-of patterns
-- get a warning at compile-time plus a run-time exception if match fails
*)
let get_risky1 opt =
match opt with
| None -> failwith "nopes"
| Some v -> v
let get_risky2 opt =
let Some v = opt in
v
let get_risky3 (Some v) =
v
(* CSE 341, Lecture 7 *)
(*#utop_prompt_dummy
let _ = UTop.set_show_box false
*)
(* two ways NOT to do zip3 *)
let rec meh_zip3_v1 (xs,ys,zs) =
if xs=[] && ys=[] && zs=[] then
[]
else if xs=[] || ys=[] || zs=[] then
failwith "zip3 length mismatch"
else
(List.hd xs, List.hd ys, List.hd zs)
:: meh_zip3_v1 (List.tl xs, List.tl ys, List.tl zs)
let rec meh_zip3_v2 (xs,ys,zs) = (* like life without && and || *)
match xs with
| [] -> (match ys with
| [] -> (match zs with
| [] -> []
| _ -> failwith "zip3 length mismatch")
| _ -> failwith "zip3 lenght mismatch")
| x::xs' -> (match ys with
| [] -> failwith "zip3 length mismatch"
| y::ys' -> (match zs with
| [] -> failwith "zip3 length mismatch"
| z::zs' -> (x,y,z)::meh_zip3_v2(xs',ys',zs')))
(* nested patterns give you "and" by matching the entire pattern,
along with nested data extraction *)
let rec zip3 list_triple =
match list_triple with
| ([],[],[]) -> []
| (x::xs',y::ys',z::zs') -> (x,y,z) :: zip3 (xs',ys',zs')
| _ -> failwith "zip3 length mismatch"
(* the inverse function is also elegant *)
let rec unzip3 xyzs =
match xyzs with
| [] -> ([],[],[])
| (x,y,z)::xyzs' -> let (xs,ys,zs) = unzip3 xyzs' in
(x::xs,y::ys,z::zs)
(* a couple more examples with lists *)
let rec is_sorted xs =
match xs with
| [] -> true
| x::[] -> true
| head :: (neck :: rest) -> head <= neck && is_sorted (neck :: rest)
let rec cumulative_sum xs =
match xs with
| [] -> xs
| x::[] -> xs
| head :: (neck :: rest) -> head :: cumulative_sum ((head+neck)::rest)
type sign = P | N | Z
let multsign (x1,x2) =
let sign_of_num x = if x=0 then Z else if x > 0 then P else N in
match (sign_of_num x1, sign_of_num x2) with
| (Z,_) -> Z
| (_,Z) -> Z
| (P,P) -> P
| (N,N) -> P
| _ -> N (* questionable style; we are okay with it*)
let rec length xs =
match xs with
| [] -> 0
| _::xs -> 1 + length xs
let rec sum_pair_list xs =
match xs with
| [] -> 0
| (x,y)::xs' -> x + y + sum_pair_list xs'
(* tail recursion *)
let rec fact1 n = if n=0 then 1 else n * fact1 (n-1)
let rec last xs =
match xs with
| [] -> failwith "last: empty list"
| x::[] -> x
| _::xs' -> last xs'
let fact2 n =
let rec loop (n,acc) = if n=0 then acc else loop (n-1,acc*n) in
loop (n,1)
let rec sum1 xs =
match xs with
| [] -> 0
| i::xs' -> i + sum1 xs'
let sum2 xs =
let rec f (xs,acc) =
match xs with
| [] -> acc
| i::xs' -> f(xs',i+acc) in
f(xs,0)
let rec rev1 xs =
match xs with
| [] -> []
| x::xs' -> (rev1 xs') @ [x]
let rev2 xs =
let rec loop (xs,acc) =
match xs with
| [] -> acc
| x::xs' -> loop (xs', x::acc) in
loop (xs,[])
(* exceptions *)
exception MyUndesirableCondition
exception MyOtherException of int * int
let oh_no () =
raise MyUndesirableCondition
let oh_no_with_info () =
raise (MyOtherException (7, 42))
let catch_example () =
try oh_no ()
with MyUndesirableCondition -> 0
let catch_example_with_info () =
try oh_no_with_info ()
with MyOtherException (x, y) -> x + y
let boo () =
try oh_no ()
with MyOtherException (x, y) -> x + y
let hd xs =
match xs with
| [] -> raise MyUndesirableCondition
| x::_ -> x
let foo1 = hd [3;4;5]
(*let foo2 = hd []*)
let bar1 = try Some (hd [3;4;5]) with MyUndesirableCondition -> None
let bar2 = try Some (hd []) with MyUndesirableCondition -> None
let rec maxlist (xs,ex) = (* int list * exn -> int *)
match xs with
| [] -> raise ex
| x::[] -> x
| x::xs' -> let m = maxlist(xs',ex) in if x > m then x else m
let m1 = maxlist ([3;4;5],MyUndesirableCondition)
let m2 = try maxlist ([3;4;5],MyUndesirableCondition) with
MyUndesirableCondition -> 42
(*let m3 = maxlist ([],MyUndesirableCondition)*)
let m4 = try maxlist ([],MyUndesirableCondition) with
MyUndesirableCondition -> 42
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment