Hitung determinan Haskell dari sebuah matriks

Saya memutuskan untuk memposting kode untuk menghitung determinan. Kode berfungsi, meskipun tidak berpura-pura menjadi virtuoso. Sangat menarik untuk menyelesaikan masalah ini di Haskell. Dua pendekatan untuk memecahkan masalah dipertimbangkan: rekursi sederhana dan metode Gaussian.

Sedikit teori

Seperti yang Anda ketahui, determinan dari matriks persegi n * n adalah jumlah dari n! suku, yang masing-masing merupakan produk yang mengandung tepat satu elemen matriks dari setiap kolom dan tepat satu dari setiap baris. Tanda potongan selanjutnya:

$$

$${a}_{1,i1}*{a}_{2,i2}*...{a}_{n,in}$$

ditentukan oleh paritas substitusi:

\ begin {pmatrix} 1 & 2 &… & n \\ {i} _ {1} & {i} _ {2} &… & {i} _ {n} \ end {pmatrix} $$\begin{pmatrix}1 & 2 &… & n \\ {i}_{1} & {i}_{2} &… & {i}_{n} \end{pmatrix}$$



Metode langsung untuk menghitung determinan terdiri dari menguraikannya dengan elemen baris atau kolom menjadi jumlah produk elemen baris atau kolom dengan pelengkap aljabar mereka. Selanjutnya, komplemen aljabar dari elemen matriks

$$

$${a}_{i,j}$$

ada

$$

$${(-1)}^{i+j}*{M}_{i,j}$$

di mana

$$

$${M}_{i,j}$$

- Ada elemen minor (i, j), yaitu determinan diperoleh dari determinan asli dengan menghapus baris ke-i dan kolom ke-j.



Metode ini menghasilkan proses rekursif yang memungkinkan setiap determinan dihitung. Tetapi kinerja dari algoritma ini meninggalkan banyak hal yang diinginkan - O (n!). Oleh karena itu, penghitungan langsung seperti itu digunakan, kecuali untuk penghitungan simbolik (dan dengan determinan yang orde-nya tidak terlalu tinggi).



Metode Gauss ternyata jauh lebih produktif. Esensinya didasarkan pada ketentuan berikut:



1. Determinan dari matriks segitiga atas \ begin {pmatrix} {a} _ {1,1} & {a} _ {1,2} &… & {a} _ {1, n} \\ 0 & {a} _ {2,2} &… & {a} _ {2, n} \\ 0 & 0 & ... & ... \\ 0 & 0 &… & {a} _ {n, n} \\\ akhir { pmatrix} sama dengan hasil kali elemen diagonalnya. Fakta ini segera mengikuti dari dekomposisi determinan ke dalam elemen-elemen baris pertama atau kolom pertama. 2. Jika dalam matriks ke elemen satu baris ditambahkan elemen baris lain, dikalikan dengan angka yang sama, maka nilai determinan tidak akan berubah. 3. Jika dua baris (atau dua kolom) dipertukarkan dalam matriks, maka nilai determinan akan berubah tandanya menjadi sebaliknya. sama dengan produk dari elemen-elemen diagonalnya. Fakta ini segera mengikuti dekomposisi determinan dalam elemen-elemen baris pertama atau kolom pertama. $$\begin{pmatrix}{a}_{1,1} & {a}_{1,2} &… & {a}_{1,n} \\ 0 & {a}_{2,2} &… & {a}_{2,n} \\ 0 & 0 &… & ...\\ 0 & 0 &… & {a}_{n,n} \\\end{pmatrix}$$











Dengan memilih koefisien, kita dapat menambahkan baris pertama dari matriks dengan yang lainnya dan mendapatkan nol di kolom pertama di semua posisi kecuali yang pertama. Untuk mendapatkan nol di baris kedua, Anda harus menambahkan baris pertama ke baris kedua, dikalikan dengan

$$

$$-{a}_{2,1}/{a}_{1,1}$$

Untuk mendapatkan nol di baris ketiga, tambahkan baris pertama dikalikan

$$

