Haskell实现行列式、秩和逆矩阵计算 – 输入矩阵大小限制

huangapple go评论65阅读模式
英文:

Haskell implementation of Determinant, Rank and Inverse Matrix calculation- input matrix size limitation

问题

我是新手Haskell。

作为学术课程的一部分,我被要求在Haskell中实现一个函数,该函数计算给定矩阵的行列式、秩和逆矩阵。

我使用高斯消元法(对原始矩阵和初始化为单位矩阵的另一个矩阵执行相同的行操作)。我正在使用一次性方法来累积秩和行列式的值。

该函数对最大为600x600的输入矩阵表现如预期(在此情况下的执行时间为63秒)。
任何大小超过这个尺寸的输入都会导致过多的内存使用和不切实际的计算时间。

输入是3个不同的矩阵,大小分别为800x800、800x800和1000x1000。

值得一提的是,我不允许使用任何外部库(如HMatrix或Data.Matrix)。

我尽力优化了代码,但由于我是新手,未能使我的代码适用于大于600x600的大小。

import Data.Time.Clock
import System.IO

type Matrix = [[Double]]

-- Row operations

swapRows :: Int -> Int -> Matrix -> Matrix
swapRows i j mat = take i mat ++ [mat !! j] ++ (drop (i+1) . take j $ mat) ++ [mat !! i] ++ drop (j+1) mat

scaleRow :: Int -> Double -> Matrix -> Matrix
scaleRow i k mat = take i mat ++ [map (* k) (mat !! i)] ++ drop (i+1) mat

addRows :: Int -> Int -> Double -> Matrix -> Matrix
addRows i j k mat = take i mat ++ [zipWith (+) (mat !! i) (map (* k) (mat !! j))] ++ drop (i+1) mat

-- Gaussian elimination

eliminate :: Matrix -> (Matrix, Matrix, Double, Int)
eliminate mat = foldr eliminateRow (mat, identityMatrix (length mat), 1.0, rank) [0..length mat-1]
  where
    rank = length mat  -- Initialize rank as the number of rows

    eliminateRow row (mat, invMat, detAccum, rank) = foldl eliminateEntry (mat, invMat, detAccum, rank) [0..length mat-1]
      where
        eliminateEntry (mat, invMat, detAccum, rank) col
          | row == col = (scaleRow row (1 / pivot) mat, scaleRow row (1 / pivot) invMat, detAccum * pivot, rank)
          | mat !! col !! row /= 0 = (addRows col row (-ratio) mat, addRows col row (-ratio) invMat, detAccum, rank)
          | otherwise = (mat, invMat, detAccum, rank - 1)
          where
            pivot = mat !! row !! row
            ratio = (mat !! col !! row) / pivot

-- Matrix operations

identityMatrix :: Int -> Matrix
identityMatrix n = [[fromIntegral (fromEnum (i == j)) | j <- [1..n]] | i <- [1..n]]

-- create sub matrix n x n from matrix mat
subMatrix :: [[Double]] -> Int -> [[Double]]
subMatrix mat n = take n (map (take n) mat) 

-- Testing

main :: IO ()
main = do
  contenm_headMulScal <- readFile "det_matrix(800 x 800).txt"
  let mat = map (map read . words) (lines contenm_headMulScal) :: [[Double]]
  
  let piece_dim = 600
  let submat = subMatrix mat piece_dim
  
  tt_start <- getCurrentTime
  let (refMat, inverse, determinant, rank) = eliminate submat  -- Calculate the ref matrix, determinant, and rank
  t_end <- getCurrentTime
  
  putStrLn "\nDeterminant:"
  print determinant
  putStrLn "\nInverse Matrix:"
  putStrLn $ "First element in the inverse matrix: " ++ show (head (head inverse))
  putStrLn "\nRank:"
  print rank
  
  tt_end <- getCurrentTime
  
  print "Runtime:"
  print (diffUTCTime tt_end tt_start)

