initial commit

.gitignore

@@ -0,0 +1 @@
+dist-newstyle

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2020, Felix Van der Jeugt
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Felix Van der Jeugt nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Main.hs

@@ -0,0 +1,93 @@
+module Main where
+
+import Control.Monad (forM_)
+import Data.List (intercalate)
+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 Ring = Int -- ^ A ring of a 2D spiral
+type Length = Int -- ^ The length of an line segment
+type X = Int
+type Y = Int
+type Z = Int
+type Point = (X, Y, Z)
+
+area :: Int -> Int
+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)
+
+-- | Offset of a cell in a layer within its spiral ring
+rOffset :: Cell -> Cell
+rOffset o = o - area (edge $ ring o - 1)
+
+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
+
+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
+
+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
+
+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
+
+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 <- [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
+                   ]
+  where replace :: [a] -> Int -> a -> [a]
+        replace l i e = take i l ++ [e] ++ drop (i+1) l
+
+main :: IO ()
+main = forM_ (reverse $ asMatrix 6) $ \plane -> do
+           forM_ (reverse plane) $ \row -> do
+               putStrLn $ intercalate ",\t" $ map show row
+           putStrLn ""

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

spirals.cabal

@@ -0,0 +1,25 @@
+cabal-version:       >=1.10
+-- Initial package description 'spirals.cabal' generated by 'cabal init'.
+-- For further documentation, see http://haskell.org/cabal/users-guide/
+
+name:                spirals
+version:             0.1.0.0
+synopsis:            Filling a cube with spirals
+-- description:
+-- bug-reports:
+license:             BSD3
+license-file:        LICENSE
+author:              Felix Van der Jeugt
+maintainer:          felix.vanderjeugt@posteo.net
+-- copyright:
+category:            Math
+build-type:          Simple
+
+executable spirals
+  main-is:             Main.hs
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >=4.13 && <4.14
+                     , integer-roots >= 1.0 && < 1.1
+  -- hs-source-dirs:
+  default-language:    Haskell2010