Pārlūkot izejas kodu

Enlargen cubes centered around the origin with peeledCubes

master
Felix Van der Jeugt pirms 11 mēnešiem
vecāks
revīzija
248aa5e446
Šim parakstam datu bāzē netika atrasta zināma atslēga GPG atslēgas ID: 58B209295023754D
  1. 48
      Main.hs

48
Main.hs

@ -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
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)
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)
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

Notiek ielāde…
Atcelt
Saglabāt