Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
P
prog3-coursework
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Deploy
Releases
Package registry
Model registry
Operate
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
GitLab community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
ik1g19
prog3-coursework
Commits
a3612da4
Commit
a3612da4
authored
4 years ago
by
ik1g19
Browse files
Options
Downloads
Patches
Plain Diff
first version challenge 2 finished
parent
862e37b2
No related branches found
No related tags found
No related merge requests found
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
cw/src/Challenges.hs
+69
-27
69 additions, 27 deletions
cw/src/Challenges.hs
with
69 additions
and
27 deletions
cw/src/Challenges.hs
+
69
−
27
View file @
a3612da4
...
...
@@ -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
GridVal
s
=
Letter
Char
|
Rand
type
RandGrid
=
[[
GridVal
s
]]
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''
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment