{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE FlexibleContexts #-}
module MarchingCubes.Utils
  ( module MarchingCubes.Utils
  ) where
import           Data.Array.Unboxed             ( (!)
                                                , IArray(..)
                                                , UArray
                                                )
import           Data.List                      ( transpose )
import           Data.Matrix                    ( (<|>)
                                                , Matrix(..)
                                                , colVector
                                                , getElem
                                                , mapPos
                                                , matrix
                                                , toLists
                                                )
import qualified Data.Matrix                   as M
import           Data.Sequence                  ( (><)
                                                , Seq
                                                , (|>)
                                                )
import qualified Data.Sequence                 as S
import qualified Data.Vector                   as V
import           Data.Vector.Unboxed            ( Vector )
import qualified Data.Vector.Unboxed           as UV

levelMatrix :: Real a => Matrix a -> a -> Bool -> Matrix Int
levelMatrix :: forall a. Real a => Matrix a -> a -> Bool -> Matrix Int
levelMatrix Matrix a
mtrx a
level Bool
strict = forall a b. ((Int, Int) -> a -> b) -> Matrix a -> Matrix b
mapPos (\(Int, Int)
_ a
x -> if a -> Bool
lt a
x then Int
1 else Int
0) Matrix a
mtrx
  where lt :: a -> Bool
lt = if Bool
strict then forall a. Ord a => a -> a -> Bool
(<) a
level else forall a. Ord a => a -> a -> Bool
(<=) a
level

arrayToMatrix :: IArray UArray a => UArray (Int, Int, Int) a -> Int -> Matrix a
arrayToMatrix :: forall a.
IArray UArray a =>
UArray (Int, Int, Int) a -> Int -> Matrix a
arrayToMatrix UArray (Int, Int, Int) a
arr Int
k = forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix (Int
nx forall a. Num a => a -> a -> a
+ Int
1)
                             (Int
ny forall a. Num a => a -> a -> a
+ Int
1)
                             (\(Int
i, Int
j) -> UArray (Int, Int, Int) a
arr forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
i forall a. Num a => a -> a -> a
- Int
1, Int
j forall a. Num a => a -> a -> a
- Int
1, Int
k))
  where ((Int, Int, Int)
_, (Int
nx, Int
ny, Int
_)) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray (Int, Int, Int) a
arr

whichIndicesAndItems :: Matrix Int -> Seq (Int, Int)
whichIndicesAndItems :: Matrix Int -> Seq (Int, Int)
whichIndicesAndItems Matrix Int
mtrx = Int -> Seq (Int, Int) -> Seq (Int, Int)
go Int
1 forall a. Seq a
S.empty
 where
  m :: Int
m = forall a. Matrix a -> Int
nrows Matrix Int
mtrx forall a. Num a => a -> a -> a
+ Int
1
  n :: Int
n = forall a. Matrix a -> Int
ncols Matrix Int
mtrx forall a. Num a => a -> a -> a
+ Int
1
  go :: Int -> Seq (Int, Int) -> Seq (Int, Int)
  go :: Int -> Seq (Int, Int) -> Seq (Int, Int)
go Int
j !Seq (Int, Int)
out | Int
j forall a. Eq a => a -> a -> Bool
== Int
n    = Seq (Int, Int)
out
            | Bool
otherwise = Int -> Seq (Int, Int) -> Seq (Int, Int)
go (Int
j forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int -> Seq (Int, Int) -> Seq (Int, Int)
inner Int
1 Int
j Seq (Int, Int)
out)
  inner :: Int -> Int -> Seq (Int, Int) -> Seq (Int, Int)
inner Int
i !Int
j !Seq (Int, Int)
out | Int
i forall a. Eq a => a -> a -> Bool
== Int
m    = Seq (Int, Int)
out
                  | Bool
otherwise = Int -> Int -> Seq (Int, Int) -> Seq (Int, Int)
inner (Int
i forall a. Num a => a -> a -> a
+ Int
1) Int
j Seq (Int, Int)
out'
   where
    out' :: Seq (Int, Int)
out' =
      let x :: Int
x = forall a. Int -> Int -> Matrix a -> a
getElem Int
i Int
j Matrix Int
mtrx
      in  if Int
x forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
255
            then Seq (Int, Int)
