module HeldKarpSet_Par
(makeTestTriple,
makePoint,
makeTestSet,
convertFloat,
getDistance, 
getPathDistance, 
triples, 
permShort, 
minTrip, 
minTripFib)
where
import qualified Data.List as List
import Data.Function.FastMemo
import Data.Word
import Data.FloatCast
import qualified Data.Set as Set
import Control.Parallel.Strategies

type Point = (Word32, Word32)

makeTestTriple :: Float -> Float -> Float -> Float -> [(Float, Float)] -> (Point, Point, Set.Set Point)
makeTestTriple x1 y1 x2 y2 trav = (makePoint x1 y1, makePoint x2 y2, Set.fromList (map (\(a,b) -> makePoint a b) trav))

makePoint :: Float -> Float -> Point
makePoint x y = (floatToWord x, floatToWord y)

makeTestSet :: Int -> Set.Set Point
makeTestSet n = Set.fromList [ makePoint (fromIntegral a) ((fromIntegral a) + 1) | a <- [1..n]]

convertFloat :: [Point] -> [(Float, Float)]
convertFloat pts = [(wordToFloat a, wordToFloat b) | (a, b) <- pts]

getDistance :: Point -> Point -> Word32
getDistance (x1, y1) (x2, y2) = floatToWord ((((wordToFloat x1 - wordToFloat x2) ** (2 :: Float)) + ((wordToFloat y1 - wordToFloat y2) ** (2 :: Float))) ** (0.5 :: Float))

getPathDistance :: Set.Set Point -> Word32
getPathDistance pts | (Set.size pts) < 2 = floatToWord 0.0
                    | otherwise = floatToWord (sum (map wordToFloat (zipWith (getDistance) pt_lst pt_tail)))
                                    where 
                                        pt_lst = Set.toList pts
                                        pt_tail = tail pt_lst


triples :: Point -> [Point] -> [(Point, Point, [Point])]
triples start_pt points = [(start, end, trav) | start <- points, end <- points, start == start_pt, start /= end, let trav = List.delete start $ List.delete end points]

permShort :: [Point] -> [[Point]]
permShort xs = [ x : [y | y <- xs, y /= x] | x <- xs ] `using` parList rpar

minTrip :: (Point, Point, Set.Set Point) -> Word32
minTrip (start_pt, end_pt, pts) | Set.size pts == 0 = getDistance start_pt end_pt
                                | Set.size pts == 1 = floatToWord (wordToFloat (getDistance start_pt (Set.elemAt 0 pts)) + wordToFloat (getDistance (Set.elemAt 0 pts) end_pt))
                                | otherwise = floatToWord (wordToFloat (getDistance end_pt first_elem) + wordToFloat (minimum (map minTrip [(start_pt, first_elem, Set.fromList ps) | ps <- pms])))
                                                where
                                                    first_elem = Set.elemAt 0 pts
                                                    pms = permShort . Set.toList . snd $ (Set.splitAt 1 pts)
 
                                               
minTripFib :: (Point, Point, Set.Set Point) -> Word32
minTripFib = memoize $ \(start_pt, end_pt, pts) -> case Set.size pts of 
        0 -> getDistance start_pt end_pt
        1 -> floatToWord (wordToFloat (getDistance start_pt first_elem) + wordToFloat (getDistance first_elem end_pt))
            where
                first_elem = Set.elemAt 0 pts
        _ -> floatToWord (wordToFloat (getDistance end_pt first_elem) + wordToFloat (minimum (parMap rpar minTripFib [(start_pt, first_elem, Set.fromList ps) | ps <- pms]))) --parmap rpar
            where
                first_elem = Set.elemAt 0 pts
                pms = permShort . Set.toList . snd $ (Set.splitAt 1 pts)                

