From 1cd0b90dae4b2a0ea35447427e7962b6fe053308 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 4 Oct 2011 15:00:08 -0400 Subject: [PATCH] Performance improvement: don't compute coefficients by 'eval'ing Cardinals. --- src/Tetrahedron.hs | 248 +++++++++++++++++++++++---------------------- 1 file changed, 129 insertions(+), 119 deletions(-) diff --git a/src/Tetrahedron.hs b/src/Tetrahedron.hs index a7b4047..f3b5319 100644 --- a/src/Tetrahedron.hs +++ b/src/Tetrahedron.hs @@ -25,9 +25,8 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) -import Cardinal import Comparisons ((~=), nearly_ge) -import FunctionValues +import FunctionValues (FunctionValues(..), empty_values) import Misc (factorial) import Point import RealFunction @@ -161,123 +160,134 @@ beta t i j k l -- Zeilfelder, pp. 84-86. If incorrect indices are supplied, the -- function will simply error. c :: Tetrahedron -> Int -> Int -> Int -> Int -> Double -c t 0 0 3 0 = eval (function_values t) $ - (1/8) * (I + F + L + T + LT + FL + FT + FLT) - -c t 0 0 0 3 = eval (function_values t) $ - (1/8) * (I + F + R + T + RT + FR + FT + FRT) - -c t 0 0 2 1 = eval (function_values t) $ - (5/24)*(I + F + T + FT) + - (1/24)*(L + FL + LT + FLT) - -c t 0 0 1 2 = eval (function_values t) $ - (5/24)*(I + F + T + FT) + - (1/24)*(R + FR + RT + FRT) - -c t 0 1 2 0 = eval (function_values t) $ - (5/24)*(I + F) + - (1/8)*(L + T + FL + FT) + - (1/24)*(LT + FLT) - -c t 0 1 0 2 = eval (function_values t) $ - (5/24)*(I + F) + - (1/8)*(R + T + FR + FT) + - (1/24)*(RT + FRT) - -c t 0 1 1 1 = eval (function_values t) $ - (13/48)*(I + F) + - (7/48)*(T + FT) + - (1/32)*(L + R + FL + FR) + - (1/96)*(LT + RT + FLT + FRT) - -c t 0 2 1 0 = eval (function_values t) $ - (13/48)*(I + F) + - (17/192)*(L + T + FL + FT) + - (1/96)*(LT + FLT) + - (1/64)*(R + D + FR + FD) + - (1/192)*(RT + LD + FRT + FLD) - -c t 0 2 0 1 = eval (function_values t) $ - (13/48)*(I + F) + - (17/192)*(R + T + FR + FT) + - (1/96)*(RT + FRT) + - (1/64)*(L + D + FL + FD) + - (1/192)*(RD + LT + FLT + FRD) - -c t 0 3 0 0 = eval (function_values t) $ - (13/48)*(I + F) + - (5/96)*(L + R + T + D + FL + FR + FT + FD) + - (1/192)*(RT + RD + LT + LD + FRT + FRD + FLT + FLD) - -c t 1 0 2 0 = eval (function_values t) $ - (1/4)*I + - (1/6)*(F + L + T) + - (1/12)*(LT + FL + FT) - -c t 1 0 0 2 = eval (function_values t) $ - (1/4)*I + - (1/6)*(F + R + T) + - (1/12)*(RT + FR + FT) - -c t 1 0 1 1 = eval (function_values t) $ - (1/3)*I + - (5/24)*(F + T) + - (1/12)*FT + - (1/24)*(L + R) + - (1/48)*(LT + RT + FL + FR) - -c t 1 1 1 0 = eval (function_values t) $ - (1/3)*I + - (5/24)*F + - (1/8)*(L + T) + - (5/96)*(FL + FT) + - (1/48)*(D + R + LT) + - (1/96)*(FD + LD + RT + FR) - -c t 1 1 0 1 = eval (function_values t) $ - (1/3)*I + - (5/24)*F + - (1/8)*(R + T) + - (5/96)*(FR + FT) + - (1/48)*(D + L + RT) + - (1/96)*(FD + LT + RD + FL) - -c t 1 2 0 0 = eval (function_values t) $ - (1/3)*I + - (5/24)*F + - (7/96)*(L + R + T + D) + - (1/32)*(FL + FR + FT + FD) + - (1/96)*(RT + RD + LT + LD) - -c t 2 0 1 0 = eval (function_values t) $ - (3/8)*I + - (7/48)*(F + T + L) + - (1/48)*(R + D + B + LT + FL + FT) + - (1/96)*(RT + BT + FR + FD + LD + BL) - -c t 2 0 0 1 = eval (function_values t) $ - (3/8)*I + - (7/48)*(F + T + R) + - (1/48)*(L + D + B + RT + FR + FT) + - (1/96)*(LT + BT + FL + FD + RD + BR) - -c t 2 1 0 0 = eval (function_values t) $ - (3/8)*I + - (1/12)*(T + R + L + D) + - (1/64)*(FT + FR + FL + FD) + - (7/48)*F + - (1/48)*B + - (1/96)*(RT + LD + LT + RD) + - (1/192)*(BT + BR + BL + BD) - -c t 3 0 0 0 = eval (function_values t) $ - (3/8)*I + - (1/12)*(T + F + L + R + D + B) + - (1/96)*(LT + FL + FT + RT + BT + FR) + - (1/96)*(FD + LD + BD + BR + RD + BL) - -c _ _ _ _ _ = error "coefficient index out of bounds" +c t i j k l = + coefficient i j k l + where + fvs = function_values t + f = front fvs + b = back fvs + r = right fvs + l' = left fvs + t' = top fvs + d = down fvs + fl = front_left fvs + fr = front_right fvs + fd = front_down fvs + ft = front_top fvs + bl = back_left fvs + br = back_right fvs + bd = back_down fvs + bt = back_top fvs + ld = left_down fvs + lt = left_top fvs + rd = right_down fvs + rt = right_top fvs + fld = front_left_down fvs + flt = front_left_top fvs + frd = front_right_down fvs + frt = front_right_top fvs + i' = interior fvs + + coefficient :: Int -> Int -> Int -> Int -> Double + coefficient 0 0 3 0 = + (1/8) * (i' + f + l' + t' + lt + fl + ft + flt) + + coefficient 0 0 0 3 = + (1/8) * (i' + f + r + t' + rt + fr + ft + frt) + + coefficient 0 0 2 1 = + (5/24)*(i' + f + t' + ft) + (1/24)*(l' + fl + lt + flt) + + coefficient 0 0 1 2 = + (5/24)*(i' + f + t' + ft) + (1/24)*(r + fr + rt + frt) + + coefficient 0 1 2 0 = + (5/24)*(i' + f) + (1/8)*(l' + t' + fl + ft) + + (1/24)*(lt + flt) + + coefficient 0 1 0 2 = + (5/24)*(i' + f) + (1/8)*(r + t' + fr + ft) + + (1/24)*(rt + frt) + + coefficient 0 1 1 1 = + (13/48)*(i' + f) + (7/48)*(t' + ft) + + (1/32)*(l' + r + fl + fr) + + (1/96)*(lt + rt + flt + frt) + + coefficient 0 2 1 0 = + (13/48)*(i' + f) + (17/192)*(l' + t' + fl + ft) + + (1/96)*(lt + flt) + + (1/64)*(r + d + fr + fd) + + (1/192)*(rt + ld + frt + fld) + + coefficient 0 2 0 1 = + (13/48)*(i' + f) + (17/192)*(r + t' + fr + ft) + + (1/96)*(rt + frt) + + (1/64)*(l' + d + fl + fd) + + (1/192)*(rd + lt + flt + frd) + + coefficient 0 3 0 0 = + (13/48)*(i' + f) + (5/96)*(l' + r + t' + d + fl + fr + ft + fd) + + (1/192)*(rt + rd + lt + ld + frt + frd + flt + fld) + + coefficient 1 0 2 0 = + (1/4)*i' + (1/6)*(f + l' + t') + + (1/12)*(lt + fl + ft) + + coefficient 1 0 0 2 = + (1/4)*i' + (1/6)*(f + r + t') + + (1/12)*(rt + fr + ft) + + coefficient 1 0 1 1 = + (1/3)*i' + (5/24)*(f + t') + + (1/12)*ft + + (1/24)*(l' + r) + + (1/48)*(lt + rt + fl + fr) + + coefficient 1 1 1 0 = + (1/3)*i' + (5/24)*f + + (1/8)*(l' + t') + + (5/96)*(fl + ft) + + (1/48)*(d + r + lt) + + (1/96)*(fd + ld + rt + fr) + + coefficient 1 1 0 1 = + (1/3)*i' + (5/24)*f + + (1/8)*(r + t') + + (5/96)*(fr + ft) + + (1/48)*(d + l' + rt) + + (1/96)*(fd + lt + rd + fl) + + coefficient 1 2 0 0 = + (1/3)*i' + (5/24)*f + + (7/96)*(l' + r + t' + d) + + (1/32)*(fl + fr + ft + fd) + + (1/96)*(rt + rd + lt + ld) + + coefficient 2 0 1 0 = + (3/8)*i' + (7/48)*(f + t' + l') + + (1/48)*(r + d + b + lt + fl + ft) + + (1/96)*(rt + bt + fr + fd + ld + bl) + + coefficient 2 0 0 1 = + (3/8)*i' + (7/48)*(f + t' + r) + + (1/48)*(l' + d + b + rt + fr + ft) + + (1/96)*(lt + bt + fl + fd + rd + br) + + coefficient 2 1 0 0 = + (3/8)*i' + (1/12)*(t' + r + l' + d) + + (1/64)*(ft + fr + fl + fd) + + (7/48)*f + + (1/48)*b + + (1/96)*(rt + ld + lt + rd) + + (1/192)*(bt + br + bl + bd) + + coefficient 3 0 0 0 = + (3/8)*i' + (1/12)*(t' + f + l' + r + d + b) + + (1/96)*(lt + fl + ft + rt + bt + fr) + + (1/96)*(fd + ld + bd + br + rd + bl) + + coefficient _ _ _ _ = error "coefficient index out of bounds" -- 2.43.2