From 01925d099b231a128f6bd51abd61bf9ff9c424b6 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 7 May 2011 18:14:46 -0400 Subject: [PATCH] Add the rest of the tetrahedron and tests. --- src/Cube.hs | 125 ++++++++++++++++++++++++++++++++++++++-------- src/Tests/Cube.hs | 48 ++++++++++++++++++ test/TestSuite.hs | 24 +++++++++ 3 files changed, 177 insertions(+), 20 deletions(-) diff --git a/src/Cube.hs b/src/Cube.hs index 4c70a41..b44f007 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -161,10 +161,10 @@ left_face :: Cube -> Face.Face left_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (-delta, -delta, delta) - v1' = (center c) + (delta, -delta, delta) - v2' = (center c) + (delta, -delta, -delta) - v3' = (center c) + (-delta, -delta, -delta) + v0' = (center c) + (delta, -delta, delta) + v1' = (center c) + (-delta, -delta, delta) + v2' = (center c) + (-delta, -delta, -delta) + v3' = (center c) + (delta, -delta, -delta) -- | The right (in the direction of y) face of the cube. @@ -172,10 +172,10 @@ right_face :: Cube -> Face.Face right_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) - v0' = (center c) + (-delta, delta, -delta) - v1' = (center c) + (delta, delta, -delta) - v2' = (center c) + (delta, delta, delta) - v3' = (center c) + (-delta, delta, delta) + v0' = (center c) + (-delta, delta, delta) + v1' = (center c) + (delta, delta, delta) + v2' = (center c) + (delta, delta, -delta) + v3' = (center c) + (-delta, delta, -delta) tetrahedron0 :: Cube -> Tetrahedron @@ -343,6 +343,94 @@ tetrahedron15 c = fv' = rotate (Tetrahedron.fv (tetrahedron12 c)) cwz +tetrahedron16 :: Cube -> Tetrahedron +tetrahedron16 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v0 (right_face c) + v3' = Face.v1 (right_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwz + + +tetrahedron17 :: Cube -> Tetrahedron +tetrahedron17 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v1 (right_face c) + v3' = Face.v2 (right_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) cwy + + +tetrahedron18 :: Cube -> Tetrahedron +tetrahedron18 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v2 (right_face c) + v3' = Face.v3 (right_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) (cwy . cwy) + + +tetrahedron19 :: Cube -> Tetrahedron +tetrahedron19 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (right_face c) + v2' = Face.v3 (right_face c) + v3' = Face.v0 (right_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron16 c)) ccwy + + +tetrahedron20 :: Cube -> Tetrahedron +tetrahedron20 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v0 (left_face c) + v3' = Face.v1 (left_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwz + + +tetrahedron21 :: Cube -> Tetrahedron +tetrahedron21 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v1 (left_face c) + v3' = Face.v2 (left_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy + + +tetrahedron22 :: Cube -> Tetrahedron +tetrahedron22 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v2 (left_face c) + v3' = Face.v3 (left_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy + + +tetrahedron23 :: Cube -> Tetrahedron +tetrahedron23 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (left_face c) + v2' = Face.v3 (left_face c) + v3' = Face.v0 (left_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron20 c)) ccwy + + tetrahedrons :: Cube -> [Tetrahedron] tetrahedrons c = [tetrahedron0 c, @@ -360,15 +448,12 @@ tetrahedrons c = tetrahedron12 c, tetrahedron13 c, tetrahedron14 c, - tetrahedron15 c - -- tetrahedron16 c, - -- tetrahedron17 c, - -- tetrahedron18 c, - -- tetrahedron19 c, - -- tetrahedron20 c, - -- tetrahedron21 c, - -- tetrahedron21 c, - -- tetrahedron22 c, - -- tetrahedron23 c, - -- tetrahedron24 c - ] + tetrahedron15 c, + tetrahedron16 c, + tetrahedron17 c, + tetrahedron18 c, + tetrahedron19 c, + tetrahedron20 c, + tetrahedron21 c, + tetrahedron22 c, + tetrahedron23 c] diff --git a/src/Tests/Cube.hs b/src/Tests/Cube.hs index 9c21311..5485046 100644 --- a/src/Tests/Cube.hs +++ b/src/Tests/Cube.hs @@ -210,3 +210,51 @@ prop_tetrahedron14_volumes_positive c = prop_tetrahedron15_volumes_positive :: Cube -> Bool prop_tetrahedron15_volumes_positive c = volume (tetrahedron15 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron16_volumes_positive :: Cube -> Bool +prop_tetrahedron16_volumes_positive c = + volume (tetrahedron16 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron17_volumes_positive :: Cube -> Bool +prop_tetrahedron17_volumes_positive c = + volume (tetrahedron17 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron18_volumes_positive :: Cube -> Bool +prop_tetrahedron18_volumes_positive c = + volume (tetrahedron18 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron19_volumes_positive :: Cube -> Bool +prop_tetrahedron19_volumes_positive c = + volume (tetrahedron19 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron20_volumes_positive :: Cube -> Bool +prop_tetrahedron20_volumes_positive c = + volume (tetrahedron20 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron21_volumes_positive :: Cube -> Bool +prop_tetrahedron21_volumes_positive c = + volume (tetrahedron21 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron22_volumes_positive :: Cube -> Bool +prop_tetrahedron22_volumes_positive c = + volume (tetrahedron22 c) > 0 + +-- | This pretty much repeats the prop_all_volumes_positive property, +-- but will let me know which tetrahedrons's vertices are disoriented. +prop_tetrahedron23_volumes_positive :: Cube -> Bool +prop_tetrahedron23_volumes_positive c = + volume (tetrahedron23 c) > 0 diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 057468b..20a2476 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -104,6 +104,30 @@ main = do putStr "prop_tetrahedron15_volumes_positive... " quickCheckWith qc_args prop_tetrahedron15_volumes_positive + putStr "prop_tetrahedron16_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron16_volumes_positive + + putStr "prop_tetrahedron17_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron17_volumes_positive + + putStr "prop_tetrahedron18_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron18_volumes_positive + + putStr "prop_tetrahedron19_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron19_volumes_positive + + putStr "prop_tetrahedron20_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron20_volumes_positive + + putStr "prop_tetrahedron21_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron21_volumes_positive + + putStr "prop_tetrahedron22_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron22_volumes_positive + + putStr "prop_tetrahedron23_volumes_positive... " + quickCheckWith qc_args prop_tetrahedron23_volumes_positive + putStr "prop_v0_all_equal... " quickCheckWith qc_args prop_v0_all_equal -- 2.43.2