day 7 part 1

day07/sample1.in

@@ -0,0 +1,5 @@
+32T3K 765
+T55J5 684
+KK677 28
+KTJJT 220
+QQQJA 483

day07/sol.tcl

@@ -0,0 +1,76 @@
+#!/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]
+    }
+    set sorted [lsort -index 0 -stride 2 -decreasing -command beats $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}]
+    return $t
+}
+
+proc index {c} { return [lsearch {A K Q J T 9 8 7 6 5 4 3 2} $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} {list 1}
+        {? 4 *} {list 2}
+        {? 3 ? 2} {list 3}
+        {? 3 *} {list 4}
+        {? 2 ? 2 *} {list 5}
+        {? 2 *} {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} {
+    #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]]