Haskell :: Recursion in Recursion for Loops in Loops (Part 2)

Question

Haskell :: Recursion in Recursion for Loops in Loops (Part 2)

This question follows from the previous question and answer. You can find the link here: Haskell :: Recursion in recursion for loop in loop (part 1)

The question was answered, I can say super awesome with a good explanation for future reference. Get @ user2407038 for his amazing skills. However, something interesting to think about recursion with more than two sections. To be clear, I slightly modified the data for simplicity. Here's what it looks like:

Previously, two red dots were generated by finding (min x, min y) and (max x, max y). To generate 4 red dots (min x, min y) (max x, min y) (min x, max y) (max x, max y) partition4 should be taken into account. Visually, it looks like this:

, 3, 1 4 . . , :

:

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

main = do

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

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

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

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

    print main