The Kauffman Bracket using Haskell: Difference between revisions
From Knot Atlas
Jump to navigationJump to search
No edit summary |
No edit summary |
||
| Line 1: | Line 1: | ||
Here's a program to compute the Kauffman Bracket of a knot using [http://www.haskell.org/ Haskell], written by [http://www.math.columbia.edu/~dpt/ Dylan Thurston]. The required imports are at [[Media:PreludeBase.lhs|Media:PreludeBase.lhs]] ([[Image |
Here's a program to compute the Kauffman Bracket of a knot using [http://www.haskell.org/ Haskell], written by [http://www.math.columbia.edu/~dpt/ Dylan Thurston]. The required imports are at [[Media:PreludeBase.lhs|Media:PreludeBase.lhs]] ([[Image:PreludeBase.lhs|file description]]), [[Media:NumPrelude.lhs|Media:NumPrelude.lhs]] ([[Image:NumPrelude.lhs|file description]]), [[Media:VectorSpace.lhs|Media:VectorSpace.lhs]] ([[Image:VectorSpace.lhs|file description]]), [[Media:Polynomial.lhs|Media:Polynomial.lhs]] ([[Image:Polynomial.lhs|file description]])). |
||
Compute the Jones polynomial, in stupid and more clever ways. |
Compute the Jones polynomial, in stupid and more clever ways. |
||
Revision as of 18:51, 22 December 2005
Here's a program to compute the Kauffman Bracket of a knot using Haskell, written by Dylan Thurston. The required imports are at Media:PreludeBase.lhs (File:PreludeBase.lhs), Media:NumPrelude.lhs (File:NumPrelude.lhs), Media:VectorSpace.lhs (File:VectorSpace.lhs), Media:Polynomial.lhs (File:Polynomial.lhs)).
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)
