1 
    2 -- ==========================================================--
    3 -- === Miscellaneous stuff for the frontiers algorithm.   ===--
    4 -- ===                                    FrontierMisc.hs ===--
    5 -- ==========================================================--
    6 
    7 module FrontierMisc2 where
    8 import BaseDefs
    9 import Utils
   10 import MyUtils
   11 import AbstractVals2
   12 import SuccsAndPreds2
   13 import AbstractMisc
   14 
   15 
   16 
   17 -- ==========================================================--
   18 --
   19 fsZULB :: Rep -> Rep -> Rep
   20 
   21 fsZULB (RepTwo fru) (RepTwo frl)
   22    = RepTwo (fsZULB_2 fru frl)
   23 
   24 fsZULB (Rep1 lfu hfsu) (Rep1 lfl hfsl)
   25    = Rep1 (fsZULB_2 lfu lfl) (myZipWith2 fsZULB hfsu hfsl)
   26 
   27 fsZULB (Rep2 lfu mfu hfsu) (Rep2 lfl mfl hfsl)
   28    = Rep2 (fsZULB_2 lfu lfl) (fsZULB_2 mfu mfl) (myZipWith2 fsZULB hfsu hfsl)
   29 
   30 fsZULB_2 (Min1Max0 aru f1u f0u) (Min1Max0 arl f1l f0l)
   31    = Min1Max0 aru f1l f0u
   32 
   33 
   34 -- ==========================================================--
   35 --
   36 fmSelect :: Int ->
   37             [FrontierElem] ->
   38             [FrontierElem] ->
   39             Bool ->
   40             Maybe FrontierElem
   41 
   42 fmSelect a_rand up_space down_space fromTop
   43    = let min_max_pairs
   44             = take 30 [(mi, ma) | mi <- up_space,
   45                                     ma <- down_space, mi `avBelowEQfrel` ma]
   46          mmpl = length min_max_pairs
   47          n = a_rand `mod` mmpl
   48          selected_pair = min_max_pairs ## n
   49      in
   50          if null min_max_pairs
   51          then Nothing
   52          else 
   53          if fromTop
   54          then Just (second selected_pair)
   55          else Just (first  selected_pair)
   56 
   57 
   58 -- ==========================================================--
   59 --
   60 fmIsNothing :: Maybe a -> Bool
   61 
   62 fmIsNothing Nothing   = True
   63 fmIsNothing (Just _)  = False
   64 
   65 
   66 -- ==========================================================--
   67 --
   68 fmMaxIntersection :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
   69 
   70 fmMaxIntersection xx yy
   71    = avMaxfrel [ x `avGLBfrel` y | x <- xx, y <- yy ]
   72 
   73 
   74 -- ==========================================================--
   75 --
   76 fmMinIntersection :: [FrontierElem] -> [FrontierElem] -> [FrontierElem]
   77 
   78 fmMinIntersection xx yy
   79    = avMinfrel [ x `avLUBfrel` y | x <- xx, y <- yy ]
   80 
   81 
   82 -- ==========================================================--
   83 --
   84 fmReviseMinXX :: [Domain] ->
   85                  [FrontierElem] -> 
   86                  FrontierElem -> 
   87                  [FrontierElem]
   88 
   89 fmReviseMinXX ds trial_min_xx args
   90    = let (x_underneath, x_not_underneath)
   91             = splitList (`avBelowEQfrel` args) trial_min_xx
   92          optimised_result 
   93             = fmReviseMinXX_aux
   94                     (fmMinIntersection x_underneath (spSuccsFrel ds args))
   95                     x_not_underneath
   96          fmReviseMinXX_aux xs ys 
   97             = if     length xs < length ys 
   98               then   foldr avMinAddPtfrel xs ys
   99               else   foldr avMinAddPtfrel ys xs
  100      in
  101          optimised_result
  102 
  103 
  104 -- ==========================================================--
  105 --
  106 fmReviseMaxYY :: [Domain] -> 
  107                  [FrontierElem] -> 
  108                  FrontierElem -> 
  109                  [FrontierElem]
  110 
  111 fmReviseMaxYY ds trial_max_yy args
  112    = let (y_above, y_not_above)
  113             = splitList (args `avBelowEQfrel`) trial_max_yy
  114          optimised_result
  115             = fmReviseMaxYY_aux
  116                     y_not_above
  117                     (fmMaxIntersection y_above (spPredsFrel ds args))
  118          fmReviseMaxYY_aux xs ys
  119             = if    length xs > length ys
  120               then  foldr avMaxAddPtfrel xs ys
  121               else  foldr avMaxAddPtfrel ys xs
  122      in
  123          optimised_result
  124 
  125 
  126 -- ==========================================================--
  127 -- === end                                FrontierMisc.hs ===--
  128 -- ==========================================================--