algorithm - Haskell求两个最近点之间的距离

Question

给定一个二维空间中的点列表，您想在其中执行一个函数Haskell 求两个最近点之间的距离。例子:输入:项目 [(1,5), (3,4), (2,8), (-1,2), (-8.6), (7.0), (1.5), (5.5), (4.8), (7.4)]输出:2.0

假设列表中最远的两个点之间的距离最多为10000。

这是我的代码:

import Data.List
import System.Random

sort_ :: Ord a => [a] -> [a]
sort_ []    =  []
sort_ [x]  =  [x]
sort_ xs   =  merge (sort_ left) (sort_ right)
  where
    (left, right) = splitAt (length xs `div` 2) xs
    merge [] xs = xs
    merge xs [] = xs
    merge (x:xs) (y:ys)=
    if x <= y then 
        x : merge xs (y:ys)
    else  y : merge (x:xs) ys     

project :: [(Float,Float)] -> Float
project [] = 0
project (x:xs)=
    if null (xs) then 
        error "The list have only 1 point"
    else head(sort_(dstList(x:xs)))

distance :: (Float,Float)->(Float,Float) -> Float
distance (x1,y1) (x2,y2) = sqrt((x1 - x2)^2 + (y1 - y2)^2)


dstList :: [(Float,Float)] -> [Float]
dstList (x:xs)=
    if length xs == 1 then 
        (dstBetween x xs):[]
    else (dstBetween x xs):(dstList xs)


dstBetween :: (Float,Float) -> [(Float,Float)] -> Float
dstBetween pnt (x:xs)=
    if null (xs) then 
        distance pnt x
    else  minimum ((distance pnt ):((dstBetween pnt xs)):[])

{-
Calling generator to create a file created at random points
-}
generator = do
    putStrLn "Enter File Name"
    file <- getLine
    g <- newStdGen
    let pts = take 1000 . unfoldr (Just . (\([a,b],c)->((a,b),c)) . splitAt 2) 
                $ randomRs(-1,1) g :: [(Float,Float)]
    writeFile file . show $ pts

{-
Call the main to read a file and pass it to the function of project
The function of the project should keep the name 'project' as described 
in the statement
-}
main= do
    putStrLn "Enter filename to read"
    name <- getLine
    file <- readFile name
    putStrLn . show . project $ readA file

readA::String->[(Float,Float)]
readA = read

我可以像示例中那样运行程序或使用生成器，如下所示:

在 haskell 解释器中必须输入“generator”，程序会在这里询问一个包含一千个点的文件名。在 Haskell 解释器中生成文件后，必须编写 main，并请求一个文件名，这是您使用“generator”创建的文件的名称。

问题是，对于随机生成的 1000 个点，我的程序需要很长时间，在具有双核处理器的计算机上大约需要 3 分钟。我究竟做错了什么？我如何优化我的代码以更快地工作？

Answer 1

您正在使用二次算法:

project []  = error "Empty list of points"
project [_] = error "Single point is given"
project ps  = go 10000 ps
  where
    go a [_]    = a
    go a (p:ps) = let a2 = min a $ minimum [distance p q | q<-ps]
                  in a2 `seq` go a2 ps

你应该使用更好的算法。 Search computational-geometry tag on SO为了更好的算法。

另见 http://en.wikipedia.org/wiki/Closest_pair_of_points_problem .

---

@maxtaldykin proposes对算法的一个很好、简单和有效的更改，它应该对随机数据产生真正的影响——按 X 坐标对点进行预排序，并且永远不要尝试距离当前点超过 d 个单位的点点，在 X 坐标中(其中 d 是当前已知的最小距离):

import Data.Ord (comparing)
import Data.List (sortBy)

project2 ps@(_:_:_) = go 10000 p1 t 
  where
    (p1:t) = sortBy (comparing fst) ps
    go d _         [] = d
    go d p1@(x1,_) t  = g2 d t
      where
        g2 d []          = go d (head t) (tail t)
        g2 d (p2@(x2,_):r)
           | x2-x1 >= d  = go d (head t) (tail t)
           | d2 >= d     = g2 d  r
           | otherwise   = g2 d2 r   -- change it "mid-flight"
               where
                 d2 = distance p1 p2

对于随机数据，g2 将在 O(1) 时间内运行，因此 go 将花费 O(n) 并且整个事情将受到排序的限制，~ n log n。

Empirical orders of growth显示 ~ n^2.1 用于第一个代码(在 1k/2k 范围内)和 ~n^1.1 用于第二个，在 10k/20k 范围内，快速测试'脏编译加载到 GHCi 中(第二个代码运行速度比第一个快 50 倍 2,000 点，80 倍快 3,000 点)。