module DataStructures
    implicit none

    private
    public :: GenericStack, GenericQueue, GenericLinkedList, MathematicalExpression
    public :: BaseVertex, OperatorVertex, ConstantVertex, VariableVertex
    public :: IsEmpty, Clear, Top, Push, Pop, Enqueue, Dequeue, Add, At, InsertAt, RemoveAt, GetSize, Evaluate, InOrder

	! A láncolt adatszerkezet egy láncszeme ilyen struktúrájú lesz
    type Node
        class(*), pointer :: Data
        type(Node), pointer :: Next => null()
    end type Node

	! A publikus verem adatszerkezet
    type GenericStack
        type(Node), pointer, private :: First => null()
    end type GenericStack

	! A publikus sor adatszerkezet
    type GenericQueue
        type(Node), pointer, private :: First => null(), Last => null()
    end type GenericQueue

	! A publikus láncolt lista adatszerkezet
    type GenericLinkedList
        type(Node), pointer, private :: First => null(), Last => null()
        integer, private :: Size = 0
    end type GenericLinkedList

	! A publikus matematikai kifejezés adatszerekezet
    type MathematicalExpression
        class(BaseVertex), pointer :: Root => null()
    end type MathematicalExpression

	! A matematikai kifejezés egy vertexpontjának bázisosztálya
    type, abstract :: BaseVertex
        class(BaseVertex), pointer :: LeftChild => null(), RightChild => null()
    end type BaseVertex

    type, extends(BaseVertex) :: OperatorVertex
        character :: Type
    end type OperatorVertex

    type, extends(BaseVertex) :: ConstantVertex
        double precision :: Value
    end type ConstantVertex

    type, extends(BaseVertex) :: VariableVertex
    end type VariableVertex

	! Az adatszerezetek üresség lekérdező függvényéhez definiált interfész
    interface IsEmpty
        module procedure StackIsEmpty
        module procedure QueueIsEmpty
        module procedure LinkedListIsEmpty
    end interface IsEmpty

	! Az adatszerkezetek üressé tévő eljárásának interfésze
    interface Clear
        module procedure StackClear
        module procedure QueueClear
        module procedure LinkedListClear
    end interface Clear

