Challenge: Convert this small 3d-graphics imperative algorithm to Haskell

Show and Tell
8

You can implement it like this with accelerate. This passes the type checker, but I haven’t tested it yet:

import Data.Array.Accelerate
import Data.Array.Accelerate.Linear

type Vec3 = V3 Double

meshNormalise :: Acc (Array DIM2 Int) -> Acc (Vector Vec3) -> Acc (Vector Vec3)
meshNormalise faces vertices =
  let
    nFaces, nVertices :: Exp Int
    (I2 nFaces _) = shape faces
    (I1 nVertices) = shape vertices
    i0, i1, i2 :: Acc (Vector Int)
    i0 = backpermute (I1 nFaces) (\(I1 i) -> I2 i 0) faces
    i1 = backpermute (I1 nFaces) (\(I1 i) -> I2 i 1) faces
    i2 = backpermute (I1 nFaces) (\(I1 i) -> I2 i 2) faces
    v0, v1, v2 :: Acc (Vector Vec3)
    v0 = gather i0 vertices
    v1 = gather i1 vertices
    v2 = gather i2 vertices
    faceNormals :: Acc (Vector Vec3)
    faceNormals = zipWith3 (\x y z -> cross (x - y) (z - y)) v0 v1 v2
    zeros :: Acc (Vector Vec3)
    zeros = fill (I1 nVertices) 0
    n0, n1, n2 :: Acc (Vector Vec3)
    n0 = permute (+) zeros (\i -> Just_ (I1 (i0 ! i))) faceNormals
    n1 = permute (+) zeros (\i -> Just_ (I1 (i1 ! i))) faceNormals
    n2 = permute (+) zeros (\i -> Just_ (I1 (i2 ! i))) faceNormals
  in map normalize $ zipWith3 (\x y z -> x + y + z) n0 n1 n2

The nice thing is that this will probably all fuse away to become equivalent to the reference C solution and you get automatic parallelism for free (and it can run on NVidia GPUs)!

Let me see if I can test it.

7 Likes