printMatrix :: Matrix -> IO ()
printMatrix mat = mapM_ (putStrLn . unwords . map show) mat

例如,如你所见,我从800x800的输入中取了一个600x600的“片段”。它可以工作。如果取一个更大的片段(700x700,或整个输入),则变得不切实际 - 大约需要一个小时的计算时间,计算机完全卡住了,因为内存使用过多。

感谢Daniel Wagner指出:
对于想要在家中尝试的人,可以尝试以下内容:

countingMatrix :: Int -> Matrix
countingMatrix n = [[fromIntegral (j*n+i) | j <- [1..n]] | i <- [1..n]]

用它替代从磁盘加载的矩阵。我将不胜感激地接受任何建议。

英文:

I'm new to Haskell.
As a part of an academic course, I was requested to implement a function in Haskell that calculates the determinant, rank and inverse matrix of a given matrix.

I use gaussian elimination (performing same row operations on both the original matrix and another matrix which is initialized as the identity matrix). I'm using a one-pass approach to accumulate to rank and determinant "on the fly".

The function behaves as expected for input matrices up to 600x600 (execution time in this case is 63 seconds).
Any input above that size causes excessive memory usage and impractical computation time.

The inputs are 3 different matrices, sizes 800x800, 800x800 and 1000x1000.

Worth mentioning I am not allowed to use any external libraries (such as HMatrix or Data.Matrix)

I did my best to optimize the code, but since I'm new I wasn't successful at making my code work for sizes larger than 600x600.

import Data.Time.Clock
import System.IO
type Matrix = [[Double]]
-- Row operations
swapRows :: Int -&gt; Int -&gt; Matrix -&gt; Matrix
swapRows i j mat = take i mat ++ [mat !! j] ++ (drop (i+1) . take j $ mat) ++ [mat !! i] ++ drop (j+1) mat
scaleRow :: Int -&gt; Double -&gt; Matrix -&gt; Matrix
scaleRow i k mat = take i mat ++ [map (* k) (mat !! i)] ++ drop (i+1) mat
addRows :: Int -&gt; Int -&gt; Double -&gt; Matrix -&gt; Matrix
addRows i j k mat = take i mat ++ [zipWith (+) (mat !! i) (map (* k) (mat !! j))] ++ drop (i+1) mat
-- Gaussian elimination
eliminate :: Matrix -&gt; (Matrix, Matrix, Double, Int)
eliminate mat = foldr eliminateRow (mat, identityMatrix (length mat), 1.0, rank) [0..length mat-1]
where
rank = length mat  -- Initialize rank as the number of rows
eliminateRow row (mat, invMat, detAccum, rank) = foldl eliminateEntry (mat, invMat, detAccum, rank) [0..length mat-1]
where
eliminateEntry (mat, invMat, detAccum, rank) col
| row == col = (scaleRow row (1 / pivot) mat, scaleRow row (1 / pivot) invMat, detAccum * pivot, rank)
| mat !! col !! row /= 0 = (addRows col row (-ratio) mat, addRows col row (-ratio) invMat, detAccum, rank)
| otherwise = (mat, invMat, detAccum, rank - 1)
where
pivot = mat !! row !! row
ratio = (mat !! col !! row) / pivot
-- Matrix operations
identityMatrix :: Int -&gt; Matrix
identityMatrix n = [[fromIntegral (fromEnum (i == j)) | j &lt;- [1..n]] | i &lt;- [1..n]]
-- create sub matrix n x n from matrix mat
subMatrix :: [[Double]] -&gt; Int -&gt; [[Double]]
subMatrix mat n = take n (map (take n) mat) 
-- Testing
main :: IO ()
main = do
--let submat = [[1, 2], [3, 4]]  -- 3x3 invertible matrix
contenm_headMulScal &lt;- readFile &quot;det_matrix(800 x 800).txt&quot;
let mat = map (map read . words) (lines contenm_headMulScal) :: [[Double]]
let piece_dim = 600
let submat = subMatrix mat piece_dim
tt_start &lt;- getCurrentTime
let (refMat, inverse, determinant, rank) = eliminate submat  -- Calculate the ref matrix, determinant, and rank
t_end &lt;- getCurrentTime
--putStrLn &quot;Original Matrix:&quot;
--printMatrix submat
putStrLn &quot;\nDeterminant:&quot;
print determinant
putStrLn &quot;\nInverse Matrix:&quot;
--printMatrix inverse
putStrLn $ &quot;First element in the inverse matrix: &quot; ++ show (head (head inverse))
putStrLn &quot;\nRank:&quot;
print rank
tt_end &lt;- getCurrentTime
print &quot;Runtime:&quot;
print (diffUTCTime tt_end tt_start)
printMatrix :: Matrix -&gt; IO ()
printMatrix mat = mapM_ (putStrLn . unwords . map show) mat

