101 lines
2.5 KiB
Tcl
Executable File
101 lines
2.5 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
source ../prelude.tcl
|
|
|
|
proc parse input {
|
|
return [join [split [read $input] "\n"]]
|
|
}
|
|
|
|
proc solve hands {
|
|
foreach {hand bid} $hands {
|
|
puts "$hand: [type $hand] [type [jokerize $hand]]"
|
|
}
|
|
set result {}
|
|
foreach transform {id jokerize} {
|
|
set sorted [lsort -index 0 -stride 2 -decreasing -command beats [$transform $hands]]
|
|
#puts $sorted
|
|
set i 0
|
|
set t 0
|
|
foreach {hand bid} $sorted {
|
|
incr i
|
|
incr t [expr {$i*$bid}]
|
|
}
|
|
#puts [lmap {a b} $sorted {list $b}]
|
|
lappend result $t
|
|
}
|
|
return $result
|
|
}
|
|
|
|
proc id {x} { return $x }
|
|
proc jokerize {hands} {
|
|
# turn J into jokers (which we represent by an X)
|
|
return [string map {J X} $hands]
|
|
}
|
|
|
|
proc index {c} { return [lsearch {A K Q J T 9 8 7 6 5 4 3 2 X} $c] }
|
|
|
|
proc type hand {
|
|
if {$hand eq "XXXXX"} {
|
|
# all jokers!
|
|
return 1
|
|
}
|
|
array set n {}
|
|
set jokers 0
|
|
foreach c [split $hand ""] {
|
|
if {$c ne "X"} {
|
|
incr n($c)
|
|
} else {
|
|
incr jokers
|
|
}
|
|
}
|
|
set counts [lmap {k v} [array get n] {list $v}]
|
|
set counts [lsort -decreasing -integer $counts]
|
|
# more of the same card is always better,
|
|
# so add the jokers to the most frequent card
|
|
lset counts 0 [expr {$jokers + [lindex $counts 0]}]
|
|
#puts $groups
|
|
return [switch -glob $counts {
|
|
{5} {{#} Five of a kind; list 1}
|
|
{4 *} {{#} Four of a kind; list 2}
|
|
{3 2} {{#} Full house; list 3}
|
|
{3 *} {{#} Three of a kind; list 4}
|
|
{2 2 *} {{#} Two pair; list 5}
|
|
{2 *} {{#} One pair; list 6}
|
|
default {list 7}
|
|
}]
|
|
}
|
|
|
|
proc cmp {a b} { return [expr {($b < $a) - ($a < $b)}] }
|
|
|
|
proc xbeats {hand1 hand2} {
|
|
set x [beats $hand1 $hand2]
|
|
if {$x < 0} {puts "$hand1 beats $hand2"} \
|
|
elseif {$x > 0} {puts "$hand2 beats $hand1"} \
|
|
else {puts "$hand1 ties $hand2"}
|
|
return $x
|
|
}
|
|
|
|
# take a look at these hands
|
|
# take a look at these hands
|
|
proc beats {hand1 hand2} {
|
|
#puts "cmp $hand1 $hand2"
|
|
set r1 [type $hand1]
|
|
set r2 [type $hand2]
|
|
if {$r1 != $r2} {
|
|
return [cmp $r1 $r2]
|
|
}
|
|
#puts "r= $r1 $r2"
|
|
foreach c1 [split $hand1 ""] c2 [split $hand2 ""] {
|
|
#puts "c=$c1 $c2"
|
|
if {$c1 ne $c2} {
|
|
set i1 [index $c1]
|
|
set i2 [index $c2]
|
|
#puts "i=$i1 $i2"
|
|
return [cmp $i1 $i2]
|
|
}
|
|
}
|
|
error "$hand1 ties $hand2"
|
|
return 0
|
|
}
|
|
|
|
puts [solve [parse stdin]]
|