|
|
@ -12,7 +12,8 @@ type Length = Int -- ^ The length of an line segment |
|
|
|
type X = Int |
|
|
|
type Y = Int |
|
|
|
type Z = Int |
|
|
|
type Point = (X, Y, Z) |
|
|
|
type Point2D = (X, Y) |
|
|
|
type Point3D = (X, Y, Z) |
|
|
|
|
|
|
|
area :: Int -> Int |
|
|
|
area a = a * a |
|
|
@ -20,68 +21,53 @@ area a = a * a |
|
|
|
cube :: Int -> Int |
|
|
|
cube a = a * a * a |
|
|
|
|
|
|
|
layer :: Cell -> Layer |
|
|
|
layer c = integerCubeRoot c `div` 2 |
|
|
|
|
|
|
|
ring :: Cell -> Ring |
|
|
|
ring o = integerSquareRoot o `div` 2 |
|
|
|
|
|
|
|
edge :: Layer -> Length |
|
|
|
edge l = 2 * l + 2 |
|
|
|
|
|
|
|
-- | Offset of a cell within its layer |
|
|
|
lOffset :: Cell -> Cell |
|
|
|
lOffset c = c - cube (edge $ layer c - 1) |
|
|
|
atZ :: Z -> Point2D -> Point3D |
|
|
|
atZ z (x, y) = (x, y, z) |
|
|
|
|
|
|
|
reflectY :: Point2D -> Point2D |
|
|
|
reflectY (x, y) = (x, -y - 1) |
|
|
|
|
|
|
|
-- | Offset of a cell in a layer within its spiral ring |
|
|
|
rOffset :: Cell -> Cell |
|
|
|
rOffset o = o - area (edge $ ring o - 1) |
|
|
|
reflectX :: Point2D -> Point2D |
|
|
|
reflectX (x, y) = (-x - 1, y) |
|
|
|
|
|
|
|
location :: Cell -> Point |
|
|
|
location c | o < a = locationOnTop (e `div` 2 - 1) o |
|
|
|
| o < a + (e - 2) * (e - 1) * 4 = locationAround c |
|
|
|
| otherwise = locationOnBottom ((-e) `div` 2) c (o - a - (e - 2) * (e - 1) * 4) |
|
|
|
where o = lOffset c -- ^ offset within the current layer |
|
|
|
l = layer c -- ^ the current layer |
|
|
|
e = edge l -- ^ the length of the edge of the current layer |
|
|
|
a = area e -- ^ the area of a side of the current layer |
|
|
|
rotate :: Length -> Point2D -> Point2D |
|
|
|
rotate l (x, y) = (-y - 1, -x - 1) |
|
|
|
|
|
|
|
locationOnTop :: Z -> Cell -> Point |
|
|
|
locationOnTop z o | o == 0 = (0, 0, z) |
|
|
|
| ro < e - 1 = (r, ro - r, z) -- 64 |
|
|
|
| ro < 2 * e - 2 = (3 * r - ro, r, z) |
|
|
|
| ro < 3 * e - 3 = (0 - r - 1, 5 * r - ro + 1, z) |
|
|
|
| otherwise = (ro - 7 * r - 3, 0 - r - 1, z) |
|
|
|
where r = ring o -- ^ the current spiral ring |
|
|
|
ro = rOffset o -- ^ offset within this ring |
|
|
|
e = edge r -- ^ edge of the this ring |
|
|
|
location :: Length -> Cell -> Point3D |
|
|
|
location l c = atZ h $ case h `mod` 4 of |
|
|
|
0 -> growingSpiral l o |
|
|
|
1 -> rotate l $ shrinkingSpiral l o |
|
|
|
2 -> reflectX . reflectY $ growingSpiral l o |
|
|
|
3 -> reflectX . reflectY . rotate l $ shrinkingSpiral l o |
|
|
|
where h = c `div` area l |
|
|
|
o = c - h * area l |
|
|
|
z = h - l `div` 2 - 1 |
|
|
|
|
|
|
|
locationAround :: Cell -> Point |
|
|
|
locationAround c | o <= r = (l - r + o, 0 - l - 1, l - r - 1) |
|
|
|
| o <= r + e - 1 = (l, 0 - l - 1 + o - r, l - r - 1) |
|
|
|
| o <= r + 2 * e - 2 = (l - o + r + e - 1, l, l - r - 1) |
|
|
|
| o <= r + 3 * e - 3 = (0 - l - 1, l - o + r + 2 * e - 2, l - r - 1) |
|
|
|
| otherwise = (0 - l - 1 + o - r - 3 * e + 3, 0 - l - 1, l - r - 1) |
|
|
|
where l = layer c |
|
|
|
e = edge l |
|
|
|
s = lOffset c - area e -- ^ offset since starting the sides of the cude |
|
|
|
r = s `div` (4 * e - 4) -- ^ revolutions since starting on the side |
|
|
|
o = s - (4 * e - 4) * r -- ^ offset within this revolution |
|
|
|
growingSpiral :: Length -> Cell -> Point2D |
|
|
|
growingSpiral l o | o == 0 = (0, 0) |
|
|
|
| ro < e - 1 = (r, ro - r) -- 64 |
|
|
|
| ro < 2 * e - 2 = (3 * r - ro, r) |
|
|
|
| ro < 3 * e - 3 = (0 - r - 1, 5 * r - ro + 1) |
|
|
|
| otherwise = (ro - 7 * r - 3, 0 - r - 1) |
|
|
|
where r = ring o -- ^ the current spiral ring |
|
|
|
ro = o - area (edge $ r - 1) -- ^ offset within this ring |
|
|
|
e = edge r -- ^ edge of the this ring |
|
|
|
|
|
|
|
locationOnBottom :: Z -> Cell -> Cell -> Point |
|
|
|
locationOnBottom z c b | False = (r, r, z) |
|
|
|
| otherwise = (3, -3, z) |
|
|
|
where l = layer c |
|
|
|
r = integerSquareRoot (area (edge l) - b - 1) `div` 2 -- ^ the current spiral ring |
|
|
|
shrinkingSpiral :: Length -> Cell -> Point2D |
|
|
|
shrinkingSpiral l o = growingSpiral l (area l - o - 1) |
|
|
|
|
|
|
|
asMatrix :: Length -> [[[Cell]]] |
|
|
|
asMatrix e = foldl (\c (i, x, y, z) -> replace c z $ replace (c!!z) y $ replace (c!!z!!y) x i) |
|
|
|
(replicate e $ replicate e $ replicate e (-1)) |
|
|
|
[ (i, x + div e 2, y + div e 2, z + div e 2) |
|
|
|
[ (i, x + div e 2, y + div e 2, z) |
|
|
|
| i <- [0..cube e - 1] |
|
|
|
, let (x, y, z) = location i |
|
|
|
-- , x + div e 2 >= 0, y + div e 2 >= 0, z + div e 2 >= 0 |
|
|
|
-- , x < div e 2, y < div e 2, z < div e 2 |
|
|
|
, let (x, y, z) = location e i |
|
|
|
] |
|
|
|
where replace :: [a] -> Int -> a -> [a] |
|
|
|
replace l i e = take i l ++ [e] ++ drop (i+1) l |
|
|
|