problem_12.f90 Source File

program problem_12

use iso_fortran_env
use aoc_utilities

implicit none

integer,parameter :: POINT    = 0
integer,parameter :: NUMBER   = 1
integer,parameter :: QUESTION = 2

! some global variables
integer,dimension(:),allocatable :: a,ints,ipattern,ipattern_tmp
integer(ip) :: n_valid
integer(ip) :: isum
integer :: iline

call clk%tic()

call go(.false., isum); write(*,*) '12a: ', isum
! call go(.true., isum); write(*,*) '12b: ', isum

call clk%toc('12')

contains

subroutine go(expand,isum)
    logical,intent(in) :: expand
    integer(ip),intent(out) :: isum

    integer :: iunit, n_lines, n_unknowns
    integer(ip) :: n_perms
    character(len=:),allocatable :: line, pattern
    type(string),dimension(:),allocatable :: vals

    ! open(newunit=iunit, file='inputs/day12_test.txt', status='OLD')
    open(newunit=iunit, file='inputs/day12.txt', status='OLD')
    n_lines = number_of_lines_in_file(iunit)
    isum = 0
    do iline = 1, n_lines
        line = read_line(iunit)
        vals = split(line,' ')
        ints = parse_ints(vals(2)%str)     ! integer list  1,1,3
        pattern = vals(1)%str              ! the pattern   #.#.###

        ! will convert the pattern to an array of numbers:
        ipattern = str_to_int_array_with_mapping(pattern,['.','#','?'],&
                                                        [POINT,NUMBER,QUESTION])  ! 1010111

        if (expand) then
            ! brute force it
            ipattern = [ipattern, QUESTION, ipattern, QUESTION, &
                        ipattern, QUESTION, ipattern, QUESTION, &
                        ipattern]
            ints = [ints, ints, ints, ints, ints]
        end if

        n_unknowns = count(ipattern==2)
        n_valid = 0 ! number of valid permutations
        n_perms = 2 ** n_unknowns ! number of permutations
        ipattern_tmp = ipattern

        ! recursively test all the permutations
        if (allocated(a)) deallocate(a)
        allocate(a(n_unknowns))
        call test(1, n_unknowns)

        isum = isum + n_valid

       ! write(*,*) iline, 'n_valid = ', n_valid

    end do

    end subroutine go

    recursive subroutine test (i, n)
    !! each ? can be either a . or a #
    !! check pattern to match the int list

    integer, intent(in) :: i, n
    integer :: ix
    integer,dimension(*),parameter :: icoeffs = [POINT,NUMBER] !! set of coefficients ['.', '#']

    ! what we are not doing here is accounting for permutations
    ! that we know do not match, because the begin with a sequence
    ! that doesn't match. those need to be skipped...

    if (i > n) then
        ! so we have an array of 0s and 1s -> replace the 2s in the ipattern with these
        !     ipattern: 2220111  -> ???.###
        !            a: 011      -> .##
        !       result: 0110111  -> .##.###
        !write(*,'(a,1x,i5,1x, *(I1))') 'test:', iline, ipattern_tmp
        ipattern_tmp = unpack(a, mask=ipattern==QUESTION, field=ipattern)
        if (match(ipattern_tmp, ints)) n_valid = n_valid + 1
    else
        do ix = 1, 2
            a(i) = icoeffs(ix)
            call test(i+1, n)
        end do
    end if
    end subroutine test

    logical function match(ipattern, ints)
        !! returns true if the pattern is valid for the int list.
        integer,dimension(:),intent(in) :: ipattern
        integer,dimension(:),intent(in) :: ints

        integer :: i, iacc, int_checked
        integer,dimension(1) :: ifirst, iend
        logical :: accumulating

        ! .##..###... -> 2,3

        ! start and end indices (ignoring leading and trailing spaces)
        ifirst = findloc(ipattern,1)
        iend   = findloc(ipattern,1,back=.true.)
        if (ifirst(1)==0 .or. iend(1)==0) then ! all blank
            match = .false.; return
        end if

        ! step through the pattern and stop once we find it invalid
        accumulating = .true.
        iacc = 0
        int_checked = 0 ! the count of ints that have been checked
        match = .true. ! initialize
        do i = ifirst(1), iend(1)
            select case(ipattern(i))
            case(POINT)
                if (accumulating) then
                    int_checked = int_checked + 1 ! check the next one
                    if (int_checked>size(ints)) then
                        ! too many ints
                        match = .false.
                        return
                    else if (ints(int_checked)/=iacc) then
                        ! doesn't match
                        match = .false.
                        return
                    end if
                    accumulating = .false.
                    iacc = 0
                end if
            case(NUMBER)
                if (accumulating) then
                    iacc = iacc + 1
                else
                    ! start of a new number
                    accumulating = .true.
                    iacc = 1
                end if
                if (i==iend(1)) then ! last number
                    int_checked = int_checked + 1 ! check the next one
                    if (int_checked/=size(ints)) then
                        ! not enough ints
                        match = .false.
                        return
                    else if (ints(int_checked)/=iacc) then
                        ! doesn't match
                        match = .false.
                        return
                    end if
                end if
            end select
        end do

    end function match

end program problem_12