Haskell for Perl Programmers

Licence

CC0
To the extent possible under law, Shlomi Fish has waived all copyright and related or neighbouring rights to Haskell for Perl Programmers. This work is published from: Israel.


1. Introduction


2. Basic Examples


2.1. Recursion

Length

--  Type declaration : 
--      [a] - a linked list of any type
--      x -> y - function that accepts x and returns y
mylen :: [a] -> Integer
-- Declare the length of the empty list to be 0
mylen [] = 0
-- x:xs == the list whose first item (the head) is x and the rest (the tail)
-- is xs.
mylen (x:xs) = 1 + (mylen xs)

Fibonacci (Braindead)

fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
fib a = (fib (a-1)) + (fib (a-2))

Fibonacci (Less Braindead)

-- (a,b) is a tuple whose first element is a and its second is b
fibo_helper :: Integer -> (Integer,Integer)

fibo_helper 0 = (0,1)
-- Notice the use of the closure (where) to assign two temporary values
fibo_helper n = (b,a+b) where
    (a,b) = fibo_helper (n-1)

-- (fst (a,b)) = a
fibo n = (fst (fibo_helper n))

2.2. Lists

Reversing a List

myreverse :: [a] -> [a]

myreverse mylist = helper mylist [] where
    helper :: [a] -> [a] -> [a]
    -- A stopping condition
    helper [] as = as
    -- Recurse
    helper (b:bs) as = helper bs (b:as)

Run-Length Encoding

rle :: Eq a => [a] -> [(a,Integer)]

rle [] = []
rle (a:[]) = [(a,1)]
rle (x:xs) = (if (x == a)
              then (a,count+1):as
              else (x,1):(a,count):as
             ) where
        ((a,count):as) = (rle xs)

Quick-Sort

qsort []     = []
-- ++ is list concatenation
qsort (x:xs) = qsort elts_lt_x ++ [x] ++ qsort elts_greq_x
                 where
                   -- Choose the elements out of xs that are lesser than x
                   elts_lt_x   = [y | y <- xs, y < x]
                   elts_greq_x = [y | y <- xs, y >= x]

3. Infinite Lists


3.1. Fibonacci with Lists

fibs = [0,1] ++ [a+b | (a,b) <- zip fibs (tail fibs) ]

-- zip is defined as:
-- zip (x:xs) (y:xs) = (x,y) : zip xs ys
-- zip xs ys = []

3.2. Primes (with low efficiency)

primes = sieve [2..] where
    sieve (x:xs) = x:(sieve [a | a <- xs, a `mod` x /= 0 ])

3.3. Primes (with better efficiency)

primes = sieve [2..] where
    sieve (p:xs) =
        p : (sieve (remove p xs)) where
            remove what (a:as)  | a < what = a:(remove what as)
                                | a == what = (remove (what+p) as)
                                | a > what = a:(remove (what+p) as)

4. List and String Manipulation Routines

Function NameDescription
headThe first element in the list
tailThe list containing the second to the other elements
lengthThe length of the list.
reverseA list whose elements are reversed.
take num_elems listExtracts a list with the first num_elems from list.
drop num_elems listExtracts the list starting with the num_elems+1's element.
filter callback listExtracts the list of elements that match a certain callback. A kin to grep in Perl.
map callback listtransforms each element in the list according to the callback
a ++ bConcatenates the lists a and b

4.1. Examples

Greatest Common Prefix of a List of Strings

prefix_2 :: Eq a => [a] -> [a] -> [a]

prefix_2 xs [] = []
prefix_2 [] xs = []
prefix_2 (a:as) (b:bs) = if a == b
                         then a:(prefix_2 as bs)
                         else []

-- Can also be expressed as:
prefix_2_other xs ys = map fst . takeWhile (uncurry (==)) $ (zip xs ys)

gc_prefix :: Eq a => [[a]] -> [a]

gc_prefix [] = []
gc_prefix (a:as) = foldl prefix_2 a as

Split

import List

mysplit :: Eq a => [a] -> [a] -> [[a]]

mysplit separator base = helper base where
    len = (length separator)
    helper [] = [[]]
    helper base =
        (if (isPrefixOf separator base)
         then []:(helper (drop len base))
         else let ret = (helper (tail base))
              in (head(base):head(ret)) : tail(ret)
        )

4.2. Multi-map Function

orig = [1 .. 10]
one = [ i*2 | i <- orig ]
two = [ i*3+1 | i <- orig ]
three = orig
four = [ 100-i | i <- orig ]

lists = [one,two,three,four]

