1       (23 marks)

(i)     [1 mark]

Write a function capVowels, which takes a string and capitalises every lowercase vowel (‘a’, ‘e’, ‘i’, ‘o’, ‘u’).

Your solution should satisfy:

vTest  ::  Bool

vTest  =  (capVowels  "mmh"       ==  "mmh")  &&

(capVowels  "learn"  ==  "lEArn")  &&

(capVowels  "Only"    ==  "Only")  &&

(capVowels  "holy"      ==  "hOly")

capVowels  ::  String  ->  String

capVowels  =  undefined

(ii)    [2 marks]     The quadratic equation ax2 + bx + c = 0 has two roots, given by the formulas

x = -b士 2(^)a(b2) -4ac . As long as the discriminant b2 - 4ac is non-negative, the roots are real

complex roots. Assume a  0.

Your solution should satisfy:

qrTest  ::  Bool

qrTest  =  and  (map  isQR  [

(2,  (-8),  8,  Just  (2 .0,2 .0)),

(5,  2,  1,  Nothing),

(5,  6,  1,  Just  (-0 .2,-1 .0)),

(1,  (-4),  6 .25,  Nothing)])

where

isQR  (i,  j,  k,  l)  =  qRoots  i  j  k  ==  l

qRoots  ::  (Ord  z,  Floating  z)  =>  z  ->  z  ->  z  ->  Maybe  (z,  z)

qRoots  =  undefined

(iii)   [3 marks]     Write a function tMatch that takes two lists over the same Eq type and which if the lists have the same length returns a Maybe pair, Just  (same,  diff). The value

same is the count of positions where the two lists have the same value, and diff is the count of positions that have different values.  If the two lists have different lengths the  function should return Nothing.

Your solution should satisfy:

mTest  ::  Bool

mTest  =  (tMatch  [1,  2,  3]  [2,  2,  3]         ==  Just  (2,1))  && (tMatch  [1,  2,  3]  [2,  2,  3,  4]  ==  Nothing)       &&

(tMatch  "soft2"  "soft3" (tMatch  "THE2"  "SOF3"    (tMatch  "  "  "  "

==  Just  (4,1))  &&

==  Just  (0,4))  &&

==  Just  (1,0))

tMatch  ::  (Eq  a)  =>  [a]  ->  [a]  ->  Maybe  (Int,Int)

tMatch  =  undefined

(iv)   [17 marks]

Consider the record of a computer science student modelled by the type CSStudent

data  CSStudent  =  CSStudent  {sid  ::  SID,  sname  ::  SName,  stage  ::  Stage} deriving  (Ord,  Eq,  Show)

type  SID         =  Int

type  SName    =  String

data  Stage    =  SOne  |  STwo  |  SThree  |  SFour  deriving  (Ord,  Eq,  Show) B-Trees are a generalisation of binary sort trees in which each node can have a larger,             variable number of children.

Knuth’s definition, a B-Tree of order m is a tree which satisfies the following properties:

1.  Every node has at most m children.

2.  Every non-leaf node (except the root) has at least the ceiling of m/2 child nodes .

3.  The root has at least two children unless it is a leaf node .

4.  A non-leaf node with k children contains k- 1  keys .

5.  All leaves appear in the same level.

Also,

1.  All keys of a node are sorted in increasing order.

2.  The child between two keys k1 and k2 contains all keys in the range from k1 and k2.

3.  A B-Tree grows and shrinks from the root.

4.  Insertion of a node in a B-Tree happens only at the leaf node.

To insert a key k:

1.  Traverse the B-Tree from the root to the appropriate leaf node (or the leaf node containing keys of the same range).

2.  Ensure that the node is not full, thus the node has extra space .

3.  If the node has extra space, insert the key k and ensure that elements in the node are ordered.

4.  If the node is full, then evenly split it into two nodes with a single median before inserting into the appropriate node.  Move the single median into its parent node.

