2023-12-16 14:17:48 +13:00

263 lines
8.9 KiB
Fortran

program day12
implicit none
integer, parameter :: max_chars = 300
integer, parameter :: max_rows = 2000
integer, parameter :: b_kind = selected_int_kind(15)
character(200) :: fname
character(max_chars) :: fline
character(max_chars) :: springs, spt
integer :: cache(1:20, 1:300)
integer :: tn_spr, n_springs
integer :: n_arguments
integer :: n_repeats
integer :: istat
integer :: strlen
integer, allocatable :: tspec(:), specifiers(:)
integer :: tn_spec, n_specifiers
integer :: i, i2, i3
integer :: s_pos
integer :: num_wc
integer(kind=b_kind) :: val, total_valid
n_arguments = command_argument_count()
if (n_arguments .eq. 2) then
call get_command_argument(1, fname)
print *, "File: ", trim(fname)
call get_command_argument(2, fline)
read(fline, *) n_repeats
print *, "Number of repeats: ", n_repeats
else
print *, "Wrong number of arguments: ", n_arguments
stop
end if
open(10, file=fname)
total_valid = 0
do i=1,max_rows
read(10, "(a)", iostat=istat) fline
strlen = len_trim(fline)
if ((strlen .eq. 0) .or. (is_iostat_end(istat))) then
exit
end if
s_pos = scan(fline, " ")
tn_spr = s_pos - 1
spt = fline(1:tn_spr)
tn_spec = 1
do i2 = s_pos+1, strlen
if (fline(i2:i2) .eq. ',') then
tn_spec = tn_spec + 1
end if
end do
n_specifiers = tn_spec * (1 + n_repeats)
allocate(tspec(1:tn_spec))
allocate(specifiers(1:n_specifiers))
read(fline((s_pos + 1):strlen), *) tspec
do i2=0,n_repeats
do i3=1,tn_spec
specifiers(i2 * tn_spec + i3) = tspec(i3)
end do
end do
springs = spt
if (n_repeats .ge. 1) then
do i2=1,n_repeats
springs = trim(springs) // '?' // trim(spt)
end do
end if
n_springs = (n_repeats + 1) * tn_spr + n_repeats
print *, "Row: ", i
print *, "Original: ", trim(spt)
print *, "Original specifiers: "
print "(20i2)", tspec
print *, "Expanded: ", trim(springs)
print *, "Expanded specifiers: "
print "(20i2)", specifiers
num_wc = numstr(trim(springs), '?')
print *, "Length: ", n_springs
print *, "Number of wildcards: ", num_wc
print *, "Wildcard Combinations: ", 2**num_wc
cache = -1
val = nvalid(springs, n_springs, specifiers, n_specifiers)
print *, "Valid: ", val
print *
total_valid = total_valid + val
deallocate(tspec)
deallocate(specifiers)
end do
close(10)
print *
print *, "Total valid: ", total_valid
contains
function nvalid(springs, n_spr, specs, n_specs) result(nv)
implicit none
character(*), intent(in) :: springs
integer, intent(in) :: specs(:)
integer, intent(in) :: n_spr, n_specs
integer :: nv
integer :: ex_dist, i, cur
cur = 0
do i=1, n_specs
cur = cur + specs(i) + 1
end do
ex_dist = n_spr - cur + 1
print *, "Budget: ", ex_dist
print *, "Cnk: ", n_specs + ex_dist, ex_dist
nv = n_specval(springs, n_spr, specs, n_specs, 0, ex_dist, 1)
end function nvalid
recursive function n_specval(springs, n_spr, specs, n_specs, i_gap, budget, cur) result(nsv)
implicit none
integer, intent(in) :: n_spr, n_specs, i_gap, budget, cur
integer, intent(in) :: specs(:)
character(*), intent(in) :: springs
integer :: nsv
integer :: b_used, cur2, curnew, brem
logical :: bad
if (i_gap .eq. n_specs) then
! Working on the last gap; all good so far
if (budget .eq. 0) then
! Nothing to consider
nsv = 1
else if (scan(springs((n_spr - budget + 1):n_spr), '#') .ne. 0) then
nsv = 0
else
nsv = 1
end if
return
end if
nsv = 0
do b_used=0,budget
cur2 = cur + b_used
if (i_gap .lt. 7) then
print *, i_gap, b_used, cur2, repeat('*', i_gap + 1)
end if
curnew = cur2 + specs(i_gap + 1) + 1
bad = .false.
if (.not. mem_specval(cur2, specs(i_gap + 1), springs, n_spr)) then
! Bad placement
bad = .true.
end if
if ((.not. bad) .and. (b_used .gt. 0)) then
if (scan(springs(cur:(cur2-1)), '#') .ne. 0) then
! Something between
bad = .true.
end if
end if
if (.not. bad) then
brem = budget - b_used
nsv = nsv + n_specval(springs, n_spr, specs, n_specs, i_gap + 1, brem, curnew)
end if
end do
end function n_specval
subroutine pr_specs(n_spr, n_specs, specs, s_starts)
implicit none
integer, intent(in) :: n_spr, n_specs, specs(:), s_starts(:)
character(len=max_chars) :: pstr
integer :: i
pstr = ' '
pstr(1:n_spr) = repeat('.', n_spr)
do i=1,n_specs
pstr(s_starts(i):(s_starts(i) + specs(i) - 1)) = repeat('#', specs(i))
end do
print *, trim(pstr)
end subroutine pr_specs
function spec_test(specs, spec_starts, n_specs, springs, n_spr)
implicit none
integer, intent(in) :: specs(:), spec_starts(:), n_specs, n_spr
character(*), intent(in) :: springs
logical :: spec_test
integer :: i
spec_test = .true.
do i=1,n_specs
if (.not. specval(spec_starts(i), specs(i), springs, n_spr)) then
spec_test = .false.
return
end if
end do
end function spec_test
function mem_specval(spec_start, spec_len, springs, n_spr)
implicit none
integer, intent(in) :: spec_start, spec_len, n_spr
character(*), intent(in) :: springs
logical :: mem_specval
if (cache(spec_len, spec_start) .eq. -1) then
mem_specval = specval(spec_start, spec_len, springs, n_spr)
if (mem_specval) then
cache(spec_len, spec_start) = 1
else
cache(spec_len, spec_start) = 0
end if
else if (cache(spec_len, spec_start) .eq. 0) then
mem_specval = .false.
else
mem_specval = .true.
end if
end function mem_specval
function specval(spec_start, spec_len, springs, n_spr)
implicit none
integer, intent(in) :: spec_start, spec_len, n_spr
character(*), intent(in) :: springs
logical :: specval
integer :: spec_end, pos
spec_end = spec_start + spec_len - 1
if (spec_end .gt. n_spr) then
specval = .false.
return
end if
pos = scan(springs(spec_start:spec_end), '.')
if (pos .ne. 0) then
specval = .false.
return
end if
if (spec_start .gt. 0) then
if (springs((spec_start-1):(spec_start-1)) .eq. '#') then
specval = .false.
return
end if
end if
if (spec_end .lt. n_spr) then
if (springs((spec_end+1):(spec_end+1)) .eq. '#') then
specval = .false.
return
end if
end if
specval = .true.
end function specval
function numstr(springs, str)
implicit none
character(*), intent(in) :: springs, str
integer :: numstr
integer :: sprlen, i
sprlen = len_trim(springs)
numstr = 0
do i=1,sprlen
if (scan(springs(i:i), str) .ne. 0) then
numstr = numstr + 1
end if
end do
end function numstr
function Cnk(n, k)
implicit none
integer, intent(in) :: n, k
integer :: Cnk
integer :: i
integer :: num, den
num = 1
do i = 0, k-1
num = num * (n-i)
end do
den = 1
do i = 1, k
den = den * i
end do
Cnk = num/den
end function Cnk
end program day12