incremental
This commit is contained in:
@@ -1,11 +1,11 @@
|
||||
module Main (main) where
|
||||
|
||||
import PolyCube
|
||||
import Children
|
||||
import Text.Read (readMaybe)
|
||||
import System.Exit ( ExitCode(ExitFailure), exitWith )
|
||||
import System.Environment (getArgs)
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import Combinatorics
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@@ -34,41 +34,7 @@ evaluateChildren :: Int -> PolyCube -> Map.HashMap [Offset3D] (Int, [Coord3D]) -
|
||||
evaluateChildren maxSize polycube = loop (getChildren (maxSize - size polycube) polycube) where
|
||||
loop :: [PolyCube] -> Map.HashMap [Offset3D] (Int, [Coord3D]) -> Map.HashMap [Offset3D] (Int, [Coord3D])
|
||||
loop [] d = d
|
||||
loop ((PolyCube o la s):pcs) d = if any (flip Map.member d . getOffsets) o
|
||||
loop ((PolyCube o la s):pcs) d = if any (\x -> Map.member (getOffsets x) d) o
|
||||
then loop pcs d
|
||||
else loop pcs $ evaluateChildren maxSize (PolyCube o la s) $ Map.insert (getOffsets $ head o) (s, head o) d
|
||||
|
||||
getChildren :: Int -> PolyCube -> [PolyCube]
|
||||
getChildren 0 _ = []
|
||||
getChildren i (PolyCube o la s) = foldr condGrowth [] $ foldr (\x acc -> tuples x possibleGrowth ++ acc) [] [1..i] where
|
||||
condGrowth :: [Coord3D] -> [PolyCube] -> [PolyCube]
|
||||
condGrowth gs ps = if any (\x -> elem x $ head o) gs
|
||||
then ps
|
||||
else PolyCube (zipWith (\x n -> insertAllSorted x $ rotateCubes gs n) o [1..24]) gs (s + length gs) : ps
|
||||
transformations :: [Offset3D]
|
||||
transformations = [
|
||||
Offset3D (-1, 0, 0),
|
||||
Offset3D (0, -1, 0),
|
||||
Offset3D (0, 0, -1),
|
||||
Offset3D (1, 0, 0),
|
||||
Offset3D (0, 1, 0),
|
||||
Offset3D (0, 0, 1)]
|
||||
applyTransformations :: Coord3D -> [Offset3D] -> [Coord3D]
|
||||
applyTransformations _ [] = []
|
||||
applyTransformations p (x:xs) = applyOffset p x:applyTransformations p xs
|
||||
possibleGrowth :: [Coord3D]
|
||||
possibleGrowth = foldr (\x acc -> insertAllSorted acc (applyTransformations x transformations)) [] la
|
||||
|
||||
insertAllSorted :: (Ord a) => [a] -> [a] -> [a]
|
||||
insertAllSorted [] [] = []
|
||||
insertAllSorted [] [v] = [v]
|
||||
insertAllSorted xs [] = xs
|
||||
insertAllSorted xs (y:ys) = insertAllSorted (insertSorted xs y) ys
|
||||
|
||||
insertSorted :: (Ord a) => [a] -> a -> [a]
|
||||
insertSorted [] v = [v]
|
||||
insertSorted (x:xs) v
|
||||
| v < x = v:x:xs
|
||||
| v > x = x:insertSorted xs v
|
||||
| otherwise = x:xs
|
||||
|
||||
|
||||
@@ -1 +1 @@
|
||||
[1,1,2,8,25]
|
||||
[1,1,2,8,25,136,728]
|
||||
|
||||
@@ -37,6 +37,7 @@ library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
- hashable
|
||||
- combinatorial
|
||||
|
||||
executables:
|
||||
pcc-haskell-exe:
|
||||
@@ -49,7 +50,6 @@ executables:
|
||||
dependencies:
|
||||
- pcc-haskell
|
||||
- unordered-containers
|
||||
- combinatorial
|
||||
|
||||
tests:
|
||||
pcc-haskell-test:
|
||||
|
||||
@@ -25,6 +25,7 @@ source-repository head
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Children
|
||||
PolyCube
|
||||
other-modules:
|
||||
Paths_pcc_haskell
|
||||
@@ -35,6 +36,7 @@ library
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, combinatorial
|
||||
, hashable
|
||||
default-language: Haskell2010
|
||||
|
||||
@@ -49,7 +51,6 @@ executable pcc-haskell-exe
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, combinatorial
|
||||
, pcc-haskell
|
||||
, unordered-containers
|
||||
default-language: Haskell2010
|
||||
|
||||
46
haskell/src/Children.hs
Normal file
46
haskell/src/Children.hs
Normal file
@@ -0,0 +1,46 @@
|
||||
module Children (
|
||||
getChildren
|
||||
) where
|
||||
|
||||
import PolyCube
|
||||
import Combinatorics
|
||||
|
||||
-- generates legal children of given polycube up to a given size
|
||||
getChildren :: Int -> PolyCube -> [PolyCube]
|
||||
getChildren 0 _ = []
|
||||
getChildren i (PolyCube o la s) = foldr condGrowth [] $ foldr (\x acc -> tuples x possibleGrowth ++ acc) [] [1..i] where
|
||||
condGrowth :: [Coord3D] -> [PolyCube] -> [PolyCube]
|
||||
condGrowth gs ps =
|
||||
if any (\x -> elem x $ head o) gs
|
||||
then ps
|
||||
else PolyCube (zipWith (\x n -> insertAllSorted x $ rotateCubes gs n) o [1..24]) gs (s + length gs) : ps
|
||||
possibleGrowth :: [Coord3D]
|
||||
possibleGrowth = foldr (\x acc -> insertAllSorted acc (generateNeighbors x)) [] la
|
||||
|
||||
-- generate all neighbors of a Coord3D
|
||||
generateNeighbors :: Coord3D -> [Coord3D]
|
||||
generateNeighbors p = map (applyOffset p) transformations where
|
||||
transformations :: [Offset3D]
|
||||
transformations = [
|
||||
Offset3D (-1, 0, 0),
|
||||
Offset3D (0, -1, 0),
|
||||
Offset3D (0, 0, -1),
|
||||
Offset3D (1, 0, 0),
|
||||
Offset3D (0, 1, 0),
|
||||
Offset3D (0, 0, 1)]
|
||||
|
||||
-- inserts all elements from the second list into the first
|
||||
insertAllSorted :: (Ord a) => [a] -> [a] -> [a]
|
||||
insertAllSorted [] [] = []
|
||||
insertAllSorted [] [v] = [v]
|
||||
insertAllSorted xs [] = xs
|
||||
insertAllSorted xs (y:ys) = insertAllSorted (insertSorted xs y) ys
|
||||
|
||||
-- inserts element into sorted list
|
||||
insertSorted :: (Ord a) => [a] -> a -> [a]
|
||||
insertSorted [] v = [v]
|
||||
insertSorted (x:xs) v
|
||||
| v < x = v:x:xs
|
||||
| v > x = x:insertSorted xs v
|
||||
| otherwise = x:xs
|
||||
|
||||
@@ -40,6 +40,7 @@ data PolyCube = PolyCube {
|
||||
Eq
|
||||
)
|
||||
|
||||
-- offset calculations
|
||||
getOffsets :: [Coord3D] -> [Offset3D]
|
||||
getOffsets [] = error "empty List"
|
||||
getOffsets [_] = []
|
||||
@@ -51,8 +52,9 @@ diff (Coord3D (a, b, c)) (Coord3D (x, y, z)) = Offset3D (x-a, y-b, z-c)
|
||||
applyOffset :: Coord3D -> Offset3D -> Coord3D
|
||||
applyOffset (Coord3D (a, b, c)) (Offset3D (x, y, z)) = Coord3D (a+x, b+y, c+z)
|
||||
|
||||
-- calculates an oriented reprenentation
|
||||
rotateCubes :: [Coord3D] -> Int -> [Coord3D]
|
||||
rotateCubes tree n = map (invert . flip . rotate n) tree where
|
||||
rotateCubes ors n = map (invert . flip . rotate n) ors where
|
||||
rotate :: Int -> Coord3D -> (Int, (Int, Int, Int))
|
||||
rotate i (Coord3D (a, b, c)) = case mod i 3 of
|
||||
0 -> (j, (a, b, c))
|
||||
|
||||
Reference in New Issue
Block a user