// 2018 3
(*
Running on windows / linux is not easy.
This thing needs stеps before it can execute any code.
Sequence windows:
1) get visual studio, basics only, f# might include c# because
f# is built on that (~2 Gb)
2) get visual studion code (~50 Mb)
3) in vs code, on left, bottom icon "Extensions" search for ionide,
install ionide f#
-) ctrl + shift + p = search in vs code
-) ctrl + shift + p -> type "fsi start" = open f# terminal
-) alt + enter = run selected code in f# terminal / interactive
-) nuget for FsLexYacc, lexing and parsing arbitrary languages
*)
questions
- printfn "%d %A %i%%", where is a complete list with each meaning?
%i is number, %f float, %A not string not float not byte (set map function some something),
%s string, %c char, %x? bytes
- cashregister adesc != (tuple1,tuple) != string, wtf? still works?
- difference match and function and (fun x y z -> ??? ref)
- bat file ubuntu sh
// 2017 12 exa _____________________________________
// 3
let rec f g = function
| (x::xs,y::ys) -> g x y || f g (x::xs,ys) || f g (xs,y::ys)
| _ -> false
let h z = f (>) z;;
let g = (fun x -> x)
//f g ([1],[1]);;
// 4
(*
1. 4 values of type K:
1) M (L, "a"*[1], L)
2) M ((L, ("b",[1;2]) ,L), ("a",[1]), L)
3) M (L, "a"*[1], (L, ("c",[2;3]) ,L))
4) M ((L, ("b",[1;2]) ,L), "a"*[1], (L, ("c",[2;3]) ,L)
2. c outputs a list of tuples / integers / strings / boolean values
3. c computes a list representation of a tree
*)
// end 2017 12 exa _____________________________________
// 2011 fall exa ______________________________________
(* Problem 1 (Approx. 30%)
In this problem we will onsider a simple register for memb ers of a sp orts lub. It ould
b e a tennis lub, a ?shing lub, or ... . To keep the problem simple we identify memb ers
by their names and ea h memb er is des rib ed by a phone number and a level, where the
level is an indi ation of how well the memb er is p erforming in this sp ort. Phone numb ers
and levels are mo delled by integers and we arrive at the following de larations: *)
type name = string;; type phone = int;; type level = int;;
type description = phone * level;;
type register = (name * description) list;;
(* 1. Declare a value of typce register, that contains four members: Joe (having phone
number: 10101010 and level: 4) , Sal (having phone numb er: 11111111 and level: 2),
Sam (having phone numb er: 12121212 and level: 7), Jane (having phone numb er:
13131313 and level: 1). *)
let r1:register = [("Joe",(101010110,4));("Sal",(11111111,2));
("Sam",(12121212,7));("Jane",(13131313,1))];;
(* 2. Declare a function getPhone: name -> register -> phone to extract the phone
number of a member in a register. The function should raise an exception Register
if the member is not occurring in the register. *)
let rec getPhone name reg:register = match name,reg with
| _,[] -> "Register"
| nm,[(name,(ph,_))::tl] when nm=name -> string ph + ", " + (getPhone nm tl);;
let rec getPhone nm = function
| (ac',(ph,_))::_ when nm=ac' -> string ph
| _::reg -> getPhone nm reg
| _ -> failwith(nm + " is an unknown name");;
getPhone "Joe" r1;;
(* 3. Declare a function delete: name * register -> register to delete the entry for
a member in a register. *)
let rec delete nm reg = match nm,reg with
| _,[] -> []
| nm,[(nam,_)::tl] when nm=nam -> delete nm tl
| nm,[(nam,a)::tl] when nm<>nam -> (nam,a)@(delete nm tl);;
(* 4. We say that two levels l and l′ match if one is bigger than the other by at most 2, i.e.
if |l − l′| < 3 .
Declare a function getCandidates: level -> register -> (name*phone) list,
that for a given level l and register reg gives the name and phone number of all
members of reg with a level matching l . In the example from question 1, Joe and
Sam have levels matching level 5. *)
(* Problem 2 (Approx. 30%)
In this problem we consider simple expressions, like 3 + 5 ∗ 2 , which can be constructed
from integer constants using binary operators. Such expressions are modelled using the
following declaration of the type exp*)
type exp = | C of int
| BinOp of exp * string * exp
(* where the constructor C generates an integer constant and the operator is given as a string
(e.g. "+" and "*") when generating an expression using the construtor BinOp.
1. Give three different values of type exp. *)
let exp1 = C 5;; let exp2 = BinOp (C 5,"*",C 5);; let exp3 = BinOp (C 5,"+",C 5);;
(* 2. Declare a function toString: exp -> string, that gives a string representation
for an expression. Put brackets around every sub expression with operators, e.g.
(3+(5*2)) is a string representation of the above example.*)
let rec toString exp = match exp with
| C n -> string n
| BinOp (e1,op,e2) -> "(" + toString e1 + op + toString e2 + ")"
toString (BinOp(C 5,"+",BinOp(C 5,"*",C 5)))
// 3. Declare a function to extract the set of operators from an expression.
let rec ops exp = match exp with
| C n -> Set.empty //set [] // 2 options
| BinOp (e1,op,e2) -> Set.union (ops e1) (Set.add op (ops e2));;
ops (BinOp(C 5,"+",BinOp(C 5,"*",C 5)))
(* 4. The type for expressions is now extended to include identifiers (constructor Id) and
local defnitions (constructor Def) *)
type exp =
| C of int
| BinOp of exp * string * exp
| Id of string
| Def of string * exp * exp;;
(* where Def("x", C 5 , BinOp(Id "x", "+", Id "x")), for example, denotes the
expression where x is defned by the onstant 5 in the expression x+x . This expression
would evaluate to 10. I. e. (x = 5, x + x) = 5+5 = 10
We say that an expression is defned if it evaluates to an integer value, i.e. if there is a
defnition for every identifer ocurring in the expression. We have, for example, that
Def("x", C 5, BinOp(Id "x", "+", Id "x")) is defned, whereas the expression
Def("x", C 5, BinOp(Id "y", "+", Id "x")) is not defned since there is no def-
inition for "y".
Declare a function isDef: exp -> bool that can test whether an expression is defined.
Hint: make use of an auxiliary function having an extra argument that takes care of
defined identifiers *)
let rec isDefAux ids = function
| C n -> true
| (BinOp (e1,op,e2)) -> isDefAux ids e1 && isDefAux ids e2
| (Id x) -> Set.contains x ids
| Def (x,e1,e2) -> isDefAux ids e1 && isDefAux (Set.add x ids) e2
let isDef exp = isDefAux (set []) exp;;
let v4 = Def("x", C 5, BinOp(Id "x", "+", Id "x"));; isDef v4;;
let v5 = Def("x", C 5, BinOp(Id "y", "+", Id "x"));; isDef v5;;
(* Version 2:
An occurrence of an identifier x in an expression e is said to be bound if
e contains a (sub-) expression Def(y, e1, e2) and the occurrence of
x is either y or the occurrence of x is in e2
An identifier x is said to be free in e if e contains an occurrence of x that is not bound
For example, v4 contains 3 bound occurrences of "x" and no idetifier is free in v4.
v5 contains 2 bound occurrencies of "x". Furthermore, "y" is free in v5.
Consider the expression Def("x", Id "x", Id "x"). The first and
the third occurrence of "x" are bound,
whereas the second occurrence is not bound. That is, "x" is free in this expression.
The set of free identifiers are computed as follows:
free: Exp -> Set *)
let rec free = function
| C _ -> set []
| BinOp(e1,_,e2) -> Set.union (free e1) (free e2)
| Id x -> set [x]
| Def(x,e1,e2) -> Set.union (free e1) (Set.remove x (free e2));;
// An expression is well defined if it contains no free idetifier
let isDef2 e = free e = set [];; isDef2 v4;; isDef2 v5;;
(* Problem 3 (20%)
Consider the following F# de larations: *)
type 'a tree =
| Lf
| Br of 'a * 'a tree * 'a tree;;
let rec f(n,t) = match t with
| Lf -> Lf
| Br(a, t1, t2) -> if n>0 then Br(a, f(n-1, t1), f(n-1, t2))
else Lf;;
let rec g p = function
| Br(a, t1, t2) when p a -> Br(a, g p t1, g p t2)
| _ -> Lf;;
let rec h k = function
| Lf -> Lf
| Br(a, t1, t2) -> Br(k a, h k t1, h k t2);;
(* 1. Give the types of f, g and h, and describe what each of these three functions compute.
Your description for each function should focus on what it computes, rather than on
individual computation steps.
f computes a tree of depth n. (n should be a positive integer) If tree is deeper
than n, branches at depth n are turned into leaves.
type: val f: n:int * t: 'a tree -> 'a tree
g shows (in order from tree root to its leaves) only those branches that satisfy
a boolean function p. If a branch doesn't satisfy p, it is turned into a leaf.
type: val g: p:('a -> bool) -> arg1: 'a tree -> 'a tree
h is similar to map on lists.
It 'maps' (modifies) all branch values of a given tree.
type: val h: k:('a -> 'a) -> arg1: 'a tree -> 'a tree *)
(* Problem 4 (Approx. 20%)
Consider the following F# declarations: *)
let rec map f = function
| [] -> [] // m1
| x::xs -> f x :: map f xs;; // m2
let rec rev = function
| [] -> [] // r1
| x::xs -> rev xs @ [x];; // r2
(* Prove that
rev (map f xs) = map f (rev xs)
holds for all functions f and lists xs of appropriate types.
In your proof you an assume that
map f (xs @ ys) = (map f xs) @ (map f ys)
holds for all fun tions f and lists xs and ys of appropriate typ es *)
(* map f xs performs a function on each element of input list xs. rev xs
reverses input list xs. map doesn't change order of elements in list.
So it doesn't matter whether a list is first changed by map or rev.
(map and rev attend to different properties of lists. map modifies each
element, rev modifies element order.) *)
// end 2011 fall exa ______________________________________
// 47 / 11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11
// proj 4 , Problem 4 from the exam Fall 2014
(* A sample space is the set of all outcomes of an experiment. If the experiment is ‘toss a
coin’, the sample space consists of two samples: ‘head’ (Danish ‘krone’) or ‘tail’ (Danish:
‘plat’). The probability of each outcome is 1/2 if a fair coin is used. This is illustrated in
the left probability tree of Fig. 1, which also contains annotations such as “head?”, “head:
you win” and “tail: you lose”. When an experiment is given by a sequential process, such
illustration - Figure 1: Two probability trees
as tossing a coin three times, a sample is a list where the elements describe the outcome
at each stage of the process. If a coin is tossed three times, a list comprising ‘tail’, ‘head’
and ‘tail’ is one sample and the sample space has 8 elements.
We shall consider a simple form of probability trees to represent sample spaces of sequential
processes, where the outcomes at each stage in the process is either success or failure. The
left tree in Fig. 1 is such a tree when we consider ‘head’ as success and ‘tail’ as failure. The
right tree in the figure is a probability tree for a process where a dice (Danish: ‘terning’) is
rolled twice. The first roll is successful when more than 2 pips (Danish: ‘øjne’) are facing
up (with probability 2/3) and the second roll is successful when more than 3 pips are facing
up (with probability 1/2). We shall use the following F# types to model this: *)
type Outcome = | S | F // S: for success and F: for failure
type Sample = Outcome list
type ProbTree = | Branch of string * float * ProbTree * ProbTree
| Leaf of string
(* The F# representation of the right tree in Fig. 1 (where 2/3 is approximated by 0.67) is: *)
let exp = Branch(">2",0.67, Branch(">3",0.5, Leaf "A", Leaf "B")
, Branch(">3",0.5, Leaf "C", Leaf "D"))
(* For a branch Branch(ds,p,tl,tr), the string ds describes a successful stage of an experiment,
the float value p is the probability for a successful outcome leading to the left subtree tl.
Therefore, 1.0 − p is the probability for a failing outcome leading to the right subtree tr.
Notice that the successful branches are the upper branches in Fig. 1.*)
(* 1. Declare a function probOK: ProbTree -> bool that is true iff every probability p oc-
curring in a probability tree satisfies: 0 ≤ p ≤ 1. *)
let rec namesFs0 = function // function to cr8 a set of names
| Leaf l -> true
| Branch(a) -> probOK0 a
and probOK0 = function //
| Branch(_,p,t1,t2) -> (0>=p>=1) && (namesFs0 t1) && (namesFs0 t2);;
let probOK n r = Set.contains n (probOK0 r);; // checker if name in set
(* A list of outcomes os is a correct sample for a given probability tree t, if traversing t as os
describes leads to a leaf. For example, if F is the head of os then the right subtree tr of a
branch Branch(ds,p,tl,tr) is chosen for further traversal using the tail of os. The list of
outcomes [F;S] is a correct sample for the right subtree in Fig. 1 because it leads to the
leaf with annotation "C". Any correct sample for this tree has length 2. *)
(* 2. Declare a function isSample(os,t) that is true iff os is a correct sample given t. Fur-
thermore, state the type of isSample. *)
(* The description of a correct sample os = [o1 ;...;on ] for a probability tree t is a tuple
([(o 1 ,ds 1 );...;(o n ,ds n )],p,s) where ds i is the string in a branch node Branch(ds i ,p i ,tl i ,tr i )
describing stage i in the experiment according to os, p is the probability of the sample
(described below), and s is the string in the leaf node reached by os. The probability p of
the sample os is the product p'1 · p'2 · ··· · p'n , where p'i is the probability of outcome o i of
os, that is, pi if oi = S and 1.0 − pi if oi = F. For example, the description of the sample
[F;S] for the probability tree exp is
([(F,">2");(S,">3")], 0.165, "C"), because 0.165 = (1.0 − 0.67) · 0.5. *)
(* 3. Declare a type Description for descriptions and a function descriptionOfost that
gives the description of the sample os for the probability tree t. The function should
raise an exception if os is not a correct sample *)
(* 4. Declare a function allDescriptions: PropTree -> Setthat computes
the set of all descriptions for a probability tree. The set of all descriptions for exp, for
example, has the following 4 elements:
([(S,">2");(S,">3")], 0.335, "A"), ([(S,">2");(F,">3")], 0.335, "B"),
([(F,">2");(S,">3")], 0.165, "C") and ([(F,">2");(F,">3")], 0.165, "D") *)
(* Let pred : string -> bool be a predicate on strings and t a probability tree. The proba-
bility of samples leading to leaves of t whose strings satisfy pred is the sum of the proba-
bilities of these samples. For example, the probability of samples for exp leading to leaves
annotated with either "B" or "C" is 0.335 + 0.165 = 0.5. *)
(* 5. Declare a function probabilityOf: PropTree -> (string->bool) -> float, so that
probabilityOftpred is the probability of reaching leaves Leafs where preds is true. *)
(* 6. Show how probabilityOf can be used to calculate the probability of samples for exp
leading to leaves annotated with either "B" or "C". *)
// end 47 / 11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11-11
// 99999999999999999999999999999999999999999999999
(*continuation, accumulating parameter, tail-recursion
purpose - reduce space use, finish all operations before recursing
this way all variables get updated and passed to next recursion / loop
basic recursion, non-tail-recursion builds large expressions
that get evaluated after all recusions are complete *)
let rec naiveRev = function
| [] -> []
| x::xs -> naiveRev xs @ [x];;
let rec fact = function
| 0 -> 1
| n -> n * fact(n-1);;
let rec factA = function
| (0,m) -> m
| (n,m) -> factA(n-1,n * m);;
let xs16 = List.init 1000000 (fun i -> 106);;
#time;;
for i in xs16 do let _ = fact i in ();;
for i in xs16 do let _ = factA(i,1) in ();;
for i in xs16 do let _ = () in ();;
#time;;
// end 9999999999999999999999999999999999999999999
//44 / 8888888888888888888888888888888888888888888888888888888888
// proj 3 , Problem 3 from the exam Fall 2015
(* We consider rivers, where a river has a name, a source contributing with an average stream
flow rate (in Danish: ‘middelvandføring’) and a list of tributaries (in Danish: ‘bifloder’).
A tributary is itself a river. We assume that names are unique for a river and will use the
phrase ‘the river n’ to mean ‘the river with name n’. Consider a simple example (where
average stream flow rate is abbreviated to flow):
• A river named “R” has flow 10m3 /s from its source and it has three tributaries named
“R1”, “R2” and “R3”, respectively.
• The river “R1” has flow 5m3 /s from its source and no tributaries.
• The river “R2” has flow 15m3 /s from its source and one tributary named "R4".
• The river “R3” has flow 8m3 /s from its source and no tributaries.
• The river “R4” has flow 2m3 /s from its source and no tributaries.
The following F# types are used to model rivers with tributaries by trees:*)
type Name = string;;
type Flow = int // can be assumed positive in below questions
type Tri = River list
and River = | R of (Name*Flow*Tri);;
(* 1. Declare F# values riv and riv3 corresponding to the rivers “R” and “R3”. *)
let riv3 = R("R3",8,[]);;
let riv = R("R",10,[R("R1",5,[]);
R("R2",15,[R("R4",2,[])]);
R("R3",8,[])]);;
(* 2. Declare a function contains : Name → River → bool. The value of contains n r is true
if and only if the name of r is n, or n is the name of a tributary occurring somewhere in
r. For example, "R", "R1", "R2", "R3" and "R4" constitute all names contained in riv. *)
let rec namesFs0 = function // function to cr8 a set of names
| [] -> Set.empty
| e::es -> Set.union (contains0 e) (namesFs0 es)
and contains0 = function //
| R(name,_,riv) -> Set.union (set [name]) (namesFs0 riv);;
let contains n r = Set.contains n (contains0 r);; // checker if name in set
contains0 riv;; // test
contains "R" riv;; // test
(* 3. Declare a function allNames r which returns a list with all names contained in the river
r. The order in which names occur in the list is of no significance. *)
let rec namesFs0 = function // function to cr8 a set of names
| [] -> Set.empty
| e::es -> Set.union (contains0 e) (namesFs0 es)
and contains0 = function //
| R(name,_,riv) -> Set.union (set [name]) (namesFs0 riv);;
let allNames r = Set.toList (contains0 r);; // conversion to list
allNames riv;; // test
(* 4. Declare a function totalFlow r which returns the total flow in the river mouth (in
Danish ‘udmunding’) of r, by adding the flow from the source of r to the total flows of
r’s tributaries. For example totalFlow riv = 40. *)
let rec namesFs0 = function //
| [] -> 0
| e::es -> (totalFlow e) + (namesFs0 es)
and totalFlow = function //
| R(_,Flow,riv) -> Flow+(namesFs0 riv);;
totalFlow riv;;
(* 5. Declare a function mainSource : River → (Name ∗ Flow). If (n,fl) = mainSource r,
then fl is the biggest flow of some source occurring in the river r and n is the name of
a river having this “biggest” source. For example, mainSource riv = ("R2",15) and
mainSource riv3 = ("R3",8). *)
let rec namesFs5 = function // function to cr8 a set of tuples with flow values and names
| [] -> Set.empty
| e::es -> Set.union (contains5 e) (namesFs5 es)
and contains5 = function //
| R(Name,Flow,riv) -> Set.union (set [(Flow,Name)]) (namesFs5 riv);;
// bit complex, taking max from flow list, swapping tuple elements
let swap (x,y) = (y,x);; let mainSource r = swap (Set.maxElement(contains5 r));;
mainSource riv;; //test
(* 6. Declare a function tryInsert : Name → River → River → River option. The value
of tryInsert n t r is Some r' if n is the name of a river in r and r' is obtained from r
by adding t as a tributary of n. The value of tryInsert n t r is None if n is not a name
occurring in r. *)
let t3 = R("T3",7,[]);;
contains n r;; // test
let tryInsert n t = function
| contains n r=true ->
| contains n r=false -> "None"
(* 7. Discuss briefly possible limitations of the above tree-based model of rivers. *)
(* If rivers split and unite again. Trees don't support that. *)
(* Feedback
1. Correct.
2. Correct.
3. Correct.
4. Correct.
5. Correct.
Working with lists you can use List.maxBy and pass snd as the function, not requiring any swapping.
6. Incorrect.
This exercise is done easiest with an auxiliary function to do the insertion as follows:
let rec insert n t = function
| R(n',f,ts) when n=n' -> R(n',f, t::ts)
| R(n',f,ts) -> R(n',f, List.map (insert n t) ts)
let tryInsert n t r = if contains n r then Some(insert n t r) else None
7. Correct.
Overall a good assignment, however try not to overcomplicate your solutions. It makes sense to define mutually recursive functions given the mutually recursive type, although these exercises can be solved quite easily (if not easier) without. Consider that all exercises can be solved matching two cases, e.g.
let rec mainSource = function
| R(n,fl,[]) -> (n,fl)
| R(n,fl,ts) -> List.maxBy snd ((n,fl)::List.map mainSource ts)
Alternatively, all exercises can be solved using List.fold once, and I would recommend that you try to rewrite some of your solutions using high-order libary functions as an exercise.
Approved, 15.11.17
Best regards, Helge *)
// end 44 / 8888888888888888888888888888888888888888888888888888888888
// 43 / 77777777777777777777777777777777777777777777777777777777777
// file system
type FileSys = Element list
and Element = | File of (string*string)
| Dir of string*FileSys;;
let d1 = Dir("d1",[File("a1","java");
Dir("d2", [File("a2","fsx");
Dir("d3", [File("a3","fs")])]);
File("a4","fsx");
Dir("d3", [File("a5","pdf")])]);;
let rec namesFileSys = function // name func
| [] -> []
| e::es -> (namesElement e) @ (namesFileSys es)
and namesElement = function
| File (s1,s2) -> [s1+"."+s2]
| Dir(s,fs) -> s :: (namesFileSys fs);;
namesElement d1;;
let rec searchFileSys format = function // search func
| [] -> Set.empty // consistent output
| e::es -> Set.union (searchElement format e) (searchFileSys format es) // unify sets
and searchElement format = function
| File (s1,s2) when s2 = format -> set [s1]
| File (s1,s2) -> Set.empty // no find statement
| Dir (_,s2) -> searchFileSys format s2;; // if dir go up in tree
searchElement "fsx" d1;;
let rec longNamesFileSys = function
| [] -> Set.empty
| e::es -> Set.union (longNamesElement e) (longNamesFileSys es)
and longNamesElement = function
| File (s1,s2) -> set [s1+"."+s2]
| Dir(s,fs) -> Set.map (fun n -> s+"\\"+n) (longNamesFileSys fs);; //element wise function
longNamesElement d1;;
//Differentiation and comprehensive output
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 D = function
| Const _ -> Const 0.0
| X -> Const 1.0
| Add(fe,ge) -> Add(D fe, D ge)
| Sub(fe,ge) -> Sub(D fe, D ge)
| Mul(fe,ge) -> Add(Mul(D fe, ge), Mul(fe, D ge))
| Div(fe,ge) -> Div(Sub(Mul(D fe,ge), Mul(fe,D ge)), Mul(ge,ge))
| Sin fe -> Mul(Cos fe, D fe)
| Cos fe -> Mul(Const -1.0, Mul(Sin fe, D fe))
| Log fe -> Div(D fe, fe)
| Exp fe -> Mul(Exp fe, D fe);;
D(Sin(Mul(X, X)));; D(Mul(Const 3.0, Exp X));;
let rec toString = function
| Const x -> string x
| X -> "x"
| Add(fe1,fe2) -> "(" + (toString fe1) + ")"
+ " + " + "(" + (toString fe2) + ")"
| Sub(fe1,fe2) -> "(" + (toString fe1) + ")"
+ " - " + "(" + (toString fe2) + ")"
| Mul(fe1,fe2) -> "(" + (toString fe1) + ")"
+ " * " + "(" + (toString fe2) + ")"
| Div(fe1,fe2) -> "(" + (toString fe1) + ")"
+ " / " + "(" + (toString fe2) + ")"
| Sin fe -> "sin(" + (toString fe) + ")"
| Cos fe -> "cos(" + (toString fe) + ")"
| Log fe -> "log(" + (toString fe) + ")"
| Exp fe -> "exp(" + (toString fe) + ")";;
toString(Mul(Cos(Mul(X, X)),
Add(Mul(Const 1.0, X), Mul(X, Const 1.0))));;
// end 43 / 77777777777777777777777777777777777777777777777777777777777
// 41 / 66666666666666666666666666666666666666666666666666666666666
// proj 2
// GL and ME merged
(* The focus of this problem is on courses and curricula at DTU. A course is uniquely identified
by a course number and a course is described by a title and a number of ECTS point. The
course base is a map from course numbers to course descriptions. *)
type CourseNo = int;; type Title = string;; type ECTS = int;; //type declarations
type CourseDesc = Title * ECTS;; type CourseBase = Map;;
(* We require in this problem that valid ECTS points are positive integers that are divisible
by 5, that is, 5, 10, 15, 20, ... is the sequence of valid ECTS points. *)
(* 1. Declare a function isValidCourseDesc: CourseDesc -> bool,
where isValidCourseDesc desc is true if the ECTS part of desc is valid.*)
(* let CourseDesc = Map.ofList [("a1",25); ("a2",4); ("a3",5)];;
// modulo function to set fitting ects values to zero
let CourseDesc0 CourseDesc = Map.map (fun _ ects -> ects % 5) CourseDesc;;
// checker if all values are zero
let isValidCourseDesc CourseDesc = Map.forall (fun _ ects -> ects = 0) (CourseDesc0 CourseDesc);; *)
let isValidCourseDesc (title,ects) = (ects % 5 = 0) && ects>0
let CourseDesc = ("a1",4);;
// call function
isValidCourseDesc CourseDesc;; isValidCourseDesc ("a",-5)
(* 2. Declare a function isValidCourseBase: CourseBase -> bool,
where isValidCourseBase cb is true if every course description occurring the course
base cb is valid, that is, it satisfies the predicate isValidCourseDesc. *)
(* - no wildcard operator _ on RHS of (fun ... -> ...), therefore used a instead in 2nd try
- 3 ways to do fun below, 3rd way really hard to read and comprehend, though shortest*)
//let isValidCourseBase cb = Map.forall (fun _ (_,ects) -> ects % 5 = 0 && ects > 0) cb
let isValidCourseBase cb = Map.forall (fun _ (a,ects) -> isValidCourseDesc (a,ects)) cb
//let isValidCourseBase cb = Map.forall (fun _ cd -> isValidCourseDesc cd) cb
let CourseBase = Map.ofList [(12,("cheese",20));(13,("herring",5));(14,("soft drink",5));
(17,("herring",50))]
isValidCourseBase CourseBase;;
(* We shall from now on assume that course descriptions and course bases are valid.
The educations of DTU are organized so that students are required to earn a number
of ECTS points within certain course groups. For the BSc programmes, technological
core courses constitutes one such course group. Course
groups are organized into a mandatory part and a optional part. Students following a
certain programme must take all courses belonging to the mandatory part, and some of
courses in the optional part. For the bachelor programme in Software Technology,
the courses 02131 Embedded Systems and 02141 Computer Science Modelling are among
mandatory technological core courses, while 02157 Functional programming and 02158
Parallel programming are among optional courses. This is described by the following
type declarations, where mandatory and optional courses are represented by sets
of course numbers: *)
type Mandatory = Set;; type Optional = Set;;
type CourseGroup = Mandatory * Optional;;
(* 3. Declare a function disjoint: Set<’a> -> Set<’a> -> bool, where disjoint s1 s2
is true if the two sets s1 and s2 have no common element, that is, they are disjoint.*)
let disjoint s1 s2 = Set.intersect s1 s2 = set [];;
let s1 = Set.ofList [1..5];; let s2 = Set.ofList [3..5];; let s3 = Set.ofList [6..9];;
let test3a1 = Set.ofList [(12,("cheese",20));(13,("herring",5));(14,("soft drink",5));
(17,("herring",50))]
let test3a2 = Set.ofList [(12,("cheese",21));(131,("herring",5))]
// test, odd that it works for 1st elements of test3a1
disjoint s1 s2;; disjoint s1 s3;; disjoint test3a1 test3a2;;
(* 4. Declare a function sumECTS: Set -> CourseBase -> int,
where sumECTS cs cb is the sum of all ECTS points of the courses with numbers in cs,
where the ECTS points are extracted from course descriptions in the course base cb. *)
// rewrite input variables
let CourseBase = Map.ofList [(0,("a1",25)); (1,("a2",4)); (2,("a3",5))];; let s4 = set [1;2;5];;
type Cnter = Set
let Cnter = Set.empty
// compares every cs element with 1 entry in cb (tuple)
let rec sumECTS0 (cs:list) cb = match (cs,cb) with
| ([],_) -> 0
| (head::tail, (CourseNo,(nm,ects))) ->
if head = CourseNo then (*(Set.add head Cnter) ,*) (ects + sumECTS0 tail (CourseNo,(nm,ects)))
else sumECTS0 tail (CourseNo,(nm,ects));;
(*//trying to get a list of course codes from cb
let rec listCB cb = match cb with
| [] -> []
| (hd,(_,_))::tl -> hd@(listCB tl);;
listCB (Map.toList CourseBase) *)
// iterates sumECTS0 through all tuples of CourseBase, don't know how implement
// stop of iteration if cs is depleted
let rec sumECTS1 cs cb = match (cs,cb) with
| (_,[]) -> 0
| (hdcs::tlcs,hdcb::tlcb) ->
sumECTS0 cs hdcb + sumECTS1 cs tlcb;;
// final function, converts CourseBase map and cs set into lists
// then runs those lists through sumECTS1 (and sumECTS0)
let sumECTS cs cb = sumECTS1 (Set.toList cs) (Map.toList cb);;
// test
sumECTS s4 CourseBase;;
let test4a1 = Set.ofList [12;14;17];; let test4a3 = Set.ofList [11;18;19];;
let test4a2 = Map.ofList [(12,("cheese",20));(13,("herring",5));(14,("soft drink",5));(17,("herring",50))]
sumECTS test4a1 test4a2;; sumECTS test4a1 Map.empty;; sumECTS test4a3 test4a2;;
(* 5. A course group (man,opt) for a bachelor programme is valid for a given course base cb
if:
• man and opt are disjoint,
• the sum of all mandatory ECTS points (i.e. the ECTS sum for all courses in man)
is less than or equal to 45,
• the set of optional courses opt is empty when the mandatory ECTS points add up
to 45, and
• the total number of ECTS points of mandatory and optional courses should be at
least 45.
Declare a function isValidCourseGroup: CourseGroup -> CourseBase -> bool that
can check whether a course group is valid for a given course base. *)
// input some earlier defined functions
let rec forall p = function
| [] -> true
| x::xs -> p x && forall p xs;;
let CourseGroup = (Set.ofList [1;2],Set.ofList [3;4]);; // updating variables for testing
let CourseBase = Map.ofList [(1,("a1",10)); (2,("a2",15)); (3,("a3",10)); (4,("a4",10))];;
let isValidCourseGroup (man,opt) cb =
if (sumECTS man cb) = 45 then opt=Set.empty
else (disjoint man opt) && ((sumECTS man cb) <= 45) &&
((sumECTS man cb) + (sumECTS opt cb) >= 45);;
isValidCourseGroup CourseGroup CourseBase;; // test
let test5a1 = (Set.ofList [12;14;17], Set.ofList [21;20]);;
let test5a2 = Map.ofList [(12,("c",20));(13,("h",5));(14,("s",5));(17,("he",20))];;
isValidCourseGroup test5a1 test5a2;;
(* The bachelor programmes are organized according to the flag model, with three course
groups for basic natural science courses, technological core courses and project and profes-
sional skills courses, respectively.
The group of elective courses form the fourth component of the flag model. This group is
described by a predicate on course numbers, characterizing the courses the study leader
has accepted as suitable elective courses. Furthermore, a course plan is given by a set of
course numbers: *)
type BasicNaturalScience = CourseGroup;; type TechnologicalCore = CourseGroup;;
type ProjectProfessionalSkill = CourseGroup;; type Elective = CourseNo -> bool;;
type FlagModel = BasicNaturalScience * TechnologicalCore * ProjectProfessionalSkill * Elective;;
type CoursePlan = Set;;
(* A flag model (bns,tc,pps,ep) is valid if
• the three course groups bns, tc and pps are all valid,
• no course belongs to more than one of the course groups bns, tc and pps, and
• any course belonging to a course group bns, tc or pps must qualify as an elective
course, that is, it must satisfy the predicate ep. *)
(* 6. Declare a function isValid: FlagModel -> CourseBase -> bool that can test whether
a flag model is valid for a given course base. *)
(* Here, on the left side the flag model is decomposed into smaller pieces because they
will be used on the right side.
In the first condition there could be another function which checks all 3 elements all
together but in this case I found it more feasible to write liket this.
In the second condition to check if any of them have some element in common, I simply united
the whole sets and counted
their size and checked if this size is equal to the sum of the size of the sets individually.
In the third condition I again united the whole sets and used forall method to check predicate*)
let isValid ((man, opt), (man2, opt2), (man3, opt3),es) cb =
isValidCourseGroup (man, opt) cb && isValidCourseGroup (man2, opt2) cb
&& isValidCourseGroup (man3, opt3) cb
//First condition is over, now the second condition
&& Set.count (Set.union (Set.union (Set.union man opt) (Set.union man2 opt2))
(Set.union man3 opt3)) = (Set.count (Set.union man opt)) +
(Set.count (Set.union man2 opt2)) + (Set.count (Set.union man3 opt3))
//Second condition is over, now third
&& Set.forall es (Set.union (Set.union (Set.union man opt) (Set.union man2 opt2))
(Set.union man3 opt3));;
let man = Set.ofList [1;2;3];; let opt = Set.ofList [4;5;6];; let man2 = Set.ofList [7;8;9];;
let opt2 = Set.ofList [10;11;12];;
let man3 = Set.ofList [13;14;15];; let opt3 = Set.ofList [16;17;18];;
//Indicating that electives cannot be say, Phd courses. "smaller than 50."
let es courseno = courseno < 50
let opt3_2 = Set.empty
let coursebase =
Map.ofList [(1,("math1",20));(2,("math2",5));(3,("physics",5));(4,("chem1",20));
(5,("physics2",5));(6,("chem2",20));(7,("math3",20));(8,("math4",5));
(9,("physics3",5));(10,("chem3",20));(11,("math5",20));(12,("math6",5));
(13,("physics4",5));(14,("chem4",20));(15,("math7",20));(16,("math8",5));
(17,("physics5",5));(18,("chem5",20));(19,("math9",20));(20,("math10",5))]
(* Test6 will be like this because opt3 set is not empty while it is supposed to be. It is declared as
empty set in cases where
mandatory courses add up to 45. So here it adds up to 45 ects so optional courses are not 0.
Then this will violate first condition of is valid function. *)
let test6_1 = isValid ((man,opt),(man2,opt2),(man3,opt3),es) coursebase = false
(* This time it will be true because note that third element of the input tuple has changed
to (man3,opt3_2). This time it is assigned to empty set. So it is fine. *)
let test6_2 = isValid ((man,opt),(man2,opt2),(man3,opt3_2),es) coursebase = true;;
(* A course plan cs satisfies a (valid) flag model of a bachelor programme (for a given course
base), if the number of ECTS points earned from the courses in cs is 180, subject to the
requirement that 45 points are earned in each course group of the flag model, including
the elective courses.*)
(* 7. Declare a function checkPlan: CoursePlan -> FlagModel -> CourseBase -> bool
that can check whether a course plan satisfies a flag model for a given course base. *)
let checkPlan cs ((man,opt),(man2,opt2),(man3,opt3),_) cb =
sumECTS cs cb = 180 && sumECTS (Set.union man opt) cb = 45 &&
sumECTS (Set.union man2 opt2) cb = 45 && // set.intersect (Set.union man2 opt2) cs
sumECTS (Set.union man3 opt3) cb = 45;;
let cs = (Set.ofList [1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23])
let coursebase2 =
Map.ofList [(1,("math1",10));(2,("math2",5));(3,("physics",5));(4,("chem1",10));
(5,("physics2",5));(6,("chem2",10));(7,("math3",5));(8,("math4",5));
(9,("physics3",5));(10,("chem3",10));(11,("math5",5));(12,("math6",15));
(13,("physics4",5));(14,("chem4",10));(15,("math7",5));(16,("math8",5));
(17,("physics5",5));(18,("chem5",15));(19,("math9",20));(20,("math10",5));
(21,("math11",10));(22,("hist",5));(23,("asd",5));(24,("qwe",5))];;
(* Created another coursebase in order to test this function. So this time coursebase2 is used.
((man,opt),(man2,opt2),(man3,opt3),es) these values are the same values used in "inValid"
function tests. *)
let test7 = checkPlan cs ((man,opt),(man2,opt2),(man3,opt3),es) coursebase2 = true ;;
(* Lets say we changed our cs and subtracted the course which had 23 key value in the map.
Then we expect false due to total wont be equal to 180 ects. *)
let test7_2 = checkPlan (Set.remove 23 cs) ((man,opt),(man2,opt2),(man3,opt3),es) coursebase2=false;;
(* I can see you have somehow handed in twice, but the other one is without '',
so the Assessment is just the same:
1. - Not correct, you forgot to check that the number is positive
2. - Correct, nice and clean solution
3. - Correct
4. - Correct, but inefficient, as the course base is easily order of magnitude
larger than the Set
5. - Correct
6. - Correct, but not too readable, next time, try to extract some functionality
to auxiliary functions, eg. let allCourse = the union of all sets. Or just use an
auxiliary function for each condition
7. - Not correct, you are not checking that the FlagModel contains 45 points in each group,
not that the CoursePlan has.
Approved
- Jakob Rydhof *)
// end 41 / 66666666666666666666666666666666666666666666666666666666666
// 40 / 55555555555555555555555555555555555555555555555555555555555
type Shape =
| Circle of float
| Square of float
| Triangle of float * float * float;;
let area = function
| Circle r -> System.Math.PI*r*r
| Square a -> a*a
| Triangle(a,b,c) -> let s = (a + b + c)/2.0
sqrt(s * (s-a) * (s-b) * (s-c));;
area (Circle 2.0);;
type Month = | January | February | March | April | May | June | July | August | September
| October | November | December;;
let daysOfMonth = function
| February -> 28
| April | June | September | November -> 30
| _ -> 31;;
daysOfMonth December;;
let rec findPosA p x = function
| y::_ when x=y -> Some p
| _::ys -> findPosA (p+1) x ys
| [] -> None;;
let findPos x ys = findPosA 0 x ys;; findPos 4 [2 .. 6];;
findPos 7 [2 .. 6];; Option.get(findPos 4 [2;4;3;4;2]);;
type Room =
| Auditorium of int*int
| Databar of int*int*int;;
let seatCapacity = function
| Auditorium (loc,seats) -> seats
| Databar (loc,PCs,seats) -> seats;;
let computerCapacity = function
| Auditorium (loc,seats) -> 0
| Databar (loc,PCs,seats) -> PCs;;
seatCapacity (Databar (2,1,2));; computerCapacity(Auditorium (2,2));;
let rec map f = function
| [] -> []
| x::xs -> f x :: map f xs;;
let map = (fun x -> x*x+1);;
let addElems = map (fun (x,y) -> x+y);; addElems [(2,5);(3,3)];;
let g = map (fun x -> (x*x+1));; g[2;4];;
let rec exists p = function
| [] -> false
| x::xs -> p x || exists p xs;;
exists (fun x -> x>=2) [1; 3; 1; 4];;
let contains x ys = exists (fun a -> a=x) ys;; // care, a var in fun, else
// f# gets confused by fun x
contains 0 [0;1;2] // odd addition of ;; when running
let rec forall p = function
| [] -> true
| x::xs -> p x && forall p xs;;
forall (fun x -> x>=2) [1; 2];;
let rec disjoint xs = function // xs and ys lists
| [] -> true
| y::ys -> forall (fun x -> x<>y) xs && disjoint xs ys;;
disjoint [1;2] [3;4];;
let rec subset xs ys = // xs and ys lists
match (xs,ys) with
| ([],_) -> true
| (_,[]) -> true
| (xs,y::ys) when (List.length xs >= List.length ys)
-> exists (fun x -> x=y) xs && subset xs ys
| (x::xs,ys) when (not (List.length xs >= List.length ys))
-> exists (fun y -> y=x) ys && subset xs ys;;
subset [3;7] [3;4;7;8];; subset [1;2] [3]
let rec filter p = function
| [] -> []
| x::xs -> if p x then x :: filter p xs
else filter p xs;;
filter System.Char.IsLetter ['1'; 'p'; 'F'; '-'];;
let rec inter xs ys =
match (xs, ys) with
| ([], _) -> []
| (_, []) -> []
| (x::xs, ys) -> (filter (fun a -> a=x) ys)@(inter xs ys);;
inter [1;3] [3;4]
let rec tryFind p = function
| x::xs when p x -> Some x
| _::xs -> tryFind p xs
| _ -> None;;
tryFind (fun x -> x>3) [1;5;-2;8];;
let norm(x1:float,y1:float) = sqrt(x1 * x1+y1 * y1);;
let rec sumOfNorms = function
| [] -> 0.0
| v::vs -> norm v + sumOfNorms vs;;
sumOfNorms [(1.0,2.0); (2.0,1.0); (2.0, 5.5)];;
List.foldBack (+) [1; 2; 3] 0
List.foldBack (-) [1; 2; 3] 0
let (@) xs ys = List.foldBack (fun x rst -> x::rst) xs ys;;
[1;2] @ [3;4]
let rec foldBack f xlst e =
match xlst with
| x::xs -> f x (foldBack f xs e)
| [] -> e;;
let sumOfNorms vs = foldBack (fun v s -> norm v + s) vs 0.0;;
let length xs = foldBack (fun _ n -> n+1) xs 0;;
let map f xs = foldBack (fun x rs -> f x :: rs) xs [];;
let rec isMember elem ls =
match (elem,ls) with
| (elem,l::ls) -> (l = elem) || (isMember elem ls)
| (_,[]) -> false;;
let insert x ys = if isMember x ys then ys else x::ys
let length xs = foldBack (fun _ n -> n+1) xs 0;;
let union xs ys = foldBack (fun a b -> insert a ys) xs [];; //short way
let union xs ys = List.foldBack (fun a b -> insert a ys) xs [];; //short way built in
let union xs ys = // pattern matching way
match (xs,ys) with
| ([],_) -> []
| (xs,ys) -> foldBack (fun a b -> insert a ys) xs [];;
union [1;1;3] [3;4];; // element duplication fixed in 1st list
List.fold (-) 0 [1; 2; 3]
List.foldBack (-) [1; 2; 3] 0
let rec fold f e = function
| x::xs -> fold f (f e x) xs
| [] -> e;;
let rev xs = fold (fun rs x -> x::rs) [] xs;;
// 1. Give a declaration for List.filter using List.foldBack.
(* 5.2 Solve Exercise 4.15 using List.fold or List.foldBack.
4.12 Declare a function sum (p,xs) where p is a predicate of type int -> bool and
xs is a list of integers. The value of sum (p,xs) is the sum of the elements in xs
satisfying the predicate p .
Test the function on different predicates (e.g., p(x) = x > 0 ). *)
let rec sum p xs =
match xs with
| [] -> 0
| x::xs when p=true -> x + sum xs;;
sum (fun x -> x>0) [1;1;1]
(* 5.3 Solve Exercise 4.12 using List.fold or List.foldBack.
4.15 Declare an F# function revrev working on a list of lists,
that maps a list to the reversed list of the reversed elements, for example:
revrev [[1;2];[3;4;5]] = [[5;4;3];[2;1]] *)
let rev xs = List.rev xs // 4.15 option 1
let rec rev xls = // 4.15 option 2
match xls with
| [] -> []
| x::xs -> rev xs @ [x];;
let rev xs = List.fold (fun rs x -> x::rs) [] xs // 5.3
rev [1;2;3]
let rec revrev0 xs =
match xs with
| [] -> []
| x::xs -> (rev x)::(revrev0 xs);; // reverse sub lists in recursion
let revrev xs = rev (revrev0 xs);; // reverse resulting list ONCE, 5.3
let revrev xs = List.rev (revrev0 xs);; // 4.15
revrev [[1;2];[3;4;5];[7;8];[9;10]];;
(* 5.5 Consider the map colouring example in Section 4.6. Give declarations for the
functions areNb, canBeExtBy, extColouring, countries and colCntrs using higher-order
list functions. Are there cases where the old declaration from Section 4.6 is preferable? *)
// dictionary (called map in f#)
Map.ofList [(1,"a"); (2,"b"); (2,"c");(3,"a"); (1,"d");(3,"k")];;
let reg1 = Map.ofList [("a1",("cheese",25));
("a2",("herring",4));
("a3",("soft drink",5))];;
//sets
let rec tryFind p s =
if Set.isEmpty s then None
else let minE = Set.minElement s
if p minE then Some minE
else tryFind p (Set.remove minE s);;
let ss = set [set [1;3;5]; set [2;4]; set [7;8;9] ];;
tryFind (fun s -> Set.count s = 3) ss;;
Set.fold (+) 5 (set [1;2;3]) ;; Set.foldBack (+) (set [1;2;3]) 0;;
let males = set ["Bob"; "Bill"; "Ben"];; let boardMembers = Set.ofList [ "Alice"; "Bill"; "Ann"];;
Set.difference boardMembers males;;
// quadratic eq.
type Equation = float*float*float;; type Solution = float*float;;
exception Slve;;
let solve(a,b,c) =
if b * b-4.0 * a * c < 0.0 || a = 0.0 then raise Slve
else ((-b + sqrt(b * b-4.0 * a * c))/(2.0 * a),
(-b - sqrt(b * b-4.0 * a * c))/(2.0 * a));;
solve(1.0, -1.0, 2.0);;
// end 40 / 55555555555555555555555555555555555555555555555555555555555
// 4444444444444444444444444444444444444444444444444444444444444444
//Proj. 1. Club. M
//1. Assigning types for reg
type no = int;; type yb = int;; type ths = string list;; type description = (no * yb * ths)
type name = string;; type reg = ( name * description ) list;;
type extractInterested = (name * no) list;; type p1 = bool;; type p2 = bool;;
//helping function check if it is a member
type ismember = bool;;
//2.
let reg = [( "Mike", (11,1994, ["jazz";"soccer"] )); ( "Aaron", (12,1974, ["rock";"jazz";"basketball";"gamble";"soccer"] ));( "Jackson", (13,1994, ["jazz";"alcohol";"basketball";"k"] ))]
let trdreg (_,_,t,_) = t;; (trdreg (reg.Item(1)));; let frthreg (_,_,_,t) = t;;
(p1 reg.(0));; let ee = (1,1,"a");;
reg.[0][0];;
//5.
//type: 'a-> 'a list-> bool
//role: check if a list has an element with a certain value
let rec ismember element = function
| head::tail -> (head = element) || (ismember element tail)
| [] -> false
//6. test of ismember function
let test1 = ismember "soccer" ["jazz";"soccer"] = true;;
let test2 = ismember "ser" ["jazz";"soccer"] = false;;
//5.
//type: string list -> bool
//role: check thms in reg entry and return true or false for interest conditions p1
let p1 (_,yb,ths) = yb>1982 && ((ismember "soccer" ths) && (ismember "jazz" ths));;
let p2 (_,yb,ths) = yb>1982 && ((ismember "soccer" ths) || (ismember "jazz" ths));;
//6. test of p1 function
let test1 = p1 ["jazz";"soccer"] = true;;
let test2 = p1 ["jazz";"swim"] = false;;
//5.
//type: string list -> bool
//role: check thms in reg entry and return true or false for conditions p2
//6. test of p2 function
let test1 = p2 [] = false;;
let test2 = p2 ["jazz";"swim"] = true;;
//3.
//type: ('a -> bool) -> ('b * ('c * int 'a'))list -> ('b * 'c) list
//role: compose a list of potentially
//interested club members by calling p1 / p2 / event function and reg
let rec extractInterested p1 = function
| [] -> []
| (name,(no,yb,thms))::tail when (p1 (no,yb,thms)) -> (name, no)::(extractInterested p1 tail)
| x::y -> extractInterested p1 y;;
// See outputs.
extractInterested p1 reg;; extractInterested p2 reg;;
//4.
let test1 = (extractInterested p1 reg) = [("Mike", 11)];;
let test2 = extractInterested p2 reg = [("Mike", 11); ("Jackson", 13)];;
// end Club M
//Proj. 1. Club. ""
type no = int;; type yb = int;; type ths = string list;; type name = string;;
type Register = (name*no*yb*(ths)) list;;
let reg1 = ("Jeston",01,1911,("jazz","poker"));;
let reg2 = ("Mester",16,1986,("jazz","soccer"));;
let reg3 = ("Jesse",11,1991,("jazz","hockey"));; let reg = [reg1;reg2;reg3];;
reg.Item(1);;
let trdreg (_,_,t,_) = t;; (trdreg (reg.Item(1)));; let frthreg (_,_,_,t) = t;;
let frstp (t,_,_) = t;; let scndp (_,t,_) = t;; let trdp (_,_,t) = t;;
// events don't need no (phone number)
let p1 = (1986,("jazz","soccer"),"and");; let p2 = (1986,("jazz","soccer"),"or");;
((trdreg (reg.Item(1))) >= (frstp p1)) && ((frthreg (reg.Item(1))) = (scndp p1));;
trdreg (reg.Item(0));;
// end Club ""
// end 4444444444444444444444444444444444444444444
// Cash register /////////////////////////////////////////////////
type ArticleCode = string;; type ArticleName = string;;
type Price = int;; // pr where pr >= 0
type Register = (ArticleCode*(ArticleName * Price)) list;;
let reg = [("a1",("cheese",25));
("a2",("herring",4));
("a3",("soft drink",5))];;
type NoPieces = int;; // np where np >= 0
type Item = NoPieces*ArticleCode;; type Purchase = Item list;;
let pur = [(3,"a2"); (1,"a1")];;
type Info = NoPieces*ArticleName*Price;; type Infoseq = Info list;;
type Bill = Infoseq*Price;;
let rec findArticle ac = function
| (ac',adesc)::_ when ac=ac' -> adesc
| _::reg -> findArticle ac reg
| _ -> failwith(ac + " is an unknown article code");;
let rec makeBill reg = function
| [] -> ([],0)
| (np,ac)::pur -> let (aname,aprice) = findArticle ac reg
let tprice = np * aprice
let (billtl,sumtl) = makeBill reg pur
((np,aname,tprice)::billtl,tprice+sumtl);;
makeBill reg pur;;
// end Cash reg ___________________________________________
// Map colouring. Example 2. ///////////////////////////////////
type Country = string;; type Map = (Country * Country) list;;
let exMap = [("a","b"); ("c","d"); ("d","a")];;
type Colour = Country list;; type Colouring = Colour list;;
let rec isMember x = function
| y::ys -> x=y || (isMember x ys)
| [] -> false;;
let areNb m c1 c2 =
isMember (c1,c2) m || isMember (c2,c1) m;;
let rec canBeExtBy m col c =
match col with
| [] -> true
| c'::col' -> not(areNb m c' c) && canBeExtBy m col' c;;
canBeExtBy exMap ["c"] "a";; canBeExtBy exMap ["a"; "c"] "b";;
let rec extColouring m cols c =
match cols with
| [] -> [[c]]
| col::cols' -> if canBeExtBy m col c
then (c::col)::cols'
else col::extColouring m cols' c;;
extColouring exMap [] "a";; extColouring exMap [["c"]] "a";; extColouring exMap [["b"]] "a";;
let addElem x ys = if isMember x ys then ys else x::ys;;
let rec countries = function
| [] -> []
| (c1,c2)::m -> addElem c1 (addElem c2 (countries m));;
let rec colCntrs m = function
| [] -> []
| c::cs -> extColouring m (colCntrs m cs) c;;
let colMap m = colCntrs m (countries m);;
colMap exMap;;
// end Map colour _____________________________________
// 222222222222222222222222222222222222222222222222222222222222
//1. works only with positive integers
let mrgSrt x y =
List.sortBy (fun elem -> abs elem)(x@y);;
mrgSrt [1;4;9;12] [2;3;4;5;10;13];;
//2. split func
let rec split x =
match x with
| [] -> ([],[])
| [x] -> ([x],[])
| a::b::c -> let (l1,l2) = split c
in (a::l1, b::l2);;
split [2;3;4;5;10;13];;
//assign list range, access element list, length, accessing string elements
let ddd = [1..5];; ddd.Item(0);; ddd.Length;; let str = "asdasdasd";; str.[1];; ReverseString str;;
// efficiency, sort time
let randomArray n range = let rand = let gen = new System.Random()
(fun max -> gen.Next(max))
Array.init n (fun _ -> rand range);;
let randomList n range = List.ofArray(randomArray n range);;
let xs30000 = randomList 30000 1000000;; #time;;
List.sort xs30000;;
#time;;
// end 222222222222222222222222222222222222222222222222222222222222
// 1111111111111111111111111111111111111111111111111111111111
//1.
let rec func1 n =
match n with
| 0 -> 0
| _ -> n + func1 (n-1)
func1 3;;
//2.
let rec func2 (x:int,y:int) =
match (x,y) with
| (_,0) -> 0
| (0,_) -> 0
| (x,y) when (x>0) -> x+y+func2(x,y-1)
func2 (2,2);;
//3.
let rec factorial n =
match n with
| 0 | 1 -> 1
| _ -> n * factorial (n - 1);;
factorial 8;;
let rec paTri (n,k) =
match (n,k) with
| (_,0) -> 1
| (n,k) when n=k -> 1
| (n,k) -> paTri(n-1,k-1)+paTri(n-1,k);; //this works as recursive
//| (n,k) -> factorial(n)/factorial(k)/factorial(n-k);; // this works as n!
paTri(4, 2);;
//4.
let rec mulTi x y =
match y with
| [] -> 0
| head::tail when head = x -> 1 + mulTi x tail
| head::tail -> mulTi x tail;;
mulTi 2 [2;1;1;3;2];;
//5.
let rec mulC x y =
match y with
| [] -> []
| head::tail -> (x*head)::(mulC x tail);;
mulC 2 [2;1;1;1;2;1];;
//6.
let rec addE (x, y) =
match (x, y) with
| ([], []) -> []
| (headx::tailx, []) -> headx::(addE (tailx, []))
| ([], heady::taily) -> heady::(addE ([], taily))
| (headx::tailx, heady::taily) -> (headx + heady)::(addE (tailx, taily));;
addE ([2;2], [2;1;1;5;7]);; addE ([1;2;3;4], [5;6]);;
//7. a
let mulX x = //
match x with
| [] -> [0]
| x -> [0]@x;;
mulX [2;1;1];;
let rec mulX1 (x, y) = // adds specified amount of zeros in front of list
match (x, y) with
| (0, _) -> y
| (x, y) -> mulX1 (x-1, ([0]@y));;
mulX1 (2, [2;1;1]);;
//7.b polynomial multiplication
let rec mul x y =
match (x, y) with
| (_, _) when x=[] || y=[] -> [0]
| (hxs::taxs, y) -> addE ((mulC hxs y), (mulX (mul taxs y)));;
mul [1;0;3] [0;0;2;3] ;;
let ddd=[2..5];; (ddd.Item(0));;
//7.c
let ReverseString (s:string) = new string(Array.rev (s.ToCharArray()));;
(* function format specifying all input vars needs "match [var/vars] with" and | (ifs)
| run from top to bottom, 1st match gets executed, rest disregarded
so order matters
RHS of | _ -> _ statements specifies output format*)
let rec addX y c = // cr8 c counter as 2nd var
match y with
| [] -> "" // output type list, same in all ifs |
| head::tail when c=0 -> string(head)+" + "+(addX tail (c+1))
| head::[] -> string(head)+" * x^"+string(c) // empty tail removes last plus
| head::tail -> string(head)+" * x^"+string(c)+" + "+(addX tail (c+1));; // use and update counter
let addY x = addX x 0;; //cr8 another func with given counter input
addY [2;1;1;1;2;1];; // final func needs only 1 requested input
// end 111111111111111111111111111111111111111111111111111111