{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module Numeric.Recommender.ALS where

import Control.Parallel.Strategies
import Data.Bifunctor
import Data.Default.Class
import qualified Data.Foldable as Foldable
import qualified Data.IntMap.Lazy as IntMap
import qualified Data.IntSet as IntSet
import Data.List (sortBy, sortOn, unfoldr)
import Data.Maybe
import Data.Tuple
import qualified Data.Vector.Storable
import Data.Vector.Storable ((//))
import Numeric.LinearAlgebra
import System.Random

import Prelude hiding ((<>))

data ALSParams = ALSParams
  { ALSParams -> Double
lambda :: Double    -- ^ Training speed
  , ALSParams -> Double
alpha :: Double     -- ^ Weight multiplier
  , ALSParams -> Int
seed :: Int         -- ^ RNG seed
  , ALSParams -> Int
nFactors :: Int     -- ^ Hidden features dimension
  , ALSParams -> Int
parChunk :: Int     -- ^ Chunk size for parallelization
  } deriving (Int -> ALSParams -> ShowS
[ALSParams] -> ShowS
ALSParams -> String
(Int -> ALSParams -> ShowS)
-> (ALSParams -> String)
-> ([ALSParams] -> ShowS)
-> Show ALSParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ALSParams -> ShowS
showsPrec :: Int -> ALSParams -> ShowS
$cshow :: ALSParams -> String
show :: ALSParams -> String
$cshowList :: [ALSParams] -> ShowS
showList :: [ALSParams] -> ShowS
Show)

instance Default ALSParams where
  def :: ALSParams
def = Double -> Double -> Int -> Int -> Int -> ALSParams
ALSParams Double
0.1 Double
10 Int
0 Int
10 Int
10

data ALSResult = ALSResult
  { ALSResult -> Double
cost :: Double
  , ALSResult -> Matrix Double
itemFeature :: !(Matrix Double)
  , ALSResult -> Matrix Double
userFeature :: !(Matrix Double)
  }

data ALSModel u i = ALSModel
  { forall u i. ALSModel u i -> u -> Maybe Int
encodeUser :: u -> Maybe Int        -- ^ User to dense representation
  , forall u i. ALSModel u i -> Int -> u
decodeUser :: Int -> u              -- ^ User from dense representation
  , forall u i. ALSModel u i -> i -> Maybe Int
encodeItem :: i -> Maybe Int        -- ^ Item to dense representation
  , forall u i. ALSModel u i -> Int -> i
decodeItem :: Int -> i              -- ^ Item from dense representation
  -- | Internal representation of the input data pairs
  , forall u i. ALSModel u i -> [(Int, Int)]
pairs :: [(Int, Int)]
  -- | Results as further iterations of the algorithm
  , forall u i. ALSModel u i -> [ALSResult]
results :: [ALSResult]
  }

-- | Build recommendations based on users' unrated item choices.
--
-- Takes conversion functions to/from Int representation for user
-- supplied data types.  Use 'id' if you're already based on them.
--
-- The implementation follows the one in the recommenderlab library in
-- CRAN.  For further details, see "Large-scale Parallel Collaborative
-- Filtering for the Netflix Prize" by Yunhong Zhou, Dennis Wilkinson,
-- Robert Schreiber and Rong Pan.
buildModel
  :: (Functor f, Foldable f)
  => ALSParams
  -> (u -> Int)
  -> (Int -> u)
  -> (i -> Int)
  -> (Int -> i)
  -> f (u, i)      -- ^ User-item pairs
  -> ALSModel u i
buildModel :: forall (f :: * -> *) u i.
(Functor f, Foldable f) =>
ALSParams
-> (u -> Int)
-> (Int -> u)
-> (i -> Int)
-> (Int -> i)
-> f (u, i)
-> ALSModel u i
buildModel ALSParams
p u -> Int
fromUser Int -> u
toUser i -> Int
fromItem Int -> i
toItem =
  ALSParams
-> (u -> Int)
-> (Int -> u)
-> (i -> Int)
-> (Int -> i)
-> f (u, (i, Double))
-> ALSModel u i
forall (f :: * -> *) u i.
(Functor f, Foldable f) =>
ALSParams
-> (u -> Int)
-> (Int -> u)
-> (i -> Int)
-> (Int -> i)
-> f (u, (i, Double))
-> ALSModel u i
buildModelRated ALSParams
p u -> Int
fromUser Int -> u
toUser i -> Int
fromItem Int -> i
toItem (f (u, (i, Double)) -> ALSModel u i)
-> (f (u, i) -> f (u, (i, Double))) -> f (u, i) -> ALSModel u i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ((u, i) -> (u, (i, Double))) -> f (u, i) -> f (u, (i, Double))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(u
a,i
b) -> (u
a,(i
b,Double
1)))

-- | Build model for data with ratings.
buildModelRated
  :: (Functor f, Foldable f)
  => ALSParams
  -> (u -> Int)
  -> (Int -> u)
  -> (i -> Int)
  -> (Int -> i)
  -> f (u, (i, Double))  -- ^ User-item pairs, rated
  -> ALSModel u i
buildModelRated :: forall (f :: * -> *) u i.
(Functor f, Foldable f) =>
ALSParams
-> (u -> Int)
-> (Int -> u)
-> (i -> Int)
-> (Int -> i)
-> f (u, (i, Double))
-> ALSModel u i
buildModelRated ALSParams{Double
Int
lambda :: ALSParams -> Double
alpha :: ALSParams -> Double
seed :: ALSParams -> Int
nFactors :: ALSParams -> Int
parChunk :: ALSParams -> Int
lambda :: Double
alpha :: Double
seed :: Int
nFactors :: Int
parChunk :: Int
..} u -> Int
fromUser Int -> u
toUser i -> Int
fromItem Int -> i
toItem f (u, (i, Double))
xs = let
  parMap' :: (a -> a) -> [a] -> [a]
parMap' a -> a
f = Strategy [a] -> [a] -> [a]
forall a. Strategy a -> a -> a
withStrategy (Int -> Strategy a -> Strategy [a]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
parChunk Strategy a
forall a. NFData a => Strategy a
rdeepseq) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f
  rnd :: StdGen
rnd = Int -> StdGen
mkStdGen Int
seed
  (u -> Maybe Int
encUser, Int -> u
decUser) = ((Int -> Maybe Int) -> u -> Maybe Int)
-> ((Int -> Int) -> Int -> u)
-> (Int -> Maybe Int, Int -> Int)
-> (u -> Maybe Int, Int -> u)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Int -> Maybe Int) -> (u -> Int) -> u -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Int
fromUser) (Int -> u
toUser (Int -> u) -> (Int -> Int) -> Int -> u
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Maybe Int, Int -> Int) -> (u -> Maybe Int, Int -> u))
-> (f Int -> (Int -> Maybe Int, Int -> Int))
-> f Int
-> (u -> Maybe Int, Int -> u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    f Int -> (Int -> Maybe Int, Int -> Int)
forall (f :: * -> *).
Foldable f =>
f Int -> (Int -> Maybe Int, Int -> Int)
compact (f Int -> (u -> Maybe Int, Int -> u))
-> f Int -> (u -> Maybe Int, Int -> u)
forall a b. (a -> b) -> a -> b
$ ((u, (i, Double)) -> Int) -> f (u, (i, Double)) -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (u -> Int
fromUser (u -> Int) -> ((u, (i, Double)) -> u) -> (u, (i, Double)) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, (i, Double)) -> u
forall a b. (a, b) -> a
fst) f (u, (i, Double))
xs
  (i -> Maybe Int
encItem, Int -> i
decItem) = ((Int -> Maybe Int) -> i -> Maybe Int)
-> ((Int -> Int) -> Int -> i)
-> (Int -> Maybe Int, Int -> Int)
-> (i -> Maybe Int, Int -> i)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Int -> Maybe Int) -> (i -> Int) -> i -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
fromItem) (Int -> i
toItem (Int -> i) -> (Int -> Int) -> Int -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> Maybe Int, Int -> Int) -> (i -> Maybe Int, Int -> i))
-> (f Int -> (Int -> Maybe Int, Int -> Int))
-> f Int
-> (i -> Maybe Int, Int -> i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    f Int -> (Int -> Maybe Int, Int -> Int)
forall (f :: * -> *).
Foldable f =>
f Int -> (Int -> Maybe Int, Int -> Int)
compact (f Int -> (i -> Maybe Int, Int -> i))
-> f Int -> (i -> Maybe Int, Int -> i)
forall a b. (a -> b) -> a -> b
$ ((u, (i, Double)) -> Int) -> f (u, (i, Double)) -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i -> Int
fromItem (i -> Int) -> ((u, (i, Double)) -> i) -> (u, (i, Double)) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, Double) -> i
forall a b. (a, b) -> a
fst ((i, Double) -> i)
-> ((u, (i, Double)) -> (i, Double)) -> (u, (i, Double)) -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, (i, Double)) -> (i, Double)
forall a b. (a, b) -> b
snd) f (u, (i, Double))
xs
  xs' :: f (Int, (Int, Double))
