From 6ee08be31b394b54f77c243a3691864e9e229f43 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Wed, 12 Jun 2019 19:39:29 -0400 Subject: benchmarks --- src/Wavefront.hs | 33 +++++++++++++++++++++ test/bench.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++ test/cube.c | 54 +++++++++++++++++++++++++++++++++++ wavefront-obj.cabal | 6 ++++ 4 files changed, 175 insertions(+) create mode 100644 test/bench.hs create mode 100644 test/cube.c diff --git a/src/Wavefront.hs b/src/Wavefront.hs index 66d6cdb..9e42779 100644 --- a/src/Wavefront.hs +++ b/src/Wavefront.hs @@ -42,6 +42,39 @@ data ObjBuilder m = ObjBuilder , badToken :: L.ByteString -> m () } +nullBuilder :: Applicative m => ObjBuilder m +nullBuilder = ObjBuilder + { vertex = \vs -> pure () + , vertexT = \vs -> pure () + , vertexN = \vs -> pure () + , vertexP = \vs -> pure () + , face = \is -> pure () + , cstype = \isRat typ -> pure () + , curv2 = \is -> pure () + , curv = \u0 v0 is -> pure () + , parm = \isU is -> pure () + , specialPoints = \is -> pure () + , endFreeForm = pure () + , ctech = \approx -> pure () + , stech = \approx -> pure () + , deg = \is -> pure () + , surf = \u0 u1 v0 v1 ts -> pure () + , trim = \ss -> pure () + , hole = \ss -> pure () + , specialCurves = \ss -> pure () + , equivalentCurves = \ccs -> pure () + , groups = \gs -> pure () + , smoothingGroup = \sg -> pure () + , mergingGroup = \mg δ -> pure () + , usemtl = \mtl -> pure () + , deprecated_cdc = \is -> pure () + , deprecated_bzp = \is -> pure () + , mtllib = \fns -> pure () + , objectName = \obn -> pure () + , badToken = \bs -> pure () + } + + data CurveSamplingSpec -- ctech cparm = UniformSubdivision diff --git a/test/bench.hs b/test/bench.hs new file mode 100644 index 0000000..9952ec2 --- /dev/null +++ b/test/bench.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +import qualified Data.Attoparsec.Text as Atto +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L +import Data.List as List +import Data.Either +import Data.ByteString.Unsafe +import Data.Text +import Data.Text.Encoding +import Data.Word +import Foreign.Ptr +import System.IO.Unsafe +import qualified Data.Vector as V +import Control.Monad.State ( State, execState, gets, modify ) +import qualified Data.IntMap as IntMap + +import Codec.Wavefront.Lexer ( lexer ) +import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ, objLocations ) +import Codec.Wavefront.Token ( tokenize ) + +import qualified Graphics.WaveFront.Parse as Parse +import qualified Graphics.WaveFront.Parse.Common as Parse + +import Wavefront + +import Criterion.Main +import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on. + +foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8 +cube_obj_len :: Int +cube_obj_len = 840 + +cube_obj :: L.ByteString +cube_obj = L.fromChunks . pure . unsafePerformIO $ do + unsafePackCStringFinalizer cube_ptr cube_obj_len (return ()) +{-# NOINLINE cube_obj #-} + +cube_objT :: Text +cube_objT = decodeASCII $ L.toStrict cube_obj +{-# NOINLINE cube_objT #-} + +countVerticesSabadie :: Text -> Int +countVerticesSabadie ts = V.length vs + where + obj = sabadie ts + vs = either (const V.empty) objLocations obj + +countVerticesSundqvist :: Text -> Int +countVerticesSundqvist ts = List.length vs + where + obj = sundqvist ts + vs = either (const []) (List.filter isOBJVertex) obj + isOBJVertex (Parse.OBJVertex {}) = True + isOBJVertex _ = False + +countVerticesCrayne :: L.ByteString -> Int +countVerticesCrayne bs = execState (parseOBJ builder (ObjConfig IntMap.empty) bs) 0 + where + builder = nullBuilder + { vertex = \_ -> modify succ + } + +sabadie :: Text -> Either String WavefrontOBJ +sabadie = fmap (ctxtToWavefrontOBJ . lexer) . tokenize + +sundqvist :: Text -> Either String (Parse.OBJ Double Text Integer []) +sundqvist = Atto.parseOnly (Parse.wholeFile Parse.obj) + +main :: IO () +main = do + print $ countVerticesSabadie cube_objT + print $ countVerticesSundqvist cube_objT + print $ countVerticesCrayne cube_obj + putStrLn $ "---- Benchmarking" + defaultMain [ + bgroup "count vertices" + [ bench "crayne" $ whnf countVerticesCrayne cube_obj + , bench "sabadie" $ whnf countVerticesSabadie cube_objT + , bench "sundqvist" $ whnf countVerticesSundqvist cube_objT + ] + ] + return () diff --git a/test/cube.c b/test/cube.c new file mode 100644 index 0000000..952f32e --- /dev/null +++ b/test/cube.c @@ -0,0 +1,54 @@ + +unsigned char cube_obj[] = + " \n" + " \n" + // For now, sabadie parser has bug and cannot handle leading comments. + // "# cube.obj\n" + // "#\n" + "\n" + "o cube\n" + "mtllib cube.mtl\n" + "\n" + "v -0.500000 -0.500000 0.500000\n" + "v 0.500000 -0.500000 0.500000\n" + "v -0.500000 0.500000 0.500000\n" + "v 0.500000 0.500000 0.500000\n" + "v -0.500000 0.500000 -0.500000\n" + "v 0.500000 0.500000 -0.500000\n" + "v -0.500000 -0.500000 -0.500000\n" + "v 0.500000 -0.500000 -0.500000\n" + "\n" + "vt 0.000000 0.000000\n" + "vt 1.000000 0.000000\n" + "vt 0.000000 1.000000\n" + "vt 1.000000 1.000000\n" + "\n" + "vn 0.000000 0.000000 1.000000\n" + "vn 0.000000 1.000000 0.000000\n" + "vn 0.000000 0.000000 -1.000000\n" + "vn 0.000000 -1.000000 0.000000\n" + "vn 1.000000 0.000000 0.000000\n" + "vn -1.000000 0.000000 0.000000\n" + "\n" + "g cube\n" + "usemtl material0\n" + "s 1\n" + "f 1/1/1 2/2/1 3/3/1\n" + "f 3/3/1 2/2/1 4/4/1\n" + "s 2\n" + "f 3/1/2 4/2/2 5/3/2\n" + "f 5/3/2 4/2/2 6/4/2\n" + "s 3\n" + "f 5/4/3 6/3/3 7/2/3\n" + "f 7/2/3 6/3/3 8/1/3\n" + "s 4\n" + "f 7/1/4 8/2/4 1/3/4\n" + "f 1/3/4 8/2/4 2/4/4\n" + "s 5\n" + "f 2/1/5 8/2/5 4/3/5\n" + "f 4/3/5 8/2/5 6/4/5\n" + "s 6\n" + "f 7/1/6 1/2/6 5/3/6\n" + "f 5/3/6 1/2/6 3/4/6\n"; + +unsigned int cube_obj_len = 840; diff --git a/wavefront-obj.cabal b/wavefront-obj.cabal index 612d6f5..a1087df 100644 --- a/wavefront-obj.cabal +++ b/wavefront-obj.cabal @@ -92,3 +92,9 @@ library hs-source-dirs: src default-language: Haskell2010 + +executable bench + main-is: test/bench.hs + C-sources: test/cube.c + ghc-options: -Wall -rtsopts + build-depends: base, bytestring, attoparsec, text, vector, transformers, mtl, containers, wavefront-obj, criterion, weigh -- cgit v1.2.3