problem_3 Program

Uses

  • program~~problem_3~~UsesGraph program~problem_3 problem_3 iso_fortran_env iso_fortran_env program~problem_3->iso_fortran_env module~aoc_utilities aoc_utilities program~problem_3->module~aoc_utilities module~aoc_utilities->iso_fortran_env

Calls

program~~problem_3~~CallsGraph program~problem_3 problem_3 proc~check~3 problem_3::check program~problem_3->proc~check~3 proc~clock_end aoc_utilities::clock%clock_end program~problem_3->proc~clock_end proc~clock_start aoc_utilities::clock%clock_start program~problem_3->proc~clock_start proc~get_number problem_3::get_number program~problem_3->proc~get_number proc~is_not_number aoc_utilities::is_not_number program~problem_3->proc~is_not_number proc~is_symbol problem_3::is_symbol program~problem_3->proc~is_symbol proc~read_file_to_char_array aoc_utilities::read_file_to_char_array program~problem_3->proc~read_file_to_char_array proc~check~3->proc~get_number proc~is_number aoc_utilities::is_number proc~check~3->proc~is_number proc~get_number->proc~is_symbol proc~is_not_number->proc~is_number proc~is_symbol->proc~is_not_number proc~number_of_lines_in_file aoc_utilities::number_of_lines_in_file proc~read_file_to_char_array->proc~number_of_lines_in_file proc~read_line aoc_utilities::read_line proc~read_file_to_char_array->proc~read_line

Variables

Type Attributes Name Initial
integer :: n_lines
integer :: i
integer :: j
integer :: n_cols
integer :: jstart
integer :: jend
logical :: adjacent
logical :: tmp
integer(kind=ip) :: isum
character(len=1), dimension(:,:), allocatable :: array
integer(kind=ip), dimension(:), allocatable :: ivals

Functions

function check(i, j)

if the char is part of a number, then get it and append to ivals

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: i
integer, intent(in) :: j

Return Value logical

function is_symbol(c)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: c

Return Value logical

function get_number(i, j)

get the full number contining the character at i,j

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: i
integer, intent(in) :: j

Return Value integer(kind=ip)


Source Code

program problem_3

use iso_fortran_env
use aoc_utilities

implicit none

integer :: n_lines, i, j, n_cols, jstart, jend
logical :: adjacent, tmp
integer(ip) :: isum
character(len=1),dimension(:,:),allocatable :: array
integer(ip),dimension(:),allocatable :: ivals

call clk%tic()

! read file:
! pad around with blanks to simplify logic below
array = read_file_to_char_array('inputs/day3.txt', border = '.')
n_lines = size(array,1)
n_cols  = size(array,2)

!----------------- part 1 -----------------

isum = 0
do i = 1, n_lines
    ! is this character adjacent to a symbol?
    jend = 0
    do j = 1, n_cols
        if (is_not_number(array(i,j))) cycle
        if (j<=jend) cycle   ! skip the cols that we already have
        jend = 0
        adjacent =  is_symbol(array(i-1,j)  ) .or. &
                    is_symbol(array(i-1,j-1)) .or. &
                    is_symbol(array(i-1,j+1)) .or. &
                    is_symbol(array(i,j-1)  ) .or. &
                    is_symbol(array(i,j+1)  ) .or. &
                    is_symbol(array(i+1,j)  ) .or. &
                    is_symbol(array(i+1,j-1)) .or. &
                    is_symbol(array(i+1,j+1))
        if (adjacent) isum = isum + get_number(i,j) ! note: this sets jend
    end do
end do
write(*,*) '3a: sum :', isum

!----------------- part 2 -----------------

! now look for '*' and find adjacent numbers ....
isum = 0
do i = 1, n_lines
    do j = 1, n_cols
        if (array(i,j) == '*') then
            ! look for 2 adjacent numbers.
            if (allocated(ivals)) deallocate(ivals); allocate(ivals(0))
            ! above
            tmp = check(i-1,j) ! if only one on top
            if (.not. tmp) then
                tmp = check(i-1,j-1)
                tmp = check(i-1,j+1)
            end if
            tmp = check(i,j-1)    ! left and right
            tmp = check(i,j+1)
            ! below
            tmp = check(i+1,j) ! if only one below
            if (.not. tmp) then
                tmp = check(i+1,j-1)
                tmp = check(i+1,j+1)
            end if
            if (size(ivals) == 2) isum = isum + product(ivals) ! sum gear ratio
        end if
    end do

end do
write(*,*) '3b: result :', isum

call clk%toc('3')

contains

    logical function check(i,j)
        !! if the char is part of a number, then get it and append to ivals
        integer,intent(in) :: i,j
        check = is_number(array(i,j))
        if (check) ivals = [ivals, get_number(i,j)]
    end function check

    logical function is_symbol(c)
        character(len=1),intent(in) :: c
        is_symbol = is_not_number(c) .and. c /= '.'
    end function is_symbol

    integer(ip) function get_number(i,j)
        !! get the full number contining the character at i,j
        integer,intent(in) :: i,j
        jstart = j
        jend = j
        do
            if (array(i,jstart-1)=='.' .or. is_symbol(array(i,jstart-1))) exit
            jstart = jstart - 1
        end do
        do
            if (array(i,jend+1)=='.' .or. is_symbol(array(i,jend+1))) exit
            jend = jend + 1
        end do
        get_number = int(array(i, jstart:jend))
    end function get_number

end program problem_3