summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMasahiroSakai <>2018-11-08 10:08:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-11-08 10:08:00 (GMT)
commit5b371977a4c330b511939af2be267a4cb589c052 (patch)
tree3273c6cafe8304b6dddfb824d6fc7dcf83345970
parenta0c53fbee23ad718e68991099c8d08071c4e6668 (diff)
version 0.3.0HEAD0.3.0master
-rw-r--r--app/mnist_example.hs89
-rw-r--r--app/vgg16_example.hs2
-rw-r--r--menoh.cabal5
-rw-r--r--src/Menoh.hs152
-rw-r--r--src/Menoh/Base.hsc49
-rw-r--r--test/test.hs139
6 files changed, 312 insertions, 124 deletions
diff --git a/app/mnist_example.hs b/app/mnist_example.hs
index 8f9e1ca..9db1f9b 100644
--- 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 @@ main = do
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,17 +62,22 @@ main = do
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 ""
-- -------------------------------------------------------------------------
@@ -122,31 +120,12 @@ parserInfo dir = info (helper <*> versionOption <*> optionsParser dir)
-- -------------------------------------------------------------------------
-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
index 1cbca63..d9c65fe 100644
--- a/app/vgg16_example.hs
+++ b/app/vgg16_example.hs
@@ -47,7 +47,7 @@ main = do
-- 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
index 0448c70..57c35be 100644
--- 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 <sakai@preferred.jp>
@@ -55,7 +55,7 @@ library
, 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 @@ Test-suite Test
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
index b946ac2..58f9b81 100644
--- 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 <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 @@ module Menoh
-- * 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 @@ module Menoh
, makeVariableProfileTableBuilder
, addInputProfileDims2
, addInputProfileDims4
+ , addOutputName
, addOutputProfile
+ , AddOutput (..)
, buildVariableProfileTable
-- ** Builder for 'Model'
@@ -139,8 +160,6 @@ import Foreign.C
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 @@ data Error
| 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 @@ runMenoh m = runInBoundThread' $ do
, (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 @@ type Dims = [Int]
-- | @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 @@ optimizeModelData (ModelData m) (VariableProfileTable vpt) = liftIO $
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 @@ makeVariableProfileTableBuilder = liftIO $ alloca $ \p -> do
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 @@ addInputProfileDims2 (VariableProfileTableBuilder vpt) name dtype (num, size) =
-- 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 @@ addInputProfileDims4 (VariableProfileTableBuilder vpt) name dtype (num, channel,
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 @@ addOutputProfile (VariableProfileTableBuilder vpt) name dtype = liftIO $
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 @@ newtype VariableProfileTable
--
-- 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
index 20b1442..8a1cf48 100644
--- a/src/Menoh/Base.hsc
+++ b/src/Menoh/Base.hsc
@@ -24,6 +24,11 @@ import Foreign.C
#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 @@ type MenohErrorCode = #type menoh_error_code
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 @@ type MenohModelDataHandle = Ptr MenohModelData
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 @@ foreign import ccall "&menoh_delete_variable_profile_table_builder"
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_input_profi
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
@@ -140,6 +160,33 @@ foreign import ccall unsafe menoh_model_get_variable_dims_at
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
index f9594e0..b394bb8 100644
--- 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 Test.Tasty.TH
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_basicWriteBuffer_list = do
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 @@ case_empty_output = do
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_empty_output = do
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 @@ case_bad_input = do
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,15 +162,32 @@ loadMNISTImages = do
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"
@@ -198,10 +217,10 @@ case_MNIST_concurrently = do
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 @@ case_MNIST_concurrently = do
V.maxIndex scores @?= i
return ()
--- -------------------------------------------------------------------------
+case_makeModelDataFromONNXByteString :: Assertion
+case_makeModelDataFromONNXByteString = do
+ images <- loadMNISTImages
+ model1 <- loadMNISTModel (length images)
+ model2 <- loadMNISTModelFromByteString (length images)
+
+ -- Run the model (1)
+ writeBuffer model1 mnist_in_name images
+ run model1
+ (vs1 :: [V.Vector Float]) <- readBuffer model1 mnist_out_name
+
+ -- Run the model (2)
+ writeBuffer model2 mnist_in_name images
+ run model2
+ (vs2 :: [V.Vector Float]) <- readBuffer model2 mnist_out_name
+
+ vs2 @?= vs1
+
+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"
-convert :: Int -> Int -> Picture.DynamicImage -> VS.Vector Float
-convert w h = reorderToNCHW . resize (w,h) . crop . Picture.convertRGB8
+ vpt <- makeVariableProfileTable
+ [("input", DTypeFloat, [1, 3])]
+ ["output"]
+ md
-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
+ optimizeModelData md vpt
+ m <- makeModel vpt md "mkldnn"
--- 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
+ writeBuffer m "input" $ [VS.fromList [1::Float,2,3]]
+ run m
+ [r] <- readBuffer m "output"
-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
+ r @?= VS.fromList [21::Float,40]
------------------------------------------------------------------------
-- Test harness