transpose_list ([]:as) = []
transpose_list as =
    [ head(i) | i <- as] :
        transpose_list ([ tail (i) | i <- as])

multimap func list_of_lists = (map func (transpose_list list_of_lists))

result = multimap sum lists


5. Arrays


5.1. Histogram

hist            :: (Ix a, Integral b) => (a,a) -> [a] -> Array a b
hist bnds is    =  accumArray (+) 0 bnds [(i, 1) | i <- is, inRange bnds i]

5.2. Hash

module Hash where

import Array

data Hash hash_function compare_function size table num_elems =
    MyHash hash_function compare_function size table num_elems

get_hash_function (MyHash hash_function compare_function size table num_elems) = hash_function

get_compare_function (MyHash hash_function compare_function size table num_elems) = compare_function

get_size (MyHash hash_function compare_function size table num_elems) = size

get_table (MyHash hash_function compare_function size table num_elems) = table

get_num_elems (MyHash hash_function compare_function size table num_elems) = num_elems

type IntHash = Hash (Int -> Int) (Int -> Int -> Int) Int (Array Int [(Int,Int)]) Int

type StringHash = Hash (String -> Int) (String -> String -> Int) Int (Array Int [(Int,String)]) Int

type StringToString = (String,String)

type StringToStringHash = Hash (StringToString -> Int) (StringToString -> StringToString -> Int) Int (Array Int [(Int,StringToString)]) Int

exists (MyHash hash_function compare_function size table num_elems) myelem =
    ((length
    (filter
        cmp_element
        (table!index)
    )) > 0) where
        hash_value = (hash_function myelem)
        index = (hash_value `mod` size)
        cmp_element x = (
                (hash_value == (fst x)) &&
                ((compare_function myelem (snd x)) == 0)
            )


insert (MyHash hash_function compare_function size table num_elems) myelem =
    (if (exists (MyHash hash_function compare_function size table num_elems) myelem)
    then (MyHash hash_function compare_function size table num_elems)
    else
    (MyHash
        hash_function
        compare_function
        size
        (table // [(index , new_list)])
        (num_elems+1)
    )) where
        hash_value = (hash_function myelem)
        index = (hash_value `mod` size)
        new_list = (hash_value,myelem):(table!index)

remove (MyHash hash_function compare_function size table num_elems) myelem =
    (MyHash
        hash_function
        compare_function
        size
        (table // [(index, new_list)])
        (if orig_len == length(new_list)
         then num_elems
         else (num_elems-1)
        )
    ) where
        hash_value = (hash_function myelem)
        index = (hash_value `mod` size)
        orig_len = length(table!index)
        cmp_element x = (
                (hash_value == (fst x)) &&
                ((compare_function myelem (snd x)) == 0)
            )
        new_list =
            (filter
                (\x -> (not(cmp_element x)))
                (table!index)
            )

get_value (MyHash hash_function compare_function size table num_elems) myelem =
    item_list where
        hash_value = (hash_function myelem)
        index = (hash_value `mod` size)
        cmp_element x = (
                (hash_value == (fst x)) &&
                ((compare_function myelem (snd x)) == 0)
            )
        item_list =
            [ snd(i) | i <- (filter cmp_element (table!index) ) ]

replace_or_add (MyHash hash_function compare_function size table num_elems) myelem =
    (MyHash
        hash_function
        compare_function
        size
        (table // [(index, new_list)])
        (if orig_len == length(new_list)
         then num_elems
         else (num_elems-1)
        )
    ) where
        hash_value = (hash_function myelem)
        index = (hash_value `mod` size)
        orig_len = length(table!index)
        cmp_element x = (
                (hash_value == (fst x)) &&
                ((compare_function myelem (snd x)) == 0)
            )
        new_list = (myreplace (table!index)) where
            myreplace :: [(Int,StringToString)] -> [(Int,StringToString)]
            myreplace [] = [(hash_value,myelem)]
            myreplace (a:as) =
                (if (cmp_element a)
                 then ((hash_value,myelem):as)
                 else (a:myreplace(as)))

get_all_values (MyHash hash_function compare_function size table num_elems) =
    [ snd(a) | i <- [ 0 .. (size-1) ] , a <- table!i ]

rehash (MyHash hash_function compare_function size table num_elems) new_size =
    (MyHash
        hash_function
        compare_function
        new_size
        new_table
        num_elems
    ) where
        new_table = (accumArray
            (\present -> \new_elem -> (new_elem:present))
            ]
            (0,(new_size-1))
            [   (hash_value `mod` new_size, (hash_value,elem)) |
                i <- [ 0 .. (size-1) ],
                (hash_value,elem) <- table!i
            ]
        )