The Kauffman Bracket using Haskell: Difference between revisions
From Knot Atlas
Jump to navigationJump to search
No edit summary |
m (Reverted edits by CnatrOclet (Talk); changed back to last version by Drorbn) |
||
| (2 intermediate revisions by 2 users not shown) | |||
| Line 44: | Line 44: | ||
> + av * kauffman (Join a d:Join b c:pd) |
> + av * kauffman (Join a d:Join b c:pd) |
||
The required imports are at [[Media:PreludeBase.lhs| |
The required imports are at [[Media:PreludeBase.lhs|PreludeBase.lhs]] ([[Image:PreludeBase.lhs|file description]]), [[Media:NumPrelude.lhs|NumPrelude.lhs]] ([[Image:NumPrelude.lhs|file description]]), [[Media:VectorSpace.lhs|VectorSpace.lhs]] ([[Image:VectorSpace.lhs|file description]]) and at [[Media:Polynomial.lhs|Polynomial.lhs]] ([[Image:Polynomial.lhs|file description]]). |
||
Latest revision as of 13:09, 12 July 2008
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).
