My code is pasted here.
Below is my ghci debug session. I still don't understand why it has a range of (0, -193459561) when the 'len' binding is 90570.
*Main> :break 125
Breakpoint 4 activated at SVMCF.hs:125:13-86
*Main> :trace main
Stopped at SVMCF.hs:125:13-86
_result :: UA.Array Int [User] = _
len :: Int = 90570
rts :: [RTuple] = (1,1,5.0) : (1,2,3.0) : (1,3,4.0) : (1,4,3.0) :
(1,5,3.0) : ....
[SVMCF.hs:125:13-86] *Main> :lis
124 points :: A.Array Int [Int]
125 points = assert (len > 0) $ A.listArray (1::Int, len) $ map (\(u,i,r) -> [u,i]) rts
126 values :: UA.UArray Int Double
[SVMCF.hs:125:13-86] *Main> :ste
Stopped at SVMCF.hs:125:13-28
_result :: UA.Array Int [User] -> UA.Array Int [User] = _
len :: Int = 90570
[SVMCF.hs:125:13-28] *Main> :ste
Stopped at SVMCF.hs:125:21-27
_result :: Bool = _
len :: Int = 90570
[SVMCF.hs:125:21-27] *Main> :ste
Stopped at SVMCF.hs:125:32-86
_result :: UA.Array Int [User] = _
len :: Int = 90570
rts :: [RTuple] = (1,1,5.0) : (1,2,3.0) : (1,3,4.0) : (1,4,3.0) :
(1,5,3.0) : ....
[SVMCF.hs:125:32-86] *Main> :ste
Stopped at SVMCF.hs:125:32-56
_result :: [[User]] -> UA.Array Int [User] = _
len :: Int = 90570
[SVMCF.hs:125:32-56] *Main> :lis
124 points :: A.Array Int [Int]
125 points = assert (len > 0) $ A.listArray (1::Int, len) $ map (\(u,i,r) -> [u,i]) rts
126 values :: UA.UArray Int Double
[SVMCF.hs:125:32-56] *Main> len
90570
[SVMCF.hs:125:32-56] *Main> :ste
Stopped at SVMCF.hs:125:60-86
_result :: [[User]] = _
rts :: [RTuple] = (1,1,5.0) : (1,2,3.0) : (1,3,4.0) : (1,4,3.0) :
(1,5,3.0) : ....
[SVMCF.hs:125:60-86] *Main> :ste
*** Exception: Ix{Int}.index: Index (1) out of range ((1,-193459561))
I suspect the index out of range exception is not being caused in the expression that you think it is!
Data.Array.listArray (1,-10) [2,3,4,5]
does not throw any exception, it just gives you an empty array. Also note the column numbers in the last debug message:
Stopped at SVMCF.hs:125:60-86
60 to 86 is map (\(u,i,r) -> [u,i]) rts which doesn't obviously have any indexing going on in it: There's certainly none in map, nor in its first argument, and rts looks clean too as it comes straight from ua.base via Parsec.
Because Haskell is allowed to be fairly free with its evaluation order, it's possible that the exception is being thrown by a reduction in a completely different expression. Are you sure all the other things you're passing into SVM are set up correctly? In particular, given that you're using Int-indexed arrays, are you sure there's no integer overflow occurring in any array? Are any of your datasets, for example, 4101507735 or 8396475031 records long, because these overflow to -193459561 as Int).
Does the :history command in the GHCi debugger give you any more information?
Related
Intro:
I am trying to write a large set of data to a single file using MPI IO using the code below.
The problem i encounter is, that i get an integer overflow (variable disp) and thus the MPI IO does not work properly.
The reason for this is, i think, the declaration of the variable disp (integer (kind=MPI_OFFSET_KIND) :: disp = 0) in the subroutine write_to_file(...).
Since for the process with the highest rank disp overflows.
Question:
Can I somehow define disp as kind=MPI_OFFSET_KIND but with higher range? I did not find a solution for that, except writing to multiple files, but I would prefer writing into a single file.
Some context:
The code is just a part of an code, which i use to output (and read; but I cut that part from the code example to make it easier) scalar (ivar = 1), vector(ivar=3) or tensor(ivar=3,6 or 9) values into binary files. The size of the 3D grid is defined by imax, jmax and kmax, where kmax is decomposed by Px processes into Mk. Lately the 3D grid grew to a size where i encountered the described problem.
Code Example: MPI_IO_LargeFile.f90
"""
PROGRAM MPI_IO_LargeFile
use MPI
implicit none
integer rank, ierr, Px
integer i, j, k, cnt
integer imax, jmax, kmax, Mk
integer status(MPI_STATUS_SIZE)
integer ivars;
real*4, dimension(:,:,:,:), allocatable :: outarr, dataarr
call MPI_Init(ierr)
call MPI_Comm_size(MPI_COMM_WORLD, Px, ierr)
call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr)
imax = 256
jmax = 512
kmax = 1024
Mk = kmax / Px
if (rank < 1) print *, 'Preparing dataarr'
ivars = 6
allocate(dataarr(ivars,imax,jmax,Mk))
call RANDOM_NUMBER(dataarr)
! Output of Small File
if (rank < 1) print *, 'Output of SmallFile.txt'
ivars = 3
allocate(outarr(ivars,imax,jmax,Mk))
outarr(:,:,:,:) = dataarr(1:3,:,:,:)
call write_to_file(rank, 'SmallFile.txt', outarr)
deallocate(outarr)
! Output of Large File
if (rank < 1) print *, 'Output of LargeFile.txt'
ivars = 6
allocate(outarr(ivars,imax,jmax,Mk))
outarr(:,:,:,:) = dataarr(1:6,:,:,:)
call write_to_file(rank, 'LargeFile.txt', outarr)
deallocate(outarr)
deallocate(dataarr)
call MPI_Finalize(ierr)
CONTAINS
subroutine write_to_file(myrank, filename, arr)
implicit none
integer, intent(in) :: myrank
integer :: ierr, file, varsize
character(len=*), intent(in):: filename
real*4, dimension(:,:,:,:), allocatable, intent(inout) :: arr
**integer (kind=MPI_OFFSET_KIND) :: disp = 0**
varsize = size(arr)
disp = myrank * varsize * 4
**write(*,*) rank, varsize, disp**
call MPI_File_open(MPI_COMM_WORLD, filename, &
& MPI_MODE_WRONLY + MPI_MODE_CREATE, &
& MPI_INFO_NULL, file, ierr )
call MPI_File_set_view(file, disp, MPI_REAL4, &
& MPI_REAL4, 'native', MPI_INFO_NULL, ierr)
call MPI_File_write(file, arr, varsize, &
& MPI_REAL4, MPI_STATUS_IGNORE, ierr)
call MPI_FILE_CLOSE(file, ierr)
end subroutine write_to_file
END PROGRAM MPI_IO_LargeFile
"""
Output of Code: MPI_IO_LargeFile.f90
mpif90 MPI_IO_LargeFile.f90 -o MPI_IO_LargeFile
mpirun -np 4 MPI_IO_LargeFile
Preparing dataarr
Output of SmallFile.txt
2 100663296 805306368
1 100663296 402653184
3 100663296 1207959552
0 100663296 0
Output of LargeFile.txt
1 201326592 805306368
0 201326592 0
2 201326592 1610612736
3 201326592 -1879048192
mca_fbtl_posix_pwritev: error in writev:Invalid argument
mca_fbtl_posix_pwritev: error in writev:Invalid argument
The Problem is that the multiplication in
disp = myrank * varsize * 4
overflowed, since each variable was declared as integer.
One solution provided by #Gilles (in the comments of the question) was simply to change this line to
disp = myrank * size(arr, kind=MPI_OFFSET_KIND) * 4
Using size(arr, kind=MPI_OFFSET_KIND) converts the solution into an integer of kind=MPI_OFFSET_KIND, which solves the overflow problem.
Thank you for your help.
Haskell one is implemented using optimized Data.IntSet with complexity O(lg n). However, there is a 15x (previously 30x) speed difference for n = 2000000 despite Haskell code is already optimized for even number cases. I would like to know whether/why my implementation in Haskell is imperfect.
Original Haskell
primesUpTo :: Int -> [Int]
primesUpTo n = 2 : put S.empty [3,5..n]
where put :: S.IntSet -> [Int] -> [Int]
put _ [] = []
put comps (x:xs) =
if S.member x comps
then put comps xs
else x : put (S.union comps multiples) xs
where multiples = S.fromList [x*2, x*3 .. n]
Update
fromDistinctAscList gives a 4x speed increase. 2-3-5-7-Wheel speeds up by another 50%.
primesUpTo :: Int -> [Int]
primesUpTo n = 2 : 3 : 5 : 7 : put S.empty (takeWhile (<=n) (spin wheel 11))
where put :: S.IntSet -> [Int] -> [Int]
put _ [] = []
put comps (x:xs) =
if S.member x comps
then put comps xs
else x : put (S.union comps multiples) xs
where multiples = S.fromDistinctAscList [x*x, x*(x+2) .. n]
spin (x:xs) n = n : spin xs (n + x)
wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel
Benchmarking
All time are measured by *nix time command, real space
Haskell original : 2e6: N/A; 2e7: >30s
Haskell optimized: 2e6: 0.396s; 2e7: 6.273s
C++ Set (ordered): 2e6: 4.694s; 2e7: >30s
C++ Bool Array : 2e6: 0.039s; 2e7: 0.421s
Haskell optimized is slower than C++ Bool by 10~15x, and faster than C++ Set by 10x.
Source code
C Compiler options: g++ 5.3.1, g++ -std=c++11
Haskell options: ghc 7.8.4, ghc
C code (Bool array) http://pastebin.com/W0s7cSWi
prime[0] = prime[1] = false;
for (int i=2; i<=limit; i++) { //edited
if (!prime[i]) continue;
for (int j=2*i; j<=n; j+=i)
prime[j] = false;
}
C code (Set) http://pastebin.com/sNpghrU4
nonprime.insert(1);
for (int i=2; i<=limit; i++) { //edited
if (nonprime.count(i) > 0) continue;
for (int j=2*i; j<=n; j+=i)
nonprime.insert(j);
}
Haskell code http://pastebin.com/HuMqwvRW
Code as written above.
I would like to know whether/why my implementation in Haskell is imperfect.
Instead of fromList you better use fromDistinctAscList which performs linearly. You may also add only odd multiples starting with x*x not x*2, because all the smaller odd multiples have already been added. Style-wise, a right fold may fit better than recursion.
Doing so, I get more than 3 times performance improvement for n equal to 2,000,000:
import Data.IntSet (member, union, empty, fromDistinctAscList)
sieve :: Int -> [Int]
sieve n = 2: foldr go (const []) [3,5..n] empty
where
go i run obs
| member i obs = run obs
| otherwise = i: run (union obs inc)
where inc = fromDistinctAscList [i*i, i*(i + 2)..n]
Nevertheless, an array has both O(1) access and cache friendly memory allocation. Using mutable arrays, I see more than 15 times performance improvement over your Haskell code (again n equal to 2,000,000):
{-# LANGUAGE FlexibleContexts #-}
import Data.Array.ST (STUArray)
import Control.Monad (forM_, foldM)
import Control.Monad.ST (ST, runST)
import Data.Array.Base (newArray, unsafeWrite, unsafeRead)
sieve :: Int -> [Int]
sieve n = reverse $ runST $ do
arr <- newArray (0, n) False :: ST s (STUArray s Int Bool)
foldM (go arr) [2] [3,5..n]
where
go arr acc i = do
b <- unsafeRead arr i
if b then return acc else do
forM_ [i*i, i*(i + 2).. n] $ \k -> unsafeWrite arr k True
return $ i: acc
I am implementing a topological sort in Haskell with the requirement to be as efficient as possible. I have profiled my current solution and found out the the following method is taking 60% of total time (and 0 amount of additional space):
import Control.Monad.ST
import Control.Monad
import Data.Array.ST
import Data.Array.Unboxed
import Data.Word
import Data.Array.Base
zeroElementsAfterDecrement' :: (MArray a e m, Num e, Eq e) => a Int e -> [Int] -> m [Int]
zeroElementsAfterDecrement' arr is = foldr k (return []) is
where k i a = do xs <- a
decremented <- liftM (subtract 1) (unsafeRead arr i)
unsafeWrite arr i decremented
if decremented == 0 then return (i:xs) else return xs
largenum :: Int
largenum = 10000000
test = runST $ do arr <- newArray (1, largenum) 100 :: ST s (STUArray s Int Word32)
zeroElementsAfterDecrement' arr [1..largenum]
main = (putStrLn . show) test
The function takes an array (I use unboxed mutable arrays) and a list of indexes, decrements elements by these indexes and returns indexes of elements that became zero during this operation. Right now this is more than 10 times slower than the optimized C++ code but still pretty good compared to Python (or maybe I don't know Python way to optimize this). I understand there is an overhead from executing a monadic code, but maybe there are still ways to optimize I am not aware of?
Edit:
GHC: -O -fllvm: 0.54s
GHC (with unsafeWrite/unsafeRead and Word32): 0.34s
g++: 0.24s
g++ -O2: 0.05s
python3: 2.66s
Also when I change foldr to foldl' it starts allocating some memory and is 4 times slower as a result, why is that?
Here is a C++ version I compared it to:
#include <iostream>
#include <vector>
using namespace std;
#define LARGENUM 10000000
int main()
{
vector <int> arr;
for (int i = 0; i < LARGENUM; i++) {
arr.push_back(100);
}
for (int i = 0; i < arr.size(); i++) {
arr[i]--;
if (arr[i] == 0)
cout << i << endl;
}
return 0;
}
And a Python version:
arr = [100] * 10000000
for x in range (0, 10000000 - 1):
arr[x] = arr[x] - 1
if arr[x] == 0:
print x
There is a thread waiting for new input in a queue to safe it to the file system. It also creates backup copies. The sscce looks like this:
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Data.Time.Clock.POSIX
main :: IO ()
main = do
contentQueue <- atomically $ newTQueue
_ <- forkIO $ saveThreadFunc contentQueue
forever $ do
line <- getLine
atomically $ writeTQueue contentQueue line
saveThreadFunc :: TQueue String -> IO ()
saveThreadFunc queue = forever $ do
newLine <- atomically $ readTQueue queue
now <- round `fmap` getPOSIXTime :: IO Int
writeFile "content.txt" newLine
-- todo: Backup no more than once every 86400 seconds (24 hours).
backupContent now newLine
backupContent :: Int -> String -> IO ()
backupContent t = writeFile $ "content.backup." ++ show t
Now it would be great if the backup would not be written more than once every 24 hours. In imperative programming I would probably use a mutable int lastBackupTime inside the "forever loop" in saveThreadFunc. How can the same effect be achieved in Haskell?
How about Control.Monad.Loops.iterateM_? This is slightly neater as it avoids explict recursion.
iterateM_ :: Monad m => (a -> m a) -> a -> m b
saveThreadFunc :: TQueue String -> Int -> IO ()
saveThreadFunc queue = iterateM_ $ \lastBackupTime -> do
newLine <- atomically $ readTQueue queue
now <- round `fmap` getPOSIXTime :: IO Int
writeFile "content.txt" newLine
let makeNewBackup = now >= lastBackupTime + 86400
when makeNewBackup (backupContent now newLine)
return (if makeNewBackup then now else lastBackupTime)
Replace forever with explicit recursion.
foo :: Int -> IO ()
foo n = do
use n
foo (n+1)
Of course, you can use any type for your state instead of Int.
Otherwise, if you really want the mutable state:
foo :: IO ()
foo = do
r <- newIORef (0 :: Int)
forever $ do
n <- readIORef r
use n
writeIORef r (n+1)
Unless you really need mutability for some other reason, I'd not recommend the second option.
Adapting the above idea to the concrete code:
saveThreadFunc :: Int -> TQueue String -> IO ()
saveThreadFunc lastBackupTime queue = do
newLine <- atomically $ readTQueue queue
now <- round `fmap` getPOSIXTime :: IO Int
writeFile "content.txt" newLine
let makeNewBackup = now >= lastBackupTime + 86400
if makeNewBackup then do
backupContent now newLine
saveThreadFunc now queue
else
saveThreadFunc lastBackupTime queue
The usual way to add state to a monad is using StateT from Control.Monad.Trans.State.Strict in the transformers package (part of the Haskell Platform). In this case, you would change the type of saveThreadFunc:
saveThreadFunc :: TQueue String -> StateT Int IO ()
You'd have to Control.Monad.Trans.lift the actual IO things to StateT Int IO, and then in the end evalStateT to turn the whole thing into IO a.
This approach is perhaps more modular than the the iterateM_ one Tom Ellis suggests (although that's something of a matter of taste), and will generally be optimized better than the IORef version chi suggests you avoid.
I'm having a little Haskell Situation over here. I'm trying to write two functions with monads.
First one is supposed to iterate through a function as long as the condition is true for the input / output of the function. Second one is supposed to use the first one to take a number as input and write it as output until you enter a space.
I'm stuck with this, any help?
module Test where
while :: (a -> Bool) -> (a -> IO a) -> a -> IO a
while praed funktion x = do
f <- praed (funktion x)
if f == True then do
y <- funktion x
while praed funktion y
else return x
power2 :: IO ()
power2 = do putStr (Please enter a number.")
i <- getChar
while praed funktion
where praed x = if x /= ' ' then False else True
funktion = i
import Control.Monad
while :: (a -> Bool) -> (a -> IO a) -> a -> IO a
while praed funktion x
| praed x = do
y <- funktion x
while praed funktion y
| otherwise = return x
power2 :: IO ()
power2 = do
putStr "Please enter a number."
i <- getChar
let praed x = x /= ' '
let f x = do
putChar x
getChar
while praed f '?'
return ()
Some notes:
Using if x then True else False is redundant, it's equivalent to just x.
Similarly if x == True ... is redundant and equivalent to if x ....
You need to distinguish between IO actions and their results. For example, if yo do
do
i <- getChar
...
then in ... i represents the result of the action, a character, so i :: Char. But getChar :: IO Char is the action itself. You can view it as a recipe that returns Char when performed. You can pass the recipe around to functions etc., and it is only performed when executed somewhere.
Your while called funktion twice, which probably isn't what you intend - it would read a character twice, check the first one and return the second one. Remember, your funktion is an action, so each time you "invoke" the action (for example by using <- funktion ... in the do notation), the action is run again. So it should rather be something like
do
y <- funktion x
f <- praed y
-- ...
(My code is somewhat different, it checks the argument that is passed to it.)
For a pure version:
{-# LANGUAGE BangPatterns #-}
while :: (a -> Bool) -> (a -> a) -> a -> a
while p f = go where go !x = if p x then go (f x) else x
test1 :: Int
test1 = while (< 1000) (* 2) 2
-- test1 => 1024
for monadic:
import Control.Monad
whileM :: (Monad m, MonadPlus f) => (a -> m Bool) -> m a -> m (f a)
whileM p f = go where
go = do
x <- f
r <- p x
if r then (return x `mplus`) `liftM` go else return mzero
test2 :: IO [String]
test2 = whileM (return . (/= "quit")) getLine
-- *Main> test2
-- quit
-- []
-- *Main> test2
-- 1
-- 2
-- 3
-- quit
-- ["1","2","3"]
power2 :: IO (Maybe Char)
power2 = whileM (return . (/= 'q')) getChar
-- *Main> power2
-- q
-- Nothing
-- *Main> power2
-- 1
-- 2
-- 3
-- q
-- Just '\n'
see also:
http://hackage.haskell.org/package/monad-loops, http://hackage.haskell.org/package/loop-while, http://hackage.haskell.org/package/control-monad-loop.
http://www.haskellforall.com/2012/01/haskell-for-c-programmers-for-loops.html