MODULE Data_Structures

  IMPLICIT NONE

  ! Élek típusa
  TYPE Edge
    INTEGER :: source         ! Az él kezdőpontjának indexe
    INTEGER :: destination    ! Az él végpontjának indexe
    REAL :: weight            ! Az él súlya
  END TYPE Edge

  ! Típus a listák csúcsaihoz
  TYPE Node
    TYPE(Edge) :: data                       ! A tárolt él
    TYPE(Node), POINTER :: next => NULL()    ! Mutató a következő csúcsra
    TYPE(Node), POINTER :: prev => NULL()    ! Mutató az előző csúcsra
  END TYPE Node

  ! Lista típus
  TYPE List
    TYPE(Node), POINTER :: first => NULL()    ! Mutató a lista kezdőcsúcsára
    TYPE(Node), POINTER :: last => NULL()     ! Mutató a lista utolsó csúcsára
    INTEGER :: length = 0                     ! A lista hossza
  END TYPE List

  ! Halmaz típus
  TYPE Set
    TYPE(List) :: l    ! A halmaz implementálásához felhasznált lista
  END Type Set

  ! Gráf típus
  TYPE Graph
    TYPE(Set) :: edges    ! A gráf éleinek halmaza
  END TYPE Graph

CONTAINS

  ! Az Edge típushoz tartozó függvények ----------------------------------------

  TYPE(Edge) FUNCTION Create_Edge(source, destination, weight)
    IMPLICIT NONE

    INTEGER, INTENT(IN) :: source, destination    ! Az él kezdő- és végpontja
    REAL, INTENT(IN) :: weight                    ! Az él súlya

    Create_Edge%source = source
    Create_Edge%destination = destination
    Create_Edge%weight = weight
  END FUNCTION Create_Edge

  ! A Node típushoz tartozó függvények -----------------------------------------

  ! Új csúcs létrehozása
  FUNCTION New_Node(data, next, prev)
    IMPLICIT NONE

    TYPE(Edge), INTENT(IN) :: data     ! A tárolandó él
    TYPE(Node), INTENT(IN), &
      TARGET, OPTIONAL :: next         ! A következő csúcs
    TYPE(Node), INTENT(IN), &
      TARGET, OPTIONAL :: prev         ! Az előző csúcs

    TYPE(Node), POINTER :: New_Node    ! Visszatérési érték

    ALLOCATE(New_Node)
    New_Node%data = data

    IF (PRESENT(next)) THEN
      New_Node%next => next
    ELSE
      NULLIFY(New_Node%next)
    END IF

    IF (PRESENT(prev)) THEN
      New_Node%prev => prev
    ELSE
      NULLIFY(New_Node%prev)
    END IF
  END FUNCTION New_Node

  ! Csúcs felszabadítása, a rákövetkező csúcsokkal együtt
  RECURSIVE SUBROUTINE Delete_Node(n)
    IMPLICIT NONE

    TYPE(Node), INTENT(INOUT), POINTER :: n    ! A felszabadítandó csúcsra mutat

    IF (ASSOCIATED(n%next)) THEN
      CALL Delete_Node(n%next)
    END IF

    DEALLOCATE(n)
  END SUBROUTINE Delete_Node

  ! A List típushoz tartozó függvények -----------------------------------------

  ! Lista kezdő állapotba hozása/ürítése
  SUBROUTINE Initialize_List(l)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amin a művelet végrehajtódik

    IF (ASSOCIATED(l%first)) THEN
      CALL Delete_Node(l%first)
    END IF

    NULLIFY(l%first)
    NULLIFY(l%last)
    l%length = 0
  END SUBROUTINE Initialize_List

  ! Lista kiírása
  SUBROUTINE Print_List(l, i_fmt, r_fmt)
    IMPLICIT NONE

    TYPE(List), INTENT(IN) :: l          ! A lista, amin a művelet végrehajtódik
    CHARACTER(LEN=*), OPTIONAL :: i_fmt  ! Az egészek kiírási formátuma
    CHARACTER(LEN=*), OPTIONAL :: r_fmt  ! A valósak kiírási formátuma

    TYPE(Node), POINTER :: p

    WRITE(*, "(A)", ADVANCE="NO") "["
    p => l%first
    DO WHILE (ASSOCIATED(p))
      WRITE(*, "(A)", ADVANCE="NO") "("
      CALL W_i(p%data%source)
      WRITE(*, "(A)", ADVANCE="NO") ", "
      CALL W_i(p%data%destination)
      WRITE(*, "(A)", ADVANCE="NO") ", "
      CALL W_r(p%data%weight)
      WRITE(*, "(A)", ADVANCE="NO") ")"
      IF (.NOT. ASSOCIATED(p, l%last)) THEN
        WRITE(*, "(A)", ADVANCE="NO") ", "
      END IF
      p => p%next
    END DO
    WRITE(*, "(A)") "]"
  CONTAINS
    SUBROUTINE W_i(i)
      IMPLICIT NONE

      INTEGER, INTENT(IN) :: i

      IF (PRESENT(i_fmt)) THEN
        WRITE(*, i_fmt, ADVANCE="NO") i
      ELSE
        WRITE(*, "(I12)", ADVANCE="NO") i
      END IF
    END SUBROUTINE W_i

    SUBROUTINE W_r(r)
      IMPLICIT NONE

      REAL, INTENT(IN) :: r

      IF (PRESENT(r_fmt)) THEN
        WRITE(*, r_fmt, ADVANCE="NO") r
      ELSE
        WRITE(*, "(F12.7)", ADVANCE="NO") r
      END IF
    END SUBROUTINE W_r
  END SUBROUTINE Print_List

  ! Elem beszúrása a lista elejére
  SUBROUTINE Push_Front(l, data)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amin a művelet végrehajtódik
    TYPE(Edge), INTENT(IN) :: data    ! A beszúrandó elem

    TYPE(Node), POINTER :: new

    new => New_Node(data, next=l%first)
    IF (ASSOCIATED(l%first)) THEN
      l%first%prev => new
    END IF
    l%first => new
    IF (l%length == 0) THEN
      l%last => new
    END IF
    l%length = l%length + 1
  END SUBROUTINE Push_Front

  ! Elem beszúrása a lista végére
  SUBROUTINE Push_Back(l, data)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amin a művelet végrehajtódik
    TYPE(Edge), INTENT(IN) :: data    ! A beszúrandó elem

    TYPE(Node), POINTER :: new

    new => New_Node(data, prev=l%last)
    IF (ASSOCIATED(l%last)) THEN
      l%last%next => new
    END IF
    IF (l%length == 0) THEN
      l%first => new
    END IF
    l%last => new
    l%length = l%length + 1
  END SUBROUTINE Push_Back

  ! Elem eltávolítása a lista elejéről
  TYPE(Edge) FUNCTION Pop_Front(l)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amin a művelet végrehajtódik

    TYPE(Node), POINTER :: temp

    IF (l%length > 0) THEN
      temp => l%first
      l%first => l%first%next
      Pop_Front = temp%data
      DEALLOCATE(temp)
      IF (l%length > 1) THEN
        NULLIFY(l%first%prev)
      ELSE
        NULLIFY(l%last)
      END IF
      l%length = l%length - 1
    END IF
  END FUNCTION Pop_Front

  ! Elem eltávolítása a lista végéről
  TYPE(Edge) FUNCTION Pop_Back(l)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amin a művelet végrehajtódik

    TYPE(Node), POINTER :: temp

    IF (l%length > 0) THEN
      temp => l%last
      l%last => l%last%prev
      Pop_Back = temp%data
      DEALLOCATE(temp)
      IF (l%length > 1) THEN
        NULLIFY(l%last%next)
      ELSE
        NULLIFY(l%first)
      END IF
      l%length = l%length - 1
    END IF
  END FUNCTION Pop_Back

  ! Adott csúcspár közötti él első előfordulásának keresése
  ! Visszatérési érték: - az elem sorszáma (a számozást 1-el kezdve)
  !                     - 0, ha az elem nem található meg
  INTEGER FUNCTION Find(l, d)
    IMPLICIT NONE

    TYPE(List), INTENT(IN) :: l    ! A lista, amiben keresünk
    TYPE(Edge), INTENT(IN) :: d

    TYPE(Node), POINTER :: p

    p => l%first
    Find = 1
    DO WHILE (ASSOCIATED(p))
      IF (p%data%source == d%source .AND. &
          p%data%destination == d%destination) THEN
        RETURN
      END IF
      p => p%next
      Find = Find + 1
    END DO
    Find = 0
  END FUNCTION Find

  ! Adott indexű él lekérdezése
  TYPE(Edge) FUNCTION Get_At(l, i)
    IMPLICIT NONE

    TYPE(List), INTENT(IN) :: l    ! A lista, amiből lekérdezünk
    INTEGER, INTENT(IN) :: i

    TYPE(Node), POINTER :: p
    INTEGER :: idx

    p => l%first
    IF (i >= 1 .AND. i <= l%length) THEN
      DO idx = 1, i-1
        p => p%next
      END DO
      Get_At = p%data
    END IF
  END FUNCTION Get_At

  ! Adott indexű él súlyának beállítása
  SUBROUTINE Set_At(l, i, w)
    IMPLICIT NONE

    TYPE(List), INTENT(INOUT) :: l    ! A lista, amiben módosítunk
    INTEGER, INTENT(IN) :: i
    REAL, INTENT(IN) :: w

    TYPE(Node), POINTER :: p
    INTEGER :: idx

    p => l%first
    IF (i >= 1 .AND. i <= l%length) THEN
      DO idx = 1, i-1
        p => p%next
      END DO
      p%data%weight = w
    END IF
  END SUBROUTINE Set_At

  ! A Set típushoz tartozó függvények ------------------------------------------

  ! Halmaz inicializálása
  SUBROUTINE Initialize_Set(s)
    IMPLICIT NONE

    TYPE(Set), INTENT(INOUT) :: s    ! A halmaz, amin a művelet végrehajtódik

    CALL Initialize_List(s%l)
  END SUBROUTINE Initialize_Set

  ! Halmaz kiírása
  SUBROUTINE Print_Set(s, i_fmt, r_fmt)
    IMPLICIT NONE

    TYPE(Set), INTENT(IN) :: s          ! A halmaz, amin a művelet végrehajtódik
    CHARACTER(LEN=*), OPTIONAL :: i_fmt ! Az egészek kiírási formátuma
    CHARACTER(LEN=*), OPTIONAL :: r_fmt ! A valósak kiírási formátuma

    TYPE(Node), POINTER :: p

    WRITE(*, "(A)", ADVANCE="NO") "{"
    p => s%l%first
    DO WHILE (ASSOCIATED(p))
      WRITE(*, "(A)", ADVANCE="NO") "("
      CALL W_i(p%data%source)
      WRITE(*, "(A)", ADVANCE="NO") ", "
      CALL W_i(p%data%destination)
      WRITE(*, "(A)", ADVANCE="NO") ", "
      CALL W_r(p%data%weight)
      WRITE(*, "(A)", ADVANCE="NO") ")"
      IF (.NOT. ASSOCIATED(p, s%l%last)) THEN
        WRITE(*, "(A)", ADVANCE="NO") ", "
      END IF
      p => p%next
    END DO
    WRITE(*, "(A)") "}"
  CONTAINS
    SUBROUTINE W_i(i)
      IMPLICIT NONE

      INTEGER, INTENT(IN) :: i

      IF (PRESENT(i_fmt)) THEN
        WRITE(*, i_fmt, ADVANCE="NO") i
      ELSE
        WRITE(*, "(I12)", ADVANCE="NO") i
      END IF
    END SUBROUTINE W_i

    SUBROUTINE W_r(r)
      IMPLICIT NONE

      REAL, INTENT(IN) :: r

      IF (PRESENT(r_fmt)) THEN
        WRITE(*, r_fmt, ADVANCE="NO") r
      ELSE
        WRITE(*, "(F12.7)", ADVANCE="NO") r
      END IF
    END SUBROUTINE W_r
  END SUBROUTINE Print_Set

  ! Él beszúrása
  ! Ha van már az adott kezdő- és végpont között él, akkor felülírja
  SUBROUTINE Add(s, d)
    IMPLICIT NONE

    TYPE(Set), INTENT(INOUT) :: s    ! A halmaz, amin a művelet végrehajtódik
    TYPE(Edge), INTENT(IN) :: d      ! A beszúrandó elem

    IF (Find(s%l, d) == 0) THEN
      CALL Push_Front(s%l, d)
    ELSE
      CALL Set_At(s%l, Find(s%l, d), d%weight)
    END IF
  END SUBROUTINE Add

  ! Elemszám lekérdezése
  INTEGER FUNCTION Cardinality(s)
    IMPLICIT NONE

    TYPE(Set), INTENT(IN) :: s    ! A halmaz, amit vizsgálunk

    Cardinality = s%l%length
  END FUNCTION Cardinality

  ! A Graph típushoz tartozó függvények ----------------------------------------

  ! Gráf inicializálása
  SUBROUTINE Initialize_Graph(g)
    IMPLICIT NONE

    TYPE(Graph), INTENT(INOUT) :: g    ! A gráf, amin a művelet végrehajtódik

    CALL Initialize_Set(g%edges)
  END SUBROUTINE Initialize_Graph

  ! Adott él súlyának lekérdezése
  REAL FUNCTION Weight_Of(g, source, destination)
    IMPLICIT NONE

    TYPE(Graph), INTENT(IN) :: g                  ! A gráf, amit vizsgálunk
    INTEGER, INTENT(IN) :: source, destination    ! Az él végpontjai

    TYPE(Edge) :: e

    IF (Find(g%edges%l, Create_Edge(source, destination, 0.0)) /= 0) THEN
      e = Get_At(g%edges%l, &
                 Find(g%edges%l, Create_Edge(source, destination, 0.0)))
      Weight_Of = e%weight
    END IF
  END FUNCTION Weight_Of

  ! Gráf beolvasása fájlból
  TYPE(Graph) FUNCTION From_File(fname)
    IMPLICIT NONE

    CHARACTER(LEN=*), INTENT(IN) :: fname

    INTEGER :: db, i, source, destination
    REAL :: weight

    CALL Initialize_Graph(From_File)

    OPEN(UNIT=13, FILE=fname, STATUS="OLD")
    READ(13, *) db
    DO i = 1, db
      READ(13, *) source, destination, weight
      CALL Add(From_File%edges, Create_Edge(source, destination, weight))
    END DO
    CLOSE(13)
  END FUNCTION

  ! A csúcsok indexeinek alsó és felső határa
  FUNCTION Vertex_Boundaries(g)
    IMPLICIT NONE

    TYPE(Graph), INTENT(IN) :: g    ! A gráf, amivel dolgozunk
    INTEGER, DIMENSION(1:2) :: Vertex_Boundaries

    INTEGER, DIMENSION(1:g%edges%l%length*2) :: vertexes
    INTEGER :: i
    TYPE(Edge) :: e

    DO i = 1, Cardinality(g%edges)
      e = Get_At(g%edges%l, i)
      vertexes(2*i-1) = e%source
      vertexes(2*i) = e%destination
    END DO

    Vertex_Boundaries(1) = MINVAL(vertexes)
    Vertex_Boundaries(2) = MAXVAL(vertexes)
  END FUNCTION Vertex_Boundaries

END MODULE Data_Structures