Poker scoring

-module(poker).
-export([compare/2]).

is_flush([{_,H}|T]) -> lists:all(fun({_,Suit})-> Suit =:= H end, T).

ordinal($2) -> 2;
ordinal($3) -> 3;
ordinal($4) -> 4;
ordinal($5) -> 5;
ordinal($6) -> 6;
ordinal($7) -> 7;
ordinal($8) -> 8;
ordinal($9) -> 9;
ordinal($T) -> 10;
ordinal($J) -> 11;
ordinal($Q) -> 12;
ordinal($K) -> 13;
ordinal($A) -> 14.

is_five_high_straight([{$2,_},{$3,_},{$4,_},{$5,_},{$A,_}]) -> true;
is_five_high_straight(_) -> false.
is_straight(Hand) ->
 [H|T] = [ordinal(Rank)||{Rank,_}<-Hand],
 Orders = lists:zip(T,[1,2,3,4]),
 lists:all(fun({Ordinal,Offset}) -> Ordinal =:= H + Offset end, Orders).

kinds(Hand) ->
 Counts=lists:foldl(fun({Rank,_},D)-> dict:update_counter(Rank,1,D) end,dict:new(),Hand),
 Kinds=dict:to_list(Counts),
 lists:reverse(lists:keysort(2,Kinds)).

score(Hand) ->
 Sorted=lists:keysort(1,Hand),
 {HighRank,_}=lists:last(Sorted),
 IsFlush = is_flush(Sorted),
 IsStraight = is_straight(Sorted),
 IsFiveHighStraight = is_five_high_straight(Sorted),
 case kinds(Sorted) of
  _ when IsFlush andalso IsFiveHighStraight -> {9,"straight flush",fun compare_rank/2,$5};
  _ when IsFlush andalso IsStraight -> {9,"straight flush",fun compare_rank/2,HighRank};
  [{Rank,4},{_,1}] -> {8,"four of a kind",fun compare_rank/2,Rank};
  [{Rank,3},{_,2}] -> {7,"full house",fun compare_rank/2,Rank};
  _ when IsFlush -> {6,"flush",fun compare_ranks/2,[R||{R,_}<-Hand]};
  _ when IsFiveHighStraight -> {5,"straight",fun compare_rank/2,$5};
  _ when IsStraight -> {5,"straight",fun compare_rank/2,HighRank};
  [{Rank,3}|_] -> {4,"three of a kind",fun compare_rank/2,Rank};
  [{P1,2},{P2,2},{R,1}] -> {3,"two pairs",fun compare_two_pairs/2,{[P1,P2],R}};
  [{P,2},{R1,_},{R2,_},{R3,_}] -> {2,"pair",fun compare_one_pair/2,{P,[R1,R2,R3]}};
  _ -> {1,"high card",fun compare_ranks/2,[R||{R,_}<-Hand]}
 end.

compare_one_pair({PB,TB},{PW,TW}) ->
 case compare_rank(PB,PW) of
  tie -> compare_ranks(TB,TW);
  {A,B} -> {A,B}
 end.

compare_two_pairs({PB,TB},{PW,TW}) ->
 case compare_ranks(PB,PW) of
  tie -> compare_rank(TB,TW);
  {A,B} -> {A,B}
 end.

compare_rank(RankB,RankW) ->
 OrdinalB = ordinal(RankB),
 OrdinalW = ordinal(RankW),
 if
  OrdinalB  >  OrdinalW -> {black,RankB};
  OrdinalB  <  OrdinalW -> {white,RankW};
  OrdinalB =:= OrdinalW -> tie
 end.

compare_ranks(HandB,HandW) ->
 Order=fun(Hand)->lists:reverse(lists:keysort(2,[{R,ordinal(R)}||R<-Hand])) end,
 Hands=lists:zip(Order(HandB),Order(HandW)),
 Diff=lists:dropwhile(fun({{_,A},{_,B}})->A=:=B end, Hands),
 case Diff of
  [] -> tie;
  [{{RB,OB},{_ ,OW}}|_] when OB > OW -> {black,RB};
  [{{_ ,OB},{RW,OW}}|_] when OB < OW -> {white,RW}
 end.

compare(Black,White) ->
 Parse=fun(Tokens)->[{R,S}||[R,S]<-string:tokens(Tokens, " ")] end,
 {RankB,CategoryB,FunB,ValueB} = score(Parse(Black)),
 {RankW,CategoryW,_   ,ValueW} = score(Parse(White)),
 if
  RankB  >  RankW -> "Black wins. - with " ++ CategoryB;
  RankB  <  RankW -> "White wins. - with " ++ CategoryW;
  RankB =:= RankW ->
   case FunB(ValueB,ValueW) of
    {black,Rank} -> "Black wins. - with " ++ CategoryB ++ ": " ++ [Rank];
    {white,Rank} -> "White wins. - with " ++ CategoryW ++ ": " ++ [Rank];
    tie          -> "Tie."
   end
  end.

%%Test cases
%%poker:compare("2H 3D 5C 9C KD", "2C 3H 4S 8C AH").
%%poker:compare("2H 4C 4C 2D 4H", "2S 8S AS QS 3S").
%%poker:compare("2H 3D 5S 9C KD", "2C 3H 4S 8C KH").
%%poker:compare("2H 3D 5S 9C KD", "2C 3H 5C 9S KH").