src/FunctionValues.hs

   1 -- | The FunctionValues module contains the 'FunctionValues' type and
   2 --   the functions used to manipulate it.
   3 module FunctionValues
   4 where
   5
   6 import Prelude hiding (LT)
   7 import Test.QuickCheck (Arbitrary(..), choose)
   8
   9 import Cardinal
  10
  11 -- | The FunctionValues type represents the value of our function f at
  12 --   the 27 points surrounding (and including) the center of a
  13 --   cube. Each value of f can be accessed by the name of its
  14 --   direction.
  15 data FunctionValues =
  16     FunctionValues { front  :: Double,
  17                      back   :: Double,
  18                      left   :: Double,
  19                      right  :: Double,
  20                      top    :: Double,
  21                      down   :: Double,
  22                      front_left :: Double,
  23                      front_right :: Double,
  24                      front_down :: Double,
  25                      front_top :: Double,
  26                      back_left :: Double,
  27                      back_right :: Double,
  28                      back_down :: Double,
  29                      back_top :: Double,
  30                      left_down :: Double,
  31                      left_top :: Double,
  32                      right_down :: Double,
  33                      right_top :: Double,
  34                      front_left_down :: Double,
  35                      front_left_top :: Double,
  36                      front_right_down :: Double,
  37                      front_right_top :: Double,
  38                      back_left_down :: Double,
  39                      back_left_top :: Double,
  40                      back_right_down :: Double,
  41                      back_right_top :: Double,
  42                      interior :: Double }
  43       deriving (Eq, Show)
  44
  45
  46 instance Arbitrary FunctionValues where
  47     arbitrary = do
  48       front'  <- choose (min_double, max_double)
  49       back'   <- choose (min_double, max_double)
  50       left'   <- choose (min_double, max_double)
  51       right'  <- choose (min_double, max_double)
  52       top'    <- choose (min_double, max_double)
  53       down'   <- choose (min_double, max_double)
  54       front_left' <- choose (min_double, max_double)
  55       front_right' <- choose (min_double, max_double)
  56       front_top' <- choose (min_double, max_double)
  57       front_down' <- choose (min_double, max_double)
  58       back_left' <- choose (min_double, max_double)
  59       back_right' <- choose (min_double, max_double)
  60       back_top' <- choose (min_double, max_double)
  61       back_down' <- choose (min_double, max_double)
  62       left_top' <- choose (min_double, max_double)
  63       left_down' <- choose (min_double, max_double)
  64       right_top' <- choose (min_double, max_double)
  65       right_down' <- choose (min_double, max_double)
  66       front_left_top' <- choose (min_double, max_double)
  67       front_left_down' <- choose (min_double, max_double)
  68       front_right_top' <- choose (min_double, max_double)
  69       front_right_down' <- choose (min_double, max_double)
  70       back_left_top' <- choose (min_double, max_double)
  71       back_left_down' <- choose (min_double, max_double)
  72       back_right_top' <- choose (min_double, max_double)
  73       back_right_down' <- choose (min_double, max_double)
  74       interior' <- choose (min_double, max_double)
  75
  76       return empty_values { front = front',
  77                             back  = back',
  78                             left  = left',
  79                             right = right',
  80                             top   = top',
  81                             down  = down',
  82                             front_left = front_left',
  83                             front_right = front_right',
  84                             front_top = front_top',
  85                             front_down = front_down',
  86                             back_left = back_left',
  87                             back_right = back_right',
  88                             back_top = back_top',
  89                             back_down = back_down',
  90                             left_top = left_top',
  91                             left_down = left_down',
  92                             right_top = right_top',
  93                             right_down = right_down',
  94                             front_left_top = front_left_top',
  95                             front_left_down = front_left_down',
  96                             front_right_top = front_right_top',
  97                             front_right_down = front_right_down',
  98                             back_left_top = back_left_top',
  99                             back_left_down = back_left_down',
 100                             back_right_top = back_right_top',
 101                             back_right_down = back_right_down',
 102                             interior = interior' }
 103       where
 104         -- | We perform addition with the function values contained in a
 105         --   FunctionValues object. If we choose random doubles near the machine
 106         --   min/max, we risk overflowing or underflowing the 'Double'. This
 107         --   places a reasonably safe limit on the maximum size of our generated
 108         --   'Double' members.
 109         max_double :: Double
 110         max_double = 10000.0
 111
 112         -- | See 'max_double'.
 113         min_double :: Double
 114         min_double = (-1) * max_double
 115
 116
 117 -- | Return a 'FunctionValues' with a bunch of zeros for data points.
 118 empty_values :: FunctionValues
 119 empty_values =
 120     FunctionValues 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 121
 122 -- | The eval function is where the magic happens for the
 123 --   FunctionValues type. Given a 'Cardinal' direction and a
 124 --   'FunctionValues' object, eval will return the value of the
 125 --   function f in that 'Cardinal' direction. Note that 'Cardinal' can
 126 --   be a composite type; eval is what performs the \"arithmetic\" on
 127 --   'Cardinal' directions.
 128 eval :: FunctionValues -> Cardinal -> Double
 129 eval f F = front f
 130 eval f B = back f
 131 eval f L = left f
 132 eval f R = right f
 133 eval f T = top f
 134 eval f D = down f
 135 eval f FL = front_left f
 136 eval f FR = front_right f
 137 eval f FD = front_down f
 138 eval f FT = front_top f
 139 eval f BL = back_left f
 140 eval f BR = back_right f
 141 eval f BD = back_down f
 142 eval f BT = back_top f
 143 eval f LD = left_down f
 144 eval f LT = left_top f
 145 eval f RD = right_down f
 146 eval f RT = right_top f
 147 eval f FLD = front_left_down f
 148 eval f FLT = front_left_top f
 149 eval f FRD = front_right_down f
 150 eval f FRT = front_right_top f
 151 eval f BLD = back_left_down f
 152 eval f BLT = back_left_top f
 153 eval f BRD = back_right_down f
 154 eval f BRT = back_right_top f
 155 eval f I   = interior f
 156 eval _ (Scalar x) = x
 157 eval f (Sum x y) = (eval f x) + (eval f y)
 158 eval f (Difference x y) = (eval f x) - (eval f y)
 159 eval f (Product x y) = (eval f x) * (eval f y)
 160 eval f (Quotient x y) = (eval f x) / (eval f y)
 161
 162 -- | Takes a three-dimensional list of 'Double' and a set of 3D
 163 --   coordinates (i,j,k), and returns the value at (i,j,k) in the
 164 --   supplied list. If there is no such value, zero is returned.
 165 value_at :: [[[Double]]] -> Int -> Int -> Int -> Double
 166 value_at values i j k
 167          | i < 0 = 0
 168          | j < 0 = 0
 169          | k < 0 = 0
 170          | length values <= k = 0
 171          | length (values !! k) <= j = 0
 172          | length ((values !! k) !! j) <= i = 0
 173          | otherwise = ((values !! k) !! j) !! i
 174
 175
 176 -- | Given a three-dimensional list of 'Double' and a set of 3D
 177 --   coordinates (i,j,k), constructs and returns the 'FunctionValues'
 178 --   object centered at (i,j,k)
 179 make_values :: [[[Double]]] -> Int -> Int -> Int -> FunctionValues
 180 make_values values i j k =
 181     empty_values { front  = value_at values (i-1) j k,
 182                    back   = value_at values (i+1) j k,
 183                    left   = value_at values i (j-1) k,
 184                    right  = value_at values i (j+1) k,
 185                    down   = value_at values i j (k-1),
 186                    top    = value_at values i j (k+1),
 187                    front_left = value_at values (i-1) (j-1) k,
 188                    front_right = value_at values (i-1) (j+1) k,
 189                    front_down =value_at values (i-1) j (k-1),
 190                    front_top = value_at values (i-1) j (k+1),
 191                    back_left = value_at values (i+1) (j-1) k,
 192                    back_right = value_at values (i+1) (j+1) k,
 193                    back_down = value_at values (i+1) j (k-1),
 194                    back_top = value_at values (i+1) j (k+1),
 195                    left_down = value_at values i (j-1) (k-1),
 196                    left_top = value_at values i (j-1) (k+1),
 197                    right_down = value_at values i (j+1) (k-1),
 198                    right_top = value_at values i (j+1) (k+1),
 199                    front_left_down = value_at values (i-1) (j-1) (k-1),
 200                    front_left_top = value_at values (i-1) (j-1) (k+1),
 201                    front_right_down = value_at values (i-1) (j+1) (k-1),
 202                    front_right_top = value_at values (i-1) (j+1) (k+1),
 203                    back_left_down = value_at values (i+1) (j-1) (k-1),
 204                    back_left_top = value_at values (i+1) (j-1) (k+1),
 205                    back_right_down = value_at values (i+1) (j+1) (k-1),
 206                    back_right_top = value_at values (i+1) (j+1) (k+1),
 207                    interior = value_at values i j k }
 208
 209 -- | Takes a 'FunctionValues' and a function that transforms one
 210 --   'Cardinal' to another (called a rotation). Then it applies the
 211 --   rotation to each element of the 'FunctionValues' object, and
 212 --   returns the result.
 213 rotate :: (Cardinal -> Cardinal) -> FunctionValues -> FunctionValues
 214 rotate rotation fv =
 215     FunctionValues { front  = eval fv (rotation F),
 216                      back   = eval fv (rotation B),
 217                      left   = eval fv (rotation L),
 218                      right  = eval fv (rotation R),
 219                      down   = eval fv (rotation D),
 220                      top    = eval fv (rotation T),
 221                      front_left = eval fv (rotation FL),
 222                      front_right = eval fv (rotation FR),
 223                      front_down = eval fv (rotation FD),
 224                      front_top = eval fv (rotation FT),
 225                      back_left = eval fv (rotation BL),
 226                      back_right = eval fv (rotation BR),
 227                      back_down = eval fv (rotation BD),
 228                      back_top = eval fv (rotation BT),
 229                      left_down = eval fv (rotation LD),
 230                      left_top = eval fv (rotation LT),
 231                      right_down = eval fv (rotation RD),
 232                      right_top = eval fv (rotation RT),
 233                      front_left_down = eval fv (rotation FLD),
 234                      front_left_top = eval fv (rotation FLT),
 235                      front_right_down = eval fv (rotation FRD),
 236                      front_right_top = eval fv (rotation FRT),
 237                      back_left_down = eval fv (rotation BLD),
 238                      back_left_top = eval fv (rotation BLT),
 239                      back_right_down = eval fv (rotation BRD),
 240                      back_right_top = eval fv (rotation BRT),
 241                      interior = interior fv }