String Matching – Haskell

– String Matching
– Directed Studies – Assignment 3
– By: Nicholas Webb.

{- Longest Common Subsequence algorithm

– s1 subsequence s2 characters in s1 appear in s2 in same order but not necessarily contiguous
e.g., “ppl” subsequence “popular”

– s1 longestCommentSubsequence s2 length s where s subsequence s1 and s subsequence s2 and
not exists s’ where s’ subsequence s1 and s’ subsequence s2 and length s’ > length s
-}

– Task 1: Example LCS Implementations.
–

– Definitional implementation. Very slow due to redundant recursive computations.

lcsLength _ [] = 0
lcsLength [] _ = 0
lcsLength (x:xs) (y:ys)
| x == y = 1 + lcsLength xs ys
| otherwise = max (lcsLength xs (y:ys)) (lcsLength (x:xs) ys)

lcs _ [] = []
lcs [] _ = []
lcs (x:xs) (y:ys)
| x == y = x : lcs xs ys
| otherwise = longest (lcs xs (y:ys)) (lcs (x:xs) ys)
where
longest s1 s2 = if length s1 > length s2 then s1 else s2

– Efficient implementation. Uses a lazily generated table using dynamic programming.

lcsLength’ xs ys = lcsLen (length xs) (length ys)
where
lcsLen i j = lcsTable !! i !! j
lcsTable = [ [lcsEntry i j | j <- [0..]] | i <- [0..] ]

lcsEntry _ 0 = 0
lcsEntry 0 _ = 0
lcsEntry i j
| x == y = 1 + lcsLen (i-1) (j-1)
| otherwise = max (lcsLen i (j-1)) (lcsLen (i-1) j)
where
x = xs!!(i-1)
y = ys!!(j-1)

