223 lines
10 KiB
Fortran
223 lines
10 KiB
Fortran
! =============================================================================
|
|
! tree_traversal.f90
|
|
!
|
|
! Demonstrates four classic binary-tree traversal algorithms on the following
|
|
! hand-built nine-node tree:
|
|
!
|
|
! 1
|
|
! / \
|
|
! 2 3
|
|
! / \ /
|
|
! 4 5 6
|
|
! / / \
|
|
! 7 8 9
|
|
!
|
|
! Expected output:
|
|
! preorder: 1 2 4 7 5 3 6 8 9
|
|
! inorder: 7 4 2 5 1 8 6 9 3
|
|
! postorder: 7 4 5 2 8 9 6 3 1
|
|
! level-order: 1 2 3 4 5 6 7 8 9
|
|
! =============================================================================
|
|
program tree_traversal
|
|
implicit none
|
|
|
|
! ------------------------------------------------------------------
|
|
! node -- one element of the binary tree.
|
|
! val : the integer payload stored at this node
|
|
! left : pointer to the left child (null => no left child)
|
|
! right : pointer to the right child (null => no right child)
|
|
! ------------------------------------------------------------------
|
|
type :: node
|
|
integer :: val
|
|
type(node), pointer :: left => null()
|
|
type(node), pointer :: right => null()
|
|
end type node
|
|
|
|
! ------------------------------------------------------------------
|
|
! node_ptr -- thin wrapper that lets us build an array of pointers.
|
|
! Fortran does not allow "type(node), pointer :: arr(n)" directly, so
|
|
! we embed the pointer in a derived type and make an array of that.
|
|
! Used only by level_order as a fixed-size FIFO queue.
|
|
! ------------------------------------------------------------------
|
|
type :: node_ptr
|
|
type(node), pointer :: p => null()
|
|
end type node_ptr
|
|
|
|
! root is the entry point to the whole tree
|
|
type(node), pointer :: root
|
|
|
|
! ------------------------------------------------------------------
|
|
! Build the tree by allocating nodes one at a time and wiring up the
|
|
! parent/child pointer relationships. new_node() allocates a fresh
|
|
! node, stores the value, and nullifies both child pointers.
|
|
!
|
|
! Visual layout of pointer assignments below:
|
|
!
|
|
! root (1)
|
|
! +-- left --> (2)
|
|
! | +-- left --> (4)
|
|
! | | +-- left --> (7) [leaf]
|
|
! | | +-- right --> [none]
|
|
! | +-- right --> (5) [leaf]
|
|
! +-- right --> (3)
|
|
! +-- left --> (6)
|
|
! | +-- left --> (8) [leaf]
|
|
! | +-- right --> (9) [leaf]
|
|
! +-- right --> [none]
|
|
! ------------------------------------------------------------------
|
|
root => new_node(1) ! tree root
|
|
root%left => new_node(2) ! depth 1, left subtree
|
|
root%right => new_node(3) ! depth 1, right subtree
|
|
root%left%left => new_node(4) ! depth 2
|
|
root%left%right => new_node(5) ! depth 2, leaf
|
|
root%right%left => new_node(6) ! depth 2
|
|
root%left%left%left => new_node(7) ! depth 3, leaf
|
|
root%right%left%left => new_node(8) ! depth 3, leaf
|
|
root%right%left%right => new_node(9) ! depth 3, leaf
|
|
|
|
! ------------------------------------------------------------------
|
|
! Preorder: root -> left subtree -> right subtree
|
|
! Each node is visited BEFORE its children, so the root always
|
|
! appears first and every subtree root appears before its descendants.
|
|
! ------------------------------------------------------------------
|
|
write(*,'(a)', advance='no') 'preorder: '
|
|
call preorder(root)
|
|
write(*,*) ! newline after values
|
|
|
|
! ------------------------------------------------------------------
|
|
! Inorder: left subtree -> root -> right subtree
|
|
! For a binary SEARCH tree this would yield sorted ascending order,
|
|
! but this tree is not a BST -- it merely demonstrates the traversal.
|
|
! ------------------------------------------------------------------
|
|
write(*,'(a)', advance='no') 'inorder: '
|
|
call inorder(root)
|
|
write(*,*)
|
|
|
|
! ------------------------------------------------------------------
|
|
! Postorder: left subtree -> right subtree -> root
|
|
! Each node is visited AFTER both its children, so the root always
|
|
! appears last. Useful for safely deallocating a tree (free children
|
|
! before the parent).
|
|
! ------------------------------------------------------------------
|
|
write(*,'(a)', advance='no') 'postorder: '
|
|
call postorder(root)
|
|
write(*,*)
|
|
|
|
! ------------------------------------------------------------------
|
|
! Level-order (breadth-first): visit every node at depth d before any
|
|
! node at depth d+1, scanning left to right within each level.
|
|
! Implemented iteratively with a FIFO queue rather than recursion.
|
|
! ------------------------------------------------------------------
|
|
write(*,'(a)', advance='no') 'level-order: '
|
|
call level_order(root)
|
|
write(*,*)
|
|
|
|
contains
|
|
|
|
! ------------------------------------------------------------------
|
|
! new_node(val)
|
|
! Allocate a new tree node, store val, null both child pointers.
|
|
! Returns a pointer to the newly allocated node.
|
|
! ------------------------------------------------------------------
|
|
function new_node(val) result(n)
|
|
integer, intent(in) :: val
|
|
type(node), pointer :: n
|
|
allocate(n) ! heap-allocate one node record
|
|
n%val = val
|
|
n%left => null() ! no left child yet
|
|
n%right => null() ! no right child yet
|
|
end function new_node
|
|
|
|
! ------------------------------------------------------------------
|
|
! preorder(n) -- recursive, depth-first
|
|
! Visit pattern: SELF left right
|
|
! Base case: if n is not associated (null pointer) do nothing.
|
|
! ------------------------------------------------------------------
|
|
recursive subroutine preorder(n)
|
|
type(node), pointer, intent(in) :: n
|
|
if (.not. associated(n)) return ! null pointer: nothing to do
|
|
write(*,'(i0," ")', advance='no') n%val ! print this node first
|
|
call preorder(n%left) ! then recurse into left child
|
|
call preorder(n%right) ! then recurse into right child
|
|
end subroutine preorder
|
|
|
|
! ------------------------------------------------------------------
|
|
! inorder(n) -- recursive, depth-first
|
|
! Visit pattern: left SELF right
|
|
! The left subtree is fully exhausted before the current node is
|
|
! printed, and the right subtree is visited last.
|
|
! ------------------------------------------------------------------
|
|
recursive subroutine inorder(n)
|
|
type(node), pointer, intent(in) :: n
|
|
if (.not. associated(n)) return ! base case: null pointer
|
|
call inorder(n%left) ! recurse left first
|
|
write(*,'(i0," ")', advance='no') n%val ! print this node second
|
|
call inorder(n%right) ! recurse right last
|
|
end subroutine inorder
|
|
|
|
! ------------------------------------------------------------------
|
|
! postorder(n) -- recursive, depth-first
|
|
! Visit pattern: left right SELF
|
|
! Both subtrees are fully exhausted before the current node is
|
|
! printed, so leaves always appear before their parents.
|
|
! ------------------------------------------------------------------
|
|
recursive subroutine postorder(n)
|
|
type(node), pointer, intent(in) :: n
|
|
if (.not. associated(n)) return ! base case: null pointer
|
|
call postorder(n%left) ! recurse left
|
|
call postorder(n%right) ! recurse right
|
|
write(*,'(i0," ")', advance='no') n%val ! print this node last
|
|
end subroutine postorder
|
|
|
|
! ------------------------------------------------------------------
|
|
! level_order(root_node) -- iterative, breadth-first
|
|
!
|
|
! Algorithm (standard BFS with a FIFO queue):
|
|
! 1. Enqueue the root.
|
|
! 2. While the queue is non-empty:
|
|
! a. Dequeue the front node.
|
|
! b. Print its value.
|
|
! c. Enqueue its left child if it exists.
|
|
! d. Enqueue its right child if it exists.
|
|
!
|
|
! Queue implementation: a fixed-size array of node_ptr wrappers.
|
|
! head = index of the next item to dequeue (front of queue)
|
|
! tail = index of the next free slot (back of queue)
|
|
! The queue holds at most 100 pointers; plenty for this 9-node tree.
|
|
! head < tail means the queue is non-empty.
|
|
! ------------------------------------------------------------------
|
|
subroutine level_order(root_node)
|
|
type(node), pointer, intent(in) :: root_node
|
|
type(node_ptr) :: queue(100) ! fixed-size array-based FIFO queue
|
|
type(node), pointer :: cur ! node being processed this iteration
|
|
integer :: head ! index of front element (next dequeue)
|
|
integer :: tail ! index of next free slot (next enqueue)
|
|
|
|
! Initialise queue with just the root
|
|
head = 1
|
|
tail = 1
|
|
queue(tail)%p => root_node ! enqueue root at position 1
|
|
tail = tail + 1 ! tail now points to next free slot (2)
|
|
|
|
! Process until the queue is drained
|
|
do while (head < tail) ! head == tail means queue is empty
|
|
cur => queue(head)%p ! dequeue: read the front element
|
|
head = head + 1 ! advance head (slot is now "consumed")
|
|
|
|
write(*,'(i0," ")', advance='no') cur%val ! visit: print value
|
|
|
|
! Enqueue left child if it exists
|
|
if (associated(cur%left)) then
|
|
queue(tail)%p => cur%left
|
|
tail = tail + 1
|
|
end if
|
|
|
|
! Enqueue right child if it exists
|
|
if (associated(cur%right)) then
|
|
queue(tail)%p => cur%right
|
|
tail = tail + 1
|
|
end if
|
|
end do
|
|
end subroutine level_order
|
|
|
|
end program tree_traversal
|