module CodeWorld.Tasks.VectorSpace (
  -- * CodeWorld interface
  Point,
  Vector,
  translatedPoint,
  rotatedPoint,
  reflectedPoint,
  scaledPoint,
  dilatedPoint,
  vectorLength,
  vectorDirection,
  vectorSum,
  vectorDifference,
  scaledVector,
  rotatedVector,
  dotProduct,
  -- * other stuff
  crossProduct,
  sideLengths,
  rotationAngle,
  isRectangle,
  atOriginWithOffset,
  wasTranslatedBy,
  wasScaledBy,
  wasRotatedBy
  ) where


import Data.Containers.ListUtils        (nubOrd)
import Data.List.Extra                  (headDef, takeEnd)
import Data.Maybe                       (fromMaybe)
import Data.Tuple.Extra                 (both)



{-|
A point in 2D space.
Synonym for a pair of `Double` values.
-}
type Point = (Double,Double)

{-|
A vector in 2D space.
Synonym for a pair of `Double` values.
-}
type Vector = (Double,Double)


{-|
Moves a point in X and Y-directions.
-}
translatedPoint :: Double -> Double -> Point -> Point
translatedPoint :: Double -> Double -> Point -> Point
translatedPoint Double
x Double
y (Double
xp,Double
yp) = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xp,Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yp)

{- |
Scales a point by given X and Y scaling factor.
Scaling by a negative factor also reflects across that axis.
-}
scaledPoint :: Double -> Double -> Point -> Point
scaledPoint :: Double -> Double -> Point -> Point
scaledPoint = Double -> Double -> Point -> Point
scaledVector


{-|
Dilates a point by given uniform scaling factor.
Dilating by a negative factor also reflects across the origin.
-}
dilatedPoint :: Double -> Point -> Point
dilatedPoint :: Double -> Point -> Point
dilatedPoint Double
f = Double -> Double -> Point -> Point
scaledPoint Double
f Double
f

{- |
Rotates a point around the origin by the given angle in radians.
-}
rotatedPoint :: Double -> Point -> Point
rotatedPoint :: Double -> Point -> Point
rotatedPoint = Double -> Point -> Point
rotatedVector


getVector :: Point -> Point -> Vector
getVector :: Point -> Point -> Point
getVector (Double
x1,Double
y1) (Double
x2,Double
y2) = (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x1,Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y1)


isOrthogonal :: Vector -> Vector -> Bool
isOrthogonal :: Point -> Point -> Bool
isOrthogonal Point
p = (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==Double
0) (Double -> Bool) -> (Point -> Double) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Point -> Double
dotProduct Point
p


dotProduct :: Vector -> Vector -> Double
dotProduct :: Point -> Point -> Double
dotProduct (Double
x1,Double
y1) (Double
x2,Double
y2) = Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y2


crossProduct :: Vector -> Vector -> Double
crossProduct :: Point -> Point -> Double
crossProduct (Double
a,Double
b) (Double
c,Double
d) = Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b


{- |
The length of a vector.
-}
vectorLength :: Vector -> Double
vectorLength :: Point -> Double
vectorLength (Double
x,Double
y) = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y


{- |
Scales a vector by the given scalar multiplier.
-}
scaledVector :: Double -> Double -> Vector -> Vector
scaledVector :: Double -> Double -> Point -> Point
scaledVector Double
xFac Double
yFac (Double
x,Double
y) = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
xFac,Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
yFac)

{- |
Rotates a vector by the given angle in radians.
-}
rotatedVector :: Double -> Vector -> Vector
rotatedVector :: Double -> Point -> Point
rotatedVector Double
angle (Double
x,Double
y) = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
angle Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
angle, Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
angle Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
angle)


{- |
The difference of two vectors.
-}
vectorDifference :: Vector -> Vector -> Vector
vectorDifference :: Point -> Point -> Point
vectorDifference (Double
x1,Double
y1) (Double
x2,Double
y2) = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y2)


{- |
The sum of two vectors.
-}
vectorSum :: Vector -> Vector -> Vector
vectorSum :: Point -> Point -> Point
vectorSum (Double
x1,Double
y1) (Double
x2,Double
y2) = (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2,Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2)


{- |
The counter-clockwise angle of a vector from the X-axis.
-}
vectorDirection :: Vector -> Double
vectorDirection :: Point -> Double
vectorDirection (Double
x,Double
y) = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x


{- |
Reflects a point across a line through the origin at this angle from the X-axis.
-}
reflectedPoint :: Double -> Point -> Point
reflectedPoint :: Double -> Point -> Point
reflectedPoint Double
th (Double
x, Double
y) = (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
a, Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
a)
  where a :: Double
a = Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
th


allOrthogonal :: [Point] -> Bool
allOrthogonal :: [Point] -> Bool
allOrthogonal (Point
p1:Point
p2:Point
p3:[Point]
xs) = Point -> Point -> Bool
isOrthogonal (Point -> Point -> Point
getVector Point
p1 Point
p2) (Point -> Point -> Point
getVector Point
p2 Point
p3) Bool -> Bool -> Bool
&& [Point] -> Bool
allOrthogonal (Point
p2Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:Point
p3Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
:[Point]
xs)
allOrthogonal [Point]
_ = Bool
True


