A visualization proving that axis aligned rectangles are PAC learnable.

AxisAligned.hs

import Control.Monad
import Data.Array

-- A class for axis-aligned rectangles.
-- The rectangle is defined by the left and right most x
-- coordinates. And the left and rightmost y coordinates.

type Point = (Int, Int)

data Rectangle = Rectangle {
  x :: Point,
  y :: Point
} deriving (Show, Eq)

mkRectangle :: Int
            -> Int
            -> Int
            -> Int
            -> Rectangle
mkRectangle a b c d = Rectangle { x = (a, b), y = (c, d) }

type Canvas = Array (Int, Int) Char

mkCanvas :: Int -> Int -> Canvas
mkCanvas w h = listArray ((0, 0), (h - 1, w - 1)) (repeat '.')

toPoints :: Rectangle -> [Point]
toPoints r = top ++ bottom ++ left ++ right
  where top    = zip [(fst (y r))..(snd (y r))] 
                     (repeat (fst (x r)))
        bottom = zip [(fst (y r))..(snd (y r))]
                     (repeat (snd (x r)))
        left   = zip (repeat (fst (y r)))
                     [(fst (x r))..(snd (x r))]
        right  = zip (repeat (snd (y r)))
                     [(fst (x r))..(snd (x r))]

toFilledPoints :: Rectangle -> [Point]
toFilledPoints r = [(j, i) | i <- [(fst (x r))..(snd (x r))], j <- [(fst (y r))..(snd (y r))]]

height :: Rectangle -> Int
height r = snd (y r) - fst (y r)

width :: Rectangle -> Int
width r = snd (x r) - fst (x r)

area :: Rectangle -> Int
area r = (height r) * (width r)

-- 
overlap :: Rectangle -> Rectangle -> Rectangle
overlap a b = mkRectangle (max (fst (x a)) (fst (x b))) (min (snd (x a)) (snd (x b)))
                          (max (fst (y a)) (fst (y b))) (min (snd (y a)) (snd (y b)))

-- L1 loss
loss :: Rectangle -> Rectangle -> Double
loss a b = (fromIntegral (area (overlap a b))) / (fromIntegral (max (area a) (area b)))


target :: Rectangle
target = mkRectangle 1 8 2 12


drawPoints :: Canvas -> [Point] -> Canvas
drawPoints c ps = (//) c  (zip ps (repeat '█'))

drawPoint :: Canvas -> Point -> Canvas
drawPoint c p = drawPoints c [p]

drawRectangle :: Canvas
              -> Rectangle
              -> Canvas
drawRectangle c r = drawPoints c (toPoints r)

drawFilledRectangle :: Canvas -> Rectangle -> Canvas
drawFilledRectangle c r = drawPoints c (toFilledPoints r)

showCanvas :: Canvas -> IO ()
showCanvas c = mapM_ putStrLn (chunksOf width (elems c))
  where width = snd (snd (bounds c)) + 1
        
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n
  
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

main = do
  let target = mkRectangle 10 38 12 22
  let tightest = mkRectangle 14 23 15 20
  let boundary = mkRectangle 0 79 0 49
  let c = (drawRectangle (mkCanvas 80 50) boundary)
  let withTightest = drawRectangle c tightest
  let withTarget = drawRectangle withTightest target
  showCanvas (drawFilledRectangle withTarget (overlap tightest target))
  print (loss tightest target)