# LANGUAGE BangPatterns , FlexibleInstances #

module SlopeTwo
    (
      SlopeOne
    , Count
    , RatingValue
    , Rating
    , empty
    , size
    , update
    , predict
    ) where

import Control.Parallel.Strategies
import qualified Data.Map as M
import Debug.Trace


type Count = Int
type RatingValue = Double

-- The Rating is the known (item,Rating) information for a particular "user"
type Rating item = M.Map item RatingValue

  The SlopeOne matrix is indexed by pairs of items and is implemented
-- as a sparse map of distinct ascending lists.  The 'update' and
-- 'predict' functions do not need the inner type to actually be a
-- map, so the list saves space and complexity.
newtype SlopeOne item = SlopeOne (M.Map item [Tup item])
  deriving (Eq, Show)
 
  Strict triple tuple type for SlopeOne internals
data Tup item = Tup {
      itemT :: !item
    , countT :: !Count
    , ratingT :: !RatingValue
    } deriving (Eq, Show)
 
empty :: SlopeOne item
empty = SlopeOne M.empty
 
size :: SlopeOne item -> Int
size (SlopeOne m) = M.size m

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = let (y,ys) = splitAt n xs
                in y:chunksOf n ys

instance NFData (Tup item)

unionsWith :: (Ord k, NFData k, NFData a) => (a->a->a) -> [M.Map k a] -> M.Map k a
unionsWith f ms = M.unionsWith f . parMap rwhnf (M.unionsWith f) $
                  trace ("l " ++ show (length ms)) $ chunksOf 100 ms

update :: (NFData item, Ord item) => SlopeOne item -> [Rating item] -> SlopeOne item
update s@(SlopeOne matrixIn) usersRatingsIn | null usersRatings = s
                                            | otherwise =
    SlopeOne . unionsWith mergeAdd . (matrixIn:) . parMap rwhnf fromRating $ usersRatings
  where usersRatings = filter ((1<) . M.size) usersRatingsIn
  fromRating converts a Rating into a Map of Lists , a singleton SlopeOne .
        fromRating userRatings = M.mapWithKey expand userRatings
          where expand item1 rating1 = map makeTup . M.toAscList . M.delete item1 $ userRatings
                  where makeTup (item2,rating2) = Tup item2 1 (rating1-rating2)
 
-- 'mergeAdd' is a helper for 'update'.
-- Optimized traversal of distinct ascending lists to perform additive merge.
mergeAdd :: Ord item => [Tup item] -> [Tup item] -> [Tup item]
mergeAdd xa@(x:xs) ya@(y:ys) =
  case compare (itemT x) (itemT y) of
    LT -> x : mergeAdd xs ya
    GT -> y : mergeAdd xa ys
    EQ -> Tup (itemT x) (countT x + countT y) (ratingT x + ratingT y) : mergeAdd xs ys
mergeAdd xs [] = xs
mergeAdd [] ys = ys
 
-- The output Rating has no items in common with the input Rating and
-- only includes positively weighted ratings.
predict :: Ord item => SlopeOne item -> Rating item -> Rating item
predict (SlopeOne matrixIn) userRatings =
    M.mapMaybe (computeRating ratingList) (M.difference matrixIn userRatings)
  where ratingList = M.toAscList userRatings
 
-- 'computeRating' is a helper for 'predict'.
-- Optimized traversal of distinct ascending lists to compute positive weighted rating.
computeRating :: (Ord item) => [(item,RatingValue)] -> [Tup item] -> Maybe RatingValue
computeRating !xa@(x:xs) !ya@(y:ys) =
  case compare (fst x) (itemT y) of
    LT -> computeRating xs ya
    GT -> computeRating xa ys
    EQ -> helper (countT y) (ratingT y + fromIntegral (countT y) * snd x) xs ys
 where
  helper :: (Ord item) => Count -> RatingValue -> [(item,RatingValue)] -> [Tup item] -> Maybe RatingValue
  helper !count !rating !xa@(x:xs) !ya@(y:ys) =
    case compare (fst x) (itemT y) of
      LT -> helper count rating xs ya
      GT -> helper count rating xa ys
      EQ -> helper (count + countT y) (rating + ratingT y + fromIntegral (countT y) * (snd x)) xs ys
  helper !count !rating _ _  | rating > 0 = Just (rating / fromIntegral count)
                             | otherwise = Nothing
