{----------------------------------------------------------------------- Software for "The tree of knot tunnels" by Sangbum Cho and Darryl McCullough Version of April 5, 2007 Contact: dmccullough@math.ou.edu This is a Haskell script, written for the hugs Haskell 98 interpreter. ------------------------------------------------------------------------ These functions convert between the Scharlemann-Thompson invariant and the principal slope invariant. First, the function evenCFrac takes a rational number r = p/q with p odd and writes it as a continued fraction of the form [2a_1, 2b_1, 2a_2, 2b_2, ..., 2a_n, b_n ] i. e. with an even number of terms, all of which are even except possibly the last one. Also, a_n and b_n have the same sign. Putting a equal to the sum of the a_i, the other invariant is then [(-1)^p 2a, -b_n, -2a_{n-1}, ..., -2a_2, -2b_1 ]. ------------------------------------------------------------------------ To convert from either invariant p/q to the other, use convert (p/q) STinvariant> convert (54723/13363) -199299/13363 To convert all p/q for p between m and n, use convertRange q m n STinvariant> convertRange 436 135 155 (p/q, p'/q') 135/436, -4599/436 137/436, -8249/436 139/436, -4291/436 141/436, -1509/436 143/436, -9903/436 145/436, -63217/436 147/436, 14213/436 149/436, 4003/436 151/436, -231/436 153/436, 1687/436 155/436, 3533/436 -----------------------------------------------------------------------} module STinvariant where import Prelude import Ratio unCFrac :: [Integer] -> Rational -- convert from continued fraction back to number unCFrac [n] = toRational n unCFrac (n:ns) = (toRational n) + 1/unCFrac(ns) -- functions to calculate the continued fraction with -- all terms even, except possibly the last term integerPart :: Rational -> Integer integerPart x = quot (numerator ( x ) ) (denominator ( x )) nearestEvenInteger :: Rational -> Integer nearestEvenInteger r | r > 0 = 2 * (integerPart ( ( r + 1 )/2 )) | otherwise = (-2) * (integerPart ( ( (-r) + 1 )/2 )) evenCFrac :: Rational -> [Integer] evenCFrac r | even ( length eCFrac ) = eCFrac | even ( last eCFrac ) = eCFrac | otherwise = take (length eCFrac - 1) eCFrac ++ ( if lastTerm > 1 then [ lastTerm -1, 1] else [ lastTerm + 1, -1 ] ) where lastTerm = last eCFrac eCFrac = evenCFrac' r evenCFrac' :: Rational -> [Integer] -- auxiliary function for evenCFrac, allows last term odd evenCFrac' r | denominator( r ) == 1 = [numerator( r )] | otherwise = (nearestEvenInteger r ) : ( evenCFrac' ( 1/(evenRemainder r ) ) ) where evenRemainder x = x - toRational( nearestEvenInteger x ) -- functions to convert between Scharlemann-Thompson invariant and -- principal slope invariant sumOddTerms :: [Integer] -> Integer sumOddTerms [ ] = 0 sumOddTerms [x] = x sumOddTerms (x:y:rest) = x + sumOddTerms(rest) convertIntegerList :: [Integer] -> Integer -> [Integer] convertIntegerList list p = ( (-1)^p * (sumOddTerms list) ) : reverseRemainingList where reverseRemainingList = map (\x -> (-x)) (reverse (tail list)) convert :: Rational -> IO() convert r = putStr ( convert' r ) convert' :: Rational -> String convert' r = ( prettyPrint . unCFrac ) (convertIntegerList (evenCFrac r) (denominator r)) prettyPrint :: Rational -> String prettyPrint r | denominator(r) == 1 = (show (numerator r)) | otherwise = (show (numerator r)) ++ "/" ++ (show (denominator r)) -- function to convert ranges of numbers convertRange :: Integer -> Integer -> Integer -> IO() convertRange q m n = putStr ("\n(p/q, p'/q')\n\n" ++ ( concat [ (prettyPrint (p % q)) ++ ", " ++ (convert' (p % q)) ++ "\n" | p <- [m',(m'+step)..n], gcd p q == 1 ] )) where m' = if odd m then m else m+1 step = if m' < n then 2 else -2