move {#} to prelude.tcl

we don't need to know the card identities when determining hand-type,
just the counts

day06/sol.py

@@ -71,5 +71,3 @@ def part2(data):
 print(solve(part2(sample)))
 print(fancy_solve(part2(sample)))
 print(fancy_solve(part2(input)))
-                
-

day07/sample1.in

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

day07/sol.tcl

@@ -0,0 +1,98 @@
+#!/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
+}
+
+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]]

prelude.tcl

@@ -2,6 +2,8 @@ package require Tcl 8.6
 namespace import tcl::mathfunc::min
 namespace import tcl::mathfunc::max
 
+proc {#} args {}
+
 proc ladd {list} {
     set t 0
     foreach x $list { incr t $x }