diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,7 @@ +# 0.2.3, 2018-11-02 +- IO ported to Conduit based +- support for CSV with cassava +- added criterion benchmarks + +# 0.2.1, 2018-11-01 +Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,2 +1,23 @@ -# multilinear-io -Input/output capability in various formats (binary, CSV, JSON) for Multilinear package in Haskell. +# README + +## Build status +- Travis (Linux, macOS): [![Build Status](https://travis-ci.org/ArturB/multilinear.svg?branch=master)](https://travis-ci.org/ArturB/multilinear) +- AppVeyor (Windows): [![Tests status](https://ci.appveyor.com/api/projects/status/github/ArturB/multilinear +)](https://ci.appveyor.com/api/projects/status/github/ArturB/multilinear) + +## Summary +This package provides conduit-based input/output capability for [Multilinear](https://github.com/ArturB/multilinear) package, in various formats: +- binary, zlib compressed +- JSON +- CSV + +Other formats to be proposed and implemented. + +## Contribution + +If you want to contribute to this library, contact with me. + +## Who do I talk to? + +All copyrights to Artur M. Brodzki. +Contact mail: artur@brodzki.org diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/benchmark/Bench.hs b/benchmark/Bench.hs --- a/benchmark/Bench.hs +++ b/benchmark/Bench.hs @@ -1,35 +1,89 @@ -{-| -Module : Bench -Description : Benchmark of Multilinear library -Copyright : (c) Artur M. Brodzki, 2018 -License : BSD3 -Maintainer : artur@brodzki.org -Stability : experimental -Portability : Windows/POSIX - --} - -module Main ( - main -) where - -import Control.DeepSeq -import Criterion.Main -import Criterion.Measurement as Meas -import Criterion.Types -import Multilinear.Generic -import qualified Multilinear.Matrix as Matrix - -m1 :: Tensor Double -m1 = Matrix.fromIndices "ij" 1000 1000 $ \i j -> fromIntegral (2*i) - exp (fromIntegral j) - -m2 :: Tensor Double -m2 = Matrix.fromIndices "jk" 1000 1000 $ \i j -> sin (fromIntegral i) + cos (fromIntegral j) - -main :: IO () -main = do - putStrLn "Two matrices 1000x1000 multiplying..." - (meas,_) <- Meas.measure ( nfIO $ (m1 * m2) `deepseq` putStrLn "End!" ) 1 - putStrLn $ "Measured time: " ++ show (measCpuTime meas) ++ " s." - return () - +{-| +Module : Bench +Description : Benchmark of Multilinear library +Copyright : (c) Artur M. Brodzki, 2018 +License : BSD3 +Maintainer : artur@brodzki.org +Stability : experimental +Portability : Windows/POSIX + +-} + +module Main ( + main +) where + +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Criterion.Main +import Multilinear.Generic +import Multilinear.Generic.Serialize +import qualified Multilinear.Matrix as Matrix +import System.Directory + +pathPref :: String +pathPref = "benchmark/matrix-" + +gen :: Int -> Int -> Double +gen j k = sin (fromIntegral j) + cos (fromIntegral k) + +writeMatrixBinaryBench :: Int -> Benchmark +writeMatrixBinaryBench s = + let path = pathPref ++ show s ++ ".zlib" in + bench (show s ++ "x" ++ show s) $ + nfIO $ toBinaryFile (Matrix.fromIndices "ij" s s gen) path + +readMatrixBinaryBench :: Int -> Benchmark +readMatrixBinaryBench s = do + let path = pathPref ++ show s ++ ".zlib" + let tensorDoubleIOT = fromBinaryFile path :: ExceptT String IO (Tensor Double) + bench (show s ++ "x" ++ show s) $ + nfIO $ runExceptT tensorDoubleIOT + +writeMatrixJSONBench :: Int -> Benchmark +writeMatrixJSONBench s = + let path = pathPref ++ show s ++ ".json" in + bench (show s ++ "x" ++ show s) $ + nfIO $ toJSONFile (Matrix.fromIndices "ij" s s gen) path + +readMatrixJSONBench :: Int -> Benchmark +readMatrixJSONBench s = do + let path = pathPref ++ show s ++ ".json" + let tensorDoubleIOT = fromJSONFile path :: MaybeT IO (Tensor Double) + bench (show s ++ "x" ++ show s) $ + nfIO $ runMaybeT tensorDoubleIOT + +writeMatrixCSVBench :: Int -> Benchmark +writeMatrixCSVBench s = + let path = pathPref ++ show s ++ ".csv" in + bench (show s ++ "x" ++ show s) $ + nfIO $ toCSVFile (Matrix.fromIndices "ij" s s gen) path + +readMatrixCSVBench :: Int -> Benchmark +readMatrixCSVBench s = do + let path = pathPref ++ show s ++ ".csv" + let tensorDoubleIOT = fromCSVFile path ',' "ij" :: ExceptT String IO (Tensor Double) + bench (show s ++ "x" ++ show s) $ + nfIO $ runExceptT tensorDoubleIOT + +benchSizes :: [Int] +benchSizes = [100, 200, 400, 800, 1600] + +-- ENTRY POINT +mainBench :: IO () +mainBench = defaultMain [ + bgroup "matrix binary write" $ writeMatrixBinaryBench <$> benchSizes, + bgroup "matrix binary read" $ readMatrixBinaryBench <$> benchSizes, + bgroup "matrix JSON write" $ writeMatrixJSONBench <$> benchSizes, + bgroup "matrix JSON read" $ readMatrixJSONBench <$> benchSizes, + bgroup "matrix CSV write" $ writeMatrixCSVBench <$> benchSizes, + bgroup "matrix CSV read" $ readMatrixCSVBench <$> benchSizes + ] + +main :: IO () +main = do + mainBench + let pathsBinary = (\s -> pathPref ++ show s ++ ".zlib") <$> benchSizes + let pathsJSON = (\s -> pathPref ++ show s ++ ".json") <$> benchSizes + let pathsCSV = (\s -> pathPref ++ show s ++ ".csv") <$> benchSizes + mapM_ removeFile (pathsBinary ++ pathsJSON ++ pathsCSV) diff --git a/multilinear-io.cabal b/multilinear-io.cabal --- a/multilinear-io.cabal +++ b/multilinear-io.cabal @@ -1,11 +1,13 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- --- hash: d5eb0d5bc61cffa4450cc9e59913c7c8fce5aba6af63c5dd05316971821945cd +-- hash: f722f54ad6081f3a4e98e1615679d778fd0ba99c89c3d5db3165762ff54a5bd3 name: multilinear-io -version: 0.2.1.2 +version: 0.2.3 synopsis: Input/output capability for multilinear package. description: Input & output capability for multilinear package . Supports various file formats: binary, CSV, JSON. More information available on GitHub: category: Machine learning @@ -17,9 +19,9 @@ license: BSD3 license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: README.md + ChangeLog.md source-repository head type: git @@ -34,15 +36,16 @@ Paths_multilinear_io hs-source-dirs: src - default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses + default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses ScopedTypeVariables ghc-options: -O2 -Wall build-depends: aeson , base >=4.7 && <5 , bytestring + , cassava , cereal , cereal-vector - , csv-enumerator + , conduit , either , multilinear >=0.2.0 && <0.3 , transformers @@ -50,23 +53,60 @@ , zlib default-language: Haskell2010 -test-suite multilinear-io-test +test-suite binary type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Paths_multilinear_io hs-source-dirs: - test - default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses + test/binary + default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses ScopedTypeVariables ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , directory , either , multilinear >=0.2.0 && <0.3 , multilinear-io , transformers default-language: Haskell2010 +test-suite csv + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_multilinear_io + hs-source-dirs: + test/csv + default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses ScopedTypeVariables + ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , directory + , either + , multilinear >=0.2.0 && <0.3 + , multilinear-io + , transformers + default-language: Haskell2010 + +test-suite json + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_multilinear_io + hs-source-dirs: + test/json + default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses ScopedTypeVariables + ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , directory + , either + , multilinear >=0.2.0 && <0.3 + , multilinear-io + , transformers + default-language: Haskell2010 + benchmark multilinear-io-bench type: exitcode-stdio-1.0 main-is: Bench.hs @@ -74,12 +114,13 @@ Paths_multilinear_io hs-source-dirs: benchmark - default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses + default-extensions: DeriveGeneric FlexibleContexts FlexibleInstances MultiParamTypeClasses ScopedTypeVariables ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , criterion , deepseq + , directory , either , multilinear >=0.2.0 && <0.3 , multilinear-io diff --git a/src/Multilinear/Generic/Serialize.hs b/src/Multilinear/Generic/Serialize.hs --- a/src/Multilinear/Generic/Serialize.hs +++ b/src/Multilinear/Generic/Serialize.hs @@ -1,154 +1,170 @@ -{-| -Module : Multilinear.Generic.Serialize -Description : Generic array tensor serialization: binary, JSON, CSV. -Copyright : (c) Artur M. Brodzki, 2018 -License : BSD3 -Maintainer : artur@brodzki.org -Stability : experimental -Portability : Windows/POSIX - --} - -module Multilinear.Generic.Serialize ( - toBinary, toBinaryFile, - fromBinary, fromBinaryFile, - Multilinear.Generic.Serialize.toJSON, toJSONFile, - Multilinear.Generic.Serialize.fromJSON, fromJSONFile, - fromCSV, toCSV -) where - -import Codec.Compression.GZip -import Control.Exception -import Control.Monad.Trans.Class -import Control.Monad.Trans.Either -import Control.Monad.Trans.Maybe -import Data.Aeson -import qualified Data.ByteString.Lazy as ByteString -import Data.CSV.Enumerator -import Data.Either -import Data.Serialize -import qualified Data.Vector as Boxed -import Data.Vector.Serialize () -import Multilinear.Class -import Multilinear.Generic -import qualified Multilinear.Index.Finite as Finite -import Multilinear.Index.Finite.Serialize () -import Multilinear.Index.Infinite.Serialize () - --- Binary serialization instance -instance Serialize a => Serialize (Tensor a) --- JSON serialization instance -instance ToJSON a => ToJSON (Tensor a) --- JSON deserialization instance -instance FromJSON a => FromJSON (Tensor a) - -invalidIndices :: String -- ^ CSV error message -invalidIndices = "Indices and its sizes not compatible with structure of matrix!" - -deserializationError :: String -- ^ CSV error message -deserializationError = "Components deserialization error!" - -{-| Serialize tensor to binary string -} -toBinary :: ( - Serialize a - ) => Tensor a -- ^ Tensor to serialize - -> ByteString.ByteString -- ^ Tensor serialized to lazy ByteString -toBinary = Data.Serialize.encodeLazy - -{-| Write tensor to binary file. Uses compression with gzip -} -toBinaryFile :: ( - Serialize a - ) => String -- ^ File name - -> Tensor a -- ^ Tensor to serialize - -> IO () -toBinaryFile name = ByteString.writeFile name . compress . toBinary - -{-| Deserialize tensor from binary string -} -fromBinary :: ( - Serialize a - ) => ByteString.ByteString -- ^ ByteString to deserialize - -> Either String (Tensor a) -- ^ Deserialized tensor or an error message. -fromBinary = Data.Serialize.decodeLazy - -{-| Read tensor from binary file -} -fromBinaryFile :: ( - Serialize a - ) => String -- ^ File path. - -> EitherT String IO (Tensor a) -- ^ Deserialized tensor or an error message -fromBinaryFile name = do - contents <- lift $ ByteString.readFile name - EitherT $ return $ fromBinary $ decompress contents - -{-| Serialize tensor to JSON string -} -toJSON :: ( - ToJSON a - ) => Tensor a -- ^ Tensor to serialize. - -> ByteString.ByteString -- ^ Tensor serialized to lazy ByteString. -toJSON = Data.Aeson.encode - -{-| Write tensor to JSON file -} -toJSONFile :: ( - ToJSON a - ) => String -- ^ File path. - -> Tensor a -- ^ Tensor to serialize - -> IO () -toJSONFile name = ByteString.writeFile name . Multilinear.Generic.Serialize.toJSON - -{-| Deserialize tensor from JSON string -} -fromJSON :: ( - FromJSON a - ) => ByteString.ByteString -- ^ ByteString to deserialize - -> Maybe (Tensor a) -- ^ Deserialized tensor or Nothing, if deserialization error occured. -fromJSON = Data.Aeson.decode - -{-| Read tensor from JSON file -} -fromJSONFile :: ( - FromJSON a - ) => String -- ^ File path. - -> MaybeT IO (Tensor a) -- ^ Deserialized tensor or Nothing, if error occured. -fromJSONFile name = do - contents <- lift $ ByteString.readFile name - MaybeT $ return $ Multilinear.Generic.Serialize.fromJSON contents - -{-| Read tensor (matrix) components from CSV file. -} -{-# INLINE fromCSV #-} -fromCSV :: ( - Num a, Serialize a - ) => String -- ^ Indices names (one character per index, first character: rows index, second character: columns index) - -> String -- ^ CSV file name - -> Char -- ^ Separator expected to be used in this CSV file - -> EitherT SomeException IO (Tensor a) -- ^ Generated matrix or error message - -fromCSV x = case x of - [u,d] -> \fileName separator -> do - csv <- EitherT $ readCSVFile (CSVS separator (Just '"') (Just '"') separator) fileName - let components = (Data.Serialize.decode <$> ) <$> csv - let rows = length components - let columns = if rows > 0 then length $ rights (head components) else 0 - if rows > 0 && columns > 0 - then return $ - FiniteTensor (Finite.Contravariant rows [u]) $ ( - SimpleFinite (Finite.Covariant columns [d]) . Boxed.fromList . rights - ) <$> Boxed.fromList components - else EitherT $ return $ Left $ SomeException $ TypeError deserializationError - - _ -> \_ _ -> return $ Err invalidIndices - - -{-| Write matrix to CSV file. -} -{-# INLINE toCSV #-} -toCSV :: ( - Num a, Serialize a - ) => Tensor a -- ^ Matrix to serialize. If given tensor os not a matrix, an error occurs and no data (0 rows) are saved to file. - -> String -- ^ CSV file name - -> Char -- ^ Separator expected to be used in this CSV file - -> IO Int -- ^ Number of rows written - -toCSV t = case order t of - (1,1) -> \fileName separator -> - let t' = _standardize t - elems = Boxed.toList $ Boxed.toList . tensorScalars <$> tensorsFinite t' - encodedElems = (Data.Serialize.encode <$>) <$> elems - in writeCSVFile (CSVS separator (Just '"') (Just '"') separator) fileName encodedElems - - _ -> \_ _ -> return 0 +{-| +Module : Multilinear.Generic.Serialize +Description : Generic array tensor serialization: binary, JSON, CSV. +Copyright : (c) Artur M. Brodzki, 2018 +License : BSD3 +Maintainer : artur@brodzki.org +Stability : experimental +Portability : Windows/POSIX + +-} + +module Multilinear.Generic.Serialize ( + toBinary, toBinaryFile, + fromBinary, fromBinaryFile, + Multilinear.Generic.Serialize.toJSON, + Multilinear.Generic.Serialize.toJSONFile, + Multilinear.Generic.Serialize.fromJSON, + Multilinear.Generic.Serialize.fromJSONFile, + fromCSVFile, toCSVFile +) where + +import Codec.Compression.GZip +import Data.Conduit +import Data.Conduit.Combinators +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Data.Aeson +import qualified Data.ByteString.Internal as BS +import qualified Data.ByteString.Lazy as ByteString +import Data.Csv +import Data.Either +import Data.Serialize +import qualified Data.Vector as Boxed +import Data.Vector.Serialize () +import Multilinear.Generic +import qualified Multilinear.Index.Finite as Finite +import Multilinear.Index.Finite.Serialize () +import Multilinear.Index.Infinite.Serialize () + +-- Binary serialization instance +instance Serialize a => Serialize (Tensor a) +-- JSON serialization instance +instance ToJSON a => ToJSON (Tensor a) +-- JSON deserialization instance +instance FromJSON a => FromJSON (Tensor a) +-- CSV serialization instance +instance ToField a => ToRecord (Tensor a) where + toRecord (Scalar x) = record [toField x] + toRecord (SimpleFinite _ scalars) = toRecord scalars + toRecord _ = error "Only 1-order tensor may be converted to record!" +instance FromField a => FromRecord (Tensor a) where + parseRecord v = + if Boxed.length v == 1 then + Scalar <$> v .! 0 + else + --FiniteTensor (Finite.Covariant (Boxed.length v) "i") <$> v + error "non-scalar" + + + +{-| Serialize tensor to zlib compressed binary string -} +toBinary :: ( + Serialize a + ) => Tensor a -- ^ Tensor to serialize + -> ByteString.ByteString -- ^ Tensor serialized to lazy ByteString +toBinary = compress . Data.Serialize.encodeLazy + +{-| Write tensor to binary file. Uses compression with gzip -} +toBinaryFile :: ( + Serialize a + ) => Tensor a -- ^ Tensor to serialize + -> String -- ^ File name + -> IO () +toBinaryFile t fileName = do + let bs = toBinary t + runConduitRes $ + sourceLazy bs .| sinkFile fileName + +{-| Deserialize tensor from zlib compressed binary string -} +fromBinary :: ( + Serialize a + ) => ByteString.ByteString -- ^ ByteString to deserialize + -> Either String (Tensor a) -- ^ Deserialized tensor or an error message. +fromBinary = Data.Serialize.decodeLazy . decompress + +{-| Read tensor from binary file -} +fromBinaryFile :: ( + Serialize a + ) => String -- ^ File path. + -> ExceptT String IO (Tensor a) -- ^ Deserialized tensor or an error message +fromBinaryFile fileName = do + contents <- lift $ runConduitRes $ + sourceFile fileName .| sinkLazy + ExceptT $ return $ fromBinary contents + +{-| Serialize tensor to JSON string -} +toJSON :: ( + ToJSON a + ) => Tensor a -- ^ Tensor to serialize. + -> ByteString.ByteString -- ^ Tensor serialized to lazy ByteString. +toJSON = Data.Aeson.encode + +{-| Write tensor to JSON file -} +toJSONFile :: ( + ToJSON a + ) => Tensor a -- ^ Tensor to serialize + -> String -- ^ File path. + -> IO () +toJSONFile t fileName = do + let bs = Multilinear.Generic.Serialize.toJSON t + runConduitRes $ + sourceLazy bs .| sinkFile fileName + +{-| Deserialize tensor from JSON string -} +fromJSON :: ( + FromJSON a + ) => ByteString.ByteString -- ^ ByteString to deserialize + -> Maybe (Tensor a) -- ^ Deserialized tensor or Nothing, if deserialization error occured. +fromJSON = Data.Aeson.decode + +{-| Read tensor from JSON file -} +fromJSONFile :: ( + FromJSON a + ) => String -- ^ File path. + -> MaybeT IO (Tensor a) -- ^ Deserialized tensor or Nothing, if error occured. +fromJSONFile fileName = do + contents <- lift $ runConduitRes $ + sourceFile fileName .| sinkLazy + MaybeT $ return $ Multilinear.Generic.Serialize.fromJSON contents + +{-| Write tensor to CSV file -} +toCSVFile :: ( + ToField a + ) => Tensor a -- ^ Tensor to serialize + -> String -- ^ File path + -> IO () +toCSVFile (FiniteTensor _ vrows) fileName = do + let rows = Boxed.toList vrows + let bs = Data.Csv.encode rows + runConduitRes $ + sourceLazy bs .| sinkFile fileName +toCSVFile (SimpleFinite _ vs) fileName = do + let rows = [vs] + let bs = Data.Csv.encode rows + runConduitRes $ + sourceLazy bs .| sinkFile fileName + + +{-| Read tensor from CSV -} +fromCSVFile :: ( + FromField a + ) => String -- ^ File path. + -> Char -- ^ CSV separator + -> String -- ^ Matrix indices names + -> ExceptT String IO (Tensor a) -- ^ Deserialized tensor or an error message +fromCSVFile fileName separator [conI,covI] = do + --let csvSettings = CSVSettings separator Nothing + contents <- lift $ runConduitRes $ + sourceFile fileName .| sinkLazy + let decodedData = Data.Csv.decodeWith (DecodeOptions (BS.c2w separator)) NoHeader contents :: FromField a => Either String (Boxed.Vector (Boxed.Vector a)) + if isLeft decodedData + then do + let msg = fromLeft "" decodedData + ExceptT $ return $ Left msg + else do + let components = fromRight (Boxed.empty) decodedData + let rows = (\r -> SimpleFinite (Finite.Covariant (Boxed.length r) [covI]) r) <$> components + ExceptT $ return $ Right $ FiniteTensor (Finite.Contravariant (Boxed.length rows) [conI]) rows +fromCSVFile _ _ _ = error "You must provide exactly two indices names!" diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 --- a/test/Spec.hs +++ /dev/null @@ -1,112 +0,0 @@ -module Main where - -import Control.Exception.Base -import Control.Monad.Trans.Either -import Control.Monad.Trans.Class -import Multilinear.Class as Multilinear -import Multilinear.Generic -import Multilinear.Generic.Serialize -import qualified Multilinear.Matrix as Matrix -import qualified Multilinear.Tensor as Tensor -import qualified Multilinear.Vector as Vector - --- PARAMETRY SKRYPTU -fi = signum -- funkcja aktywacji perceptronu -layers = 10 -- liczba warstw perceptronu - -mlp_input = "test/data/mlp_input.csv" -- dane uczące dla perceptronu -mlp_expected = "test/data/mlp_expected.csv" -- dane oczekiwane dla percepttronu -mlp_classify = "test/data/mlp_classify.csv" -- dane do klasyfikacji na nauczonym perceptronie -mlp_output = "test/data/mlp_output.csv" -- wyjście perceptronu -hopfield_input = "test/data/hopfield_input.csv" -- wzorce do zpamiętania dla sieci Hopfielda -hopfield_classify = "test/data/hopfield_classify.csv" -- dane do klasyfikacji dla sieci Hopfielda -hopfield_output = "test/data/hopfield_output.csv" -- wyjście sieci Hopfielda - - --- PERCEPTRON WIELOWARSTWOWY -perceptron :: Int -- ns: liczba neuronów w warstwie - -> Int -- ks: liczba warstw - -> Int -- ps: liczba wektorów uczących - -> Int -- cs: liczba wektorów do klasyfikacji - -> (Int -> Tensor Double) -- x t: wejścia uczące w funkcji czasu - -> (Int -> Tensor Double) -- e t: wyjścia oczekiwane w funkcji czasu - -> (Int -> Tensor Double) -- c t: dane do klasyfikacji w funkcji czasu - -> Tensor Double -- Tensor ("i","t"): zaklasyfikowane dane - -perceptron ns ks ps cs x e c = - let -- wagi startowe - zero = Tensor.const ("ki",[ks,ns]) ("j",[ns]) 0 - -- wagi w następnym kroku uczącym - nextWeights w x e = - let ygen [k] [] = -- tensor wyjść - if k == 0 then x $| ("j","") - else fi <$> w $$| ("k",[k - 1]) $| ("i","j") * ygen [k-1] [] $| ("j","") - y = Tensor.generate ("k",[ks + 1]) ("",[]) $ \[k] [] -> ygen [k] [] - -- tensor wejścia-wyjścia omega - om = Tensor.generate ("k",[ks]) ("",[]) $ - \[k] [] -> ygen [k + 1] [] $| ("i","") * ygen [k] [] $| ("j","") \/ "j" - incWgen [k] [] = -- inkrementacyjna propagacja wsteczna - if k == ks - 1 then x $| ("j","") \/ "j" * (y $$| ("k",[ks-1]) $| ("i","") - e $| ("i","")) - else Multilinear.transpose (w $$| ("k",[k+1])) $| ("i","b") * - incWgen [k+1] [] $| ("b","c") * - om $$| ("k",[k]) $| ("c","j") - incW = Tensor.generate ("k",[ks]) ("",[]) $ \[k] [] -> incWgen [k] [] - in w $| ("ki","j") + incW $| ("ki","j") - xl = take 2 $ x <$> [0 .. ps - 1] - el = take 2 $ e <$> [0 .. ps - 1] - -- uczenie sieci - learnedNetwork = foldr (\(x,e) w -> nextWeights w x e) zero $ zip xl el - -- praca nauczonej sieci - out t = fi <$> learnedNetwork $$| ("k",[ks-1]) $| ("i","j") * c t $| ("j","") - in Tensor.generate ("",[]) ("t",[cs]) $ \[] [t] -> out t - --- SIEĆ HOPFIELDA -hopfield :: Int -- ns: liczba neuronów w sieci - -> Int -- ps: liczba wzorców do zapamiętania - -> Int -- cs: liczba wzorców do klasyfikacji - -> Tensor Int -- x: macierz wektorów do zapamiętania - -> Tensor Int -- c: macierz wektorów do sklasyfikowania - -> Tensor Int -- macierz sklafyfikowanych wektorów -hopfield ns ps cs x c = - let -- 1 - deltaKroneckera - delta = Matrix.fromIndices "ij" ns ns $ \i j -> if i == j then 0 else 1 - -- wagi sieci ze wzorców - w = delta * x $| ("i","t") * (x $| ("j","t") \/ "j") * Vector.const "t" ps 1 - -- wyjście sieci: sieć działa rekurencyjnie aż do osiągnięcia stanu stabilnego - y inp = - let out = (\x -> if x > 0 then 1 else 0) <$> w $| ("i","j") * inp $| ("j","") - in if out $| ("i","") == inp $| ("i","") then out else y out - -- klasyfikacja zadanych wektorów - in Tensor.generate ("",[]) ("t",[cs]) $ \[] [t] -> y ((c $| ("i","t")) $$| ("t",[t])) - --- OPERACJE WEJŚCIA/WYJŚCIA -prog :: EitherT SomeException IO () -prog = do - -- wczytywanie danych - mlpInput <- fromCSV "tj" mlp_input ';' - mlpExp <- fromCSV "tj" mlp_expected ';' - mlpClas <- fromCSV "tj" mlp_classify ';' - hopInput <- fromCSV "tj" hopfield_input ';' - hopClas <- fromCSV "tj" hopfield_classify ';' - let mx t = Multilinear.transpose $ mlpInput $$| ("t",[t]) - let me t = Multilinear.transpose $ mlpExp $$| ("t",[t]) - let mc t = Multilinear.transpose $ mlpClas $$| ("t",[t]) - let hx = Multilinear.transpose $ hopInput $| ("it",[]) - let hc = Multilinear.transpose $ hopClas $| ("it",[]) - let (ns_mlp,ps_mlp,cs_mlp,ns_hop,ps_hop,cs_hop) = - (mlpInput `size` "j", mlpExp `size` "t", mlpClas `size` "t", - hopInput `size` "j", hopInput `size` "t", hopClas `size` "t") - -- perceptron - let mlp_net = perceptron ns_mlp layers ps_mlp cs_mlp mx me mc - smlp <- lift $ toCSV mlp_net mlp_output ';' - -- hopfield - let hop_net = hopfield ns_hop ps_hop cs_hop hx hc - shop <- lift $ toCSV hop_net hopfield_output ';' - lift $ putStrLn $ "Perceptron: " ++ show smlp ++ " vectors saved to '" ++ mlp_output ++ "'." - lift $ putStrLn $ "Hopfield: " ++ show shop ++ " vectors saved to '" ++ hopfield_output ++ "'." - return () - --- ENTRY POINT -main :: IO (Either SomeException ()) -main = runEitherT prog - diff --git a/test/binary/Spec.hs b/test/binary/Spec.hs new file mode 100644 --- /dev/null +++ b/test/binary/Spec.hs @@ -0,0 +1,43 @@ +module Main ( + main +) where + +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Data.Maybe +import Multilinear.Class +import Multilinear.Generic +import Multilinear.Generic.Serialize +import Multilinear.Index +import qualified Multilinear.Matrix as Matrix +import System.Directory + +fileName1 :: String +fileName1 = "test/m1" + +m1 :: Tensor Double +m1 = Matrix.fromIndices "ij" 500 500 $ \i j -> cos (fromIntegral i) + sin (fromIntegral j) + +writeMatrixBinary :: Tensor Double -> String -> IO () +writeMatrixBinary m fileName = do + let [xsize,ysize] = indexSize <$> indices m1 + putStrLn $ "Writing " ++ show (fromJust xsize) ++ "x" ++ show (fromJust ysize) ++ " matrix to " ++ fileName ++ ".zlib..." + m `toBinaryFile` (fileName ++ ".zlib") + putStrLn $ "Matrix successfully written!" + +readMatrixBinary :: String -> ExceptT String IO () +readMatrixBinary fileName = do + lift $ putStrLn $ "Reading matrix m1 from " ++ fileName ++ ".zlib..." + m1' <- fromBinaryFile (fileName ++ ".zlib") + if m1' == m1 then + lift $ putStrLn "Matrix successfully read!" + else + ExceptT $ return $ Left "Matrix deserialization error" + +-- ENTRY POINT +main :: IO () +main = do + writeMatrixBinary m1 fileName1 + runExceptT $ readMatrixBinary fileName1 + removeFile $ fileName1 ++ ".zlib" + return () diff --git a/test/csv/Spec.hs b/test/csv/Spec.hs new file mode 100644 --- /dev/null +++ b/test/csv/Spec.hs @@ -0,0 +1,43 @@ +module Main ( + main +) where + +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Data.Maybe +import Multilinear.Class +import Multilinear.Generic +import Multilinear.Generic.Serialize +import Multilinear.Index +import qualified Multilinear.Matrix as Matrix +import System.Directory + +fileName1 :: String +fileName1 = "test/m1" + +m1 :: Tensor Double +m1 = Matrix.fromIndices "ij" 500 500 $ \i j -> cos (fromIntegral i) + sin (fromIntegral j) + +writeMatrixCSV :: Tensor Double -> String -> IO () +writeMatrixCSV m fileName = do + let [xsize,ysize] = indexSize <$> indices m1 + putStrLn $ "Writing " ++ show (fromJust xsize) ++ "x" ++ show (fromJust ysize) ++ " matrix to " ++ fileName ++ ".csv..." + m `toCSVFile` (fileName ++ ".csv") + putStrLn "Matrix successfully written!" + +readMatrixCSV :: Tensor Double -> String -> ExceptT String IO () +readMatrixCSV m fileName = do + lift $ putStrLn $ "Reading matrix m1 from " ++ fileName ++ ".csv..." + (m1' :: Tensor Double) <- fromCSVFile (fileName ++ ".csv") ',' "ij" + if m1' == m then + lift $ putStrLn "Matrix successfully read!" + else + ExceptT $ return $ Left "Matrix deserialization error" + +-- ENTRY POINT +main :: IO () +main = do + writeMatrixCSV m1 fileName1 + runExceptT $ readMatrixCSV m1 fileName1 + removeFile $ fileName1 ++ ".csv" + return () diff --git a/test/json/Spec.hs b/test/json/Spec.hs new file mode 100644 --- /dev/null +++ b/test/json/Spec.hs @@ -0,0 +1,43 @@ +module Main ( + main +) where + +import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe +import Data.Maybe +import Multilinear.Class +import Multilinear.Generic +import Multilinear.Generic.Serialize +import Multilinear.Index +import qualified Multilinear.Matrix as Matrix +import System.Directory + +fileName1 :: String +fileName1 = "test/m1" + +m1 :: Tensor Double +m1 = Matrix.fromIndices "ij" 500 500 $ \i j -> cos (fromIntegral i) + sin (fromIntegral j) + +writeMatrixJSON :: Tensor Double -> String -> IO () +writeMatrixJSON m fileName = do + let [xsize,ysize] = indexSize <$> indices m1 + putStrLn $ "Writing " ++ show (fromJust xsize) ++ "x" ++ show (fromJust ysize) ++ " matrix to " ++ fileName ++ ".json..." + m `toJSONFile` (fileName ++ ".json") + putStrLn $ "Matrix successfully written!" + +readMatrixJSON :: String -> MaybeT IO () +readMatrixJSON fileName = do + lift $ putStrLn $ "Reading matrix m1 from " ++ fileName ++ ".json..." + m1' <- fromJSONFile (fileName ++ ".json") + if m1' == m1 then + lift $ putStrLn "Matrix successfully read!" + else + MaybeT $ return Nothing + +-- ENTRY POINT +main :: IO () +main = do + writeMatrixJSON m1 fileName1 + runMaybeT $ readMatrixJSON fileName1 + removeFile $ fileName1 ++ ".json" + return ()