{-----------------------------------------------------------------------

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