commit b8fef3fd768ea23e15f1739d7c69048d95979351 Author: Felix Van der Jeugt Date: Mon Jul 6 11:00:00 2020 +0200 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..48a004c --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +dist-newstyle diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..68c7e89 --- /dev/null +++ b/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. diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..0873b25 --- /dev/null +++ b/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 "" diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/spirals.cabal b/spirals.cabal new file mode 100644 index 0000000..b3dcf03 --- /dev/null +++ b/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