Skip to content

Commit 14b3bda

Browse files
leynierleynier
committed
Merge branch 'leynier' into main
2 parents c22fdc2 + 7a7b07a commit 14b3bda

File tree

2 files changed

+71
-47
lines changed

2 files changed

+71
-47
lines changed

‎algorithms/algorithms.hs

Lines changed: 22 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -5,22 +5,27 @@ module Algorithms
55
) where
66

77
import Structures
8-
8+
import Data.Set (Set, lookupMin, lookupMax)
9+
import qualified Data.Set as Set
10+
import Debug.Trace
11+
import Data.Map (Map)
12+
import qualified Data.Map as Map
913

1014
generate :: Matrix
11-
generate = read "{7 . . \n x . x \n . . 1}" :: Matrix
15+
generate = read "{. x x x x x x x x \n . 8 x x x x x x x \n . . 11 x x x x x x \n 29 . 10 . x x x x x \n 30 . . . . x x x x \n . 31 1 38 . . x x x \n . 32 . . 39 41 . x x \n . . . 22 . . 42 . x \n . . . . . . . 44 45}" :: Matrix
1216

13-
stepMatrix :: Int -> Matrix -> Cell -> [(Matrix, Cell)]
14-
stepMatrix step m prevCell = if null pCells
17+
stepMatrix :: Int -> Matrix -> Cell -> Map Int Cell -> [(Matrix, Cell)]
18+
stepMatrix step m@(Matrix rs cs ma) prevCell map = if Map.notMember step map
1519
then [
16-
(editMatrixCell m actCell, actCell) | cell <- matrix m,
17-
let actCell = Cell (row cell) (column cell) step,
18-
isAdjacent cell prevCell,
19-
value cell == 0
20+
(Matrix rs cs (Set.insert cell ma), cell) | cell <- getAdjacents prevCell rs cs step,
21+
let actCell = Set.elemAt (Set.findIndex cell $ ma) ma,
22+
value actCell == 0
2023
]
21-
else let (actCell : _) = pCells
24+
else let actCell = map Map.! step
2225
in [(m, actCell) | isAdjacent actCell prevCell || value actCell == 1]
23-
where pCells = findCellByValue m step
26+
27+
buildMap :: Matrix -> Map Int Cell
28+
buildMap ma@(Matrix r c m) = Set.foldl (\acc cell -> Map.insert (value cell) cell acc) Map.empty m
2429

2530
-- solveRecursiveBFS :: [(Matrix, Int)] -> [Matrix]
2631
-- solveRecursiveBFS [] = []
@@ -30,16 +35,16 @@ stepMatrix step m prevCell = if null pCells
3035
-- | matrix <- stepMatrix step actualMatrix]
3136
-- in solveRecursiveBFS (queue ++ toAdd)
3237

33-
solveRecursiveDFS :: Matrix -> Int -> Cell -> [Matrix]
34-
solveRecursiveDFS actualMatrix step prevCell
35-
| isFinalMatrix actualMatrix = [actualMatrix]
36-
| otherwise = let toAdd = stepMatrix step actualMatrix prevCell
37-
in concat [ solveRecursiveDFS matrix (step + 1) prevCell | (matrix, prevCell) <- toAdd ]
38+
solveRecursiveDFS :: Matrix -> Int -> Cell -> Int -> Map Int Cell -> [Matrix]
39+
solveRecursiveDFS actualMatrix step prevCell obs map
40+
| step == obs + 1 = [actualMatrix]
41+
| otherwise = let toAdd = stepMatrix step actualMatrix prevCell map
42+
in concat [ solveRecursiveDFS matrix (step + 1) prevCell obs map | (matrix, prevCell) <- toAdd ]
3843

3944
solveAll :: Matrix -> [Matrix]
40-
solveAll m = solveRecursiveDFS m 1 (Cell 0 0 0)
45+
solveAll m = solveRecursiveDFS m 1 (Cell 0 0 0) ((rows m) * (columns m) - countObstacles m) $ buildMap m
4146

4247
solve :: Matrix -> Matrix
43-
solve m = let solves = solveRecursiveDFS m 1 (Cell 0 0 0)
48+
solve m = let solves = solveAll m
4449
in case solves of [] -> error "Solve not found"
4550
(x: xs) -> x

‎structures/structures.hs

Lines changed: 49 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -9,10 +9,13 @@ module Structures
99
, isFinalMatrix
1010
, editMatrixCell
1111
, findCellByValue
12+
, getAdjacents
1213
) where
1314

