Haskell:：针对循环中循环的递归中的递归

过程：基于元组集（id，x，y），找到x和y的最小-最大值，然后创建两个点（红点）。元组中的每个元素根据到红点的距离分为两组

getDistance :: (Int, Double, Double) -> (Int, Double, Double) -> Double
getDistance (_,x1,y1) (_,x2,y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
getTheClusterID :: (Int, Double, Double) -> Int
getTheClusterID  (id, _, _) = id

idxy = [(id, x, y)]
createCluster id cs = [(id, minX, minY),(id+1, maxX, minY), (id+2, minX, maxY), (id+3, maxX, maxY)]
                        where minX = minimum $ map (\(_,x,_,_) -> x) cs
                              maxX = maximum $ map (\(_,x,_,_) -> x) cs
                              minY = minimum $ map (\(_,_,y,_) -> y) cs
                              maxY = maximum $ map (\(_,_,y,_) -> y) cs
idCluster = [1]
cluster = createCluster (last idCluster) idxy

clusterThis (id,a,b) = case (a,b) of
  j | getDistance (a,b) (cluster!!0) < getDistance (a,b) (cluster!!1) &&
        -> (getTheClusterID (cluster!!0), a, b) 
  j | getDistance (a,b) (cluster!!1) < getDistance (a,b) (cluster!!0) &&
        -> (getTheClusterID (cluster!!1), a, b)
  _ -> (getTheClusterID (cluster!!0), a, b)

groupAll = map clusterThis idxy

每组不得超过5个点。如果超过，则应计算新组。我已经在第一阶段完成了递归。但我不知道第二阶段怎么做。第二阶段应如下所示：

基于这两组，它需要再次找到x和y的最小最大值（每组），然后创建四个点（红色点）。元组中的每个元素根据到红点的距离分为两组

getDistance :: (Int, Double, Double) -> (Int, Double, Double) -> Double
getDistance (_,x1,y1) (_,x2,y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
getTheClusterID :: (Int, Double, Double) -> Int
getTheClusterID  (id, _, _) = id

idxy = [(id, x, y)]
createCluster id cs = [(id, minX, minY),(id+1, maxX, minY), (id+2, minX, maxY), (id+3, maxX, maxY)]
                        where minX = minimum $ map (\(_,x,_,_) -> x) cs
                              maxX = maximum $ map (\(_,x,_,_) -> x) cs
                              minY = minimum $ map (\(_,_,y,_) -> y) cs
                              maxY = maximum $ map (\(_,_,y,_) -> y) cs
idCluster = [1]
cluster = createCluster (last idCluster) idxy

clusterThis (id,a,b) = case (a,b) of
  j | getDistance (a,b) (cluster!!0) < getDistance (a,b) (cluster!!1) &&
        -> (getTheClusterID (cluster!!0), a, b) 
  j | getDistance (a,b) (cluster!!1) < getDistance (a,b) (cluster!!0) &&
        -> (getTheClusterID (cluster!!1), a, b)
  _ -> (getTheClusterID (cluster!!0), a, b)

groupAll = map clusterThis idxy

getDistance:：（Int，Double，Double）->（Int，Double，Double）->Double
getDistance（x1，y1）（_x2，y2）=sqrt$（x1-x2）^2+（y1-y2）^2
getTheClusterID:：（Int，Double，Double）->Int
getTheClusterID（id，，=id）
idxy=[（id，x，y）]
createCluster id cs=[（id，minX，minY），（id+1，maxX，minY），（id+2，minX，maxY），（id+3，maxX，maxY）]
其中minX=最小$map（\（\，x，\，\）->x）cs
maxX=最大$map（\（\ux，\ux，\ux）->x）cs
minY=最小$map（\（\，y，\）->y）cs
maxY=最大$map（\（\，y，\）->y）cs
idCluster=[1]
cluster=createCluster（最后一个idCluster）idxy
clusterThis（id，a，b）=的情况（a，b）
j | getDistance（a，b）（cluster！！0）（获取群集ID（群集！！0），a，b）
j | getDistance（a，b）（cluster！！1）（获取群集ID（群集！！1），a，b）
_->（getTheClusterID（cluster！！0），a，b）
groupAll=map clusterThis idxy

我正在从命令式转变为功能性。对不起，如果我的思维方式仍然是强制性的。还在学习

编辑： 澄清一下，这是原始数据的样子

---

编写这种算法的基本原则是编写小型的合成程序；每个程序都很容易独立地进行推理和测试，最终的程序可以用较小的程序编写

该算法可概括如下：

计算约束点集的点

将其余点拆分为两个簇，一个簇包含更接近最小点的点，另一个簇包含所有其他点（相当于，更接近最大点的点）

如果任何群集包含超过5个点，请在该群集上重复此过程

“重复流程”步骤的存在表明这是一个问题

我认为每个点都不需要ID，所以我省去了这个

首先，为要使用的每种数据类型定义数据类型：

import Data.List (partition)

data Point = Point { ptX :: Double, ptY :: Double }
data Cluster = Cluster { clusterPts :: [Point] }

对于这样简单的数据，这可能看起来很愚蠢，但它可能会在调试期间为您节省大量的混乱。还要注意我们稍后将使用的函数的导入

第一步：

minMaxPoints :: [Point] -> (Point, Point)
minMaxPoints ps = 
   (Point minX minY
   ,Point maxX maxY)
     where minX = minimum $ map ptX ps
           maxX = maximum $ map ptX ps
           minY = minimum $ map ptY ps
           maxY = maximum $ map ptY ps

这与

createCluster

函数基本相同

第二步：

pointDistance :: Point -> Point -> Double
pointDistance (Point x1 y1) (Point x2 y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2

cluster1 :: [Point] -> [Cluster]
cluster1 ps =
  let (mn, mx) = minMaxPoints ps
      (psmn, psmx) = partition (\p -> pointDistance mn p < pointDistance mx p) ps
  in [ Cluster psmn, Cluster psmx ]

这也非常直接地实现了上面的语句。也许唯一让人困惑的部分是

>=

，它（这里）的类型是

[a]->（a->[b]）->[b]

；它只是将给定的函数应用于给定列表的每个元素，并连接结果（等价地，它被写入

flip-concatMap

）

最后是您的测试用例（我希望我已正确地将其从图片转换为Haskell数据）：

运行此程序会产生

[(0.0,0.0),(0.0,2.0),(2.0,1.0),(1.0,0.0)]
[(4.0,4.0),(5.0,2.0),(5.0,4.0),(4.0,3.0)]
[(10.0,2.0),(9.0,3.0),(8.0,2.0)]
[(13.0,3.0),(12.0,3.0),(11.0,4.0),(13.0,5.0)]

---

函数式程序员喜欢递归，但他们会竭尽全力避免编写它。天哪，各位，拿定主意

我喜欢尽可能地使用常见的、易于理解的组合词来构造代码。我想演示一种Haskell编程风格，它严重依赖于标准工具，以尽可能简洁和通用的方式实现程序中枯燥的部分（映射、压缩、循环），从而使您能够专注于手头的问题

所以，如果你不了解这里的一切，不要担心。我只是想告诉你什么是可能的！（如果有问题，请提问！）

载体 第一件事：我们正在处理二维空间，所以我们需要二维向量和一些中学向量代数来处理它们

我要用构建向量空间的标量来参数化向量。这将允许我使用标准类型类，如

Functor

，因此我可以将构建向量代数的大量工作委托给机器。我打开了

DeriveFunctor

和

DeriveFoldable

，这让我能够说出神奇的单词

派生（Functor，Foldable）

此后，我将避免显式使用

对

，并将程序编程到接口，而不是实现。这将允许我以一种独立于向量空间维度的方式构建一个简单的线性代数库。我将以

V2

为例给出类型签名：

type V2 = Pair Double

标量乘法：函子 A需要有两个运算：标量乘法和向量加法。标量乘法意味着将向量的每个分量乘以一个常量标量。如果将向量视为组件的容器，那么应该很清楚，这意味着“对容器中的每个元素执行相同的操作”——也就是说，这是一个映射操作。这就是为什么

矢量加法：zippy应用程序 矢量加法涉及按点将矢量的分量相加。将向量视为组件的容器，加法是一种压缩操作——将两个向量中的每个元素匹配起来并相加

是具有附加“应用”操作的函子。将函子

f

看作一个容器，

Appli
data Pair a = Pair {
    px :: a,
    py :: a
} deriving (Show, Functor, Foldable)

type V2 = Pair Double

-- mul :: Double -> V2 -> V2
mul :: (Functor f, Num n) => n -> f n -> f n
mul k f = fmap (k *) f

instance Applicative Pair where
    pure x = Pair x x
    Pair f g <*> Pair x y = Pair (f x) (g y)

-- add :: V2 -> V2 -> V2
add :: (Applicative f, Num n) => f n -> f n -> f n
add = liftA2 (+)

-- minus :: V2 -> V2 -> V2
minus :: (Applicative f, Num n) => f n -> f n -> f n
v `minus` u = v `add` mul (-1) u

-- dot :: V2 -> V2 -> Double
dot :: (Applicative f, Foldable f, Num n) => f n -> f n -> n
v `dot` u = sum $ liftA2 (*) v u

-- modulus :: V2 -> Double
modulus :: (Applicative f, Foldable f, Floating n) => f n -> n
modulus v = sqrt $ v `dot` v

dist :: (Applicative f, Foldable f, Floating n) => f n -> f n -> n
dist v u = modulus (v `minus` u)

-- boundingBox :: [V2] -> Pair V2
boundingBox :: (Traversable t, Applicative f, Ord n) => t (f n) -> Pair (f n)
boundingBox vs =
    let components = sequenceA vs
    in Pair (minimum <$> components) (maximum <$> components)

type Cluster = []
-- cluster :: Cluster V2 -> [Cluster V2]
cluster :: (Applicative f, Foldable f, Ord n, Floating n) => Cluster (f n) -> [Cluster (f n)]
cluster vs =
    let Pair bottomLeft topRight = boundingBox vs
        whichCluster v = dist v bottomLeft <= dist v topRight
        (g1, g2) = partition whichCluster vs
    in [g1, g2]

-- smallClusters :: Int -> Cluster V2 -> [Cluster V2]
smallClusters :: (Applicative f, Foldable f, Ord n, Floating n) => Int -> Cluster (f n) -> [Cluster (f n)]
smallClusters maxSize vs = fst $ until (null . snd) splitLarge ([], [vs])
    where
        smallEnough xs = length xs <= maxSize
        splitLarge (small, remaining) =
            let (newSmall, large) = partition smallEnough remaining
            in (small ++ newSmall, large >>= cluster)

testPts :: [V2]
testPts = map (uncurry Pair)
    [ (0,0), (1,0), (2,1), (0,2)
    , (5,2), (5,4), (4,3), (4,4)
    , (8,2), (9,3), (10,2)
    , (11,4), (12,3), (13,3), (13,5) ]

ghci> smallClusters 5 testPts
[
    [Pair {px = 0.0, py = 0.0},Pair {px = 1.0, py = 0.0},Pair {px = 2.0, py = 1.0},Pair {px = 0.0, py = 2.0}],
    [Pair {px = 5.0, py = 2.0},Pair {px = 5.0, py = 4.0},Pair {px = 4.0, py = 3.0},Pair {px = 4.0, py = 4.0}],
    [Pair {px = 8.0, py = 2.0},Pair {px = 9.0, py = 3.0},Pair {px = 10.0, py = 2.0}]
    [Pair {px = 11.0, py = 4.0},Pair {px = 12.0, py = 3.0},Pair {px = 13.0, py = 3.0},Pair {px = 13.0, py = 5.0}]
    ]

data Labelled m f a = Labelled m (f a) deriving (Show, Functor, Foldable)

instance (Monoid m, Applicative f) => Applicative (Labelled m f) where
    pure = Labelled mempty . pure
    Labelled m ff <*> Labelled n fx = Labelled (m <> n) (ff <*> fx)

type LabelledV2 = Labelled (First Int) Pair Double

testPts :: [LabelledV2]
testPts = zipWith (Labelled . First . Just) [0..] $ map (uncurry Pair)
    [ (0,0), (1,0), (2,1), (0,2)
    , (5,2), (5,4), (4,3), (4,4)
    , (8,2), (9,3), (10,2)
    , (11,4), (12,3), (13,3), (13,5) ]

ghci> traverse (traverse (getFirst . lbl)) $ smallClusters 5 testPts
Just [[0,1,2,3],[4,5,6,7],[8,9,10],[11,12,13,14]]  -- try reordering testPts