xs' = ((u, (i, Double)) -> (Int, (Int, Double)))
-> f (u, (i, Double)) -> f (Int, (Int, Double))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((u -> Int)
-> ((i, Double) -> (Int, Double))
-> (u, (i, Double))
-> (Int, (Int, Double))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (u -> Maybe Int) -> u -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Maybe Int
encUser) ((i -> Int) -> (i, Double) -> (Int, Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> (i -> Maybe Int) -> i -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Maybe Int
encItem))) f (u, (i, Double))
xs
  nU :: Int
nU = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (f Int -> Int
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (f Int -> Int) -> f Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, (Int, Double)) -> Int) -> f (Int, (Int, Double)) -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, (Int, Double)) -> Int
forall a b. (a, b) -> a
fst f (Int, (Int, Double))
xs')
  nM :: Int
nM = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (f Int -> Int
forall a. Ord a => f a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (f Int -> Int) -> f Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, (Int, Double)) -> Int) -> f (Int, (Int, Double)) -> f Int
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int, Double) -> Int
forall a b. (a, b) -> a
fst ((Int, Double) -> Int)
-> ((Int, (Int, Double)) -> (Int, Double))
-> (Int, (Int, Double))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Int, Double)) -> (Int, Double)
forall a b. (a, b) -> b
snd) f (Int, (Int, Double))
xs')
  selRated :: Vector Double
