Compare commits

...

7 Commits

Author SHA1 Message Date
magical dfa1fc0ed5 move {#} to prelude.tcl 2023-12-07 21:59:35 +00:00
magical 04f091e4a7 chmod +x 2023-12-07 07:39:20 +00:00
magical ba438b7b05 day 7 more cleanup
we don't need to know the card identities when determining hand-type,
just the counts
2023-12-07 07:37:07 +00:00
magical 8081b6f1fa day 7 cleanup
borrow an idea from elly's solution: we don't need separate copies of
each function in order to treat jokers differently, we can just replace
the Js with a different letter
2023-12-07 07:34:17 +00:00
magical bea122a661 trim 2023-12-07 07:08:20 +00:00
magical a0d4b47e16 day 7 part 2 2023-12-07 07:08:20 +00:00
magical d4485070f4 day 7 part 1 2023-12-07 07:08:20 +00:00
5 changed files with 1105 additions and 2 deletions

View File

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

1000
day07/input 100644

File diff suppressed because it is too large Load Diff

5
day07/sample1.in 100644
View File

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

98
day07/sol.tcl 100755
View File

@ -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]]

View File

@ -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 }