program problem_23 !! alternate one... collapse the maze into a graph ! Process: ! 1. locate the start and end nodes (top and bottom) ! 2. find all the cells that have 3 or 4 adjacent cells: ! ! 1 2 3 4 ! ### #.# ### #.# !--> #.# #.# ... ... ! #.# #.# #.# #.# ! ! those are the nodes, and the paths between them are the edges ! 3. compute the edges between each node combination and construct the graph ! 4. DFS all paths to find the longest. use iso_fortran_env use aoc_utilities implicit none type :: node integer(ip),dimension(:),allocatable :: inext !! the node connected to this one integer(ip),dimension(:),allocatable :: idist !! distance to inext nodes end type node type(node),dimension(:),allocatable :: nodes !! the list of nodes logical :: slopes !! a=true, b=false logical,dimension(:,:),allocatable :: visited logical,dimension(:),allocatable :: nodes_visited integer(ip),dimension(:),allocatable :: inodes, jnodes !! node coordinates integer(ip) :: max_dist, total_nodes, nrows, ncols character(len=1),dimension(:,:),allocatable :: array integer(ip),dimension(:),allocatable :: node_dist integer(ip),dimension(:),allocatable :: node_prev call clk%tic() ! call go('23a', 'inputs/day23_test.txt', .true. ) ! call go('23b', 'inputs/day23_test.txt', .false.) call go('23a', 'inputs/day23.txt', .true. ) call go('23b', 'inputs/day23.txt', .false.) call clk%toc('23') contains subroutine go(case, filename, parta) !! solve the case character(len=*),intent(in) :: case !! case name for printing character(len=*),intent(in) :: filename !! input file to read logical,intent(in) :: parta !! if this is part a, then consider the slopes integer(ip),dimension(1) :: iloc integer(ip) :: istart, iend, idist, i, j logical,parameter :: use_dijkstra = .false. !.... doesn't work yet .... don't know why ....... ! initialize: max_dist = 0 slopes = parta if (allocated(nodes)) deallocate(nodes) if (allocated(visited)) deallocate(visited) if (allocated(nodes_visited)) deallocate(nodes_visited) if (allocated(inodes)) deallocate(inodes) if (allocated(jnodes)) deallocate(jnodes) if (allocated(node_dist)) deallocate(node_dist) if (allocated(node_prev)) deallocate(node_prev) ! read the data file: array = read_file_to_char_array(filename) nrows = size(array,1) ncols = size(array,2) iloc = findloc(array(1,:), '.'); istart = iloc(1) ! get start and end columns iloc = findloc(array(nrows,:), '.'); iend = iloc(1) ! ! identify the coordinates of all the nodes: inodes = [1] ! start node jnodes = [istart] do i = 1, nrows do j = 1, ncols if (count_adjacent(i,j)>=3) then inodes = [inodes, i] jnodes = [jnodes, j] end if end do end do inodes = [inodes,nrows] ! end node jnodes = [jnodes,iend] total_nodes = size(inodes) ! for each node, find the other nodes they are ! connected to and the distances between them (the edges) allocate(nodes(total_nodes)) allocate(visited(nrows, ncols)) do i = 1, total_nodes visited = .false. idist = 0 call build_graph(i,inodes(i),jnodes(i),idist,visited) end do if (use_dijkstra) then !write(*,*) 'hello use_dijkstra' ! ... something wrong here... don't get the right answer ! based on AOC 2021, Problem 15 allocate(node_dist(total_nodes)); node_dist = -1; node_dist(1) = 0 allocate(node_prev(total_nodes)); node_prev = -1 allocate(nodes_visited(total_nodes)); nodes_visited = .false. do iloc = maxloc(node_dist, mask=.not. nodes_visited) i = iloc(1) nodes_visited(i) = .true. if (i==total_nodes) exit ! we are done! !write(*,*) 'visited ', i if (allocated(nodes(i)%inext)) then do j = 1, size(nodes(i)%inext) ! adjacent nodes to this one call dijkstra(i, j) end do end if !if (all(nodes_visited)) exit ! done end do !write(*,*) case, node_dist(size(node_dist)) ! result for this case (last node) !write(*,*) nodes_visited !write(*,*) node_dist else ! start at first, and find the longest that gets to the last. ! recursively traverse the graph. visited = .false. allocate(nodes_visited(total_nodes)); nodes_visited = .false. call traverse(1_ip, 0_ip, nodes_visited) write(*,*) case, max_dist ! result for this case end if end subroutine go subroutine dijkstra(u, inext) integer(ip),intent(in) :: u ! current integer(ip),intent(in) :: inext ! index in inext array of the next node integer(ip) :: idist associate (next_node => nodes(u)%inext(inext), & distance_to_next_node => nodes(u)%idist(inext)) if (nodes_visited(next_node)) return ! already visited this one idist = node_dist(u) + distance_to_next_node ! add distance from u to v if (idist > node_dist(next_node)) then !write(*,*) 'highest so far: ', idist node_dist(next_node) = idist node_prev(next_node) = u end if end associate end subroutine dijkstra recursive subroutine build_graph(node_num,i,j,idist,visited) integer(ip),intent(in) :: node_num !! current node number integer(ip),intent(in) :: i,j !! current position integer(ip),intent(in) :: idist !! current distance (number of steps) logical,dimension(:,:),intent(in) :: visited !! elements visited in this path (not counting this one) logical,dimension(:,:),allocatable :: tmp_visited integer(ip) :: child_node_num if (i<1 .or. i>nrows .or. j<1 .or. j>ncols) return if (visited(i,j)) return if (array(i,j)=='#') return ! can't continue from here ! go until we hit another node child_node_num = node_number(i,j) if (child_node_num>0 .and. child_node_num/=node_num) then ! we have reached another node call add_edge(node_num, child_node_num, idist) else ! continue processing this edge tmp_visited = visited !make a copy and mark this one tmp_visited(i,j) = .true. ! we are here now associate (a => get_cell(i,j)) ! paths (.), forest (#), and steep slopes (^, >, v, and <). select case (a) case ('.') ! path call build_graph(node_num,i-1,j ,idist+1,tmp_visited) call build_graph(node_num,i+1,j ,idist+1,tmp_visited) call build_graph(node_num,i, j+1,idist+1,tmp_visited) call build_graph(node_num,i, j-1,idist+1,tmp_visited) ! these don't have a choice, must go in these directions: case('^'); call build_graph(node_num, i-1,j, idist+1, tmp_visited) case('v'); call build_graph(node_num, i+1,j, idist+1, tmp_visited) case('>'); call build_graph(node_num, i, j+1,idist+1, tmp_visited) case('<'); call build_graph(node_num, i, j-1,idist+1, tmp_visited) end select end associate end if end subroutine build_graph recursive subroutine traverse(node_num, idist, nodes_visited) !! traverse the graph until we get to the end and check the max distance integer(ip),intent(in) :: node_num !! current node integer(ip),intent(in) :: idist !! distance to get here logical,dimension(:),intent(in) :: nodes_visited logical,dimension(:),allocatable :: tmp_nodes_visited integer :: i if (nodes_visited(node_num)) return ! already visited this node if (node_num==total_nodes) then ! reached the destination if (idist>max_dist) max_dist = idist ! best so far else ! are their child nodes? if (allocated(nodes(node_num)%inext)) then tmp_nodes_visited = nodes_visited tmp_nodes_visited(node_num) = .true. ! mark this node do i = 1, size(nodes(node_num)%inext) call traverse(nodes(node_num)%inext(i), idist + nodes(node_num)%idist(i), tmp_nodes_visited) end do end if end if end subroutine traverse pure logical function is_node(i,j) !! returns true if a node is at these coordinates integer(ip),intent(in) :: i,j is_node = any(inodes==i .and. jnodes==j) end function is_node subroutine add_edge(inode, ichild, idist) !! add an edge to this node (path to another node with the specified distance) integer(ip),intent(in) :: inode, ichild, idist if (.not. allocated(nodes(inode)%inext)) then allocate(nodes(inode)%inext(0)) allocate(nodes(inode)%idist(0)) end if nodes(inode)%inext = [nodes(inode)%inext, ichild] nodes(inode)%idist = [nodes(inode)%idist, idist] end subroutine add_edge pure integer(ip) function node_number(i,j) !! returns the index of these coordinates in !! the list of nodes (0 if it is not a node) integer(ip),intent(in) :: i,j integer(ip),dimension(1) :: iloc iloc = findloc(inodes==i .and. jnodes==j, .true.) node_number = iloc(1) end function node_number pure function count_adjacent(i,j) result(icount) !! count the number of adjacent cells not a tree integer(ip),intent(in) :: i,j integer(ip) :: icount icount = 0 if (i>=1) icount = icount + count([not_tree(i-1,j )]) if (i<=nrows) icount = icount + count([not_tree(i+1,j )]) if (j<=ncols) icount = icount + count([not_tree(i, j+1)]) if (j>=1) icount = icount + count([not_tree(i, j-1)]) end function count_adjacent pure function get_cell(i,j) result(a) integer(ip),intent(in) :: i,j !! coordinates character(len=1) :: a if (slopes) then a = array(i,j) else a = '.' ! ignore the slopes for part b end if end function get_cell pure logical function not_tree(i,j) !! returns true if the cell isn't a tree integer(ip),intent(in) :: i,j !! coordinates if (i<1 .or. i>nrows .or. j<1 .or. j>ncols) then not_tree = .false. ! off the board, call it a tree else not_tree = array(i,j) /= '#' end if end function not_tree end program problem_23