selRated = (Int -> Double -> Vector Double
forall a. Storable a => Int -> a -> Vector a
Data.Vector.Storable.replicate (Int
nUInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nM) Double
0.0) Vector Double -> [(Int, Double)] -> Vector Double
forall a. Storable a => Vector a -> [(Int, a)] -> Vector a
//
             (((Int, (Int, Double)) -> (Int, Double))
-> [(Int, (Int, Double))] -> [(Int, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
u,(Int
c,Double
v)) -> (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
nMInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
u), Double
v)) ([(Int, (Int, Double))] -> [(Int, Double)])
-> [(Int, (Int, Double))] -> [(Int, Double)]
forall a b. (a -> b) -> a -> b
$ f (Int, (Int, Double)) -> [(Int, (Int, Double))]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f (Int, (Int, Double))
xs')
  ratings :: Matrix Double
ratings = Int -> Vector Double -> Matrix Double
forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
nM Vector Double
selRated
  ratings' :: Matrix Double
ratings' = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr Matrix Double
ratings
  weighted :: Matrix Double
weighted = Double -> Matrix Double
forall (c :: * -> *) e. Container c e => e -> c e
scalar Double
alpha Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* Matrix Double
ratings
  weighted' :: Matrix Double
weighted' = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr Matrix Double
weighted
  -- Initialize the first row with average ratings
  mIni :: Matrix Double
mIni = (Int
nFactorsInt -> Int -> [Double] -> Matrix Double
forall a. Storable a => Int -> Int -> [a] -> Matrix a
><Int
nM) ([Double] -> Matrix Double) -> [Double] -> Matrix Double
forall a b. (a -> b) -> a -> b
$
         ((Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> (Double -> Double -> Double) -> (Double, Double) -> Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/) ((Double, Double) -> Double)
-> ((Double, Integer) -> (Double, Double))
-> (Double, Integer)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Double) -> (Double, Integer) -> (Double, Double)
forall a b. (a -> b) -> (Double, a) -> (Double, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double, Integer) -> Double) -> (Double, Integer) -> Double
forall a b. (a -> b) -> a -> b
$ (Int -> (Double, Integer) -> (Double, Integer))
-> (Double, Integer) -> [Int] -> (Double, Integer)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\Int
x (Double
acc,Integer
cnt) -> let v :: Double
v = Vector Double
selRated Vector Double -> Int -> Double
forall c t. Indexable c t => c -> Int -> t
! Int
x
                                 in if Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.1 then (Double
accDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
v,Integer -> Integer
forall a. Enum a => a -> a
succ Integer
cnt) else (Double
acc, Integer
cnt))
                (Double
0.0,Integer
0) [Int
i, Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
nM..Int
nMInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
nUInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
              ) [Int
0..Int
nMInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]) [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++
         (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take (Int
nFactorsInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
nMInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> StdGen -> [Double]
forall g. RandomGen g => (Double, Double) -> g -> [Double]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Double
0,Double
lambda) StdGen
rnd)
  sumsU :: Vector Double
sumsU = [Double] -> Vector Double
vector ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (Vector Double -> Double) -> [Vector Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Double -> Double) -> Double -> Vector Double -> Double
forall a b. Storable a => (a -> b -> b) -> b -> Vector a -> b
Data.Vector.Storable.foldr Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0) ([Vector Double] -> [Double]) -> [Vector Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ Matrix Double -> [Vector Double]
forall t. Element t => Matrix t -> [Vector t]
toRows Matrix Double
ratings
  sumsM :: Vector Double
sumsM = [Double] -> Vector Double
vector ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (Vector Double -> Double) -> [Vector Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Double -> Double) -> Double -> Vector Double -> Double
forall a b. Storable a => (a -> b -> b) -> b -> Vector a -> b
Data.Vector.Storable.foldr Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0) ([Vector Double] -> [Double]) -> [Vector Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ Matrix Double -> [Vector Double]
forall t. Element t => Matrix t -> [Vector t]
toColumns Matrix Double
ratings
  factorsIdent :: Matrix Double
factorsIdent = Int -> Matrix Double
forall a. (Num a, Element a) => Int -> Matrix a
ident Int
nFactors
  minimizeLoss :: Int -> Int -> Vector Double -> Matrix Double -> Matrix Double -> Matrix Double -> Matrix Double
  minimizeLoss :: Int
-> Int
-> Vector Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
minimizeLoss Int
n Int
n' Vector Double
sums Matrix Double
w Matrix Double
r Matrix Double
m =
    let mtm :: Matrix Double
mtm = Matrix Double
m Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
<> Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr Matrix Double
m
    in [Vector Double] -> Matrix Double
forall t. Element t => [Vector t] -> Matrix t
fromRows ([Vector Double] -> Matrix Double)
-> [Vector Double] -> Matrix Double
forall a b. (a -> b) -> a -> b
$ ((Int -> Vector Double) -> [Int] -> [Vector Double])
-> [Int] -> (Int -> Vector Double) -> [Vector Double]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Vector Double) -> [Int] -> [Vector Double]
forall {a} {a}. NFData a => (a -> a) -> [a] -> [a]
parMap' [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> Vector Double) -> [Vector Double])
-> (Int -> Vector Double) -> [Vector Double]
forall a b. (a -> b) -> a -> b
$ \Int
i ->
      let -- Drop the rows and columns not relevant to this user
          relevant :: [Int]
