<table cellspacing="0" cellpadding="0" border="0" ><tr><td valign="top" style="font: inherit;">I am keeping with my project of translating programs from Clean to Haskell. As far as arrays go, I don't understand well how to use them in Haskell. Therefore, I will appreciate if somebody can find time to check the program below, and make suggestions to improve it. My Haskell program is about 4 times slower than the Clean version. It would be great if one could reduce the execution time by half, approaching to the speed of Clean and Scheme. Here are the constraints:<br><br>1 --- The program must be implemented using arrays. Update must be done in place, in order to minimize use of the garbage collector. I have used Data.Array.IO, but I guess that Data.Array.ST is better. Is it easy to rewrite the program in order to use DataArray.ST?<br><br>2 -- I liked very much the forM_ monad. I wonder if there is an accumulating monad that play the role
of a program like leftSide.<br><br>3 -- Clean program almost double its speed, if one uses strictness annotations. Is it possible to use similar anotations for Haskell?<br><br>Here is how I compiled the program:<br><br>ghc -O2 gel.hs --make<br><br>In order to run the program with 2000 equations, type<br><br>gel.exe 2000 +RTS -sstderr<br><br>The program will create a linear system with 2000 equations so that all elements of the solution is equal to 1. It prints 20 elements of the solution.<br><br>Here is the program:<br><br>{- File: gel.hs<br>Compilation: ghc -O2 gel.hs --make<br>Run: time gel.exe 2000<br>-}<br>import Control.Monad<br>import Data.Array.IO<br>import System.IO<br>import System.Random<br>import System (getArgs)<br><br>prtSol i n1 arr | i < 1= return ()<br>prtSol i n1 arr= do<br> b <- readArray arr (i, n1)<br> putStr ((show b)++" ")<br> prtSol (i-1) n1 arr<br><br>fillArray xs
s (i, n) (j, m) arr | i > n= return ()<br>fillArray xs s (i,n) (j, m) arr | i==n && j>m= do<br> writeArray arr (i, j) s<br> return ()<br>fillArray xs s (i, n) (j, m) arr | j > m = do<br> writeArray arr (i, j) s<br> fillArray xs 0.0 (i+1, n) (1, m) arr<br>fillArray (val:xs) s (i, n) (j, m) arr= do<br> writeArray arr (i, j) val<br> fillArray xs (s+val) (i, n) (j+1, m) arr<br><br>sLU arr n= sIJ 2 1 2 n arr<br><br>sIJ i j k n arr | i > n = return ()<br>sIJ i j k n arr | k > n = sIJ (i+1) i (i+1) n arr<br>sIJ i j k n arr = do<br> im <- pmax (j+1) j<br> swap j im 1<br> a <- readArray arr (k, j)<br> forM_ [j..n+1] $ \l -> do<br> ajj <- readArray arr (j, j)<br> ajl <- readArray arr (j, l)<br> akl <- readArray arr (k, l)
<br> writeArray arr (k, l) (akl-a*(ajl/ajj))<br> sIJ i j (k+1) n arr where<br> pmax line imax | line > n = return imax<br> pmax line imax = do<br> alj <- readArray arr (line, j)<br> aij <- readArray arr (imax, j)<br> if (abs alj)> (abs aij) <br> then pmax (line+1) line<br> else pmax (line+1) imax<br> swap r s q | q>n+1 = return ()<br> swap r s q | r==s = return ()<br> swap r s q = do<br> arq <- readArray arr (r,q)<br> asq <- readArray arr
(s,q)<br> writeArray arr (s,q) arq<br> writeArray arr (r,q) asq<br> swap r s (q+1)<br> <br> <br>leftSide acc i j n arr | j>n= return acc<br>leftSide acc i j n arr = do<br> v <- readArray arr (j, n+1)<br> a <- readArray arr (i, j)<br> leftSide (acc-v*a) i (j+1) n arr<br><br>solvit i n arr | i<1= return ()<br>solvit i n arr= do<br> a <- readArray arr (i, i)<br> acc <- readArray arr (i, n+1)<br> v <- leftSide acc i (i+1) n arr<br> writeArray arr (i, n+1) (v/a)<br> solvit (i-1) n arr<br><br>rnList :: (Double, Double) -> IO [Double]<br>rnList r=getStdGen>>=(\x->return(randomRs r x))<br><br>dims [input] = (read input, read input)<br>dims _ = (1000, 1000)<br><br>main =
do<br> xs <- rnList (1.0,1000.0)<br> args <- getArgs<br> let (n, m)= dims args<br> arr <- newArray_ ((1,1),(n,m+1)) :: <br> IO (IOUArray (Int, Int) Double)<br> fillArray xs 0.0 (1,n) (1,m) arr<br> sLU arr n<br> solvit n n arr<br> prtSol (min 20 n) (n+1) arr<br> print "Done"<br><br></td></tr></table><br>
<hr size=1>
Looking for the perfect gift?<a href="http://www.flickr.com/gift/"><b> Give the gift of Flickr!</b></a>