49 lines
1.7 KiB
Haskell
49 lines
1.7 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]
|
|
|
|
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],
|
|
q /= 0] -- use p /= 0 || q /= 0 for more symmetric output
|
|
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]
|