adventofcode2023/day07/sol.tcl

#!/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]]