petra
/
AdventOfFortran
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

2023 day 7

main
Petra 2023-12-07 21:35:48 +13:00
parent 36325259ba
commit a786488bca
5 changed files with 1366 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
2023/Makefile
View File

@ -2,7 +2,7 @@ FC:=gfortran
FFLAGS:=-Wall -Wno-maybe-uninitialized FFLAGS:=-Wall -Wno-maybe-uninitialized
BIN:=./bin BIN:=./bin
SRC:=./src SRC:=./src
BINS:=./bin/day01.bin ./bin/day01b.bin ./bin/day02.bin ./bin/day03.bin ./bin/day04.bin ./bin/day05.bin ./bin/day05b.bin ./bin/day06.bin BINS:=./bin/day01.bin ./bin/day01b.bin ./bin/day02.bin ./bin/day03.bin ./bin/day04.bin ./bin/day05.bin ./bin/day05b.bin ./bin/day06.bin ./bin/day07.bin ./bin/day07b.bin
all: aoc19 all: aoc19

1001
2023/data/day07.txt 100644
View File

File diff suppressed because it is too large Load Diff

5
2023/data/day07ex1.txt 100644
View File

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

171
2023/src/day07.f90 100644
View File

@ -0,0 +1,171 @@
program day7
implicit none
integer, parameter :: max_chars = 300
character(200) :: fname
character(max_chars) :: fline
integer :: n_arguments
integer, parameter :: max_hands = 2000
character(len=5) :: hands(1:max_hands)
integer :: bids(1:max_hands)
integer :: rank(1:max_hands)
integer :: i, i2, n_hands
integer :: istat
integer :: beats, winnings, total_winnings
n_arguments = command_argument_count()
if (n_arguments .eq. 1) then
call get_command_argument(1, fname)
print *, "File: ", trim(fname)
print *
else
print *, "Wrong number of arguments: ", n_arguments
stop
end if
open(10, file=fname)
n_hands = 0
do i=1, max_hands
read(10, "(a)", iostat = istat) fline
if ((len_trim(fline) .eq. 0) .or. (is_iostat_end(istat))) then
exit
end if
read(fline, *) hands(i), bids(i)
n_hands = n_hands + 1
end do
close(10)
print *, "Number of hands: ", n_hands
rank = -1
rank(1) = 1
print *
do i=2,n_hands
beats = 0
do i2=1,(i-1)
if (rank_correct(hands(i), hands(i2))) then
! hand i ranks higher than hand i2
if (rank(i2) .gt. beats) then
beats = rank(i2)
end if
write(*, 21) i, hands(i), i2, hands(i2)
else
! hand i ranks lower than hand i2
rank(i2) = rank(i2) + 1
write(*, 22) i, hands(i), i2, hands(i2)
end if
end do
rank(i) = beats+1
end do
print *
total_winnings = 0
do i=1, n_hands
winnings = bids(i) * rank(i)
write(*, 20) hands(i), bids(i), rank(i), winnings
total_winnings = total_winnings + winnings
end do
print *
print *, "Total winnings: ", total_winnings
20 format("Hand: ", a5, "; Bid: ", i4, "; Rank: ", i4, "; Winnings: ", i8)
21 format(i4, " (", a5, ") beats ", i4, " (", a5, ")")
22 format(i4, " (", a5, ") beaten by ", i4, " (", a5, ")")
contains
function hand_type(hand)
character(len=5), intent(in) :: hand
integer :: hand_type
character(len=1) :: dist_cards(1:5)
integer :: card_count(1:5)
integer :: n_dc
integer :: i, i2
character(len=1) :: this_card
logical :: existing_card
integer :: sets(1:5)
dist_cards = ' '
card_count = 0
n_dc = 1
dist_cards(1) = hand(1:1)
card_count(1) = 1
do i=2,5
this_card = hand(i:i)
existing_card = .false.
do i2=1,n_dc
if (dist_cards(i2) .eq. this_card) then
existing_card = .true.
exit
end if
end do
if (existing_card) then
card_count(i2) = card_count(i2) + 1
else
n_dc = n_dc + 1
card_count(n_dc) = 1
dist_cards(n_dc) = this_card
end if
end do
sets = 0
do i=1,n_dc
sets(card_count(i)) = sets(card_count(i)) + 1
end do
if (sets(5) .eq. 1) then
! Five of a kind
hand_type = 7
else if (sets(4) .eq. 1) then
! Four of a kind
hand_type = 6
else if ((sets(3) .eq. 1) .and. (sets(2) .eq. 1)) then
! Full house
hand_type = 5
else if (sets(3) .eq. 1) then
! Three of a kind
hand_type = 4
else if (sets(2) .eq. 2) then
! Two pair
hand_type = 3
else if (sets(2) .eq. 1) then
! One pair
hand_type = 2
else
! High card
hand_type = 1
end if
end function hand_type
function tiebreak(hand1, hand2)
! True if hand1 would tiebreak ahead of hand2
implicit none
character(len=5), intent(in) :: hand1, hand2
logical :: tiebreak
character(len=13) :: cards = "23456789TJQKA"
integer :: pos_1, pos_2, i
do i=1,5
pos_1 = scan(cards, hand1(i:i))
pos_2 = scan(cards, hand2(i:i))
if (pos_1 .lt. pos_2) then
tiebreak = .false.
return
else if (pos_1 .gt. pos_2) then
tiebreak = .true.
return
end if
end do
tiebreak = .true.
end function tiebreak
function rank_correct(hand1, hand2)
implicit none
character(len=5), intent(in) :: hand1, hand2
logical :: rank_correct
integer :: h1_type, h2_type
h1_type = hand_type(hand1)
h2_type = hand_type(hand2)
if (h1_type .gt. h2_type) then
rank_correct = .true.
else if (h1_type .lt. h2_type) then
rank_correct = .false.
else
rank_correct = tiebreak(hand1, hand2)
end if
end function rank_correct
end program day7

