Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit 250efc5b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev' into 428-dev-worker-fixes

parents 3c614d85 3192b0f5
Pipeline #7383 failed with stages
          Hide whitespace changes
          Inline Side-by-side
          Showing with 1020 additions and 211 deletions
          bench/Main.hs
          View file @ 250efc5b
          {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE OverloadedStrings #-}
          {-# LANGUAGE NumericUnderscores #-}
          {-# LANGUAGE BangPatterns #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TypeOperators #-}
          module Main where module Main where
          ...@@ -9,9 +14,19 @@ import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo) ...@@ -9,9 +14,19 @@ import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo)
          import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo) import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo)
          import Gargantext.Core.Viz.Phylo.PhyloTools import Gargantext.Core.Viz.Phylo.PhyloTools
          import Gargantext.Prelude.Crypto.Auth (createPasswordHash) import Gargantext.Prelude.Crypto.Auth (createPasswordHash)
          import Test.Tasty.Bench
          import Paths_gargantext import Paths_gargantext
          import qualified Data.Array.Accelerate as A
          import qualified Data.Array.Accelerate as Accelerate
          import qualified Data.Array.Accelerate.LLVM.Native as LLVM
          import qualified Data.Array.Accelerate.Interpreter as Naive
          import qualified Data.List.Split as Split
          import qualified Data.Massiv.Array as Massiv
          import qualified Gargantext.Core.LinearAlgebra as LA
          import qualified Gargantext.Core.Methods.Matrix.Accelerate.Utils as Accelerate
          import qualified Gargantext.Core.Methods.Similarities.Accelerate.Distributional as Accelerate
          import qualified Numeric.LinearAlgebra.Data as HM
          import Test.Tasty.Bench
          import Data.Array.Accelerate ((:.))
          phyloConfig :: PhyloConfig phyloConfig :: PhyloConfig
          phyloConfig = PhyloConfig { phyloConfig = PhyloConfig {
          ...@@ -37,10 +52,38 @@ phyloConfig = PhyloConfig { ...@@ -37,10 +52,38 @@ phyloConfig = PhyloConfig {
          , exportFilter = [ByBranchSize {_branch_size = 3.0}] , exportFilter = [ByBranchSize {_branch_size = 3.0}]
          } }
          matrixValues :: [Int]
          matrixValues = [ 1 .. 10_000 ]
          matrixDim :: Int
          matrixDim = 100
          testMatrix :: A.Matrix Int
          testMatrix = A.fromList (A.Z A.:. matrixDim A.:. matrixDim) $ matrixValues
          {-# INLINE testMatrix #-}
          testVector :: A.Array (A.Z :. Int :. Int :. Int) Int
          testVector = A.fromList (A.Z A.:. 20 A.:. 20 A.:. 20) $ matrixValues
          {-# INLINE testVector #-}
          testMassivMatrix :: Massiv.Matrix Massiv.U Int
          testMassivMatrix = Massiv.fromLists' Massiv.Par $ Split.chunksOf matrixDim $ matrixValues
          {-# INLINE testMassivMatrix #-}
          testMassivVector :: Massiv.Array Massiv.U Massiv.Ix3 Int
          testMassivVector = LA.accelerate2Massiv3DMatrix testVector
          {-# INLINE testMassivVector #-}
          main :: IO () main :: IO ()
          main = do main = do
          _issue290Phylo <- force . setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290.json") _issue290Phylo <- force . setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290.json")
          issue290PhyloSmall <- force . setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json") issue290PhyloSmall <- force . setConfig phyloConfig <$> (readPhylo =<< getDataFileName "bench-data/phylo/issue-290-small.json")
          let !accInput = force testMatrix
          let !accVector = force testVector
          let !massivVector = force testMassivVector
          let !(accDoubleInput :: Accelerate.Matrix Double) = force $ Naive.run $ Accelerate.map Accelerate.fromIntegral (Accelerate.use testMatrix)
          let !massivInput = force testMassivMatrix
          let !(massivDoubleInput :: Massiv.Matrix Massiv.U Double) = force $ Massiv.computeP $ Massiv.map fromIntegral testMassivMatrix
          defaultMain defaultMain
          [ bgroup "Benchmarks" [ bgroup "Benchmarks"
          [ bgroup "User creation" [ [ bgroup "User creation" [
          ...@@ -51,5 +94,59 @@ main = do ...@@ -51,5 +94,59 @@ main = do
          , bgroup "Phylo" [ , bgroup "Phylo" [
          bench "toPhylo (small)" $ nf toPhylo issue290PhyloSmall bench "toPhylo (small)" $ nf toPhylo issue290PhyloSmall
          ] ]
          , bgroup "logDistributional2" [
          bench "Accelerate (Naive)" $ nf (Accelerate.logDistributional2With @Double Naive.run) accInput
          , bench "Accelerate (LLVM)" $ nf (Accelerate.logDistributional2With @Double LLVM.run) accInput
          , bench "Massiv" $ nf (LA.logDistributional2 @_ @Double) massivInput
          ]
          , bgroup "distributional" [
          bench "Accelerate (Naive)" $ nf (Accelerate.distributionalWith @Double Naive.run) accInput
          , bench "Accelerate (LLVM)" $ nf (Accelerate.distributionalWith @Double LLVM.run) accInput
          , bench "Massiv (reference implementation)" $ nf (LA.distributionalReferenceImplementation @_ @Double) massivInput
          , bench "Massiv " $ nf (LA.distributional @_ @Double) massivInput
          ]
          , bgroup "diag" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.diag . Accelerate.use) accInput
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.diag . Accelerate.use) accInput
          , bench "Massiv " $ nf (LA.diag @_) massivInput
          ]
          , bgroup "matrixIdentity" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.matrixIdentity @Double) 1000
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.matrixIdentity @Double) 1000
          , bench "Massiv" $ nf (LA.matrixIdentity @Double) 1000
          , bench "HMatrix" $ nf (HM.ident @Double) 1000
          ]
          , bgroup "matrixEye" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.matrixEye @Double) 1000
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.matrixEye @Double) 1000
          , bench "Massiv " $ nf (LA.matrixEye @Double) 1000
          ]
          , bgroup "matMaxMini" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.matMaxMini @Double . Accelerate.use) accDoubleInput
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.matMaxMini @Double . Accelerate.use) accDoubleInput
          , bench "Massiv " $ nf LA.matMaxMini massivDoubleInput
          ]
          , bgroup "(.*)" [
          bench "Accelerate (Naive)" $ nf (\v -> Naive.run $ (Accelerate.use v) Accelerate..* (Accelerate.use v)) accDoubleInput
          , bench "Accelerate (LLVM)" $ nf (\v -> LLVM.run $ (Accelerate.use v) Accelerate..* (Accelerate.use v)) accDoubleInput
          , bench "Massiv " $ nf (\v -> (v LA..* v) :: Massiv.Matrix Massiv.U Double) massivDoubleInput
          ]
          , bgroup "sumRows" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.sum . Accelerate.use) accVector
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.sum . Accelerate.use) accVector
          , bench "Massiv " $ nf LA.sumRows massivVector
          ]
          , bgroup "sumMin_go" [
          bench "Accelerate (Naive)" $ nf (Naive.run . Accelerate.sumMin_go 100 . Accelerate.use) accDoubleInput
          , bench "Accelerate (LLVM)" $ nf (LLVM.run . Accelerate.sumMin_go 100 . Accelerate.use) accDoubleInput
          , bench "Massiv " $ nf (Massiv.compute @Massiv.U . LA.sumMin_go 100) massivDoubleInput
          ]
          , bgroup "termDivNan" [
          bench "Accelerate (Naive)" $
          nf (\m -> Naive.run $ Accelerate.termDivNan (Accelerate.use m) (Accelerate.use m)) accDoubleInput
          , bench "Accelerate (LLVM)" $
          nf (\m -> LLVM.run $ Accelerate.termDivNan (Accelerate.use m) (Accelerate.use m)) accDoubleInput
          , bench "Massiv " $ nf (\m -> LA.termDivNan @Massiv.U m m) massivDoubleInput
          ]
          ] ]
          ] ]
          bin/update-project-dependencies
          View file @ 250efc5b
          ...@@ -18,8 +18,8 @@ fi ...@@ -18,8 +18,8 @@ fi
          # with the `sha256sum` result calculated on the `cabal.project` and # with the `sha256sum` result calculated on the `cabal.project` and
          # `cabal.project.freeze`. This ensures the files stay deterministic so that CI # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
          # cache can kick in. # cache can kick in.
          expected_cabal_project_hash="57a8b73abcbcf2c44ad259d7c2c152060b570b6a9963d58ddf8f0d9acf9d781f" expected_cabal_project_hash="43ef700760f469f504cc78ccb7ca0fce80aba265a1bcac26e0db250b4b8562b6"
          expected_cabal_project_freeze_hash="163f5b7483c7408e9d365dd205d1d0e8beb147b22357d5f3c634a98640da7754" expected_cabal_project_freeze_hash="bf98c4373747e16acdba3e143ad67c978b53587918ee68b313237434dc21d56d"
          cabal --store-dir=$STORE_DIR v2-build --dry-run cabal --store-dir=$STORE_DIR v2-build --dry-run
          ......
          cabal.project
          View file @ 250efc5b
          ...@@ -5,6 +5,7 @@ index-state: 2024-09-12T03:02:26Z ...@@ -5,6 +5,7 @@ index-state: 2024-09-12T03:02:26Z
          with-compiler: ghc-9.4.8 with-compiler: ghc-9.4.8
          optimization: 2 optimization: 2
          benchmarks: False
          packages: packages:
          ./ ./
          ...@@ -14,13 +15,6 @@ source-repository-package ...@@ -14,13 +15,6 @@ source-repository-package
          location: https://github.com/AccelerateHS/accelerate.git location: https://github.com/AccelerateHS/accelerate.git
          tag: 334d05519436bb7f20f9926ec76418f5b8afa359 tag: 334d05519436bb7f20f9926ec76418f5b8afa359
          source-repository-package
          type: git
          location: https://github.com/AccelerateHS/accelerate-llvm.git
          tag: 2b5d69448557e89002c0179ea1aaf59bb757a6e3
          subdir: accelerate-llvm-native/
          accelerate-llvm/
          -- Patch for "Allow NOT to backtrack" -- Patch for "Allow NOT to backtrack"
          source-repository-package source-repository-package
          type: git type: git
          ...@@ -32,13 +26,6 @@ source-repository-package ...@@ -32,13 +26,6 @@ source-repository-package
          location: https://gitlab.iscpif.fr/gargantext/opaleye-textsearch.git location: https://gitlab.iscpif.fr/gargantext/opaleye-textsearch.git
          tag: 04b5c9044fef44393b66bffa258ca0b0f59c1087 tag: 04b5c9044fef44393b66bffa258ca0b0f59c1087
          source-repository-package
          type: git
          location: https://github.com/adinapoli/llvm-hs.git
          tag: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
          subdir: llvm-hs
          llvm-hs-pure
          source-repository-package source-repository-package
          type: git type: git
          location: https://github.com/alpmestan/accelerate-arithmetic.git location: https://github.com/alpmestan/accelerate-arithmetic.git
          ......
          cabal.project.freeze
          View file @ 250efc5b
          ...@@ -26,8 +26,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -26,8 +26,6 @@ constraints: any.Boolean ==0.2.4,
          any.accelerate ==1.3.0.0, any.accelerate ==1.3.0.0,
          accelerate +bounds-checks -debug -internal-checks -nofib -unsafe-checks, accelerate +bounds-checks -debug -internal-checks -nofib -unsafe-checks,
          any.accelerate-arithmetic ==1.0.0.1, any.accelerate-arithmetic ==1.0.0.1,
          any.accelerate-llvm ==1.3.0.0,
          any.accelerate-llvm-native ==1.3.0.0,
          any.accelerate-utility ==1.0.0.1, any.accelerate-utility ==1.0.0.1,
          any.adjunctions ==4.4.2, any.adjunctions ==4.4.2,
          any.aeson ==2.1.2.1, any.aeson ==2.1.2.1,
          ...@@ -308,9 +306,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -308,9 +306,6 @@ constraints: any.Boolean ==0.2.4,
          any.linear ==1.23, any.linear ==1.23,
          linear -herbie +template-haskell, linear -herbie +template-haskell,
          any.list-t ==1.0.5.7, any.list-t ==1.0.5.7,
          any.llvm-hs ==12.0.0,
          llvm-hs -debug -llvm-with-rtti +shared-llvm,
          any.llvm-hs-pure ==12.0.0,
          any.lockfree-queue ==0.2.4, any.lockfree-queue ==0.2.4,
          any.logict ==0.8.1.0, any.logict ==0.8.1.0,
          any.loop ==0.3.0, any.loop ==0.3.0,
          ......
          gargantext.cabal
          View file @ 250efc5b
          ...@@ -100,6 +100,10 @@ flag no-phylo-debug-logs ...@@ -100,6 +100,10 @@ flag no-phylo-debug-logs
          default: False default: False
          manual: True manual: True
          flag enable-benchmarks
          default: False
          manual: True
          library library
          import: import:
          defaults defaults
          ...@@ -188,9 +192,14 @@ library ...@@ -188,9 +192,14 @@ library
          Gargantext.Core.Config.Types Gargantext.Core.Config.Types
          Gargantext.Core.Config.Utils Gargantext.Core.Config.Utils
          Gargantext.Core.Config.Worker Gargantext.Core.Config.Worker
          Gargantext.Core.LinearAlgebra
          Gargantext.Core.LinearAlgebra.Distributional
          Gargantext.Core.LinearAlgebra.Operations
          Gargantext.Core.Mail Gargantext.Core.Mail
          Gargantext.Core.Mail.Types Gargantext.Core.Mail.Types
          Gargantext.Core.Methods.Matrix.Accelerate.Utils
          Gargantext.Core.Methods.Similarities Gargantext.Core.Methods.Similarities
          Gargantext.Core.Methods.Similarities.Accelerate.Distributional
          Gargantext.Core.Methods.Similarities.Conditional Gargantext.Core.Methods.Similarities.Conditional
          Gargantext.Core.NLP Gargantext.Core.NLP
          Gargantext.Core.NodeStory Gargantext.Core.NodeStory
          ...@@ -295,6 +304,9 @@ library ...@@ -295,6 +304,9 @@ library
          Gargantext.Database.Schema.User Gargantext.Database.Schema.User
          Gargantext.Defaults Gargantext.Defaults
          Gargantext.MicroServices.ReverseProxy Gargantext.MicroServices.ReverseProxy
          Gargantext.Orphans
          Gargantext.Orphans.Accelerate
          Gargantext.Orphans.OpenAPI
          Gargantext.System.Logging Gargantext.System.Logging
          Gargantext.Utils.Dict Gargantext.Utils.Dict
          Gargantext.Utils.Jobs.Error Gargantext.Utils.Jobs.Error
          ...@@ -303,6 +315,7 @@ library ...@@ -303,6 +315,7 @@ library
          Gargantext.Utils.SpacyNLP.Types Gargantext.Utils.SpacyNLP.Types
          Gargantext.Utils.Tuple Gargantext.Utils.Tuple
          Gargantext.Utils.Zip Gargantext.Utils.Zip
          Paths_gargantext
          other-modules: other-modules:
          Gargantext.API.Admin.Auth Gargantext.API.Admin.Auth
          Gargantext.API.Admin.FrontEnd Gargantext.API.Admin.FrontEnd
          ...@@ -356,9 +369,7 @@ library ...@@ -356,9 +369,7 @@ library
          Gargantext.Core.Flow.Ngrams Gargantext.Core.Flow.Ngrams
          Gargantext.Core.Flow.Types Gargantext.Core.Flow.Types
          Gargantext.Core.Methods.Graph.MaxClique Gargantext.Core.Methods.Graph.MaxClique
          Gargantext.Core.Methods.Matrix.Accelerate.Utils
          Gargantext.Core.Methods.Similarities.Accelerate.Conditional Gargantext.Core.Methods.Similarities.Accelerate.Conditional
          Gargantext.Core.Methods.Similarities.Accelerate.Distributional
          Gargantext.Core.Methods.Similarities.Accelerate.SpeGen Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
          Gargantext.Core.Statistics Gargantext.Core.Statistics
          Gargantext.Core.Text.Corpus Gargantext.Core.Text.Corpus
          ...@@ -470,12 +481,9 @@ library ...@@ -470,12 +481,9 @@ library
          Gargantext.Database.Schema.NodeNode Gargantext.Database.Schema.NodeNode
          Gargantext.Database.Schema.Prelude Gargantext.Database.Schema.Prelude
          Gargantext.Database.Types Gargantext.Database.Types
          Gargantext.Orphans
          Gargantext.Orphans.OpenAPI
          Gargantext.Utils.Aeson Gargantext.Utils.Aeson
          Gargantext.Utils.Servant Gargantext.Utils.Servant
          Gargantext.Utils.UTCTime Gargantext.Utils.UTCTime
          Paths_gargantext
          ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Wunused-packages -Werror -freduction-depth=300 -fprint-potential-instances ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Wunused-packages -Werror -freduction-depth=300 -fprint-potential-instances
          hs-source-dirs: hs-source-dirs:
          src src
          ...@@ -489,7 +497,6 @@ library ...@@ -489,7 +497,6 @@ library
          , MonadRandom ^>= 0.6 , MonadRandom ^>= 0.6
          , QuickCheck ^>= 2.14.2 , QuickCheck ^>= 2.14.2
          , accelerate ^>= 1.3.0.0 , accelerate ^>= 1.3.0.0
          , accelerate-llvm-native ^>= 1.3.0.0
          , aeson ^>= 2.1.2.1 , aeson ^>= 2.1.2.1
          , ansi-terminal , ansi-terminal
          , array ^>= 0.5.4.0 , array ^>= 0.5.4.0
          ...@@ -554,6 +561,7 @@ library ...@@ -554,6 +561,7 @@ library
          , json-stream ^>= 0.4.2.4 , json-stream ^>= 0.4.2.4
          , lens >= 5.2.2 && < 5.3 , lens >= 5.2.2 && < 5.3
          , lens-aeson < 1.3 , lens-aeson < 1.3
          , massiv < 1.1
          , matrix ^>= 0.3.6.1 , matrix ^>= 0.3.6.1
          , mime-mail >= 0.5.1 , mime-mail >= 0.5.1
          , monad-control ^>= 1.0.3.1 , monad-control ^>= 1.0.3.1
          ...@@ -586,6 +594,7 @@ library ...@@ -586,6 +594,7 @@ library
          , replace-attoparsec ^>= 1.5.0.0 , replace-attoparsec ^>= 1.5.0.0
          , resource-pool >= 0.4.0.0 && < 0.5 , resource-pool >= 0.4.0.0 && < 0.5
          , safe-exceptions >= 0.1.7.4 && < 0.2 , safe-exceptions >= 0.1.7.4 && < 0.2
          , scientific < 0.4
          , serialise ^>= 0.2.4.0 , serialise ^>= 0.2.4.0
          , servant >= 0.20.1 && < 0.21 , servant >= 0.20.1 && < 0.21
          , servant-auth ^>= 0.4.0.0 , servant-auth ^>= 0.4.0.0
          ...@@ -609,7 +618,7 @@ library ...@@ -609,7 +618,7 @@ library
          , singletons ^>= 3.0.2 , singletons ^>= 3.0.2
          , singletons-th >= 3.1 && < 3.2 , singletons-th >= 3.1 && < 3.2
          , smtp-mail >= 0.3.0.0 , smtp-mail >= 0.3.0.0
          , split >= 0.2.0 , split >= 0.2.3.4
          , stemmer == 0.5.2 , stemmer == 0.5.2
          , stm >= 2.5.1.0 && < 2.6 , stm >= 2.5.1.0 && < 2.6
          , stm-containers >= 1.2.0.3 && < 1.3 , stm-containers >= 1.2.0.3 && < 1.3
          ...@@ -694,14 +703,18 @@ executable gargantext ...@@ -694,14 +703,18 @@ executable gargantext
          , servant-routes < 0.2 , servant-routes < 0.2
          , servant-websockets >= 2.0.0 && < 2.1 , servant-websockets >= 2.0.0 && < 2.1
          , shelly , shelly
          , split ^>= 0.2.3.4 , split >= 0.2.3.4
          , text ^>= 2.0.2 , text ^>= 2.0.2
          , toml-parser >= 2.0.1.0 && < 3 , toml-parser >= 2.0.1.0 && < 3
          , tree-diff , tree-diff
          , vector >= 0.12.3.0 && <= 0.13.1.0 , vector >= 0.12.3.0 && <= 0.13.1.0
          ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fprint-potential-instances ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fprint-potential-instances
          common testDependencies -- Dependencies needed by both test stanzas. Dependencies
          -- which are not shared must be placed in the `build-depends`
          -- of each separate stanza to not trigger any warning if `-Wunused-packages`
          -- is enabled.
          common commonTestDependencies
          build-depends: build-depends:
          base >=4.7 && <5 base >=4.7 && <5
          , QuickCheck ^>= 2.14.2 , QuickCheck ^>= 2.14.2
          ...@@ -763,17 +776,20 @@ common testDependencies ...@@ -763,17 +776,20 @@ common testDependencies
          test-suite garg-test-tasty test-suite garg-test-tasty
          import: import:
          defaults defaults
          , testDependencies , commonTestDependencies
          type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
          main-is: drivers/tasty/Main.hs main-is: drivers/tasty/Main.hs
          build-depends: build-depends:
          aeson-pretty ^>= 0.8.9 aeson-pretty ^>= 0.8.9
          , accelerate >= 1.3.0.0
          , boolexpr ^>= 0.3 , boolexpr ^>= 0.3
          , conduit ^>= 1.3.4.2 , conduit ^>= 1.3.4.2
          , crawlerArxiv , crawlerArxiv
          , cryptohash , cryptohash
          , directory ^>= 1.3.7.1 , directory ^>= 1.3.7.1
          , graphviz ^>= 2999.20.1.0 , graphviz ^>= 2999.20.1.0
          , massiv < 1.1
          , scientific < 0.4
          , split , split
          , tasty >= 1.4.3 && < 1.6 , tasty >= 1.4.3 && < 1.6
          , tasty-golden , tasty-golden
          ...@@ -795,6 +811,7 @@ test-suite garg-test-tasty ...@@ -795,6 +811,7 @@ test-suite garg-test-tasty
          Test.API.Setup Test.API.Setup
          Test.API.Prelude Test.API.Prelude
          Test.API.UpdateList Test.API.UpdateList
          Test.Core.LinearAlgebra
          Test.Core.Notifications Test.Core.Notifications
          Test.Core.Orchestrator Test.Core.Orchestrator
          Test.Core.Similarity Test.Core.Similarity
          ...@@ -845,7 +862,7 @@ test-suite garg-test-tasty ...@@ -845,7 +862,7 @@ test-suite garg-test-tasty
          test-suite garg-test-hspec test-suite garg-test-hspec
          import: import:
          defaults defaults
          , testDependencies , commonTestDependencies
          type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
          main-is: drivers/hspec/Main.hs main-is: drivers/hspec/Main.hs
          build-depends: process ^>= 1.6.18.0 build-depends: process ^>= 1.6.18.0
          ...@@ -889,11 +906,16 @@ benchmark garg-bench ...@@ -889,11 +906,16 @@ benchmark garg-bench
          other-modules: other-modules:
          Paths_gargantext Paths_gargantext
          build-depends: base build-depends: base
          , bytestring ^>= 0.11.5.3 , accelerate
          , accelerate-llvm-native
          , hmatrix
          , massiv
          , deepseq
          , gargantext , gargantext
          , gargantext-prelude , gargantext-prelude
          , split
          , tasty-bench , tasty-bench
          ghc-options: "-with-rtsopts=-T -A32m" ghc-options: -threaded "-with-rtsopts=-N -T -A32m"
          if impl(ghc >= 8.6) if impl(ghc >= 8.6)
          ghc-options: "-with-rtsopts=--nonmoving-gc" ghc-options: -threaded "-with-rtsopts=-N --nonmoving-gc"
          src/Gargantext/Core/LinearAlgebra.hs 0 → 100644
          View file @ 250efc5b
          {-# LANGUAGE DerivingStrategies #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE TypeOperators #-}
          {-|
          Module : Gargantext.Core.LinearAlgebra
          Description : Linear Algebra utility functions
          Copyright : (c) CNRS, 2017-Present
          License : AGPL + CECILL v3
          Maintainer : team@gargantext.org
          Stability : experimental
          Portability : POSIX
          Linear algebra utility functions to be used across all the Gargantext modules requiring it.
          -}
          module Gargantext.Core.LinearAlgebra (
          -- * Handy re-exports
          module Gargantext.Core.LinearAlgebra.Operations
          , module Gargantext.Core.LinearAlgebra.Distributional
          ) where
          import Gargantext.Core.LinearAlgebra.Operations
          import Gargantext.Core.LinearAlgebra.Distributional
          src/Gargantext/Core/LinearAlgebra/Distributional.hs 0 → 100644
          View file @ 250efc5b
          {-# LANGUAGE DerivingStrategies #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TypeApplications #-}
          {-|
          Module : Gargantext.Core.LinearAlgebra.Distributional
          Description : The "distributional" algorithm, fast and slow implementations
          Copyright : (c) CNRS, 2017-Present
          License : AGPL + CECILL v3
          Maintainer : team@gargantext.org
          Stability : experimental
          Portability : POSIX
          -}
          module Gargantext.Core.LinearAlgebra.Distributional (
          distributional
          , logDistributional2
          -- * Internals for testing
          , distributionalReferenceImplementation
          ) where
          import Data.Massiv.Array (D, Matrix, Vector, Array, Ix3, U, Ix2 (..), IxN (..))
          import Data.Massiv.Array qualified as A
          import Gargantext.Core.LinearAlgebra.Operations
          import Prelude
          -- | `distributional m` returns the distributional distance between each
          -- pair of terms as a matrix. The argument m is the matrix $[n_{ij}]_{i,j}$
          -- where $n_{ij}$ is the coocccurrence between term $i$ and term $j$.
          --
          -- ## Basic example with Matrix of size 3:
          --
          -- >>> theMatrixInt 3
          -- Matrix (Z :. 3 :. 3)
          -- [ 7, 4, 0,
          -- 4, 5, 3,
          -- 0, 3, 4]
          --
          -- >>> distributional $ theMatrixInt 3
          -- Matrix (Z :. 3 :. 3)
          -- [ 1.0, 0.0, 0.9843749999999999,
          -- 0.0, 1.0, 0.0,
          -- 1.0, 0.0, 1.0]
          --
          -- ## Basic example with Matrix of size 4:
          --
          -- >>> theMatrixInt 4
          -- Matrix (Z :. 4 :. 4)
          -- [ 4, 1, 2, 1,
          -- 1, 4, 0, 0,
          -- 2, 0, 3, 3,
          -- 1, 0, 3, 3]
          --
          -- >>> distributional $ theMatrixInt 4
          -- Matrix (Z :. 4 :. 4)
          -- [ 1.0, 0.0, 0.5714285714285715, 0.8421052631578947,
          -- 0.0, 1.0, 1.0, 1.0,
          -- 8.333333333333333e-2, 4.6875e-2, 1.0, 0.25,
          -- 0.3333333333333333, 5.7692307692307696e-2, 1.0, 1.0]
          --
          -- /IMPORTANT/: As this function computes the diagonal matrix in order to carry on the computation
          -- the input has to be a square matrix, or this function will fail at runtime.
          distributional :: forall r e. ( A.Manifest r e
          , A.Manifest r Int
          , A.Unbox e
          , A.Source r Int
          , A.Size r
          , Ord e
          , Fractional e
          , Num e
          )
          => Matrix r Int
          -> Matrix U e
          distributional m' = A.computeP result
          where
          mD :: Matrix D e
          mD = A.map fromIntegral m'
          m :: Matrix A.U e
          m = A.compute mD
          n :: Int
          n = dim m'
          diag_m :: Vector A.U e
          diag_m = diag m
          d_1 :: Matrix A.D e
          d_1 = A.backpermute' (A.Sz2 n n) (\(_ A.:. i) -> i) diag_m
          d_2 :: Matrix A.D e
          d_2 = A.backpermute' (A.Sz2 n n) (\(i A.:. _) -> i) diag_m
          a :: Matrix D e
          a = termDivNanD mD d_1
          b :: Matrix D e
          b = termDivNanD mD d_2
          miDelayed :: Matrix D e
          miDelayed = a `mulD` b
          miMemo :: Matrix D e
          miMemo = A.delay (A.compute @U miDelayed)
          w_1 :: Array D Ix3 e
          w_1 = A.backpermute' (A.Sz3 n n n) (\(x A.:> _y A.:. z) -> x A.:. z) miMemo
          w_2 :: Array D Ix3 e
          w_2 = A.backpermute' (A.Sz3 n n n) (\(_x A.:> y A.:. z) -> y A.:. z) miMemo
          w' :: Array D Ix3 e
          w' = A.zipWith min w_1 w_2
          z_1 :: Matrix A.D e
          z_1 = A.ifoldlWithin' 1 ( \(i :> j :. k) acc w'_val ->
          let ii_val = if k /= i && k /= j then 1 else 0
          z1_val = w'_val * ii_val
          in acc + z1_val
          ) 0 w'
          z_2 :: Matrix A.D e
          z_2 = A.ifoldlWithin' 1 ( \(i :> j :. k) acc w1_val ->
          let ii_val = if k /= i && k /= j then 1 else 0
          z2_val = w1_val * ii_val
          in acc + z2_val
          ) 0 w_1
          result :: Matrix A.D e
          result = termDivNanD z_1 z_2
          -- | A reference implementation for \"distributional\" which is slower but
          -- it's more declarative and can be used to assess the correctness of the
          -- optimised version.
          -- Same proviso about the shape of the matri applies for this function.
          distributionalReferenceImplementation :: forall r e.
          ( A.Manifest r e
          , A.Unbox e
          , A.Source r Int
          , A.Size r
          , Ord e
          , Fractional e
          , Num e
          )
          => Matrix r Int
          -> Matrix r e
          distributionalReferenceImplementation m' = result
          where
          mD :: Matrix D e
          mD = A.map fromIntegral m'
          m :: Matrix A.U e
          m = A.compute mD
          n :: Int
          n = dim m'
          -- Computes the diagonal matrix of the input ..
          diag_m :: Vector A.U e
          diag_m = diag m
          -- Then we create a matrix that contains the same elements of diag_m
          -- for the rows and columns, to make it square again.
          d_1 :: Matrix A.D e
          d_1 = A.backpermute' (A.Sz2 n n) (\(_ A.:. i) -> i) diag_m
          d_2 :: Matrix A.D e
          d_2 = A.backpermute' (A.Sz2 n n) (\(i A.:. _) -> i) diag_m
          a :: Matrix D e
          a = termDivNanD mD d_1
          b :: Matrix D e
          b = termDivNanD mD d_2
          miDelayed :: Matrix D e
          miDelayed = a `mulD` b
          miMemo :: Matrix D e
          miMemo = A.delay (A.compute @U miDelayed)
          -- The matrix permutations is taken care of below by directly replicating
          -- the matrix mi, making the matrix w unneccessary and saving one step.
          -- replicate (constant (Z :. All :. n :. All)) mi
          w_1 :: Array D Ix3 e
          w_1 = A.backpermute' (A.Sz3 n n n) (\(x A.:> _y A.:. z) -> x A.:. z) miMemo
          -- replicate (constant (Z :. n :. All :. All)) mi
          w_2 :: Array D Ix3 e
          w_2 = A.backpermute' (A.Sz3 n n n) (\(_x A.:> y A.:. z) -> y A.:. z) miMemo
          w' :: Array D Ix3 e
          w' = A.zipWith min w_1 w_2
          -- The matrix ii = [r_{i,j,k}]_{i,j,k} has r_(i,j,k) = 0 if k = i OR k = j
          -- and r_(i,j,k) = 1 otherwise (i.e. k /= i AND k /= j).
          -- generate (constant (Z :. n :. n :. n)) (lift1 (\( i A.:. j A.:. k) -> cond ((&&) ((/=) k i) ((/=) k j)) 1 0))
          ii :: Array A.D Ix3 e
          ii = A.makeArrayR A.D A.Seq (A.Sz3 n n n) $ \(i A.:> j A.:. k) -> if k /= i && k /= j then 1 else 0
          z_1 :: Matrix A.D e
          z_1 = sumRowsD (w' `mulD` ii)
          z_2 :: Matrix A.D e
          z_2 = sumRowsD (w_1 `mulD` ii)
          result = A.computeP (termDivNanD z_1 z_2)
          logDistributional2 :: (A.Manifest r e
          , A.Unbox e
          , A.Source r Int
          , A.Shape r Ix2
          , Num e
          , Ord e
          , A.Source r e
          , Fractional e
          , Floating e
          )
          => Matrix r Int
          -> Matrix r e
          logDistributional2 m = A.computeP
          $ diagNull n
          $ matMaxMini
          $ logDistributional' n m
          where
          n = dim m
          logDistributional' :: forall r e.
          ( A.Manifest r e
          , A.Unbox e
          , A.Source r Int
          , A.Shape r Ix2
          , Num e
          , Ord e
          , A.Source r e
          , Fractional e
          , Floating e
          )
          => Int
          -> Matrix r Int
          -> Matrix r e
          logDistributional' n m' = result
          where
          m :: Matrix A.U e
          m = A.compute $ A.map fromIntegral m'
          -- Scalar. Sum of all elements of m.
          to :: e
          to = A.sum m
          -- Diagonal matrix with the diagonal of m.
          d_m :: Matrix A.D e
          d_m = m `mulD` (matrixIdentity n)
          -- Size n vector. s = [s_i]_i
          s :: Vector A.U e
          s = A.compute $ sumRowsD (m `subD` d_m)
          -- Matrix nxn. Vector s replicated as rows.
          s_1 :: Matrix D e
          s_1 = A.backpermute' (A.Sz2 n n) (\(x :. _y) -> x) s
          -- Matrix nxn. Vector s replicated as columns.
          s_2 :: Matrix D e
          s_2 = A.backpermute' (A.Sz2 n n) (\(_x :. y) -> y) s
          -- Matrix nxn. ss = [s_i * s_j]_{i,j}. Outer product of s with itself.
          ss :: Matrix A.D e
          ss = s_1 `mulD` s_2
          mi_divvy :: Matrix A.D e
          mi_divvy = A.zipWith (\m_val ss_val ->
          let x = m_val `safeDiv` ss_val
          x' = x * to
          in if (x' < 1) then 0 else log x') m ss
          -- Matrix nxn. mi = [m_{i,j}]_{i,j} where
          -- m_{i,j} = 0 if n_{i,j} = 0 or i = j,
          -- m_{i,j} = log(to * n_{i,j} / s_{i,j}) otherwise.
          mi :: Matrix A.U e
          mi = A.computeP $ mulD (matrixEye n) (mi_divvy)
          sumMin :: Matrix A.U e
          sumMin = sumMin_go n mi
          sumM :: Matrix A.U e
          sumM = sumM_go n mi
          result :: Matrix r e
          result = termDivNan sumMin sumM
          src/Gargantext/Core/LinearAlgebra/Operations.hs 0 → 100644
          View file @ 250efc5b
          {-# LANGUAGE DerivingStrategies #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE TypeOperators #-}
          {-|
          Module : Gargantext.Core.LinearAlgebra.Operations
          Description : Operations on matrixes using massiv
          Copyright : (c) CNRS, 2017-Present
          License : AGPL + CECILL v3
          Maintainer : team@gargantext.org
          Stability : experimental
          Portability : POSIX
          -}
          module Gargantext.Core.LinearAlgebra.Operations (
          -- * Convertion functions
          accelerate2MassivMatrix
          , accelerate2Massiv3DMatrix
          , massiv2AccelerateMatrix
          , massiv2AccelerateVector
          -- * Operations on matrixes
          , (.*)
          , (.-)
          , diag
          , termDivNan
          , sumRows
          , dim
          , matrixEye
          , matrixIdentity
          , diagNull
          -- * Operations on delayed arrays
          , diagD
          , subD
          , mulD
          , termDivNanD
          , sumRowsD
          , safeDiv
          -- * Internals for testing
          , sumRowsReferenceImplementation
          , matMaxMini
          , sumM_go
          , sumMin_go
          ) where
          import Data.Array.Accelerate qualified as Acc
          import Data.List.Split qualified as Split
          import Data.Massiv.Array (D, Matrix, Vector, Array)
          import Data.Massiv.Array qualified as A
          import Prelude
          import Protolude.Safe (headMay)
          import Data.Monoid
          -- | Converts an accelerate matrix into a Massiv matrix.
          accelerate2MassivMatrix :: (A.Unbox a, Acc.Elt a) => Acc.Matrix a -> Matrix A.U a
          accelerate2MassivMatrix m =
          let (Acc.Z Acc.:. _r Acc.:. c) = Acc.arrayShape m
          in A.fromLists' @A.U A.Par $ Split.chunksOf c (Acc.toList m)
          -- | Converts a massiv matrix into an accelerate matrix.
          massiv2AccelerateMatrix :: (Acc.Elt a, A.Source r a) => Matrix r a -> Acc.Matrix a
          massiv2AccelerateMatrix m =
          let m' = A.toLists2 m
          r = Prelude.length m'
          c = maybe 0 Prelude.length (headMay m')
          in Acc.fromList (Acc.Z Acc.:. r Acc.:. c) (mconcat m')
          -- | Converts a massiv vector into an accelerate one.
          massiv2AccelerateVector :: (A.Source r a, Acc.Elt a) => A.Vector r a -> Acc.Vector a
          massiv2AccelerateVector m =
          let m' = A.toList m
          r = Prelude.length m'
          in Acc.fromList (Acc.Z Acc.:. r) m'
          accelerate2Massiv3DMatrix :: (A.Unbox e, Acc.Elt e, A.Manifest r e)
          => Acc.Array (Acc.Z Acc.:. Int Acc.:. Int Acc.:. Int) e
          -> A.Array r A.Ix3 e
          accelerate2Massiv3DMatrix m =
          let (Acc.Z Acc.:. _r Acc.:. _c Acc.:. _z) = Acc.arrayShape m
          in A.fromLists' A.Par $ map (Split.chunksOf $ _z) $ Split.chunksOf (_c*_z) (Acc.toList m)
          -- | Computes the diagnonal matrix of the input one.
          diag :: (A.Unbox e, A.Manifest r e, A.Source r e, Num e) => Matrix r e -> Vector A.U e
          diag matrix =
          let (A.Sz2 rows _cols) = A.size matrix
          newSize = A.Sz1 rows
          in A.makeArrayR A.U A.Seq newSize $ (\(A.Ix1 i) -> matrix A.! (A.Ix2 i i))
          diagD :: (A.Source r e, A.Size r) => Matrix r e -> Vector A.D e
          diagD matrix =
          let (A.Sz2 rows _cols) = A.size matrix
          newSize = A.Sz1 rows
          in A.backpermute' newSize (\i -> i A.:. i) matrix
          -- | Term by term division where divisions by 0 produce 0 rather than NaN.
          termDivNan :: (A.Manifest r3 a, A.Source r1 a, A.Source r2 a, Eq a, Fractional a)
          => Matrix r1 a
          -> Matrix r2 a
          -> Matrix r3 a
          termDivNan m1 = A.compute . termDivNanD m1
          termDivNanD :: (A.Source r1 a, A.Source r2 a, Eq a, Fractional a)
          => Matrix r1 a
          -> Matrix r2 a
          -> Matrix D a
          termDivNanD m1 m2 = A.zipWith safeDiv m1 m2
          safeDiv :: (Eq a, Fractional a) => a -> a -> a
          safeDiv i j = if j == 0 then 0 else i / j
          {-# INLINE safeDiv #-}
          sumRows :: ( A.Index (A.Lower ix)
          , A.Index ix
          , A.Source r e
          , A.Manifest r e
          , A.Strategy r
          , A.Size r
          , Num e
          ) => Array r ix e
          -> Array r (A.Lower ix) e
          sumRows = A.compute . sumRowsD
          sumRowsD :: ( A.Index (A.Lower ix)
          , A.Index ix
          , A.Source r e
          , Num e
          ) => Array r ix e
          -> Array D (A.Lower ix) e
          sumRowsD matrix = A.map getSum $ A.foldlWithin' 1 (\(Sum s) n -> Sum $ s + n) mempty matrix
          sumRowsReferenceImplementation :: ( A.Load r A.Ix2 e
          , A.Source r e
          , A.Manifest r e
          , A.Strategy r
          , A.Size r
          , Num e
          ) => Array r A.Ix3 e
          -> Array r A.Ix2 e
          sumRowsReferenceImplementation matrix =
          let A.Sz3 rows cols z = A.size matrix
          in A.makeArray (A.getComp matrix) (A.Sz2 rows cols) $ \(i A.:. j) ->
          A.sum (A.backpermute' (A.Sz1 z) (\c -> i A.:> j A.:. c) matrix)
          -- | Matrix cell by cell multiplication
          (.*) :: (A.Manifest r3 a, A.Source r1 a, A.Source r2 a, A.Index ix, Num a)
          => Array r1 ix a
          -> Array r2 ix a
          -> Array r3 ix a
          (.*) m1 = A.compute . mulD m1
          mulD :: (A.Source r1 a, A.Source r2 a, A.Index ix, Num a)
          => Array r1 ix a
          -> Array r2 ix a
          -> Array D ix a
          mulD m1 m2 = A.zipWith (*) m1 m2
          -- | Matrix cell by cell substraction
          (.-) :: (A.Manifest r3 a, A.Source r1 a, A.Source r2 a, A.Index ix, Num a)
          => Array r1 ix a
          -> Array r2 ix a
          -> Array r3 ix a
          (.-) m1 = A.compute . subD m1
          subD :: (A.Source r1 a, A.Source r2 a, A.Index ix, Num a)
          => Array r1 ix a
          -> Array r2 ix a
          -> Array D ix a
          subD m1 m2 = A.zipWith (-) m1 m2
          -- | Get the dimensions of a /square/ matrix.
          dim :: A.Size r => Matrix r a -> Int
          dim m = n
          where
          (A.Sz2 _ n) = A.size m
          matMaxMini :: (A.Unbox a, A.Source r a, Ord a, Num a, A.Shape r A.Ix2) => Matrix r a -> Matrix A.U a
          matMaxMini m = A.compute $ A.map (\x -> if x > miniMax then x else 0) m
          where
          -- Convert the matrix to a list of rows, take the minimum of each row,
          -- and then the maximum of those minima.
          miniMax = maximum (map minimum (A.toLists m))
          sumM_go :: (A.Unbox a, A.Manifest r a, Num a, A.Load r A.Ix2 a) => Int -> Matrix r a -> Matrix A.U a
          sumM_go n mi = A.makeArrayR A.U A.Seq (A.Sz2 n n) $ \(i A.:. j) ->
          Prelude.sum [ if k /= i && k /= j then mi A.! (i A.:. k) else 0 | k <- [0 .. n - 1] ]
          sumMin_go :: (A.Unbox a, A.Manifest r a, Num a, Ord a, A.Load r A.Ix2 a) => Int -> Matrix r a -> Matrix A.U a
          sumMin_go n mi = A.makeArrayR A.U A.Seq (A.Sz2 n n) $ \(i A.:. j) ->
          Prelude.sum
          [ if k /= i && k /= j
          then min (mi A.! (i A.:. k)) (mi A.! (j A.:. k))
          else 0
          | k <- [0 .. n - 1]
          ]
          matrixEye :: (A.Unbox e, Num e) => Int -> Matrix A.U e
          matrixEye n = A.makeArrayR A.U A.Seq (A.Sz2 n n) $ \(i A.:. j) -> if i == j then 0 else 1
          {-# INLINE matrixEye #-}
          {-# SPECIALIZE matrixEye :: Int -> Matrix A.U Double #-}
          matrixIdentity :: (A.Unbox e, Num e) => Int -> Matrix A.U e
          matrixIdentity n = A.makeArrayR A.U A.Seq (A.Sz2 n n) $ \(i A.:. j) -> if i == j then 1 else 0
          {-# INLINE matrixIdentity #-}
          {-# SPECIALIZE matrixIdentity :: Int -> Matrix A.U Double #-}
          diagNull :: (A.Unbox e, A.Source r e, Num e) => Int -> Matrix r e -> Matrix A.U e
          diagNull n m = A.compute $ A.zipWith (*) m (matrixEye n)
          src/Gargantext/Core/Methods/Matrix/Accelerate/Utils.hs
          View file @ 250efc5b
          ...@@ -38,8 +38,6 @@ import Data.Array.Accelerate ...@@ -38,8 +38,6 @@ import Data.Array.Accelerate
          import Data.Array.Accelerate.Interpreter (run) import Data.Array.Accelerate.Interpreter (run)
          import qualified Gargantext.Prelude as P import qualified Gargantext.Prelude as P
          import Debug.Trace (trace)
          -- | Matrix cell by cell multiplication -- | Matrix cell by cell multiplication
          (.*) :: ( Shape ix (.*) :: ( Shape ix
          , Slice ix , Slice ix
          ...@@ -55,26 +53,28 @@ import Debug.Trace (trace) ...@@ -55,26 +53,28 @@ import Debug.Trace (trace)
          (./) :: ( Shape ix (./) :: ( Shape ix
          , Slice ix , Slice ix
          , Elt a , Elt a
          , Eq a
          , P.Num (Exp a) , P.Num (Exp a)
          , P.Fractional (Exp a) , P.Fractional (Exp a)
          ) )
          => Acc (Array ((ix :. Int) :. Int) a) => Acc (Array ((ix :. Int) :. Int) a)
          -> Acc (Array ((ix :. Int) :. Int) a) -> Acc (Array ((ix :. Int) :. Int) a)
          -> Acc (Array ((ix :. Int) :. Int) a) -> Acc (Array ((ix :. Int) :. Int) a)
          (./) = zipWith (/) (./) = zipWith safeDivCond
          -- | Term by term division where divisions by 0 produce 0 rather than NaN. -- | Term by term division where divisions by 0 produce 0 rather than NaN.
          termDivNan :: ( Shape ix termDivNan :: ( Elt a
          , Slice ix , Eq a
          , Elt a , P.Num (Exp a)
          , Eq a , P.Fractional (Exp a)
          , P.Num (Exp a) )
          , P.Fractional (Exp a) => Acc (Matrix a)
          ) -> Acc (Matrix a)
          => Acc (Array ((ix :. Int) :. Int) a) -> Acc (Matrix a)
          -> Acc (Array ((ix :. Int) :. Int) a) termDivNan = zipWith safeDivCond
          -> Acc (Array ((ix :. Int) :. Int) a)
          termDivNan = trace "termDivNan" $ zipWith (\i j -> cond ((==) j 0) 0 ((/) i j)) safeDivCond :: (Eq a, P.Num (Exp a), P.Fractional (Exp a)) => Exp a -> Exp a -> Exp a
          safeDivCond i j = cond ((==) j 0) 0 ((/) i j)
          (.-) :: ( Shape ix (.-) :: ( Shape ix
          , Slice ix , Slice ix
          ......
          src/Gargantext/Core/Methods/Similarities.hs
          View file @ 250efc5b
          ...@@ -20,10 +20,11 @@ import Data.Swagger ...@@ -20,10 +20,11 @@ import Data.Swagger
          import Data.Text (Text) import Data.Text (Text)
          import GHC.Generics (Generic) import GHC.Generics (Generic)
          import Gargantext.Core.Methods.Similarities.Accelerate.Conditional (measureConditional') import Gargantext.Core.Methods.Similarities.Accelerate.Conditional (measureConditional')
          import Gargantext.Core.Methods.Similarities.Accelerate.Distributional (logDistributional2) import Gargantext.Core.LinearAlgebra.Operations (accelerate2MassivMatrix, massiv2AccelerateMatrix)
          import Gargantext.Core.LinearAlgebra.Distributional (logDistributional2)
          -- import Gargantext.Core.Text.Metrics.Count (coocOn) -- import Gargantext.Core.Text.Metrics.Count (coocOn)
          -- import Gargantext.Core.Viz.Graph.Index -- import Gargantext.Core.Viz.Graph.Index
          import Gargantext.Prelude (Ord, Eq, Int, Double, Show, map) import Gargantext.Prelude (Ord, Eq, Int, Double, Show, map, ($), (.))
          import Prelude (Enum, Bounded, minBound, maxBound) import Prelude (Enum, Bounded, minBound, maxBound)
          import Test.QuickCheck (elements) import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
          ...@@ -36,7 +37,7 @@ data Similarity = Conditional | Distributional ...@@ -36,7 +37,7 @@ data Similarity = Conditional | Distributional
          measure :: Similarity -> Matrix Int -> Matrix Double measure :: Similarity -> Matrix Int -> Matrix Double
          measure Conditional x = measureConditional' x measure Conditional x = measureConditional' x
          measure Distributional x = logDistributional2 x measure Distributional x = massiv2AccelerateMatrix . logDistributional2 . accelerate2MassivMatrix $ x
          ------------------------------------------------------------------------ ------------------------------------------------------------------------
          withMetric :: GraphMetric -> Similarity withMetric :: GraphMetric -> Similarity
          ......
          src/Gargantext/Core/Methods/Similarities/Accelerate/Distributional.hs
          View file @ 250efc5b
          ...@@ -89,18 +89,22 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$ ...@@ -89,18 +89,22 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
          {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
          module Gargantext.Core.Methods.Similarities.Accelerate.Distributional module Gargantext.Core.Methods.Similarities.Accelerate.Distributional
          ( distributional
          , logDistributional2
          -- internals for testing
          , distributionalWith
          , logDistributional2With
          , sumMin_go
          , sumM_go
          )
          where where
          -- import qualified Data.Foldable as P (foldl1) -- import qualified Data.Foldable as P (foldl1)
          -- import Debug.Trace (trace) -- import Debug.Trace (trace)
          import Data.Array.Accelerate as A import Data.Array.Accelerate as A
          -- import Data.Array.Accelerate.Interpreter (run) import Data.Array.Accelerate.Interpreter qualified as Naive
          import Data.Array.Accelerate.LLVM.Native (run) -- TODO: try runQ?
          import Gargantext.Core.Methods.Matrix.Accelerate.Utils import Gargantext.Core.Methods.Matrix.Accelerate.Utils
          import qualified Gargantext.Prelude as P
          import Debug.Trace
          import Prelude (show, mappend{- , String, (<>), fromIntegral, flip -})
          import qualified Prelude import qualified Prelude
          ...@@ -138,8 +142,16 @@ import qualified Prelude ...@@ -138,8 +142,16 @@ import qualified Prelude
          -- 8.333333333333333e-2, 4.6875e-2, 1.0, 0.25, -- 8.333333333333333e-2, 4.6875e-2, 1.0, 0.25,
          -- 0.3333333333333333, 5.7692307692307696e-2, 1.0, 1.0] -- 0.3333333333333333, 5.7692307692307696e-2, 1.0, 1.0]
          -- --
          -- /IMPORTANT/: As this function computes the diagonal matrix in order to carry on the computation
          -- the input has to be a square matrix, or this function will fail at runtime.
          distributional :: Matrix Int -> Matrix Double distributional :: Matrix Int -> Matrix Double
          distributional m' = run $ result distributional = distributionalWith Naive.run
          distributionalWith :: (Elt e, FromIntegral Int e, Eq e, Prelude.Fractional (Exp e), Ord e)
          => (forall a. Arrays a => Acc a -> a)
          -> Matrix Int
          -> Matrix e
          distributionalWith interpret m' = interpret $ result
          where where
          m = map A.fromIntegral $ use m' m = map A.fromIntegral $ use m'
          n = dim m' n = dim m'
          ...@@ -149,7 +161,7 @@ distributional m' = run $ result ...@@ -149,7 +161,7 @@ distributional m' = run $ result
          d_1 = replicate (constant (Z :. n :. All)) diag_m d_1 = replicate (constant (Z :. n :. All)) diag_m
          d_2 = replicate (constant (Z :. All :. n)) diag_m d_2 = replicate (constant (Z :. All :. n)) diag_m
          mi = (.*) ((./) m d_1) ((./) m d_2) mi = (.*) (termDivNan m d_1) (termDivNan m d_2)
          -- w = (.-) mi d_mi -- w = (.-) mi d_mi
          ...@@ -170,15 +182,36 @@ distributional m' = run $ result ...@@ -170,15 +182,36 @@ distributional m' = run $ result
          result = termDivNan z_1 z_2 result = termDivNan z_1 z_2
          logDistributional2 :: Matrix Int -> Matrix Double logDistributional2 :: Matrix Int -> Matrix Double
          logDistributional2 m = trace ("logDistributional2, dim=" `mappend` show n) . run logDistributional2 m = logDistributional2With Naive.run m
          logDistributional2With :: ( Elt e
          , Prelude.Num (Exp e)
          , Ord e
          , Prelude.Num e
          , FromIntegral Int e
          , Prelude.Fractional (Exp e)
          , Prelude.Floating (Exp e)
          )
          => (forall a. Arrays a => Acc a -> a)
          -> Matrix Int -> Matrix e
          logDistributional2With interpreter m = interpreter
          $ diagNull n $ diagNull n
          $ matMaxMini $ matMaxMini
          $ logDistributional' n m $ logDistributional' n m
          where where
          n = dim m n = dim m
          logDistributional' :: Int -> Matrix Int -> Acc (Matrix Double) logDistributional' :: ( Elt e
          logDistributional' n m' = trace ("logDistributional'") result , Prelude.Num (Exp e)
          , FromIntegral Int e
          , Eq e
          , Ord e
          , Prelude.Fractional (Exp e)
          , Prelude.Floating (Exp e)
          )
          => Int -> Matrix Int
          -> Acc (Matrix e)
          logDistributional' n m' = result
          where where
          -- From Matrix Int to Matrix Double, i.e : -- From Matrix Int to Matrix Double, i.e :
          -- m :: Matrix Int -> Matrix Double -- m :: Matrix Int -> Matrix Double
          ...@@ -236,10 +269,10 @@ logDistributional' n m' = trace ("logDistributional'") result ...@@ -236,10 +269,10 @@ logDistributional' n m' = trace ("logDistributional'") result
          -- k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j))) -- k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j)))
          -- Matrix nxn. -- Matrix nxn.
          sumMin = trace "sumMin" $ sumMin_go n mi -- sum (condOrDefault k_diff_i_and_j 0 w') sumMin = sumMin_go n mi -- sum (condOrDefault k_diff_i_and_j 0 w')
          -- Matrix nxn. All columns are the same. -- Matrix nxn. All columns are the same.
          sumM = trace "sumM" $ sumM_go n mi -- trace "sumM" $ sum (condOrDefault k_diff_i_and_j 0 w_1) sumM = sumM_go n mi -- trace "sumM" $ sum (condOrDefault k_diff_i_and_j 0 w_1)
          result = termDivNan sumMin sumM result = termDivNan sumMin sumM
          ...@@ -264,103 +297,6 @@ logDistributional' n m' = trace ("logDistributional'") result ...@@ -264,103 +297,6 @@ logDistributional' n m' = trace ("logDistributional'") result
          -- \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\] -- \[N_{m} = \sum_{i,i \neq i}^{m} \sum_{j, j \neq j}^{m} S_{ij}\]
          -- --
          logDistributional :: Matrix Int -> Matrix Double
          logDistributional m' = run $ diagNull n $ result
          where
          m = map fromIntegral $ use m'
          n = dim m'
          -- Scalar. Sum of all elements of m.
          to = the $ sum (flatten m)
          -- Diagonal matrix with the diagonal of m.
          d_m = (.*) m (matrixIdentity n)
          -- Size n vector. s = [s_i]_i
          s = sum ((.-) m d_m)
          -- Matrix nxn. Vector s replicated as rows.
          s_1 = replicate (constant (Z :. All :. n)) s
          -- Matrix nxn. Vector s replicated as columns.
          s_2 = replicate (constant (Z :. n :. All)) s
          -- Matrix nxn. ss = [s_i * s_j]_{i,j}. Outer product of s with itself.
          ss = (.*) s_1 s_2
          -- Matrix nxn. mi = [m_{i,j}]_{i,j} where
          -- m_{i,j} = 0 if n_{i,j} = 0 or i = j,
          -- m_{i,j} = log(to * n_{i,j} / s_{i,j}) otherwise.
          mi = (.*) (matrixEye n)
          (map (lift1 (\x -> cond (x == 0) 0 (log (x * to)))) ((./) m ss))
          -- Tensor nxnxn. Matrix mi replicated along the 2nd axis.
          w_1 = replicate (constant (Z :. All :. n :. All)) mi
          -- Tensor nxnxn. Matrix mi replicated along the 1st axis.
          w_2 = replicate (constant (Z :. n :. All :. All)) mi
          -- Tensor nxnxn.
          w' = zipWith min w_1 w_2
          -- A predicate that is true when the input (i, j, k) satisfy
          -- k /= i AND k /= j
          k_diff_i_and_j = lift1 (\(Z :. i :. j :. k) -> ((&&) ((/=) k i) ((/=) k j)))
          -- Matrix nxn.
          sumMin = sum (condOrDefault k_diff_i_and_j 0 w')
          -- Matrix nxn. All columns are the same.
          sumM = sum (condOrDefault k_diff_i_and_j 0 w_1)
          result = termDivNan sumMin sumM
          distributional'' :: Matrix Int -> Matrix Double
          distributional'' m = -- run {- $ matMaxMini -}
          run $ diagNull n
          $ rIJ n
          $ filterWith 0 100
          $ filter' 0
          $ s_mi
          $ map A.fromIntegral
          {- from Int to Double -}
          $ use m
          {- push matrix in Accelerate type -}
          where
          _ri :: Acc (Matrix Double) -> Acc (Matrix Double)
          _ri mat = mat1 -- zipWith (/) mat1 mat2
          where
          mat1 = matSumCol n $ zipWith min (_myMin mat) (_myMin $ filterWith 0 100 $ diagNull n $ transpose mat)
          _mat2 = total mat
          _myMin :: Acc (Matrix Double) -> Acc (Matrix Double)
          _myMin = replicate (constant (Z :. n :. All)) . minimum
          -- TODO fix NaN
          -- Quali TEST: OK
          s_mi :: Acc (Matrix Double) -> Acc (Matrix Double)
          s_mi m' = zipWith (\x y -> log (x / y)) (diagNull n m')
          $ zipWith (/) (crossProduct n m') (total m')
          -- crossProduct n m'
          total :: Acc (Matrix Double) -> Acc (Matrix Double)
          total = replicate (constant (Z :. n :. n)) . sum . sum
          n :: Dim
          n = dim m
          rIJ :: (Elt a, Ord a, P.Fractional (Exp a), P.Num a)
          => Dim -> Acc (Matrix a) -> Acc (Matrix a)
          rIJ n m = matMaxMini $ divide a b
          where
          a = sumRowMin n m
          b = sumColMin n m
          -- * For Tests (to be removed) -- * For Tests (to be removed)
          -- | Test perfermance with this matrix -- | Test perfermance with this matrix
          -- TODO : add this in a benchmark folder -- TODO : add this in a benchmark folder
          ...@@ -376,25 +312,6 @@ distriTest n = logDistributional m == distributional m ...@@ -376,25 +312,6 @@ distriTest n = logDistributional m == distributional m
          -- compact repr of "extend along an axis" op? -- compact repr of "extend along an axis" op?
          -- general sparse repr ? -- general sparse repr ?
          type Extended sh = sh :. Int
          data Ext where
          Along1 :: Int -> Ext
          Along2 :: Int -> Ext
          along1 :: Int -> Ext
          along1 = Along1
          along2 :: Int -> Ext
          along2 = Along2
          type Delayed sh a = Exp sh -> Exp a
          data ExtArr sh a = ExtArr
          { extSh :: Extended sh
          , extFun :: Delayed (Extended sh) a
          }
          {- {-
          w_1_{i, j, k} = mi_{i, k} w_1_{i, j, k} = mi_{i, k}
          w_2_{i, j, k} = mi_{j, k} w_2_{i, j, k} = mi_{j, k}
          ......
          src/Gargantext/Core/Viz/Graph/Index.hs
          View file @ 250efc5b
          ...@@ -20,6 +20,7 @@ TODO: ...@@ -20,6 +20,7 @@ TODO:
          {-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
          {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MonoLocalBinds #-}
          {-# OPTIONS_GHC -Wno-unused-top-binds #-}
          module Gargantext.Core.Viz.Graph.Index module Gargantext.Core.Viz.Graph.Index
          where where
          ......
          src/Gargantext/Orphans.hs
          View file @ 250efc5b
          {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
          module Gargantext.Orphans ( module Gargantext.Orphans (
          module Gargantext.Orphans.OpenAPI module Gargantext.Orphans.OpenAPI
          ) where ) where
          import Data.Aeson qualified as JSON import Data.Aeson qualified as JSON
          import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata) import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
          import Gargantext.Orphans.Accelerate ()
          import Gargantext.Orphans.OpenAPI import Gargantext.Orphans.OpenAPI
          instance Hyperdata JSON.Value instance Hyperdata JSON.Value
          src/Gargantext/Orphans/Accelerate.hs 0 → 100644
          View file @ 250efc5b
          {-# OPTIONS_GHC -Wno-orphans #-}
          {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE MultiWayIf #-}
          module Gargantext.Orphans.Accelerate where
          import Prelude
          import Test.QuickCheck
          import Data.Scientific ()
          import Data.Array.Accelerate (DIM2, Z (..), (:.) (..), Array, Elt, fromList, arrayShape, DIM3)
          import Data.Array.Accelerate qualified as A
          import qualified Data.List.Split as Split
          instance (Show e, Elt e, Arbitrary e, Num e, Ord e) => Arbitrary (Array DIM3 e) where
          arbitrary = do
          x <- choose (1,10)
          y <- choose (1,10)
          z <- choose (1,10)
          let sh = Z :. x :. y :. z
          fromList sh <$> vectorOf (x * y * z) (getPositive <$> arbitrary)
          instance (Show e, Elt e, Arbitrary e) => Arbitrary (Array DIM2 e) where
          arbitrary = do
          x <- choose (1,128)
          y <- choose (1,48)
          let sh = Z :. x :. y
          fromList sh <$> vectorOf (x * y) arbitrary
          shrink arr = sliceArray arr
          -- Slice the array to the new shape, keeping the square dimensions.
          sliceArray :: (Elt e, Show e) => Array DIM2 e -> [Array DIM2 e]
          sliceArray arr =
          case arrayShape arr of
          (Z :. x :. y) -> case (x, y) of
          (_,1) -> [ ]
          (1,_) -> [ ]
          _ -> [ resizeArray arr (max 1 (x - 1)) (max 1 (y - 1)) ]
          resizeArray :: (Show e, Elt e) => Array DIM2 e -> Int -> Int -> Array DIM2 e
          resizeArray arr rows cols =
          let (Z :. _originRows :. originCols) = arrayShape arr
          vals = A.toList arr
          chunks = map (take cols) $ Split.chunksOf originCols vals
          m' = mconcat $ take rows chunks
          in A.fromList (Z :. rows :. cols) m'
          stack.yaml
          View file @ 250efc5b
          ...@@ -126,7 +126,6 @@ ...@@ -126,7 +126,6 @@
          - "taggy-0.2.1" - "taggy-0.2.1"
          - "taggy-lens-0.1.2" - "taggy-lens-0.1.2"
          - "tasty-1.5" - "tasty-1.5"
          - "tasty-bench-0.4"
          - "tasty-hspec-1.2.0.4" - "tasty-hspec-1.2.0.4"
          - "tasty-hunit-0.10.2" - "tasty-hunit-0.10.2"
          - "tasty-quickcheck-0.11" - "tasty-quickcheck-0.11"
          ...@@ -157,14 +156,6 @@ ...@@ -157,14 +156,6 @@
          - "zip-2.0.1" - "zip-2.0.1"
          - "zip-archive-0.4.3.2" - "zip-archive-0.4.3.2"
          - "zlib-0.7.1.0" - "zlib-0.7.1.0"
          - commit: 2b5d69448557e89002c0179ea1aaf59bb757a6e3
          git: "https://github.com/AccelerateHS/accelerate-llvm.git"
          subdirs:
          - "accelerate-llvm-native/"
          - commit: 2b5d69448557e89002c0179ea1aaf59bb757a6e3
          git: "https://github.com/AccelerateHS/accelerate-llvm.git"
          subdirs:
          - "accelerate-llvm/"
          - commit: 334d05519436bb7f20f9926ec76418f5b8afa359 - commit: 334d05519436bb7f20f9926ec76418f5b8afa359
          git: "https://github.com/AccelerateHS/accelerate.git" git: "https://github.com/AccelerateHS/accelerate.git"
          subdirs: subdirs:
          ...@@ -173,14 +164,6 @@ ...@@ -173,14 +164,6 @@
          git: "https://github.com/adinapoli/http-reverse-proxy.git" git: "https://github.com/adinapoli/http-reverse-proxy.git"
          subdirs: subdirs:
          - . - .
          - commit: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
          git: "https://github.com/adinapoli/llvm-hs.git"
          subdirs:
          - "llvm-hs"
          - commit: 7533a9ccd3bfe77141745f6b61039a26aaf5c83b
          git: "https://github.com/adinapoli/llvm-hs.git"
          subdirs:
          - "llvm-hs-pure"
          - commit: a110807651036ca2228a76507ee35bbf7aedf87a - commit: a110807651036ca2228a76507ee35bbf7aedf87a
          git: "https://github.com/alpmestan/accelerate-arithmetic.git" git: "https://github.com/alpmestan/accelerate-arithmetic.git"
          subdirs: subdirs:
          ...@@ -326,8 +309,6 @@ flags: ...@@ -326,8 +309,6 @@ flags:
          templatehaskell: true templatehaskell: true
          SHA: SHA:
          exe: false exe: false
          "abstract-deque":
          usecas: false
          accelerate: accelerate:
          "bounds-checks": true "bounds-checks": true
          debug: false debug: false
          ...@@ -440,6 +421,7 @@ flags: ...@@ -440,6 +421,7 @@ flags:
          formatting: formatting:
          "no-double-conversion": false "no-double-conversion": false
          gargantext: gargantext:
          "enable-benchmarks": false
          "no-phylo-debug-logs": false "no-phylo-debug-logs": false
          "test-crypto": false "test-crypto": false
          graphviz: graphviz:
          ...@@ -495,20 +477,16 @@ flags: ...@@ -495,20 +477,16 @@ flags:
          "test-properties": true "test-properties": true
          "test-templates": true "test-templates": true
          trustworthy: true trustworthy: true
          libffi:
          "ghc-bundled-libffi": true
          libyaml: libyaml:
          "no-unicode": false "no-unicode": false
          "system-libyaml": false "system-libyaml": false
          linear: linear:
          herbie: false herbie: false
          "template-haskell": true "template-haskell": true
          "llvm-hs":
          debug: false
          "llvm-with-rtti": false
          "shared-llvm": true
          lzma: lzma:
          pkgconfig: true pkgconfig: true
          massiv:
          "unsafe-checks": false
          "math-functions": "math-functions":
          "system-erf": true "system-erf": true
          "system-expm1": true "system-expm1": true
          ...@@ -617,8 +595,6 @@ flags: ...@@ -617,8 +595,6 @@ flags:
          transformers: true transformers: true
          tasty: tasty:
          unix: true unix: true
          "tasty-bench":
          tasty: true
          "tasty-golden": "tasty-golden":
          "build-example": false "build-example": false
          "text-format": "text-format":
          ......
          test/Test/Core/LinearAlgebra.hs 0 → 100644
          View file @ 250efc5b
          {-# LANGUAGE TypeApplications #-}
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE MultiWayIf #-}
          {-# LANGUAGE DerivingStrategies #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE ViewPatterns #-}
          module Test.Core.LinearAlgebra where
          import Data.Array.Accelerate hiding (Ord, Eq, map, (<=))
          import Data.Array.Accelerate.Interpreter qualified as Naive
          import Data.Array.Accelerate qualified as A
          import Data.Massiv.Array qualified as Massiv
          import Data.Proxy
          import Data.Scientific
          import Gargantext.Core.LinearAlgebra qualified as LA
          import Gargantext.Core.Methods.Matrix.Accelerate.Utils qualified as A
          import Gargantext.Core.Methods.Matrix.Accelerate.Utils qualified as Legacy
          import Gargantext.Core.Methods.Similarities.Accelerate.Distributional qualified as Legacy
          import Gargantext.Orphans.Accelerate (sliceArray)
          import Prelude hiding ((^))
          import Test.Tasty
          import Test.Tasty.QuickCheck
          --
          -- Utility types and functions
          --
          newtype SquareMatrix a = SquareMatrix { _SquareMatrix :: Matrix a }
          deriving newtype (Show, Eq)
          instance (Elt a, Show a, Prelude.Num a, Ord a, Arbitrary a) => Arbitrary (SquareMatrix a) where
          arbitrary = do
          x <- choose (1,30)
          let sh = Z :. x :. x
          SquareMatrix . A.fromList sh <$> vectorOf (x*x) arbitrary
          shrink = map (SquareMatrix) . sliceArray . _SquareMatrix
          type TermDivNanShape = Z :. Int :. Int
          twoByTwo :: SquareMatrix Int
          twoByTwo = SquareMatrix $ fromList (Z :. 2 :. 2) (Prelude.replicate 4 5)
          testMatrix_01 :: SquareMatrix Int
          testMatrix_01 = SquareMatrix $ fromList (Z :. 14 :. 14) $
          [ 30, 36, -36, -16, 0, 7, 34, -7, 5, -4, 0, 21, 6, -35,
          0, -31, 20, -15, -22, -7, -22, -37, -29, -29, 23, -31, -29, -23,
          -24, -29, 19, -6, 16, 7, 15, -27, -27, -30, -9, -33, 18, -23,
          7, -36, 12, 26, -17, -3, -2, -15, -4, 26, 24, 9, -4, 4,
          32, 28, -2, -10, 34, -3, 20, -9, -22, 20, -26, 34, 18, -21,
          7, -12, 12, -2, 36, 10, 34, -37, 13, -9, -28, 34, 33, -18,
          -4, -32, -1, 29, 29, -28, 24, 28, 35, 19, 8, -18, 25, -35,
          -14, -4, -24, -1, 7, 34, -37, -28, -12, -32, -5, -23, 27, 33,
          -36, -28, 21, -29, -2, -26, -4, -31, -26, -21, 33, -11, -33, 20,
          25, 14, 5, -7, 5, 24, 37, 1, -3, 23, 25, -16, 17, 5,
          -35, 36, -2, -2, 1, -14, 34, -30, -10, 12, 25, 21, 0, 34,
          17, -1, 20, -19, 15, 20, -5, -30, -35, -13, 5, 17, -10, -19,
          -34, -11, -18, 26, -29, -28, 0, 3, 23, -6, 36, 4, 16, 28,
          13, -37, -16, 2, 7, -13, 21, -10, -33, -33, -26, -19, -1, 29]
          testMatrix_02 :: SquareMatrix Int
          testMatrix_02 = SquareMatrix $ fromList (Z :. 7 :. 7) $
          [ 30, 36, -36, -16, 0, 7, 34,
          0, -31, 20, -15, -22, -7, -22,
          -24, -29, 19, -6, 16, 7, 15,
          7, -36, 12, 26, -17, -3, -2,
          32, 28, -2, -10, 34, -3, 20,
          7, -12, 12, -2, 36, 10, 34,
          13, -37, -16, 2, 7, -13, 21]
          testMatrix_03 :: SquareMatrix Int
          testMatrix_03 = SquareMatrix $ fromList (Z :. 11 :. 11) $
          [ 1, -1, 1, 0, 1, -1, 0, 1, 1, 0, 0,
          1, 1, 1, 1, 1, 0, 1, -1, 1, 0, 0,
          -1, 1, 0, -1, 0, -1, 0, 1, 0, -1, 0,
          1, 1, 1, -1, -1, 0, 1, -1, 0, 0, -1,
          -1, 1, -1, -1, 0, 1, 1, 1, -1, -1, -1,
          1, 1, 0, -1, -1, -1, 1, 0, 1, -1, -1,
          -1, 1, 0, -1, 1, -1, 0, 1, -1, -1, -1,
          1, 1, -1, 1, 1, 0, 1, -1, 1, -1, 1,
          -1, -1, 0, 1, 1, 0, 1, 1, -1, 1, 0,
          1, 1, 0, -1, 1, -1, 1, 0, 1, 0, -1,
          1, 1, -1, 0, -1, -1, 1, 0, 1, 0, -1]
          testMatrix_04 :: SquareMatrix Int
          testMatrix_04 = SquareMatrix $ fromList (Z :. 8 :. 8) $
          [ 3, -1, 0, 1, -1, 1, 1, -3,
          -2, -2, 2, 1, 1, -2, 1, -1,
          -2, -3, -1, 1, 1, -3, -2, -1,
          1, -2, 2, 0, 1, 0, 2, 0,
          -1, -3, -1, 3, -3, 0, -1, 2,
          0, 0, -3, 3, -1, -2, -1, 1,
          -2, 1, -1, 2, 1, -1, -2, 0,
          -2, 2, 1, 1, 1, 0, 2, -3]
          --
          -- Main test runner
          --
          tests :: TestTree
          tests = testGroup "LinearAlgebra" [
          testProperty "termDivNan" compareTermDivNan
          , testProperty "diag" compareDiag
          , testProperty "sumRows" compareSumRows
          , testProperty "matMaxMini" compareMatMaxMini
          , testProperty "sumM_go" compareSumM_go
          , testProperty "sumMin_go" compareSumMin_go
          , testProperty "matrixEye" compareMatrixEye
          , testProperty "diagNull" compareDiagNull
          , testGroup "distributional" [
          testProperty "reference implementation roundtrips" compareDistributionalImplementations
          , testProperty "2x2" (compareDistributional (Proxy @Double) twoByTwo)
          , testProperty "7x7" (compareDistributional (Proxy @Double) testMatrix_02)
          , testProperty "14x14" (compareDistributional (Proxy @Double) testMatrix_01)
          , testProperty "roundtrips" (compareDistributional (Proxy @Double))
          ]
          , testGroup "logDistributional2" [
          testProperty "2x2" (compareLogDistributional2 (Proxy @Double) twoByTwo)
          , testProperty "7x7" (compareLogDistributional2 (Proxy @Double) testMatrix_02)
          , testProperty "8x8" (compareLogDistributional2 (Proxy @Double) testMatrix_04)
          , testProperty "11x11" (compareLogDistributional2 (Proxy @Double) testMatrix_03)
          , testProperty "14x14" (compareLogDistributional2 (Proxy @Double) testMatrix_01)
          ,testProperty "roundtrips" (compareLogDistributional2 (Proxy @Double))
          ]
          ]
          --
          -- Tests
          --
          compareTermDivNan :: (Array TermDivNanShape Double)
          -> (Array TermDivNanShape Double)
          -> Property
          compareTermDivNan i1 i2
          = let massiv = LA.termDivNan @Massiv.U (LA.accelerate2MassivMatrix i1) (LA.accelerate2MassivMatrix i2)
          accelerate = Naive.run (Legacy.termDivNan (use i1) (use i2))
          in accelerate === LA.massiv2AccelerateMatrix massiv
          compareDiag :: SquareMatrix Int -> Property
          compareDiag (SquareMatrix i1)
          = let massiv = LA.diag (LA.accelerate2MassivMatrix i1)
          accelerate = Naive.run (Legacy.diag (use i1))
          in accelerate === LA.massiv2AccelerateVector massiv
          compareSumRows :: Array (Z :. Int :. Int :. Int) Int -> Property
          compareSumRows i1
          = let massiv = LA.sumRows @_ @Massiv.U (LA.accelerate2Massiv3DMatrix i1)
          massiv' = LA.sumRowsReferenceImplementation @Massiv.U (LA.accelerate2Massiv3DMatrix i1)
          accelerate = Naive.run (A.sum (use i1))
          in counterexample "sumRows and reference implementation do not agree" (massiv === massiv') .&&.
          accelerate === LA.massiv2AccelerateMatrix massiv
          compareDistributionalImplementations :: SquareMatrix Int -> Property
          compareDistributionalImplementations (SquareMatrix i1) =
          let ma = LA.accelerate2MassivMatrix i1
          in LA.distributional @Massiv.U @Double ma === LA.distributionalReferenceImplementation ma
          compareDistributional :: forall e.
          ( Eq e
          , Show e
          , FromIntegral Int e
          , Prelude.RealFloat e
          , Massiv.Unbox e
          , A.Ord e
          , Ord e
          , Prelude.Fractional (Exp e)
          , Prelude.Fractional e
          , Monoid e
          ) => Proxy e
          -> SquareMatrix Int
          -> Property
          compareDistributional Proxy (SquareMatrix i1)
          = let massiv = Massiv.computeAs Massiv.B $ LA.distributional @_ @e (LA.accelerate2MassivMatrix i1)
          accelerate = Legacy.distributionalWith Naive.run i1
          expected = map conv (A.toList accelerate)
          actual = map conv (mconcat (Massiv.toLists2 massiv))
          in counterexample "size not equal" (Prelude.length expected === Prelude.length actual) .&&. expected === actual
          where
          conv :: e -> Scientific
          conv = fromFloatDigits
          compareLogDistributional2 :: forall e.
          ( Eq e
          , Show e
          , FromIntegral Int e
          , Prelude.RealFloat e
          , Massiv.Unbox e
          , A.Ord e
          , Ord e
          , Prelude.Fractional (Exp e)
          , Prelude.Fractional e
          , Prelude.Floating (Exp e)
          , Prelude.Floating e
          , Monoid e
          ) => Proxy e
          -> SquareMatrix Int
          -> Property
          compareLogDistributional2 Proxy (SquareMatrix i1)
          = let massiv = Massiv.computeAs Massiv.B $ LA.logDistributional2 @_ @e (LA.accelerate2MassivMatrix i1)
          accelerate = Legacy.logDistributional2With Naive.run i1
          expected = map conv (A.toList accelerate)
          actual = map conv (mconcat (Massiv.toLists2 massiv))
          in counterexample "size not equal" (Prelude.length expected === Prelude.length actual) .&&. expected === actual
          where
          conv :: e -> Scientific
          conv = fromFloatDigits
          compareMatMaxMini :: SquareMatrix Int -> Property
          compareMatMaxMini (SquareMatrix i1)
          = let massiv = LA.matMaxMini (LA.accelerate2MassivMatrix i1)
          accelerate = Naive.run (A.matMaxMini (use i1))
          in accelerate === LA.massiv2AccelerateMatrix massiv
          compareSumMin_go :: SquareMatrix Int -> Property
          compareSumMin_go (SquareMatrix i1)
          = let massiv = LA.sumMin_go (A.dim i1) (LA.accelerate2MassivMatrix i1)
          accelerate = Naive.run (Legacy.sumMin_go (A.dim i1) (use i1))
          in accelerate === LA.massiv2AccelerateMatrix massiv
          compareSumM_go :: SquareMatrix Int -> Property
          compareSumM_go (SquareMatrix i1)
          = let massiv = LA.sumM_go (A.dim i1) (LA.accelerate2MassivMatrix i1)
          accelerate = Naive.run (Legacy.sumM_go (A.dim i1) (use i1))
          in accelerate === LA.massiv2AccelerateMatrix massiv
          compareMatrixEye :: Positive Int -> Property
          compareMatrixEye (getPositive -> n)
          = let massiv = Massiv.compute @Massiv.U $ LA.matrixEye @Int n
          accelerate = Naive.run (Legacy.matrixEye n)
          in accelerate === LA.massiv2AccelerateMatrix massiv
          compareDiagNull :: SquareMatrix Int -> Property
          compareDiagNull (SquareMatrix i1)
          = let massiv = Massiv.compute @Massiv.U $ LA.diagNull (A.dim i1) (LA.accelerate2MassivMatrix i1)
          accelerate = Naive.run (Legacy.diagNull (A.dim i1) (use i1))
          in accelerate === LA.massiv2AccelerateMatrix massiv
          test/drivers/tasty/Main.hs
          View file @ 250efc5b
          ...@@ -12,6 +12,7 @@ module Main where ...@@ -12,6 +12,7 @@ module Main where
          import Gargantext.Prelude import Gargantext.Prelude
          import qualified Test.Core.LinearAlgebra as LinearAlgebra
          import qualified Test.Core.Notifications as Notifications import qualified Test.Core.Notifications as Notifications
          import qualified Test.Core.Orchestrator as Orchestrator import qualified Test.Core.Orchestrator as Orchestrator
          import qualified Test.Core.Similarity as Similarity import qualified Test.Core.Similarity as Similarity
          ...@@ -78,4 +79,5 @@ main = do ...@@ -78,4 +79,5 @@ main = do
          , Notifications.qcTests , Notifications.qcTests
          , Orchestrator.qcTests , Orchestrator.qcTests
          , NgramsTerms.tests , NgramsTerms.tests
          , LinearAlgebra.tests
          ] ]
          Markdown is supported
          0% or
          You are about to add 0 people to the discussion. Proceed with caution.
          Finish editing this message first!
          Please register or to comment