1415
import Data.Char (isDigit)
1516
import Data.List
17+
import Data.Set (Set, lookupMin, lookupMax)
18+
import qualified Data.Set as Set
1619

1720
data Cell = Cell { row :: Int
1821
, column :: Int
@@ -33,20 +36,23 @@ instance Show Cell where
3336

3437
instance Read Cell where
3538
readsPrec _ input =
36-
let (opar:rest1) = input
39+
let (opar : rest1) = input
3740
(rows, rest2) = span isDigit rest1
3841
(comma1:rest3) = rest2
3942
(columns, rest4) = span isDigit rest3
40-
(comma2:rest5) = rest4
43+
(comma2 : rest5) = rest4
4144
(values, rest6) = span isDigit rest5
42-
(cpar:rest7) = rest6
45+
(cpar : rest7) = rest6
4346
row = read rows :: Int
4447
column = read columns :: Int
4548
value = read values :: Int
4649
in
4750
[(Cell row column value, rest7) |
4851
opar == '(' && comma1 == comma2 && comma2 == ',' && cpar == ')']
4952

53+
getAdjacents :: Cell -> Int -> Int -> Int -> [Cell]
54+
getAdjacents (Cell r c v) rs cs s = [Cell nr nc s | dr <- [-1, 0, 1], dc <- [-1, 0, 1], let (nr, nc) = (r + dr, c + dc), nr > 0, nr <= rs, nc > 0, nc <= cs]
55+
5056
isAdjacent :: Cell -> Cell -> Bool
5157
isAdjacent (Cell f1 c1 v1) (Cell f2 c2 v2)
5258
| Cell f1 c1 v1 == Cell f2 c2 v2 = False
@@ -63,21 +69,34 @@ getCellChar (Cell _ _ value) size
6369
valueStr = show value
6470
lenValueStr = length $ show value
6571

72+
cellEqual :: Cell -> Cell -> Bool
73+
cellEqual x y = row x == row y && column x == column y && value x == value y
74+
75+
cellEquals' :: [Cell] -> [Cell] -> Bool -> Bool
76+
callEquals' _ _ False = False
77+
cellEquals' [] [] x = x && True
78+
cellEquals' _ [] _ = False
79+
cellEquals' [] _ _ = False
80+
cellEquals' (x:xs) (y:ys) b = cellEquals' xs ys (cellEqual x y)
81+
82+
cellEquals :: [Cell] -> [Cell] -> Bool
83+
cellEquals xs ys = cellEquals' xs ys True
84+
6685
data Matrix = Matrix { rows :: Int
6786
, columns :: Int
68-
, matrix :: [Cell]
87+
, matrix :: Set Cell
6988
}
7089

7190
instance Eq Matrix where
72-
m1 == m2 = rows m1 == rows m2 && columns m1 == columns m2 && sort (matrix m1) == sort (matrix m2)
91+
m1 == m2 = rows m1 == rows m2 && columns m1 == columns m2 && cellEquals (Set.elems $ matrix m1) (Set.elems $ matrix m2)
7392

7493
showMatrixRow :: [Cell] -> Int -> String
7594
showMatrixRow rowCells size = unwords [getCellChar cell size | cell <- rowCells ]
7695

7796
instance Show Matrix where
78-
show m = "{" ++ intercalate "\n " [ showMatrixRow (sort (filter (\(Cell crow _ _) -> crow == row) (matrix m))) maxSize |
97+
show m = "{" ++ intercalate "\n " [ showMatrixRow (sort (filter (\(Cell crow _ _) -> crow == row) (Set.elems $ matrix m))) maxSize |
7998
row <- [1..(rows m)]] ++ "}\n" where
80-
maxSize = maximum [length (getCellChar cell 0) | cell <- matrix m]
99+
maxSize = maximum [length (getCellChar cell 0) | cell <- Set.elems $ matrix m]
81100

82101
parseMatrixCell :: String -> (Int, String)
83102
parseMatrixCell "" = (-2, "")
@@ -88,23 +107,23 @@ parseMatrixCell (s:rest)
88107
| s == 'x' = (-1, rest)
89108
| otherwise = (-2, s:rest)
90109

91-
parseMatrixRowRecursive :: Int -> Int -> String -> ([Cell], String)
110+
parseMatrixRowRecursive :: Int -> Int -> String -> (Set Cell, String)
92111
parseMatrixRowRecursive rowNum columnNum input =
93112
let (_, rinput) = span (' '==) input
94113
(value, rest1) = parseMatrixCell rinput
95-
in if value == -2 then ([], rest1) else
96-
let (parsedCells, frest) = parseMatrixRowRecursive rowNum (columnNum+1) rest1
114+
in if value == -2 then (Set.empty, rest1) else
115+
let (parsedCells, frest) = parseMatrixRowRecursive rowNum (columnNum + 1) rest1
97116
parsedCell = Cell rowNum columnNum value
98-
in (parsedCell:parsedCells, frest)
117+
in (Set.insert parsedCell parsedCells, frest)
99118

100119
parseMatrixRow rowNum = parseMatrixRowRecursive rowNum 1
101120

102-
parseMatrixRecursive :: Int -> String -> ([Cell], String)
121+
parseMatrixRecursive :: Int -> String -> (Set Cell, String)
103122
parseMatrixRecursive rowNum (s:rest)
104123
| (s == '{' && rowNum == 1) || s == '\n' = let (parsedRow, rest1) = parseMatrixRow rowNum rest
105-
(parsedRows, rest2) = parseMatrixRecursive (rowNum+1) rest1
106-
in (parsedRow ++ parsedRows, rest2)
107-
| s == '}' = ([], rest)
124+
(parsedRows, rest2) = parseMatrixRecursive (rowNum + 1) rest1
125+
in (Set.union parsedRow parsedRows, rest2)
126+
| s == '}' = (Set.empty, rest)
108127

109128
parseMatrix = parseMatrixRecursive 1
110129

@@ -124,29 +143,29 @@ isValidMatrix m = let allCells = length (matrix m) == rows m * columns m
124143
(matrix m)
125144
in correctValues && allCells
126145

127-
isFinalMatrix :: Matrix -> Bool
128-
isFinalMatrix (Matrix rows columns cells)
129-
| or [ value cell == 0 | cell <- cells ] = False
130-
| not (and [ countInMatrix val (Matrix rows columns cells) == 1
131-
| val <- [1..(rows * columns - countObstacles (Matrix rows columns cells))]
132-
]) = False
133-
| not (and [ or [ value cell1 + 1 == value cell2 | cell2 <- cells, isAdjacent cell1 cell2 ]
134-
| cell1 <- cells,
146+
isFinalMatrix :: Matrix -> Int -> Int -> Bool
147+
isFinalMatrix m@(Matrix rows columns cells) step obs
148+
| step < notObs = False
149+
| or [ value cell == 0 | cell <- Set.elems cells ] = False
150+
| not (and [ countInMatrix val m == 1 | val <- [1..notObs] ]) = False
151+
| not (and [ or [ value cell1 + 1 == value cell2 | cell2 <- Set.elems cells, isAdjacent cell1 cell2 ]
152+
| cell1 <- Set.elems cells,
135153
value cell1 /= fvalue,
136154
value cell1 /= (-1) ]) = False
137-
| otherwise = True
138-
where fvalue = maximum [value cell | cell <- cells]
155+
| otherwise = True
156+
where fvalue = maximum [value cell | cell <- Set.elems cells]
157+
notObs = rows * columns - obs
139158

140159
instance Read Matrix where
141160
readsPrec _ input =
142161
let (matrixCells, rest) = parseMatrix input
143-
rowNum = maximum [ row cell | cell <- matrixCells ]
144-
columnNum = maximum [ column cell | cell <- matrixCells ]
162+
rowNum = maximum [ row cell | cell <- Set.elems matrixCells ]
163+
columnNum = maximum [ column cell | cell <- Set.elems matrixCells ]
145164
theMatrix = Matrix rowNum columnNum matrixCells
146165
in [(theMatrix, rest) | isValidMatrix theMatrix]
147166

148167
editMatrixCell :: Matrix -> Cell -> Matrix
149-
editMatrixCell (Matrix r c cells) newCell = Matrix r c [ if cell == newCell then newCell else cell | cell <- cells ]
168+
editMatrixCell (Matrix r c cells) newCell = Matrix r c (Set.fromList ([ if cell == newCell then newCell else cell | cell <- Set.elems cells ]) :: Set Cell )
150169

151-
findCellByValue :: Matrix -> Int -> [Cell]
152-
findCellByValue m val = [ cell | cell <- matrix m, value cell == val ]
170+
findCellByValue :: Matrix -> Int -> Set Cell
171+
findCellByValue m val = Set.filter (\cell -> value cell == val) $ matrix m

0 commit comments

Comments
 (0)