From a3612da44e7f9e03a98fc3e07eb7816145b12d45 Mon Sep 17 00:00:00 2001 From: ik1g19 <ik1g19@soton.ac.uk> Date: Tue, 29 Dec 2020 23:21:08 +0000 Subject: [PATCH] first version challenge 2 finished --- cw/src/Challenges.hs | 96 +++++++++++++++++++++++++++++++------------- 1 file changed, 69 insertions(+), 27 deletions(-) diff --git a/cw/src/Challenges.hs b/cw/src/Challenges.hs index 1948480..bfbae43 100644 --- a/cw/src/Challenges.hs +++ b/cw/src/Challenges.hs @@ -48,7 +48,7 @@ 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 :: WordSearchGrid -> Posn -> 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 @@ -59,7 +59,7 @@ findLocation css (x,y) s@(l:ls) | x > limit && y > limit = N --checks for hidden word in possible directions -findPlacement :: WordSearchGrid -> (Int,Int) -> String -> Maybe Placement +findPlacement :: WordSearchGrid -> Posn -> 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) @@ -71,7 +71,7 @@ findPlacement css (x,y) s | checkWordDir css (x,y) Forward s = Just (( | otherwise = Nothing -checkWordDir :: WordSearchGrid -> (Int,Int) -> Orientation -> String -> Bool +checkWordDir :: WordSearchGrid -> Posn -> 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 dir (x,y)) dir ls @@ -82,7 +82,7 @@ checkWordDir css (x,y) dir (l:ls) | nextElem css (x,y) dir == Just l = checkWo --------------------pattern matching for traversing the grid-------------------- --returns position of movement in a given direction -nextPos :: Orientation -> (Int,Int) -> (Int,Int) +nextPos :: Orientation -> Posn -> Posn nextPos Forward (x,y) = (x+1,y) nextPos Back (x,y) = (x-1,y) nextPos Up (x,y) = (x,y-1) @@ -93,12 +93,12 @@ nextPos DownForward (x,y) = (x+1,y+1) nextPos DownBack (x,y) = (x-1,y+1) -elemAt :: [[a]] -> (Int,Int) -> a +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 --returns specified adjacent element in grid, relative to given position -nextElem :: [[a]] -> (Int,Int) -> Orientation -> Maybe a +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')) where @@ -117,8 +117,8 @@ 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]] +data GridVal = Letter Char | Rand +type RandGrid = [[GridVal]] createWordSearch :: [ String ] -> Double -> IO WordSearchGrid createWordSearch ss den = do gen <- getStdGen --initial generator @@ -129,30 +129,71 @@ createWordSearch ss den = do gen <- getStdGen dim = head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen] --calculates needed dimension of grid according to the density -createGrid :: [String] -> Int -> StdGen -> WordSearchGrid -createGrid ss dim gen = addStrsToGrid tempGrid ss gen +createGrid :: Int -> StdGen -> [String] -> WordSearchGrid +createGrid dim gen ss = randToWord finalGrid (charsFromStrs ss) gen' where - tempGrid :: RandGrid - tempGrid = replicate dim (replicate dim Rand) --fills grid with random values + 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 + +--removes duplicates from a list +--code from https://stackoverflow.com/a/16109302/10218833 +rmdups :: (Ord a) => [a] -> [a] +rmdups = map head . group . sort + + +-- --converts RandGrid to WordSearchGrid +-- --replaces placeholder random values with actual random values +-- randToWord :: RandGrid -> [Char] -> StdGen -> WordSearchGrid +-- randToWord rg cs gen = +-- where +-- charStream :: [Char] +-- charStream = map (cs!!) $ randomRs (0,length cs - 1) g + +-- replaceRands = map (\Rand -> head charStream) + +randToWord :: [Char] -> StdGen -> RandGrid -> WordSearchGrid +randToWord cs gen [] = [] +randToWord cs gen (row:rs) = let (newRow,newGen) = rowConvert cs gen row + in newRow : randToWord cs newGen + +rowConvert :: [Char] -> StdGen -> [GridVal] -> ([Char],StdGen) +rowConvert cs gen [] = ([],gen) +rowConvert cs gen (Letter x:xs) = let (rows,gen') = rowConvert cs gen xs + in (x : rows,gen') +rowConvert cs gen (Rand:xs) = let (rows,gen') = rowConvert cs newGen xs + in (randChar : rows,gen') + where + (index,newGen) = randomR (0,length cs - 1) gen + randChar = cs !! index --adds list of strings to given grid one by one -addStrsToGrid :: RandGrid -> [String] -> StdGen -> RandGrid -addStrsToGrid rg (s:ss) gen = addStrsToGrid newGrid ss newGen +addStrsToGrid :: RandGrid -> StdGen -> [String] -> (RandGrid,StdGen) +addStrsToGrid rg gen (s:[]) = (newGrid,newGen) +addStrsToGrid rg gen (s:ss) = addStrsToGrid newGrid newGen ss 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 = +validDirs :: RandGrid -> String -> Posn -> [Orientation] +validDirs rg s (x,y) = map fst $ filter ( \(_,b) -> b == True ) (zip dirs (map ( checkDir rg s (x,y) ) dirs) ) + where dirs = [Forward,Back,Up,Down,UpForward,UpBack,DownForward,DownBack] + + +--checks whether an orientation for a string at a given position in a grid is valid +checkDir :: RandGrid -> String -> Posn -> Orientation -> Bool +checkDir rg s (x,y) dir | let (x',y') = posns !! length s - 1, + x' < 0 || x' > length rg - 1 || + y' < 0 || y' > length rg - 1 = False + | foldl (&&) True (map (\(a,b) -> Letter a == b || b == Rand) $ zip s lettersGrid) = True + | otherwise = False + where + posns = iterate (nextPos dir) (x,y) + lettersGrid = take (length s) $ map (elemAt rg) posns --adds an individual string to a given grid @@ -161,12 +202,13 @@ 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 - | otherwise = + | otherwise = (addToGrid randomDir s rg (x,y),newGen) where - ((x,y),newGen) = generatePos gen (length rg) + ( (x,y),newGen ) = generatePos gen (length rg) vDirs = validDirs rg s (x,y) + (randomDir,_) = vDirs !! randomR (0,length vDirs - 1) gen :: (Int,StdGen) - addToGrid :: Orientation -> String -> RandGrid -> (Int,Int) -> RandGrid + addToGrid :: Orientation -> String -> RandGrid -> Posn -> RandGrid addToGrid dir (c:[]) rg (x',y') = insertAt2D (Letter c) (x',y') rg addToGrid dir (c:cs) rg (x',y') = addToGrid dir cs charAdded (nextPos dir (x',y')) where @@ -183,13 +225,13 @@ insertAt2D newElement (x,y) grid | y == 0 = insertAt newElement x where (aboveRows,belowRows) = splitAt y grid ---using code from https://stackoverflow.com/questions/43291442/haskell-insert-an-element-on-nth-position +--using code from https://stackoverflow.com/a/43291593/10218833 insertAt :: a -> Int -> [a] -> [a] insertAt newElement 0 as = newElement : drop 1 as insertAt newElement i (a:as) = a : insertAt newElement (i - 1) as -generatePos :: StdGen -> Int -> ((Int,Int),StdGen) +generatePos :: StdGen -> Int -> (Posn,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'') -- GitLab