Day 12 part 2?
parent
f20eb10586
commit
3477b81b21
|
@ -1,5 +1,5 @@
|
||||||
FC:=gfortran
|
FC:=gfortran
|
||||||
FFLAGS:=-Wall -Wno-maybe-uninitialized
|
FFLAGS:=-Wall -Wno-maybe-uninitialized -O2
|
||||||
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 ./bin/day07.bin ./bin/day07b.bin ./bin/day08.bin ./bin/day08b.bin ./bin/day09.bin ./bin/day10.bin ./bin/day11.bin ./bin/day12.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 ./bin/day08.bin ./bin/day08b.bin ./bin/day09.bin ./bin/day10.bin ./bin/day11.bin ./bin/day12.bin
|
||||||
|
|
|
@ -2,24 +2,29 @@ program day12
|
||||||
implicit none
|
implicit none
|
||||||
integer, parameter :: max_chars = 300
|
integer, parameter :: max_chars = 300
|
||||||
integer, parameter :: max_rows = 2000
|
integer, parameter :: max_rows = 2000
|
||||||
|
integer, parameter :: b_kind = selected_int_kind(15)
|
||||||
character(200) :: fname
|
character(200) :: fname
|
||||||
character(max_chars) :: fline
|
character(max_chars) :: fline
|
||||||
character(max_chars) :: springs
|
character(max_chars) :: springs, spt
|
||||||
integer :: n_springs
|
integer :: tn_spr, n_springs
|
||||||
integer :: n_arguments
|
integer :: n_arguments
|
||||||
|
integer :: n_repeats
|
||||||
integer :: istat
|
integer :: istat
|
||||||
integer :: strlen
|
integer :: strlen
|
||||||
integer, allocatable :: specifiers(:)
|
integer, allocatable :: tspec(:), specifiers(:)
|
||||||
integer :: n_specifiers
|
integer :: tn_spec, n_specifiers
|
||||||
integer :: i, i2
|
integer :: i, i2, i3
|
||||||
integer :: s_pos
|
integer :: s_pos
|
||||||
integer :: val, total_valid
|
integer :: num_wc
|
||||||
|
integer(kind=b_kind) :: val, total_valid
|
||||||
|
|
||||||
n_arguments = command_argument_count()
|
n_arguments = command_argument_count()
|
||||||
if (n_arguments .eq. 1) then
|
if (n_arguments .eq. 2) then
|
||||||
call get_command_argument(1, fname)
|
call get_command_argument(1, fname)
|
||||||
print *, "File: ", trim(fname)
|
print *, "File: ", trim(fname)
|
||||||
print *
|
call get_command_argument(2, fline)
|
||||||
|
read(fline, *) n_repeats
|
||||||
|
print *, "Number of repeats: ", n_repeats
|
||||||
else
|
else
|
||||||
print *, "Wrong number of arguments: ", n_arguments
|
print *, "Wrong number of arguments: ", n_arguments
|
||||||
stop
|
stop
|
||||||
|
@ -33,32 +38,46 @@ program day12
|
||||||
exit
|
exit
|
||||||
end if
|
end if
|
||||||
s_pos = scan(fline, " ")
|
s_pos = scan(fline, " ")
|
||||||
n_springs = s_pos - 1
|
tn_spr = s_pos - 1
|
||||||
springs = fline(1:n_springs)
|
spt = fline(1:tn_spr)
|
||||||
n_specifiers = 1
|
tn_spec = 1
|
||||||
do i2 = s_pos+1, strlen
|
do i2 = s_pos+1, strlen
|
||||||
if (fline(i2:i2) .eq. ',') then
|
if (fline(i2:i2) .eq. ',') then
|
||||||
n_specifiers = n_specifiers + 1
|
tn_spec = tn_spec + 1
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
|
n_specifiers = tn_spec * (1 + n_repeats)
|
||||||
|
allocate(tspec(1:tn_spec))
|
||||||
allocate(specifiers(1:n_specifiers))
|
allocate(specifiers(1:n_specifiers))
|
||||||
read(fline((s_pos + 1):strlen), *) specifiers
|
read(fline((s_pos + 1):strlen), *) tspec
|
||||||
print *, trim(springs)
|
do i2=0,n_repeats
|
||||||
call set3(springs)
|
do i3=1,tn_spec
|
||||||
val = 0
|
specifiers(i2 * tn_spec + i3) = tspec(i3)
|
||||||
do
|
|
||||||
if (consistent(springs, n_springs, specifiers, n_specifiers)) then
|
|
||||||
val = val + 1
|
|
||||||
print *, trim(springs)
|
|
||||||
end if
|
|
||||||
if (no3(springs)) then
|
|
||||||
exit
|
|
||||||
end if
|
|
||||||
call iterate(springs, strlen)
|
|
||||||
end do
|
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
|
||||||
|
val = nvalid(springs, n_springs, specifiers, n_specifiers, .true.)
|
||||||
print *, "Valid: ", val
|
print *, "Valid: ", val
|
||||||
print *
|
print *
|
||||||
total_valid = total_valid + val
|
total_valid = total_valid + val
|
||||||
|
deallocate(tspec)
|
||||||
deallocate(specifiers)
|
deallocate(specifiers)
|
||||||
end do
|
end do
|
||||||
close(10)
|
close(10)
|
||||||
|
@ -66,50 +85,8 @@ program day12
|
||||||
print *, "Total valid: ", total_valid
|
print *, "Total valid: ", total_valid
|
||||||
|
|
||||||
contains
|
contains
|
||||||
subroutine set3(springs)
|
|
||||||
character(*), intent(inout) :: springs
|
|
||||||
integer :: pos
|
|
||||||
do
|
|
||||||
pos = scan(springs, '?')
|
|
||||||
if (pos .eq. 0) then
|
|
||||||
exit
|
|
||||||
end if
|
|
||||||
springs(pos:pos) = '3'
|
|
||||||
end do
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
subroutine iterate(springs, nspr)
|
|
||||||
character(*), intent(inout) :: springs
|
|
||||||
integer, intent(in) :: nspr
|
|
||||||
integer :: p1, p2
|
|
||||||
p1 = 1
|
|
||||||
do
|
|
||||||
if (p1 .gt. nspr) then
|
|
||||||
exit
|
|
||||||
end if
|
|
||||||
p2 = scan(springs(p1:nspr), '3>')
|
|
||||||
if (p2 .eq. 0) then
|
|
||||||
exit
|
|
||||||
end if
|
|
||||||
p2 = p2 + p1 - 1
|
|
||||||
if (springs(p2:p2) .eq. '3') then
|
|
||||||
springs(p2:p2) = '>'
|
|
||||||
exit
|
|
||||||
else
|
|
||||||
springs(p2:p2) = '3'
|
|
||||||
! carry the '>'
|
|
||||||
p1 = p2 + 1
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
function no3(springs)
|
|
||||||
character(*), intent(in) :: springs
|
|
||||||
logical :: no3
|
|
||||||
no3 = (scan(springs, '3') .eq. 0)
|
|
||||||
end function no3
|
|
||||||
|
|
||||||
function consistent(springs, n_spr, specs, n_specs)
|
function consistent(springs, n_spr, specs, n_specs)
|
||||||
|
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
|
||||||
|
@ -125,14 +102,14 @@ program day12
|
||||||
! We've run out of springs
|
! We've run out of springs
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
c2 = scan(springs(c1:n_spr), '#3')
|
c2 = scan(springs(c1:n_spr), '#')
|
||||||
if (c2 .eq. 0) then
|
if (c2 .eq. 0) then
|
||||||
consistent = speccur .eq. n_specs
|
consistent = speccur .eq. n_specs
|
||||||
! Also run out of springs
|
! Also run out of springs
|
||||||
return
|
return
|
||||||
end if
|
end if
|
||||||
c2 = c1 + c2 - 1
|
c2 = c1 + c2 - 1
|
||||||
c3 = verify(springs(c2:n_spr), '#3')
|
c3 = verify(springs(c2:n_spr), '#')
|
||||||
if (c3 .eq. 0) then
|
if (c3 .eq. 0) then
|
||||||
! Ends at end of string
|
! Ends at end of string
|
||||||
c3 = n_spr
|
c3 = n_spr
|
||||||
|
@ -153,5 +130,96 @@ program day12
|
||||||
end do
|
end do
|
||||||
print *, '???'
|
print *, '???'
|
||||||
end function consistent
|
end function consistent
|
||||||
|
|
||||||
|
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 viable(springs, n_spr, specs, n_specs)
|
||||||
|
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
|
||||||
|
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
|
||||||
end program day12
|
end program day12
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue