first version challenge 2 finished

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
+      (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'')