[Haskell-cafe] assistance with using haskell to calculate the determinant

Daniel Fischer daniel.is.fischer at web.de
Sun Mar 27 09:42:54 EST 2005


Am Sonntag, 27. März 2005 07:04 schrieb Carter Tazio Schonwald:
> I've written a simple program to calculate determinants of matrices, and
> while it executes to completion
> it fails to yield a correct answer. (and yes, I know I'm using lists to
> represent matrices)
>
> I would greatly appreciate any assistance in correcting this algorithm
>
> --Carter Schonwald
>
>
> import Prelude
 ^^^^^^^^^^^^^^^
is automatically done

>
>
> first [] = []
> first (a:b) = a
>
> nth::Int->[a]->a
> nth _ [] = error "list is too small"
> nth 1 (a:b) = a
> nth n (a:b)  = nth (n-1) b
>
> takeAfter::Int->[a]->[a]
> takeAfter _ [] = error "list too small"
> takeAfter 0 a= a
> takeAfter  1  (a:b) = b
> takeAfter  n (a:b)  = takeAfter  ( n-1)  b
^^^^^^^^^^
this is just 'drop'
>
>
>
> type Matrix = [[Rational]]
>
>
> pad a  = [x++x| x<- a]
>
>
> time2 []  _ = []
> time2  _ [] = []
> time2 (a:b) (c:d) = (a  * c):(time2 b d)
^^^^^^^^^
zipWith (*)
>
>
> tupleProd (a,b) = a * b
^^^^^^^^^^^
unused
>
>
> altSign a = [b* (-1^num) |  b<-a, num <- [2..]]
^^^^^^^^^
first real problem: this does absolutely not what you want,
take 4 (altSign [1,2])  == [-1,-1,-1,-1].
What you want is altSign [1,2] == [1,-2], which you get by

altSign = zipWith (*) [(-1)^n | n <- [0 .. ]]

or, with less calculation:

altSign = zipWith (*) (cycle [1,-1])


>
> index::Int->Int->Matrix->Rational
> index a b c  = nth b (nth a c) --- ath row, bth column
>
> slice::(Int,Int)->(Int,Int)->Matrix->Matrix
> slice (a,b) (c,d) list =   let rowSliceFront = takeAfter  (a-1) list
> ---  a and c are rows, b and c are columns
>                 in let rowSlice = take  (c-a+1) list
                                                                ^^^^^^
should be rowSliceFront
>                   in let columnSliceFront = map (takeAfter (b-1)) rowSlice
>                     in map (take  (d-b+1)) columnSliceFront
>
this would be more readable with layout:

slice (i,j) (k,l) mat
     = let rowSliceFront = drop (i-1) mat
             rowSlice = take (k-i+1) rowSliceFront
             columnSliceFront = map (drop (j-1)) rowSlice
         in map (take (l-j+1)) columnSliceFront

>
> determinant::Matrix->Rational
> determinant a = det (pad a) (length a)
>
>   -- only called from determinant
> det::Matrix->Int->Rational
> det a 1 = index 1 1 a
> det a size =let
>         coeffs = altSign (first (take 1 a))
>         newsize = size - 1
>         leastToMax = newsize - 1
>         slices = [ slice (2,  i) (size, i + leastToMax) a | i <-
> [2..(size+1)]  ]
>           in
>           sum (time2  coeffs (map (\l-> det l newsize) (map (pad)
> slices))  )
>
here is the next problem, you get the wrong signs here, for the 'slices' for 
the 3x3-matrix

1 2 3
6 5 4
2 4 2

will be 
5 4
4 2 -correct,

4 6
2 2 -which ought to be

6 4
2 2

and, correct again
6 5
2 4.

So some of the subdeterminants are summed with the wrong sign.

I fixed that in the attched code, clinging close to your version.
However I think it's not very efficient.

Hope to have been of assistance,

Daniel
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
-------------- next part --------------
module MyDet where

type Matrix = [[Rational]]

first :: [[a]] -> [a]
first [] = []
first (xs:_) = xs

pad a = [x ++ x | x <- a]

sig n = case odd n of
           True -> -1
	   False -> 1

ind :: Int -> Int -> Matrix -> Rational
ind i k mat = (mat !! (i-1)) !! (k-1)

slice :: (Int,Int) -> (Int,Int) -> Matrix -> Matrix
slice (i,j) (k,l) mat
    = let rowSliceFront = drop (i-1) mat
          rowSlice      = take (k-i+1) rowSliceFront
	  columnSliceFront = map (drop (j-1)) rowSlice
      in map (take (l-j+1)) columnSliceFront

determinant :: Matrix -> Rational
determinant mat = det (pad mat) (length mat)

det :: Matrix -> Int -> Rational
det mat 1 = ind 1 1 mat
det mat size
    = let coeffs = zipWith (*) (cycle [1,sig newsize]) $ first mat
          newsize = size - 1
	  leastToMax = newsize - 1
	  slices = [slice (2,i) (size,i+leastToMax) mat | i <- [2 .. (size+1)]]
      in sum (zipWith (*) coeffs (map (\l -> det l newsize) (map pad slices)))


More information about the Haskell-Cafe mailing list