Posts Tagged ‘algorithm’

Programming Praxis – Three Binary Algorithms

January 15, 2010

In today’s Programming Praxis we have to implement binary algorithms for multiplying, dividing, and finding the greatest common divisor of two numbers. Let’s get started.

Since all our functions require the Bits typeclass, for which Haskell doesn’t do type defaulting, we use the following language pragma so we don’t have to specify types in the tests.

{-# LANGUAGE ExtendedDefaultRules #-}

We need an import to do bitshifting.

import Data.Bits

And because we’re going to be doing quite a bit of it, two quick convenience convenience functions for doubling and halving numbers:

left, right :: Bits a => a -> a
left = flip shiftL 1
right = flip shiftR 1

Binary multiplication. Piece of cake.

binmult :: (Bits a, Integral a) => a -> a -> a
binmult 1 b = b
binmult a b = binmult (right a) (left b) + if odd a then b else 0

Binary division. By using the until function we don’t have use explicit recursion to find t.

bindiv :: (Bits a, Ord a) => a -> a -> (a, a)
bindiv n d = f (right $ until (> n) left d) 0 n where
    f t q r | t < d     = (q, r)
            | t <= r    = f (right t) (left q + 1) (r - t)
            | otherwise = f (right t) (left q)     r

Binary gcd. A lot of different conditions, but all very straightforward.

bingcd :: (Bits a, Integral a) => a -> a -> a
bingcd a 0 = a
bingcd 0 b = b
bingcd a b | even a && even b = 2 * bingcd (right a) (right b)
           | even a           = bingcd (right a) b
           | even b           = bingcd a (right b)
           | a > b            = bingcd (a - b) b
           | otherwise        = bingcd a (b - a)

A quick test shows that everything is working correctly:

main :: IO ()
main = do print $ binmult 14 12
          print $ bindiv 837 43
          print $ bingcd 2322 654

Programming Praxis – Two Sub-Quadratic Sorts

October 31, 2009

In yesterday’s Programming Praxis problem we have to implement two sort algorithms. Let’s get started.

First, some imports:

import Control.Monad
import Data.List
import Data.List.HT
import Data.Array.IO
import Data.Array.MArray

For the Comb sort algorithm, we’re going to need a function to swap two elements of an array.

swap :: (MArray a e m, Ix i, Ord e) => i -> i -> a i e -> m ()
swap i j a = do x <- readArray a i
                y <- readArray a j
                when (y < x) $ writeArray a i y >> writeArray a j x

The Comb sort algorithm itself:

combSort :: Ord a => [a] -> IO [a]
combSort [] = return []
combSort xs = comb (s-1) =<< newListArray (1, s) xs where
    comb :: Ord a => Int -> IOArray Int a -> IO [a]
    comb 0 a = getElems a
    comb n a = mapM_ (\i -> swap i (i+n) a) [1..s-n] >> comb (n-1) a
    s = length xs

We don’t need array access for the Shell sort algorithm, so that saves some code. It’s in the IO monad so we can use the same test function, but the algorithm itself is pure.

shellSort :: Ord a => [a] -> IO [a]
shellSort [] = return []
shellSort xs = return $ shell (last . takeWhile (< length xs) $
                               iterate (succ . (*3)) 1) xs where
    shell 1 = foldr insert []
    shell n = shell (div (n-1) 3) . concatMap (shell 1) . sliceHorizontal n

A little test harness to see of everything’s working:

test :: ([Int] -> IO [Int]) -> IO ()
test f = do print . null =<< f []
            print . (== [1..9]) =<< f [4,7,3,9,1,5,2,6,8]

main :: IO ()
main = do test combSort
          test shellSort

Looks like it is.