contains

	! ------------- A VEREM MŰVELETEI -------------
    logical function StackIsEmpty(gStack)
        implicit none
        type(GenericStack), intent(in) :: gStack
        StackIsEmpty = .not. associated(gStack%First)
    end function StackIsEmpty

    function Top(gStack)
        implicit none
        class(*), pointer :: Top
        type(GenericStack), intent(in) :: gStack
        Top => gStack%First%Data
    end function Top

    subroutine StackClear(gStack)
        implicit none
        type(GenericStack), intent(inout) :: gStack
        type(Node), pointer :: Iterator, Tmp
        Iterator => gStack%First
        do while(associated(Iterator))
            Tmp => Iterator
            Iterator => Iterator%Next
            deallocate(Tmp)
        end do
        gStack%First => null()
    end subroutine StackClear

    subroutine Push(gStack, data)
        implicit none
        type(GenericStack), intent(inout) :: gStack
        class(*), pointer, intent(in) :: data
        type(Node), pointer :: Tmp
        allocate(Tmp)
        Tmp%Next => gStack%First
        Tmp%Data => data
        gStack%First => Tmp
    end subroutine Push

    function Pop(gStack)
        implicit none
        class(*), pointer :: Pop
        type(GenericStack), intent(inout) :: gStack
        type(Node), pointer :: Tmp
        Pop => gStack%First%Data
        Tmp => gStack%First
        gStack%First => Tmp%Next
        deallocate(Tmp)
    end function Pop

	! ------------- A SOR MŰVELETEI -------------
    logical function QueueIsEmpty(gQueue)
        implicit none
        type(GenericQueue), intent(in) :: gQueue
        QueueIsEmpty = .not. associated(gQueue%First)
    end function QueueIsEmpty

    function Peek(gQueue)
        implicit none
        class(*), pointer :: Peek
        type(GenericQueue), intent(in) :: gQueue
        Peek => gQueue%First%Data
    end function Peek

    subroutine QueueClear(gQueue)
        implicit none
        type(GenericQueue), intent(inout) :: gQueue
        type(Node), pointer :: Iterator, Tmp
        Iterator => gQueue%First
        do while(associated(Iterator))
            Tmp => Iterator
            Iterator => Iterator%Next
            deallocate(Tmp)
        end do
        gQueue%First => null()
        gQueue%Last => null()
    end subroutine QueueClear

    subroutine Enqueue(gQueue, data)
        implicit none
        type(GenericQueue), intent(inout) :: gQueue
        class(*), pointer, intent(in) :: data
        if(.not. associated(gQueue%First)) then
            allocate(gQueue%First)
            gQueue%First%Data => data
            gQueue%Last => gQueue%First
        else
            allocate(gQueue%Last%Next)
            gQueue%Last => gQueue%Last%Next
            gQueue%Last%Data => data
        end if
    end subroutine Enqueue

    function Dequeue(gQueue)
        implicit none
        class(*), pointer :: Dequeue
        type(GenericQueue), intent(inout) :: gQueue
        type(Node), pointer :: Tmp
        Dequeue => gQueue%First%Data
        Tmp => gQueue%First
        gQueue%First => gQueue%First%Next
        deallocate(Tmp)
        if(.not. associated(gQueue%First)) gQueue%Last => null()
    end function Dequeue

	! ------------- A LÁNCOLT LISTA MŰVELETEI -------------
    logical function LinkedListIsEmpty(gLinkedList)
        implicit none
        type(GenericLinkedList), intent(in) :: gLinkedList
        LinkedListIsEmpty = gLinkedList%Size .eq. 0
    end function LinkedListIsEmpty

    subroutine LinkedListClear(gLinkedList)
        implicit none
        type(GenericLinkedList), intent(inout) :: gLinkedList
        type(Node), pointer :: Iterator, Tmp
        Iterator => gLinkedList%First
        do while(associated(Iterator))
            Tmp => Iterator
            Iterator => Iterator%Next
            deallocate(Tmp)
        end do
        gLinkedList%First => null()
        gLinkedList%Last => null()
        gLinkedList%Size = 0
    end subroutine LinkedListClear

    integer function GetSize(gLinkedList)
        implicit none
        type(GenericLinkedList), intent(in) :: gLinkedList
        GetSize = gLinkedList%Size
    end function GetSize

    subroutine Add(gLinkedList, data)
        implicit none
        type(GenericLinkedList), intent(inout) :: gLinkedList
        class(*), pointer, intent(in) :: data
        if(.not. associated(gLinkedList%First)) then
            allocate(gLinkedList%First)
            gLinkedList%First%Data => data
            gLinkedList%Last => gLinkedList%First
        else
            allocate(gLinkedList%Last%Next)
            gLinkedList%Last => gLinkedList%Last%Next
            gLinkedList%Last%Data => data
        end if
        gLinkedList%Size = gLinkedList%Size + 1
    end subroutine Add

    function At(gLinkedList, index)
        implicit none
        class(*), pointer :: At
        type(GenericLinkedList), intent(in) :: gLinkedList
        integer, intent(in) :: index
        type(Node), pointer :: Iterator
        integer :: i
        Iterator => gLinkedList%First
        do i = 0, index - 1
            Iterator => Iterator%Next
        end do
        At => Iterator%Data
    end function At

    subroutine InsertAt(gLinkedList, data, index)
        implicit none
        type(GenericLinkedList), intent(inout) :: gLinkedList
        class(*), pointer, intent(in) :: data
        integer, intent(in) :: index
        type(Node), pointer :: Iterator, Tmp
        integer i
        if(index .eq. gLinkedList%Size) then
            call Add(gLinkedList, data)
        else if(index .eq. 0) then
            allocate(Tmp)
            Tmp%Data => data
            Tmp%Next => gLinkedList%First
            gLinkedList%First => Tmp
            gLinkedList%Size = gLinkedList%Size + 1
        else
            Iterator => gLinkedList%First
            do i = 0, index - 2
                Iterator => Iterator%Next
            end do
            allocate(Tmp)
            Tmp%Data => data
            Tmp%Next => Iterator%Next
            Iterator%Next => Tmp
            gLinkedList%Size = gLinkedList%Size + 1
        end if
    end subroutine InsertAt

    subroutine RemoveAt(gLinkedList, index)
        implicit none
        type(GenericLinkedList), intent(inout) :: gLinkedList
        integer, intent(in) :: index
        type(Node), pointer :: Iterator, Tmp
        integer i
        if(index .eq. 0) then
            Tmp => gLinkedList%First
            gLinkedList%First => gLinkedList%First%Next
            deallocate(Tmp)
            gLinkedList%Size = gLinkedList%Size - 1
            if(gLinkedList%Size .eq. 0) then
                gLinkedList%First => null()
                gLinkedList%Last => null()
            end if
        else
            Iterator => gLinkedList%First
            do i = 0, index - 2
                Iterator => Iterator%Next
            end do
            Tmp => Iterator%Next
            Iterator%Next => Iterator%Next%Next
            deallocate(Tmp)
            gLinkedList%Size = gLinkedList%Size - 1
            if(.not. associated(Iterator%Next)) gLinkedList%Last => Iterator
        end if
    end subroutine RemoveAt

	! ------------- A MATEMATIKAI KIFEJEZÉS MŰVELETEI -------------
    recursive function Evaluate(root, x) result (eval_result)
        implicit none
        double precision eval_result
        class(BaseVertex), pointer, intent(in) :: root
        double precision, intent(in) :: x
        select type(root)
            type is(OperatorVertex)
                select case(root%Type)
                    case('+')
                        eval_result = Evaluate(root%LeftChild, x) + Evaluate(root%RightChild, x)
                    case('-')
                        eval_result = Evaluate(root%LeftChild, x) - Evaluate(root%RightChild, x)
                    case('*')
                        eval_result = Evaluate(root%LeftChild, x) * Evaluate(root%RightChild, x)
                    case('/')
                        eval_result = Evaluate(root%LeftChild, x) / Evaluate(root%RightChild, x)
                end select
            type is(ConstantVertex)
                eval_result = root%Value
            type is(VariableVertex)
                eval_result = x
        end select
    end function Evaluate

    recursive subroutine InOrder(root)
        implicit none
        class(BaseVertex), pointer, intent(in) :: root
        if(associated(root%LeftChild)) then
            write (*, "(a)", advance = "no") '('
            call InOrder(root%LeftChild)
        end if
        select type(root)
            type is(OperatorVertex)
                select case(root%Type)
                    case('+')
                        write (*, "(a)", advance = "no") '+'
                    case('-')
                        write (*, "(a)", advance = "no") '-'
                    case('*')
                        write (*, "(a)", advance = "no") '*'
                    case('/')
                        write (*, "(a)", advance = "no") '/'
                end select
            type is(ConstantVertex)
                write (*, "(f3.1)", advance = "no") root%Value
            type is(VariableVertex)
                write (*, "(a)", advance = "no") 'x'
        end select
        if(associated(root%RightChild)) then
            call InOrder(root%RightChild)
            write (*, "(a)", advance = "no") ')'
        end if
    end subroutine InOrder

	! EZ KI VAN KOMMENTEZVE MERT A MINGW 4.8.2 GFORTRAN FORDÍTÓJA INTERNAL COMPILER ERRORRAL ELSZÁLL TŐLE
!    subroutine DeleteTree(root)
!        implicit none
!        class(BaseVertex), pointer, intent(inout) :: root
!        type(GenericStack) Vertices
!        class(BaseVertex), pointer :: ActualVertex
!        class(*), pointer :: ActualData
!        class(*), pointer :: ActualDataTMP
!        ActualData => root
!        call Push(Vertices, ActualData)
!        do while(.not. IsEmpty(Vertices))
!            ActualData => Pop(Vertices)
!            select type(ActualData)
!                class is(BaseVertex)
!                    ActualVertex => ActualData
!                    if(associated(ActualVertex%LeftChild, ActualVertex%RightChild)) then
!                        ActualDataTMP => ActualVertex%LeftChild
!                        call Push(Vertices, ActualDataTMP)
!                        ActualDataTMP => ActualVertex%RightChild
!                        call Push(Vertices, ActualDataTMP)
!                    end if
!                    deallocate(ActualVertex)
!            end select
!        end do
!    end subroutine DeleteTree
end module DataStructures