What package would you recommend for typed lists?

Hello. I’m looking for a solution to dynamically store integers to a list. This list is meant to work just as an intermediate storage during the search phase of the algorithm. Once the search is over, I would them move the content of the list into an allocatable integer array… and resume the search… and so on.

  • Could you recommend a package, preferably well maintained? (I don’t want to code yet another linked list…)
  • Ideally, it would be nice if the list knew its own size.
  • It would also be nice if it were easy to copy the content of the list to an array. For instance, something like: myintvector = myintlist%to_vector().

Thanks for any hints.

Maybe not exactly what you were looking for, but TOML Fortran would provide you with the data structure you need for this as well as the necessary procedures to create and retrieve values:

program demo
  use tomlf, only : toml_array, set_value, get_value, len
  type(toml_array) :: array
  array = toml_array()

  block
    integer :: it
    do it = 1, 10
      call set_value(array, it, it*it)
    end do
    print *, len(array)
    ! 10
  end block

  block
    integer, allocatable :: list(:)
    call get_value(array, list)
    print '(*(g0:, ",", 1x))', list
    ! 1, 4, 9, 16, 25, 36, 49, 64, 81, 100
  end block

  call array%destroy  ! optional, since all components are allocatable
end program demo

The implementation of the toml_array is an array of pointers kind rather than a linked list. Generally, the data structures aim to be zero copy, but for basic types the set_value / get_value interfaces will handle the data creation / retrieval for you.

2 Likes

A better suited alternative might be the Fortran template library (ftl). Note that this one is not compatible with fpm yet and usually requires to copy over the template files to your build system.

2 Likes

What operations do you need? Would you like to just append at the end of the list, or do you also need to insert at the front or in the middle?

Thanks, I guess this is indeed the kind of thing I am looking for. Unfortunately, I am a bit clueless how to integrate this type of code in my project. The lib comes with a Linux makefile, but I am on Windows…
Since I am just interested in ftlList, there is probably a workaround, but I have zero experience with code that requires preprocessing. As a result, I will probably use (at least for now) tomfl, even though it seems less of a direct fit for my application.

1 Like

Append is actually all I need. It could not be easier! :slight_smile:

1 Like

Here’s something I threw together quickly, based upon a resize routine by @awvwgk provided here: An API for working with allocatable arrays · Issue #598 · fortran-lang/stdlib · GitHub.

Integer list (click to open)
! intlist.f90

!> Provides "list of integers" type which supports appending
module intlist

implicit none
private

!> List operations
public :: append
public :: asarray
public :: size, capacity
public :: shrink_to_fit
public :: reset

type, public :: intlist_type
   private
   integer :: size = 0
   integer :: remaining = -1
   integer, allocatable :: data(:)
end type

!> Append a scalar or an array
interface append 
   module subroutine append_scalar(list,item)
   type(intlist_type), intent(inout) :: list
   integer, intent(in) :: item
   end subroutine
   module subroutine append_array(list,array)
   type(intlist_type), intent(inout) :: list
   integer, intent(in) :: array(:)
   end subroutine
end interface

!> Size of the list
interface size
   module integer function intlist_type_size(list)
      type(intlist_type), intent(in) :: list
   end function
end interface

interface

   !> Capacity of the list (maximum number of items it can store)
   module integer function capacity(list)
      type(intlist_type), intent(in) :: list
   end function

   !> Return allocatable array containing the list data
   module function asarray(list) result(arr)
      type(intlist_type), intent(in) :: list
      integer,  allocatable :: arr(:)
   end function
   
   !> Shrink list capacity to match size of data
   module subroutine shrink_to_fit(list)
      type(intlist_type), intent(inout) :: list
   end subroutine
   
   !> Reset list to empty state
   module subroutine reset(list)
      type(intlist_type), intent(out) :: list
   end subroutine

end interface

end module
! intlist_implementation.f90
!
submodule (intlist) intlist_implementation

integer, parameter :: INITIAL_SIZE = 1024

contains

!> Reset list to empty state
module subroutine reset(list)
   type(intlist_type), intent(out) :: list
   associate(sz => list%size)
      ! do nothing, just to silence spurious warnings
   end associate
end subroutine

module integer function intlist_type_size(list) result(sz)
   type(intlist_type), intent(in) :: list
   sz = list%size
end function

!> Capacity of the list
module integer function capacity(list)
   type(intlist_type), intent(in) :: list
   intrinsic :: size
   if (allocated(list%data)) then
      capacity = size(list%data)
   else
      capacity = 0
   end if
end function

!> Append a scalar
module subroutine append_scalar(list,item)
   type(intlist_type), intent(inout) :: list
   integer, intent(in) :: item

   intrinsic :: size

   if (list%remaining < 1) then
      call resize_int(list%data)
      list%remaining = size(list%data) - list%size
   end if

   list%data(list%size+1) = item
   list%size = list%size + 1
   list%remaining = list%remaining - 1

end subroutine

!> Append an array of integer
module subroutine append_array(list,array)
   type(intlist_type), intent(inout) :: list
   integer, intent(in) :: array(:)

   integer :: current, new

   intrinsic :: size

   if (list%remaining < size(array)) then
      current = size(list%data)
      new = current + max(size(array),current/2) + 1
      call resize_int(list%data, new)
      list%remaining = size(list%data) - list%size
   end if

   list%data(list%size+1:list%size+size(array)) = array
   list%size = list%size + size(array)
   list%remaining = list%remaining - size(array)

end subroutine

! Return allocatable array containing the list data
module function asarray(list) result(arr)
   type(intlist_type), intent(in) :: list
   integer,  allocatable :: arr(:)
   arr = list%data(1:list%size)
end function

