Haskell :: Recursion in recursion for loop in loop

Question

How this happens: based on the set of tuples (id, x, y) find min max for x and y, then create two points (red points). Each element in the cortega is grouped into two groups based on the distance to the red dots.

Each group cannot exceed 5 points. If exceeded, a new group should be calculated. I managed to do the recursion in the first stage. But I do not know how to do this in the second stage. The second phase should look like this:

Based on these two groups, again you need to find min max for x and y (for each group), then four points (red points) are created. Each element in the cortega is grouped into two groups based on the distance to the red dots.

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

. , . .

EDIT: , .

Answer 1

, ; , .

:

• , .
• , , , - ( , ).
• - 5 , .

" " , .

, .

, :

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 ]

- . partition , , , - , . pointDistance getDistance.

:

cluster :: [Point] -> [Cluster]
cluster ps =
  cluster1 ps >>= \cl@(Cluster c) ->
  if length c > 5
  then cluster c
  else [cl]

. , >>=, () [a] -> (a -> [b]) -> [b]; (, flip concatMap).

, (, , Haskell):

testPts :: [Point]
testPts = map (uncurry Point)
  [ (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) ]

main = mapM_ (print . map (\p -> (ptX p, ptY p)) . clusterPts) $ cluster testPts

[(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)]

Answer 2

, , . , , !

, , , . Haskell, (, zipping, looping) , .

, . , ! ( , !)

: , .

, . , Functor, . DeriveFunctor DeriveFoldable, deriving (Functor, Foldable).

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

Pair , . , . V2:

type V2 = Pair Double

:

A : . . , , " ", .. . , Functor .

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

: zippy

. , - - .

"". f , Applicative <*> :: f (a -> b) -> f a -> f b , . , Pair Applicative zip .

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

( zippy . .)

, , Applicative .

-- 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

:

- , a dot product. , , . , Applicative , : " "?

Foldable - , "" foldr :: (a -> b -> b) -> b -> f a -> b. sum foldr, :

-- 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)

N-ary zipping:

(-) . Pair, .

, , . . Traversable sequenceA.

-- 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)

, , : .

. , . , partition.

whichCluster, minus modulus, , partition, .

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]

, ,

cluster, , 5. . , , , , . partition , , , . monad >>= :: [a] -> (a -> [b]) -> [b] ( [Cluster V2] -> ([V2] -> [Cluster V2]) -> [Cluster V2]), , . until , .

-- 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)

, @user2407038 answer:

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}]
    ]

. n- , .

Applicative Foldable, V2 , , .

3- , Double Int , V2 . ? , - - - . Foldable Applicative, !

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)

Monoid , . First - - - , zipping, modulus boundingBox.

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