Table of Contents
Haskell Fibonacci Function
Haskell is an odd little language that is neither widely used, nor known about. It is a purely functional language (meaning that every single thing in the language, and I mean everything, can be expressed as a function). The only reason that I have written any Haskell programs is that functional programming is a requirement of getting a degree at the University of Glasgow, and Haskell happens to be the language that they use to teach it.
I have written only one program in Haskell that is anything more than a tiny program, but since there seems to be so little Haskell code on the net, I thought I should maybe put them up here anyway. Although I doubt Haskell's serious potential as a main stream language, I do think it's a very elegant one, and pretty good for coding up quick solutions to problems you can't be bothered doing by hand. For the moment I will keep them all on this page. If I think it's worthwhile, I may split them up into different pages later.
But for now, here's the Fibonacci function written in Haskell:
fib :: Int -> Int fib 1 = 1 fib 2 = 1 fib x = (fib (x - 1)) + (fib (x - 2))
If that seems rather simple compared to my other implementations on this site, then you are right. The difference being that this version will run very slowly, while the others will run relatively quickly. The nice thing about this one though, is that it took me about 30 seconds to write. The others all took between a day and a week. In saying that, most of the coding in my other programs is to deal with the representation of large numbers and has little to do with the Fibonacci stuff. The actual fast fib algorithm I use would probably look like this in Haskell:
helpfib :: Int -> Int -> Int -> Int -> Int helpfib w x y z = if (w == y) then y else (helpfib w (x + 1) (y + z) y) fib :: Int -> Int fib 1 = 1 fib 2 = 1 fib x = (helpfib x 1 1 0)
Although I doubt that will be of much use to anyone as it will most likely cause a stack overflow if you try to compute a fib index above 3 (which is kind of the reason the other ones have to be that long if they are also going to be quick).
Euclidean Algorithm
The Euclidean algorithm is for finding the lowest common denominator between numbers. Very clever stuff (not my program, the algorithm).
euclid :: Int -> Int -> Int euclid x y = if (y /= 0) then (euclid y (mod x y)) else x
FP2 Programming Assignment
This is my second year Functional Programming assessed exercise for which I gained full marks. It is a simple little program (though it may not look that way) for performing some set functions. This may actually be useful to you if you are weak on set theory, but I doubt it. There is example input at the bottom of the code.
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- --
-- FP 2 Assignment 2 --
-- Program Title : Set Representations with Lists and Binary Search Trees --
-- Version : 0.9 --
-- Author : nex --
-- Login : <removed> --
-- Group : <removed> --
-- Matriculation Number : <removed> --
-- Date Last Modified : 23rd April 2004 --
-- --
-- Description : This program contains Haskell functions for representing --
-- sets of Int as Lists and Binary Search Trees. It --
-- contains a number of functions for performing actions on --
-- sets in these representations. Input and Output is taken --
-- and given as standard strings. --
-- --
-- State of Program: The program has worked correctly for all correctly --
-- formed test data. --
-- --
-- --
-- Improvements: --
-- 1. Lists should be defaultly ordered when taken from String input --
-- according to definition. This is currently not the case, but I --
-- believe the program is more efficient this way. --
-- 2. BSTs are pretty unbalanced at the moment. This should technically --
-- be fixed, though it doesn't affect the 'workingness' of the --
-- program. --
-- --
-- --
-- This is my own work as defined in the Academic Ethics agreement I --
-- have signed. --
-- --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- Start of list functions --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- removedups [1,1,3,4] -- returns a list with no duplicates (i.e. [1,3,4] in
-- this example) when input is an ordered list.
removedups :: [Int] -> [Int]
removedups [] = []
removedups (x:xs)
| (x == (if xs /= [] then (head xs) else -1)) = (removedups xs)
| (x /= (if xs /= [] then (head xs) else -1)) = [x] ++ (removedups xs)
-- finddups [4,5,7,8,8] -- returns a list of the duplicates in a given list.
finddups :: [Int] -> [Int]
finddups [] = []
finddups (x:xs)
| (x /= (if xs /= [] then (head xs) else 0)) = (finddups xs)
| (x == (if xs /= [] then (head xs) else 0)) =
removedups ([x] ++ (finddups xs))
-- sort [1,5,2,7] -- returns the sorted list of Int of that entered.
sort :: [Int] -> [Int]
sort [] = []
sort (x:xs) = sort [y|y<-xs,y<x] ++ [x] ++ sort [y|y<-xs,y>=x]
-- lintersection [1,2,3] [3,4,5] -- returns the intersection of the two
-- 'sets' (i.e. 3 in this example).
lintersection :: [Int] -> [Int] -> [Int]
lintersection [] [] = []
lintersection [a] [] = []
lintersection [] [a] = []
lintersection (x:xs) (y:ys) = finddups (sort ((removedups (sort (x:xs))) ++
(removedups (sort (y:ys)))))
-- lunion [1,2,3] [5,3,4] -- returns the union of two 'sets' (i.e.
-- [1,2,3,4,5] in this example).
lunion :: [Int] -> [Int] -> [Int]
lunion [] [] = []
lunion [a] [] = [a]
lunion [] [a] = [a]
lunion xs ys = removedups (sort (xs ++ ys))
-- equalstep [2,4,6] [2,4,6] -- returns True if two 'sets' are equal,
-- assuming 'sets' are represented as ordered lists. Otherwise, returns False.
equalstep :: [Int] -> [Int] -> Bool
equalstep [] [] = True
equalstep [a] [] = False
equalstep [] [a] = False
equalstep (x:xs) (y:ys)
| (x == y) = equalstep xs ys
| otherwise = False
-- lequal [2,6,5,7] [2,5,6,7] -- returns True if two 'sets' are equal.
lequal :: [Int] -> [Int] -> Bool
lequal xs ys = equalstep (removedups (sort xs)) (removedups (sort ys))
-- cardinalitystep [2,4,6] -- returns the cardinality of the 'set' (i.e. 3 in
-- this example), assuming there are no duplicates in the set.
cardinalitystep :: [Int] -> Int
cardinalitystep [] = 0
cardinalitystep (x:xs) = 1 + (cardinalitystep xs)
-- lcardinality [1,5,4,7] -- returns the cardinality of the 'set' (i.e. 4 in
-- this example).
lcardinality :: [Int] -> Int
lcardinality [] = 0
lcardinality (x:xs) = cardinalitystep (removedups (sort (x:xs)))
-- lsuccessorstep 4 [3,6,7,4,8] -- returns the smallest number in a 'set'
-- greater than the given Integer value (i.e. 6 in this example) assuming that
-- there are no duplicates in the set.
lsuccessorstep :: Int -> [Int] -> Int
lsuccessorstep a [b] = a
lsuccessorstep a [] = a
lsuccessorstep a (x:xs)
| (a == (head (sort (x:xs)))) = head (sort xs)
| otherwise = lsuccessorstep a xs
-- lsuccessor 4 [3,6,7,4,8] -- returns the smallest number in a 'set' greater
-- than the given Integer value (i.e. 6 in this example).
lsuccessor :: Int -> [Int] -> Int
lsuccessor a [b] = a
lsuccessor a [] = a
lsuccessor a (x:xs) = lsuccessorstep a (removedups (sort (x:xs)))
-- lclosest 4 [3,6,7,4,8] -- returns the number closest to x ('4' in this
-- example) in the set from the numbers greater than and closest to x and less
-- than and closest to x. This function assumes that there is at least one
-- element greater than and one element less than x in the 'set'.
lclosest :: [Int] -> Int -> Int
lclosest [b] a = b
lclosest [] a = a
lclosest (x:xs) a
| if ( ( [x | x <- (x:xs), x < a] /= []) &&
( [x | x <- (x:xs), x > a] /= []) ) then
( (a - (last [x | x <- (sort (x:xs)), x < a])) <
((head [x | x <- (sort (x:xs)), x > a]) - a) ) else False
= (last [x | x <- (sort (x:xs)), x < a])
| if ( ( [x | x <- (x:xs), x < a] /= []) &&
( [x | x <- (x:xs), x > a] /= []) ) then
( (a - (last [x | x <- (sort (x:xs)), x < a])) ==
((head [x | x <- (sort (x:xs)), x > a]) - a) ) else False
= (last [x | x <- (sort (x:xs)), x < a])
| if ( ( [x | x <- (x:xs), x < a] /= []) &&
( [x | x <- (x:xs), x > a] /= []) ) then
( (a - (last [x | x <- (sort (x:xs)), x < a])) >
((head [x | x <- (sort (x:xs)), x > a]) - a) ) else False
= (head [x | x <- (sort (x:xs)), x > a])
| ( ([x | x <- (x:xs), x < a] /= []) &&
([x | x <- (x:xs), x > a] == []) )
= (last [x | x <- (sort (x:xs)), x < a])
| ( ([x | x <- (x:xs), x < a] == []) &&
([x | x <- (x:xs), x > a] /= []) )
= (head [x | x <- (sort (x:xs)), x > a])
| otherwise = x
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- end of list functions --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- Start of BST functions --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- Define type "Tree" to be used in BST functions
data Tree a = Nil | Node a (Tree a) (Tree a)
deriving (Eq,Ord,Show,Read)
-- insert x (Tree Int) -- returns a BST with 'x' inserted in an appropriate
-- position.
insert :: Int -> (Tree Int) -> (Tree Int)
insert x Nil = Node x Nil Nil
insert x (Node n t1 t2)
| (x == n) = Node n t1 t2
| (x < n) = Node n (insert x t1) t2
| (x > n) = Node n t1 (insert x t2)
-- bstunion (Node 1 Nil (Node 2 Nil (Node 3 Nil Nil))) (Node 5 (Node 3 Nil
-- (Node 4 Nil Nil)) Nil) -- returns the union of two 'sets' (i.e. 'Node 5
-- (Node 3 (Node 1 Nil (Node 2 Nil Nil)) (Node 4 Nil Nil)) Nil' in this
-- example).
bstunion :: (Tree Int) -> (Tree Int) -> (Tree Int)
bstunion Nil t1 = t1
bstunion t1 Nil = t1
bstunion (Node x t2 t3) t1 = bstunion t3 (bstunion t2 (insert x t1))
-- bstcardinality (Node 3 (Node 2 (Node 1 Nil Nil) Nil) (Node 6 (Node 4 Nil
-- Nil) (Node 8 (Node 7 Nil Nil) (Node 9 Nil Nil)))) -- returns the
-- cardinality of the 'set' (i.e. 8 in this example).
bstcardinality :: (Tree Int) -> Int
bstcardinality Nil = 0
bstcardinality (Node n t1 t2) = 1 + (bstcardinality t1) + (bstcardinality t2)
-- inbst x (Tree a) -- returns True if x is in a BST
inbst :: Int -> (Tree Int) -> Bool
inbst _ Nil = False
inbst x (Node y t1 t2)
| ( x == y ) = True
| otherwise = False || ((inbst x t1) || (inbst x t2))
-- bstintersection (Node 2 (Node 1 Nil Nil) (Node 3 Nil Nil)) (Node 4 (Node
-- 3 Nil Nil) (Node 5 Nil Nil)) -- returns the intersection of the two 'sets'
-- (i.e. 'Node 3 Nil Nil' in this example).
bstintersection :: (Tree Int) -> (Tree Int) -> (Tree Int)
bstintersection Nil Nil = Nil
bstintersection Nil t1 = Nil
bstintersection t1 Nil = Nil
bstintersection (Node x t1 t2) t3
| ((inbst x t3) == True) = insert x (bstunion (bstintersection t1 t3)
(bstintersection t2 t3))
| otherwise = bstunion (bstintersection t1 t3) (bstintersection t2 t3)
-- bstequal (Node 1 Nil (Node 2 Nil (Node 3 Nil Nil))) (Node 5 (Node 3 Nil
-- (Node 4 Nil Nil)) Nil) -- returns True if the two 'sets' are equal. (i.e.
-- in this case False).
bstequal :: (Tree Int) -> (Tree Int) -> Bool
bstequal Nil Nil = True
bstequal t1 Nil = False
bstequal Nil t1 = False
bstequal t1 t2
| ( (bstcardinality t1) == (bstcardinality (bstunion t1 t2)) ) = True
| otherwise = False
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- end of BST functions --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- main program --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- listfrombst (Node x t1 t2) -- returns a List of all 'x' values from a
-- binary search tree.
listfrombst :: (Tree Int) -> [Int]
listfrombst Nil = []
listfrombst (Node 0 Nil Nil) = [0]
listfrombst (Node x t1 t2) = sort (removedups ([x] ++ (listfrombst t1) ++
(listfrombst t2)))
-- bstfromlist [5,7,9] -- returns a BST from a List of Int.
bstfromlist :: [Int] -> (Tree Int)
bstfromlist [] = Nil
bstfromlist (x:xs) = insert x (bstfromlist xs)
-- removebrac "[3,45,6,7]" -- returns the input String with the Characters
-- '[' and ']' removed.
removebrac :: String -> String
removebrac [] = []
removebrac (x:xs)
| (x == '[') = removebrac xs
| (x == ']') = []
| otherwise = [x] ++ (removebrac xs)
-- putlist [4,45,3,2,789] -- returns a 'set' formatted String of a given
-- List (i.e. "{4,45,3,2,789}" in this example).
putlist :: [Int] -> String
putlist [] = "{}"
putlist (x:xs) = "{" ++ (removebrac (show (x:xs))) ++ "}"
-- skipword "skipthis rest of string" -- returns the input String with the
-- first encountered word removed (i.e. "rest of string" in this example).
skipword :: String -> String
skipword "" = []
skipword (x:xs)
| (x /= ' ') = [] ++ (skipword xs)
| otherwise = xs
-- getword "getthis rest of string" -- returns the first encountered word in
-- a given String (i.e. "getthis" in this example).
getword :: String -> String
getword "" = []
getword (x:xs)
| (x == ' ') = []
| otherwise = [x] ++ (getword xs)
-- numconstruct "3,4,67,7}" -- returns a String of the full (single or
-- multiple digit) number first encountered in a String (i.e. "3" in this
-- example).
numconstruct :: String -> String
numconstruct [] = []
numconstruct (x:xs)
| ((head xs) == '}') = [x]
| ((head xs) == ',') = [x]
| otherwise = [x] ++ (numconstruct xs)
-- remainconstruct "3,4,67,7}" -- returns a String of all the Characters in
-- the input String except the first full (single or multiple digit) number
-- encountered (i.e. ",4,67,7}" in this example).
remainconstruct :: String -> String
remainconstruct [] = []
remainconstruct (x:xs)
| (x /= '}' && x /= ',') = remainconstruct xs
| otherwise = (x:xs)
-- getlist "{3,45,6,7,322}" -- returns a List of Int from a correctly
-- formatted String in standard 'set' notation (i.e. [3,45,6,7,322] in this
-- example).
getlist :: String -> [Int]
getlist [] = []
getlist (x:xs)
| (x == '{') = getlist xs
| (x == '}') = []
| (x == ',') = getlist xs
| otherwise = if (head xs) /= ',' && (head xs) /= '}' then [read (numconstruct
(x:xs))] ++ (getlist (remainconstruct xs)) else [read [x]] ++ (getlist xs)
-- bstfunc "BST equal {3,4,5} {5,3,4}" -- parses out the requested function
-- from the String then calls the approproate 'BST' function with the
-- appropriate paramemters. The returned value is then appropriately formatted
-- as output.
bstfunc :: String -> String
bstfunc (x:xs)
| ((getword(skipword (x:xs))) == "union") = putlist (listfrombst (bstunion
(bstfromlist (getlist (getword (skipword (skipword (x:xs)))))) (bstfromlist
(getlist (getword (skipword (skipword (skipword (x:xs)))))))))
| ((getword(skipword (x:xs))) == "intersection") = putlist (listfrombst
(bstintersection (bstfromlist (getlist (getword (skipword
(skipword (x:xs)))))) (bstfromlist (getlist (getword (skipword (skipword
(skipword (x:xs)))))))))
| ((getword(skipword (x:xs))) == "equal") = show (bstequal (bstfromlist (sort
(getlist (getword (skipword (skipword (x:xs))))))) (bstfromlist (sort
(getlist (getword (skipword (skipword (skipword (x:xs)))))))))
| ((getword(skipword (x:xs))) == "cardinality") = show (bstcardinality
(bstfromlist (getlist (getword (skipword (skipword (x:xs)))))))
| otherwise = "Error in input : Please check command"
-- listfunc "List equal {3,4,5} {5,3,4}" -- parses out the requested function
-- from the String then calls the approproate 'List' function with the
-- appropriate paramemters. The returned value is then appropriately formatted
-- as output.
listfunc :: String -> String
listfunc (x:xs)
| ((getword(skipword (x:xs))) == "union") = putlist (lunion (getlist (getword
(skipword (skipword (x:xs))))) (getlist (getword (skipword (skipword
(skipword (x:xs)))))))
| ((getword(skipword (x:xs))) == "intersection") = putlist (lintersection
(getlist (getword (skipword (skipword (x:xs))))) (getlist (getword (skipword
(skipword (skipword (x:xs)))))))
| ((getword(skipword (x:xs))) == "equal") = show (lequal (getlist (getword
(skipword (skipword (x:xs))))) (getlist (getword (skipword (skipword
(skipword (x:xs)))))))
| ((getword(skipword (x:xs))) == "cardinality") = show (lcardinality (getlist
(getword (skipword (skipword (x:xs))))))
| ((getword(skipword (x:xs))) == "successor") = show (lsuccessor (read (getword
(skipword (skipword (x:xs))))) (getlist (getword (skipword (skipword
(skipword (x:xs)))))))
| ((getword(skipword (x:xs))) == "closest") = show (lclosest (getlist (getword
(skipword (skipword (x:xs))))) (read (getword (skipword (skipword
(skipword (x:xs)))))))
| otherwise = "Error in input : Please check command"
-- sets "List union {1,2,3} {5,3,4}" -- parses out all required information
-- from the input String to call the appropriate functions with correct
-- parameters, then returns the correctly formatted output String.
sets :: String -> String
sets (x:xs)
| ((getword (x:xs)) == "List") = listfunc (x:xs)
| ((getword (x:xs)) == "BST") = bstfunc (x:xs)
| otherwise = "Error in input : Please check command"
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- end of main program --
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
-- Input Examples: ------------------------------------------------------------
--------------------------------------------------------------------------------
--
-- sets "List union {1,2,3} {5,3,4}"
-- sets "List intersection {1,2,3} {5,3,4}"
-- sets "List equal {1,2,3} {5,3,4}"
-- sets "List cardinality {1,2,3}"
-- sets "List successor 1 {5,3,4}"
-- sets "List closest {5,3,4} 2"
--
-- sets "BST union {1,2,3} {5,3,4}"
-- sets "BST intersection {1,2,3} {5,3,4}"
-- sets "BST equal {1,2,3} {5,3,4}"
-- sets "BST cardinality {5,3,4}"
Other Random Programs I've Made Over The Years
-- sqr x -- returns the square of x sqr :: Int -> Int sqr x = x*x
-- cube x -- returns the cube of x cube :: Int -> Int cube x = x*x*x
-- max4 a b c d -- returns the greatest of four integers max4 :: Int -> Int -> Int -> Int -> Int max4 a b c d = max a (max b (max c d) )
-- leap x -- returns true if integer can represent a leap year leap :: Int -> Bool leap x |(x `mod` 400 == 0) = True |(x `mod` 100 == 0) = False |(x `mod` 4 == 0) = True |otherwise = False
-- factorial x -- return factorial of x factorial :: Int -> Int factorial x |(x==0) = 1 |otherwise = product [1..x]
-- oddsum x -- returns sum of odd numbers up to that number oddsum :: Int -> Int oddsum x |(x==0) = 0 |(x<=2) = 1 |(x==3) = 4 |otherwise = sum [1,3..x]
-- occurs 'x' "y" -- returns number of times a letter appears in a sting occurs :: Char -> String -> Integer occurs x [] = 0 occurs x(y:ys) = if (x==y) then (occurs x ys)+1 else occurs x ys
-- sort [Int] -- returns a sorted list of integers (quick sort) sort :: [Int] -> [Int] sort [] = [] sort (x:xs) = sort ltn_x ++ [x] ++ sort gte_x where ltn_x = [y | y <- xs, y < x] gte_x = [y | y <- xs, y >= x]
-- merge [Int] [Int] -- returns a sorted merge of two lists of integers -- merge :: [Int] -> [Int] -> [Int] -- merge (x:xs)(y:ys) = [(min x y), (max x y), (merge xs ys)]
Learning more
If you want to learn more about Haskell, then pop over to haskell.org.
— Nexami Engeo 2007/07/06 00:07#
Discussion