module RiskWeaver.Pip where

newtype Polygon = Polygon [(Double, Double)] deriving (Int -> Polygon -> ShowS
[Polygon] -> ShowS
Polygon -> String
(Int -> Polygon -> ShowS)
-> (Polygon -> String) -> ([Polygon] -> ShowS) -> Show Polygon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Polygon -> ShowS
showsPrec :: Int -> Polygon -> ShowS
$cshow :: Polygon -> String
show :: Polygon -> String
$cshowList :: [Polygon] -> ShowS
showList :: [Polygon] -> ShowS
Show, Polygon -> Polygon -> Bool
(Polygon -> Polygon -> Bool)
-> (Polygon -> Polygon -> Bool) -> Eq Polygon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Polygon -> Polygon -> Bool
== :: Polygon -> Polygon -> Bool
$c/= :: Polygon -> Polygon -> Bool
/= :: Polygon -> Polygon -> Bool
Eq)

newtype Point = Point (Double, Double) deriving (Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Point -> ShowS
showsPrec :: Int -> Point -> ShowS
$cshow :: Point -> String
show :: Point -> String
$cshowList :: [Point] -> ShowS
showList :: [Point] -> ShowS
Show, Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
/= :: Point -> Point -> Bool
Eq)

-- | When given a polygon and a point, returns True if the point is inside the polygon.
pointInPolygon :: Polygon -> Point -> Bool
pointInPolygon :: Polygon -> Point -> Bool
pointInPolygon (Polygon [(Double, Double)]
polygon) (Point (Double, Double)
point) =
  let points :: [((Double, Double), (Double, Double))]
points = [(Double, Double)]
-> [(Double, Double)] -> [((Double, Double), (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Double, Double)]
polygon ([(Double, Double)] -> [(Double, Double)]
forall a. HasCallStack => [a] -> [a]
tail [(Double, Double)]
polygon)
      wn :: [Int]
wn = ((((Double, Double), (Double, Double)) -> Int)
 -> [((Double, Double), (Double, Double))] -> [Int])
-> [((Double, Double), (Double, Double))]
-> (((Double, Double), (Double, Double)) -> Int)
-> [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Double, Double), (Double, Double)) -> Int)
-> [((Double, Double), (Double, Double))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [((Double, Double), (Double, Double))]
points ((((Double, Double), (Double, Double)) -> Int) -> [Int])
-> (((Double, Double), (Double, Double)) -> Int) -> [Int]
forall a b. (a -> b) -> a -> b
$ \((Double, Double)
vi, (Double, Double)
vii) ->
        if (((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point) Bool -> Bool -> Bool
&& ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vii Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point))
          then
            let vt :: Double
vt = ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vii Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi)
             in if ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
point Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
vt Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vii Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vi))))
                  then Int
1
                  else Int
0
          else
            if (((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point) Bool -> Bool -> Bool
&& ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vii Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point))
              then
                let vt :: Double
vt = ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
point Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ ((Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vii Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> b
snd (Double, Double)
vi)
                 in if ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
point Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
vt Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vii Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double, Double) -> Double
forall a b. (a, b) -> a
fst (Double, Double)
vi))))
                      then -Int
1
                      else Int
0
              else Int
0
   in ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
wn) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
0 :: Int)