Skip to content
Snippets Groups Projects
Commit a3612da4 authored by ik1g19's avatar ik1g19
Browse files

first version challenge 2 finished

parent 862e37b2
No related branches found
No related tags found
No related merge requests found
......@@ -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
(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) =
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 -> (Int,Int) -> Orientation -> Bool
checkDir rg s (x,y) dir =
--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)
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'')
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment