Build cartesian tree in Haskell in 3 ways (O(N^2), O(N*LogN) and O(N))

cartesian_tree.hs

-- video https://youtu.be/E8Fxtpr24Zg
-- GHCi, version 8.8.4
{-# LANGUAGE RankNTypes    #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

import PrettyT -- https://www.youtube.com/watch?v=Ud-1Z0hBlB8&t=379s
-- data Btree a = Empty | Node a (Btree a) (Btree a) deriving Show
import Data.Ord
import Data.List
import Data.Maybe
import Data.Function
import Control.Monad 
import System.Random

-- Cartesian tree facts:
-- tree of pairs (X,Y)
-- binary search tree by X
-- heap by Y

-- build Cartesian tree
-- X is uniq
-- Y is uniq
-- x1 < x2 < x3 ... < xN
--d = [(1,2),(2,4),(3,5),(4,7),(5,6),(6,1)]
d = (zip [1..]) <$> (nub <$> (replicateM 300000 (randomRIO (1,1000000)) :: IO [Int]))
-- join $ printt <$> (build <$> d)
build :: (Ord a, Ord b) => [(a,b)] -> Btree (a,b)
-- O (N^2)
build [] = Empty
build d = Node maxy l r
    where        
      maxy = maximumBy (comparing snd) d  
      l = build dl
      r = build dr
      (dl,_:dr) = splitAt maxy_i d
      maxy_i = fromJust $ elemIndex maxy d


-- sort list by Y in desc - O (N*logN)
-- choose first element (with max Y) - this is a root
-- next pairs - element with greater X - go to right , lower X - go to left

--O(N*logN)
build2 :: (Ord a, Ord b) => [(a,b)] -> Btree (a,b)
build2 [] = Empty
build2 d = go Empty sd
    where 
      go t [] = t
      go t (maxy@(mx,my):d) = go (ins t) d
        where
          ins Empty = Node maxy Empty Empty
          ins (Node p@(x,y) l r) | mx>x = Node p l (ins r) 
                                 | mx<x = Node p (ins l) r
      sd = sortBy (flip $ comparing snd) d
       

--build cartesian tree in O(N) time
build3 :: forall a b.(Ord a, Ord b) => [(a,b)] -> Btree (a,b)
build3 d = go [] d [] where
  go :: (Ord a, Ord b) => [Btree (a,b)] -> [(a,b)] -> [Btree (a,b)] -> Btree (a,b)
  go ts [] _ = m ts
  go [] (p:ds) [] = go [Node p Empty Empty] ds []
  go [] (p:ds) bs = go [Node p (m $ reverse bs) Empty] ds []
  go trs@(t@(Node (lx,ly) _ _):ts) d@(p@(x,y):ds) bs
    | ly>y = go (n:trs) ds []
    | ly<y = go ts d (t:bs)
    where 
      n = Node p (m $ reverse bs) Empty
  
  m :: [Btree (a,b)] -> Btree (a,b)
  m [] = Empty 
  m ts = foldl1 (\r (Node e l _) -> Node e l r) ts


-- https://en.wikipedia.org/wiki/Cartesian_tree



mx = 10
d1 = (zip [1..mx]) <$> (nub <$> (replicateM mx (randomRIO (1,1000)) :: IO [Int]))
d2 = (zip [mx+1..]) <$> (nub <$> (replicateM mx (randomRIO (1,1000)) :: IO [Int]))

t1 = (build3 <$> d1)
t2 = (build3 <$> d2)
main = join $ printt <$> (build3 <$> d)

-- merge log N
-- ct1_x < ct2_x 

merge :: (Ord a, Ord b) => Btree (a,b) -> Btree (a,b) -> Btree (a,b)
merge Empty Empty = Empty
merge t1 Empty = t1
merge Empty t2 = t2
merge ct1@(Node (x1,y1) l1 r1) ct2@(Node (x2,y2) l2 r2) 
  | y2 > y1 = Node (x2,y2) c1_l c1_r
  | y1 > y2 = Node (x1,y1) c2_l c2_r
    where 
      c1_l = merge ct1 l2
      c1_r = r2  
      c2_l = l1
      c2_r = merge r1 ct2     

d_ = [(1,2),(2,4),(3,5),(5,8),(6,1),(7,7)]
-- split, log N
splt :: Ord a => Btree (a,b) -> a -> (Btree (a,b),Btree (a,b))
splt Empty _ = (Empty,Empty)
splt t@(Node (x,y) l r) sx 
  | x < sx = (Node (x,y) l lt_r, gt_r) 
  | x >= sx = (lt_l,Node (x,y) gt_l r)
    where
      (lt_r,gt_r)  = splt r sx
      (lt_l,gt_l) = splt l sx
      

spl = do 
        d <- d1
        printt $ build3 d
        let (t1,t2) = splt (build3 d) (mx `div` 2)
        print $ mx `div` 2
        printt t1
        printt t2

ins :: (Ord a, Ord b) => Btree (a,b) -> (a,b) -> Btree (a,b)
ins Empty p = Node p Empty Empty 
ins t@(Node (x,y) l r) p@(ix,iy) 
  | iy > y = Node (ix,iy) nl nr
  | iy < y = Node (x,y) nl2 nr2
  where 
    (nl,nr) = splt t ix
    nl2 = if ix<x then ins l p else l
    nr2 = if ix>x then ins r p else r


del :: (Ord a, Ord b) => Btree (a,b) -> (a,b) -> Btree (a,b)
del Empty _ = Empty
del (Node p@(x,y) l r) dp@(dx,dy) 
  | (x == dx) && (y==dy) = merge l r
  | x < dx = Node p l (del r dp)
  | x > dx = Node p (del l dp) r
  
main = join $ printt <$> (build3 <$> d)