relevant = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
j -> (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>Double
0.1) (Double -> Bool) -> Double -> Bool
forall a b. (a -> b) -> a -> b
$ Matrix Double -> IndexOf Matrix -> Double
forall (c :: * -> *) e. Container c e => c e -> IndexOf c -> e
atIndex Matrix Double
r (Int
i,Int
j)) [Int
0..Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
          m' :: Matrix Double
m' = Matrix Double
m Matrix Double -> [Int] -> Matrix Double
forall t. Element t => Matrix t -> [Int] -> Matrix t
¿ [Int]
relevant
          f' :: Matrix Double -> Vector Double
          f' :: Matrix Double -> Vector Double
f' Matrix Double
x = [Double] -> Vector Double
vector ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
j -> Matrix Double -> IndexOf Matrix -> Double
forall (c :: * -> *) e. Container c e => c e -> IndexOf c -> e
atIndex Matrix Double
x (Int
i,Int
j))
                 [Int]
relevant
          w' :: Vector Double
w' = Matrix Double -> Vector Double
f' Matrix Double
w
          r' :: Vector Double
r' = Matrix Double -> Vector Double
f' Matrix Double
r
          m'' :: Matrix Double
m'' = Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr (Matrix Double -> Matrix Double) -> Matrix Double -> Matrix Double
forall a b. (a -> b) -> a -> b
$ (Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr Matrix Double
m') Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* Vector Double -> Matrix Double
forall a. Storable a => Vector a -> Matrix a
asColumn Vector Double
w'
          x1 :: Matrix Double
x1 = Matrix Double
mtm Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
+ (Matrix Double
m'' Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
<> Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr Matrix Double
m' Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
+
                      (Double -> Matrix Double
forall (c :: * -> *) e. Container c e => e -> c e
scalar Double
lambda Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* Double -> Matrix Double
forall (c :: * -> *) e. Container c e => e -> c e
scalar (Vector Double -> IndexOf Vector -> Double
forall (c :: * -> *) e. Container c e => c e -> IndexOf c -> e
atIndex Vector Double
sums Int
IndexOf Vector
i) Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* Matrix Double
factorsIdent))
          x2 :: Matrix Double
x2 = Vector Double -> Matrix Double
forall a. Storable a => Vector a -> Matrix a
asColumn (Vector Double -> Matrix Double) -> Vector Double -> Matrix Double
forall a b. (a -> b) -> a -> b
$ (Matrix Double
m'' Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
+ Matrix Double
m') Matrix Double -> Vector Double -> Vector Double
forall t. Numeric t => Matrix t -> Vector t -> Vector t
#> Vector Double
r'
      in Matrix Double -> Vector Double
forall t. Element t => Matrix t -> Vector t
flatten (Matrix Double -> Vector Double)
-> (Maybe (Matrix Double) -> Matrix Double)
-> Maybe (Matrix Double)
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double
-> (Matrix Double -> Matrix Double)
-> Maybe (Matrix Double)
-> Matrix Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Matrix Double -> Matrix Double -> Matrix Double
forall t. Field t => Matrix t -> Matrix t -> Matrix t
linearSolveSVD Matrix Double
x1 Matrix Double
x2) Matrix Double -> Matrix Double
forall a. a -> a
id (Maybe (Matrix Double) -> Vector Double)
-> Maybe (Matrix Double) -> Vector Double
forall a b. (a -> b) -> a -> b
$ Matrix Double -> Matrix Double -> Maybe (Matrix Double)
forall {t}. Field t => Matrix t -> Matrix t -> Maybe (Matrix t)
linearSolve Matrix Double
x1 Matrix Double
x2
  f :: Matrix Double -> (Matrix Double, Matrix Double)
f =
    ((,) (Matrix Double -> Matrix Double -> (Matrix Double, Matrix Double))
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> (Matrix Double, Matrix Double)
forall a b.
(Matrix Double -> a -> b)
-> (Matrix Double -> a) -> Matrix Double -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr (Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Int
-> Vector Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
minimizeLoss Int
nM Int
nU Vector Double
sumsM Matrix Double
weighted' Matrix Double
ratings' (Matrix Double -> Matrix Double)
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> Matrix Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Matrix Double
forall m mt. Transposable m mt => m -> mt
tr) (Matrix Double -> (Matrix Double, Matrix Double))
-> (Matrix Double -> Matrix Double)
-> Matrix Double
-> (Matrix Double, Matrix Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int
-> Int
-> Vector Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
minimizeLoss Int
nU Int
nM Vector Double
sumsU Matrix Double
weighted Matrix Double
ratings

  results :: [(Matrix Double, Matrix Double)]
results = ((Matrix Double, Matrix Double) -> (Matrix Double, Matrix Double))
-> (Matrix Double, Matrix Double)
-> [(Matrix Double, Matrix Double)]
forall a. (a -> a) -> a -> [a]
iterate ((\Matrix Double
x -> Matrix Double
x Matrix Double
-> (Matrix Double, Matrix Double) -> (Matrix Double, Matrix Double)
forall a b. a -> b -> b
`seq` Matrix Double -> (Matrix Double, Matrix Double)
f Matrix Double
x) (Matrix Double -> (Matrix Double, Matrix Double))
-> ((Matrix Double, Matrix Double) -> Matrix Double)
-> (Matrix Double, Matrix Double)
-> (Matrix Double, Matrix Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix Double, Matrix Double) -> Matrix Double
forall a b. (a, b) -> b
snd) (Matrix Double -> (Matrix Double, Matrix Double)
f Matrix Double
mIni)
  in (u -> Maybe Int)
-> (Int -> u)
-> (i -> Maybe Int)
-> (Int -> i)
-> [(Int, Int)]
-> [ALSResult]
-> ALSModel u i
forall u i.
(u -> Maybe Int)
-> (Int -> u)
-> (i -> Maybe Int)
-> (Int -> i)
-> [(Int, Int)]
-> [ALSResult]
-> ALSModel u i
ALSModel u -> Maybe Int
encUser Int -> u
decUser i -> Maybe Int
encItem Int -> i
decItem (((Int, (Int, Double)) -> [(Int, Int)] -> [(Int, Int)])
-> [(Int, Int)] -> f (Int, (Int, Double)) -> [(Int, Int)]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) ((Int, Int) -> [(Int, Int)] -> [(Int, Int)])
-> ((Int, (Int, Double)) -> (Int, Int))
-> (Int, (Int, Double))
-> [(Int, Int)]
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Double) -> Int) -> (Int, (Int, Double)) -> (Int, Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int, Double) -> Int
forall a b. (a, b) -> a
fst) [] f (Int, (Int, Double))
xs') ([ALSResult] -> ALSModel u i) -> [ALSResult] -> ALSModel u i
forall a b. (a -> b) -> a -> b
$
     ((Matrix Double, Matrix Double) -> ALSResult)