$$-{a}_{3,1}/{a}_{1,1}$$

dll. Akhirnya, matriks tersebut akan direduksi menjadi bentuk di mana semua elemen

$$

$${a}_{n,1}$$

karena n> 1 akan sama dengan nol.



Jika dalam matriks elemen

$$

$${a}_{1,1}$$

ternyata sama dengan nol, maka Anda dapat menemukan elemen bukan nol di kolom pertama (misalkan ada di tempat ke-k) dan menukar baris pertama dan ke-k. Dengan transformasi ini, determinan hanya mengubah tandanya, yang dapat diperhitungkan. Jika tidak ada elemen bukan nol di kolom pertama, maka determinannya sama dengan nol.



Selanjutnya, bertindak dengan cara yang sama, Anda bisa mendapatkan nol di kolom kedua, lalu di kolom ketiga, dll. Penting bahwa angka nol yang diperoleh sebelumnya tidak akan berubah ketika string ditambahkan. Jika untuk setiap baris tidak mungkin menemukan elemen bukan nol untuk penyebut, maka determinannya sama dengan nol dan prosesnya dapat dihentikan. Penyelesaian normal dari proses Gaussian menghasilkan matriks di mana semua elemen yang terletak di bawah diagonal utama sama dengan nol. Seperti disebutkan di atas, determinan matriks tersebut sama dengan hasil kali elemen diagonal.

Mari beralih ke pemrograman.

Kami bekerja dengan data titik mengambang. Kami mewakili matriks sebagai daftar string. Pertama, mari kita tentukan dua jenis:

type Row    = [Double]
type Matrix = [Row]

Rekursi sederhana

Tanpa ragu lagi, kami akan memperluas determinan dengan elemen baris pertama (yaitu nol). Kami membutuhkan program untuk membangun minor, diperoleh dengan menghapus baris pertama dan kolom k.

--  k-     
deln :: Matrix -> Int -> Matrix
deln matrix k = map (\ r -> (take (k) r)++(drop (k+1) r)) matrix

Dan inilah minornya:

--  k-   
minor :: Matrix -> Int -> Double
minor matrix k = det $ deln (drop 1 matrix) k

Harap diperhatikan: minor adalah determinan. Kami memanggil fungsi det, yang belum kami implementasikan. Untuk mengimplementasikan det, kita harus membentuk penjumlahan bergantian dari produk elemen berikutnya dari baris pertama dengan determinan minor berikutnya. Untuk menghindari ekspresi yang tidak praktis, mari buat fungsi terpisah untuk membentuk tanda penjumlahan:

sgn :: Int -> Double
sgn n = if n `rem` 2 == 0 then 1.0 else (-1.0)

Sekarang kita bisa menghitung determinannya:

--   
det :: Matrix -> Double
det [[a,b],[c,d]] = a*d-b*c
det matrix = sum $ map (\c -> ((matrix !! 0)!!c)*(sgn c)*(minor matrix c))  [0..n]
             where n = length matrix - 1

Kode ini sangat sederhana dan tidak memerlukan komentar khusus Untuk menguji kinerja fungsi kita, mari tulis fungsi utama:

main = print $ det [[1,2,3],[4,5,6],[7,8,(-9)]]

Nilai determinan ini adalah 54, yang dapat diverifikasi.

Metode Gauss

Kami membutuhkan beberapa fungsi utilitas (yang dapat digunakan di tempat lain). Yang pertama adalah pertukaran dua baris dalam matriks:

--    
swap :: Matrix -> Int -> Int -> Matrix
swap matrix n1 n2 = map row [0..n]
                    where n=length matrix - 1
                          row k | k==n1 = matrix !! n2
                                | k==n2 = matrix !! n1
                                | otherwise = matrix !! k

Seperti yang Anda lihat dari kode di atas, fungsinya melewati baris demi baris. Dalam kasus ini, jika garis dengan nomor n1 ditemukan, garis n2 diganti paksa (dan sebaliknya). Sisa garis tetap di tempatnya.