For example, I take a "piece" of 600x600 out of the 800x800 input as you can see. It works. take a larger piece (700x700, or all the input) and it become impractical - about an hour of calculation in which the computer is totally stuck due to excessive memory usage.

Thanks to Daniel Wagner for pointing out:
For folks who want to play along at home, try:

countingMatrix :: Int -&gt; Matrix
countingMatrix n = [[fromIntegral (j*n+i) | j &lt;- [1..n]] | i &lt;- 
[1..n]] 

in place of the matrix loaded from disk.

I would appreciate any suggestions.

答案1

得分: 3

看起来有一个空间泄漏/惰性问题。我不怪你:我发现要获得我想要的评估行为,即使我已经相当确定问题是什么,也感到令人讨厌!

你要确保的事情是,当创建一个新矩阵时,不要保留对旧矩阵的任何引用。如果这样做,垃圾回收器就不能收集旧矩阵。特别是,引用包括潜在的计算,如take i oldMatrixoldMatrix !! i或类似的操作。所以!让我们讨论一下我不得不做的更改。

首先:当我们创建一个新矩阵,大部分是从旧矩阵复制的行,但有一两行是新的时,我们需要一种方法来说:“遍历整个矩阵,并强制执行足够的计算,以便您复制一个指向特定行的指针,而不是稍后在旧矩阵中查找该行的计算”。为了实现这一点,我们将创建一个函数,用于强制执行列表的每个元素,但仅强制到弱头正规型(WHNF)。请注意,由于我们将矩阵传递给这个函数,这不是完全的评估!我们不会一直强制到矩阵元素,只会强制到矩阵行的级别。在我的第一次尝试中,我弄错了这一点,强制执行了到元素级别的评估,并无意中引入了非常严重的性能退化。

seqElements :: [a] -> [a]
seqElements [] = []
seqElements as@(a:at) = a `seq` seqElements at `seq` as

我们将在每个行操作的开头调用它。

swapRows i j mat = seqElements $ {- 旧实现 -}
scaleRows i k mat = seqElements $ {- 旧实现 -}
addRows i j k mat = seqElements $ {- 旧实现 -}

这形成了我们手动强制注释的“基本情况”。不幸的是,现在我们需要将这个传播到整个表达式树中——每个调用者都需要确保它使用其中一个字段创建的任何数据结构也将该字段的评估与数据结构的评估绑定在一起。在eliminateEntry中,这意味着我们需要一个更严格版本的四元组。

quadruple a b c d = a `seq` b `seq` c `seq` d `seq` (a, b, c, d)
-- 然后,在稍后,我们用四元组替换(,,,):
eliminateEntry (mat, invMat, detAccum, rank) col
  | row == col = quadruple (scaleRow row (1 / pivot) mat) (scaleRow row (1 / pivot) invMat) (detAccum * pivot) rank
  | mat !! col !! row /= 0 = quadruple (addRows col row (-ratio) mat) (addRows col row (-ratio) invMat) detAccum rank
  | otherwise = quadruple mat invMat detAccum (rank - 1)

