The following pretends to reveal a bug in ghc-0.29-linux-386.
The program reduces the matrix mM to the staircase form by the
Gauss method over the coefficient domain = C = Int, Integer.
result( mM ) =
[1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
[0, 1, 2, 2, 2, 4, 1, 1, 3, 2, 2, 0, 1, 1, 1]
[0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
[0, 0, 0, 1, -3, -2, 2, -2, -5, -3, -1, 1, -3, -2, -2]
[0, 0, 0, 0, 1, -2, -3, 1, 2, 1, -1, -1, 2, 1, 1]
[0, 0, 0, 0, 0, 1, -65, -104, -142, 142, -18, 10, 47, -123, 57]
[0, 0, 0, 0, 0, 0, 1, 573, 935, -358, 74, -144, 73, 649, -71]
[0, 0, 0, 0, 0, 0, 0, 1, -487, -859, 291, -380, -1248, 282, -89]
...
[ ... 152394109291282413964112613753446 ]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]
result( mM_without_last_row_and_last_column ) = -- the right one
[1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
[0, 1, 1, 2, 1, 2, 1, 1, 2, 0, 1, 0, 0, 1]
[0, 0, -1, -2, -1, -2, -1, -1, -2, 0, -1, 0, 0, -1]
[0, 0, 0, 1, 2, 0, -1, 3, 5, -1, 0, -1, 1, 3]
[0, 0, 0, 0, 1, -1, -1, 3, 3, -1, 0, -1, 1, 3]
[0, 0, 0, 0, 0, 1, 1, -2, -1, 1, 0, 1, 0, -2]
[0, 0, 0, 0, 0, 0, 1, -2, -1, 1, -1, 1, 1, -2]
[0, 0, 0, 0, 0, 0, 0, 1, 4, -1, 1, 0, 3, 5]
[0, 0, 0, 0, 0, 0, 0, 0, 1, -2, -2, -1, 3, 4]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 13, 1, -2, -2]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, -1, 0]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, -27, 1]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0]
[0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1]
Bug in arithmetics ??
------------------------------------------------------------------
------------------------------------------------------------------
module Main ( main ) where
type C = Integer -- Int too
main =
let
mM = [ [1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 2, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 2, 2, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 3, 3, 3, 1, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0],
[1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0],
[1, 2, 2, 1, 2, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0],
[1, 2, 3, 1, 2, 2, 0, 1, 1, 1, 0, 0, 0, 0, 0],
[1, 3, 4, 3, 3, 4, 1, 1, 2, 1, 1, 0, 0, 0, 0],
[1, 4, 6, 6, 4, 8, 4, 1, 3, 2, 3, 1, 0, 0, 0],
[1, 2, 3, 1, 3, 2, 0, 1, 2, 1, 0, 0, 1, 0, 0],
[1, 3, 4, 3, 4, 4, 1, 2, 4, 1, 1, 0, 1, 1, 0],
[1, 3, 5, 3, 5, 6, 1, 2, 5, 3, 2, 0, 2, 1, 1]
]
:: [[C]]
restr n rows = map (take n) (take n rows)
n = 15 -- SWITCH 14 - 15
rM = restr n mM
in
writeFile "result"
(
"sM = \n" ++ (showMatr (toStaircase rM))
)
exit done
------------------------------------------------------------------
toStaircase :: [[C]] -> [[C]]
toStaircase = sc
where
sc [row] = [row]
sc m =
let
{ m' = clearColumn m; row1 = head m' }
in
case ( genericLength (head m'), (head row1)==0 )
of
(1, _ ) -> m'
(_, True) -> let s' = sc (map tail m') in map (0 :) s'
_ ->
let s'' = sc (map tail (tail m'))
in row1:(map (0 :) s'')
clearColumn m = case partition (\row-> (head row)/=0) m
of
([] , rest) -> rest
([r] , rest) -> r:rest
(maxs, rest) -> c maxs rest
c [r] rest = r:rest
c (r1:r2:maxs) rest =
let
mE22 = [[1,0],[0,1]] :: [[C]]
(a1,a2,t2) = reducePair (head r1) (head r2) mE22
:: (C, C, [[C]])
[r1Tl,r2Tl] = matrixMul t2 [tail r1,tail r2]
in
c ((a1:r1Tl):maxs) ((a2:r2Tl):rest)
reducePair :: C -> C -> [[C]] -> (C, C, [[C]])
reducePair a b [row1,row2] =
let
(q,r) = divRem b a
row2' = if q==0 then row2
else let q_row1 = map (q*) row1
in zipWith (-) row2 q_row1
in
if r==0 then ( a, r, [row1,row2'] )
else reducePair r a [row2',row1]
------------------------------------------------------------------
divRem :: C -> C -> (C,C)
divRem 0 y = (0,0)
divRem x y = let q = div x y
r = mod x y
in
if r==0 then (q,r)
else if r>0 then (q,r) else (q+1,r-y)
showMatr rows = concat (map (\row-> '\n':(show row)) rows)
matrixMul :: [[C]] -> [[C]] -> [[C]]
matrixMul rows1 rows2 =
map (\r-> rowMatrixMul r rows2) rows1
rowMatrixMul :: [C] -> [[C]] -> [C]
rowMatrixMul (x:xs) (row:rows) = rmm xs rows (map (x *) row)
where
rmm [] [] res = res
rmm (x:xs) (row:rows) res =
rmm xs rows (zipWith (+) res (map (x*) row))
rmm _ _ _ =
error "rowMatrixMul r m: different length"
;
