From 6816f5827638e03a47c7c557bc6971c2f5ed1cbf Mon Sep 17 00:00:00 2001
From: ik1g19 <ik1g19@soton.ac.uk>
Date: Fri, 1 Jan 2021 02:15:25 +0000
Subject: [PATCH] started part 2
---
cw/src/Challenges.hs | 83 +++++++++++++++++++++++++++-----------------
1 file changed, 52 insertions(+), 31 deletions(-)
diff --git a/cw/src/Challenges.hs b/cw/src/Challenges.hs
index d4a8261..a551d7c 100644
--- a/cw/src/Challenges.hs
+++ b/cw/src/Challenges.hs
@@ -38,6 +38,7 @@ data LamExpr = LamMacro String | LamApp LamExpr LamExpr |
-- Challenge 1 --
+
solveWordSearch :: [ String ] -> WordSearchGrid -> [ (String,Maybe Placement) ]
solveWordSearch ss css = map (findString css) ss
@@ -94,48 +95,58 @@ nextPos DownBack (x,y) = (x-1,y+1)
elemAt :: [[a]] -> Posn -> a
-elemAt ass (x,y) = (ass !! y) !! x --ass means list of list of a's, not associated with any other meaning
-
+elemAt ass (x,y) = (ass !! y) !! x --ass means list of list of a's,
+ --not associated with any other meaning
--returns specified adjacent element in grid, relative to given position
nextElem :: [[a]] -> Posn -> Orientation -> Maybe a
-nextElem css (x,y) dir | x' < 0 || y' < 0 || x' > length css - 1 || y' > length css - 1 = Nothing
- | otherwise = Just (elemAt css (x',y'))
+nextElem css (x,y) dir | x' < 0 || y' < 0 ||
+ x' > length css - 1 || y' > length css - 1 = Nothing
+ | otherwise = Just (elemAt css (x',y'))
where
(x',y') = nextPos dir (x,y)
-- 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" ]
+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" ]
+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 GridVal = Letter Char | Rand deriving Eq
type RandGrid = [[GridVal]]
+
createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
-createWordSearch ss den = do gen <- newStdGen --initial generator
+createWordSearch ss den = do gen <- newStdGen --initial generator
return (createGrid dim gen ss)
where
charInInput = fromIntegral $ sum $ map length ss :: Double
longestWordLen = fromIntegral $ foldl1 max $ map length ss :: Double
- dim = floor $ head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen] --calculates needed dimension of grid according to the density
+ dim = floor $ head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen] --calculates needed dimension of grid according to the density
createGrid :: Int -> StdGen -> [String] -> WordSearchGrid
createGrid dim gen ss = randToWord (charsFromStrs ss) gen' finalGrid
where
- tempGrid = replicate dim (replicate dim Rand) --fills grid with random values
- (finalGrid,gen') = addStrsToGrid tempGrid gen ss --final grid after all strings added
+ tempGrid = replicate dim (replicate dim Rand) --fills grid with random values
+ (finalGrid,gen') = addStrsToGrid tempGrid gen ss --final grid after all strings added
- charsFromStrs = rmdups . concat --list of chars used in given strings
+ charsFromStrs = rmdups . concat --list of chars used in given strings
--removes duplicates from a list
--code from https://stackoverflow.com/a/16109302/10218833
@@ -200,8 +211,8 @@ checkDir rg s (x,y) dir | let (x',y') = posns !! (length s - 1),
--returns new grid and new generator
insertString :: RandGrid -> String -> StdGen -> (RandGrid,StdGen)
insertString rg s gen | elemAt rg (x,y) /= Rand &&
- elemAt rg (x,y) /= Letter (head s) = insertString rg s newGen --guard:if position is invalid, generate new position
- | length vDirs == 0 = insertString rg s newGen --guard:if no valid orientations exist, generate new position
+ elemAt rg (x,y) /= Letter (head s) = insertString rg s newGen --guard:if position is invalid, generate new position
+ | length vDirs == 0 = insertString rg s newGen --guard:if no valid orientations exist, generate new position
| otherwise = (addToGrid randomDir s rg (x,y),newGen)
where
( (x,y),newGen ) = generatePos gen (length rg)
@@ -238,6 +249,7 @@ generatePos gen dim = let (x,gen') = randomR (0,dim - 1) gen :: (Int,StdGen)
in ((x,y),gen'')
+
--- Convenience functions supplied for testing purposes
createAndSolve :: [ String ] -> Double -> IO [ (String, Maybe Placement) ]
createAndSolve words maxDensity = do g <- createWordSearch words maxDensity
@@ -250,31 +262,40 @@ 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 --
+
--- generatePos :: StdGen -> Int -> (Int,Int)
--- generatePos gen dim = let (x,gen') = randomR (1,dim) gen :: (Int,StdGen)
--- (y,gen'') = randomR (1,dim) gen' :: (Int,StdGen)
--- in (x,y)
+-- 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)
+prettyPrint :: LamMacroExpr -> String
+prettyPrint (LamDef ms expr) = exprBrackets expr
--- Challenge 3 --
+--applies brackets to expr if needed
+exprBrackets :: LamExpr -> String
+exprBrackets expr | parseExpr str == expr = str --omit brackets
+ | otherwise = "(" + str ++ ")" --include brackets
+ where
+ str = exprToStr expr
+
+
+--converts expr to string
+exprToStr :: LamExpr -> String
+exprToStr (LamApp expr1 expr2) = exprBrackets expr1 ++ " " ++ exprBrackets expr2
+exprToStr (LamAbs x expr) = "\\x" ++ show x ++ " -> " ++ exprBrackets expr
+exprToStr (LamVar x) = "x" ++ show x
+exprToStr (LamMacro m) = m
+
-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)))
+ex3'1 = LamDef [] (LamApp (LamAbs 1 (LamVar 1)) (LamAbs 1 (LamVar 1))) --"(\x1 -> x1) \x1 -> x1"
+ex3'2 = LamDef [] (LamAbs 1 (LamApp (LamVar 1) (LamAbs 1 (LamVar 1)))) --"\x1 -> x1 \x1 -> x1"
+ex3'3 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamVar 2) (LamMacro "F"))) --"def F = \x1-> x1 in \x2 -> x2 F"
+ex3'4 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamAbs 1 (LamVar 1)) (LamVar 2))) --"def F = \x1-> x1 in \x2-> F x2"
-- Challenge 4 --
--
GitLab