Extension for "Pearls of Functional Algorithm Design" by Richard Bird,
2010, page 25 #Haskell
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
module SelectionProblem where
import Data.Array
import Data.List
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Question: is there a way to get the type signature as the following:
-- smallest :: (Ord a) => Int -> [Array Int a] -> a
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Works on 2 finite ordered disjoint sets represented as sorted arrays.
smallest :: (Ord a) => Int -> (Array Int a, Array Int a) -> a
smallest k (xa,ya) =
search k (xa,ya) (0,m+1) (0,n+1)
where
(0,m) = bounds xa
(0,n) = bounds ya
-- Removed some of the "indexitis" at the cost of calling another function.
search :: (Ord a) => Int -> (Array Int a, Array Int a) -> (Int,Int) ->
(Int,Int) -> a
search k (xa,ya) (lx,rx) (ly,ry)
| lx == rx = ya ! (k+ly)
| ly == ry = xa ! (k+lx)
| otherwise = case (xa ! mx < ya ! my) of
(True) -> smallest2h k (xa,ya) ((lx,mx,rx),(ly,my,ry))
(False) -> smallest2h k (ya,xa) ((ly,my,ry),(lx,mx,rx))
where
mx = (lx+rx) `div` 2
my = (ly+ry) `div` 2
-- Here the sorted arrays are in order by their middle elements.
-- Only cutting the leading or trailing array by half.
-- Here xa is the first array and ya the second array by their middle elements.
smallest2h :: (Ord a) => Int -> (Array Int a, Array Int a) ->
((Int,Int,Int),(Int,Int,Int)) -> a
smallest2h k (xa,ya) ((lx,mx,rx),(ly,my,ry)) =
case (k<=mx-lx+my-ly) of
(True) -> search k (xa,ya) (lx,rx) (ly,my)
(False) -> search (k-(mx-lx)-1) (xa,ya) (mx+1,rx) (ly,ry)
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Works on 3 finite ordered disjoint sets represented as sorted arrays.
smallest3 :: (Ord a) => Int -> (Array Int a, Array Int a, Array Int a) -> a
smallest3 k (xa,ya,za) =
-- On each recursive call the order of the arrays can switch.
search3 k (xa,ya,za) (0,bx+1) (0,by+1) (0,bz+1)
where
(0,bx) = bounds xa
(0,by) = bounds ya
(0,bz) = bounds za
-- Removed some of the "indexitis" at the cost of calling another function.
search3 :: (Ord a) => Int -> (Array Int a, Array Int a, Array Int a) ->
(Int,Int) -> (Int,Int) -> (Int,Int) -> a
search3 k (xa,ya,za) (lx,rx) (ly,ry) (lz,rz)
| lx == rx && ly == ry = za ! (k+lz)
| ly == ry && lz == rz = xa ! (k+lx)
| lx == rx && lz == rz = ya ! (k+ly)
| lx == rx = search k (ya,za) (ly,ry) (lz,rz)
| ly == ry = search k (xa,za) (lx,rx) (lz,rz)
| lz == rz = search k (xa,ya) (lx,rx) (ly,ry)
| otherwise = case (xa ! mx < ya ! my, xa ! mx < za ! mz, ya ! my
< za ! mz) of
(True, True, True) -> smallest3h k (xa,ya,za)
((lx,mx,rx),(ly,my,ry),(lz,mz,rz)) -- a