-> [(Matrix Double, Matrix Double)] -> [ALSResult]
forall a b. (a -> b) -> [a] -> [b]
map (\(Matrix Double
u, Matrix Double
m) -> Double -> Matrix Double -> Matrix Double -> ALSResult
ALSResult
           (Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Double
-> Vector Double
-> Vector Double
-> Double
costFunction Matrix Double
ratings Matrix Double
u Matrix Double
m Matrix Double
weighted Double
lambda Vector Double
sumsU Vector Double
sumsM) Matrix Double
m Matrix Double
u) [(Matrix Double, Matrix Double)]
results
  where
    -- |Build to/from functions from a sparse set to a dense 0..n-1
    -- range.
    --
    -- The reverse function is total for convenience since the inputs
    -- for it are better controlled.
    compact
      :: Foldable f
      => f Int
      -> (Int -> Maybe Int, Int -> Int)
    compact :: forall (f :: * -> *).
Foldable f =>
f Int -> (Int -> Maybe Int, Int -> Int)
compact f Int
ys = let
      mp :: IntMap Int
mp = (Int -> IntMap Int -> IntMap Int)
-> IntMap Int -> f Int -> IntMap Int
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
x IntMap Int
a -> (Int -> Int -> Int) -> Int -> Int -> IntMap Int -> IntMap Int
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a b. a -> b -> a
const) Int
x (IntMap Int -> Int
forall a. IntMap a -> Int
IntMap.size IntMap Int
a) IntMap Int
a) IntMap Int
forall a. Monoid a => a
mempty f Int
ys
      pm :: IntMap Int
pm = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Int)] -> IntMap Int)
-> ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> IntMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ([(Int, Int)] -> IntMap Int) -> [(Int, Int)] -> IntMap Int
forall a b. (a -> b) -> a -> b
$ IntMap Int -> [(Int, Int)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Int
mp
      in ( (Int -> IntMap Int -> Maybe Int) -> IntMap Int -> Int -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup IntMap Int
mp
         , Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"missing value") Int -> Int
forall a. a -> a
id (Maybe Int -> Int) -> (Int -> Maybe Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IntMap Int -> Maybe Int) -> IntMap Int -> Int -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntMap Int -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup IntMap Int
pm
         )
    -- |This is not actually used by the algorithm.
    costFunction
      :: Matrix Double -> Matrix Double -> Matrix Double -> Matrix Double
      -> Double -> Vector Double -> Vector Double -> Double
    costFunction :: Matrix Double