最后,在eliminateRow中,我建议从foldl切换到foldl'。在我的测试中,似乎在这种情况下没有任何区别,但养成这个好习惯是明智的;foldl提供的额外惰性几乎从不需要,而且通常是有害的。

eliminateRow row (mat, invMat, detAccum, rank) = foldl' eliminateEntry (mat, invMat, detAccum, rank) [0..length mat-1]

通过这些更改,我现在看到内存使用量大幅降低:600x600矩阵约为50秒,96MiB,800x800矩阵约为128秒,167MiB。

如果需要的话,很可能还有显著的进一步优化机会,例如,我预计切换到可变数组表示法将是另一个重大提升。

英文:

Looks like there's a space leak/laziness issue. I don't blame you: I found it surprisingly finicky to get the evaluation behavior I wanted, even when I was already pretty sure what the problem was!

The thing you want to make sure of is that when making a new matrix, you don't hold onto any references to the old matrix. If you do, then the GC can't collect the old matrix. In particular, references include latent calculations like take i oldMatrix or oldMatrix !! i or similar. So! Let's discuss the changes I had to make to get this to happen.

First: when we make a new matrix that's mostly a copy of rows from the old matrix, but one or two new rows, we'll want a way to say "walk through the entire matrix, and force enough of its computation that you copy a pointer to a specific row, rather than a calculation that looks up that row in the old matrix later". To get this, we'll make a function that forces each element of a list, but only to WHNF. Note that, since we're passing this a matrix, this isn't a full evaluation! We don't force all the way down to matrix elements, only down to the level of matrix rows. On my first go I got this wrong, forcing all the way down to the element level, and inadvertently introduced a very serious time performance regression.

seqElements :: [a] -&gt; [a]
seqElements [] = []
seqElements as@(a:at) = a `seq` seqElements at `seq` as

We will call this at the start of each of the row operations.

swapRows i j mat = seqElements $ {- old implementation -}
scaleRows i k mat = seqElements $ {- old implementation -}
addRows i j k mat = seqElements $ {- old implementatiotn -}

This forms the "base case" of our manual forcing annotations. Unfortunately, we now need to propagate this all the way up the expression tree -- each caller needs to make sure that any data structures it makes with one of these in a field also ties evaluation of that data structure to evaluation of the field. In eliminateEntry, that means we need a stricter version of quadruples.

quadruple a b c d = a `seq` b `seq` c `seq` d `seq` (a, b, c, d)
-- then, later, we replace (,,,) with quadruple:
eliminateEntry (mat, invMat, detAccum, rank) col
| row == col = quadruple (scaleRow row (1 / pivot) mat) (scaleRow row (1 / pivot) invMat) (detAccum * pivot) rank
| mat !! col !! row /= 0 = quadruple (addRows col row (-ratio) mat) (addRows col row (-ratio) invMat) detAccum rank
| otherwise = quadruple mat invMat detAccum (rank - 1)

Finally, in eliminateRow, I recommend switching from foldl to foldl&#39;. It doesn't appear to make a difference in this case in my tests, but it's a good habit to get into; the extra laziness that foldl provides is almost never needed and frequently detrimental.

    eliminateRow row (mat, invMat, detAccum, rank) = foldl&#39; eliminateEntry (mat, invMat, detAccum, rank) [0..length mat-1]

With these changes, I now see a much lower memory usage: ~50s, 96MiB for the 600x600 matrix and ~128s, 167MiB for the 800x800 matrix.

There are likely opportunities for significant further optimization, if that turns out to be needed; e.g. I expect switching to a mutable array representation for your matrix would be another big boost.

huangapple
  • 本文由 发表于 2023年6月16日 03:53:34
  • 转载请务必保留本文链接:https://go.coder-hub.com/76485105.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定