From 2f8f875990871c90a17a7ad70a21749c5af96d45 Mon Sep 17 00:00:00 2001 From: Petra Date: Sat, 16 Dec 2023 14:17:48 +1300 Subject: [PATCH] Another 2023 day 12 part 2 attempt --- 2023/src/day12.f90 | 269 ++++++++++++++++++++++++++------------------- 1 file changed, 153 insertions(+), 116 deletions(-) diff --git a/2023/src/day12.f90 b/2023/src/day12.f90 index c2a9cca..d5c4636 100644 --- a/2023/src/day12.f90 +++ b/2023/src/day12.f90 @@ -6,6 +6,7 @@ program day12 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 @@ -73,7 +74,9 @@ program day12 num_wc = numstr(trim(springs), '?') print *, "Length: ", n_springs 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 * total_valid = total_valid + val @@ -85,51 +88,145 @@ program day12 print *, "Total valid: ", total_valid contains - function consistent(springs, n_spr, specs, n_specs) + function nvalid(springs, n_spr, specs, n_specs) result(nv) implicit none - character(*), intent(in) ::springs + character(*), intent(in) :: springs integer, intent(in) :: specs(:) integer, intent(in) :: n_spr, n_specs - logical :: consistent - integer :: c1, c2, c3, i, speccur, clen - - consistent = .true. - c1 = 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 + integer :: nv + integer :: ex_dist, i, cur + cur = 0 + do i=1, n_specs + cur = cur + specs(i) + 1 end do - print *, '???' - end function consistent + 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 @@ -145,81 +242,21 @@ program day12 end do end function numstr - function viable(springs, n_spr, specs, n_specs) + function Cnk(n, k) implicit none - character(*), intent(in) ::springs - integer, intent(in) :: specs(:) - integer, intent(in) :: n_spr, n_specs - logical :: viable - character(len=1) :: ch - integer :: i, i2, spi, spc, nrq, remt - logical :: ch1v, ch2v - 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 - remt = remt - spc - viable = (nrq .ge. remt) - return - 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 + 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 - end function viable - - 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 + den = 1 + do i = 1, k + den = den * i + end do + Cnk = num/den + end function Cnk end program day12