diff --git a/billiard_words.hs b/billiard_words.hs index 80c8d5a..56e4654 100644 --- a/billiard_words.hs +++ b/billiard_words.hs @@ -2,25 +2,32 @@ import Data.List import Data.Ord import Text.Printf -main = do - 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, length w <= 100] +main = listWordsUpToLength 22 -wordlist = nub $ sortBy (comparing sl) [((p `div` gcd p q, q `div` gcd p q), slopeWord p q) | p <- [0..50], q <- [1..50], p <= q] +listWordsUpToLength :: Int -> IO () +listWordsUpToLength n = do + putStrLn $ unlines [printf "%d/%d\t%.7f\t%d\t%s" p q (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] +-- 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..50], q <- [0..50], p /= 0 || q /= 0] where sl ((p,q),_) = fromIntegral p / fromIntegral q --- only allows slopes 0 <= p/q <= 1 -slopeWord :: Int -> Int -> String -slopeWord p q = concat $ map word $ zipWith step list (tail list) +-- 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) = "bc" - word (1,0) = "ab" - word (2,0) = "ca" - word (0,1) = "baca" - word (1,1) = "acbc" - word (2,1) = "cbab" + 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]