# Haskell Quiz/Geodesic Dome Faces/Solution Jkramar

(Difference between revisions)

This problem seems to be strongly IO-bound, so actually computing the geodesic faces is not too time-sensitive. Hence there is time for computing the faces from the vertices by trying each triple of vertices to check if it's a face.

Originally I wrote this program representing vectors just by ordinary tuples, and in some places that was definitely more understandable. But of course it's more fun this way.

```import Prelude hiding (maximum, foldr, foldr1, concat, sequence_, sum)
import Control.Applicative
import Data.Foldable

data V3 a = V !a !a !a deriving (Read,Show)
instance Foldable V3 where foldr f x (V a b c) = f a\$f b\$f c x
instance Functor V3 where fmap f (V a b c) = V (f a) (f b) (f c)
instance Applicative V3 where
pure a = V a a a
V f g h <*> V a b c = V (f a) (g b) (h c)
type Tri a = V3 (V3 a)

(.+) :: (Num a) => V3 a -> V3 a -> V3 a
(.+) = liftA2 (+)

(.-) :: (Num a) => V3 a -> V3 a -> V3 a
(.-) = liftA2 (-)

(.*) :: (Num a) => a -> V3 a -> V3 a
(.*) = fmap.(*)

dot :: (Num a) => V3 a -> V3 a -> a
dot a b = sum\$liftA2 (*) a b

cross :: (Num a) => V3 a -> V3 a -> V3 a
cross (V x y z) (V x' y' z')=V (y*z'-z*y') (z*x'-x*z') (x*y'-y*x')

det :: (Num a) => V3 (V3 a) -> a
det (V a b c) = (a `cross` b) `dot` c

-- matrix multiplication
mmul :: (Num a) => V3 (V3 a) -> V3 (V3 a) -> V3 (V3 a)
mmul t s = foldr1 (.+) <\$> (flip (.*)<\$>t<*>) <\$> s

normize :: (Floating a) => V3 a -> V3 a
normize v = (1/sqrt (dot v v)).*v

-- chooses xs!!n gives the combinations of n elements from xs
chooses :: (Alternative f) => [a] -> [f [a]]
chooses = foldr consider\$pure []:repeat empty where
consider x cs = zipWith (flip (<|>)) cs\$map ((x:)<\$>)\$empty:cs

tris :: (Alternative f) => [V3 a] -> f (Tri a)
tris xs = (\[a,b,c]->V a b c) <\$> (chooses xs!!3)

orient :: (Num a) => Tri a -> Tri a
orient t@(V a b c) = if (==1)\$signum\$det t then t else V a c b

-- inefficient function to generate all the positively-oriented faces of the
-- triangle-faced polyhedron with vertices at vs
faces :: (Num a, Ord a, MonadPlus m) => [V3 a] -> m (Tri a)
faces vs = do
t@(V a b c) <- unwrapMonad \$ orient <\$> tris vs
let dir = ((a.-b) `cross` (a.-c)); farth = maximum.map (dot dir)
guard (farth [a,b,c]==farth vs) >> return t

-- each triangle side is broken into n pieces, unlike in the problem statement,
-- where they use n+1 for some reason
shatter :: (Integral a1, Fractional a) => a1 -> Tri a -> [Tri a]
shatter n t = mmul t'<\$>coords where
basis = V (V 1 0 0) (V 0 1 0) (V 0 0 1)
fwd = [(V k j (n-1-k-j).+) <\$> basis|k<-[0..n-1], j<-[0..n-1-k]]
bwd = [(V k j (n+1-k-j).-) <\$> basis|k<-[1..n], j<-[1..n-k]]
t' = ((1/fromIntegral n).*)<\$>t
coords = (fmap fromIntegral<\$>)<\$>fwd++bwd

geode :: (Floating a, Ord a, Integral a1) => [V3 a] -> a1 -> [Tri a]
geode vs n = fmap normize<\$>(shatter n=<<faces vs)

cyc :: V3 a -> [V3 a]
cyc (V a b c) = [V a b c, V b c a, V c a b]

tetrahed :: (Floating a) => [V3 a]
tetrahed = [V (x*sqrt 1.5) (-sqrt 2/3) (-1/3)|x<-[-1,1]]++
[V 0 (2*sqrt 2/3) (-1/3), V 0 0 1]

octahed :: (Num a) => [V3 a]
octahed = cyc =<< [V x 0 0|x<-[-1,1]]

icosahed :: (Floating a) => [V3 a]
icosahed = cyc =<< [V x (y*(1+sqrt 5/2)) 0|x<-[-1, 1], y<-[-1, 1]]

-- this is the test the Ruby Quiz people were doing to see how fast the code is
main :: IO ()
main = sequence_\$map print\$(geode octahed::Int->[Tri Double]) 51```