Select Git revision
Challenges.hs
Challenges.hs 9.69 KiB
{-# LANGUAGE DeriveGeneric #-}
-- comp2209 Functional Programming Challenges
-- (c) University of Southampton 2020
-- Skeleton code to be updated with your solutions
-- The dummy functions here simply return an arbitrary value that is usually wrong
-- DO NOT MODIFY THE FOLLOWING LINES OF CODE
module Challenges (WordSearchGrid,Placement,Posn,Orientation(..),solveWordSearch, createWordSearch,
LamMacroExpr(..),LamExpr(..),prettyPrint, parseLamMacro,
cpsTransform,innerRedn1,outerRedn1,compareInnerOuter,generatePos) where
-- Import standard library and parsing definitions from Hutton 2016, Chapter 13
-- We import System.Random - make sure that your installation has it installed - use stack ghci and stack ghc
import Data.Char
import Parsing
import Control.Monad
import Data.List
import GHC.Generics (Generic,Generic1)
import Control.DeepSeq
import System.IO
import System.Random
-- types for Part I
type WordSearchGrid = [[ Char ]]
type Placement = (Posn,Orientation)
type Posn = (Int,Int)
data Orientation = Forward | Back | Up | Down | UpForward | UpBack | DownForward | DownBack deriving (Eq,Ord,Show,Read)
-- types for Parts II and III
data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read)
data LamExpr = LamMacro String | LamApp LamExpr LamExpr |
LamAbs Int LamExpr | LamVar Int deriving (Eq,Show,Read)
-- END OF CODE YOU MUST NOT MODIFY
-- ADD YOUR OWN CODE HERE
-- Challenge 1 --
--attempts to find each string in the input list
solveWordSearch :: [ String ] -> WordSearchGrid -> [ (String,Maybe Placement) ]
solveWordSearch ss css = map (findString css) ss
findString :: WordSearchGrid -> String -> (String,Maybe Placement)
findString css s = (s,findLocation css 0 0 s)
--recursively searches grid for first char of word
--returns Nothing or Placement
findLocation :: WordSearchGrid -> Int -> Int -> String -> Maybe Placement
findLocation css x y s@(l:ls) | x > limit && y > limit = Nothing
| x > limit = findLocation css 0 (y+1) s
| (css !! y) !! x == l && result /= Nothing = result
| otherwise = findLocation css (x+1) y s
where
result = findPlacement css x y ls
limit = length css - 1
--checks for hidden word in possible directions
findPlacement :: WordSearchGrid -> Int -> Int -> String -> Maybe Placement
findPlacement css x y s | checkWordDir css (x,y) Forward s = Just ((x,y),Forward)
| checkWordDir css (x,y) Back s = Just ((x,y),Back)
| checkWordDir css (x,y) Up s = Just ((x,y),Up)
| checkWordDir css (x,y) Down s = Just ((x,y),Down)
| checkWordDir css (x,y) UpForward s = Just ((x,y),UpForward)
| checkWordDir css (x,y) UpBack s = Just ((x,y),UpBack)
| checkWordDir css (x,y) DownForward s = Just ((x,y),DownForward)
| checkWordDir css (x,y) DownBack s = Just ((x,y),DownBack)
| otherwise = Nothing
checkWordDir :: WordSearchGrid -> (Int,Int) -> Orientation -> String -> Bool
checkWordDir css (x,y) dir (l:[]) | nextElem css x y dir == Just l = True
| otherwise = False
checkWordDir css (x,y) dir (l:ls) | nextElem css x y dir == Just l = checkWordDir css (nextPos (x,y) dir) dir ls
| otherwise = False
--------------------pattern matching for traversing the grid--------------------
--returns position of movement in a given direction
nextPos :: (Int,Int) -> Orientation -> (Int,Int)
nextPos (x,y) Forward = (x+1,y)
nextPos (x,y) Back = (x-1,y)
nextPos (x,y) Up = (x,y-1)
nextPos (x,y) Down = (x,y+1)
nextPos (x,y) UpForward = (x+1,y-1)
nextPos (x,y) UpBack = (x-1,y-1)
nextPos (x,y) DownForward = (x+1,y+1)
nextPos (x,y) DownBack = (x-1,y+1)
--returns specified adjacent element in grid, relative to given position
nextElem :: [[a]] -> Int -> Int -> Orientation -> Maybe a
nextElem css x y dir | x' < 0 || y' < 0 || x' > length css - 1 || y' > length css - 1 = Nothing
| otherwise = Just ((css !! y') !! x')
where
(x',y') = nextPos (x,y) dir
-- Two examples for you to try out, the first of which is in the instructions
exGrid1'1 = [ "HAGNIRTSH" , "SACAGETAK", "GCSTACKEL","MGHKMILKI","EKNLETGCN","TNIRTLETE","IRAAHCLSR","MAMROSAGD","GIZKDDNRG" ]
exWords1'1 = [ "HASKELL","STRING","STACK","MAIN","METHOD"]
exGrid1'2 = ["ROBREUMBR","AURPEPSAN","UNLALMSEE","YGAUNPYYP","NLMNBGENA","NBLEALEOR","ALRYPBBLG","NREPBEBEP","YGAYAROMR"]
exWords1'2 = [ "BANANA", "ORANGE", "MELON", "RASPBERRY","APPLE","PLUM","GRAPE" ]
-- Challenge 2 --
--internal grid values are either a character or a placeholder for a random letter
data GridVals = Letter Char | Rand
type RandGrid = [[GridVals]]
-- createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
-- createWordSearch ss den = return (createGrid ss dim)
-- where
-- charInInput = sum (map length ss)
-- longestWordLen = max (map length ss)
-- dim = head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen]
-- createGrid :: [String] -> Int -> WordSearchGrid
-- createGrid ss dim = addStrsToGrid tempGrid ss
-- where
-- tempGrid :: RandGrid
-- tempGrid = replicate dim (replicate dim Rand)
-- addStrsToGrid :: RandGrid -> [String] -> RandGrid
-- addStrsToGrid rg (s:ss) = addStrsToGrid newGrid ss
-- where
-- newGrid :: RandGrid
-- newGrid =
-- --takes a grid, string and a position
-- --returns a list of valid orientations for the string at that position
-- validDirs :: RandGrid -> String -> (Int,Int) -> [Orientation]
-- validDirs rg s (x,y) =
-- --checks whether an orientation for a string at a given position
-- --in a grid is valid
-- checkDir :: RandGrid -> String -> (Int,Int) -> Orientation -> Bool-- checkDir rg s (x,y) dir =
-- insertString :: RandGrid -> String -> RandGrid
-- insertString rg s =
-- generatePos :: StdGen -> Int -> IO (Int,Int)
-- generatePos gen dim = do let (x,newGen) = randomR (1,dim) gen :: (Int,StdGen)
-- let (y,_) = randomR (1,dim) newGen :: (Int,StdGen)
-- return (x,y)
-- --- Convenience functions supplied for testing purposes
-- createAndSolve :: [ String ] -> Double -> IO [ (String, Maybe Placement) ]
-- createAndSolve words maxDensity = do g <- createWordSearch words maxDensity
-- let soln = solveWordSearch words g
-- printGrid g
-- return soln
-- printGrid :: WordSearchGrid -> IO ()
-- printGrid [] = return ()
-- printGrid (w:ws) = do putStrLn w
-- printGrid ws
createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
createWordSearch ss den = return []
generatePos :: Int -> StdGen -> IO (Int,Int)
generatePos dim gen = do let (x,newGen) = randomR (1,dim) gen :: (Int,StdGen)
let (y,_) = randomR (1,dim) newGen :: (Int,StdGen)
return (x,y)
-- Challenge 3 --
prettyPrint :: LamMacroExpr -> String
prettyPrint _ = ""
-- examples in the instructions
ex3'1 = LamDef [] (LamApp (LamAbs 1 (LamVar 1)) (LamAbs 1 (LamVar 1)))
ex3'2 = LamDef [] (LamAbs 1 (LamApp (LamVar 1) (LamAbs 1 (LamVar 1))))
ex3'3 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamVar 2) (LamMacro "F")))
ex3'4 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamAbs 1 (LamVar 1)) (LamVar 2)))
-- Challenge 4 --
parseLamMacro :: String -> Maybe LamMacroExpr
parseLamMacro _ = Nothing
-- Challenge 5
cpsTransform :: LamMacroExpr -> LamMacroExpr
cpsTransform _ = LamDef [] (LamVar 0)
-- Examples in the instructions
exId = (LamAbs 1 (LamVar 1))
ex5'1 = LamDef [] (LamApp (LamVar 1) (LamVar 2))
ex5'2 = (LamDef [ ("F", exId) ] (LamVar 2) )
ex5'3 = (LamDef [ ("F", exId) ] (LamMacro "F") )
ex5'4 = (LamDef [ ("F", exId) ] (LamApp (LamMacro "F") (LamMacro "F")))
-- Challenge 6
innerRedn1 :: LamMacroExpr -> Maybe LamMacroExpr
innerRedn1 _ = Nothing
outerRedn1 :: LamMacroExpr -> Maybe LamMacroExprouterRedn1 _ = Nothing
compareInnerOuter :: LamMacroExpr -> Int -> (Maybe Int,Maybe Int,Maybe Int,Maybe Int)
compareInnerOuter _ _ = (Nothing,Nothing,Nothing,Nothing)
-- Examples in the instructions
-- (\x1 -> x1 x2)
ex6'1 = LamDef [] (LamAbs 1 (LamApp (LamVar 1) (LamVar 2)))
-- def F = \x1 -> x1 in F
ex6'2 = LamDef [ ("F",exId) ] (LamMacro "F")
-- (\x1 -> x1) (\x2 -> x2)
ex6'3 = LamDef [] ( LamApp exId (LamAbs 2 (LamVar 2)))
-- (\x1 -> x1 x1)(\x1 -> x1 x1)
wExp = (LamAbs 1 (LamApp (LamVar 1) (LamVar 1)))
ex6'4 = LamDef [] (LamApp wExp wExp)
-- def ID = \x1 -> x1 in def FST = (\x1 -> λx2 -> x1) in FST x3 (ID x4)
ex6'5 = LamDef [ ("ID",exId) , ("FST",LamAbs 1 (LamAbs 2 (LamVar 1))) ] ( LamApp (LamApp (LamMacro "FST") (LamVar 3)) (LamApp (LamMacro "ID") (LamVar 4)))
-- def FST = (\x1 -> λx2 -> x1) in FST x3 ((\x1 ->x1) x4))
ex6'6 = LamDef [ ("FST", LamAbs 1 (LamAbs 2 (LamVar 1)) ) ] ( LamApp (LamApp (LamMacro "FST") (LamVar 3)) (LamApp (exId) (LamVar 4)))
-- def ID = \x1 -> x1 in def SND = (\x1 -> λx2 -> x2) in SND ((\x1 -> x1 x1 ) (\x1 -> x1 x1)) ID
ex6'7 = LamDef [ ("ID",exId) , ("SND",LamAbs 1 (LamAbs 2 (LamVar 2))) ] (LamApp (LamApp (LamMacro "SND") (LamApp wExp wExp) ) (LamMacro "ID") )