-> Matrix Double
-> Matrix Double
-> Matrix Double
-> Double
-> Vector Double
-> Vector Double
-> Double
costFunction Matrix Double
r Matrix Double
u Matrix Double
m Matrix Double
w Double
l Vector Double
nui Vector Double
nmj = let rum :: Matrix Double
rum = Matrix Double
r Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
- (Matrix Double
u Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
<> Matrix Double
m)
      in Matrix Double -> Double
forall (c :: * -> *) e. Container c e => c e -> e
sumElements ((Matrix Double
w Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
+ Matrix Double
1) Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* (Matrix Double
rum Matrix Double -> Matrix Double -> Matrix Double
forall a. Num a => a -> a -> a
* Matrix Double
rum)) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
         (Double
l Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Vector Double -> Double
forall (c :: * -> *) e. Container c e => c e -> e
sumElements (Vector Double
nui Vector Double -> Matrix Double -> Vector Double
forall t. Numeric t => Vector t -> Matrix t -> Vector t
<# (Matrix Double
uMatrix Double -> Integer -> Matrix Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2)) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Vector Double -> Double
forall (c :: * -> *) e. Container c e => c e -> e
sumElements ((Matrix Double
mMatrix Double -> Integer -> Matrix Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2) Matrix Double -> Vector Double -> Vector Double
forall t. Numeric t => Matrix t -> Vector t -> Vector t
#> Vector Double
nmj)))

-- | Per user recommendations.  Results include items user has
-- selected and the snd in the tuple is False for those items.
--
-- The result IntMap uses dense user representation as the key.
-- Access with encodeUser.
recommend
  :: ALSModel u i
  -> Int  -- ^ Iterations
  -> IntMap.IntMap [(i, Bool)]
recommend :: forall u i. ALSModel u i -> Int -> IntMap [(i, Bool)]
recommend ALSModel{[(Int, Int)]
[ALSResult]
u -> Maybe Int
i -> Maybe Int
Int -> u
Int -> i
encodeUser :: forall u i. ALSModel u i -> u -> Maybe Int
decodeUser :: forall u i. ALSModel u i -> Int -> u
encodeItem :: forall u i. ALSModel u i -> i -> Maybe Int
decodeItem :: forall u i. ALSModel u i -> Int -> i
pairs :: forall u i. ALSModel u i -> [(Int, Int)]
results :: forall u i. ALSModel u i -> [ALSResult]
encodeUser :: u -> Maybe Int
decodeUser :: Int -> u
encodeItem :: i -> Maybe Int
decodeItem :: Int -> i
pairs :: [(Int, Int)]
results :: [ALSResult]
..} Int
n =
  let ALSResult{Double
Matrix Double
cost :: ALSResult -> Double
itemFeature :: ALSResult -> Matrix Double
userFeature :: ALSResult -> Matrix Double
cost :: Double
itemFeature :: Matrix Double
userFeature :: Matrix Double
..} = [ALSResult]
results [ALSResult] -> Int -> ALSResult
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
      feat :: Matrix Double
feat = Matrix Double
userFeature Matrix Double -> Matrix Double -> Matrix Double
forall t. Numeric t => Matrix t -> Matrix t -> Matrix t
<> Matrix Double
itemFeature
      usrIt :: IntMap IntSet
usrIt = ((Int, Int) -> IntMap IntSet -> IntMap IntSet)
-> IntMap IntSet -> [(Int, Int)] -> IntMap IntSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        (\(Int
k,Int
v) -> (IntSet -> IntSet -> IntSet)
-> Int -> IntSet -> IntMap IntSet -> IntMap IntSet
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith IntSet -> IntSet -> IntSet
IntSet.union Int
k (Int -> IntSet
IntSet.singleton Int
v))
        IntMap IntSet
forall a. Monoid a => a
mempty [(Int, Int)]
pairs
  in (Int -> IntMap [(i, Bool)] -> IntMap [(i, Bool)])
-> IntMap [(i, Bool)] -> [Int] -> IntMap [(i, Bool)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
u -> let inUsr :: IntSet
inUsr = Maybe IntSet -> IntSet
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe IntSet -> IntSet) -> Maybe IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$ Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
u IntMap IntSet
usrIt in
                    Int -> [(i, Bool)] -> IntMap [(i, Bool)] -> IntMap [(i, Bool)]
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
u ([(i, Bool)] -> IntMap [(i, Bool)] -> IntMap [(i, Bool)])
-> [(i, Bool)] -> IntMap [(i, Bool)] -> IntMap [(i, Bool)]
forall a b. (a -> b) -> a -> b
$
                    ((Int, Double) -> (i, Bool)) -> [(Int, Double)] -> [(i, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ((\Int
x -> (Int -> i
decodeItem Int
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> IntSet -> Bool
IntSet.member Int
x IntSet
inUsr)) (Int -> (i, Bool))
-> ((Int, Double) -> Int) -> (Int, Double) -> (i, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Double) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Double)] -> [(i, Bool)]) -> [(Int, Double)] -> [(i, Bool)]
forall a b. (a -> b) -> a -> b
$
                    ((Int, Double) -> (Int, Double) -> Ordering)
-> [(Int, Double)] -> [(Int, Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Int
_,Double
a) (Int
_,Double
b) -> Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
b Double
a) ([(Int, Double)] -> [(Int, Double)])
-> [(Int, Double)] -> [(Int, Double)]
forall a b. (a -> b) -> a -> b
$
                    [Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Double] -> [(Int, Double)]) -> [Double] -> [(Int, Double)]
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. HasCallStack => [a] -> a
head ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ Matrix Double -> [[Double]]
forall t. Element t => Matrix t -> [[t]]
toLists (Matrix Double -> [[Double]]) -> Matrix Double -> [[Double]]
forall a b. (a -> b) -> a -> b
$ Matrix Double
feat Matrix Double -> [Int] -> Matrix Double
forall t. Element t => Matrix t -> [Int] -> Matrix t
? [Int
u])
     IntMap [(i, Bool)]
forall a. Monoid a => a
mempty ([Int] -> IntMap [(i, Bool)]) -> [Int] -> IntMap [(i, Bool)]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
pairs

-- | The feature matrix gives nFactors-dimensional coordinates for the
-- items.  As such similar results can be found with using norm.
--
-- The result IntMap uses dense item representation as the key.
-- Access with encodeItem.
related
  :: ALSModel u i
  -> Int -- ^ Iterations
  -> IntMap.IntMap [(i, Double)] -- ^ IntMap key encoded item