sideLengths :: [Point] -> (Double,Double)
sideLengths :: [Point] -> Point
sideLengths (p :: Point
p@(Double
xp,Double
yp):[Point]
ps) = ([Point] -> Double
calc [Point]
forX, [Point] -> Double
calc [Point]
forY)
  where
    forX :: [Point]
forX = (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
yp) (Double -> Bool) -> (Point -> Double) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Double
forall a b. (a, b) -> b
snd) [Point]
ps
    forY :: [Point]
forY = (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
xp) (Double -> Bool) -> (Point -> Double) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Double
forall a b. (a, b) -> a
fst) [Point]
ps
    calc :: [Point] -> Double
calc [Point]
val = Point -> Double
vectorLength (Point -> Double) -> Point -> Double
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Point
getVector (Point -> [Point] -> Point
forall a. a -> [a] -> a
headDef Point
p [Point]
val) Point
p
sideLengths [Point]
_ = (Double
0,Double
0)


rectangleSideRotation :: [Point] -> Maybe Double
rectangleSideRotation :: [Point] -> Maybe Double
rectangleSideRotation (Point
p1:Point
p2:[Point]
_) = Point -> Maybe Double
angleToAxes (Point -> Point -> Point
getVector Point
p1 Point
p2)
rectangleSideRotation [Point]
_ = Maybe Double
forall a. Maybe a
Nothing


angleToAxes :: Vector -> Maybe Double
angleToAxes :: Point -> Maybe Double
angleToAxes Point
v
  | Double
dotProd Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Maybe Double
forall a. Maybe a
Nothing
  | Double
angle Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
forall a. Floating a => a
pi = Maybe Double
forall a. Maybe a
Nothing
  | Bool
otherwise = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
angle
  where
    dotProd :: Double
dotProd = Point -> Point -> Double
dotProduct Point
v (Double
0,Double
1)
    angle :: Double
angle = Double -> Double
forall a. Floating a => a -> a
acos (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
dotProd Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Point -> Double
vectorLength Point
v


rotationAngle :: [Point] -> Double
rotationAngle :: [Point] -> Double
rotationAngle = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double)
-> ([Point] -> Maybe Double) -> [Point] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Point] -> Maybe Double
rectangleSideRotation


tupleAbs :: (Ord a, Num a) => a -> (a, a) -> Bool
tupleAbs :: forall a. (Ord a, Num a) => a -> (a, a) -> Bool
tupleAbs a
threshold (a
d1,a
d2) = a -> a
forall a. Num a => a -> a
abs a
d1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
threshold Bool -> Bool -> Bool
&& a -> a
forall a. Num a => a -> a
abs a
d2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
threshold


{- |
Returns which translation needs to be applied to argument 1 to get argument 2.
Nothing if the polygons are different.

This can be used to detect translation in point list based shapes.
-}
wasTranslatedBy :: [Point] -> [Point] -> Maybe Point
wasTranslatedBy :: [Point] -> [Point] -> Maybe Point
wasTranslatedBy (Point
p11:Point
p12:[Point]
ps1) (Point
p21:Point
p22:[Point]
ps2)
  | Double -> Point -> Bool
