menoh 0.2.0 → 0.3.0
raw patch · 6 files changed
+312/−124 lines, 6 filesdep ~bytestring
Dependency ranges changed: bytestring
Files
- app/mnist_example.hs +34/−55
- app/vgg16_example.hs +1/−1
- menoh.cabal +3/−2
- src/Menoh.hs +139/−13
- src/Menoh/Base.hsc +48/−1
- test/test.hs +87/−52
app/mnist_example.hs view
@@ -4,10 +4,11 @@ module Main (main) where import qualified Codec.Picture as Picture+import qualified Codec.Picture.Types as Picture import Control.Applicative import Control.Monad import Data.Monoid-import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG import qualified Data.Vector.Storable as VS import Data.Version import Options.Applicative@@ -24,44 +25,36 @@ opt <- execParser (parserInfo (dataDir </> "data")) let input_dir = optInputPath opt- image_filenames =- [ "0.png"- , "1.png"- , "2.png"- , "3.png"- , "4.png"- , "5.png"- , "6.png"- , "7.png"- , "8.png"- , "9.png"- ]- batch_size = length image_filenames++ images <- forM [(0::Int)..9] $ \i -> do+ let fname :: String+ fname = printf "%d.png" i+ ret <- Picture.readImage $ input_dir </> fname+ case ret of+ Left e -> error e+ Right img -> return (Picture.extractLumaPlane $ Picture.convertRGB8 img, i, fname)++ let batch_size = length images channel_num = 1 height = 28 width = 28 category_num = 10+ input_dims, output_dims :: Dims input_dims = [batch_size, channel_num, height, width] output_dims = [batch_size, category_num] - images <- forM image_filenames $ \fname -> do- ret <- Picture.readImage $ input_dir </> fname- case ret of- Left e -> error e- Right img -> return $ convert width height img-- -- Aliases to onnx's node input and output tensor name- let mnist_in_name = "139900320569040"+ -- Aliases to onnx's node input and output tensor name+ mnist_in_name = "139900320569040" mnist_out_name = "139898462888656" -- Load ONNX model data- model_data <- makeModelDataFromONNX (optModelPath opt)+ model_data <- makeModelDataFromONNXFile (optModelPath opt) -- Specify inputs and outputs vpt <- makeVariableProfileTable [(mnist_in_name, DTypeFloat, input_dims)]- [(mnist_out_name, DTypeFloat)]+ [mnist_out_name] model_data optimizeModelData model_data vpt @@ -69,18 +62,23 @@ model <- makeModel vpt model_data "mkldnn" -- Copy input image data to model's input array- writeBuffer model mnist_in_name images+ writeBuffer model mnist_in_name [VG.map fromIntegral (Picture.imageData img) :: VS.Vector Float | (img,_,_) <- images] -- Run inference run model -- Get output- (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name- forM_ (zip vs image_filenames) $ \(scores,fname) -> do- let j = V.maxIndex scores- s = scores V.! j- printf "%s = %d : %f\n" fname j s+ (vs :: [VS.Vector Float]) <- readBuffer model mnist_out_name + -- Examine the results+ forM_ (zip images vs) $ \((_img,expected,fname), scores) -> do+ let guessed = VG.maxIndex scores+ putStrLn fname+ printf "Expected: %d Guessed: %d\n" expected guessed+ putStrLn $ "Scores: " ++ show (zip [(0::Int)..] (VG.toList scores))+ putStrLn $ "Probabilities: " ++ show (zip [(0::Int)..] (VG.toList (softmax scores)))+ putStrLn ""+ -- ------------------------------------------------------------------------- data Options@@ -122,31 +120,12 @@ -- ------------------------------------------------------------------------- -convert :: Int -> Int -> Picture.DynamicImage -> VS.Vector Float-convert w h = reorderToNCHW . resize (w,h) . crop . Picture.convertRGB8--crop :: Picture.Pixel a => Picture.Image a -> Picture.Image a-crop img = Picture.generateImage (\x y -> Picture.pixelAt img (base_x + x) (base_y + y)) shortEdge shortEdge- where- shortEdge = min (Picture.imageWidth img) (Picture.imageHeight img)- base_x = (Picture.imageWidth img - shortEdge) `div` 2- base_y = (Picture.imageHeight img - shortEdge) `div` 2---- TODO: Should we do some kind of interpolation?-resize :: Picture.Pixel a => (Int,Int) -> Picture.Image a -> Picture.Image a-resize (w,h) img = Picture.generateImage (\x y -> Picture.pixelAt img (x * orig_w `div` w) (y * orig_h `div` h)) w h- where- orig_w = Picture.imageWidth img- orig_h = Picture.imageHeight img--reorderToNCHW :: Picture.Image Picture.PixelRGB8 -> VS.Vector Float-reorderToNCHW img = VS.generate (Picture.imageHeight img * Picture.imageWidth img) f+softmax :: (Real a, Floating a, VG.Vector v a) => v a -> v a+softmax v | VG.null v = VG.empty+softmax v = VG.map (/ s) v' where- f i =- case Picture.pixelAt img x y of- Picture.PixelRGB8 r g b ->- (fromIntegral r + fromIntegral g + fromIntegral b) / 3- where- (y,x) = i `divMod` Picture.imageWidth img+ m = VG.maximum v+ v' = VG.map (\x -> exp (x - m)) v+ s = VG.sum v' -- -------------------------------------------------------------------------
app/vgg16_example.hs view
@@ -47,7 +47,7 @@ -- Specify inputs and outputs vpt <- makeVariableProfileTable [(conv1_1_in_name, DTypeFloat, input_dims)]- [(fc6_out_name, DTypeFloat), (softmax_out_name, DTypeFloat)]+ [fc6_out_name, softmax_out_name] model_data optimizeModelData model_data vpt
menoh.cabal view
@@ -1,5 +1,5 @@ name: menoh-version: 0.2.0+version: 0.3.0 license: MIT license-file: LICENSE author: Masahiro Sakai <sakai@preferred.jp>@@ -55,7 +55,7 @@ , transformers >=0.3 && <0.6 , vector >=0.10 && <0.13 pkgconfig-depends:- menoh >=1.0.0 && <2.0.0+ menoh >=1.1.1 && <2.0.0 default-language: Haskell2010 executable vgg16_example@@ -95,6 +95,7 @@ Paths_menoh build-depends: base >=4 && <5+ , bytestring , async >=2.0.2 , filepath >=1.3 && <1.5 , JuicyPixels
src/Menoh.hs view
@@ -18,7 +18,7 @@ -- -- = Basic usage ----- 1. Load computation graph from ONNX file using 'makeModelDataFromONNX'.+-- 1. Load computation graph from ONNX file using 'makeModelDataFromONNXFile'. -- 2. Specify input variable type/dimentions (in particular batch size) and -- which output variables you want to retrieve. This can be done by -- constructing 'VariableProfileTable' using 'makeVariableProfileTable'.@@ -52,6 +52,15 @@ -- its unsafety. -- -----------------------------------------------------------------------------++#include "MachDeps.h"+#include <menoh/version.h>++#define MIN_VERSION_libmenoh(major,minor,patch) (\+ (major) < MENOH_MAJOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) < MENOH_MINOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) == MENOH_MINOR_VERSION && (patch) <= MENOH_PATCH_VERSION)+ module Menoh ( -- * Basic data types@@ -61,8 +70,18 @@ -- * ModelData type , ModelData (..)+ , makeModelDataFromONNXFile , makeModelDataFromONNX+ , makeModelDataFromONNXByteString , optimizeModelData+ -- ** Manual model data construction API+ , makeModelData+ , addParameterFromPtr+ , addNewNode+ , addInputNameToCurrentNode+ , addOutputNameToCurrentNode+ , AttributeType (..)+ , addAttribute -- * VariableProfileTable , VariableProfileTable (..)@@ -103,7 +122,9 @@ , makeVariableProfileTableBuilder , addInputProfileDims2 , addInputProfileDims4+ , addOutputName , addOutputProfile+ , AddOutput (..) , buildVariableProfileTable -- ** Builder for 'Model'@@ -139,8 +160,6 @@ import qualified Menoh.Base as Base import qualified Paths_menoh -#include "MachDeps.h"- -- ------------------------------------------------------------------------ -- | Functions in this module can throw this exception type.@@ -161,6 +180,12 @@ | ErrorFailedToConfigureOperator String | ErrorBackendError String | ErrorSameNamedVariableAlreadyExist String+ | UnsupportedInputDims String+ | SameNamedParameterAlreadyExist String+ | SameNamedAttributeAlreadyExist String+ | InvalidBackendConfigError String+ | InputNotFoundError String+ | OutputNotFoundError String deriving (Eq, Ord, Show, Read, Typeable) instance Exception Error@@ -194,6 +219,12 @@ , (Base.menohErrorCodeFailedToConfigureOperator , ErrorFailedToConfigureOperator) , (Base.menohErrorCodeBackendError , ErrorBackendError) , (Base.menohErrorCodeSameNamedVariableAlreadyExist , ErrorSameNamedVariableAlreadyExist)+ , (Base.menohErrorCodeUnsupportedInputDims , UnsupportedInputDims)+ , (Base.menohErrorCodeSameNamedParameterAlreadyExist, SameNamedParameterAlreadyExist)+ , (Base.menohErrorCodeSameNamedAttributeAlreadyExist, SameNamedAttributeAlreadyExist)+ , (Base.menohErrorCodeInvalidBackendConfigError , InvalidBackendConfigError)+ , (Base.menohErrorCodeInputNotFoundError , InputNotFoundError)+ , (Base.menohErrorCodeOutputNotFoundError , OutputNotFoundError) ] runInBoundThread' :: IO a -> IO a@@ -246,12 +277,23 @@ -- | @ModelData@ contains model parameters and computation graph structure. newtype ModelData = ModelData (ForeignPtr Base.MenohModelData) +{-# DEPRECATED makeModelDataFromONNX "use makeModelDataFromONNXFile instead" #-} -- | Load onnx file and make 'ModelData'. makeModelDataFromONNX :: MonadIO m => FilePath -> m ModelData-makeModelDataFromONNX fpath = liftIO $ withCString fpath $ \fpath' -> alloca $ \ret -> do+makeModelDataFromONNX = makeModelDataFromONNXFile++-- | Load onnx file and make 'ModelData'.+makeModelDataFromONNXFile :: MonadIO m => FilePath -> m ModelData+makeModelDataFromONNXFile fpath = liftIO $ withCString fpath $ \fpath' -> alloca $ \ret -> do runMenoh $ Base.menoh_make_model_data_from_onnx fpath' ret liftM ModelData $ newForeignPtr Base.menoh_delete_model_data_funptr =<< peek ret +-- | make 'ModelData' from on-memory 'BS.ByteString'.+makeModelDataFromONNXByteString :: MonadIO m => BS.ByteString -> m ModelData+makeModelDataFromONNXByteString b = liftIO $ BS.useAsCStringLen b $ \(p,len) -> alloca $ \ret -> do + runMenoh $ Base.menoh_make_model_data_from_onnx_data_on_memory p (fromIntegral len) ret+ liftM ModelData $ newForeignPtr Base.menoh_delete_model_data_funptr =<< peek ret+ -- | Optimize function for 'ModelData'. -- -- This function modify given 'ModelData'.@@ -260,6 +302,68 @@ withForeignPtr m $ \m' -> withForeignPtr vpt $ \vpt' -> runMenoh $ Base.menoh_model_data_optimize m' vpt' +-- | Make empty 'ModelData'+makeModelData :: MonadIO m => m ModelData+makeModelData = liftIO $ alloca $ \ret -> do+ runMenoh $ Base.menoh_make_model_data ret+ liftM ModelData $ newForeignPtr Base.menoh_delete_model_data_funptr =<< peek ret++-- | Add a new parameter in 'ModelData'+--+-- This API is tentative and will be changed in the future.+--+-- Duplication of parameter_name is not allowed and it throws error.+addParameterFromPtr :: MonadIO m => ModelData -> String -> DType -> Dims -> Ptr a -> m ()+addParameterFromPtr (ModelData m) name dtype dims p = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' -> withArrayLen (map fromIntegral dims) $ \n dims' ->+ runMenoh $ Base.menoh_model_data_add_parameter m' name' (fromIntegral (fromEnum dtype)) (fromIntegral n) dims' p++-- | Add a new node to 'ModelData'+addNewNode :: MonadIO m => ModelData -> String -> m ()+addNewNode (ModelData m) name = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_model_data_add_new_node m' name'++-- | Add a new input name to latest added node in 'ModelData'+addInputNameToCurrentNode :: MonadIO m => ModelData -> String -> m ()+addInputNameToCurrentNode (ModelData m) name = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_model_data_add_input_name_to_current_node m' name'++-- | Add a new output name to latest added node in 'ModelData'+addOutputNameToCurrentNode :: MonadIO m => ModelData -> String -> m ()+addOutputNameToCurrentNode (ModelData m) name = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_model_data_add_output_name_to_current_node m' name'++-- | A class of types that can be added to nodes using 'addAttribute'.+class AttributeType value where+ basicAddAttribute :: Ptr Base.MenohModelData -> CString -> value -> IO ()++instance AttributeType Int where+ basicAddAttribute m' name' value =+ runMenoh $ Base.menoh_model_data_add_attribute_int_to_current_node m' name' (fromIntegral value)++instance AttributeType Float where+ basicAddAttribute m' name' value =+ runMenoh $ Base.menoh_model_data_add_attribute_float_to_current_node m' name' (realToFrac value)++instance AttributeType [Int] where+ basicAddAttribute m' name' values =+ withArrayLen (map fromIntegral values) $ \n values' ->+ runMenoh $ Base.menoh_model_data_add_attribute_ints_to_current_node m' name' (fromIntegral n) values'++instance AttributeType [Float] where+ basicAddAttribute m' name' values =+ withArrayLen (map realToFrac values) $ \n values' ->+ runMenoh $ Base.menoh_model_data_add_attribute_floats_to_current_node m' name' (fromIntegral n) values'++-- | Add a new attribute to latest added node in model_data+addAttribute :: (AttributeType value, MonadIO m) => ModelData -> String -> value -> m ()+addAttribute (ModelData m) name value = liftIO $+ withForeignPtr m $ \m' -> withCString name $ \name' ->+ basicAddAttribute m' name' value+ -- ------------------------------------------------------------------------ -- | Builder for creation of 'VariableProfileTable'.@@ -273,16 +377,17 @@ liftM VariableProfileTableBuilder $ newForeignPtr Base.menoh_delete_variable_profile_table_builder_funptr =<< peek p addInputProfileDims :: MonadIO m => VariableProfileTableBuilder -> String -> DType -> Dims -> m ()-addInputProfileDims vpt name dtype dims =- case dims of- [num, size] -> addInputProfileDims2 vpt name dtype (num, size)- [num, channel, height, width] -> addInputProfileDims4 vpt name dtype (num, channel, height, width)- _ -> liftIO $ throwIO $ ErrorDimensionMismatch $ "Menoh.addInputProfileDims: cannot handle dims of length " ++ show (length dims)+addInputProfileDims (VariableProfileTableBuilder vpt) name dtype dims =+ liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' -> withArrayLen (map fromIntegral dims) $ \n dims' ->+ runMenoh $ Base.menoh_variable_profile_table_builder_add_input_profile+ vpt' name' (fromIntegral (fromEnum dtype)) (fromIntegral n) dims' -- | Add 2D input profile. -- -- Input profile contains name, dtype and dims @(num, size)@. -- This 2D input is conventional batched 1D inputs.+{-# DEPRECATED addInputProfileDims2 "use addInputProfileDims instead" #-} addInputProfileDims2 :: MonadIO m => VariableProfileTableBuilder@@ -301,6 +406,7 @@ -- Input profile contains name, dtype and dims @(num, channel, height, width)@. -- This 4D input is conventional batched image inputs. Image input is -- 3D (channel, height, width).+{-# DEPRECATED addInputProfileDims4 "use addInputProfileDims instead" #-} addInputProfileDims4 :: MonadIO m => VariableProfileTableBuilder@@ -314,6 +420,17 @@ vpt' name' (fromIntegral (fromEnum dtype)) (fromIntegral num) (fromIntegral channel) (fromIntegral height) (fromIntegral width) +-- | Add output name+--+-- Output profile contains name and dtype. Its 'Dims' and 'DType' are calculated+-- automatically, so that you don't need to specify explicitly.+addOutputName :: MonadIO m => VariableProfileTableBuilder -> String -> m ()+addOutputName (VariableProfileTableBuilder vpt) name = liftIO $+ withForeignPtr vpt $ \vpt' -> withCString name $ \name' ->+ runMenoh $ Base.menoh_variable_profile_table_builder_add_output_name+ vpt' name'++{-# DEPRECATED addOutputProfile "use addOutputName instead" #-} -- | Add output profile -- -- Output profile contains name and dtype. Its 'Dims' are calculated automatically,@@ -324,6 +441,16 @@ runMenoh $ Base.menoh_variable_profile_table_builder_add_output_profile vpt' name' (fromIntegral (fromEnum dtype)) +-- | Type class for abstracting 'addOutputProfile' and 'addOutputName'.+class AddOutput a where+ addOutput :: VariableProfileTableBuilder -> a -> IO ()++instance AddOutput String where+ addOutput = addOutputName++instance AddOutput (String, DType) where+ addOutput b (name,_dtype) = addOutputName b name+ -- | Factory function for 'VariableProfileTable' buildVariableProfileTable :: MonadIO m@@ -347,17 +474,16 @@ -- -- If you need finer control, you can use 'VariableProfileTableBuidler'. makeVariableProfileTable- :: MonadIO m+ :: (AddOutput a, MonadIO m) => [(String, DType, Dims)] -- ^ input names with dtypes and dims- -> [(String, DType)] -- ^ required output name list with dtypes+ -> [a] -- ^ required output informations (@`String`@ or @('String', 'DType')@) -> ModelData -- ^ model data -> m VariableProfileTable makeVariableProfileTable input_name_and_dims_pair_list required_output_name_list model_data = liftIO $ runInBoundThread' $ do b <- makeVariableProfileTableBuilder forM_ input_name_and_dims_pair_list $ \(name,dtype,dims) -> do addInputProfileDims b name dtype dims- forM_ required_output_name_list $ \(name,dtype) -> do- addOutputProfile b name dtype+ mapM_ (addOutput b) required_output_name_list buildVariableProfileTable b model_data -- | Accessor function for 'VariableProfileTable'
src/Menoh/Base.hsc view
@@ -24,6 +24,11 @@ #include <menoh/menoh.h> #include <menoh/version.h> +#define MIN_VERSION_libmenoh(major,minor,patch) (\+ (major) < MENOH_MAJOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) < MENOH_MINOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) == MENOH_MINOR_VERSION && (patch) <= MENOH_PATCH_VERSION)+ type MenohDType = #type menoh_dtype type MenohErrorCode = #type menoh_error_code@@ -47,7 +52,13 @@ menoh_error_code_unsupported_operator, \ menoh_error_code_failed_to_configure_operator, \ menoh_error_code_backend_error, \- menoh_error_code_same_named_variable_already_exist+ menoh_error_code_same_named_variable_already_exist, \+ menoh_error_code_unsupported_input_dims, \+ menoh_error_code_same_named_parameter_already_exist, \+ menoh_error_code_same_named_attribute_already_exist, \+ menoh_error_code_invalid_backend_config_error, \+ menoh_error_code_input_not_found_error, \+ menoh_error_code_output_not_found_error foreign import ccall unsafe menoh_get_last_error_message :: IO CString@@ -58,6 +69,9 @@ foreign import ccall safe menoh_make_model_data_from_onnx :: CString -> Ptr MenohModelDataHandle -> IO MenohErrorCode +foreign import ccall safe menoh_make_model_data_from_onnx_data_on_memory+ :: Ptr a -> Int32 -> Ptr MenohModelDataHandle -> IO MenohErrorCode+ foreign import ccall "&menoh_delete_model_data" menoh_delete_model_data_funptr :: FunPtr (MenohModelDataHandle -> IO ()) @@ -71,6 +85,9 @@ menoh_delete_variable_profile_table_builder_funptr :: FunPtr (MenohVariableProfileTableBuilderHandle -> IO ()) +foreign import ccall unsafe menoh_variable_profile_table_builder_add_input_profile+ :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> Int32 -> Ptr Int32 -> IO MenohErrorCode+ foreign import ccall unsafe menoh_variable_profile_table_builder_add_input_profile_dims_2 :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> Int32 -> Int32 -> IO MenohErrorCode @@ -80,6 +97,9 @@ foreign import ccall unsafe menoh_variable_profile_table_builder_add_output_profile :: MenohVariableProfileTableBuilderHandle -> CString -> MenohDType -> IO MenohErrorCode +foreign import ccall unsafe menoh_variable_profile_table_builder_add_output_name+ :: MenohVariableProfileTableBuilderHandle -> CString -> IO MenohErrorCode+ data MenohVariableProfileTable type MenohVariableProfileTableHandle = Ptr MenohVariableProfileTable @@ -139,6 +159,33 @@ foreign import ccall safe menoh_model_run :: MenohModelHandle -> IO MenohErrorCode++foreign import ccall unsafe menoh_make_model_data+ :: Ptr MenohModelDataHandle -> IO MenohErrorCode++foreign import ccall safe menoh_model_data_add_parameter+ :: MenohModelDataHandle -> CString -> MenohDType -> Int32 -> Ptr Int32 -> Ptr a -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_new_node+ :: MenohModelDataHandle -> CString -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_input_name_to_current_node+ :: MenohModelDataHandle -> CString -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_output_name_to_current_node+ :: MenohModelDataHandle -> CString -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_attribute_int_to_current_node+ :: MenohModelDataHandle -> CString -> Int32 -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_attribute_float_to_current_node+ :: MenohModelDataHandle -> CString -> CFloat -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_attribute_ints_to_current_node+ :: MenohModelDataHandle -> CString -> Int32 -> Ptr CInt -> IO MenohErrorCode++foreign import ccall unsafe menoh_model_data_add_attribute_floats_to_current_node+ :: MenohModelDataHandle -> CString -> Int32 -> Ptr CFloat -> IO MenohErrorCode menoh_major_version :: Int menoh_major_version = #const MENOH_MAJOR_VERSION
test/test.hs view
@@ -1,11 +1,14 @@ {-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} import qualified Codec.Picture as Picture+import qualified Codec.Picture.Types as Picture import Control.Concurrent.Async import Control.Exception import Control.Monad+import qualified Data.ByteString as BS import qualified Data.Vector as V import qualified Data.Vector.Generic as VG import qualified Data.Vector.Storable as VS@@ -19,6 +22,13 @@ import Menoh import Paths_menoh (getDataDir) +#include <menoh/version.h>++#define MIN_VERSION_libmenoh(major,minor,patch) (\+ (major) < MENOH_MAJOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) < MENOH_MINOR_VERSION || \+ (major) == MENOH_MAJOR_VERSION && (minor) == MENOH_MINOR_VERSION && (patch) <= MENOH_PATCH_VERSION)+ ------------------------------------------------------------------------ case_basicWriteBuffer_vector :: Assertion@@ -62,7 +72,7 @@ case_loading_nonexistent_model_file :: Assertion case_loading_nonexistent_model_file = do dataDir <- getDataDir- ret <- try $ makeModelDataFromONNX $ dataDir </> "data" </> "nonexistent_model.onnx"+ ret <- try $ makeModelDataFromONNXFile $ dataDir </> "data" </> "nonexistent_model.onnx" case ret of Left (ErrorInvalidFilename _msg) -> return () _ -> assertFailure "should throw ErrorInvalidFilename"@@ -74,10 +84,10 @@ let batch_size = length images dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx" vpt <- makeVariableProfileTable [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]- []+ ([] :: [String]) model_data optimizeModelData model_data vpt model <- makeModel vpt model_data "mkldnn"@@ -93,10 +103,10 @@ case_insufficient_input :: Assertion case_insufficient_input = do dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx" ret <- try $ makeVariableProfileTable []- [(mnist_out_name, DTypeFloat)]+ [mnist_out_name] model_data case ret of Left (ErrorVariableNotFound _msg) -> return ()@@ -108,38 +118,30 @@ images <- loadMNISTImages dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"- vpt <- makeVariableProfileTable+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx"+ ret <- try $ makeVariableProfileTable [ (mnist_in_name, DTypeFloat, [length images, mnist_channel_num, mnist_height, mnist_width]) , ("bad input name", DTypeFloat, [1,8]) ]- [(mnist_out_name, DTypeFloat)]+ [mnist_out_name] model_data- optimizeModelData model_data vpt- model <- makeModel vpt model_data "mkldnn"-- -- Run the model- writeBuffer model mnist_in_name images- run model- (vs :: [V.Vector Float]) <- readBuffer model mnist_out_name- forM_ (zip [0..9] vs) $ \(i, scores) -> do- V.maxIndex scores @?= i-+ case ret of+ Left (InputNotFoundError _msg) -> return ()+ _ -> assertFailure "should throw InputNotFoundError" case_bad_output :: Assertion case_bad_output = do images <- loadMNISTImages dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx" ret <- try $ makeVariableProfileTable [(mnist_in_name, DTypeFloat, [length images, mnist_channel_num, mnist_height, mnist_width])]- [(mnist_out_name, DTypeFloat), ("bad output name", DTypeFloat)]+ [mnist_out_name, "bad output name"] model_data case ret of- Left (ErrorVariableNotFound _msg) -> return ()- _ -> assertFailure "should throw ErrorVariableNotFound"-+ Left (OutputNotFoundError _msg) -> return ()+ _ -> assertFailure "should throw OutputNotFoundError" ------------------------------------------------------------------------ @@ -160,19 +162,36 @@ ret <- Picture.readImage $ dataDir </> "data" </> (show i ++ ".png") case ret of Left e -> error e- Right img -> return $ convert mnist_width mnist_height img+ Right img -> return+ $ VG.map fromIntegral+ $ Picture.imageData+ $ Picture.extractLumaPlane+ $ Picture.convertRGB8+ $ img loadMNISTModel :: Int -> IO Model loadMNISTModel batch_size = do dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx" vpt <- makeVariableProfileTable [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]- [(mnist_out_name, DTypeFloat)]+ [mnist_out_name] model_data optimizeModelData model_data vpt makeModel vpt model_data "mkldnn" +loadMNISTModelFromByteString :: Int -> IO Model+loadMNISTModelFromByteString batch_size = do+ dataDir <- getDataDir+ b <- BS.readFile $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXByteString b+ vpt <- makeVariableProfileTable+ [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]+ [mnist_out_name]+ model_data+ optimizeModelData model_data vpt+ makeModel vpt model_data "mkldnn"+ case_MNIST :: Assertion case_MNIST = do images <- loadMNISTImages@@ -198,10 +217,10 @@ let batch_size = length images dataDir <- getDataDir- model_data <- makeModelDataFromONNX $ dataDir </> "data" </> "mnist.onnx"+ model_data <- makeModelDataFromONNXFile $ dataDir </> "data" </> "mnist.onnx" vpt <- makeVariableProfileTable [(mnist_in_name, DTypeFloat, [batch_size, mnist_channel_num, mnist_height, mnist_width])]- [(mnist_out_name, DTypeFloat)]+ [mnist_out_name] model_data optimizeModelData model_data vpt models <- replicateM 10 $ makeModel vpt model_data "mkldnn"@@ -215,34 +234,50 @@ V.maxIndex scores @?= i return () --- -------------------------------------------------------------------------+case_makeModelDataFromONNXByteString :: Assertion+case_makeModelDataFromONNXByteString = do+ images <- loadMNISTImages+ model1 <- loadMNISTModel (length images)+ model2 <- loadMNISTModelFromByteString (length images) -convert :: Int -> Int -> Picture.DynamicImage -> VS.Vector Float-convert w h = reorderToNCHW . resize (w,h) . crop . Picture.convertRGB8+ -- Run the model (1)+ writeBuffer model1 mnist_in_name images+ run model1+ (vs1 :: [V.Vector Float]) <- readBuffer model1 mnist_out_name -crop :: Picture.Pixel a => Picture.Image a -> Picture.Image a-crop img = Picture.generateImage (\x y -> Picture.pixelAt img (base_x + x) (base_y + y)) shortEdge shortEdge- where- shortEdge = min (Picture.imageWidth img) (Picture.imageHeight img)- base_x = (Picture.imageWidth img - shortEdge) `div` 2- base_y = (Picture.imageHeight img - shortEdge) `div` 2+ -- Run the model (2)+ writeBuffer model2 mnist_in_name images+ run model2+ (vs2 :: [V.Vector Float]) <- readBuffer model2 mnist_out_name --- TODO: Should we do some kind of interpolation?-resize :: Picture.Pixel a => (Int,Int) -> Picture.Image a -> Picture.Image a-resize (w,h) img = Picture.generateImage (\x y -> Picture.pixelAt img (x * orig_w `div` w) (y * orig_h `div` h)) w h- where- orig_w = Picture.imageWidth img- orig_h = Picture.imageHeight img+ vs2 @?= vs1 -reorderToNCHW :: Picture.Image Picture.PixelRGB8 -> VS.Vector Float-reorderToNCHW img = VS.generate (Picture.imageHeight img * Picture.imageWidth img) f- where- f i =- case Picture.pixelAt img x y of- Picture.PixelRGB8 r g b ->- (fromIntegral r + fromIntegral g + fromIntegral b) / 3- where- (y,x) = i `divMod` Picture.imageWidth img+case_makeModelData :: Assertion+case_makeModelData = do+ md <- makeModelData+ withArray [1,2,3,4,5,6] $ \(p :: Ptr Float) ->+ addParameterFromPtr md "W" DTypeFloat [2,3] p+ withArray [7,8] $ \(p :: Ptr Float) ->+ addParameterFromPtr md "b" DTypeFloat [2] p+ addNewNode md "FC"+ addInputNameToCurrentNode md "input"+ addInputNameToCurrentNode md "W"+ addInputNameToCurrentNode md "b"+ addOutputNameToCurrentNode md "output"++ vpt <- makeVariableProfileTable+ [("input", DTypeFloat, [1, 3])]+ ["output"]+ md++ optimizeModelData md vpt+ m <- makeModel vpt md "mkldnn"++ writeBuffer m "input" $ [VS.fromList [1::Float,2,3]]+ run m+ [r] <- readBuffer m "output"++ r @?= VS.fromList [21::Float,40] ------------------------------------------------------------------------ -- Test harness