Recommend products based on sales. There is an approximation when sorting by sales, considering the wholes sales, when only the sales of people having bought the same product should be used. The data structure could be easily implemented in Redis ;)

Reco.hs

module Reco where

import Prelude hiding (product)
import qualified Data.Set as Set
import Data.Set(Set)
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List(sortBy)
import Data.Ord (comparing)

newtype Product = Product String deriving (Eq, Ord, Show)
newtype User = User String deriving (Eq, Ord)

data ProductDatabase = ProductDatabase {
  dbProductsByUser :: Map User (Set Product),
  dbUsersByProduct :: Map Product (Set User),
  dbSales :: Map Product Int
  }

emptyProductDatabase :: ProductDatabase
emptyProductDatabase = ProductDatabase Map.empty Map.empty Map.empty

buy :: User -> Product -> ProductDatabase -> ProductDatabase
buy user product (ProductDatabase productsByUser usersByProduct sales) =
  ProductDatabase
     (Map.insertWith Set.union user (Set.singleton product) productsByUser)
     (Map.insertWith Set.union product (Set.singleton user) usersByProduct)
     (Map.insertWith (+) product 1 sales)

recommendOtherProducts :: User -> Product -> ProductDatabase -> [Product]
recommendOtherProducts user product (ProductDatabase productsByUser usersByProduct sales) =
  (sortBySales sales . removeSelectedProduct . removeAlreadyBought) allProductsBoughtByOthers 
  where
    allProductsBoughtByOthers = Set.unions $ map findProductsBoughtByUser (Set.toList usersWhoBought)
    usersWhoBought = Map.findWithDefault Set.empty product usersByProduct
    findProductsBoughtByUser u = Map.findWithDefault Set.empty u productsByUser
    removeAlreadyBought allProducts = allProducts `Set.difference` findProductsBoughtByUser user
    removeSelectedProduct = Set.delete product

sortBySales :: Map Product Int -> Set Product -> [Product]
sortBySales sales products =
  map fst
  . sortBy (comparing $ negate . snd)
  . Map.toList . Map.filterWithKey (\ k _ -> Set.member k products)
  $ sales

RecoTest.hs

{-# OPTIONS_GHC -F -pgmF htfpp #-}
import Test.Framework
import Reco (emptyProductDatabase,
             recommendOtherProducts,
             buy,
             Product(..),
             User(..))
  
rx100 :: Product
rx100 = Product "rx100"

sd32g :: Product
sd32g = Product "32G SD card"

continuous :: Product
continuous = Product "Continuous"

jb :: User
jb = User "JB"

bruno :: User
bruno = User "Bruno"

stephan :: User
stephan = User "Stephan"

test_recommend_other_products :: IO ()
test_recommend_other_products = do 
 let db = (jb `buy` rx100) .
          (jb `buy` sd32g) .
          (jb `buy` continuous) $ emptyProductDatabase 
 assertEqual [continuous, rx100] (recommendOtherProducts bruno sd32g db)


test_dont_recommend_from_unrelated_user :: IO ()
test_dont_recommend_from_unrelated_user = do 
 let db = (stephan `buy` rx100) .
          (jb `buy` sd32g) .
          (jb `buy` continuous) $ emptyProductDatabase 
 assertEqual [continuous] (recommendOtherProducts bruno sd32g db)


test_dont_recommend_already_bought :: IO ()
test_dont_recommend_already_bought = do 
 let db = (bruno `buy` rx100) .
          (jb `buy` rx100) .
          (jb `buy` sd32g) .
          (jb `buy` continuous) $ emptyProductDatabase 
 assertEqual [continuous] (recommendOtherProducts bruno sd32g db)


test_dont_recommend_same_product :: IO ()
test_dont_recommend_same_product = do 
 let db = (jb `buy` rx100) .
          (jb `buy` sd32g) $ emptyProductDatabase 
 assertEqual [rx100] (recommendOtherProducts bruno sd32g db)



test_recommend_best_seller_first :: IO ()
test_recommend_best_seller_first = do 
 let db = (stephan `buy` rx100) .
          (jb `buy` rx100) .
          (jb `buy` sd32g) .
          (jb `buy` continuous) $ emptyProductDatabase
 assertEqual [rx100, continuous] (recommendOtherProducts bruno sd32g db)

 
main :: IO ()
main = htfMain htf_thisModulesTests

http://www.reddit.com/r/haskell/comments/1hpqt9/code_review_learning_haskell_id_like_to_have_some/