Welcome, guest | Sign In | My Account | Store | Cart

Calculates 1. the category of the hand (high card, one pair, etc...) and 2. the "kicker" values that act as tiebreakers to (possibly) distinguish two hands of the same category from each other. These two attributes, category and kickers, are then used by the cmp method to compare two hand objects and return -1, 0 or 1.

Tcl, 261 lines
 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261``` ```#!/bin/sh # the next line restarts using tclsh \ exec tclsh "\$0" \${1+"\$@"} package require Tcl 8.6.0 array set categories [list \ highCard 0 \ onePair 1 \ twoPair 2 \ threeOfAKind 3 \ straight 4 \ flush 5 \ fullHouse 6 \ fourOfAKind 7 \ straightFlush 8 \ ] array set groupings [list \ {1 1 1 1 1} \$categories(highCard) \ {2 1 1 1} \$categories(onePair) \ {2 2 1} \$categories(twoPair) \ {3 1 1} \$categories(threeOfAKind) \ {3 2} \$categories(fullHouse) \ {4 1} \$categories(fourOfAKind) \ ] set nValues 13 oo::class create card { constructor {withSuit withValue} { my variable suit value set suit \$withSuit set value \$withValue } method suit {} { my variable suit return \$suit } method value {} { my variable value return \$value } destructor { my variable suit value \$suit destroy \$value destroy } } oo::class create category { constructor {withNr} { my variable nr set nr \$withNr } method cmp {other} { my variable nr return [numCmp \$nr [\$other nr]] } method nr {} { my variable nr return \$nr } } oo::class create hand { constructor {withCards} { global categories groupings my variable cards category kickers set cards \$withCards set sortedValues [lsort -command {apply {{a b} {\$a cmp \$b}}} [lmap card \$cards {\$card value}]] set typeOfStraight [my TypeOfStraight \$sortedValues] set isFlush [my IsFlush] if {\$typeOfStraight} { set category [category new [expr {\$isFlush ? \$categories(straightFlush) : \$categories(straight)}]] set kickers [list [lindex \$sortedValues [expr {\$typeOfStraight == 1 ? "end" : "end-1"}]]] return } if {\$isFlush} { set category [category new \$categories(flush)] set kickers [lreverse \$sortedValues] return } set nEquals {} set kickers {} while {[llength \$sortedValues]} { lassign [longestSeq \$sortedValues {apply {{a b} {\$a cmp \$b}}} 1] i n lappend nEquals \$n lappend kickers [lindex \$sortedValues \$i] set sortedValues [lreplace \$sortedValues \$i [expr {\$i + \$n - 1}]] } set category [category new \$groupings(\$nEquals)] } method category {} { my variable category return \$category } method cmp {other} { my variable category kickers if {[set cmpRes [\$category cmp [\$other category]]] != 0} { return \$cmpRes } foreach kicker \$kickers otherKicker [\$other kickers] { if {[set cmpRes [\$kicker cmp \$otherKicker]] != 0} { return \$cmpRes } } return 0 } method kickers {} { my variable kickers return \$kickers } method IsFlush {} { my variable cards set firstSuit [[lindex \$cards 0] suit] foreach card \$cards { if {[[\$card suit] cmp \$firstSuit] != 0} { return 0 } } return 1 } method TypeOfStraight {sortedValues} { set sVLen [llength \$sortedValues] set prevValue [lindex \$sortedValues 0] for {set i 1} {\$i < \$sVLen} {incr i} { set value [lindex \$sortedValues \$i] if {![\$value isSeqTo \$prevValue]} { return [expr {\$i == \$sVLen - 1 && [[lindex \$sortedValues 0] isLowest] && [[lindex \$sortedValues end] isHighest] ? 2 : 0}] } set prevValue \$value } return 1 } destructor { my variable cards category foreach card \$cards { \$card destroy } \$category destroy } } oo::class create suit { constructor {withNr} { my variable nr set nr \$withNr } method cmp {other} { my variable nr return [numCmp \$nr [\$other nr]] } method nr {} { my variable nr return \$nr } } oo::class create value { constructor {withNr} { my variable nr set nr \$withNr } method cmp {other} { my variable nr return [numCmp \$nr [\$other nr]] } method isHighest {} { global nValues my variable nr return [expr {\$nr == \$nValues - 1}] } method isLowest {} { my variable nr return [expr {\$nr == 0}] } method isSeqTo {other} { my variable nr return [expr {\$nr == [\$other nr] + 1}] } method nr {} { my variable nr return \$nr } } proc longestSeq {list cmpCmd firstOrLast} { set bestI 0 set bestN 0 set i 0 set listLen [llength \$list] while {\$i < \$listLen} { set n [seqLen \$list \$i \$cmpCmd] if {(\$firstOrLast == 0 && \$n > \$bestN) || (\$firstOrLast == 1 && \$n >= \$bestN)} { set bestI \$i set bestN \$n } incr i \$n } return [list \$bestI \$bestN] } proc numCmp {a b} { return [expr {\$a < \$b ? -1 : (\$a == \$b ? 0 : 1)}] } proc seqLen {list index cmpCmd} { set i \$index set listLen [llength \$list] while {\$i < \$listLen && [{*}\$cmpCmd [lindex \$list \$i] [lindex \$list \$index]] == 0} { incr i } return [expr {\$i - \$index}] } # ================ Project Euler Problem 54 ================ array set suitStrings {C 0 D 1 H 2 S 3} array set valueStrings {T 8 J 9 Q 10 K 11 A 12} proc str2Card {str} { lassign [split \$str ""] valueStr suitStr return [card new [str2Suit \$suitStr] [str2Value \$valueStr]] } proc str2Hands {str} { set cards [lmap cardStr [split \$str] {str2Card \$cardStr}] set hands {} set i 0 set cardsLen [llength \$cards] while {\$i < \$cardsLen} { lappend hands [hand new [lrange \$cards \$i [expr {\$i + 5 - 1}]]] incr i 5 } return \$hands } proc str2Suit {str} { global suitStrings return [suit new \$suitStrings(\$str)] } proc str2Value {str} { global valueStrings if {[info exists valueStrings(\$str)]} { set n \$valueStrings(\$str) } else { set n [expr {\$str - 2}] } return [value new \$n] } set count 0 while {[gets stdin line] >= 0} { lassign [str2Hands \$line] hand1 hand2 if {[\$hand1 cmp \$hand2] > 0} { incr count } \$hand1 destroy \$hand2 destroy } puts \$count ```

As soon as a new hand object is created (from five card objects), it's category and kickers attributes are calculated and set. The hand can then be quickly compared multiple times with other hands with the cmp method, or you can expand the hand class with e.g. a toStr method to print a hands exact value, like "Ace high straight" or "Jacks full of Sevens".

The kickers attribute is a list of card value objects sorted from most to least important and with no duplicates. For example, two pairs of fives and aces plus a king will give <A, 5, K>, an ace low straight <5> and a high card hand or flush a five element list sorted in descending order. The royal flush has the straight flush-category and <A> in the kickers list.

When constructors take other objects as arguments, they will always be "owned" and destroyed together with the object. To create a new card, you first need to create a new, unique suit object and a new value object, etc...

 Created by Magnus Åhman on Thu, 30 May 2013 (MIT)

### Tags

▶ Show machine tags (4)

### Required Modules

• (none specified)