Hackercup 2014 - Qualifier

I had some fun doing it last year so I thought I would have a go again. This weekend was the qualifier. You can see the questions here

Square Detector

You want to write an image detection system that is able to
recognise different geometric shapes. In the first version of the
system you settled with just being able to detect filled squares on a
grid. You are given a grid of N×N square cells. Each cell is either
white or black.  Your task is to detect whether all the black cells
form a square shape.

  ..##
  ..##
  ....
  ....    => TRUE

  ..##
  ..##
  #...
  ....    => FALSE

We basically find the bottom leftmost and top rightmost black cell and check that the count of black cells is the same as the area of the square they describe

(defn square? [s]
  (let [size (count s)
        black-cells (for [y (range size)
                     x (range size)
                     :when  (= \# (nth (nth s y)
                                       x))]
                 [y x])
        ys (map first black-cells)
        xs (map second black-cells)
        x-min (apply min xs)
        x-max (apply max xs)
        y-min (apply min ys)
        y-max (apply max ys)
        y-edge (- y-max (dec y-min))
        x-edge (- x-max (dec x-min))
        square-size (* y-edge x-edge)]
    (if (and (= x-edge y-edge)
             (= (count black-cells) square-size))
      "YES"
      "NO")))

If the input was bigger then I would have found min/max in a single reduce but I like the clarity here and naming things is good right?

Basketball Game

A group of N high school students wants to play a basketball game.
To divide themselves into two teams they first rank all the players in the
following way:

Players with a higher shot percentage are rated higher than players with a lower
shot percentage.
If two players have the same shot percentage, the taller player is rated higher.
Luckily there are no two players with both the same shot percentage and height
so they are able to order themselves in an unambiguous way. Based on that
ordering each player is assigned a draft number from the range [1..N], where the
highest-rated player gets the number 1, the second highest-rated gets the number
2, and so on. Now the first team contains all the players with the odd draft
numbers and the second team all the players with the even draft numbers.

Each team can only have P players playing at a time, so to ensure that everyone
gets similar time on the court both teams will rotate their players according to
the following algorithm:

Each team starts the game with the P players who have the lowest draft numbers.
If there are more than P players on a team after each minute of the game the
player with the highest total time played leaves the playing field. Ties are
broken by the player with the higher draft number leaving first.
To replace her the player on the bench with the lowest total time played joins
the game. Ties are broken by the player with the lower draft number entering
first.
The game has been going on for M minutes now. Your task is to print out the
names of all the players currently on the field, (that is after M rotations).

Eg:
M = 3
P = 2
Wai 99 131
Weiyan 81 155
Lin 80 100
Purav 86 198
Slawek 80 192
Meihong 44 109

Sort all the players by their shot percentage you
get the list: [Wai, Purav, Weiyan, Slawek, Lin, Meihong]. This makes the two
teams:
[Wai, Weiyan, Lin]
[Purav, Slawek, Meihong]
The game starts with Lin and Meihong sitting on the bench in their respective
teams. After the first minute passes it's time for Weiyan and Slawek to sit out
since they have the highest draft numbers of the people who played. After the
second minute passes Lin and Meihong will keep playing since they only played
one minute so far and it's Wai and Purav who have to sit out.

Finally after the third minute Lin and Maihong go back to the bench and all the
players currently playing again are:
Purav Slawek Wai Weiyan

Here we sort the players according to the rule, get the two teams using take-nth starting at the first or second. The order the players come onto the pitch is a bit tricky, the ones with lowest draft numbers are on first but then they leave in order of highest first then the people on the bench come on lowest first, so the list of players in the order they come on the pitch is (concat (reverse (take p team)) (drop p team)) which we cycle so it’s infinite then use (partition p 1 cycled-team-list) to get a sliding window of P players moving up in ones. A speedup I did not do would have been using modular arithmetic for large m (both cycles repeat in the team size so we could replace m with their LCM rather then taking the mth of the infinite list directly)

