|
|
|
@ -6,7 +6,7 @@ import Debug.Trace (trace)
@@ -6,7 +6,7 @@ import Debug.Trace (trace)
|
|
|
|
|
import Math.NumberTheory.Roots (integerSquareRoot, integerCubeRoot) |
|
|
|
|
|
|
|
|
|
type Cell = Int -- ^ The index of a cell in the cube |
|
|
|
|
type Layer = Int -- ^ A layer of our cube |
|
|
|
|
type Peel = Int -- ^ A peel of our cube |
|
|
|
|
type Ring = Int -- ^ A ring of a 2D spiral |
|
|
|
|
type Length = Int -- ^ The length of an line segment |
|
|
|
|
type X = Int |
|
|
|
@ -24,7 +24,10 @@ cube a = a * a * a
@@ -24,7 +24,10 @@ cube a = a * a * a
|
|
|
|
|
ring :: Cell -> Ring |
|
|
|
|
ring o = integerSquareRoot o `div` 2 |
|
|
|
|
|
|
|
|
|
edge :: Layer -> Length |
|
|
|
|
peel :: Cell -> Peel |
|
|
|
|
peel c = integerCubeRoot c `div` 2 |
|
|
|
|
|
|
|
|
|
edge :: Peel -> Length |
|
|
|
|
edge l = 2 * l + 2 |
|
|
|
|
|
|
|
|
|
atZ :: Z -> Point2D -> Point3D |
|
|
|
@ -36,11 +39,17 @@ reflectY (x, y) = (x, -y - 1)
@@ -36,11 +39,17 @@ reflectY (x, y) = (x, -y - 1)
|
|
|
|
|
reflectX :: Point2D -> Point2D |
|
|
|
|
reflectX (x, y) = (-x - 1, y) |
|
|
|
|
|
|
|
|
|
reflectX3 :: Point3D -> Point3D |
|
|
|
|
reflectX3 (x, y, z) = (-x - 1, y, z) |
|
|
|
|
|
|
|
|
|
reflectZ3 :: Point3D -> Point3D |
|
|
|
|
reflectZ3 (x, y, z) = (x, y, -z - 1) |
|
|
|
|
|
|
|
|
|
rotate :: Length -> Point2D -> Point2D |
|
|
|
|
rotate l (x, y) = (-y - 1, -x - 1) |
|
|
|
|
|
|
|
|
|
location :: Length -> Cell -> Point3D |
|
|
|
|
location l c = atZ h $ case h `mod` 4 of |
|
|
|
|
spirals :: Length -> Cell -> Point3D |
|
|
|
|
spirals 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 |
|
|
|
@ -62,12 +71,39 @@ growingSpiral l o | o == 0 = (0, 0)
@@ -62,12 +71,39 @@ growingSpiral l o | o == 0 = (0, 0)
|
|
|
|
|
shrinkingSpiral :: Length -> Cell -> Point2D |
|
|
|
|
shrinkingSpiral l o = growingSpiral l (area l - o - 1) |
|
|
|
|
|
|
|
|
|
peeledCubes :: Length -> Cell -> Point3D |
|
|
|
|
peeledCubes _ c | o < a = reverseIfOdd |
|
|
|
|
. atZ (e `div` 2 - 1) -- on top of the cube |
|
|
|
|
$ growingSpiral e o |
|
|
|
|
| o < a + (e - 2) * (e - 1) * 4 |
|
|
|
|
= reverseIfOdd |
|
|
|
|
$ mantel p e (o - a) |
|
|
|
|
| otherwise |
|
|
|
|
= reverseIfOdd |
|
|
|
|
. atZ (-e `div` 2) -- on the bottom of the cube |
|
|
|
|
. reflectX |
|
|
|
|
$ shrinkingSpiral e (o - a - (e - 2) * (e - 1) * 4) |
|
|
|
|
where p = peel c -- ^ the current peel |
|
|
|
|
o = c - cube (edge $ p - 1) -- ^ offset within the current peel |
|
|
|
|
e = edge p -- ^ the length of the edge of the current peel |
|
|
|
|
a = area e -- ^ the area of a side of the current peel |
|
|
|
|
reverseIfOdd = if p `mod` 2 == 0 then id else (reflectX3 . reflectZ3) |
|
|
|
|
|
|
|
|
|
mantel :: Peel -> Length -> Cell -> Point3D |
|
|
|
|
mantel p e m | o <= r = (p - r + o, 0 - p - 1, p - r - 1) |
|
|
|
|
| o <= r + e - 1 = (p, 0 - p - 1 + o - r, p - r - 1) |
|
|
|
|
| o <= r + 2 * e - 2 = (p - o + r + e - 1, p, p - r - 1) |
|
|
|
|
| o <= r + 3 * e - 3 = (0 - p - 1, p - o + r + 2 * e - 2, p - r - 1) |
|
|
|
|
| otherwise = (0 - p - 1 + o - r - 3 * e + 3, 0 - p - 1, p - r - 1) |
|
|
|
|
where r = m `div` (4 * e - 4) -- ^ revolutions since starting on the side |
|
|
|
|
o = m - (4 * e - 4) * r -- ^ offset within this revolution |
|
|
|
|
|
|
|
|
|
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) |
|
|
|
|
[ (i, x + div e 2, y + div e 2, z + div e 2) |
|
|
|
|
| i <- [0..cube e - 1] |
|
|
|
|
, let (x, y, z) = location e i |
|
|
|
|
, let (x, y, z) = peeledCubes e i |
|
|
|
|
] |
|
|
|
|
where replace :: [a] -> Int -> a -> [a] |
|
|
|
|
replace l i e = take i l ++ [e] ++ drop (i+1) l |
|
|
|
|