! pointer3.f90

! This is the third of a series of programs to demonstrate use
! of derived types and pointers.

! a "find" subroutine has been added
! a partial "delete" subroutine has been added

program pointer3
  implicit none

  ! define the type "node" to be a node in a tree
  type node
    integer (kind=selected_int_kind(1)) :: bf    ! balance factor for later use
    type (node), pointer                :: left  ! left tree branch (smaller)
    type (node), pointer                :: right ! right tree branch (larger)
    character (len=2)                   :: name  ! sort key (can be any type)
    character (len=2)                   :: phone ! any amount of stuff
  end type node

  type (node), pointer :: root_ptr               ! the root of the tree
  integer :: depth = 0

  print *, " pointer3, find and partial delete"
  nullify(root_ptr)                              ! begin with empty tree

  ! build the tree to test the "insert" and "output" procedures
  ! note the special order of insertions to make the tree balanced
  !
  !                 D 4
  !                /   \
  !              /       \
  !           B 2         F 6        first tier
  !          /   \       /   \
  !        A 1   C 3   E 5   G 7     second tier
  !

  call insert(root_ptr, "D ", "4 ")   ! root node
  call insert(root_ptr, "B ", "2 ")   ! first tier
  call insert(root_ptr, "F ", "6 ")
  call insert(root_ptr, "A ", "1 ")   ! second tier
  call insert(root_ptr, "C ", "3 ")
  call insert(root_ptr, "E ", "5 ")
  call insert(root_ptr, "G ", "7 ")
  call output(root_ptr)
  print *, " find G ", find(root_ptr, "G ")
  print *, " find B ", find(root_ptr, "B ")
  print *, " find D ", find(root_ptr, "D ")
  print *, " find Z ", find(root_ptr, "Z ")   ! not in tree
  print *, " deleting G"
  call delete(root_ptr, "G ")
  call output(root_ptr)
  print *, " find G ", find(root_ptr, "G ")   ! gone
  print *, " deleting E"
  call delete(root_ptr, "E ")
  call output(root_ptr)
  print *, " deleting B"
  call delete(root_ptr, "B ")
  call output(root_ptr)
  print *, " deleting D"
  call delete(root_ptr, "D ")
  call output(root_ptr)
  print *, " pointer3 finished"
contains

  ! needed to simulate constructor  node(0, name, phone, null, null)
  function make_node(name, phone) result(new_node)
    character (len=2), intent(in) :: name
    character (len=2), intent(in) :: phone
    type (node), pointer :: new_node

    allocate(new_node)
    new_node%bf = 0                 ! initial balance factor zero
    nullify(new_node%left)          ! initial left pointer null
    nullify(new_node%right)         ! initial right pointer null
    new_node%name = name            ! fill in name
    new_node%phone = phone          ! fill in phone
  end function make_node            ! return pointer to constructed node

  ! subroutine to output an indented tree given a pointer to the root
  recursive subroutine output(t)
    type (node), pointer :: t

    depth = depth + 1                    ! indentation
    if(associated(t)) then
      call output(t%left)
      print *, repeat("    ", depth), t%name, t%phone
      call output(t%right)
    end if
    depth = depth -1                     ! unindent
  end subroutine output

  ! subroutine to insert a new node in a tree (not yet balanced)
  recursive subroutine insert(t, name, phone)
    type (node), pointer :: t
    character (len=2), intent(in) :: name
    character (len=2), intent(in) :: phone

    if(.not. associated(t)) then
      t => make_node(name, phone)          ! new root node
    else if(name < t%name) then
      call insert(t%left, name, phone)     ! smaller goes left
    else if(name > t%name) then
      call insert(t%right, name, phone)    ! larger goes right
    else
      t%phone = phone                      ! node already exists, new phone
    end if
  end subroutine insert

  ! function to find a phone given a name
  recursive function find(t, name) result (phone)
    type (node), pointer :: t
    character (len=2), intent(in) :: name
    character (len=2) :: phone

    phone = "**"                       ! default name if not found

    if(associated(t)) then
      if(name < t%name) then
        phone = find(t%left, name)     ! smaller goes left
      else if(name > t%name) then
        phone = find(t%right, name)    ! larger goes right
      else
        phone = t%phone                ! found it
      end if
    end if
  end function find

  ! subroutine to delete a node in a tree (partial, students finish)
  subroutine delete(t, name)
    type (node), pointer :: t
    character (len=2), intent(in) :: name
    type (node), pointer :: p         ! working node, walks tree
    type (node), pointer :: q         ! next higher node

    p => t
    q => t
    do while(associated(p))
      if(name < p%name) then
        q => p
        p => p%left                          ! smaller goes left
      else if(name > p%name) then
        q => p
        p => p%right                         ! larger goes right
      else                                   ! found, do delete cases
        if((.not. associated(p%left)) .and. &
           (.not. associated(p%right))) then ! simple case, delete node
          if(associated(p,t)) then
            deallocate(t)
          else if(associated(p,q%left)) then
            deallocate(q%left)
          else
            deallocate(q%right)
          end if
!
!       else if( ???? )    ! other cases for delete
!
        end if
        exit                                 ! have deleted node, done
      end if
    end do
  end subroutine delete

end program pointer3

! result of running pointer is :
! pointer3, find and partial delete
!             A 1
!         B 2
!             C 3
!     D 4
!             E 5
!         F 6
!             G 7
! find G 7
! find B 2
! find D 4
! find Z **
! deleting G
!             A 1
!         B 2
!             C 3
!     D 4
!             E 5
!         F 6
! find G **
! pointer3 finished