Some lazy code to D

bearophile bearophileHUGS at lycos.com
Wed Aug 29 04:56:12 PDT 2012


Caligo:

> Did you time the runs?

I didn't time them. My timings (compiling with GHC -O3) are 
similar to your ones.

If you want a better comparison, this Haskell code is closer to 
the D/Python versions (the run-time is similar, maybe it's a bit 
faster):


pick :: Int -> Int -> [String]
pick nbags nballs = bags nbags nbags nballs nballs
     where
         bag :: Int -> Int -> [String]
         bag b n
             | b == 0 && n == 0 = [""]
             | b <= 0 || n <= 0 || even n = []
             | otherwise = ["(" ++ replicate n1 '*' ++ chain ++ 
")" |
                            n1 <- [0 .. n],
                            chain <- bags (b - 1) (b - 1) (n - n1) 
(n - n1)]

         bags :: Int -> Int -> Int -> Int -> [String]
         bags b c n m
             | b == 0 && n == 0 = [""]
             | b <= 0 || n <= 0 || c <= 0 || m <= 0 = []
             | otherwise = [l ++ r |
                            n1 <- [1 .. m],
                            b1 <- if n1 == m then [1 .. c] else [1 
.. b],
                            l <- bag b1 n1,
                            r <- bags (b - b1) b1 (n - n1) n1]

main = do
     mapM_ putStrLn $ (pick 5 10)


> Lazy D version, compiled as -O -inline -release, and ran with 
> pick(6, 11):
>
> real    0m4.195s
...
> Haskell version, compiled as -O2, and ran with pick(6, 11):
>
> real    0m0.159s

I don't exactly know where the difference comes from, but the GHC 
Haskell compiler is able to digest (deforestation, etc) lazyness 
very well.

In the eager D version, if I introduce memoization:


import std.stdio, std.array, std.range, std.functional;

string[] pick(in int nbags, in int nballs) /*pure nothrow*/ {
     static struct Namespace {
         static string[] bag(in int b, in int n) /*pure nothrow*/ {
             if (b == 0 && n == 0)
                 return [""];
             if (b <= 0 || n <= 0 || n % 2 == 0)
                 return [];
             typeof(return) result;
             foreach (n1; 0 .. n + 1)
                 foreach (chain; mbags(b - 1, b - 1, n - n1, n - 
n1))
                     result ~= "(" ~ std.array.replicate("*", n1) 
~ chain ~ ")";
             return result;
         }

         static string[] bags(in int b, in int c, in int n, in int 
m) /*pure nothrow*/ {
             if (b == 0 && n == 0)
                 return [""];
             if (b <= 0 || n <= 0 || c <= 0 || m <= 0)
                 return [];
             typeof(return) result;
             foreach (n1; 1 .. m + 1)
                 // iota is not pure, nor nothrow
                 foreach (b1; (n1 == m) ? iota(1, c+1) : iota(1, b 
+ 1))
                     foreach (l; mbag(b1, n1))
                         foreach (r; mbags(b - b1, b1, n - n1, n1))
                             result ~= l ~ r;
             return result;
         }

         alias memoize!bags mbags;
         alias memoize!bag mbag;
     }

     return Namespace.mbags(nbags, nbags, nballs, nballs);
}

void main() {
     foreach (sol; pick(8, 13))
         writeln(sol);
}


It runs the (8, 13) case (40_489 solutions) in less than half 
second, about eleven times faster than the Haskell version.

I think the Haskell run-time is re-using some thunks of precedent 
lazy computations, so I think Haskell is doing a kind of 
automatic partial memoization.

Bye,
bearophile


More information about the Digitalmars-d mailing list