HNumeric 0.4.0.0 → 0.5.0.0

raw patch · 8 files changed

+240/−88 lines, 8 filesdep +math-functionsdep +paralleldep −normaldistributionPVP ok

version bump matches the API change (PVP)

Dependencies added: math-functions, parallel

Dependencies removed: normaldistribution

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• HNumeric.cabal +7/−4
• README.md +8/−6
• src/HNum/CSV.hs +17/−16
• src/HNum/F.hs +9/−22
• src/HNum/Special.hs +16/−0
• src/HNum/Stats.hs +0/−2
• src/HNum/Vector.hs +177/−38

@@ -1,5 +1,11 @@ # Changelog for HNumeric ++## 0.5.0.0++* Great Optimisation with parallel+* Fix infinite determinant by Rosetta stone+ ## 0.4.0.0  * Add HNum.F (Functional Programming Library for HNum)

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a31a8bb1239bf98ba7561f43ae6c7fe1005cd190658fb003dd7a222ffd8ae071+-- hash: 9cfd5649e8b6b63aa2edca51c427be56f671256d05794ce8eaed484e456a0e1c  name:           HNumeric-version:        0.4.0.0+version:        0.5.0.0 synopsis:       Haskell Numeric Library with pure functionality, R & MATLAB Syntax. description:    Please see the README on GitHub at <https://github.com/Axect/HNumeric#readme> category:       HNum, library, Numeric, LinearAlgebra, Statistics, bsd3@@ -30,6 +30,7 @@   exposed-modules:       HNum.CSV       HNum.F+      HNum.Special       HNum.Stats       HNum.Vector   other-modules:@@ -38,7 +39,8 @@       src   build-depends:       base >=4.7 && <5-    , normaldistribution+    , math-functions+    , parallel     , random   default-language: Haskell2010 @@ -53,6 +55,7 @@   build-depends:       HNumeric     , base >=4.7 && <5-    , normaldistribution+    , math-functions+    , parallel     , random   default-language: Haskell2010

@@ -4,10 +4,11 @@  ## Packages -* HNum.Vector : Contain vector, matrix, linear algebra-* HNum.Stats  : Contain statistical functions-* HNum.CSV    : CSV Tools for HNum (Contain DataFrame)-* HNum.F      : Functional Programming Tools for HNum+* HNum.Vector  : Contain vector, matrix, linear algebra+* HNum.Stats   : Contain statistical functions+* HNum.CSV     : CSV Tools for HNum (Contain DataFrame)+* HNum.Special : Special Function wrapper for HNum+* HNum.F       : Functional Programming Tools for HNum  ## Installation @@ -174,8 +175,9 @@ * Divide and Conquer Matrix Multiplication, Determinant, Inverse * Module CSV with DataFrame (read / write) * FuncTools+* Parallelize Matrix Arithmetics -### TODO (2018.06.13)+### TODO (2018.06.18)  * DSL Documentation by LaTeX (Developing)-* More Statistical Tools+* More Statistical Tools (Like Normal Distribution)

