#!/usr/bin/env tclsh #source ../prelude.tcl proc {#} args {} proc parse input { return [join [split [read $input] "\n"]] } proc solve hands { foreach {hand bid} $hands { puts "$hand: [type $hand] [typeJ $hand]" } set result {} foreach cmp {beats beatsJ} { set sorted [lsort -index 0 -stride 2 -decreasing -command $cmp $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 index {c} { return [lsearch {A K Q J T 9 8 7 6 5 4 3 2} $c] } proc indexJ {c} { return [lsearch {A K Q T 9 8 7 6 5 4 3 2 J} $c] } proc type hand { array set n {} foreach c [split $hand ""] { incr n($c) } set groups [lsort -decreasing -stride 2 -index 1 -integer [array get n]] #puts $groups return [switch -glob $groups { {? 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 typeJ hand { # type of hand, but with jokers replaced by the best card if {$hand eq "JJJJJ"} { # all jokers! return 1 } array set n {} set j 0 foreach c [split $hand ""] { if {$c ne "J"} { incr n($c) } else { incr j } } set groups [lsort -decreasing -stride 2 -index 1 -integer [array get n]] # more of the same card is always better, # so add the jokers to the most frequent card lset groups 1 [expr {$j + [lindex $groups 1]}] #puts $groups return [switch -glob $groups { {? 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 } proc beats {hand1 hand2} { return [generic_beats type index $hand1 $hand2]} proc beatsJ {hand1 hand2} { return [generic_beats typeJ indexJ $hand1 $hand2]} proc generic_beats {typef indexf hand1 hand2} { #puts "cmp $hand1 $hand2" set r1 [$typef $hand1] set r2 [$typef $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 [$indexf $c1] set i2 [$indexf $c2] #puts "i=$i1 $i2" return [cmp $i1 $i2] } } error "$hand1 ties $hand2" return 0 } puts [solve [parse stdin]]