8
\$\begingroup\$

I've implementing the this algorithm in Java, Scala, and Clojure to show my teammates. I know the code works as expected. What I'm looking for is tips on good Clojure style.

(ns gaming.online.ranking
  "Synopsis:
       (bradley-terry-full 5
         (list (create-team 1 45 (list (create-player 101 (create-ability-with-stddev 25 8))))
               (create-team 2 32 (list (create-player 102 (create-ability-with-stddev 25 8))))))

   Updates players' ability compared with how they were expected to perform")

; defn- means a private function
(defn- sum [f xs]
  (apply + (map f xs)))

(defn- plus-pair [[a1 a2] [b1 b2]]
 [(+ a1 b1) (+ a2 b2)])

(defn split-with-similar
  "Where split-with is like [(take-while pred xs) (drop-while pred xs)], this method is like
   recursive calls to split-with on the drop-while'd portion

   The predicate takes two arguments: the head of the current list, and the element to compare it
   against"
  [pred xs]
  (when xs
   ; loop/recur is how to do tail recursion in clojure
   ; 'let', 'do', 'for', 'loop' and function params can destructure collections like this next line 
   (loop [[head & tail] xs
          acc (vector)]
     (let [[like-head not-like-head] (split-with #(pred head %) tail)
           updated-acc (conj acc (cons head like-head))] ; conj is like cons, but works with vectors too
       (if (empty? not-like-head)
         acc
         (recur not-like-head updated-acc))))))



; defining a class called Ability with these fields. It acts much like a clojure map 
(defrecord Ability [mean stddev variance])

; keywords are also functions accepting a map
; maps are also functions accepting a key
; vectors are also functions accepting an index
(defn mean [ability] (:mean ability))
(defn stddev [ability] (:stddev ability))
(defn variance [ability] (:variance ability))

(defn create-ability-with-stddev [mean stddev]
  "Create ability from stddev"
  (Ability. mean stddev (* stddev stddev)))  ; how to call a java constructor

(defn create-ability-with-variance [mean variance]
  "Create ability from variance"
  (Ability. mean (Math/sqrt variance) variance)) ; call java static function




(defprotocol HasAbility
  "Both Player and Team have these methods. A protocol
   actually compiles down to a Java interface
   Another approach would be to use multi-methods." 
  (id [this])
  (ability [this]))

(defn skill
  "A single number representative of the player(s)'s true ability.
   For ranking purposes, this is chosen as a lower bound (with 95% confidence)
   on the player's true ability: it only goes up from here!
   With 95% confidence, the number is below the players true ability"
  [has-ability]
  (let [ability (ability has-ability)]
   (- (mean ability) (* 3 (stddev ability)))))


; shows how to implement a protocol/interface
(defrecord Player [id ability]
  HasAbility
  (id [this] (:id this))
  (ability [this] (:ability this)))

(defn create-player [id ability]
  (Player. id ability))
(defn copy-player [player ability]
  (create-player (:id player) ability))



(defrecord Team [id score ability players]
  HasAbility
  (id [this] (:id this))
  (ability [this] (:ability this)))

(defn create-team [id score players]
  (let [abilities (map ability players)
        mean (sum mean abilities)
        variance (sum variance abilities)]
    (Team. id score (create-ability-with-variance mean variance) players)))

(defn team-players [team] (:players team))
(defn team-size [team] (count (team-players team)))
(defn score [team] (:score team))





(def by-score-and-skill
  (reify java.util.Comparator ; implement a java comparator in place
    (compare [this a b]
      (or
        (first (drop-while zero?
          [(compare (score b) (score a))
           (compare (team-size b) (team-size a))
           (compare (skill b) (skill a))
           (compare (id a) (id b))]))
        0))))



(defn- score-within-allowance? [allowance]
  (fn [a b]           ; defining a lambda is done via 'fn'
   (<= (- (score a) allowance) (score b))))

(defn- calculate-ranks [rank-allowance teams]
  (loop [current-rank 0
         ranks {}
         [similar-head & similar-rest] (split-with-similar (score-within-allowance? rank-allowance) teams)]
    (let [updated-ranks (apply assoc ranks (flatten (map #(vector % current-rank) similar-head)))]
      (if (empty? similar-rest)
        updated-ranks
        (recur (+ current-rank (count similar-head))
               updated-ranks
               similar-rest)))))


(defn- update-player-abilities [player team-ability Omega Delta]
  (let [ability (ability player)
        variance-to-team-variance (/ (variance ability) (variance  team-ability))]
    (copy-player player
      (create-ability-with-stddev
        (+ (mean ability) (* Omega variance-to-team-variance))
        (* (stddev ability)
           (Math/sqrt (max (- 1 (* Delta variance-to-team-variance)) 0.0001)))))))



(defn- full-update
  "calc is a function expecting 2 params: team and opponent" 
  [teams calc]
 (concat
  (for [team teams ; map,for,reduce are "chunked lazy" so don't do side effects!
        :let [scores (for [opponent teams :when (not= opponent team)] (calc team opponent))
              [omega delta] (reduce plus-pair [0.0 0.0] scores)
               team-ability (ability team)]
        player (team-players team)]
    (update-player-abilities player team-ability omega delta))))

(defn bradley-terry-full [rank-allowance _teams]
  (when _teams ; nil is an empty list
   (let [mu 25.0
         sigma (/ mu 3.0)
         beta (* sigma 0.5)
         beta**2 (* beta beta)
         teams (sort by-score-and-skill _teams)
         ranks (calculate-ranks rank-allowance teams)
         gamma (/ 1.0 (count teams))]
      (full-update teams
        (fn [team opponent-team]
         (let [team-ability (ability team)
               rank (ranks team)
               opponent (ability opponent-team)
               c (Math/sqrt (+ (variance team-ability) (variance opponent) (* 2 beta**2)))
               p (/ 1.0 (+ 1 (Math/exp (/ (- (mean opponent) (mean team-ability)) c))))
               variance-to-c (/ (variance team-ability) c)

               cmp-opponent-rank (compare rank (ranks opponent-team))
               s (cond (pos? cmp-opponent-rank) 1.0
                       (neg? cmp-opponent-rank) 0.0
                       :default 0.5)]
              [(* variance-to-c (- s p))
               (* gamma (/ variance-to-c c) p (- 1 p))]))))))





(defn- join [sep coll]
  (if (empty? coll)
    ""
    (loop [[head & tail] coll
           acc ""]
      (let [pretty-head (pr-str head)]
        (if (empty? tail)
          (str acc pretty-head)
          (recur tail (str acc pretty-head sep)))))))

(let [team1 (create-team 1 500 
              (list (create-player 1 (create-ability-with-stddev 25 8))
                    (create-player 2 (create-ability-with-stddev 27 5))
                    (create-player 3 (create-ability-with-stddev 22 3))))
      team2 (create-team 2 400
              (list (create-player 4 (create-ability-with-stddev 25 8))
                    (create-player 5 (create-ability-with-stddev 27 5))
                    (create-player 6 (create-ability-with-stddev 22 3))))
      team3 (create-team 3 395
              (list (create-player 7 (create-ability-with-stddev 25 8))
                    (create-player 8 (create-ability-with-stddev 27 5))
                    (create-player 9 (create-ability-with-stddev 22 3))))
      updated-players (bradley-terry-full 10 (list team1 team2 team3))]
  (println (join "\n" updated-players)))
\$\endgroup\$
5
\$\begingroup\$

This is a huge file to comment on, so maybe just some general tips:

  • map and mapv (a variant of map returning a vector) can take any number of sequences as argument, each element of the nth sequence being used as the nth argument of the function given to map. So plus-pair could be written:

    (defn plus-vectors [v1 v2]
      (mapv + v1 v2)
    
  • loop can be replaced by iterate and take-while, but that is mostly a matter of taste

  • You can use map->Ability to instantiate an Ability record

  • You can use the threading macros -> and ->> more often for clarity:

    (for [opponent teams :when (not= opponent team)] (calc team opponent))
    

    can be written more cleanly as:

    (->> teams          
        (remove #{team})
        (map calc team))
    
  • I would avoid the use of :let inside a for definition, I would instead use a proper (let []) inside its body whenever possible

  • By convention, argument that start with an underscore mean they are ignored, so _team might not be the best choice in this example

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.