Another 2023 day 12 part 2 attempt
parent
8942f057f5
commit
2f8f875990
|
@ -6,6 +6,7 @@ program day12
|
||||||
character(200) :: fname
|
character(200) :: fname
|
||||||
character(max_chars) :: fline
|
character(max_chars) :: fline
|
||||||
character(max_chars) :: springs, spt
|
character(max_chars) :: springs, spt
|
||||||
|
integer :: cache(1:20, 1:300)
|
||||||
integer :: tn_spr, n_springs
|
integer :: tn_spr, n_springs
|
||||||
integer :: n_arguments
|
integer :: n_arguments
|
||||||
integer :: n_repeats
|
integer :: n_repeats
|
||||||
|
@ -73,7 +74,9 @@ program day12
|
||||||
num_wc = numstr(trim(springs), '?')
|
num_wc = numstr(trim(springs), '?')
|
||||||
print *, "Length: ", n_springs
|
print *, "Length: ", n_springs
|
||||||
print *, "Number of wildcards: ", num_wc
|
print *, "Number of wildcards: ", num_wc
|
||||||
val = nvalid(springs, n_springs, specifiers, n_specifiers, .true.)
|
print *, "Wildcard Combinations: ", 2**num_wc
|
||||||
|
cache = -1
|
||||||
|
val = nvalid(springs, n_springs, specifiers, n_specifiers)
|
||||||
print *, "Valid: ", val
|
print *, "Valid: ", val
|
||||||
print *
|
print *
|
||||||
total_valid = total_valid + val
|
total_valid = total_valid + val
|
||||||
|
@ -85,51 +88,145 @@ program day12
|
||||||
print *, "Total valid: ", total_valid
|
print *, "Total valid: ", total_valid
|
||||||
|
|
||||||
contains
|
contains
|
||||||
function consistent(springs, n_spr, specs, n_specs)
|
function nvalid(springs, n_spr, specs, n_specs) result(nv)
|
||||||
implicit none
|
implicit none
|
||||||
character(*), intent(in) ::springs
|
character(*), intent(in) :: springs
|
||||||
integer, intent(in) :: specs(:)
|
integer, intent(in) :: specs(:)
|
||||||
integer, intent(in) :: n_spr, n_specs
|
integer, intent(in) :: n_spr, n_specs
|
||||||
logical :: consistent
|
integer :: nv
|
||||||
integer :: c1, c2, c3, i, speccur, clen
|
integer :: ex_dist, i, cur
|
||||||
|
cur = 0
|
||||||
consistent = .true.
|
do i=1, n_specs
|
||||||
c1 = 1
|
cur = cur + specs(i) + 1
|
||||||
speccur = 0
|
|
||||||
do i = 1, n_spr
|
|
||||||
if (c1 .gt. n_spr) then
|
|
||||||
consistent = speccur .eq. n_specs
|
|
||||||
! We've run out of springs
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
c2 = scan(springs(c1:n_spr), '#')
|
|
||||||
if (c2 .eq. 0) then
|
|
||||||
consistent = speccur .eq. n_specs
|
|
||||||
! Also run out of springs
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
c2 = c1 + c2 - 1
|
|
||||||
c3 = verify(springs(c2:n_spr), '#')
|
|
||||||
if (c3 .eq. 0) then
|
|
||||||
! Ends at end of string
|
|
||||||
c3 = n_spr
|
|
||||||
else
|
|
||||||
c3 = c2 + c3 - 2
|
|
||||||
end if
|
|
||||||
speccur = speccur + 1
|
|
||||||
if (speccur .gt. n_specs) then
|
|
||||||
consistent = .false.
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
clen = c3 - c2 + 1
|
|
||||||
if (clen .ne. specs(speccur)) then
|
|
||||||
consistent = .false.
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
c1 = c3 + 1
|
|
||||||
end do
|
end do
|
||||||
print *, '???'
|
ex_dist = n_spr - cur + 1
|
||||||
end function consistent
|
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)
|
function numstr(springs, str)
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -145,81 +242,21 @@ program day12
|
||||||
end do
|
end do
|
||||||
end function numstr
|
end function numstr
|
||||||
|
|
||||||
function viable(springs, n_spr, specs, n_specs)
|
function Cnk(n, k)
|
||||||
implicit none
|
implicit none
|
||||||
character(*), intent(in) ::springs
|
integer, intent(in) :: n, k
|
||||||
integer, intent(in) :: specs(:)
|
integer :: Cnk
|
||||||
integer, intent(in) :: n_spr, n_specs
|
integer :: i
|
||||||
logical :: viable
|
integer :: num, den
|
||||||
character(len=1) :: ch
|
num = 1
|
||||||
integer :: i, i2, spi, spc, nrq, remt
|
do i = 0, k-1
|
||||||
logical :: ch1v, ch2v
|
num = num * (n-i)
|
||||||
spi = 0
|
|
||||||
spc = 0
|
|
||||||
viable = .true.
|
|
||||||
ch2v = .false.
|
|
||||||
do i=1,n_spr
|
|
||||||
ch1v = ch2v
|
|
||||||
ch = springs(i:i)
|
|
||||||
if (ch .eq. '?') then
|
|
||||||
nrq = numstr(springs(i:n_spr), '?#')
|
|
||||||
remt = 0
|
|
||||||
do i2=spi,n_specs
|
|
||||||
remt = remt + specs(i2)
|
|
||||||
end do
|
end do
|
||||||
remt = remt - spc
|
den = 1
|
||||||
viable = (nrq .ge. remt)
|
do i = 1, k
|
||||||
return
|
den = den * i
|
||||||
end if
|
|
||||||
ch2v = scan(ch, '#') .ne. 0
|
|
||||||
if (ch2v) then
|
|
||||||
if (ch1v) then
|
|
||||||
spc = spc + 1
|
|
||||||
if (spc .gt. specs(spi)) then
|
|
||||||
viable = .false.
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
else
|
|
||||||
spc = 1
|
|
||||||
spi = spi + 1
|
|
||||||
if (spi .gt. n_specs) then
|
|
||||||
viable = .false.
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end do
|
end do
|
||||||
end function viable
|
Cnk = num/den
|
||||||
|
end function Cnk
|
||||||
recursive function nvalid(springs, n_spr, specs, n_specs, r_branch) result(nv)
|
|
||||||
implicit none
|
|
||||||
character(len=max_chars), intent(in) ::springs
|
|
||||||
integer, intent(in) :: specs(:)
|
|
||||||
integer, intent(in) :: n_spr, n_specs
|
|
||||||
logical, intent(in) :: r_branch
|
|
||||||
integer :: nv
|
|
||||||
integer :: s_pos
|
|
||||||
character(len=max_chars) :: test_spr
|
|
||||||
nv = 0
|
|
||||||
s_pos = scan(springs, '?')
|
|
||||||
if (r_branch) then
|
|
||||||
print *, "Right branch depth: ", s_pos
|
|
||||||
end if
|
|
||||||
if (s_pos .eq. 0) then
|
|
||||||
if (consistent(springs, n_spr, specs, n_specs)) then
|
|
||||||
nv = nv + 1
|
|
||||||
end if
|
|
||||||
return
|
|
||||||
end if
|
|
||||||
test_spr = springs
|
|
||||||
test_spr(s_pos:s_pos) = '#'
|
|
||||||
if (viable(test_spr, n_spr, specs, n_specs)) then
|
|
||||||
nv = nv + nvalid(test_spr, n_spr, specs, n_specs, .false.)
|
|
||||||
end if
|
|
||||||
test_spr(s_pos:s_pos) = '.'
|
|
||||||
if (viable(test_spr, n_spr, specs, n_specs)) then
|
|
||||||
nv = nv + nvalid(test_spr, n_spr, specs, n_specs, r_branch)
|
|
||||||
end if
|
|
||||||
end function nvalid
|
|
||||||
end program day12
|
end program day12
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue