Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Logan Ince
cse34122wipublic
Commits
35586d56
Commit
35586d56
authored
Jan 08, 2022
by
Dan Grossman
Browse files
import unit 2 lecture code from 21au
parent
8dc4210b
Changes
3
Hide whitespace changes
Inline
Sidebyside
lecture/lec05/lec05.ml
0 → 100755
View file @
35586d56
(* CSE 341, Lecture 5 *)
(*#utop_prompt_dummy
let _ = UTop.set_show_box false
*)
(* records *)
(* records have the same "expressive power" as tuples, just with
* userdefined 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
>
1e3

Micro
>
1e6

Nano
>
1e9
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
(* centerx, centery, 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 nonempty 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
))
lecture/lec06/lec06.ml
0 → 100755
View file @
35586d56
(* 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 patternmatching 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 builtin lists are defined /except/ special syntax [] and ::
* So yes, we can pattermatch 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
]
(* patternmatching 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'
(* patternmatching for eachof types (tuples shown; records can also be patternmatched)*)
(* terrible style never used: onearm 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 nestedpatterns 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 onebranch match expressions with eachof patterns,
it is also usually bad style to use let expressions with oneof patterns
 get a warning at compiletime plus a runtime 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
lecture/lec07/lec07.ml
0 → 100755
View file @
35586d56
(* 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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment