Task: Poker hand analyser







Python: :- initialization(main).


faces([a,k,q,j,10,9,8,7,6,5,4,3,2]).

face(F) :- faces(Fs), member(F,Fs).
suit(S) :- member(S, ['♥','♦','♣','♠']).


best_hand(Cards,H) :-
    straight_flush(Cards,C) -> H = straight-flush(C)
  ; many_kind(Cards,F,4)    -> H = four-of-a-kind(F)
  ; full_house(Cards,F1,F2) -> H = full-house(F1,F2)
  ; flush(Cards,S)          -> H = flush(S)
  ; straight(Cards,F)       -> H = straight(F)
  ; many_kind(Cards,F,3)    -> H = three-of-a-kind(F)
  ; two_pair(Cards,F1,F2)   -> H = two-pair(F1,F2)
  ; many_kind(Cards,F,2)    -> H = one-pair(F)
  ; many_kind(Cards,F,1)    -> H = high-card(F)
  ;                            H = invalid
  .

straight_flush(Cards, c(F,S)) :- straight(Cards,F), flush(Cards,S).

full_house(Cards,F1,F2) :-
    many_kind(Cards,F1,3), many_kind(Cards,F2,2), F1 \= F2.

flush(Cards,S) :- maplist(has_suit(S), Cards).
has_suit(S, c(_,S)).

straight(Cards,F) :-
    select(c(F,_), Cards, Cs), pred_face(F,F1), straight(Cs,F1).
straight([],_).
pred_face(F,F1) :- F = 2 -> F1 = a ; faces(Fs), append(_, [F,F1|_], Fs).

two_pair(Cards,F1,F2) :-
    many_kind(Cards,F1,2), many_kind(Cards,F2,2), F1 \= F2.

many_kind(Cards,F,N) :-
    face(F), findall(_, member(c(F,_), Cards), Xs), length(Xs,N).


% utils/parser
parse_line(Cards)  --> " ", parse_line(Cards).
parse_line([C|Cs]) --> parse_card(C), parse_line(Cs).
parse_line([])     --> [].

parse_card(c(F,S)) --> parse_face(F), parse_suit(S).

parse_suit(S,In,Out) :- suit(S), atom_codes(S,Xs), append(Xs,Out,In).
parse_face(F,In,Out) :- face(F), face_codes(F,Xs), append(Xs,Out,In).

face_codes(F,Xs) :- number(F) -> number_codes(F,Xs) ; atom_codes(F,Xs).


% tests
test(" 2♥  2♦ 2♣ k♣  q♦").
test(" 2♥  5♥ 7♦ 8♣  9♠").
test(" a♥  2♦ 3♣ 4♣  5♦").
test(" 2♥  3♥ 2♦ 3♣  3♦").
test(" 2♥  7♥ 2♦ 3♣  3♦").
test(" 2♥  7♥ 7♦ 7♣  7♠").
test("10♥  j♥ q♥ k♥  a♥").
test(" 4♥  4♠ k♠ 5♦ 10♠").
test(" q♣ 10♣ 7♣ 6♣  4♣").

run_tests :-
    test(Line), phrase(parse_line(Cards), Line), best_hand(Cards,H)
  , write(Cards), write('\t'), write(H), nl
  .
main :- findall(_, run_tests, _), halt.


VB: option explicit
class playingcard
 dim suit
 dim pips
  
  
  public sub print
		dim s,p
		select case suit
		case "S":s=chrW(&h2660)
		case "D":s=chrW(&h2666)
		case "C":s=chrW(&h2663)
		case "H":s=chrW(&h2665)
		end select

		select case pips
		case 1:p="A"
		case 11:p="J"
		case 12:p="Q"
		case 13:p="K"
		case else: p=""& pips
		end select

		wscript.stdout.write  right("   "&p & s,3)&" "
  end sub
end class

sub printhand(byref h,start)
   dim i
   for i =start to ubound(h)
     h(i).print
   next
   
end sub

function checkhand(byval arr)
  dim ss,i,max,last,uses,toppip,j,straight, flush,used,ace
  redim nn(13)
  
  ss=arr(0).suit   
  straight=true:flush=true
  max=0:last=0:used=0:toppip=0:ace=0
  for i=0 to ubound(arr)
      j=arr(i).pips
      if arr(i).suit<>ss then flush=false
      if j>toppip then toppip=j
      if j=1 then ace=1
      nn(j)=nn(j)+1
      if nn(j)>max then max= nn(j) 
      if abs(j-toppip)>=4  then straight=0
   next
   for i=1 to ubound(nn)
      if nn(i) then used=used+1
   next   
   if max=1 then
      if nn(1) and nn(10) and nn(11) and nn(12) and nn(13) then straight=1
   end if
   if flush and straight and max=1 then
      checkhand= "straight-flush"
   elseif flush then  
      checkhand= "flush"
   elseif straight and max=1 then   
      checkhand= "straight"
   elseif max=4 then
     checkhand= "four-of-a-kind"
   elseif max=3 then
     if used=2 then
       checkhand= "full-house"
     else  
       checkhand= "three-of-a-kind"
     end if
  elseif max=2 then
     if used=3 then
       checkhand= "two-pair"
     else  
       checkhand= "one-pair"
     end if
  else
     checkhand= "Top "& toppip
  End If
end function


function readhand(h)
  dim i,b,c,p
  redim a(4)
  for i=0 to ubound(a)
    b=h(i)
    set c=new playingcard
    p=left(b,1)
    select case p
    case "j": c.pips=11
    case "q": c.pips=12
    case "k": c.pips=13
    case "t": c.pips=10
    case "a": c.pips=1
    case else c.pips=cint(p)
    end select
    c.suit=ucase(right(b,1))
    set a(i)=c
  next
  readhand=a
  erase a
end function

dim hands,hh,i
 hands = Array(_
Array("2h", "5h", "7d", "8c", "9s"),_ 
Array("2h", "2d", "2c", "kc", "qd"),_
Array("ah", "2d", "3c", "4c", "5d"),_
Array("2h", "3h", "2d", "3c", "3d"),_
Array("2h", "7h", "2d", "3c", "3d"),_
Array("th", "jh", "qh", "kh", "ah"),_
Array("4h", "4s", "ks", "5d", "ts"),_
Array("qc", "tc", "7c", "6c", "4c"),_
Array("ah", "ah", "7c", "6c", "4c"))

for i=1 to ubound(hands)
   hh=readhand(hands(i))
   printhand hh,0
   wscript.stdout.write vbtab & checkhand(hh)
   wscript.stdout.writeblanklines(1)
   
next