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