Task: Doubly-linked list_Definition








VB: Sub InsertaElto(lista() As String, posic As Integer = 1)
    For i As Integer = Lbound(lista) To Ubound(lista)
        If i = posic Then Swap lista(i), lista(Ubound(lista))
    Next i
End Sub

Sub mostrarLista(lista() As String, titulo As String)
    
    Print !"\n"; titulo;
    For i As Integer = Lbound(lista) To Ubound(lista)
        Print lista(i); " ";
    Next i
    Print ""
End Sub

Dim As String arr()  
Dim As String elto   
Dim As Integer j, c = 0

Restore datos
Do
    Read elto : c += 1
    If elto <> "EndOfData" Then Redim Preserve arr(c) : arr(c) = elto
Loop Until elto = "EndOfData"

Dim As Integer lb = Lbound(arr), ub = Ubound(arr)
Dim As String arrTMP(ub)
For j = lb To ub : arrTMP(ub-j) = arr(j)
Next j
For j = lb To ub : Swap arr(j), arrTMP(j)
Next j
mostrarLista(arr(),"Insertion at Head: ")

Erase arr
Restore datos
c = 0
Do
    Read elto : c += 1
    If elto <> "EndOfData" Then Redim Preserve arr(c) : arr(c) = elto
Loop Until elto = "EndOfData"
mostrarLista(arr(),"Insertion at Tail:")

Erase arr
Restore datos
c = 0
Do
    Read elto : c += 1
    If elto <> "EndOfData" Then Redim Preserve arr(c) : arr(c) = elto
Loop Until elto = "EndOfData"
InsertaElto(arr(), 3)
mostrarLista(arr(),"Insertion in Middle:")

Sleep


datos:
Data "One", "Two", "Three", "Four", "Five", "Six", "EndOfData"



Fortran: module dlist
  implicit none
  type node
     type(node), pointer :: next => null()
     type(node), pointer :: prev => null()
     integer :: data
  end type node

  type dll
     type(node), pointer :: head => null()
     type(node), pointer :: tail => null()
     integer :: num_nodes = 0
  end type dll

  public  :: node, dll, append, prepend, insert, dump, reverse_dump, tidy
  private :: init

contains
  
  elemental type(dll) function new_dll()
    new_dll = dll(null(),null(),0)
    return
  end function new_dll

  
  elemental subroutine append(dl2, value)
    type(dll), intent(inout) :: dl2
    integer, intent(in)      :: value

    type(node), pointer :: np

    
    if (dl2%num_nodes == 0) then
       call init(dl2, value)
       return
    end if

    
    dl2%num_nodes = dl2%num_nodes + 1
    np => dl2%tail
    allocate(dl2%tail)
    dl2%tail%data = value
    dl2%tail%prev => np
    dl2%tail%prev%next => dl2%tail
  end subroutine append

  
  elemental subroutine prepend(dl2, value)
    type(dll), intent(inout) :: dl2
    integer, intent(in)      :: value

    type(node), pointer :: np

    if (dl2%num_nodes == 0) then
       call init(dl2, value)
       return
    end if

    dl2%num_nodes = dl2%num_nodes + 1
    np => dl2%head
    allocate(dl2%head)
    dl2%head%data = value
    dl2%head%next => np
    dl2%head%next%prev => dl2%head
  end subroutine prepend

  
  elemental subroutine insert(dl2, index, value)
    type(dll), intent(inout) :: dl2
    integer, intent(in)      :: index
    integer, intent(in)      :: value

    type(node), pointer :: element
    type(node), pointer :: np1, np2
    integer             :: i

    if (dl2%num_nodes == 0) then
       call init(dl2, value)
       return
    end if

    
    if (index > dl2%num_nodes) then
       call append(dl2, value)
       return
    end if

    
    if (index <= 1) then
       call prepend(dl2, value)
       return
    end if

    
    np1 => dl2%head
    do i=1, index-2
       np1 => np1%next
    end do
    np2 => np1%next

    
    allocate(element)
    element%data = value

    
    element%prev => np1
    element%next => np2
    np1%next => element
    np2%prev => element
    dl2%num_nodes = dl2%num_nodes + 1
  end subroutine insert

  subroutine dump(dl2)
    type(dll), intent(in) :: dl2
    type(node), pointer :: current
    integer :: i

    write(*,fmt='(a,i0,a)',advance='no') 'Doubly-linked list has ',dl2%num_nodes,' element - fwd = '
    current => dl2%head
    i = 1
    write(*,fmt='(i0,a)',advance='no') current%data,', '
    do
       current => current%next
       if (.not. associated(current)) then
          exit
       end if
       i = i + 1
       if (i == dl2%num_nodes) then
          write(*,'(i0)') current%data
       else
          write(*,fmt='(i0,a)',advance='no') current%data,', '
       end if
    end do
  end subroutine dump

  subroutine reverse_dump(dl2)
    type(dll), intent(in) :: dl2
    type(node), pointer :: current
    integer :: i

    write(*,fmt='(a,i0,a)',advance='no') 'Doubly-linked list has ',dl2%num_nodes,' element - bwd = '
    current => dl2%tail
    write(*,fmt='(i0,a)',advance='no') current%data,', '
    i = 1
    do
       current => current%prev
       if (.not. associated(current)) then
          exit
       end if
       i = i + 1
       if (i == dl2%num_nodes) then
          write(*,'(i0)') current%data
       else
          write(*,fmt='(i0,a)',advance='no') current%data,', '
       end if
    end do
  end subroutine reverse_dump

  
  elemental subroutine tidy(dl2)
    type(dll), intent(inout) :: dl2
    type(node), pointer :: current, last

    current => dl2%head
    do
       last => current
       current => current%next
       if (associated(last)) then
          deallocate(last)
       end if
       if (associated(current, dl2%tail)) then
          deallocate(current)
          exit
       end if
    end do
  end subroutine tidy

  elemental subroutine init(dl2, value)
    type(dll), intent(inout) :: dl2
    integer, intent(in)      :: value
    allocate(dl2%head)
    dl2%tail => dl2%head
    dl2%tail%data = value
    dl2%num_nodes = 1
    return
  end subroutine init

end module dlist

program dl
  use dlist
  implicit none

  type(dll) :: mydll

  mydll = new_dll()
  call append(mydll, 5)
  call append(mydll, 7)
  call prepend(mydll, 3)
  call prepend(mydll, 1)
  call insert(mydll, 3, 4)
  call dump(mydll)

  call reverse_dump(mydll)

  call tidy(mydll)
end program dl