Hilbert curve: Difference between revisions
m
→{{header|Haskell}}: Tidied
m (→JS Functional: Tidied) |
m (→{{header|Haskell}}: Tidied) |
||
Line 1,605:
and folded to a list of points in a square of given size.
<syntaxhighlight lang="haskell">import Data.
---------------------- HILBERT CURVE ---------------------
hilbertTree :: Int -> Tree Char▼
| otherwise = seed
where
| otherwise = Node c (go <$> xs)
where
hilbertPoints :: Int -> Tree Char -> [(Int, Int)]▼
where
where
((,) . f fst)
xs = subForest tree
--------------------- PRODUCTION RULE --------------------
rule :: Char -> String
Line 1,625 ⟶ 1,658:
'd' -> [(-1, 1), (1, 1), (1, -1), (-1, -1)]
_ -> []
--------------------------- TEST -------------------------
main :: IO ()
Line 1,630 ⟶ 1,666:
let w = 1024
putStrLn $ svgFromPoints w $ hilbertPoints w (hilbertTree 6)
▲hilbertTree :: Int -> Tree Char
▲hilbertTree n =
▲ let go tree =
▲ let c = rootLabel tree
▲ xs = subForest tree
▲ in Node c (bool (go <$> xs) (flip Node [] <$> rule c) (null xs))
▲ seed = Node 'a' []
▲ in bool seed (iterate go seed !! pred n) (0 < n)
▲hilbertPoints :: Int -> Tree Char -> [(Int, Int)]
▲hilbertPoints w tree =
▲ let go r xy tree =
▲ let d = quot r 2
▲ f g x = g xy + (d * g x)
▲ centres = ((,) . f fst) <*> f snd <$> vectors (rootLabel tree)
▲ xs = subForest tree
▲ in bool (concat $ zipWith (go d) centres xs) centres (null xs)
▲ r = quot w 2
svgFromPoints :: Int -> [(Int, Int)] -> String
Line 1,655 ⟶ 1,671:
let sw = show w
points =
(unwords . fmap (((
in unlines
[ "<svg xmlns=\"http://www.w3.org/2000/svg\"",
unwords
"stroke-width=\"2\" stroke=\"red\" fill=\"transparent\"/>",
▲ , "</svg>"
]</syntaxhighlight>
=={{header|IS-BASIC}}==
| |||