sort and search using binary tree

바이너리 트리를 이용한 정렬 및 탐색

PROGRAM binary_tree

USE btree

IMPLICIT NONE

INTEGER :: error
CHARACTER(LEN = 20) :: filename
INTEGER :: istat
CHARACTER(LEN = 40) :: error_msg
TYPE (node), POINTER :: root
TYPE (node), POINTER :: temp

NULLIFY(root, temp)

WRITE (*,*) 'Enter the file name with the input data: '
READ (*,'(A20)') filename

OPEN (UNIT = 9, FILE = filename, STATUS = 'OLD', ACTION = 'READ', IOSTAT = istat, IOMSG = error_msg)

IF (istat == 0) THEN
DO
ALLOCATE(temp, STAT = istat)
NULLIFY(temp%before, temp%after)

READ (9, 100, IOSTAT = istat) temp%last, temp%first, temp%mi, temp%phone
100 FORMAT (A10, 1X, A10, 1X, A1, 1X, A16)
IF (istat /= 0) EXIT
CALL add_node(root, temp)
END DO

WRITE (*,'(/,1X,A)') 'The sorted data list is: '
CALL write_node(root)

WRITE (*,'(/,1X,A)') 'Enter name to recover from tree:'
WRITE (*,'(1X,A)', ADVANCE = 'NO') 'Last Name : '
READ (*,'(A)') temp%last
WRITE (*,'(1X,A)', ADVANCE = 'NO') 'First Name : '
READ (*,'(A)') temp%first
WRITE (*,'(1X,A)', ADVANCE = 'NO') 'Middle Initial : '
READ (*,'(A)') temp%mi

CALL find_node(root, temp, error)
IF (error == 0) THEN
WRITE (*, '(/,1X,A)') 'The record is:'
WRITE (*, '(1X, 7A)') temp%last, ', ', temp%first, ', ', temp%mi, ', ', temp%phone
ELSE
WRITE (*,'(/,1X,A)') 'Specified node not found!'
END If

ELSE
WRITE (*,'(1X, A, A)') 'File open failed -- error message : ', error_msg
END IF

END PROGRAM binary_tree

위 소스를 binary_tree.f95로 저장

MODULE btree

IMPLICIT NONE

! restrict access to module contents
PRIVATE
PUBLIC :: node, OPERATOR(>), OPERATOR(<), OPERATOR(==)
PUBLIC :: add_node, write_node, find_node

TYPE :: node
CHARACTER(LEN = 10) :: last
CHARACTER(LEN = 10) :: first
CHARACTER :: mi
CHARACTER(LEN = 16) :: phone
TYPE (node), POINTER :: before
TYPE (node), POINTER :: after
END TYPE

INTERFACE OPERATOR (>)
MODULE PROCEDURE greater_than
END INTERFACE

INTERFACE OPERATOR (<)
MODULE PROCEDURE less_than
END INTERFACE

INTERFACE OPERATOR (==)
MODULE PROCEDURE equal_to
END INTERFACE

CONTAINS

RECURSIVE SUBROUTINE add_node(ptr, new_node)
! to add a new node to the binary tree structure

TYPE (node), POINTER :: ptr ! pointer to current pos. in tree
TYPE (node), POINTER :: new_node ! pointer to new node

IF (.NOT. ASSOCIATED(ptr)) THEN
! there is no tree yet
ptr => new_node
ELSE IF (new_node < ptr) THEN
IF (ASSOCIATED(ptr%before)) THEN
CALL add_node(ptr%before, new_node)
ELSE
ptr%before => new_node
END IF
ELSE
IF (ASSOCIATED(ptr%after)) THEN
CALL add_node(ptr%after, new_node)
ELSE
ptr%after => new_node
END IF
END IF
END SUBROUTINE add_node

RECURSIVE SUBROUTINE write_node(ptr)

! write out the contents of the binary tree structure in order
TYPE (node), POINTER :: ptr ! pointer to current pos. in tree

! write contents of previous node
IF (ASSOCIATED(ptr%before)) THEN
CALL write_node(ptr%before)
END IF

! write contents of current node
WRITE (*,"(1X,A,', ',A,1X,A)") ptr%last, ptr%first, ptr%mi

! write contents of next node
IF (ASSOCIATED(ptr%after)) THEN
CALL write_node(ptr%after)
END IF

END SUBROUTINE write_node

RECURSIVE SUBROUTINE find_node(ptr, search, error)