related :: forall u i. ALSModel u i -> Int -> IntMap [(i, Double)]
related ALSModel{[(Int, Int)]
[ALSResult]
u -> Maybe Int
i -> Maybe Int
Int -> u
Int -> i
encodeUser :: forall u i. ALSModel u i -> u -> Maybe Int
decodeUser :: forall u i. ALSModel u i -> Int -> u
encodeItem :: forall u i. ALSModel u i -> i -> Maybe Int
decodeItem :: forall u i. ALSModel u i -> Int -> i
pairs :: forall u i. ALSModel u i -> [(Int, Int)]
results :: forall u i. ALSModel u i -> [ALSResult]
encodeUser :: u -> Maybe Int
decodeUser :: Int -> u
encodeItem :: i -> Maybe Int
decodeItem :: Int -> i
pairs :: [(Int, Int)]
results :: [ALSResult]
..} Int
n =
  let ALSResult{Double
Matrix Double
cost :: ALSResult -> Double
itemFeature :: ALSResult -> Matrix Double
userFeature :: ALSResult -> Matrix Double
cost :: Double
itemFeature :: Matrix Double
userFeature :: Matrix Double
..} = [ALSResult]
results [ALSResult] -> Int -> ALSResult
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  in [(Int, [(i, Double)])] -> IntMap [(i, Double)]
forall a. [(Int, a)] -> IntMap a
IntMap.fromAscList ([(Int, [(i, Double)])] -> IntMap [(i, Double)])
-> (Matrix Double -> [(Int, [(i, Double)])])
-> Matrix Double
-> IntMap [(i, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (((Int, Vector Double), [(Int, Vector Double)])
 -> (Int, [(i, Double)]))
-> [((Int, Vector Double), [(Int, Vector Double)])]
-> [(Int, [(i, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
i,Vector Double
v),[(Int, Vector Double)]
xs) ->
             (Int
i, ((i, Double) -> Double) -> [(i, Double)] -> [(i, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (i, Double) -> Double
forall a b. (a, b) -> b
snd ([(i, Double)] -> [(i, Double)]) -> [(i, Double)] -> [(i, Double)]
forall a b. (a -> b) -> a -> b
$ ((Int, Vector Double) -> (i, Double))
-> [(Int, Vector Double)] -> [(i, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
a,Vector Double
b) -> (Int -> i
decodeItem Int
a, Vector Double -> Double
forall a. Normed a => a -> Double
norm_2 (Vector Double -> Double) -> Vector Double -> Double
forall a b. (a -> b) -> a -> b
$ Vector Double
v Vector Double -> Vector Double -> Vector Double
forall a. Num a => a -> a -> a
- Vector Double
b)) [(Int, Vector Double)]
xs)
         ) ([((Int, Vector Double), [(Int, Vector Double)])]
 -> [(Int, [(i, Double)])])
-> (Matrix Double
    -> [((Int, Vector Double), [(Int, Vector Double)])])
-> Matrix Double
-> [(Int, [(i, Double)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (let f :: ([a], [a]) -> Maybe ((a, [a]), ([a], [a]))
f ([a]
_,[]) = Maybe ((a, [a]), ([a], [a]))
forall a. Maybe a
Nothing
          f ([a]
rs, a
x:[a]
xs) = ((a, [a]), ([a], [a])) -> Maybe ((a, [a]), ([a], [a]))
forall a. a -> Maybe a
Just ((a
x,([a]
rs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
xs)), (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs, [a]
xs))
      in (([(Int, Vector Double)], [(Int, Vector Double)])
 -> Maybe
      (((Int, Vector Double), [(Int, Vector Double)]),
       ([(Int, Vector Double)], [(Int, Vector Double)])))
-> ([(Int, Vector Double)], [(Int, Vector Double)])
-> [((Int, Vector Double), [(Int, Vector Double)])]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ([(Int, Vector Double)], [(Int, Vector Double)])
-> Maybe
     (((Int, Vector Double), [(Int, Vector Double)]),
      ([(Int, Vector Double)], [(Int, Vector Double)]))
forall {a}. ([a], [a]) -> Maybe ((a, [a]), ([a], [a]))
f (([(Int, Vector Double)], [(Int, Vector Double)])
 -> [((Int, Vector Double), [(Int, Vector Double)])])
-> ([(Int, Vector Double)]
    -> ([(Int, Vector Double)], [(Int, Vector Double)]))
-> [(Int, Vector Double)]
-> [((Int, Vector Double), [(Int, Vector Double)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)) ([(Int, Vector Double)]
 -> [((Int, Vector Double), [(Int, Vector Double)])])
-> (Matrix Double -> [(Int, Vector Double)])
-> Matrix Double
-> [((Int, Vector Double), [(Int, Vector Double)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     [Int] -> [Vector Double] -> [(Int, Vector Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Vector Double] -> [(Int, Vector Double)])
-> (Matrix Double -> [Vector Double])
-> Matrix Double
-> [(Int, Vector Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     Matrix Double -> [Vector Double]
forall t. Element t => Matrix t -> [Vector t]
toColumns (Matrix Double -> IntMap [(i, Double)])
-> Matrix Double -> IntMap [(i, Double)]
forall a b. (a -> b) -> a -> b
$ Matrix Double
itemFeature

-- | Sort items by components of the feature matrix.  This could be
-- used for visualization purposes or to sort items along some feature
-- axis.  The interpretation of them is totally up to the user but
-- it's not unreasonable to expect items close to each other in this
-- representation to be in some sense similar.
--
-- There's no guarantee that the results are stable between different
-- models even with only small differences.
byDimensions
  :: ALSModel u i
  -> Int
  -> [[(i, Double)]]
byDimensions :: forall u i. ALSModel u i -> Int -> [[(i, Double)]]
byDimensions ALSModel{[(Int, Int)]
[ALSResult]
u -> Maybe Int
i -> Maybe Int
Int -> u
Int -> i
encodeUser :: forall u i. ALSModel u i -> u -> Maybe Int
decodeUser :: forall u i. ALSModel u i -> Int -> u
encodeItem :: forall u i. ALSModel u i -> i -> Maybe Int
decodeItem :: forall u i. ALSModel u i -> Int -> i
pairs :: forall u i. ALSModel u i -> [(Int, Int)]
results :: forall u i. ALSModel u i -> [ALSResult]
encodeUser :: u -> Maybe Int
decodeUser :: Int -> u
encodeItem :: i -> Maybe Int
decodeItem :: Int -> i
pairs :: [(Int, Int)]
results :: [ALSResult]
..} Int
n =
  let ALSResult{Double
Matrix Double
cost :: ALSResult -> Double
itemFeature :: ALSResult -> Matrix Double
userFeature :: ALSResult -> Matrix Double
cost :: Double
itemFeature :: Matrix Double
userFeature :: Matrix Double
..} = [ALSResult]
results [ALSResult] -> Int -> ALSResult
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  in (Vector Double -> [(i, Double)])
-> [Vector Double] -> [[(i, Double)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Double) -> (i, Double)) -> [(Int, Double)] -> [(i, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
a,Double
b) -> (Int -> i
decodeItem Int
a, Double
b)) ([(Int, Double)] -> [(i, Double)])
-> (Vector Double -> [(Int, Double)])
-> Vector Double
-> [(i, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Double) -> Double) -> [(Int, Double)] -> [(Int, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Double) -> Double
forall a b. (a, b) -> b
snd ([(Int, Double)] -> [(Int, Double)])
-> (Vector Double -> [(Int, Double)])
-> Vector Double
-> [(Int, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Double] -> [(Int, Double)])
-> (Vector Double -> [Double]) -> Vector Double -> [(Int, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> [Double]
forall a. Storable a => Vector a -> [a]
toList) ([Vector Double] -> [[(i, Double)]])
-> [Vector Double] -> [[(i, Double)]]
forall a b. (a -> b) -> a -> b
$
     Matrix Double -> [Vector Double]
forall t. Element t => Matrix t -> [Vector t]
toRows Matrix Double
itemFeature