# The Kauffman Bracket using Haskell

From Knot Atlas

Here's a program to compute the Kauffman Bracket of a knot using Haskell, written by Dylan Thurston:

Compute the Jones polynomial, in stupid and more clever ways. > {-# OPTIONS -fno-implicit-prelude -fglasgow-exts #-} > module Jones > where > import Prelude() > import PreludeBase > import NumPrelude > import VectorSpace > import Polynomial > data Node a = Cross a a a a | Join a a > deriving (Eq, Show, Read, Ord) > instance Functor Node where > fmap f (Cross a b c d) = Cross (f a) (f b) (f c) (f d) > fmap f (Join a b) = Join (f a) (f b) > type PD = [Node Int] Some simple knots for testing. > k31 :: PD > k31 = [Cross 1 4 2 5, Cross 3 6 4 1, Cross 5 2 6 3] The ring we work over. (Really we should work in Laurent polynomials, but this is the code I had on hand.) > type R = Ratio (Poly Rational) > av, ai :: R > av = (shiftPoly 1) % 1 > ai = recip av > kauffman :: PD -> R > kauffman [] = one > kauffman (Join a b:pd) | a == b = (-av*av-ai*ai) * kauffman pd > kauffman (Join a b:pd) | otherwise = > kauffman (map (fmap (\c -> if (c == a) then b else c)) pd) > kauffman (Cross a b c d:pd) = > ai * kauffman (Join a b:Join c d:pd) > + av * kauffman (Join a d:Join b c:pd)

The required imports are at PreludeBase.lhs (File:PreludeBase.lhs), NumPrelude.lhs (File:NumPrelude.lhs), VectorSpace.lhs (File:VectorSpace.lhs) and at Polynomial.lhs (File:Polynomial.lhs).