Figure 1 have two examples of a B-Tree with keys 7 and 4 inserted into diagrams 1 and 2 respectively.

Figure 1: A figure showing two B-Trees before and after insertion.  In example 1, the key 7 is inserted, which required the original B-Tree to split.  However, in example 2,

the key 4 is inserted without the need for splitting.

Given the type DBTreeO of a B-Tree:

data  DBTreeO  a  =  DBEmp  Int  |  DBLeafO  Int  [a]  |  DBNodeO  Int  [a]  [DBTreeO  a] deriving  (Eq,  Show)

DBEmp m is an empty tree, DBLeafO m  xs is a leaf node and DBNodeO m  xs  ts is a non-leaf node, all with order m.

Example:

csStud,  students,  uoyStud  ::  DBTreeO  CSStudent

csStud      =  DBEmp  4

students  =  DBLeafO  4

[CSStudent  {sid  =  2,  sname  =  "Mark  Foster",  stage  =  SOne},

CSStudent  {sid  =  3,  sname  =  "Juli  Smith",  stage  =  STwo}] uoyStud    =  DBNodeO  4

[CSStudent  {sid  =  2,  sname  =  "Mark  Foster",  stage  =  SOne}, CSStudent  {sid  =  5,  sname  =  "Janet  Kade",  stage  =  STwo}]

[DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Yi  Wu",  stage  =  SFour}],        DBLeafO  4  [CSStudent  {sid  =  3,  sname  =  "Juli  Smith",  stage  =  STwo}],  DBLeafO  4  [CSStudent  {sid  =  6,  sname  =  "Simon  Jones",  stage  =  SFour}, CSStudent  {sid  =  7,  sname  =  "Matt  Ohene",  stage  =  SThree}]]

Consider a database table with records of computer science students organised as a B-Tree

with order 4 and SID as keys (for example, students) . Write a function csInsert which

inserts the record of a computer science student into a database organised as a B-Tree. Your solution should satisfy:

testInsert  ::  Bool

testInsert  =

csInsert  students  CSStudent  {sid  =1,  sname  =  "Yi  Wu",  stage  =  SFour}  ==

DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Yi  Wu",  stage  =  SFour}, CSStudent  {sid  =  2,  sname  =  "Mark  Foster",  stage  =  SOne},            CSStudent  {sid  =  3,  sname  =  "Juli  Smith",  stage  =  STwo}]  &&

csInsert  csStud  CSStudent  {sid  =1,  sname  =  "Mike  Brown",  stage  =  SOne}  == DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Mike  Brown",  stage  =  SOne}]  &&

csInsert

(csInsert  csStud  CSStudent  {sid  =1,  sname  =  "Mike  Brown",  stage  =  SOne}) CSStudent  {sid=2,  sname="Georgia  Jones",  stage=STwo}  ==

DBLeafO  4

[CSStudent  {sid  =  1,  sname  =  "Mike  Brown",  stage  =  SOne},

CSStudent  {sid  =  2,  sname  =  "Georgia  Jones",  stage  =  STwo}]  && csInsert

(csInsert  (csInsert  csStud  CSStudent  {sid  =1,  sname  =  "Mike  Brown",  stage  =  SOne})  CSStudent  {sid=2,  sname="Georgia  Jones",  stage=STwo}) CSStudent  {sid=3,  sname="Tamara  Berg",  stage=SThree}  ==

DBLeafO  4

[CSStudent  {sid  =  1,  sname  =  "Mike  Brown",  stage  =  SOne},          CSStudent  {sid  =  2,  sname  =  "Georgia  Jones",  stage  =  STwo},      CSStudent  {sid  =  3,  sname  =  "Tamara  Berg",  stage  =  SThree}]  &&

csInsert

(csInsert  (csInsert  (csInsert  csStud  CSStudent  {sid  =1,  sname  =  "Mike  Brown",  stage  =  SOne})  CSStudent  {sid  =  2, sname  ="Georgia  Jones",  stage  =  STwo})

CSStudent  {sid  =  3,  sname  =  "Tamara  Berg",  stage  =  SThree}) CSStudent  {sid  =  7,  sname  =  "Eric  Han",  stage  =  SFour}  ==

DBNodeO  4

[CSStudent  {sid  =  2,  sname  =  "Georgia  Jones",  stage  =  STwo}]

[DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Mike  Brown",  stage  =  SOne}],  DBLeafO  4  [CSStudent  {sid  =  3,  sname  =  "Tamara  Berg",  stage  =  SThree}, CSStudent  {sid  =  7,  sname  =  "Eric  Han",  stage  =  SFour}]]  &&

csInsert

uoyStud  CSStudent  {sid  =  1,  sname  =  "Jane  Hay",  stage  =  SOne}  ==

DBNodeO  4

[CSStudent  {sid  =  2,  sname  =  "Mark  Foster",  stage  =  SOne}, CSStudent  {sid  =  5,  sname  =  "Janet  Kade",  stage  =  STwo}]

[DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Yi  Wu",  stage  =  SFour}],        DBLeafO  4  [CSStudent  {sid  =  3,  sname  =  "Juli  Smith",  stage  =  STwo}],  DBLeafO  4  [CSStudent  {sid  =  6,  sname  =  "Simon  Jones",  stage  =  SFour}, CSStudent  {sid  =  7,  sname  =  "Matt  Ohene",  stage  =  SThree}]]  &&

csInsert

uoyStud  CSStudent  {sid  =  4,  sname  =  "Ben  Johnson",  stage  =  SFour}  == DBNodeO  4

[CSStudent  {sid  =  2,  sname  =  "Mark  Foster",  stage  =  SOne}, CSStudent  {sid  =  5,  sname  =  "Janet  Kade",  stage  =  STwo}]

[DBLeafO  4  [CSStudent  {sid  =  1,  sname  =  "Yi  Wu",  stage  =  SFour}],    DBLeafO  4  [CSStudent  {sid  =  3,  sname  =  "Juli  Smith",  stage  =  STwo}, CSStudent  {sid  =  4,  sname  =  "Ben  Johnson",  stage  =  SFour}],                DBLeafO  4

[CSStudent  {sid  =  6,  sname  =  "Simon  Jones",  stage  =  SFour}, CSStudent  {sid  =  7,  sname  =  "Matt  Ohene",  stage  =  SThree}]]

csInsert  ::  DBTreeO  CSStudent  ->  CSStudent  ->  DBTreeO  CSStudent

csInsert  =  undefined

2       (24 marks)

Consider the type of binary trees that have data in the nodes:

data  BTree  a  =  Leaf  |  Node  (BTree  a)  a  (BTree  a)

deriving  (Eq,  Show)

(i)     [8 marks]     Write a QuickCheck property prop_MaxNodes to determine whether there    exist a maximum of (2h - 1) nodes in a binary tree with a height h, where the height of a binary tree with only a Leaf is one.

You should be able to test your solution using quickCheck  prop_MaxNodes and generate arbitrary binary trees with sample  (arbitrary::  Gen(BTree  Int)).

[Hint:  Make the type BTree  a an instance of the Arbitrary type class as part of your solution.]

prop_MaxNodes  ::  BTree  Int  ->  Bool

prop_MaxNodes  =  undefined

(ii)    [1 mark]     A BTree can be made into an instance of type class Functor:

instance  Functor  BTree  where

fmap  f  =  ff

where

ff  Leaf                      =  Leaf

ff  (Node  lt  w  rt)  =  Node  (ff  lt)  (f  w)  (ff  rt)

Write a QuickCheck property prop_functorId to verify the identity law of the BTree Functor instantiation.

You should be able to test your solution using quickCheck  (prop_functorId  ::  BTree Int  ->  Bool).

prop_functorId  ::  (Functor  f,  Eq  (f  a))  =>  f  a  ->  Bool

prop_functorId  =  undefined

(iii)   [4 marks]     BTree as an Applicative

Instantiate BTree as an Applicative.

instance  Applicative  BTree  where

pure  =  undefined

(<*>)  =  undefined

(iv)   [4 marks]     BTree as a Monad

Write functions appendLeft and appendRight.  Each replaces a Leaf in its second         argument by the first argument.  Function appendLeft replaces the left-most Leaf, while appendRight replaces the right-most Leaf.

appendLeft,  appendRight  ::  BTree  a  ->  BTree  a  ->  BTree  a

appendLeft  =  undefined

appendRight  =  undefined

(v)    [3 marks]

Hence, or otherwise, write a function joinTree that converts a tree of trees over some datatype into a tree over that datatype.

Your solution should satisfy:

btTest  ::  Bool

btTest  =  (joinTree  (Node  Leaf  bt0  Leaf)  ==  Node  Leaf  123  Leaf)  &&

(joinTree  bt2  ==  Node  (Node  (Node  Leaf  123  Leaf)  2  Leaf)  2 (Node  Leaf  (-2)  (Node  Leaf  123  Leaf)))       &&

(joinTree  bt4  ==  Node  Leaf  123  (Node  (Node  (Node  Leaf  123  Leaf)

2  Leaf)  2  (Node  Leaf  (-2)  (Node  Leaf  123  Leaf))))  &&

(joinTree  bt3  ==  Node  (Node  (Node  (Node  (Node  (Node  Leaf  2 Leaf)  2  (Node  Leaf  (-2)  Leaf))  2  Leaf)  2  (Node  Leaf  (-2)

(Node  (Node  Leaf  2  Leaf)  2  (Node  Leaf  (-2)  Leaf))))  2  Leaf) 2  (Node  Leaf  (-2)  (Node  (Node  Leaf  2  Leaf)  2  (Node  Leaf  (-2)

(Node  (Node  Leaf  2  Leaf)  2  (Node  Leaf  (-2)  Leaf))))))

bt0  =  Node  Leaf  123  Leaf

bt1  =  Node  (Node  Leaf  2  Leaf)  2  (Node  Leaf  (-2)  Leaf)      bt2  =  Node  (Node  Leaf  bt0  Leaf)  bt1  (Node  Leaf  bt0  Leaf)

bt3  =  Node  (Node  (Node  Leaf  bt1  Leaf)  bt1  (Node  Leaf  bt1  Leaf))  bt1

(Node  Leaf  bt1  (Node  Leaf  bt1  Leaf))

bt4  =  Node  Leaf  bt0  (Node  (Node  Leaf  bt0  Leaf)  bt1  (Node  Leaf  bt0  Leaf))

joinTree  ::  BTree  (BTree  a)  ->  BTree  a

joinTree  =  undefined

(vi)   [2 marks]

Hence, or otherwise, instantiate BTree as a Monad.

instance  Monad  BTree  where

(>>=)  =  undefined

(vii)  [2 marks]

Write a QuickCheck property prop_monadRightId to verify the right identity law of the BTree Monad instantiation.

You should be able to test your solution using quickCheck  (prop_monadRightId  :: BTree  Char  ->  Bool).

prop_monadRightId  ::  (Monad m,  Eq  (m  a))  => m  a  ->  Bool prop_monadRightId  =  undefined

3       (11 marks)

Consider the type definition for instructions, such as a scientific calculator may have:

data  Instruction  =  In  Int  |  Clear  |  Size  |  Mean

deriving  (Eq,  Show)

data  CalResult  =  SIZE  Int  |  MEAN  Int  |  ERROR

deriving  (Eq,  Show)

Conceptually, the calculator stores a collection of Ints. The instruction:

■  In  n places the number n into the calculator’s current collection

■  Clear empties the collection

■  Size returns as a CalResult, the size of the current collection

■ Mean returns as a CalResult, the mean of the current collection (total of values in the collection, divided by its size) if the size is non-zero; otherwise it reports an error.

Note In this question you must use integral division, div, rather than fractional division.

For example, the list of instructions:

[In  1,  In  7,  Size,  Mean,  In  4,  Size,  Clear,  Mean,  In  5,  In  6,  In  7,  Mean,  Size]

when entered into the calculator gives the list of results:

[SIZE  2,  MEAN  4,  SIZE  3,  ERROR,  MEAN  6,  SIZE  3]

This question asks you to write code to implement this functionality of the calculator.

(i)     [2 marks]

Give a data-type to represent the state of the calculator.

You may change type to newtype or data as appropriate, and you may derive any type classes that will be useful.

Marks will be awarded for the efficiency of your solution, and for how well the type protects

the programmer from making mistakes.

type  State  =  ()  - - REPLACE  THIS DEFINITION

(ii)    [1 mark]

Give the initial state of the calculator, iniS, which is the same as the state immediately following a Clear.

iniS  ::  State

iniS  =  undefined

(iii)   [2 marks]

Give a function, update that updates the state, given an instruction:

update  ::  State  ->  Instruction  ->  State

update  =  undefined

(iv)   [2 marks]

Give a function, result that produces a result of the instruction, if there is one. The mean of an empty collection should be the special result ERROR.

result  ::  State  ->  Instruction  ->  Maybe  CalResult

result  =  undefined

(v)    [2 marks]

Construct a function, combineResults that adds the result of processing an instruction in a given state onto the front of a list of results.

combineResults  ::  State  ->  Instruction  ->  [CalResult]  ->  [CalResult] combineResults  =  undefined

(vi)   [2 marks]

Finally, give a function, calc, that given a list of instructions, returns a list of results. The calculator always starts with an empty list of values.

calc  ::  [Instruction]  ->  [CalResult]

calc  =  undefined

4       (10 marks)

In this question you are asked to define types, as well as values.  Each type, Name, is given a default implementation as an alias for the unit type: type  Name  =  (). You may change the keyword type to either newtype or data if appropriate, and you should replace the    unit type, (), by a suitable type expression. You may derive any type classes, such as Show, that will be useful.

Marks will be mostly given for how well the type protects the programmer from mistakes,

for its utility to the programmer, and also partly for the run-time efficiency of the type.   The game of draughts (also spelt drafts) or, in American English, checkers (also spelt    chequers) is a game played by two opponents. There are many variants of the rules: this question uses the rules below.

The game is played on the black squares of an eight-by-eight board, that looks like a chess board. The two opponents alternate moving a single piece.

There are two kinds of pieces:

■  Ordinary, and

■  Crowned

Each player starts with twelve ordinary pieces, placed on the twelve dark squares closest to

their base line.

All moves are diagonal.

A piece can be moved

■  by one row to an unoccupied square, or

■  by a sequence ofjumps. A jump is a diagonal move of two rows over an opponents piece. A jumped-over piece is removed from the board.

An ordinary piece moves forward only; a crowned piece may move forward and backward. When an ordinary piece reaches the furthest row from its baseline it becomes “crowned”.

The first player who cannot move, either because they have no pieces, or because they have

no legal moves, loses, and the other player wins.

You are given the following types and functions to represent the players, pieces and squares:

data  Player  =  Dark  |  Light  deriving  (Eq,  Show)

data  Kind  =  Ordinary  |  Crowned  deriving  (Eq,  Show)

data  Piece  =  Piece  {kind  ::  Kind,  player  ::  Player}    deriving  (Eq,  Show)

data  RowCol  =  Zero  |  One  |  Two  |  Three  |  Four  |  Five  |  Six  |  Seven deriving  (Bounded,  Enum,  Eq,  Ord,  Show)

data  Square  =  Square  {row,  col  ::  RowCol}  deriving  (Eq,  Show)

legal  ::  Square  ->  Bool  - -  True  if  a piece  may  be  on  this  square

legal  (Square  r  c)  =  any  sameParity  [even,  odd]

where

even  =  [minBound,  succ(succ  minBound)  . .  pred  maxBound]

odd    =  succ  <$>  even

sameParity  p  =  r  ~elem ~  p  &&  c  ~elem ~  p

A game state includes a board state and the identity of the player whose turn is next.

data  GameState  =  GameState  Board  Player

Values of type Board contain information about where pieces are.

Define a suitable value for Board.

type  Board  =  ()  - - REPLACE  WITH A  SUITABLE  TYPE EXPRESSION

Define a pair of functions that

1.  create a board from a list of position/piece pairs,

2.  return a list of position/piece pairs.

fromList  ::  [(Square,  Piece)]  ->  Board

toList  ::  Board  ->  [(Square,  Piece)]

fromList  =  undefined

toList  =  undefined

The definition oneCrownEach gives a board where each player has one piece, which is crowned, and they are in opposite corners of the board.

oneCrownEach  ::  Board

oneCrownEach  =  fromList  [(Square  Zero  Zero,  Piece  Crowned  Light),  (Square  Seven  Seven,  Piece  Crowned  Dark)]

Define a function that checks if a proposed simple move is valid. The function is not required to check if a jump is valid.

validSimpleMove  ::  GameState  ->  Square  ->  Square  ->  Bool

validSimpleMove  g  f  t should be True exactly when a move from square f to square t in game state g is valid.

validSimpleMove  =  undefined

5       (10 marks)

Consider a league competition, where teams play each other exactly once.  Each match

finishes in a winner.

Scores can be recorded in at least two different ways:

■  a function from pairs of teams to a Maybe value, where Nothing means that the     match has not been played, and Just  x means that the match has been played, with x being the winner.

type  LeagueM  t  =  (t,  t)  ->  Maybe  t

■  a function from teams to the list of teams that they have beaten: type  LeagueL  t  =  t  ->  [t]

For each of the tasks 5(i), 5(ii) and 5(iii) below, give two solutions, one using each type.

(i)     [2 marks]

Give the value representing the initial state of the scores record.

initM  ::  LeagueM  t

initL  ::  LeagueL  t

initM  =  undefined

initL  =  undefined

(ii)    [4 marks]     Give the function that inserts the result of a match into the score record.  If the match result is already present, it is updated.

The input pair of teams have the winner first and loser second.

winnerM  ::  Eq  t  =>  (t,  t)  ->  LeagueM  t  ->  LeagueM  t winnerL  ::  Eq  t  =>  (t,  t)  ->  LeagueL  t  ->  LeagueL  t winnerM  =  undefined

winnerL  =  undefined

(iii)   [4 marks]     Give the function that converts values of LeagueL to values of LeagueM. What is the problem of converting values from LeagueM to LeagueL?

leagueL2M  ::  Eq  t  =>  LeagueL  t  ->  LeagueM  t

leagueL2M  =  undefined

6       (10 marks)

Recall the definition of the ProofLayout type constructor:

infixr  0  :=:  - -  the  fixity  and priority  of  the  operator         data  ProofLayout  a  =  QED  |  a  :=:  ProofLayout  a  deriving  Show

Consider the definitions:

prod  ::  Num  a  =>  [a]  ->  a

prod  []              =  1                       - -  prod . 0

prod  (x  :  xs)  =  x  *  prod  xs  - - prod . 1

foldr  ::  (a  ->  b  ->  b)  ->  b  ->  [a]  ->  b

foldr  f  z  []              =  z                                     - -  foldr . 0

foldr  f  z  (x  :  xs)  =  f  x  (foldr  f  z  xs)  - -  foldr . 1 Give a value proof4 that proves the theorem:

prod  ==  foldr  (*)  1

Hint Use structural induction over lists.

proof4  ::  Num  a  =>  [a]  ->  ProofLayout  a

proof4  =  undefined