computeRating _ _ = Nothing

 The Rating is the known (item,Rating) information for a particular "user"
 as a sparse map of distinct ascending lists.  The 'update' and
 'predict' functions do not need the inner type to actually be a
 map, so the list saves space and complexity.
 'mergeAdd' is a helper for 'update'.
 Optimized traversal of distinct ascending lists to perform additive merge.
 The output Rating has no items in common with the input Rating and
 only includes positively weighted ratings.
 'computeRating' is a helper for 'predict'.
 Optimized traversal of distinct ascending lists to compute positive weighted rating.
# LANGUAGE BangPatterns , FlexibleInstances #

module SlopeTwo
    (
      SlopeOne
    , Count
    , RatingValue
    , Rating
    , empty
    , size
    , update
    , predict
    ) where

import Control.Parallel.Strategies
import qualified Data.Map as M
import Debug.Trace


type Count = Int
type RatingValue = Double

type Rating item = M.Map item RatingValue

  The SlopeOne matrix is indexed by pairs of items and is implemented
newtype SlopeOne item = SlopeOne (M.Map item [Tup item])
  deriving (Eq, Show)
 
  Strict triple tuple type for SlopeOne internals
data Tup item = Tup {
      itemT :: !item
    , countT :: !Count
    , ratingT :: !RatingValue
    } deriving (Eq, Show)
 
empty :: SlopeOne item
empty = SlopeOne M.empty
 
size :: SlopeOne item -> Int
size (SlopeOne m) = M.size m

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = let (y,ys) = splitAt n xs
                in y:chunksOf n ys

instance NFData (Tup item)

unionsWith :: (Ord k, NFData k, NFData a) => (a->a->a) -> [M.Map k a] -> M.Map k a
unionsWith f ms = M.unionsWith f . parMap rwhnf (M.unionsWith f) $
                  trace ("l " ++ show (length ms)) $ chunksOf 100 ms

update :: (NFData item, Ord item) => SlopeOne item -> [Rating item] -> SlopeOne item
update s@(SlopeOne matrixIn) usersRatingsIn | null usersRatings = s
                                            | otherwise =
    SlopeOne . unionsWith mergeAdd . (matrixIn:) . parMap rwhnf fromRating $ usersRatings
  where usersRatings = filter ((1<) . M.size) usersRatingsIn
  fromRating converts a Rating into a Map of Lists , a singleton SlopeOne .
        fromRating userRatings = M.mapWithKey expand userRatings
          where expand item1 rating1 = map makeTup . M.toAscList . M.delete item1 $ userRatings
                  where makeTup (item2,rating2) = Tup item2 1 (rating1-rating2)
 
mergeAdd :: Ord item => [Tup item] -> [Tup item] -> [Tup item]
mergeAdd xa@(x:xs) ya@(y:ys) =
  case compare (itemT x) (itemT y) of
    LT -> x : mergeAdd xs ya
    GT -> y : mergeAdd xa ys
    EQ -> Tup (itemT x) (countT x + countT y) (ratingT x + ratingT y) : mergeAdd xs ys
mergeAdd xs [] = xs
mergeAdd [] ys = ys
 
predict :: Ord item => SlopeOne item -> Rating item -> Rating item
predict (SlopeOne matrixIn) userRatings =
    M.mapMaybe (computeRating ratingList) (M.difference matrixIn userRatings)
  where ratingList = M.toAscList userRatings
 
computeRating :: (Ord item) => [(item,RatingValue)] -> [Tup item] -> Maybe RatingValue
computeRating !xa@(x:xs) !ya@(y:ys) =
  case compare (fst x) (itemT y) of
    LT -> computeRating xs ya
    GT -> computeRating xa ys
    EQ -> helper (countT y) (ratingT y + fromIntegral (countT y) * snd x) xs ys
 where
  helper :: (Ord item) => Count -> RatingValue -> [(item,RatingValue)] -> [Tup item] -> Maybe RatingValue
  helper !count !rating !xa@(x:xs) !ya@(y:ys) =
    case compare (fst x) (itemT y) of
      LT -> helper count rating xs ya
      GT -> helper count rating xa ys
      EQ -> helper (count + countT y) (rating + ratingT y + fromIntegral (countT y) * (snd x)) xs ys
  helper !count !rating _ _  | rating > 0 = Just (rating / fromIntegral count)
                             | otherwise = Nothing
computeRating _ _ = Nothing
