! 
! Copyright 2008 Shin'ya Murakami <murashin@epa.scitec.kobe-u.ac.jp>
! $Id:$
! 
! integerのリスト
! 
module mod_integerlist
  
  implicit none
  
  type IntegerListNode
     type(IntegerListNode), pointer :: n
     type(IntegerListNode), pointer :: p
     integer i
  end type IntegerListNode
  
  type IntegerList
     type(IntegerListNode), pointer :: n
  end type IntegerList
  
contains
  
  ! 
  ! 初期化
  ! 
  subroutine il_init(il)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: node => null()
    
    nullify(il)
    allocate(il,node)
    il%n => node
    nullify(node%n, node%p)
  end subroutine il_init
  
  ! 
  ! 最初のノードを得る
  ! 
  function il_get_first(il) result(retval)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: retval
    
    retval => il%n%n
  end function Il_get_first
  
  ! 
  ! 最後のノードを得る.
  ! 
  function il_get_last(il) result(retval)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: retval, node => null()
    
    node => il_each_init(il)
    retval => node
    do while(il_each(node))
       retval => node
    end do
  end function il_get_last
  
  ! 
  ! 指定したノードの次のノードを得る
  ! 
  function iln_get_next(node) result(retval)
    
    type(IntegerListNode), pointer :: node, retval
    
    if(associated(node%n))then
       retval => node%n
    else ! last node.
       nullify(retval)
    end if
  end function Iln_get_next
  
  ! 
  ! 指定したノードの前のノードを得る
  ! 
  function iln_get_prev(node) result(retval)
    
    type(IntegerListNode), pointer :: node, retval
    
    if(associated(node%p))then
       retval => node%p
    else
       nullify(retval)
    end if
  end function iln_get_prev
  
  ! 
  ! 指定したノードの次のノードを削除
  ! 
  integer function iln_remove_next(node) result(retval)
    
    type(IntegerListNode), pointer :: node
    type(IntegerListNode), pointer :: node_next => null()
    
    if(.not. associated(node%n))then
       ! next node is null
       retval = -999
    else 
       node_next => node%n
       node%n => node%n%n
       if(associated(node%n))then ! 次の次のノードがある
          node%n%p => node
       end if
       retval = node_next%i
       deallocate(node_next)
    end if
  end function iln_remove_next
  
  !
  ! 指定したノードの次にdataを持つノードを挿入
  !
  subroutine iln_add(node, data)
    
    type(IntegerListNode), pointer :: node
    integer, intent(in) :: data
    type(IntegerListNode), pointer :: node_new => null()
    
    allocate(node_new)
    node_new%i = data
    node_new%n => node%n
    node_new%p => node
    if(associated(node%n))then
       node%n%p => node_new
    end if
    node%n => node_new
  end subroutine iln_add
  
  ! 
  ! リストの末尾にdataを持つノードを追加
  ! 
  subroutine il_add_last(il, data)
    
    type(IntegerList), pointer :: il
    integer, intent(in) :: data
    
    call iln_add(il_get_last(il), data)
  end subroutine il_add_last
  
  ! 
  ! リストの先頭にdataを持つノードを追加
  ! 
  subroutine il_add_first(il, data)
    
    type(IntegerList), pointer :: il
    integer, intent(in) :: data
    
    call iln_add(il%n, data)
  end subroutine il_add_first
  
  ! 
  ! 指定したノードのデータを取得
  ! 
  integer function iln_get_data(node) result(retval)
    
    type(IntegerListNode), pointer :: node
    
    retval = node%i
  end function iln_get_data
  
  ! 
  ! 指定したノードにデータをセット
  ! 
  subroutine iln_set_data(node, data)
    
    type(IntegerListNode), pointer :: node
    integer, intent(in) :: data
    
    node%i = data
  end subroutine iln_set_data
  
  !
  ! node の次にnode_newを挿入
  !
  subroutine iln_add_node(node, node_new)
    
    type(IntegerListNode), pointer :: node, node_new
    
    node_new%n => node%n
    node_new%p => node
    node%n => node_new
    if(associated(node_new%n))then
       node_new%n%p => node_new
    end if
  end subroutine iln_add_node
  
  !
  ! ilの先頭にnodeを挿入
  !
  subroutine il_add_node_at_first(il, node)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: node
    
    call iln_add_node(il%n, node)
  end subroutine il_add_node_at_first
  
  !
  ! 指定したノードを削除
  !
  function iln_remove_node(node) result(retval)
    
    type(IntegerListNode), pointer :: node, retval
    type(IntegerListNode), pointer :: nnode => null(), pnode => null()
   
    if(.not. associated(node%n))then
       pnode => node%p
       nullify(pnode%n, node%p)
       retval => node
    else ! others
       pnode => node%p
       nnode => node%n
       pnode%n => nnode
       nnode%p => pnode
       nullify(node%p, node%n)
       retval => node
    end if
  end function iln_remove_node
  
  ! 
  ! リンクリストを解放する.
  ! 
  subroutine il_destroy(il)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: node => null(), nnode => null()
    
    node => il%n
    deallocate(il)
    nullify(il)
    do while(associated(node%n))
       nnode => node%n
       deallocate(node)
       nullify(node)
       node => nnode
    end do
    deallocate(node)
    nullify(node)
  end subroutine il_destroy
  
  !
  ! while loop用のノード初期化
  !
  function il_each_init(il) result(retval)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: retval
    
    retval => il%n
  end function il_each_init
  
  !
  ! while loop用
  !
  logical function il_each(node) result(retval)
    
    type(IntegerListNode), pointer :: node
    
    node => node%n
    retval = associated(node)
  end function il_each
  
  !
  ! ノードがいくつあるか数える.
  ! 特殊な先頭ノードは数えない.
  ! 
  function il_size(il) result(retval)
    
    type(IntegerList), pointer :: il
    integer retval, n
    type(IntegerListNode), pointer :: node => null()
    
    n = 0
    node => il_each_init(il)
    do while(il_each(node))
       n = n+1
    end do
    retval = n
  end function il_size

  ! 
  ! il1にil2をくっつける.
  ! 
  subroutine il_attach_list(il1, il2)
    
    type(IntegerList), pointer :: il1, il2
    type(IntegerListNode), pointer :: n1=> null(), n2=> null()
    
    n1 => il_get_last(il1)
    n2 => il2%n%n
    if(associated(n1))then
       if(associated(n2))then
          ! n1, n2 ともにある
          n1%n => n2
          n2%p => n1
          nullify(il2%n%n)
       else
          ! n1 はある, n2は null
          ! そのまま
       end if
    else if(associated(n2))then
       ! n1 は null, n2はある
       il1%n%n => n2
       n2%p => il1%n
       nullify(il2%n%n)
    else
       ! n1, n2 はともに null
       ! そのまま
    end if
    call il_destroy(il2)
  end subroutine il_attach_list
  
  ! 
  ! IntegerListのダンプ
  ! 
  subroutine il_dump(il)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: node
    integer i 
    
    i = 0
    print *, "dumping integer list...."
    node => il_each_init(il)
    do while(il_each(node))
       i = i + 1
       print *, "il: ", node%i
    end do
    print *, "end of dumping"
  end subroutine il_dump
  
  ! 
  ! deep copy
  ! 
  function il_deepcopy(il) result(retval)
    
    type(IntegerList), pointer :: il, retval, il2 => null()
    type(IntegerListNode), pointer :: node => null(), node2 => null()
    
    call il_init(il2)
    node => il_each_init(il)
    node2 => il2%n
    do while(il_each(node))
       call iln_add(node2, node%i)
       node2 => node2%n
    end do
    retval => il2
  end function il_deepcopy
  
  ! 
  ! IntegerListの要素を昇順にソート
  ! 
  subroutine il_sort(il)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: n1 => null(), n2 => null()
    
    n1 => il_each_init(il)
    do while(il_each(n1))
       n2 => n1
       do while(il_each(n2))
          call iln_swap(n1, n2)
       end do
    end do
  end subroutine il_sort
  
  ! 
  ! 指定したノードのデータ間を比較して, 昇順になるようにスワップ
  ! 
  subroutine iln_swap(n1, n2)
    
    type(IntegerListNode), pointer :: n1, n2
    integer tmp
    
    if(n1%i > n2%i)then
       tmp = n2%i
       n2%i = n1%i
       n1%i = tmp
    end if
  end subroutine iln_swap
  
  ! 
  ! IntegerListの各隣接要素でデータが同じ場合に削除する.
  ! 
  subroutine il_uniq(il)
    
    type(IntegerList), pointer :: il
    type(IntegerListNode), pointer :: n1 =>null(), n2 =>null()
    integer tmp
    
    n1 => il%n%n
    if(associated(n1))then
       n2 => n1%n
       do while(associated(n2))
          if(n1%i == n2%i)then
             tmp = iln_remove_next(n1)
             n2 => n1%n
          else
             n1 => n1%n
             n2 => n2%n
          end if
       end do
    end if
  end subroutine il_uniq
  
  ! 
  ! iをデータとするノードを返す
  ! 
  function il_get_node_by_data(il, i) result(retval)
    
    type(IntegerList), pointer :: il
    integer, intent(in) :: i
    type(IntegerListNode), pointer :: node =>null(), retval
    
    if(.not. associated(il))then
       print *, "error: cannot access integer list."
    end if
    
    node => il_each_init(il)
    do while(il_each(node))
       if(node%i == i)then
          retval => node
          return
       end if
    end do
    nullify(retval)
  end function il_get_node_by_data
  
  ! 
  ! iをデータとするノードを含むかどうか. 含む場合は node にその
  ! ノードを入れる.
  ! 
  logical function il_include_data(il, i, node) result(retval)
    
    type(IntegerList), pointer :: il
    integer, intent(in) :: i
    type(IntegerListNode), pointer :: node
    
    node => il_get_node_by_data(il, i)
    retval = associated(node)
  end function il_include_data

end module mod_integerlist
