! 
! Copyright 2008 Shin'ya Murakami <murashin@epa.scitec.kobe-u.ac.jp>
! $Id:$
! 
! integer tuple とそのリストを扱うモジュール
! 
module mod_integertuplelist
  
  implicit none
  
  ! integer の tuple
  type IntegerTuple
     integer i
     integer j
  end type IntegerTuple

  ! integer の tuple のリンクリストのノード
  type IntegerTupleListNode
     type(IntegerTupleListNode), pointer :: n
     type(IntegerTupleListNode), pointer :: p
     type(IntegerTuple) data
  end type IntegerTupleListNode
  
  ! integer の tuple のリンクリスト
  type IntegerTupleList
     type(IntegerTupleListNode), pointer :: n
  end type IntegerTupleList
  
  ! 
  ! 演算子定義
  ! 
  interface operator ( == )
     module procedure it_is_equal
  end interface
  
contains
  
  ! 
  ! 初期化
  ! 
  subroutine itl_init(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node
    
    allocate(itl,node)
    itl%n => node
    nullify(node%n, node%p)
  end subroutine itl_init
  
  ! 
  ! 最初のノードを得る
  ! 
  function itl_get_first(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: retval
    
    retval => itl%n%n
  end function itl_get_first
  
  ! 
  ! 最後のノードを得る.
  ! 
  function itl_get_last(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: retval, node => null()
    
    node => itl_each_init(itl)
    retval => node
    do while(itl_each(node))
       retval => node
    end do
  end function itl_get_last
  
  ! 
  ! 指定したノードの次のノードを得る
  ! 
  function itln_get_next(node) result(retval)
    
    type(IntegerTupleListNode), pointer :: node, retval
    
    if(.not. associated(node))then
       nullify(retval)
    else
       retval => node%n
    end if
  end function itln_get_next
  
  ! 
  ! 指定したノードの前のノードを得る
  ! 
  function itln_get_prev(node) result(retval)
    
    type(IntegerTupleListNode), pointer :: node, retval
    
    if(.not. associated(node))then
       nullify(retval)
    else
       retval => node%p
    end if
  end function itln_get_prev
  
  ! 
  ! 指定したノードの次のノードを削除
  ! 
  function itln_remove_next(node) result(retval)
    
    type(IntegerTupleListNode), pointer :: node
    type(IntegerTuple) retval
    type(IntegerTupleListNode), pointer :: nnode => null()
    
    if(.not. associated(node))then
       print *, "error: node does not exist."
       call exit(1)
    end if
    if(.not. associated(node%n))then
       ! next node is null
       retval = IntegerTuple(-9999,-9999)
    else 
       nnode => node%n
       node%n => node%n%n
       if(associated(node%n))then ! 次の次のノードがある
          node%n%p => node
       end if
       retval = nnode%data
       deallocate(nnode)
    end if
  end function itln_remove_next
  
  !
  ! 指定したノードの次にdataを持つノードを挿入
  !
  subroutine itln_add(node, data)
    
    type(IntegerTupleListNode), pointer  :: node
    type(IntegerTuple), intent(in) :: data
    type(IntegerTupleListNode), pointer :: node_new => null()
    
    allocate(node_new)
    node_new%data = 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 itln_add
  
  !
  ! ノードの末尾にdataを持つノードを追加
  !
  subroutine itl_add_last(itl, data)
    
    type(IntegerTupleList), pointer  :: itl
    type(IntegerTuple), intent(in) :: data
    
    call itln_add(itl_get_last(itl), data)
  end subroutine itl_add_last
  
  !
  ! ノードの先頭にdataを持つノードを追加
  !
  subroutine itl_add_first(itl, data)
    
    type(IntegerTupleList), pointer  :: itl
    type(IntegerTuple), intent(in) :: data
    
    call itln_add(itl%n, data)
  end subroutine itl_add_first
  
  !
  ! 指定したノードのデータを取得
  ! 
  function itln_get_data(node) result(retval)
    
    type(IntegerTupleListNode), pointer   :: node
    type(IntegerTuple) retval
    
    retval = node%data
  end function itln_get_data
  
  ! 
  ! 指定したノードにデータをセット
  ! 
  subroutine itln_set_data(node, data)
    
    type(IntegerTupleListNode), pointer   :: node
    type(IntegerTuple), intent(in) :: data
    
    node%data = data
  end subroutine itln_set_data
  
  !
  ! 先頭ノードを削除
  ! 
  function itl_remove_first(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTuple) retval
    
    retval = itln_remove_next(itl%n)
  end function itl_remove_first
  
  ! 
  ! nodeの次にnode_newを挿入
  ! 
  subroutine itln_add_node(node, node_new)
    
    type(IntegerTupleListNode), 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 itln_add_node
  
  ! 
  ! itl の先頭にnodeを挿入
  ! 
  subroutine itl_add_node_at_first(itl, node)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node
    
    call itln_add_node(itl%n, node)
  end subroutine itl_add_node_at_first
  
  !
  ! 指定したノードを削除
  !
  function itln_remove(node) result(retval)
    
    type(IntegerTupleListNode), pointer :: node, retval
    type(IntegerTupleListNode), 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 itln_remove
  
  ! 
  ! リンクリストを解放する.
  ! 
  subroutine itl_destroy(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node => null(), nnode => null()
    
    node => itl%n
    deallocate(itl)
    nullify(itl)
    do while(associated(node%n))
       nnode => node%n
       deallocate(node)
       nullify(node)
       node => nnode
    end do
    deallocate(node)
    nullify(node)
  end subroutine itl_destroy
  
  ! 
  ! たどれるノードがいくつあるか数える.
  ! 特殊な先頭ノードは数えない.
  ! 
  integer function itl_size(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node => null()
    integer n
    
    n = 0
    node => itl_each_init(itl)
    do while(itl_each(node))
       n = n+1
    end do
    retval = n
  end function itl_size

!!!
!!! module specificなサブルーチン
!!!
  
  ! 
  ! tupleの順序を昇順にソート
  ! 
  subroutine it_sort_destructive(tpl)
    
    type(IntegerTuple), intent(inout) :: tpl
    
    integer tmp
    
    if(tpl%i > tpl%j)then
       tmp = tpl%i
       tpl%i = tpl%j
       tpl%j = tmp
    end if
  end subroutine it_sort_destructive

  ! 
  ! ループ用の初期化 
  ! 
  function itl_each_init(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: retval
    
    retval => itl%n
  end function itl_each_init
  
  ! 
  ! while loop用
  ! 
  logical function itl_each(node) result(retval)
    
    type(IntegerTupleListNode), pointer :: node
    
    node => node%n
    retval = associated(node)
  end function itl_each
  
  ! 
  ! 要素がゼロでない場合に真を返す.
  ! 
  logical function itl_exist(itl) result(retval)
    
    type(IntegerTupleList), pointer :: itl
    
    retval = associated(itl%n%n)
  end function itl_exist
  
  ! 
  ! TupleListの要素を昇順にソート
  ! 
  subroutine itl_sort(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: n1 => null(), n2 => null()
    
    ! リストのソートの前に, 各々の要素をソート.
    n1 => itl_each_init(itl)
    do while(itl_each(n1))
       call it_sort_destructive(n1%data)
    end do
    
    n1 => itl_each_init(itl)
    do while(itl_each(n1))
       n2 => n1
       do while(itl_each(n2))
          call itln_swap(n1, n2)
       end do
    end do
  end subroutine itl_sort
  
  ! 
  ! 指定したノードのデータ間を比較して, 昇順になるようにスワップ
  ! 
  subroutine itln_swap(n1, n2)
    
    type(IntegerTupleListNode), pointer :: n1, n2
    type(IntegerTuple) tmp
    
    if(n1%data%i == n2%data%i)then
       if(n1%data%j > n2%data%j)then
          tmp = n2%data
          n2%data = n1%data
          n1%data = tmp
       end if
    else if(n1%data%i > n2%data%i)then
       tmp = n2%data
       n2%data = n1%data
       n1%data = tmp
    end if
  end subroutine itln_swap
  
  ! 
  ! TupleListの各隣接要素でデータが同じ場合に削除する.
  ! 
  subroutine itl_uniq(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: n1 =>null(), n2 =>null()
    type(IntegerTuple) tmp

    n1 => itl%n%n
    if(associated(n1))then
       n2 => n1%n
       do while(associated(n2))
          if(n1%data == n2%data)then
             tmp = itln_remove_next(n1)
             n2 => n1%n
          else
             n1 => n1%n
             n2 => n2%n
          end if
       end do
    end if
  end subroutine itl_uniq
  
  ! 
  ! IntegerTupleListの各要素のtupleが同じ整数から成る場合に削除する.
  ! 
  subroutine itl_delete_if_equal(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node =>null(), pnode =>null()
    type(IntegerTuple) tmp
    
    node => itl_each_init(itl)
    do while(itl_each(node))
       pnode => node%p
       if(node%data%i == node%data%j)then
          tmp = itln_remove_next(node%p)
          node => pnode
       end if
    end do
  end subroutine itl_delete_if_equal
  
  !
  ! itlに含まれるid_oldをid_newにリプレイスする.
  !
  subroutine itl_replace(itl, id_old, id_new)
    
    type(IntegerTupleList), pointer :: itl
    integer id_old, id_new
    type(IntegerTupleListNode), pointer :: node => null()    
    
    node => itl_each_init(itl)
    do while(itl_each(node))
       if(node%data%i == id_old)then
          node%data%i = id_new
       end if
       if(node%data%j == id_old)then
          node%data%j = id_new
       end if
    end do
  end subroutine itl_replace
  
  ! 
  ! IntegerTupleの比較.
  ! 
  function it_is_equal(a,b) result(retval)
    
    type(IntegerTuple), intent(in) :: a,b
    type(IntegerTuple) x,y
    logical retval
    
    x = it_sort(a)
    y = it_sort(b)
    if(x%i == y%i .and. x%j == y%j)then
       retval = .true.
    else
       retval = .false.
    end if
  end function it_is_equal
  
  ! 
  ! aをソートしたものを返す.
  ! 
  function it_sort(a) result(retval)
    
    type(IntegerTuple), intent(in) :: a
    type(IntegerTuple) retval
    
    if(a%i <= a%j)then
       retval = a
    else
       retval%i = a%j
       retval%j = a%i
    end if
  end function it_sort
  
  ! 
  ! integer tupleリストのダンプ
  ! 
  subroutine itl_dump(itl)
    
    type(IntegerTupleList), pointer :: itl
    type(IntegerTupleListNode), pointer :: node
    integer i 
    
    i = 0
    if(itl_size(itl) > 0)then
       print *, "dumping integer tuple list...."
       node => itl_each_init(itl)
       do while(itl_each(node))
          i = i + 1
          print *, "itl_dump: ", i, node%data
       end do
       print *, "end of dumping"
    else
       print *, "dumping integer tuple list....null"
    end if
  end subroutine itl_dump
  
end module mod_integertuplelist
