initial commit

This commit is contained in:
Felix Van der Jeugt 2020-07-06 11:00:00 +02:00
commit b8fef3fd76
No known key found for this signature in database
GPG Key ID: 58B209295023754D
5 changed files with 151 additions and 0 deletions

1
.gitignore vendored Normal file
View File

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

30
LICENSE Normal file
View File

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

93
Main.hs Normal file
View File

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

2
Setup.hs Normal file
View File

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

25
spirals.cabal Normal file
View File

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