Test.hs

{-# OPTIONS_GHC -fno-warn-tabs #-}  -- Support tab indentation better, for a better default of no warning if tabs are used: https://dmitryfrank.com/articles/indent_with_tabs_align_with_spaces .
-- Enable warnings:
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

-- Test.hs.

{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE Arrows, ScopedTypeVariables #-}

module Test.Immutaball.Share.Math.Core.Test
	(
		main,
		testsMain,
		tests,

		simpleConstant,
		right3,
		forward3,
		up3,
		right2,
		up2,
		eq3Duplicate,
		zint,
		zdouble,
		circle,
		eqEachEach,
		v3normalized
	) where

--import Control.Arrow
--import Data.Functor.Identity

import Control.Lens
import Test.HUnit
--import Test.QuickCheck
import Test.Tasty
import Test.Tasty.HUnit hiding ((@?=), assertBool)
import Test.Tasty.QuickCheck

import Immutaball.Share.Math
import Immutaball.Share.Utils
import Test.Immutaball.Share.Math.Core.Orphans ()

main :: IO ()
main = testsMain

testsMain :: IO ()
testsMain = defaultMain tests

simpleConstant :: Integer
simpleConstant = 3

right3 :: Vec3 Double
right3 = Vec3 1.0 0.0 0.0

forward3 :: Vec3 Double
forward3 = Vec3 0.0 1.0 0.0

up3 :: Vec3 Double
up3 = Vec3 0.0 0.0 1.0

right2 :: Vec2 Double
right2 = Vec2 1.0 0.0

up2 :: Vec2 Double
up2 = Vec2 0.0 1.0

eq3Duplicate :: Vec3 Double -> Vec3 Double -> Bool
eq3Duplicate a b = abs ((b - a)^.r3) <= smalld

-- | Helps resolve default type to Integer warnings when using ‘0’.
zint :: Integer
zint = 0

zdouble :: Double
zdouble = 0.0

-- | Similar but to specialize to 'float' so that equivalence checks'
-- thresholds aren't too tight.
circle :: Float
circle = tau

-- | Given a list of values possibly known to already be unique, return a bool
-- that is True if the equality comparison on each possible pairing of values
-- is as expected.
--
-- If e.g. the values are randomly generated, they might not be unique, so only
-- check each value with each other in this case.
eqEachEach :: Bool -> (a -> a -> Bool) -> [a] -> Bool
eqEachEach guaranteedUnique eq vals =
	and $
		[ r
		| ivals <- return $ zip [zint..] vals
		, (ai, av) <- ivals
		, (bi, bv) <- ivals
		, guaranteedUnique || ai == bi
		, r <- return $ (ai == bi) == (av `eq` bv)
		]

-- | v3normalize specialized to 'Double'.
v3normalized :: Vec3 Double -> Vec3 Double
v3normalized = v3normalize

tests :: TestTree
tests = testGroup "Immutaball.Share.Math.Core" $
	[
		testCase "simpleConstant == 3" $
			simpleConstant @?= 3,

		testGroup "meta tests" $
			[
				testCase "right3 == right3" $
					right3 `eq3Duplicate` right3 @?= True,
				testCase "right3 /= forward3" $
					right3 `eq3Duplicate` forward3 @?= False,
				testCase "each axis unit vector equality checks correctly with each" $
					and [r | axes <- return $ zip [zint..] [right3, forward3, up3], (ai, av) <- axes, (bi, bv) <- axes, r <- return $ (ai == bi) == (av `eq3Duplicate` bv)] @?= True,
				testCase "each axis unit vector equality checks correctly with each" $
					eqEachEach True eq3Duplicate [right3, forward3, up3] @?= True
			],

		testGroup "eq3 tests" $
			[
				testCase "right3 == right3" $
					right3 `eq3` right3 @?= True,
				testCase "right3 /= forward3" $
					right3 `eq3` forward3 @?= False,
				testCase "each axis unit vector equality checks correctly with each" $
					and [r | axes <- return $ zip [zint..] [right3, forward3, up3], (ai, av) <- axes, (bi, bv) <- axes, r <- return $ (ai == bi) == (av `eq3` bv)] @?= True,
				testCase "each axis unit vector equality checks correctly with each" $
					eqEachEach True eq3 [right3, forward3, up3] @?= True
			],

		testGroup "eqEachEach for vecs and mats" $
			[
				testGroup "randomly generated" $
					[
						testProperty "eqEachEach random vec2" $
							\(vals :: [Vec2 Double]) -> eqEachEach False eq2 vals,
						testProperty "eqEachEach random vec3" $
							\(vals :: [Vec3 Double]) -> eqEachEach False eq3 vals,
						testProperty "eqEachEach random vec4" $
							\(vals :: [Vec4 Double]) -> eqEachEach False eq4 vals,
						testProperty "eqEachEach random mat3" $
							\(vals :: [Mat3 Double]) -> eqEachEach False eqm3 vals,
						testProperty "eqEachEach random mat4" $
							\(vals :: [Mat4 Double]) -> eqEachEach False eqm4 vals
					],

				testGroup "fixed" $
					[
						testCase "eqEachEach fixed vec2" $
							eqEachEach True eq2 [pure zdouble, pure 2.0, pure 3.5, pure $ -1.0] @?= True,
						testCase "eqEachEach fixed vec3" $
							eqEachEach True eq3 [pure zdouble, pure 2.0, pure 3.5, pure $ -1.0] @?= True,
						testCase "eqEachEach fixed vec4" $
							eqEachEach True eq4 [pure zdouble, pure 2.0, pure 3.5, pure $ -1.0] @?= True,
						testCase "eqEachEach fixed mat3" $
							eqEachEach True eqm3 [pure zdouble, pure 2.0, pure 3.5, pure $ -1.0] @?= True,
						testCase "eqEachEach fixed mat4" $
							eqEachEach True eqm4 [pure zdouble, pure 2.0, pure 3.5, pure $ -1.0] @?= True
					],

				testGroup "randomly generated, near" $
					[
						testProperty "eqEachEach random vec2 near" $
							\(vals :: [Vec2 Double]) -> eqEachEach False near2 vals,
						testProperty "eqEachEach random vec3 near" $
							\(vals :: [Vec3 Double]) -> eqEachEach False near3 vals,
						testProperty "eqEachEach random vec4 near" $
							\(vals :: [Vec4 Double]) -> eqEachEach False near4 vals,
						testProperty "eqEachEach random mat3 near" $
							\(vals :: [Mat3 Double]) -> eqEachEach False nearm3 vals,
						testProperty "eqEachEach random mat4 near" $
							\(vals :: [Mat4 Double]) -> eqEachEach False nearm4 vals
					]
			],

		testGroup "some normalization tests" $
			[
				testCase "normalizing 1,1,1 gets 1/sqrt 3 x3." $
					v3normalized (Vec3 1.0 1.0 1.0) `near3` v3normalize (Vec3 (1/sqrt 3) (1/sqrt 3) (1/sqrt 3)) @?= True,
				testCase "normalizing 1,2,3 gets /sqrt 14." $
					v3normalized (Vec3 1.0 2.0 3.0) `near3` v3normalize (Vec3 (1.0/sqrt 14) (2.0/sqrt 14) (3.0/sqrt 14)) @?= True
			],

		testGroup "3D pointing orientation utils (aiming) - using floats so that equality checks' precisions aren't too tight" $
			[
				testCase "aim right 1/8th circle" $
					--D.trace (printf "DEBUG0: left is %s and right is %s." (show $ aimHoriz3DSimple (circle/8) (Vec3 0.0 1.0 0.0)) (show $ (Vec3 (sqrt 0.5) (sqrt 0.5) 0.0))) $
					aimHoriz3DSimple (circle/8) (Vec3 0.0 1.0 0.0) `eq3` (Vec3 (sqrt 0.5) (sqrt 0.5) 0.0) @?= True,
				testCase "aim right 30 degrees" $
					aimHoriz3DSimple (circle/12) (Vec3 0.0 1.0 0.0) `eq3` (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) 0.0) @?= True,

				testCase "look 45 deg up from 30 deg right" $
					-- length of Vec2 x y should be equal to z here, so that it's a right angle.
					-- prenormalized:
					-- 	  (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) (sqrt $ x^2 + y^2))
					-- 	= (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) (sqrt $ 1/4 + 3/4))
					-- 	= (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) 1.0)
					-- prenormalized^.r: sqrt (1/4 + 3/4 + 1^2) = sqrt (1 + 1) = sqrt 2
					-- normalized:
					-- 	  (Vec3 (1.0      / 2.0) (sqrt 3.0 / 2.0) 1.0             ) / sqrt 2
					-- 	= (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0))
					--D.trace (printf "DEBUG0: left is %s and right is %s." (show $ aimVert3DSimple Nothing (circle/8) (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) 0.0)) (show $ Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0  :: Float))) $
					aimVert3DSimple Nothing (circle/8) (Vec3 (1.0 / 2.0) (sqrt 3.0 / 2.0) 0.0) `near3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)) @?= True,

				testProperty "aimVert on point in yz == rotateyzSimple *±1" $
					\(randomPointOnYz :: Vec2 Double) (randomPitchRadiansDown :: Double) ->
					let randomPoint = Vec3 0.0 (randomPointOnYz^.x2) (randomPointOnYz^.y2) in

					let planeRotateNeedsNegate = randomPoint^.y3 < 0 in

					-- Actual
					let byAimVert = aimVert3DSimple Nothing (-randomPitchRadiansDown) $ randomPoint in
					-- Expected
					let byPlaneRotate = rotateyzSimple (randomPitchRadiansDown * if' planeRotateNeedsNegate (-1.0) 1.0) `mv3` randomPoint in

					-- Optional debugging:
					--D.trace (printf "DEBUG1:\n\trandomPointOnYz: %s\n\trandomPitchRadiansDown: %s\n\trandomPoint: %s\n\tplaneRotateNeedsNegate: %s\n\tbyAimVert     (actual)   : %s\n\tbyPlaneRotate (expected) : %s" (show $ randomPointOnYz) (show $ randomPitchRadiansDown) (show $ randomPoint) (show $ planeRotateNeedsNegate) (show $ byAimVert) (show $ byPlaneRotate)) $

					byAimVert `near3` byPlaneRotate,

				testGroup "tilt3y" $
					[
						testCase "tilt3y on 0,1,0 gives same result (look 45 deg up from 30 deg right)" $
							tilt3ySimple (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)) `mv3` forward3 @?= (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)),
						testCase "tilt3y 0,1,0 on (look 45 deg up from 30 deg right) gives (look 45 deg up from 30 deg right) (no change)" $
							tilt3ySimple forward3 `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)) @?= (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)),
						testCase "tilt3y 1,0,0 on (look 45 deg up from 30 deg right) gives (look 45 deg up from 120 deg right) (just xy %~ *i**3 of last test's expected)" $
							(tilt3ySimple right3 `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0))) `near3` (Vec3 (sqrt 1.5 / 2.0) (-sqrt 2.0 / 4.0) (sqrt 2.0 / 2.0)) @?= True,
						testProperty "tilt3y == aimHoriz <> aimVert by near" $
							let v3normalize' v = v3normalize v `v3orWith` right3 in
							-- Apply a random camera target tilt to a random position.  (Camera's at origin.)
							\(relCamTarget_ :: Vec3 Double) (randomPos :: Vec3 Double) ->
							let relCamTarget = v3normalize' relCamTarget_ in
							let byTilt3y = tilt3ySimple relCamTarget `mv3` randomPos in
							let relCamTargetxy = Vec2 (relCamTarget^.x3) (relCamTarget^.y3) in
							let byAims = aimVert3DSimple Nothing ((Vec2 (relCamTargetxy^.r2) (relCamTarget^.z3))^.t2) . aimHoriz3DSimple (up2^.t2 - relCamTargetxy^.t2) $ randomPos in
							byTilt3y `near3` byAims,
						testCase "tilt3y 0,0,1 on (look 45 deg up from 30 deg right) gives (look 45 deg up from 30 deg right then yz %~ *i)" $
							(tilt3ySimple up3 `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0))) `near3` (Vec3 (sqrt 2.0 / 4.0) (-sqrt 2.0 / 2.0) (sqrt 1.5 / 2.0)) @?= True,
						testCase "tilt3y 0,0,-1 on (look 45 deg up from 30 deg right) gives (look 45 deg up from 30 deg right then yz %~ *i**3)" $
							--D.trace (printf "DEBUG0: left is %s and right is %s." (show $ updateit (tilt3ySimple (-up3) `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)))) (show $ (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (-sqrt 2.0 / 2.0)))) $
							(tilt3ySimple (-up3) `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0))) `near3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 2.0 / 2.0) (-sqrt 1.5 / 2.0)) @?= True
					],

				testGroup "tilt3z" $
					[
						testCase "tilt3z on 0,0,1 gives same result (look 45 deg up from 30 deg right)" $
							tilt3zSimple (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)) `mv3` up3 @?= (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)),
						testCase "tilt3z 0,0,1 on (look 45 deg up from 30 deg right) gives (look 45 deg up from 30 deg right) (no change)" $
							tilt3zSimple up3 `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)) @?= (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0)),
						-- Roll right a right angle.
						testCase "tilt3z 1,0,0 on (look 45 deg up from 30 deg right) gives (just xz %~ *i**3 of last test's expected)" $
							(tilt3zSimple right3 `mv3` (Vec3 (sqrt 2.0 / 4.0) (sqrt 1.5 / 2.0) (sqrt 2.0 / 2.0))) `near3` (Vec3 (sqrt 2.0 / 2.0) (sqrt 1.5 / 2.0) (-sqrt 2.0 / 4.0)) @?= True,
						testProperty "tilt3z == aimHoriz (yaw) <> rotateyz (pitch) (±aimVert by relUp) <> unaimHoriz (yaw) by near" $
							let v3normalize' v = v3normalize v `v3orWith` right3 in
							-- Apply a random up vector to a random position.
							\(relUp_ :: Vec3 Double) (randomPos :: Vec3 Double) ->
							let relUp = v3normalize' relUp_ `v3nsElse` up3 in
							-- Calculate the radians to aim right by with aimHoriz3DSimple.
							let yawRadiansRight = -(((relUp^.xy3) `v2nzElse` up2)^.t2 - up2^.t2) in
							-- Calculate the -radians to look down by.
							let pitchRadiansDown = acos $ relUp^.z3 in
							let pitchRadiansUp   = -pitchRadiansDown in

							-- Actual
							let byTilt3z = tilt3zSimple relUp `mv3` randomPos in

							-- Expected (by plane rotations)
							--let byYawPitch = aimHoriz3DSimple yawRadiansRight . aimVert3DSimple Nothing pitchRadiansUp . aimHoriz3DSimple (-yawRadiansRight) $ randomPos in  -- Incorrect result: can horizontally aim again.
							let byYawPitch = aimHoriz3DSimple yawRadiansRight . (\v -> rotateyzSimple (-pitchRadiansUp) `mv3` v) . aimHoriz3DSimple (-yawRadiansRight) $ randomPos in

							-- Optional debugging:
							--D.trace (printf "DEBUG0:\n\trelUp: %s\n\trandomPos: %s\n\tbyTilt3z: %s\n\tbyYawPitch: %s" (show $ relUp) (show $ randomPos) (show $ byTilt3z) (show $ byYawPitch)) $
							-- Optional verbose debugging:
							--D.trace (printf "DEBUG0:\n\trelUp: %s\n\trandomPos: %s\n\tbyTilt3z: %s\n\tbyYawPitch: %s\n\n\tyawRadiansRight: %s\n\tpitchRadiansUp: %s" (show $ relUp) (show $ randomPos) (show $ byTilt3z) (show $ byYawPitch) (show $ yawRadiansRight) (show $ pitchRadiansUp)) $

							byTilt3z `near3` byYawPitch
					]
			]
	]