From 5a07d324c06d06a315d0bbfa3f4fb1dbe64ecca3 Mon Sep 17 00:00:00 2001
From: ik1g19 <ik1g19@soton.ac.uk>
Date: Mon, 28 Dec 2020 15:55:36 +0000
Subject: [PATCH] progress on challenge 2, added elemAt to challenge 1
---
cw/src/Challenges.hs | 188 +++++++++++++++++++++++++------------------
1 file changed, 109 insertions(+), 79 deletions(-)
diff --git a/cw/src/Challenges.hs b/cw/src/Challenges.hs
index 03e238f..d4e76a6 100644
--- a/cw/src/Challenges.hs
+++ b/cw/src/Challenges.hs
@@ -38,41 +38,45 @@ data LamExpr = LamMacro String | LamApp LamExpr LamExpr |
-- 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)
+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
+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
+ | elemAt css (x,y) == 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
+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
+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--------------------
@@ -88,10 +92,15 @@ nextPos (x,y) UpBack = (x-1,y-1)
nextPos (x,y) DownForward = (x+1,y+1)
nextPos (x,y) DownBack = (x-1,y+1)
+
+elemAt :: [[a]] -> (Int,Int) -> a
+elemAt ass (x,y) = (ass !! y) !! x --ass means list of list of a's, not associated with other meaning
+
+
--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')
+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 (elemAt css (x',y'))
where
(x',y') = nextPos (x,y) dir
@@ -111,63 +120,84 @@ exWords1'2 = [ "BANANA", "ORANGE", "MELON", "RASPBERRY","APPLE","PLUM","GRAPE" ]
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)
+createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
+createWordSearch ss den = do gen <- getStdGen --initial generator
+ return (createGrid ss dim gen)
+ where
+ charInInput = sum (map length ss)
+ longestWordLen = max (map length ss)
+ dim = head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen] --calculates needed dimension of grid according
+ --to the density
--- --- 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
+createGrid :: [String] -> Int -> StdGen -> WordSearchGrid
+createGrid ss dim gen = addStrsToGrid tempGrid ss gen
+ where
+ tempGrid :: RandGrid
+ tempGrid = replicate dim (replicate dim Rand) --fills grid with random values
--- printGrid :: WordSearchGrid -> IO ()
--- printGrid [] = return ()
--- printGrid (w:ws) = do putStrLn w
--- printGrid ws
-createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
-createWordSearch ss den = return []
+--adds list of strings to given grid one by one
+addStrsToGrid :: RandGrid -> [String] -> StdGen -> RandGrid
+addStrsToGrid rg (s:ss) gen = addStrsToGrid newGrid ss newGen
+ where
+ (newGrid,newGen) = insertString rg s gen
+
+
+--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 =
+
+
+--adds an individual string to a given grid
+--returns new grid and new generator
+insertString :: RandGrid -> String -> StdGen -> (RandGrid,StdGen)
+insertString rg s gen |
+ | length vDirs == 0 = insertString rg s newGen
+ |
+ where
+ ((x,y),newGen) = generatePos gen (length rg)
+ vDirs = validDirs rg s (x,y)
+
+
+
+generatePos :: StdGen -> Int -> ((Int,Int),StdGen)
+generatePos gen dim = let (x,gen') = randomR (1,dim) gen :: (Int,StdGen)
+ (y,gen'') = randomR (1,dim) 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
+ 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)
-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)
+-- 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)
--
GitLab