Rosetta Code

Free polyominoes enumeration: Difference between revisions

Page Discussion

Free polyominoes enumeration (view source)

Revision as of 20:00, 15 April 2019

59 bytes added ,  5 years ago
→‎{{header|Haskell}}: Applied hlint hindent, reduced some sub-expressions, and now a little faster, without, I hope, reducing legibility too much
(Added Sidef)
(→‎{{header|Haskell}}: Applied hlint hindent, reduced some sub-expressions, and now a little faster, without, I hope, reducing legibility too much)
Line 1,003:
 
Code updated and slightly improved from: http://www.haskell.org/haskellwiki/The_Monad.Reader/Issue5/Generating_Polyominoes
<lang haskell>import DataSystem.ListEnvironment (sortgetArgs)
import Control.Arrow ((***), first)
import Data.Set (toList, fromList)
import SystemData.EnvironmentList (getArgssort)
import Data.Bool (bool)
 
type Coord = Int
 
type Point = (Coord, Coord)
 
type Polyomino = [Point]
 
Line 1,017 ⟶ 1,021:
translateToOrigin :: Polyomino -> Polyomino
translateToOrigin p =
let (minx, miny) = minima p in
in map (\(x, y) -> (x -subtract minx, y*** -subtract miny)) <$> p
 
rotate90, rotate180, rotate270, reflect :: Point -> Point
rotate90 = uncurry (flip (x, y) = ( y,. -xnegate)
 
rotate180 (x,= y) =negate (-x,*** -y)negate
rotate270 (x, y) = (-y, x)▼
 
reflect (x, y) = (-x, y)
▲rotate270 (x,= y)uncurry =(flip (-y(,) . xnegate))
 
reflect = first negate
 
-- All the plane symmetries of a rectangular region.
rotationsAndReflections :: Polyomino -> [Polyomino]
rotationsAndReflections p =
[p,(<*>)
(fmap <$>
map rotate90 p,
map[ rotate180 p,id
map, rotate270 p,rotate90
map, reflect p,rotate180
, rotate270
map (rotate90 . reflect) p,▼
map (rotate180 ., reflect) p,
map, (rotate270rotate90 . reflect) p]
▲ map, (rotate90rotate180 . reflect) p,
, rotate270 . reflect
where ]) .▼
return
 
canonical :: Polyomino -> Polyomino
canonical = minimum . map (sort . translateToOrigin) . rotationsAndReflections
 
unique
unique :: (Ord a) => [a] -> [a]▼
:: (Ord a)
▲unique :: (Ord a) => [a] -> [a]
unique = toList . fromList
 
Line 1,051 ⟶ 1,064:
newPoints :: Polyomino -> [Point]
newPoints p =
let notInP = filter (not . flip elem p) in
in unique . notInP . concatMap contiguous $ p
 
newPolys :: Polyomino -> [Polyomino]
Line 1,058 ⟶ 1,071:
 
monomino = [(0, 0)]
 
monominoes = [monomino]
 
Line 1,067 ⟶ 1,081:
 
-- Generates a textual representation of a Polyomino.
textRepresentatontextRepresentation :: Polyomino -> String
textRepresentation p =
textRepresentaton p =
unlines
unlines [[if elem (x,y) p then '#' else ' ' | x <- [0 .. maxx - minx]]▼
[ [ bool ' ' '#' |((x, y) <- [0 .. maxy -`elem` miny]]p)
▲ unlines [[if elem (x,y) p then '#' else ' ' | x <- [0 .. maxx - minx] ]
▲ where
| y <- [0 maxima.. :: Polyominomaxy -> Pointminy] ]
where
maxima (p:ps) = foldr (\(x, y) (mx, my) -> (max x mx, max y my)) p ps
maxima :: Polyomino -> Point
(minx, miny) = minima p▼
maxima (p:ps) = foldr (maxx\(x, maxyy) =(mx, maximamy) -> (max x mx, max y my)) p ps
▲ (minx, miny) = minima p
(maxx, maxy) = maxima p
 
main :: IO ()
main = do
print $ map (length . rank) [1 .. 10]
args <- getArgs
let n = if null args then 5 elsebool (read $ head args :: Int) 5 (null args)
putStrLn ("\nAll free polyominoes of rank " ++ show n ++ ":")
mapM_ (putStrLn $ map textRepresentaton. $textRepresentation) (rank n)</lang>
{{out}}
<pre>[1,1,2,5,12,35,108,369,1285,4655]
Hout
9,655

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/251099"