THypersurface.hs

{-# LANGUAGE AllowAmbiguousTypes, DataKinds #-}

--{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}
-- {-# LANGUAGE ConstrainedClassMethods, UndecidableInstances, MultiParamTypeClasses #-}


module TPolynomial.THypersurface (testsHypersurface) where


import Test.Tasty
import Test.Tasty.HUnit as HU
import Data.List
import Core
import qualified Data.Map.Strict as MS 

x, y :: Polynomial (Tropical Integer) Lex 2
x = variable 0
y = variable 1

f1 = 1*x^2 + x*y + 1*y^2 + x + y + 2
f2 = 3*x^2 + x*y + 3*y^2 + 1*x + 1*y + 0
f3 = 3*x^3 + 1*x^2*y + 1*x*y^2 + 3*y^3 + 1*x^2 + x*y + 1*y^2 + 1*x + 1*y + 3
f4 = x^3 + x^2*y + x*y^2 + y^3 + x^2 + x*y + y^2 + x + y + 0
f5 = 2*x*y^^(-1) + 2*y^^(-1) + (-2)


-- Normals 
-- (ne (northEast): means that the diagonal component points to north-east direction)
-- (nw (northWest): means that the diagonal component points to north-west direction)
-- (se (southEast): means that the diagonal component points to south-east direction)
-- (sw (southWest): means that the diagonal component points to south-west direction)


ne = sort [(1,1), (-1, 0), (0, -1)]
nw = sort [(-1,1), (1, 0), (0, -1)]
se = sort [(1,-1), (-1, 0), (0, 1)]
sw = sort [(-1,-1), (1, 0), (0, 1)]


testMapTermPoint :: TestTree
testMapTermPoint =   HU.testCase "Get the key-value pair with the terms and its corresponding points" $ do
        show (mapTermPoint f1) @?=  "fromList [((0,0),(,2)),((0,1),(X_1,0)),((0,2),(X_1^2,1)),((1,0),(X_0,0)),((1,1),(X_0X_1,0)),((2,0),(X_0^2,1))]"
 

testFindFanVertex :: TestTree
testFindFanVertex = HU.testCase "Computing fan vertices" $ do
        findFanNVertex (mapTermPoint f1) [(0,0), (0,1), (1,0)] @?= ((2,2), sw)
        findFanNVertex (mapTermPoint f1) [(1,1), (0,1), (1,0)] @?= ((0,0), ne)
        findFanNVertex (mapTermPoint f1) [(2,0), (1,1), (1,0)] @?= ((-1,0),sw)
        findFanNVertex (mapTermPoint f1) [(0,2), (0,1), (1,1)] @?= ((0,-1),sw)
        findFanNVertex (mapTermPoint f5) [(1,-1), (0,-1), (0,0)] @?= ((0,4), sw)

testInnerNormals :: TestTree
testInnerNormals = HU.testCase "Compute inner normals of triangles" $ do
        sort (innerNormals (0,0) (0,1) (1,0)) @?= sort [(-1,-1), (1,0), (0,1)]

testVerticesNormals :: TestTree
testVerticesNormals = HU.testCase "Test for vertices and their normals" $ do
        (verticesNormals f1) @?= MS.fromList [ ((2,2), sw), ((0,0), ne), ((-1,0), sw), ((0,-1), sw)]
        (verticesNormals f2) @?= MS.fromList [((-2,1), sw), ((-1,1), se), ((1,-1), nw), ((1,-2), sw)]
        (verticesNormals f3) @?= MS.fromList [((-2,0), sw), ((-1,0), ne), ((0,1), sw), ((1,1), ne), ((2,2), sw), ((1,0), sw), ((0,-1), ne), ((0,-2), sw), ((-1,-1), sw)]
        (verticesNormals f4) @?= MS.fromList [((0,0), sw)]
        (verticesNormals f5) @?= MS.fromList [((0,4), sw)]
        
-- testHypersurface :: TestTree
-- testHypersurface = HU.testCase "Compute hypersurface of polynomials" $ do
--         (sort $ hypersurface f4) @?= sort [((0,0), (0,1)), ((0,0), (1,0)), ((0,0), (-1,-1))]
--         (sort $ hypersurface f5) @?= sort [((0,4), (0,5)), ((0,4), (1,4)), ((0,4), (-1, 3))]


testsHypersurface :: TestTree
testsHypersurface = testGroup "Test for Computing Hypersurfaces" [testMapTermPoint, testFindFanVertex, testInnerNormals, testVerticesNormals]