program problem_19b
!! reformulated to operate on ranges of the x,m,a,s ratings
use aoc_utilities
use iso_fortran_env
implicit none
integer :: iunit, n_lines, iline, i
character(len=:),allocatable :: line !, name
type(string),dimension(:),allocatable :: vals
logical :: accepted
integer(ip) :: total_accepted
type :: interval
integer(ip),dimension(2) :: v !! [start, end] of the interval
end type interval
type :: part
type(interval),dimension(4) :: xmas ! [x,m,a,s] ranges
end type part
type(part) :: parts
type :: rule
logical :: accept = .false.
logical :: reject = .false.
integer :: operator = 0 ! 1:<, 2:>
integer :: operator_arg = 0 ! 1:x, 2:m, 3:a, 4:s
integer :: operator_val = 0 ! value to compare to
character(len=:),allocatable :: goto ! where to next (workflow name)
end type rule
type :: workflow
character(len=:),allocatable :: name
type(rule),dimension(:),allocatable :: rules
end type workflow
type(workflow),dimension(:), allocatable :: workflows
type(workflow),allocatable :: w
call clk%tic()
! open(newunit=iunit, file='inputs/day19_test.txt', status='OLD')
open(newunit=iunit, file='inputs/day19.txt', status='OLD')
n_lines = number_of_lines_in_file(iunit)
allocate(workflows(0))
do iline = 1, n_lines
line = read_line(iunit)
if (line == '') exit ! done - dont need the parts list for part b
! parsing workflows : qqz{s>2770:qs,m<1801:hdj,R}
if (allocated(w)) deallocate(w); allocate(w) ! blank one
vals = split(line, '{')
w%name = vals(1)%str ! workflow name
!write(*,*) '--->'//w%name//'<-----'
vals(2)%str = vals(2)%str(1:len(vals(2)%str)-1) ! remove last bracket
vals = split(vals(2)%str, ',') ! workflow rules
! add each rule to the workflow
allocate(w%rules(0))
do i = 1, size(vals)
w%rules = [w%rules, parse_rule(vals(i)%str)]
end do
workflows = [workflows, w]
end do
parts = part(xmas=[interval([1,4000]), &
interval([1,4000]), &
interval([1,4000]),&
interval([1,4000])])
i = workflow_name_to_index('in') ! start at the first workflow
total_accepted = process(i,1,parts)
write(*,*) '19b: ', total_accepted
call clk%toc('19b')
contains
recursive function process(iworkflow,irule,p) result(iaccepted)
!! process this part range starting with irule
integer,intent(in) :: iworkflow
integer,intent(in) :: irule
type(part),intent(in) :: p
integer(ip) :: iaccepted
integer(ip),dimension(:),allocatable :: itmp, itmp_t, itmp_f
integer(ip) :: i
type(part) :: pt, pf
iaccepted = 0
associate( r => workflows(iworkflow)%rules(irule) )
! check if we are done
if (r%accept) then
iaccepted = get_accepted(p)
return
else if (r%reject) then
iaccepted = 0
return
end if
! process recursively, by splitting up the intervals when necessary
if (r%operator>0) then
! process the operator
select case (r%operator)
case(1) ! <
! always create the two sets and process the two cases below
! [note that some sets maybe empty]
!
! example:
![1,200] < 10 ==> [1,9] TRUE
! [10,200] FALSE
itmp = [(i, i=p%xmas(r%operator_arg)%v(1),p%xmas(r%operator_arg)%v(2))]
itmp_t = pack(itmp, mask = itmp<r%operator_val) !true
itmp_f = pack(itmp, mask = itmp>=r%operator_val) !false
if (size(itmp_t)>0) then ! some are true
pt = p
pt%xmas(r%operator_arg)%v = [itmp_t(1), itmp_t(size(itmp_t))]
if (r%goto=='A') then
iaccepted = iaccepted + get_accepted(pt)
else if (r%goto/='R') then
! go to next workflow & start at first rule of new workflow
iaccepted = iaccepted + process(workflow_name_to_index(r%goto),1,pt)
end if
end if
if (size(itmp_f)>0) then ! some are false
pf = p
pf%xmas(r%operator_arg)%v = [itmp_f(1), itmp_f(size(itmp_f))]
iaccepted = iaccepted + process(iworkflow,irule+1,pf) ! next rule
end if
case(2) ! >
itmp = [(i, i=p%xmas(r%operator_arg)%v(1),p%xmas(r%operator_arg)%v(2))]
itmp_t = pack(itmp, mask = itmp>r%operator_val) !true
itmp_f = pack(itmp, mask = itmp<=r%operator_val) !false
if (size(itmp_t)>0) then ! some are true
pt = p
pt%xmas(r%operator_arg)%v = [itmp_t(1), itmp_t(size(itmp_t))]
if (r%goto=='A') then
iaccepted = iaccepted + get_accepted(pt)
else if (r%goto/='R') then
! go to next workflow & start at first rule of new workflow
iaccepted = iaccepted + process(workflow_name_to_index(r%goto),1,pt)
end if
end if
if (size(itmp_f)>0) then ! some are false
pf = p
pf%xmas(r%operator_arg)%v = [itmp_f(1), itmp_f(size(itmp_f))]
iaccepted = iaccepted + process(iworkflow,irule+1,pf) ! next rule
end if
end select
else
! goto another workflow & start at first rule of new workflow
iaccepted = iaccepted + process(workflow_name_to_index(r%goto),1,p)
end if
end associate
!end do
end function process
integer(ip) function get_accepted(p)
!! count of all the parts in the set
type(part),intent(in) :: p
get_accepted = (1 + (p%xmas(1)%v(2) - p%xmas(1)%v(1)))* &
(1 + (p%xmas(2)%v(2) - p%xmas(2)%v(1)))* &
(1 + (p%xmas(3)%v(2) - p%xmas(3)%v(1)))* &
(1 + (p%xmas(4)%v(2) - p%xmas(4)%v(1)))
end function get_accepted
function workflow_name_to_index(name) result(idx)
!! get the index of this workflow in the array
character(len=*),intent(in) :: name
integer :: idx
do idx = 1, size(workflows)
if (name == workflows(idx)%name) return ! found it
end do
if (idx>size(workflows)) error stop 'workflow not found: '//name
end function workflow_name_to_index
function parse_rule(s) result(r)
character(len=*),intent(in) :: s
type(rule) :: r
type(string),dimension(:),allocatable :: v
character(len=*),parameter :: xmas = 'xmas' ! 1,2,3,4
if (s=='A') then
r%accept = .true.
else if (s=='R') then
r%reject = .true.
else
if (index(s,'>')>0) then
v = split(s(3:), ':') ! example: a<2006:qkq
r%operator_arg = index(xmas,s(1:1))
r%operator = 2
r%operator_val = int(v(1)%str)
r%goto = v(2)%str ! can be a workflow or A or R
else if (index(s,'<')>0) then
v = split(s(3:), ':')
r%operator_arg = index(xmas,s(1:1))
r%operator = 1
r%operator_val = int(v(1)%str)
r%goto = v(2)%str ! can be a workflow or A or R
else
r%goto = s ! it's a workflow name
end if
end if
end function parse_rule
end program problem_19b