(defn compare-players
  [[name p height] [name' p' height']]
  (if (= p p')
    (> height height')
    (> p p')))

(defn sort-players [players]
  (map first
       (apply sorted-set-by
              compare-players
              players)))

(defn f [[m p players]]
  (let [players (sort-players (map parse-player players))
        team1 (take-nth 2 players)
        team2 (take-nth 2 (rest players))
        mth (fn [team]
              (let [team-size (count team)
                    cycled-team-list (cycle (concat (reverse (take p team))
                                                    (drop p team)))]
                (nth (partition p 1 cycled-team-list) m)))]
    (str/join " " (sort (concat (mth team1)
                                (mth team2))))))

Tennison

You may be familiar with the works of Alfred Lord Tennyson, the famous English
poet. In this problem we will concern ourselves with Tennison, the less famous
English tennis player. As you know, tennis is not so much a game of skill as
a game of luck and weather patterns. The goal of tennis is to win K sets before
the other player. However, the chance of winning a set is largely dependent on
whether or not there is weather.

Tennison plays best when it's sunny, but sometimes of course, it rains. Tennison
wins a set with probability ps when it's sunny, and with probability pr when it's
raining. The chance that there will be sun for the first set is pi. Luckily for
Tennison, whenever he wins a set, the probability that there will be sun increases
by pu with probability pw. Unfortunately, when Tennison loses a set, the probability
of sun decreases by pd with probability pl. What is the chance that Tennison will
be successful in his match?

Rain and sun are the only weather conditions, so P(rain) = 1 - P(sun) at all
times. Also, probabilities always stay in the range [0, 1]. If P(sun) would ever
be less than 0, it is instead 0. If it would ever be greater than 1, it is instead 1.

I did not get this one right, I thought the tree was too big to actually sum all of the different ways Tennison can win so tried a Monte Carlo approach which works but is too slow to converge on the precision required.

(defn normalise [p]
  (cond (< p 0.0)
        0.0
        (> p 1.0)
        1.0
        :else
        p))

(defn sim
  ([k ps pr pi pu pw pd pl]
     (sim (int k) ps pr pi pu pw pd pl 0 0))
  ([k ps pr pi pu pw pd pl wins losses]
     (cond (= k wins)
           1.0

           (= k losses)
           0.0
           ;; ps sunny win
           ;; pr rain win
           ;; pi chance of sun
           ;; wins: +pu with prob pw
           ;; lose: -pd with prob pl

           :else
           (let [pwin (if (< (rand) pi) ps pr)
                 won? (< (rand) pwin)]
             (if won?
               (let [increase? (< (rand) pw)
                     delta (if increase? pu 0)]
                 (recur k ps pr (min (+ delta pi) 1) pu pw pd pl (inc wins) losses))
               (let [decrease? (< (rand) pl)
                     delta (if decrease? pd 0)]
                 (recur k ps pr (max (- pi delta) 0) pu pw pd pl wins (inc losses))))))))

(defn win-probability [& args]
  (let [n 1000000
        won (reduce +
                    (pmap (fn [n]
                            (apply sim args))
                          (range n)))]
    (/ won n)))

After looking at the solutions they suggest a nice dynamic programming approach, but still they do calculate every way tennison can win, here is a clojure version that I think is still a bit slow on the input. I could not find a way to use the memoize function for the recursive function.

(defn win-probability2 [k ps pr pi pu pw pd pl]
  (let [lookup (atom {})
        F
        (fn F  [w l p]
          (cond (== w k)
                1
                (== l k)
                0
                :else
                (if-let [cached (@lookup [w l p])]
                  cached
                  (let [answer
                        (+
                         (* (normalise p) ps pw (F (inc w) l (+ (normalise p) pu)))
                         (* (normalise p) ps (- 1 pw) (F (inc w) l (normalise p)))
                         (*  (- 1 ps) pl (F w (inc l) (- (normalise p) pd)))
                         (* (normalise p) (- 1 ps) (- 1 pl) (F w (inc l) (+ (normalise p) pu)))
                         (* (- 1 (normalise p)) pr pw (F (inc w) l (+ (normalise p) pu)))
                         (* (- 1 (normalise p)) pr (- 1 pw) (F (inc w) l (normalise p)))
                         (* (- 1 (normalise p)) (- 1 pr) pl (F w (inc l) (- (normalise p) pd)))
                         (* (- 1 (normalise p)) (- 1 pr) (- 1 pl) (F w (inc l) (normalise p))))]
                    (swap! lookup assoc [w l p] answer)
                    answer))))]
    (F 0 0 pi)))

Please let me know any improvements to tennison you can think of, code is on github