Given \$w, h, \alpha\$ for a rectangle centered at origin with width \$w\$, height \$h\$ and itself rotated by \$\alpha\$ around origin clockwise, I wrote a code to find the intersection area.

  1. First I find all 4 corners of original and rotated rectangle, along with lines joining them.
  2. Then I find intersection with axis-parallel lines using getints
  3. Then I take all intersections in a clockwise/anti-clockwise order and find area using the co-ordinates of the polygon thus formed.

Source: https://codeforces.com/problemset/problem/280/A Image

import Data.Ord
import Data.List
import Control.Monad

main :: IO ()
main = do    
  [w, h, a] <- map read . words <$> getLine
  let a' = (min a (180 - a)) * pi / 180
  let pts = [(w/2, h/2), (w/2, -h/2), (-w/2,-h/2), (-w/2,h/2)] :: [(Double, Double)]
  let pts' = map (rotate a') pts
  let lines = zip pts (tail $ cycle pts)
  let lines' = zip pts' (tail $ cycle pts')
  let ints = concatMap (getints lines') lines
  print . area . uniq $ sortBy (comparing theta) ints

uniq [] = []
uniq [x] = [x]
uniq (x:y:xs)
  | x == y = uniq (x:xs)
  | otherwise = x : uniq (y:xs)

rotate a (x, y) = (x * cos a - y * sin a, x * sin a + y * cos a)

theta (x, y) = atan2 y x

getints xs y = concatMap (\x -> getints' x y) xs

getints' l'@((x1', y1'), (x2', y2')) l@((x, y), (x', y'))
  | x == x' =
    let y'' = y1' + (x - x1') / (x2' - x1') * (y2' - y1')
    in if min y y' <= y'' && y'' <= max y y' then [(x, y'')] else []
  | y == y' = map swap $ getints' (swap' l') (swap' l)
    swap (a, b) = (b, a)
    swap' (p1, p2) = (swap p1, swap p2)

area ps =
    xs = map fst ps
    ys = map snd ps
    0.5 * abs (sum $ zipWith4 (\x y y' x' -> x * y - y' * x') xs (tail $ cycle ys) ys (tail $ cycle xs))

1 Answer 1


Not a full rewrite, but some pointers:

Typically, a main function's do-block shouldn't be doing a whole lot of work. Additionally, do-blocks should try to avoid having lots of let statements, and instead "outsource" that work to helper functions. A function with type Double -> Double -> Double -> [((Double, Double), (Double, Double))] could replace most of the do block (the arguments would be w, h, and a).

Every style guide I've seen recommends putting type signatures on every top-level function. Just reading the code to try and figure out what the above mentioned type should be can be surprisingly difficult. Unfortunately, as the author of a program, it's really easy to forget that you know the types because the ideas for the program were your own.

Primes in function names are typically reserved for one of two things. It could mean a strict variant, such as foldl'. "Strict" in this case means that the function evaluates its argument, as opposed to Haskell's default of waiting to evaluate things as long as possible. The other option is that it's a minor variation on the function of the same name (many haskellers would say to avoid doing even this, and to reserve primes on function names for strict varaints alone). getints' is not a minor variation on getints, it is a helper function. A more appropriate name might be getintsHelper. On the other hand swap' is a minor variation on swap, and barring a better name like swapBoth, swap' is a reasonable name for that function.

Your function uniq looks like Data.List.nub. nub is a strange name and uniq honestly makes more sense, but it's better to use library functions that readers are familiar with. It's also fine to define synonyms, like uniq = nub, this way readers can see that in the source. Recognizing that uniq is a complete re-implementation is a bit harder. If you think a function you need is simple or common, check the standard library! Haskell's is quite extensive.

With top-level types added and no other changes, this would be a very strong starting point. I'd label that as good work!


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.