Exference.hs

{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE MultiWayIf #-}

module Language.Haskell.Exference
  ( findExpressions
  , findOneExpression
  , findSortNExpressions
  , findBestNExpressions
  , findFirstBestExpressions
  , takeFindSortNExpressions
  , findFirstExpressionLookahead
  , findFirstBestExpressionsLookahead
  , findFirstBestExpressionsLookaheadPreferNoConstraints
  , ExferenceInput ( .. )
  , ExferenceOutputElement
  , ExferenceStats (..)
  )
where



import Language.Haskell.Exference.Core

import Language.Haskell.Exference.Core.ExferenceStats

import Data.Maybe ( maybeToList, listToMaybe, fromMaybe )
import Control.Arrow ( first, second, (***) )
import Control.Monad ( guard, mzero )
import Control.Applicative ( (<$>), (<*>) )
import Data.List ( partition, sortBy, groupBy, minimumBy )
import Data.Ord ( comparing )
import Data.Function ( on )

import Debug.Trace



-- returns the first found solution (not necessarily the best overall)
findOneExpression :: ExferenceInput
                  -> Maybe ExferenceOutputElement
findOneExpression = listToMaybe . findExpressions

-- calculates at most n solutions, sorts by rating, returns the first m
takeFindSortNExpressions :: Int
                         -> Int
                         -> ExferenceInput
                         -> [ExferenceOutputElement]
takeFindSortNExpressions m n =
  take m . findSortNExpressions n

-- calculates at most n solutions, and returns them sorted by their rating
findSortNExpressions :: Int
                     -> ExferenceInput
                     -> [ExferenceOutputElement]
findSortNExpressions n input = sortBy (comparing g) $ take n $ r
  where
    r = findExpressions input
    g (_, _, ExferenceStats _ f _) = f

-- returns the first expressions with the best rating.
-- best explained on examples:
--   []      -> []
--   [2,5,5] -> [2]
--   [3,3,3,4,4,5,6,7] -> [3,3,3]
--   [2,5,2] -> [2] -- will not look past worse ratings
--   [4,3,2,2,2,3] -> [2,2,2] -- if directly next is better, switch to that
findFirstBestExpressions :: ExferenceInput
                         -> [ExferenceOutputElement]
findFirstBestExpressions input
  | r <- findExpressions input
  , f <- head . groupBy (\(~(_, _, stats1)) (~(_, _, stats2)) -> 
                              exference_complexityRating stats1
                           >= exference_complexityRating stats2)
  = case r of
    [] -> []
    _  -> f $ reverse $ f $ r

-- tries to find the best solution by performing a limitted amount of steps,
-- resetting the count whenever a better solution is found.
-- "finds the "first" (by some metric) local maximum"
-- advantages:
--   - might be able to find a "best" solution quicker than other approaches
--   - does not calculate the maximum amount of steps when there is no
--     solution left.
-- disadvantages:
--   - might find only a local optimum
findFirstExpressionLookahead :: Int
                             -> ExferenceInput
                             -> Maybe ExferenceOutputElement
findFirstExpressionLookahead n = f 999999 Nothing . findExpressionsChunked
  where
    f :: Int
      -> Maybe ExferenceOutputElement
      -> [[ExferenceOutputElement]]
      -> Maybe ExferenceOutputElement
    f _ best     []      = best
    f 0 best     _       = best
    f r best     ([]:sr) = f (r-1) best sr
    f _ Nothing  (s:sr)  = f n (Just $ minElem s) sr
    f r (Just (b@(_, _, statsB))) (s:sr) 
                         | sbest@(_, _, statsBest) <- minElem s
                         , exference_complexityRating statsBest
                         < exference_complexityRating statsB
                         = f n (Just sbest) sr
                         | otherwise = f (r-1) (Just b) sr
    minElem :: [ExferenceOutputElement] -> ExferenceOutputElement
    minElem = minimumBy (\(~(_, _, stats1)) (~(_, _, stats2)) ->
                           compare (exference_complexityRating stats1)
                                   (exference_complexityRating stats2))

-- a combination of the return-multiple-if-same-rating and the
-- look-some-steps-ahead-for-better-solution functionalities.
-- for example,
-- [2,3,2,2,4,5,6,7] -> [2,2,2]
--  does not stop at 3, but looks ahead, then returns all the 2-rated solutions
findFirstBestExpressionsLookahead :: Int
                                  -> ExferenceInput
                                  -> [ExferenceOutputElement]
findFirstBestExpressionsLookahead n =
  f 999999 99999.9 [] . findExpressionsChunked
 where
  f :: Int
    -> Float
    -> [ExferenceOutputElement]
    -> [[ExferenceOutputElement]]
    -> [ExferenceOutputElement]
  f _ _ ss []           = ss
  f 0 _ ss _            = ss
  f i r ss ([]:qss)     = f (i-1) r ss qss
  f i r ss ((q@(_, _, statsQ):qs):qss)
                        | rq <- exference_complexityRating statsQ
                        = if
                        | rq < r    -> f n rq [q] (qs:qss)
                        | rq == r   -> f n r (q:ss) (qs:qss)
                        | otherwise -> f i r ss (qs:qss)

-- a combination of the return-multiple-if-same-rating and the
-- look-some-steps-ahead-for-better-solution functionalities.
-- for example,
-- [2,3,2,2,4,5,6,7] -> [2,2,2]
--  does not stop at 3, but looks ahead, then returns all the 2-rated solutions
findFirstBestExpressionsLookaheadPreferNoConstraints :: Int
                                                     -> ExferenceInput
                                                     -> [ExferenceOutputElement]
findFirstBestExpressionsLookaheadPreferNoConstraints n =
  f 999999 99999.9 [] [] . findExpressionsChunked
 where
  f :: Int
    -> Float
    -> [ExferenceOutputElement] -- solutions without constraints
    -> [ExferenceOutputElement] -- solution(s) with constraints
    -> [[ExferenceOutputElement]]
    -> [ExferenceOutputElement]
  -- out of potential solutions, nothing constraint-free found
  f _ _ [] ssc []           = ssc
  -- out of potential solutions, found good stuff
  f _ _ ss _   []           = ss
  -- out of lookahead, return what we have (ss wont be null)
  f 0 _ ss _   _            = ss
  -- simple reduce when no good solutions yet
  f i r [] ssc ([]:qss)     = f i r [] ssc qss
  -- lookahead step when we already have some good solution
  f i r ss ssc ([]:qss)     = f (i-1) r ss ssc qss
  -- finding one/the first good solution
  f i r ss _   ((q@(_, [], statsQ):qs):qss)
                        | rq <- exference_complexityRating statsQ
                        = if
                        | null ss   -> f n rq [q] [] (qs:qss)
                        | rq < r    -> f n rq [q] [] (qs:qss)
                        | rq == r   -> f n r (q:ss) [] (qs:qss)
                        | otherwise -> f i r ss [] (qs:qss)
  -- finding a bad solution when there are no good solutions yet
  f i r [] ssc ((q@(_, _, statsQ):qs):qss)
                        | rq <- exference_complexityRating statsQ
                        = if
                        | rq < r    -> f i rq [] [q] (qs:qss)
                        | rq == r   -> f i r [] (q:ssc) (qs:qss)
                        | otherwise -> f i r [] ssc (qs:qss)
  -- finding a bad solution when we already have good solutions
  f i r ss _   ((_:qs):qss) = f (i-1) r ss [] (qs:qss)

-- like findSortNExpressions, but retains only the best rating
findBestNExpressions :: Int
                     -> ExferenceInput
                     -> [ExferenceOutputElement]
findBestNExpressions n input
  | r <- findSortNExpressions n input
  = case r of
    [] -> []
    _  -> head $ groupBy (\(~(_, _, stats1)) (~(_, _, stats2)) -> 
                              exference_complexityRating stats1
                           >= exference_complexityRating stats2)
                         r