188
2023/src/day07b.f90 100644
View File

@ -0,0 +1,188 @@
program day7b
implicit none
integer, parameter :: max_chars = 300
character(200) :: fname
character(max_chars) :: fline
integer :: n_arguments
integer, parameter :: max_hands = 2000
character(len=5) :: hands(1:max_hands)
integer :: bids(1:max_hands)
integer :: rank(1:max_hands)
integer :: i, i2, n_hands
integer :: istat
integer :: beats, winnings, total_winnings
n_arguments = command_argument_count()
if (n_arguments .eq. 1) then
call get_command_argument(1, fname)
print *, "File: ", trim(fname)
print *
else
print *, "Wrong number of arguments: ", n_arguments
stop
end if
open(10, file=fname)
n_hands = 0
do i=1, max_hands
read(10, "(a)", iostat = istat) fline
if ((len_trim(fline) .eq. 0) .or. (is_iostat_end(istat))) then
exit
end if
read(fline, *) hands(i), bids(i)
n_hands = n_hands + 1
end do
close(10)
print *, "Number of hands: ", n_hands
rank = -1
rank(1) = 1
print *
do i=2,n_hands
beats = 0
do i2=1,(i-1)
if (rank_correct(hands(i), hands(i2))) then
! hand i ranks higher than hand i2
if (rank(i2) .gt. beats) then
beats = rank(i2)
end if
write(*, 21) i, hands(i), i2, hands(i2)
else
! hand i ranks lower than hand i2
rank(i2) = rank(i2) + 1
write(*, 22) i, hands(i), i2, hands(i2)
end if
end do
rank(i) = beats+1
end do
print *
total_winnings = 0
do i=1, n_hands
winnings = bids(i) * rank(i)
write(*, 20) hands(i), bids(i), hand_type(hands(i)), rank(i), winnings
total_winnings = total_winnings + winnings
end do
print *
print *, "Total winnings: ", total_winnings
20 format("Hand: ", a5, "; Bid: ", i4, "; Type: ", i1, "; Rank: ", i4, "; Winnings: ", i8)
21 format(i4, " (", a5, ") beats ", i4, " (", a5, ")")
22 format(i4, " (", a5, ") b. by ", i4, " (", a5, ")")
contains
function hand_type(hand)
character(len=5), intent(in) :: hand
integer :: hand_type
character(len=1) :: dist_cards(1:5)
integer :: card_count(1:5)
integer :: n_dc
integer :: i, i2
character(len=1) :: this_card
logical :: existing_card
integer :: sets(1:5)
integer :: n_jokers
dist_cards = ' '
card_count = 0
n_dc = 1
dist_cards(1) = hand(1:1)
card_count(1) = 1
do i=2,5
this_card = hand(i:i)
existing_card = .false.
do i2=1,n_dc
if (dist_cards(i2) .eq. this_card) then
existing_card = .true.
exit
end if
end do
if (existing_card) then
card_count(i2) = card_count(i2) + 1
else
n_dc = n_dc + 1
card_count(n_dc) = 1
dist_cards(n_dc) = this_card
end if
end do
sets = 0
n_jokers = 0
do i=1,n_dc
if (dist_cards(i) .ne. 'J') then
sets(card_count(i)) = sets(card_count(i)) + 1
else
n_jokers = card_count(i)
end if
end do
if (n_jokers .eq. 5) then
sets(5) = 1
else if (n_jokers .gt. 0) then
do i=4,1,-1
if (sets(i) .gt. 0) then
sets(i + n_jokers) = 1
sets(i) = sets(i) - 1
exit
end if
end do
end if
if (sets(5) .eq. 1) then
! Five of a kind
hand_type = 7
else if (sets(4) .eq. 1) then
! Four of a kind
hand_type = 6
else if ((sets(3) .eq. 1) .and. (sets(2) .eq. 1)) then
! Full house
hand_type = 5
else if (sets(3) .eq. 1) then
! Three of a kind
hand_type = 4
else if (sets(2) .eq. 2) then
! Two pair
hand_type = 3
else if (sets(2) .eq. 1) then
! One pair
hand_type = 2
else
! High card
hand_type = 1
end if
end function hand_type
function tiebreak(hand1, hand2)
! True if hand1 would tiebreak ahead of hand2
implicit none
character(len=5), intent(in) :: hand1, hand2
logical :: tiebreak
character(len=13) :: cards = "J23456789TQKA"
integer :: pos_1, pos_2, i
do i=1,5
pos_1 = scan(cards, hand1(i:i))
pos_2 = scan(cards, hand2(i:i))
if (pos_1 .lt. pos_2) then
tiebreak = .false.
return
else if (pos_1 .gt. pos_2) then
tiebreak = .true.
return
end if
end do
tiebreak = .true.
end function tiebreak
function rank_correct(hand1, hand2)
implicit none
character(len=5), intent(in) :: hand1, hand2
logical :: rank_correct
integer :: h1_type, h2_type
h1_type = hand_type(hand1)
h2_type = hand_type(hand2)
if (h1_type .gt. h2_type) then
rank_correct = .true.
else if (h1_type .lt. h2_type) then
rank_correct = .false.
else
rank_correct = tiebreak(hand1, hand2)
end if
end function rank_correct
end program day7b