! to find a particular node in the tree
TYPE (node), POINTER :: ptr ! pointer to curr pos. in tree
TYPE (node), POINTER :: search ! pointer to value to find out
INTEGER :: error ! error : 0 = ok, 1 = not found

IF ( search < ptr ) THEN
IF (ASSOCIATED(ptr%before)) THEN
CALL find_node(ptr%before, search, error)
ELSE
error = 1
END IF
ELSE IF (search == ptr) THEN
search = ptr
error = 0
ELSE
IF (ASSOCIATED(ptr%after)) THEN
CALL find_node(ptr%after, search, error)
ELSE
error = 1
END IF
END IF

END SUBROUTINE find_node

LOGICAL FUNCTION greater_than(op1, op2)

TYPE (node), INTENT(IN) :: op1, op2
CHARACTER(LEN = 10) :: last1, last2, first1, first2
CHARACTER :: mi1, mi2

CALL ushift(op1, last1, first1, mi1)
CALL ushift(op2, last2, first2, mi2)

IF (last1 > last2) THEN
greater_than = .TRUE.
ELSE IF (last1 < last2) THEN
greater_than = .FALSE.
ELSE
IF (first1 > first2) THEN
greater_than = .TRUE.
ELSE IF (first1 < first2) THEN
greater_than = .FALSE.
ELSE
IF (mi1 > mi2) THEN
greater_than = .TRUE.
ELSE
greater_than = .FALSE.
END IF
END IF
END IF

END FUNCTION greater_than

LOGICAL FUNCTION less_than(op1, op2)

TYPE (node), INTENT(IN) :: op1, op2
CHARACTER(LEN = 10) :: last1, last2, first1, first2
CHARACTER :: mi1, mi2

CALL ushift(op1, last1, first1, mi1)
CALL ushift(op2, last2, first2, mi2)

IF (last1 < last2) THEN
less_than = .TRUE.
ELSE IF (last1 > last2) THEN
less_than = .FALSE.
ELSE
IF (first1 < first2) THEN
less_than = .TRUE.
ELSE IF (first1 > first2) THEN
less_than = .FALSE.
ELSE
IF (mi1 < mi2) THEN
less_than = .TRUE.
ELSE
less_than = .FALSE.
END IF
END IF
END IF

END FUNCTION less_than

LOGICAL FUNCTION equal_to(op1, op2)

TYPE(node), INTENT(IN) :: op1, op2
CHARACTER(LEN = 10) :: last1, last2, first1, first2
CHARACTER :: mi1, mi2

CALL ushift(op1, last1, first1, mi1)
CALL ushift(op2, last2, first2, mi2)

IF ((last1 == last2) .AND. (first1 == first2) .AND. (mi1 == mi2)) THEN
equal_to = .TRUE.
ELSE
equal_to = .FALSE.
END IF

END FUNCTION equal_to

SUBROUTINE ushift(op, last, first, mi)

TYPE (node), INTENT(IN) :: op
CHARACTER(LEN = 10), INTENT(INOUT) :: last, first
CHARACTER, INTENT(INOUT) :: mi

last = op%last
first = op%first
mi = op%mi

CALL ucase(last)
CALL ucase(first)
CALL ucase(mi)

END SUBROUTINE ushift


SUBROUTINE ucase (string)

IMPLICIT NONE

CHARACTER(LEN = *), INTENT(INOUT) :: string

INTEGER :: i
INTEGER :: length

length = LEN(string)

DO i = 1, length
IF (LGE(string(i:i), 'a') .AND. LLE(string(i:i), 'z')) THEN
string(i:i) = ACHAR(IACHAR(string(1:1)) - 32)
END IF
END DO

END SUBROUTINE ucase


END MODULE btree

위 소스를 btree.f95로 저장

Leroux Hector A (608) 555-1212
Johnson James R (800) 800-1111
Jackson Andrew D (713) 723-7777
Romanoff Alexi N (212) 338-3030
Johnson Jessie R (800) 800-1111
Chapman Stephen J (713) 721-0901
Nachshon Bini M (618) 813-1234
Ziskend Joseph J (805) 238-7999
Johnson Andrew C (504) 388-3000
Chi Shuchung F (504) 388-3123
deBerry Jonathan S (703) 765-4321
Chapman Rosa P (713) 721-0901
Gomez Jose A (415) 555-1212
Rosenberg Fred R (617) 123-4567

위 자료를 tree_in.dat 로 저장

컴파일 및 프로그램 테스트