diff --git a/app/mnist_example.hs b/app/mnist_example.hs --- a/app/mnist_example.hs +++ b/app/mnist_example.hs @@ -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' -- ------------------------------------------------------------------------- diff --git a/app/vgg16_example.hs b/app/vgg16_example.hs --- a/app/vgg16_example.hs +++ b/app/vgg16_example.hs @@ -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 diff --git a/menoh.cabal b/menoh.cabal --- a/menoh.cabal +++ b/menoh.cabal @@ -1,5 +1,5 @@ name: menoh -version: 0.2.0 +version: 0.3.0 license: MIT license-file: LICENSE author: Masahiro Sakai @@ -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 diff --git a/src/Menoh.hs b/src/Menoh.hs --- a/src/Menoh.hs +++ b/src/Menoh.hs @@ -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 + +#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' diff --git a/src/Menoh/Base.hsc b/src/Menoh/Base.hsc --- a/src/Menoh/Base.hsc +++ b/src/Menoh/Base.hsc @@ -24,6 +24,11 @@ #include #include +#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 diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -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 + +#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