@@ -9,6 +9,8 @@ module HNum.CSV where  import           HNum.Vector+import           Data.List                      ( intercalate )+import           Control.Parallel  ----------------------------------------------- -- Declaration@@ -58,19 +60,22 @@   writeCSV :: Show a => String -> f a -> IO ()  instance Writable Vector where-  toString v = foldr (\x y -> x ++ "\n" ++ y) "" (show <$> v)+  toString v = intercalate "\n" (toList $ show <$> v)   writeCSV title v = writeFile title (toString v)  instance Writable Matrix where-  toString m = foldr ((\x y -> x ++ "\n" ++ y) . cm) "" m1+  toString m = m1 `seq` m2 `seq` intercalate "\n" m2     where m1 = matForm (show <$> m)+          m2 = map (intercalate ",") m1   writeCSV title m = writeFile title (toString m)  instance Writable DataFrame where-  toString (DataFrame h m) = h' ++ "\n" ++ m'-    where h' = cm h-          m' = toString (transpose m)-  writeCSV title df = writeFile title (toString df)+  toString (DataFrame h m) = h' `par` t' `pseq` m' `pseq` h' ++ "\n" ++ m'+    where h' = intercalate "," h+          t' = transpose m+          m' = toString t'+  writeCSV title df = df' `seq` writeFile title df'+    where df' = toString df  ----------------------------------------------- -- Read from CSV@@ -87,17 +92,12 @@ ----------------------------------------------- -- Backend Function -------------------------------------------------- | For Convenient -cm :: [String] -> String-cm [] = []-cm (x : xs) | null xs   = x-            | otherwise = x ++ "," ++ cm xs- -- | Split With Seperator splitWith :: Char -> String -> [String] splitWith _ [] = []-splitWith sep str | null temp'' = [temp]-                  | otherwise   = temp : splitWith sep temp'+splitWith sep str+  | null temp'' = [temp]+  | otherwise = temp `par` temp'' `pseq` temp' `pseq` temp : splitWith sep temp'  where   temp   = takeWhile (/= sep) str   temp'' = dropWhile (/= sep) str@@ -106,8 +106,9 @@ -- | Remove Quotation Symbol rmQuot :: String -> String rmQuot [] = []-rmQuot x | null temp = clean-         | otherwise = clean ++ rmQuot clean'+rmQuot x+  | null temp = clean+  | otherwise = clean `par` temp `pseq` clean' `pseq` clean ++ rmQuot clean'  where   clean  = takeWhile (/= '"') x   temp   = dropWhile (/= '"') x

@@ -1,7 +1,14 @@+{- +Module      : HNum.F+Description : Missing Functional Programming tools for HNumeric+CopyRight   : (c) Tae Geun Kim, 2018+License     : BSD3+Maintainer  : edeftg@gmail.com+Stability   : Experimental+-} module HNum.F where -import           HNum.Vector-import           HNum.CSV+import           Data.Functor                   ( )  -- | Functional Programming Tools for HNum Object class Functor f => FuncTools f where@@ -21,24 +28,4 @@   hdrop :: Int -> f a -> f a   -- | Like dropWhile   hdropWhile :: (a -> Bool) -> f a -> f a--instance FuncTools Vector where-  hflat f = f . toList-  hlift f = vec . f . toList-  hmap = hlift . map-  hfilter = hlift . filter-  htake n = hlift (take n)-  htakeWhile f = hlift (takeWhile f)-  hdrop n = hlift (drop n)-  hdropWhile f = hlift (dropWhile f)--instance FuncTools Matrix where-  hflat = undefined-  hlift f = matrix . map f . matForm-  hmap = hlift . map-  hfilter = hlift . filter-  htake n = hlift (take n)-  htakeWhile f = hlift (takeWhile f)-  hdrop n = hlift (drop n)-  hdropWhile f = hlift (dropWhile f) 

@@ -0,0 +1,16 @@+module HNum.Special where++import           System.Random+import qualified Numeric.SpecFunctions         as SF+import           HNum.Vector+import           HNum.F++class FuncTools f => SpecialFunc f where+  erf :: Real a => f a -> f Double+  invErf :: Real a => f a -> f Double++instance SpecialFunc Vector where+  erf v = SF.erf . realToFrac <$> v+  invErf v = SF.invErf . realToFrac <$> v++

@@ -9,8 +9,6 @@ module HNum.Stats where  import           HNum.Vector-import           Data.Random.Normal-import           System.Random import           HNum.CSV  -- | To contain coefficients of linear regression.

