minor fixes

This commit is contained in:
Florian Stecker 2021-10-04 20:12:47 -05:00
parent dd940f8f35
commit 5211a60266
3 changed files with 6 additions and 10 deletions

1
.gitignore vendored
View File

@ -10,3 +10,4 @@ billiard_words
*.pnm *.pnm
*.png *.png
*.hi *.hi
gmon.out

View File

@ -11,18 +11,13 @@ wordlist = nub $ sortBy (comparing sl) [((p `div` gcd p q, q `div` gcd p q), slo
-- only allows slopes 0 <= p/q <= 1 -- only allows slopes 0 <= p/q <= 1
slopeWord :: Int -> Int -> String slopeWord :: Int -> Int -> String
slopeWord p q = slopeWord p q = concat $ map word $ zipWith step list (tail list)
concat $ map word $ zipWith step list (tail list)
where where
p_ = p `div` gcd p q p_ = p `div` gcd p q
q_ = q `div` gcd p q q_ = q `div` gcd p q
xmax = if (p_ - q_) `mod` 3 == 0 then q_ else 3*q_ xmax = if (p_-q_) `mod` 3 == 0 then q_ else 3*q_ :: Int
list = [(x,y) | x <- ([0..xmax] :: [Int]), let y = floor (fromIntegral x*fromIntegral p/fromIntegral q)] list = [(x,(x*p) `div` q) | x <- [0..xmax]]
step (x1,y1) (x2,y2) = ((x1-y1) `mod` 3, y2-y1)
step :: (Int,Int) -> (Int,Int) -> (Int,Int)
step (x1,y1) (x2,y2) = ((x1-y1) `mod` 3, y2 - y1)
word :: (Int,Int) -> String
word (0,0) = "bc" word (0,0) = "bc"
word (1,0) = "ab" word (1,0) = "ab"
word (2,0) = "ca" word (2,0) = "ca"

View File

@ -9,6 +9,6 @@ col = map (\(r,g,b) -> (round $ r*255, round $ g*255, round $ b*255)) colors ::
main = do main = do
foo <- readFile "max_slopes_billiard" foo <- readFile "max_slopes_billiard"
let dat = map (read.(!!2).words) $ lines foo :: [Int] let dat = map (read.(!!2).words) $ lines foo :: [Int]
writeFile "max_slope_billiards.pnm" $ header ++ unlines [printf "%d %d %d" r g b | p <- dat, let (r,g,b) = col !! (p `mod` 10)] writeFile "max_slope_billiards.pnm" $ header ++ unlines [printf "%d %d %d" r g b | p <- dat, let (r,g,b) = col !! (p `mod` 14)]
where where
header = "P3\n300\n123\n255\n" header = "P3\n300\n123\n255\n"