module Hoogle.Score.Scoring(scoring) where
import Hoogle.Score.Type
import Data.List
import Control.Arrow
import Data.Ord
import Data.Maybe
import Control.Monad
import System.Random
scoring :: [(Score,Score)] -> IO String
scoring xs = do
let cost ys = sum [max 0 $ 1 + vals a vals b | (a,b) <- xs
,let vals = sum . map (fromRange . fromJust . flip lookup ys) . scoreCosts]
config <- solveConfig cost [(x::TypeCost, toRange [1..10]) | x <- [minBound..maxBound]]
return $ unlines ["cost " ++ show a ++ " = " ++ show (fromRange b) | (a,b) <- config]
type Cost = Int
data Range a = Range [a] a [a] deriving Show
toRange (x:xs) = Range [] x xs
fromRange (Range _ x _) = x
type Config = [(TypeCost,Range Int)]
bestConfig f = snd . minimumBy (comparing fst) . map (f &&& id)
nextRange (Range a b c) = [Range as a (b:c) | a:as <- [a]] ++ [Range (b:a) c cs | c:cs <- [c]]
nextConfig = perturb $ \(a,b) -> map ((,) a) $ nextRange b
randomRange (Range x y z) = do
let xs = reverse x ++ y:z
i <- randomRIO (0,length xs1)
let (x2,y2:z2) = splitAt i xs
return $ Range (reverse x2) y2 z2
randomConfig = mapM $ \(a,b) -> fmap ((,) a) $ randomRange b
improveConfig :: (Config -> Cost) -> Config -> Config
improveConfig f now | f next < f now = improveConfig f next
| otherwise = now
where next = bestConfig f $ nextConfig now
solveConfig :: (Config -> Cost) -> Config -> IO Config
solveConfig f x = fmap (bestConfig f) $ replicateM 25 $ do
putChar '.'
y <- randomConfig x
let z = improveConfig f y
print (f y,f z)
return z
perturb :: (a -> [a]) -> [a] -> [[a]]
perturb f [] = [[]]
perturb f (x:xs) = map (:xs) (f x) ++ map (x:) (perturb f xs)