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
*.png
*.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
slopeWord :: Int -> Int -> String
slopeWord p q =
concat $ map word $ zipWith step list (tail list)
slopeWord p q = 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_
list = [(x,y) | x <- ([0..xmax] :: [Int]), let y = floor (fromIntegral x*fromIntegral p/fromIntegral q)]
step :: (Int,Int) -> (Int,Int) -> (Int,Int)
step (x1,y1) (x2,y2) = ((x1-y1) `mod` 3, y2 - y1)
word :: (Int,Int) -> String
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"

View File

@ -9,6 +9,6 @@ col = map (\(r,g,b) -> (round $ r*255, round $ g*255, round $ b*255)) colors ::
main = do
foo <- readFile "max_slopes_billiard"
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
header = "P3\n300\n123\n255\n"