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