!> Shrink list capacity to match size
module subroutine shrink_to_fit(list)
   type(intlist_type), intent(inout) :: list
   call resize_int(list%data,list%size)
end subroutine

!
! --- Private helper functions ---
!

!> Reallocate list of integers
!> (originally taken from https://github.com/fortran-lang/stdlib/issues/598)
pure subroutine resize_int(var, n)
   !> Instance of the array to be resized
   integer, allocatable, intent(inout) :: var(:)
   !> Dimension of the final array size
   integer, intent(in), optional :: n

   integer, allocatable :: tmp(:)
   integer :: this_size, new_size
   intrinsic :: size

   if (allocated(var)) then
      this_size = size(var, 1)
      call move_alloc(var, tmp)
   else
      this_size = initial_size
   end if

   if (present(n)) then
      new_size = n
   else
      new_size = this_size + this_size/2 + 1
   end if

   allocate(var(new_size))

   if (allocated(tmp)) then
      this_size = min(size(tmp, 1), size(var, 1))
      var(:this_size) = tmp(:this_size)
      deallocate(tmp)
   end if

end subroutine resize_int

end submodule

:warning: I haven’t done any testing of the list, so use at your own risk. :warning:

Here’s an example of the list in action:

! test_intlist.f90
!
program test_intlist
   
   use intlist, only: intlist_type, append, shrink_to_fit, asarray, &
      reset, size, capacity
   
   implicit none

   type(intlist_type) :: list
   integer, allocatable :: array(:)
   integer :: i

   do i = 1, 1447
      call append(list,i)
   end do

   print *, "list capacity before shrink = ", capacity(list)
   call shrink_to_fit(list)
   print *, "list capacity after shrink = ", capacity(list)

   array = asarray(list)

   print *, "first, last = ", array(1), array(1447)
   print *, "array size = ", size(array)

   call reset(list)
   print *, "list size after reset = ", size(list)

end program
$ ifort -warn all intlist.f90 intlist_impl.f90 test_intlist.f90 
$ ./a.out
 list capacity before shrink =         1537
 list capacity after shrink =         1447
 first, last =            1        1447
 array size =         1447
 list size after reset =            0
2 Likes

Something to try:

  1. copy ftlMacros.inc and ftlList.F90_template to the include directory of your fpm project
  2. add ftlListInt.F90 to your src directory:
// Instantiate the module from the ftlList template
#define FTL_TEMPLATE_TYPE integer
#define FTL_TEMPLATE_TYPE_NAME Int
#define FTL_INSTANTIATE_TEMPLATE
#include "ftlList.F90_template"

// Make fpm recognize the instantiated module (needs to be fixed in fpm)
#if 0
module ftlListIntModule
end module ftlListIntModule
#endif
  1. finally you can import ftlListIntModule and use it
program demo
  use ftlListIntModule
  implicit none
  type(ftlListInt) :: list

  call list%New 

  block
    integer :: it
    do it = 1, 10
      call list%PushBack(it*it)
    end do
    print *, list%Size()
  end block

  block
    type(ftlListIntIterator) :: iter
    integer, allocatable :: arr(:)
    iter = list%Begin()
    allocate(arr(0))
    do while(iter /= list%End())
      arr = [arr, iter%value]
      call iter%Inc
    end do
    print '(*(g0:, ",", 1x))', arr
  end block

  call list%Delete
end program demo

(I have to admit turning the doubly linked list back to an array is kind of cumbersome with the iterator)

4 Likes

Thanks a lot for such clear instructions, @awvwgk. It works just like you said it would!
As you mentioned, getting the content out of the list is a bit more complicated than desired. It’s a pity because there is an assignment method which allows creating a list from an array of compatible type, so the opposite should not be harder… But ok.
Again, a big big thank you for providing such a detailed solution.

1 Like

Thank you very much, @ivanpribec. It seems you code faster than I can write a question. :slight_smile:
I will test this approach based on allocatable arrays and compare it to the other one based on ftlList. I am curious to see which one will run faster overall.
Very helpful. Bravo!

1 Like

I’m using a very simple solution as follows

integer,dimension(:),allocatable ::templist
initsize=200
allocate(templist(1:initsize)

I put elements to the templist using

call puti(templist,ielem,ival) 

where

subroutine puti(ivec,iel,ival)
	integer,dimension(:),intent(inout), allocatable::ivec
	integer,intent(in) :: iel
	integer, intent(in) ::ival
 
	integer,dimension(:), allocatable::ivec2
	iubound=ubound(ivec,dim=1)
	if(iubound.lt.iel)then
		allocate(ivec2(1:iubound))
		!		write(6,*)'*doubling a allocatable integer vector'
		ivec2=ivec
		deallocate(ivec)
		allocate(ivec(1:2*iel))
		ivec(1:iubound)=ivec2
		deallocate(ivec2)
	end if !if(iubound.lt.iel)  11027
	ivec(iel)=ival
end subroutine puti

The same procedure can be applied to real and double precision vectors, and it is easy to modify the procedure for vectors where the lower bound is not one.

After filling the list, I can remove the unnecessary tail by allocating the final list to the actual size. But usually I work with lists having only some hundreds ot thousands of elements so I put the values directly to the list I intent to use. In such case the real size of the vector mus be carried using a separate integer variable. Working with data vectors which can be very large, I use linked lists. I was surprised that linked lists are not much slower than allocating vectors directly to the known size.

Consider instead the simpler approach:

allocate(ivec2(1:2*iel))
ivec2(1:iubound) = ivec      ! copy of data
call move_alloc( from=ivec2, to=ivec )

As you can see, this only copies the data once, so it is more efficient, and it eliminates the deallocate() statements, so it is simpler for humans to understand.