@@ -1,5 +1,5 @@ {-|-Module      : HNumeric.Vector+Module      : HNum.Vector Description : Haskell Vector & Matrix & Linear Algebra Library to do machine learning CopyRight   : (c) Tae Geun Kim, 2018 License     : BSD3@@ -10,6 +10,8 @@  import           Data.Functor                   ( ) import           Control.Applicative            ( )+import           HNum.F+import           Control.Parallel  --------------------------------------------------- -- Vector@@ -76,14 +78,14 @@   -- | From List   fromList :: [a] -> m a   -- | Extract Element-  (!) :: m a -> Int -> a+  (.!) :: m a -> Int -> a   -- | Find Position of Element   findFirst :: Eq a => a -> m a -> Int  instance List Vector where   toList (Vector xs) = xs   fromList = Vector-  v ! n = toList v !! n+  v .! n = toList v !! n   findFirst n v | n `notElem` v = error "Not element!"                 | otherwise     = snd $ head $ dropWhile (\x -> fst x /= n) idx     where idx = zip (toList v) [0..]@@ -115,26 +117,30 @@     | r*c /= length v = error "Matrix Dimension mismatch!"     | b = ctake c v     | otherwise = dtake c v-      where ctake :: Int -> [a] -> [[a]]-            ctake _ [] = []-            ctake n m = take n m : ctake n (drop n m)-            dtake :: Int -> [a] -> [[a]]-            dtake _ [] = []-            dtake n m = [ptake n m r | r <- [0..(length m `div` n - 1)]]-            ptake n v r = [v !! x | x <- idx v, x `mod` (length v `div` n) == r]-            idx v = take (length v) [0..]+    where ctake _ [] = []+          ctake n m = let tnm = take n m+                          dnm = drop n m in tnm `par` dnm `pseq` tnm : ctake n dnm+          dtake _ [] = []+          dtake n m = [ptake n m r | r <- [0..(length m `div` n - 1)]]+          ptake n v r = let idxv = idx v in idxv `seq` [v !! x | x <- idxv, x `mod` (length v `div` n) == r]+          idx v = take (length v) [0..]   formMat [] = Matrix (Vector []) 0 0 True-  formMat xs = Matrix (Vector (concat xs)) (length xs) (length (head xs)) True+  formMat xs = cxs `par` lxs `pseq` Matrix (Vector cxs) lxs (length (head xs)) True+    where cxs = concat xs+          lxs = length xs  instance Show a => Show (Matrix a) where   show m = "Matrix " ++ show (matForm m)  instance Functor Matrix where-  fmap f mat = mat { val = fmap f (val mat) }+  fmap f mat = vm `seq` mat { val = fmap f vm }+    where vm = val mat  instance Applicative Matrix where   pure a = matrix []-  mf <*> mx = mx { val = val mf <*> val mx }+  mf <*> mx = vmf `par` vmx `pseq` mx { val = vmf <*> vmx }+    where vmf = val mf+          vmx = val mx  instance Num a => Num (Matrix a) where   negate m = negate <$> m@@ -175,6 +181,29 @@   foldl f z (Matrix (Vector xs) _ _ _) = foldl f z xs  ---------------------------------------------------+-- FuncTools+---------------------------------------------------+instance FuncTools Vector where+      hflat f = f . toList+      hlift f = vec . f . toList+      hmap = hlift . map+      hfilter = hlift . filter+      htake n = hlift (take n)+      htakeWhile f = hlift (takeWhile f)+      hdrop n = hlift (drop n)+      hdropWhile f = hlift (dropWhile f)++instance FuncTools Matrix where+      hflat = undefined+      hlift f = matrix . map f . matForm+      hmap = hlift . map+      hfilter = hlift . filter+      htake n = hlift (take n)+      htakeWhile f = hlift (takeWhile f)+      hdrop n = hlift (drop n)+      hdropWhile f = hlift (dropWhile f)++--------------------------------------------------- -- Type Conversion --------------------------------------------------- -- | Syntactic Sugar of read of functor@@ -244,17 +273,28 @@  instance MatOps Matrix where   m %*% n | col m /= row n = error "Can't Multiply - Dimension mismatch!"-          | otherwise      = matrix $ matForm m %-*-% matForm n-  m %/% n = m %*% inv n+          | otherwise      = mfm `par` mfn `pseq` matrix $ mfm %-*-% mfn+          where mfm = matForm m+                mfn = matForm n+  m %/% n = invn `seq` m %*% invn+    where invn = inv n   det m | col m /= row m = error "Can't calculate determinant of non-square matrix"         | otherwise = detMat (matForm m)   inv m | col m /= row m = error "Can't calculate inverse of non-square matrix"-        | otherwise = (matrix . invMat . matForm) m-  transpose m = m {row = col m, col = row m, byRow = not (byRow m)}+        | otherwise = mfm `seq` invM `seq` matrix invM+        where mfm = matForm m+              invM = invMat mfm+  transpose m = cm `par` rm `par` bm `pseq` m {row = col m, col = row m, byRow = not (byRow m)}+    where cm = col m+          rm = row m+          bm = byRow m  -- |Block Partitioning bp :: Int -> Matrix a -> Matrix a-bp n m = matrix $ bpMat n (matForm m)+bp n m = mfm `seq` bpm `seq` matrix bpm+ where+  mfm = matForm m+  bpm = bpMat n mfm  --------------------------------------------------- -- Concatenate@@ -264,35 +304,48 @@   vcat :: f a -> f a -> Matrix a  instance Concatable Vector where-  hcat v w = fromList (toList v ++ toList w)-  vcat v w = matrix (toList v : [toList w])+  hcat v w = tlv `par` tlw `pseq` fromList (tlv ++ tlw)+    where tlv = toList v+          tlw = toList w+  vcat v w = tlv `par` tlw `pseq` matrix tlm+    where tlv = toList v+          tlw = [toList w]+          tlm = tlv : tlw  instance Concatable Matrix where-  hcat m n | row m == row n = matrix (zipWith (++) mf nf)+  hcat m n | row m == row n = mf `par` nf `pseq` matrix (zipWith (++) mf nf)            | otherwise = error "Can't concatenate matrices horizontally which have different row"            where mf = matForm m                  nf = matForm n-  vcat m n | col m == col n = m {val = hcat (val m) (val n), row = row m + row n}+  vcat m n | col m == col n = vm `par` vn `pseq` hmn `par` rm `par` rn `pseq` m {val = hmn, row = rm + rn}            | otherwise = error "Can't concatenate matrices vertically which have different col"+           where vm = val m+                 vn = val n+                 hmn = hcat vm vn+                 rm = row m+                 rn = row n  -- |(.:) inserts vector to head of matrix. (.:) :: Vector a -> Matrix a -> Matrix a-v .: m | length v == col m = matrix (toList v : matForm m)+v .: m | length v == col m = tv `par` mfm `pseq` matrix (tv : mfm)        | otherwise         = error "Can't insert length(Vector) /= col(Matrix)"+ where+  tv  = toList v+  mfm = matForm m  --------------------------------------------------- -- Sort --------------------------------------------------- -- | Quick Sort qsort :: Ord a => Vector a -> Vector a-qsort (Vector []) = vec []-qsort (Vector (x : xs)) =-  (qsort . vec) [ y | y <- xs, y <= x ] `hcat` vec [x] `hcat` (qsort . vec)-    [ y | y <- xs, y > x ]---- | Merge Sort---msort :: Ord a => Vector a -> Vector a---msort +qsort (Vector []      ) = vec []+qsort (Vector (x : xs)) = qsv1 `par` qsv2 `par` vx `pseq` hv1 `pseq` hv2+ where+  qsv1 = (qsort . vec) [ y | y <- xs, y <= x ]+  qsv2 = (qsort . vec) [ y | y <- xs, y > x ]+  vx   = vec [x]+  hv1  = hcat qsv1 vx+  hv2  = hcat hv1 qsv2  --------------------------------------------------- -- Backend Functions (Do not Understand)@@ -361,7 +414,23 @@ _     %-*-% [[]]  = [[]] [[] ] %-*-% _     = [[]] [[x]] %-*-% [[y]] = [[x * y]]-m     %-*-% n     = zipWith (++) a11 a12 ++ zipWith (++) a21 a22+m %-*-% n =+  m11+    `par`  m12+    `par`  m21+    `par`  m22+    `par`  n11+    `par`  n12+    `par`  n21+    `par`  n22+    `pseq` a11+    `par`  a12+    `par`  a21+    `par`  a22+    `pseq` b1+    `par`  b2+    `pseq` b1+    ++     b2  where   (m11, n11) = (bpMat 1 m, bpMat 1 n)   (m12, n12) = (bpMat 2 m, bpMat 2 n)@@ -371,6 +440,8 @@   a12        = (m11 %-*-% n12) %-+-% (m12 %-*-% n22)   a21        = (m21 %-*-% n11) %-+-% (m22 %-*-% n21)   a22        = (m21 %-*-% n12) %-+-% (m22 %-*-% n22)+  b1         = zipWith (++) a11 a12+  b2         = zipWith (++) a21 a22  zerosVec :: Int -> [Int] zerosVec n = take n [0, 0 ..]@@ -380,7 +451,10 @@  -- Position -> Length  basisVec :: Int -> Int -> [Int]-basisVec n m = zerosVec n ++ [1] ++ zerosVec (m - n - 1)+basisVec n m = zvn `par` zvm `pseq` zvn ++ [1] ++ zvm+ where+  zvn = zerosVec n+  zvm = zerosVec (m - n - 1)  permMat :: Int -> Int -> [[a]] -> [[Int]] permMat i j m@@ -425,9 +499,23 @@ detMat :: (Eq a, Fractional a) => [[a]] -> a detMat [[x]] = x detMat m-  | l == 2    = detMat m11 * detMat m22 - detMat m12 * detMat m21-  | d00 == 0  = (-1) ^ (l - 1) * detMat (cycleMat m)-  | otherwise = (detMat m11 * detMat m22 - detMat m12 * detMat m21) / detMat m00+  | l == 2+  = detMat m11 * detMat m22 - detMat m12 * detMat m21+  | d00 == 0+  = determinant m+  | otherwise+  = m11+    `par`  m12+    `par`  m21+    `par`  m22+    `par`  m00+    `pseq` d00+    `par`  d11+    `par`  d12+    `par`  d21+    `par`  d22+    `pseq` (d11 * d22 - d12 * d21)+    /      d00  where   l   = length m   m11 = bpMat' 1 m@@ -436,6 +524,10 @@   m22 = bpMat' 4 m   m00 = bpMat' 0 m   d00 = detMat m00+  d11 = detMat m11+  d22 = detMat m22+  d12 = detMat m12+  d21 = detMat m21  -- | Inverse for Double List - Order ~ n * 2^n invMat :: (Eq a, Fractional a) => [[a]] -> [[a]]@@ -448,7 +540,21 @@     $  zipWith (++) m22          (negMap m12)     ++ zipWith (++) (negMap m21) m11   | otherwise-  = zipWith (++) a11 a12 ++ zipWith (++) a21 a22+  = m11+    `par`  m12+    `par`  m21+    `par`  m22+    `pseq` a00+    `pseq` s+    `pseq` s00+    `pseq` a11+    `par`  a12+    `par`  a21+    `par`  a22+    `pseq` b1+    `par`  b2+    `pseq` b1+    ++     b2  where   m11 = bpMat 1 m   m12 = bpMat 2 m@@ -461,9 +567,42 @@   a12 = negMap a00 %-*-% m12 %-*-% s00   a21 = negMap s00 %-*-% m21 %-*-% a00   a22 = s00+  b1  = zipWith (++) a11 a12+  b2  = zipWith (++) a21 a22  -- | Find First  fd :: Eq a => a -> [a] -> Int fd n v | n `notElem` v = error "Not element!"        | otherwise     = snd $ head $ dropWhile (\x -> fst x /= n) idx   where idx = zip v [0 ..]+++-------------------------------------------------------------+-- Rosetta Stone+-------------------------------------------------------------+sPermutations :: [a] -> [([a], Int)]+sPermutations = flip zip (cycle [1, -1]) . foldl aux [[]]+ where+  aux items x = do+    (f, item) <- zip (cycle [reverse, id]) items+    f (insertEv x item)+  insertEv x []         = [[x]]+  insertEv x l@(y : ys) = (x : l) : ((y :) <$>) (insertEv x ys)++elemPos :: [[a]] -> Int -> Int -> a+elemPos ms i j = (ms !! i) !! j++prod :: Num a => ([[a]] -> Int -> Int -> a) -> [[a]] -> [Int] -> a+prod f ms = product . zipWith (f ms) [0 ..]++sDeterminant+  :: Num a => ([[a]] -> Int -> Int -> a) -> [[a]] -> [([Int], Int)] -> a+sDeterminant f ms = sum . fmap (\(is, s) -> fromIntegral s * prod f ms is)++determinant :: Num a => [[a]] -> a+determinant ms =+  sDeterminant elemPos ms . sPermutations $ [0 .. pred . length $ ms]++permanent :: Num a => [[a]] -> a+permanent ms =+  sum . fmap (prod elemPos ms . fst) . sPermutations $ [0 .. pred . length $ ms]