forall a. (Ord a, Num a) => a -> (a, a) -> Bool
tupleAbs Double
eta (Point -> Point -> Point
vectorDifference Point
firstDiff (Point -> Point -> Point
vectorDifference Point
p22 Point
p12)) Bool -> Bool -> Bool
&&
    [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps2 = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
firstDiff
  | Bool
otherwise = Maybe Point
forall a. Maybe a
Nothing
  where
    firstDiff :: Point
firstDiff = Point -> Point -> Point
vectorDifference Point
p21 Point
p11
wasTranslatedBy [Point]
_ [Point]
_ = Maybe Point
forall a. Maybe a
Nothing


{- |
Returns which scaling factors need to be applied to argument 1 to get argument 2.

* Nothing if the polygons are not similar.
* Factors themselves can also be Nothing if the factor is undeterminable.

E.g. a possible result could be @Just (Just 3, Nothing)@.
This means the second shape is a scaled version of the first and the factor in X-direction is 3,
but the factor in Y-direction cannot be determined.

This can be used to detect size scaling in point list based shapes.
-}
wasScaledBy :: [Point] -> [Point] -> Maybe (Maybe Double,Maybe Double)
wasScaledBy :: [Point] -> [Point] -> Maybe (Maybe Double, Maybe Double)
wasScaledBy [Point]
ps1 [Point]
ps2 | [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps2 =
  case ([Double] -> Maybe (Maybe Double))
-> ([Double], [Double])
-> (Maybe (Maybe Double), Maybe (Maybe Double))
forall a b. (a -> b) -> (a, a) -> (b, b)
both [Double] -> Maybe (Maybe Double)
factor ([Double]
matchX, [Double]
matchY) of
    (Just Maybe Double
a, Just Maybe Double
b) -> (Maybe Double, Maybe Double) -> Maybe (Maybe Double, Maybe Double)
forall a. a -> Maybe a
Just (Maybe Double
a,Maybe Double
b)
    (Maybe (Maybe Double), Maybe (Maybe Double))
_                -> Maybe (Maybe Double, Maybe Double)
forall a. Maybe a
Nothing
  where
    ([Double]
matchX, [Double]
matchY) =
      let ([Double]
x1s,[Double]
y1s) = [Point] -> ([Double], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [Point]
ps1
          ([Double]
x2s,[Double]
y2s) = [Point] -> ([Double], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [Point]
ps2
      in  (([Double], [Double]) -> [Double])
-> (([Double], [Double]), ([Double], [Double]))
-> ([Double], [Double])
forall a b. (a -> b) -> (a, a) -> (b, b)
both (([Double] -> [Double] -> [Double])
-> ([Double], [Double]) -> [Double]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/))) (([Double]
x2s, [Double]
x1s), ([Double]
y2s, [Double]
y1s))

    -- Nothing: Not a scaled version of the other list
    -- Just Nothing: is a scaled Version of the other list, but factor can't be determined
    -- Just fac: is a scaled version of the other list with factor fac
    handleResult :: [Double] -> Maybe (Maybe Double)
handleResult [] = Maybe Double -> Maybe (Maybe Double)
forall a. a -> Maybe a
Just Maybe Double
forall a. Maybe a
Nothing
    handleResult (Double
ref:[Double]
xs) | (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Double
x -> Double -> Double
forall a. Num a => a -> a
abs (Double
ref Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eta) [Double]
xs = Maybe Double -> Maybe (Maybe Double)
forall a. a -> Maybe a
Just (Maybe Double -> Maybe (Maybe Double))
-> Maybe Double -> Maybe (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
ref
    handleResult [Double]
_ = Maybe (Maybe Double)
forall a. Maybe a
Nothing

    factor :: [Double] -> Maybe (Maybe Double)
factor = [Double] -> Maybe (Maybe Double)
handleResult ([Double] -> Maybe (Maybe Double))
-> ([Double] -> [Double]) -> [Double] -> Maybe (Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Bool) -> [Double] -> [Double]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Double -> Bool) -> Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN)

wasScaledBy [Point]
_ [Point]
_ = Maybe (Maybe Double, Maybe Double)
forall a. Maybe a
Nothing


{- |
Returns which rotation needs to be applied to argument 1 to get argument 2.
Nothing if it does not exist.

This can be used to detect rotation in point list based shapes.
-}
wasRotatedBy :: [Point] -> [Point] -> Maybe Double
wasRotatedBy :: [Point] -> [Point] -> Maybe Double
wasRotatedBy ((Double
x,Double
y):(Double
x2,Double
y2):[Point]
ps1) ((Double
rx,Double
ry):(Double
rx2,Double
ry2):[Point]
ps2)
  | Double -> Double
forall a. Num a => a -> a
abs (Double
firstRotation Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ry2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rx2) (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rx2Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ry2)) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eta Bool -> Bool -> Bool
&&
    [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
ps2 = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
firstRotation
  | Bool
otherwise = Maybe Double
forall a. Maybe a
Nothing
  where
    firstRotation :: Double
firstRotation = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ryDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rx) (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
rxDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ry)
wasRotatedBy [Point]
_ [Point]
_ = Maybe Double
forall a. Maybe a
Nothing


-- allowed difference to be considered "equal".
eta :: Double
eta :: Double
eta = Double
0.0001


mean :: [Point] -> Point
mean :: [Point] -> Point
mean [] = (Double
0,Double
0)
mean [Point]
ps = Double -> Double -> Point -> Point
scaledVector Double
f Double
f Point
vSum
  where
    unique :: [Point]
unique = [Point] -> [Point]
forall a. Ord a => [a] -> [a]
nubOrd [Point]
ps
    vSum :: Point
vSum = (Point -> Point -> Point) -> Point -> [Point] -> Point
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> Point -> Point
vectorSum (Double
0,Double
0) [Point]
unique
    f :: Double
f = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
unique)


isRectangle :: [Point] -> Bool
isRectangle :: [Point] -> Bool
isRectangle [Point]
ps
    | Bool
hasFour Bool -> Bool -> Bool
&& Bool
endIsStart = [Point] -> Bool
allOrthogonal [Point]
unique
    | Bool
otherwise = Bool
False
  where
    unique :: [Point]
unique = [Point] -> [Point]
forall a. Ord a => [a] -> [a]
nubOrd [Point]
ps
    hasFour :: Bool
hasFour = [Point] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Point]
unique Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
    endIsStart :: Bool
endIsStart = Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
1 [Point]
ps [Point] -> [Point] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
takeEnd Int
1 [Point]
ps


atOriginWithOffset :: [Point] -> ([Point],Point)
atOriginWithOffset :: [Point] -> ([Point], Point)
atOriginWithOffset [] = ([],(Double
0,Double
0))
atOriginWithOffset [Point]
ps = ((Point -> Point) -> [Point] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Point -> Point
`vectorDifference` Point
middlePoint) [Point]
ps, Point
middlePoint)
  where
    middlePoint :: Point
middlePoint = [Point] -> Point
mean [Point]
ps