triangle_reflection_complex/billiard_words.hs

40 lines
1.8 KiB
Haskell

import Data.List
import Data.Ord
import Text.Printf
import System.Environment
main = do
argv <- getArgs
listWordsUpToLength $ read $ argv !! 0
listWordsUpToLength :: Int -> IO ()
listWordsUpToLength n = do
putStrLn $ unlines [printf "%s %d/%d %f" w (x `div` gcd x y) (y `div` gcd x y) (fromIntegral x / fromIntegral y :: Double) | ((p,q),w) <- wordlist (n`div`2) (n`div`2), length w <= n, let x = 2*q + p, let y = 2*p + q]
-- putStrLn $ unlines [printf "%d/%d\t%d/%d\t%.7f\t%d\t%s" p q (x `div` gcd x y) (y `div` gcd x y) (sqrt 3 / (1 + 2*fromIntegral q / fromIntegral p) :: Double) (length w) w | ((p,q),w) <- wordlist (n`div`2) (n`div`2), length w <= n, let x = 2*q + p, let y = 2*p + q]
-- putStrLn $ unlines [printf "%d/%d\t%.5f\t%.5f\t%d\t%s" p q (fromIntegral p / fromIntegral q :: Double) (sqrt 3 / (1 + 2*fromIntegral q / fromIntegral p) :: Double) (length w) w | ((p,q),w) <- wordlist (n`div`2) (n`div`2), length w <= n]
wordlist :: Int -> Int -> [((Int,Int),String)]
wordlist pmax qmax = nub $ sortBy (comparing sl) [((p `div` gcd p q, q `div` gcd p q), slopeWord "bca" p q) | p <- [0..pmax], q <- [0..qmax], p /= 0 || q /= 0]
where
sl ((p,q),_) = fromIntegral p / fromIntegral q
-- letters: reflection along e_1, reflection along e_2, other one; p,q >= 0
slopeWord :: [Char] -> Int -> Int -> String
slopeWord [x,y,z] p q
| p > q = slopeWord [y,x,z] q p
| otherwise = concat $ map word $ zipWith step list (tail list)
where
p_ = p `div` gcd p q
q_ = q `div` gcd p q
xmax = if (p_-q_) `mod` 3 == 0 then q_ else 3*q_ :: Int
list = [(x,(x*p) `div` q) | x <- [0..xmax]]
step (x1,y1) (x2,y2) = ((x1-y1) `mod` 3, y2-y1)
word (0,0) = [z,x]
word (1,0) = [y,z]
word (2,0) = [x,y]
word (0,1) = [z,y,x,y]
word (1,1) = [y,x,z,x]
word (2,1) = [x,z,y,z]