multilinear-io 0.2.1.2 → 0.2.3
raw patch · 10 files changed
+471/−315 lines, 10 filesdep +cassavadep +conduitdep +directorydep −csv-enumeratorsetup-changed
Dependencies added: cassava, conduit, directory
Dependencies removed: csv-enumerator
Files
- ChangeLog.md +7/−0
- README.md +23/−2
- Setup.hs +2/−2
- benchmark/Bench.hs +89/−35
- multilinear-io.cabal +51/−10
- src/Multilinear/Generic/Serialize.hs +170/−154
- test/Spec.hs +0/−112
- test/binary/Spec.hs +43/−0
- test/csv/Spec.hs +43/−0
- test/json/Spec.hs +43/−0
+ ChangeLog.md view
@@ -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
README.md view
@@ -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): [](https://travis-ci.org/ArturB/multilinear) +- AppVeyor (Windows): [](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
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
benchmark/Bench.hs view
@@ -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)
multilinear-io.cabal view
@@ -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 <https://hackage.haskell.org/package/multilinear>. Supports various file formats: binary, CSV, JSON. More information available on GitHub: <https://github.com/ArturB/multilinear-io#readme> 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
src/Multilinear/Generic/Serialize.hs view
@@ -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!"
− test/Spec.hs
@@ -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-
+ test/binary/Spec.hs view
@@ -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 ()
+ test/csv/Spec.hs view
@@ -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 ()
+ test/json/Spec.hs view
@@ -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 ()