Question

I’m learning to think and code in haskell.
The game of “smallest number wins”: n people take their bets on numbers between 1 and n, and the smallest number with only one bet wins.

I’m calculating all possible series of bets for n=10 and counting the winner numbers. Yes, this code does not do exactly that, but thats not my point here, but my code, which runs out of memory relatively fast.

(added comments – sorry!)

import Data.Array
import Data.List

f xs = flip map [1..10] $ flip (:) xs
p 1 = f []
p n =  concat $ map f $ p (n-1)
--the above, (p n) generates the list of all possible [a1, a2, ..., an] lists, where ai=1..10
--p 2 = [[1,1],[2,1],[3,1],[4,1],[5,1],...,[10,10]

--my first shot at the countidens function, the functionality stays the same with the other
--countidens2 xs = map (\x->(head x, length x)) $ group $ sort xs

countidens' xs = accumArray (+) 0 (1,10) $ zip xs $ repeat 1
countidens xs = filter ((/=) 0 . snd) $ zip [1..10] $ map ((countidens' xs)!) [1..10]
--counts the number of occurrences of each number (1..10) in a list
--countidens [1,1,1,2,2,3] = (1,3),(2,2),(3,1)]
--(the above, countidens2 is much easier to understand)

numlist n = map (flip (++) ([(0,0)])) $ map countidens $ p n
--maps countidens on the (p n) list, and attaches a dummy (0,0) to the end (this is needed later)

g (x, (y, z)) | (x==y) && (z==1)    = True
              | (x < y)             = True
              | (y==0)              = True
              | otherwise           = False
-- filter function for [(a, (a,a)] lists - (a1, (a1, a)) -> Bool

winners n = map fst $ map (head . filter g) $ map (zip [1..]) $ numlist n
-- extracts the number of the first element of (numlist n) that qualifies as g
--    for each element of g (note: these are results of the countidens function, since that was mapped)
-- the dummy (0,0) was needed so there's always one that does

winnernumsarr n = accumArray (+) 0 (1,10) $ flip zip (repeat 1) $ winners n
-- winners n produces a simple list of integers (1..10) that is 10^n long, this (winnernumsarr) accumulates the number of each integer, much like countidens did
-- (but does not produce a fancy output)

main = putStrLn $ show $ winnernumsarr 7 -- aiming for 10! even 8 runs out of memory on my machine

While I know this code does not do exactly what I’d like it to do, what’s more important is that this is not the first time I’ve run into “out of memory” issues with haskell, and with problems I know could be written in C++ with a tiny amount of memory used.

There must be a way – but how?

Answer 1

Two things are important here. Type signatures and unboxed arrays.

module Main (main) where

import Data.Array.Unboxed
import Data.List

f xs = flip map [1..10] $ flip (:) xs
p 1 = f []
p n =  concat $ map f $ p (n-1)

--my first shot at the countidens function, the functionality stays the same with the other
--countidens2 xs = map (\x->(head x, length x)) $ group $ sort xs

countidens' :: [Int] -> UArray Int Int
countidens' xs = accumArray (+) 0 (1,10) $ zip xs $ repeat 1

countidens xs = filter ((/=) 0 . snd) $ assocs (countidens' xs)

numlist n = map (flip (++) ([(0,0)])) $ map countidens $ p n

g (x, (y, z)) | (x==y) && (z==1)    = True
              | (x < y)             = True
              | (y==0)              = True
              | otherwise           = False

winners n = map fst $ map (head . filter g) $ map (zip [1..]) $ numlist n

winnernumsarr :: Int -> UArray Int Int
winnernumsarr n = accumArray (+) 0 (1,10) $ flip zip (repeat 1) $ winners n
main = putStrLn $ show $ winnernumsarr 7

runs in small space, although quite slow (takes about 50 seconds for 8, 4.9 seconds for 7).

When you’re using boxed arrays, the accumArray doesn’t write plain numbers to the array, but thunks. In winnernumsarr, the thunks become huge. That takes a lot of memory and requires a lot of stack space to evaluate at the end. Using unboxed arrays, the additions are performed as they come, not building huge thunks.

The type signatures are necessary to fix the type of array to be printed and to make all occurring number types Int for less allocation and higher speed.

A more idiomatic version, without changing the algorithm, is

module Main (main) where

import Data.Array.Unboxed
import Data.List

p :: Int -> [[Int]]
p 0 = [[]]
p n = [k:xs | xs <- p (n-1), k <- [1 .. 10]]

countidens' :: [Int] -> UArray Int Int
countidens' xs = accumArray (+) 0 (1,10) $ map (\k -> (k,1)) xs

countidens :: [Int] -> [(Int,Int)]
countidens = filter ((/=) 0 . snd) . assocs . countidens'

numlist n = map ((++[(0,0)]) . countidens) $ p n

g :: (Int,(Int,Int)) -> Bool
g (x, (y, z)) | (x==y) && (z==1)    = True
              | (x < y)             = True
              | (y==0)              = True
              | otherwise           = False

winners :: Int -> [Int]
winners n = map fst $ map (head . filter g) $ map (zip [1..]) $ numlist n

winnernumsarr :: Int -> UArray Int Int
winnernumsarr n = accumArray (+) 0 (1,10) $ map (\k -> (k,1)) $ winners n

main :: IO ()
main = print $ winnernumsarr 7

which is also faster. A bit of the speedup comes from the fact that GHC can optimise this form of the list generating function p better, the bulk comes from replacing zip xs (repeat 1) with map (\k -> (k,1)) xs. I must admit that I don’t understand why that makes such a big difference, but the zip has to match both lists with _ : _ while the map needs only match xs, which saves some work.