合格的Haskell列表理解的有效替代方法

Question

As an illustration of qualified list comprehensions in Haskell, the Learn You a Haskell tutorial provides an example of list comprehension that suggests a general approach to finding the right triangles with a given perimeter p , expressed as a tuple:

λ> let rightTriangles p = [ (a,b,c) | c <- [1..(quot p 2)], b <- [1..c], a <- [1..b], a^2 + b^2 == c^2, a + b + c == p] 

But this approach becomes very slow as p gets large.

Is there a generally faster yet idiomatic Haskell way to accomplish the same thing for large p ?

Answer 1

The comments make the good point that what you really need is a better algorithm.

But let's try something different, and see what optimizations we can make to the current code:

let rightTrianglesCubic p = [ (a,b,c) | c <- [1..quot p 2], b <- [1..c], a <- [1..b], a^2 + b^2 == c^2, a + b + c == p]

First, note how we're looping over all the values of [1..b] until we find one where a + b + c == p . But the only value where that holds is a = p - b - c , so we can skip the loop altogether, and make this into a quadratic algorithm:

let rightTrianglesQuadraticA p = [ (a,b,c) | c <- [1..quot p 2], b <- [1..c], let a = p - b - c, a^2 + b^2 == c^2]

There's a slight problem with this approach:

λ rightTrianglesCubic 120
[(30,40,50),(24,45,51),(20,48,52)]
λ rightTrianglesQuadraticA 120
[(40,30,50),(30,40,50),(45,24,51),(24,45,51),(48,20,52),(20,48,52),(0,60,60)]

We get some extra results! This is because we ignored the implicit conditions made by a <- [1..b] , namely 1 <= a and a <= b . So let's add those back in.

let rightTrianglesQuadraticB p = [ (a,b,c) | c <- [1..quot p 2], b <- [1..c], let a = p - b - c, a^2 + b^2 == c^2, 1 <= a, a <= b]

And now we get the right answer:

λ rightTrianglesQuadraticB 120
[(30,40,50),(24,45,51),(20,48,52)]

Since each value of b has a unique a , the conditions 1 <= a and a <= b can be phrased as conditions on b . 1 <= a is the same as 1 <= p - b - c or b <= p - c - 1 . a <= b is the same as p - b - c <= b or p - c <= 2*b or div (p - c + 1) 2 <= b .

This lets us shrink the bounds on the loop b <- [1..c] :

let rightTrianglesQuadraticC p = [ (a,b,c) | c <- [1..quot p 2], b <- [max 1 (div (p - c + 1) 2) .. min c (p - c - 1) ], let a = p - b - c, a^2 + b^2 == c^2]

We can even shrink the bounds on c <- [1..quot p 2] by noting that in order for a < b < c with a+b+c == p , we must have c > p/3 :

let rightTrianglesQuadraticD p = [ (a,b,c) | c <- [1 + quot p 3..quot p 2], b <- [max 1 (div (p - c + 1) 2) .. min c (p - c - 1) ], let a = p - b - c, a^2 + b^2 == c^2]

This is about as far as optimizing this particular code can go. For further performance improvement, we'll need to switch algorithms altogether.