Fungsi berikut menghitung string r1 ditambahkan dengan string r2 elemen dikalikan dengan elemen dengan angka f:

--   r1+f*r2
comb :: Row -> Row -> Double -> Row
comb r1 r2 f = zipWith (\ x y -> x+f*y) r1 r2

Semuanya di sini sangat transparan: tindakan dilakukan pada baris matriks (yaitu, pada daftar [Ganda]). Tetapi fungsi berikut melakukan transformasi ini pada matriks (dan, secara alami, mendapatkan matriks baru):

--    r1  r2,   f
trans :: Matrix -> Int -> Int -> Double -> Matrix
trans matrix n1 n2 f = map row [0..n]
                       where n=length matrix - 1
                             row k | k==n1 = comb (matrix !! n1) (matrix !! n2) f
                                   | otherwise = matrix !! k

Fungsi getNz mencari nomor elemen bukan nol pertama dalam daftar. Ini diperlukan ketika elemen diagonal berikutnya sama dengan nol.

--     
getNz :: Row -> Int
getNz xs = if length tmp == 0 then (-1) else snd $ head tmp
           where tmp=dropWhile (\ (x,k) -> (abs x) <= 1.0e-10) $ zip xs [0..]

Jika semua elemen daftar nol, fungsi akan mengembalikan -1.



Fungsi pencarian memeriksa apakah matriks tersebut cocok untuk transformasi berikutnya (harus memiliki elemen diagonal berikutnya bukan nol). Jika tidak, matriks diubah oleh permutasi baris.

--        
search :: Matrix -> Int -> Matrix
search matrix k | (abs ((matrix !! k) !! k)) > 1.0e-10 = matrix
                | nz < 0 = matrix  --      
                | otherwise = swap matrix k p 
                           where n   = length matrix
                                 lst = map (\ r -> r !! k) $ drop k matrix
                                 nz  = getNz lst
                                 p   = k + nz

Jika tidak mungkin menemukan elemen utama (bukan nol) (matriks mengalami penurunan), maka fungsi tersebut akan mengembalikannya tanpa perubahan. Fungsi mkzero membentuk nol di kolom matriks berikutnya:

--     
mkzero :: Matrix -> Int -> Int -> Matrix
mkzero matrix k p | p>n-1 = matrix
                  | otherwise = mkzero (trans matrix p k (-f)) k (p+1)
                    where n = length matrix
                          f = ((matrix !! p) !! k)/((matrix !! k) !! k)

Fungsi segitiga membentuk bentuk segitiga atas dari matriks:

--     
triangle :: Matrix -> Int -> Matrix
triangle matrix k | k>=n = matrix
                  | (abs v) <= 1.0e-10 = [[0.0]] --  
                  | otherwise = triangle (mkzero tmp k k1) k1 
                    where n   = length matrix
                          tmp = search matrix k
                          v   = (tmp !! k) !! k --  
                          k1  = k+1

Jika pada tahap berikutnya tidak mungkin menemukan elemen utama, fungsi mengembalikan matriks nol dengan urutan pertama. Sekarang Anda dapat menyusun fungsi parade untuk mereduksi matriks menjadi bentuk segitiga atas:

--  
gauss :: Matrix -> Matrix
gauss matrix = triangle matrix 0 

Untuk menghitung determinan, kita perlu mengalikan elemen diagonal. Untuk melakukan ini, mari buat fungsi terpisah:

--   
proddiag :: Matrix -> Double
proddiag matrix = product $ map (\ (r,k) -> r !!k) $ zip matrix [0,1..]

Nah, dan "busur" adalah perhitungan determinan yang sebenarnya:

--  
det :: Matrix -> Double
det matrix = proddiag $ triangle matrix 0

Mari kita periksa bagaimana fungsi ini bekerja:

main = print $ det  [[1,2,3],[4,5,6],[7,8,-9]]

[1 of 1] Compiling Main             ( main.hs, main.o ) 
Linking a.out ...                                                                                 
54.0     

Terima kasih untuk mereka yang membaca sampai akhir!



Kode dapat diunduh di sini