lcs’ xs ys = lcsLookup (length xs) (length ys)
where
lcsLookup i j = lcsTable !! i !! j
lcsTable = [ [lcsEntry i j | j <- [0..]] | i length s2 then s1 else s2

– Task 2: Cost Calculation.
–

– Takes the costs associated with a match, a mismatch, and a space, and two characters
– and returns the appropriate costing for those characters.

costChar :: Int -> Int -> Int -> Char -> Char -> Int
costChar m mm sp c1 c2
| c1 == c2 = m
| c1 == ‘-’ || c2 == ‘-’ = sp
| otherwise = mm

– Takes the costs associated with a match, a mismatch, and a space, and two strings
– (known to be of the same length) and returns the cost of that alignment of the strings.

costString :: Int -> Int -> Int -> String -> String -> Int
costString _ _ _ _ [] = 0
costString m mm sp (x:xs) (y:ys) = costChar m mm sp x y + costString m mm sp xs ys

– Task 3: Function minimaBy
–

– Takes a function from arbitrary values to ordinal values and a list of said values and
– returns the list of all the elements of the original list that are smallest.

minimaBy f l = filter (\x -> (f x) == (foldr1 min (map f l))) l

– Task 4: attach tails.
–

– attachHeads: Attaches new heads (x and y) to each of the lists of pair of lists.

attachHeads :: a -> a -> [([a],[a])] -> [([a],[a])]
attachHeads x y lis = [(x:xs, y:ys) | (xs, ys) a -> [([a],[a])] -> [([a],[a])]
attachTails x y lis = [(xs++[x], ys++[y]) | (xs, ys) Int -> Int -> String -> String -> Int
similarity’ m mm sp xs ys = simLookup (length xs) (length ys)
where
simLookup i j = simTable !! i !! j
simTable = [ [ simEntry i j | j <- [0..] ] | i Int -> Int -> String -> String -> [(String,String)]
optAlign m mm sp xs ys = minimaBy (\a -> costString m mm sp (fst a) (snd a)) (align xs ys)

– Task 7: Optimal alignment (slow) revisited
–

– The behaviours of align and optAlign combined into a single function optAlignment.

optAlignment :: Int -> Int -> Int -> String -> String -> [(String,String)]
optAlignment m mm sp xs ys = minimaBy (\a -> costString m mm sp (fst a) (snd a)) (align xs ys)
where
align [ ] [ ] = [("","")]
align (x:xs) [ ] = attachHeads x ‘-’ (align xs [ ])
align [ ] (y:ys) = attachHeads ‘-’ y (align [ ] ys)
align (x:xs) (y:ys) = attachHeads x y (align xs ys) ++
attachHeads x ‘-’ (align xs (y:ys)) ++
attachHeads ‘-’ y (align (x:xs) ys)

– Task 8: Optimal alignment (faster)
–

– optimalAlignment’ a faster version of the definitional solution to alignments. The
– function uses dynamic programming pattern to build up the alignment strings.

optimalAlignment’ :: Int -> Int -> Int -> String -> String -> [(String,String)]
optimalAlignment’ m mm sp xs ys = opt (length xs) (length ys)
where
opt i j = optTable !! i !! j
optTable = [[ optEntry i j | j <- [0..]] | i 0 && j == 0 = attachTails x ‘-’ (opt (i-1) 0)
| j > 0 && i == 0 = attachTails ‘-’ y (opt 0 (j-1))
| otherwise = minimaBy (\a -> costString m mm sp (fst a) (snd a))(
attachTails x y (opt (i-1) (j-1)) ++
attachTails x ‘-’ (opt (i-1) j) ++
attachTails ‘-’ y (opt i (j-1))
)
where
x = xs !! (i-1)
y = ys !! (j-1)

– Task 9: Optimal alignment (fast)
–

– The construction of optimal alignments combined with their cost calculations in a
– single dynamic programming function optimalAlignment” that determines optimal alignments.

optimalAlignment” :: Int -> Int -> Int -> String -> String -> (Int,[(String,String)])
optimalAlignment” m mm sp xs ys = opt (length xs) (length ys)
where
opt i j = optTable !! i !! j
optTable = [[ optEntry i j | j <- [0..]] | i 0 && j == 0 = (fst(opt (i-1) 0) + costChar m mm sp x ‘-’, attachTails x ‘-’ (snd(opt (i-1) 0)))
| j > 0 && i == 0 = (fst(opt 0 (j-1)) + costChar m mm sp ‘-’ y, attachTails ‘-’ y (snd(opt 0 (j-1))))
| otherwise = (\(h:t) -> (fst(h), foldr (\(a,b) c -> b ++ c) [] (h:t)))(minimaBy fst
[(fst(opt (i-1) (j-1)) + costChar m mm sp x y, attachTails x y (snd(opt (i-1) (j-1)))),
(fst(opt (i-1) j) + costChar m mm sp x '-', attachTails x '-' (snd(opt (i-1) j))),
(fst(opt i (j-1)) + costChar m mm sp '-' y, attachTails '-' y (snd(opt i (j-1))))])
where
x = xs !! (i-1)
y = ys !! (j-1)

Map Colouring – Prolog

%Map Colouring %
%Directed Studies – Assignment 2 %
%By: Nicholas Webb. %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%Question 1: adjacency relation among the states.
%
state_list([[qld,nsw],[qld,nt],[qld,sa],[nsw,act],[nsw,vic],[nsw,sa],
[vic,sa],[sa,nt],[sa,wa],[nt,wa]]).

adjacent(S1,S2) :- state_list(L), member([S1,S2],L);
state_list(L), member([S2,S1],L).

%Question 2&3: if given a list of states will return a valid colouring
%using the naive approach of generating a colouring for an entire list
%of states. It also has the following functionality:given a colouring
%(Colouring) that could be a valid colouring, it produces the
%corresponding list of states (States) whose colouring it might be.
%
colour_list([red, yellow, blue, green]).

valid_colouring(States,Colouring) :-
colour_list(Colours), colour_all(States,Colours,Colouring),
\+ conflict(Colouring).

colour_all([],_,[]).
colour_all([State|States],Colours,[[State,Colour]|T]) :-
member(Colour,Colours),
colour_all(States,Colours,T).

conflict(Colouring) :-
member([State1,Colour],Colouring),
member([State2,Colour],Colouring),
adjacent(State1,State2).

%Question 4: smarter map colouring program that is more efficient
%than the naive approach. Here a state is only coloured with a
%colour if it can be shown that none of its neighbors have the colour.
%
smart_colouring(States,Colouring) :-
colour_list(Colours), colour_correct([],States,Colours,Colouring).

colour_correct(_,[],_,[]).
colour_correct(Sofar,[State|States],Colours,[[State,Colour]|Colouring]) :-
member(Colour,Colours),
\+ dontColour(State,Colour,Sofar),
colour_correct([[State,Colour]|Sofar],States,Colours,Colouring).

dontColour(State,Colour,Colouring) :-
adjacent(State, Neighbor),
member([Neighbor,Colour],Colouring).

The Prisoner’s Dilemma and Axelrod’s Tournament – Scheme

;The Prisoner’s Dilemma and Axelrod’s Tournament
;Directed Studies – Assignment 1
;By: Nicholas Webb.

;Limiting the impact of the concrete representations ‘c and ‘d
(define coop ‘c)
(define def ‘d)

;GAME MATRIX

;gmat – Takes the players’ moves and returns their respective scores according to the canonical game matrix.
(define(gmat l)
(cond ((and (eq? (car l) coop) (eq? (cadr l) coop)) ‘(3 3)) ;(c c)
((and (eq? (car l) coop) (eq? (cadr l) def)) ‘(0 5)) ;(c d)
((and (eq? (car l) def) (eq? (cadr l) coop)) ‘(5 0)) ;(d c)
((and (eq? (car l) def) (eq? (cadr l) def)) ‘(1 1)) ;(d d)
)
)

;STRATEGIES

;allDefect – Defects every move.
(define(allDefect l) ((allX def) l))

;allCo-operate – Co-operates every move.
(define(allCo-operate l) ((allX coop) l))

;randomMove – Makes a random decision to defect or co-operate.
(define(randomMove l) (if (= (random 2) 0) coop def))

;majority – Examines the opponent’s history. If the opponent has defected more times than co-operating, then defect, otherwise co-operate.
(define(majority l) (if ( n (length l)) (s1 l) (s2 l))))

;TOURNAMENT

;play – plays two strategies against each other for a given number of rounds for a given game matrix and returns the cumulative score for each player as a list of two elements.
(define(play n m s1 s2) (score m (car (appendHistory n m s1 s2 ‘() ‘())) (cadr (appendHistory n m s1 s2 ‘() ‘()))))

;appendHistory – takes as parameters the players’ move histories. The function builds up the move histories by adding each player’s move (based on the opponent history) to that player’s history and continuing for the specified number of rounds.
(define(appendHistory n m s1 s2 h1 h2)
(if (= n 0) (list h1 h2)
(appendHistory (- n 1) m s1 s2 (cons (s1 h2) h1) (cons (s2 h1) h2))
)
)

;score – takes a game matrix and two move histories and returns the overall score of each player as a two element list.
(define(score m h1 h2)
(foldr (lambda (l1 l2) (map + l1 l2)) ‘(0 0) (map gmat (map list h1 h2))))