out forall a. Seq a -> a -> Seq a
|> ((Int
j forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* (Int
m forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
i forall a. Num a => a -> a -> a
- Int
1, Int
x)
            else Seq (Int, Int)
out

kro1 :: Matrix Int -> Int -> Matrix Int
kro1 :: Matrix Int -> Int -> Matrix Int
kro1 Matrix Int
mtrx Int
n = forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix Int
p Int
ny (Int, Int) -> Int
f
 where
  nx :: Int
nx = forall a. Matrix a -> Int
nrows Matrix Int
mtrx
  ny :: Int
ny = forall a. Matrix a -> Int
ncols Matrix Int
mtrx
  p :: Int
p  = Int
nx forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
1
  f :: (Int, Int) -> Int
f (Int
i, Int
j) = if Int
i forall a. Ord a => a -> a -> Bool
< Int
p then forall a. Int -> Int -> Matrix a -> a
getElem ((Int
i forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`mod` Int
nx forall a. Num a => a -> a -> a
+ Int
1) Int
j Matrix Int
mtrx else Int
0

kro2 :: Matrix Int -> Int -> Matrix Int
kro2 :: Matrix Int -> Int -> Matrix Int
kro2 Matrix Int
mtrx Int
n = forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix Int
p Int
ny (Int, Int) -> Int
f
 where
  nx :: Int
nx         = forall a. Matrix a -> Int
nrows Matrix Int
mtrx
  ny :: Int
ny         = forall a. Matrix a -> Int
ncols Matrix Int
mtrx
  p :: Int
p          = Int
nx forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
1
  replicates :: Seq Int
replicates = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Seq a -> Seq a -> Seq a
(><) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> Seq a
S.replicate Int
n) forall a. Seq a
S.empty [Int
1 .. Int
nx] :: Seq Int
  f :: (Int, Int) -> Int
f (Int
i, Int
j) = if Int
i forall a. Ord a => a -> a -> Bool
< Int
p then forall a. Int -> Int -> Matrix a -> a
getElem (forall a. Seq a -> Int -> a
S.index Seq Int
replicates (Int
i forall a. Num a => a -> a -> a
- Int
1)) Int
j Matrix Int
mtrx else Int
0

replicateEach :: [a] -> [Int] -> Seq a
replicateEach :: forall a. [a] -> [Int] -> Seq a
replicateEach [a]
list [Int]
counts = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Seq a -> Seq a -> Seq a
(><) forall a. Seq a
S.empty [Seq a]
sequences
  where sequences :: [Seq a]
sequences = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> a -> Seq a
S.replicate [Int]
counts [a]
list

replicateEach' :: [a] -> Int -> Seq a
replicateEach' :: forall a. [a] -> Int -> Seq a
replicateEach' [a]
list Int
n = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Seq a -> Seq a -> Seq a
(><) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> Seq a
S.replicate Int
n) forall a. Seq a
S.empty [a]
list

vector2matrix :: [a] -> Int -> Matrix a
vector2matrix :: forall a. [a] -> Int -> Matrix a
vector2matrix [a]
list Int
ny = forall a. Int -> Int -> [a] -> Matrix a
M.fromList (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list forall a. Integral a => a -> a -> a
`div` Int
ny) Int
ny [a]
list

cbind :: Matrix a -> [a] -> [a] -> Matrix a
cbind :: forall a. Matrix a -> [a] -> [a] -> Matrix a
cbind Matrix a
mtrx [a]
col1 [a]
col2 = Matrix a
mtrx forall a. Matrix a -> Matrix a -> Matrix a
<|> Matrix a
col1' forall a. Matrix a -> Matrix a -> Matrix a
<|> Matrix a
col2'
 where
  col1' :: Matrix a
col1' = forall a. Vector a -> Matrix a
colVector (forall a. [a] -> Vector a
V.fromList [a]
col1)
  col2' :: Matrix a
col2' = forall a. Vector a -> Matrix a
colVector (forall a. [a] -> Vector a
V.fromList [a]
col2)

subMatrix :: Matrix a -> [Int] -> Vector Int -> Matrix a
subMatrix :: forall a. Matrix a -> [Int] -> Vector Int -> Matrix a
subMatrix Matrix a
mtrx [Int]
rows Vector Int
cols = forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix
  (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rows)
  (forall a. Unbox a => Vector a -> Int
UV.length Vector Int
cols)
  (\(Int
i, Int
j) -> forall a. Int -> Int -> Matrix a -> a
getElem ([Int]
rows forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
1) (Vector Int
cols forall a. Unbox a => Vector a -> Int -> a
UV.! (Int
j forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
+ Int
1) Matrix a
mtrx)

matrix2listMinusFirstColumn :: Matrix a -> [a]
matrix2listMinusFirstColumn :: forall a. Matrix a -> [a]
matrix2listMinusFirstColumn Matrix a
mtrx =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail (forall a. Matrix a -> [[a]]
toLists forall a b. (a -> b) -> a -> b
$ forall a. Matrix a -> Matrix a
M.transpose Matrix a
mtrx)

jthColumn :: Vector Int -> Int -> Int -> Vector Int
jthColumn :: Vector Int -> Int -> Int -> Vector Int
jthColumn Vector Int
vec Int
ncol Int
j = forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UV.map (\Int
i -> Vector Int
vec forall a. Unbox a => Vector a -> Int -> a
UV.! (Int
i forall a. Num a => a -> a -> a
* Int
ncol forall a. Num a => a -> a -> a
+ Int
j))
                              (forall a. (Unbox a, Num a) => a -> Int -> Vector a
UV.enumFromN Int
0 Int
nrow)
  where nrow :: Int
nrow = forall a. Unbox a => Vector a -> Int
UV.length Vector Int
vec forall a. Integral a => a -> a -> a
`div` Int
ncol