From 263a6524b432dd9573d6c5aab2112ac22f5a3799 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Wed, 3 Feb 2021 21:39:34 +0100 Subject: [PATCH 01/20] Add module for list of strings The API for the module to manipulate lists of strings has been discussed and this has resulted in the current implementation --- doc/specs/stdlib_stringlist.md | 487 +++++++++ src/stdlib_stringlist.f90 | 996 +++++++++++++++++++ src/tests/stringlist/CMakeLists.txt | 4 + src/tests/stringlist/test_delete.f90 | 57 ++ src/tests/stringlist/test_find.f90 | 72 ++ src/tests/stringlist/test_insert.f90 | 91 ++ src/tests/stringlist/test_replace_append.f90 | 88 ++ 7 files changed, 1795 insertions(+) create mode 100644 doc/specs/stdlib_stringlist.md create mode 100644 src/stdlib_stringlist.f90 create mode 100644 src/tests/stringlist/CMakeLists.txt create mode 100644 src/tests/stringlist/test_delete.f90 create mode 100644 src/tests/stringlist/test_find.f90 create mode 100644 src/tests/stringlist/test_insert.f90 create mode 100644 src/tests/stringlist/test_replace_append.f90 diff --git a/doc/specs/stdlib_stringlist.md b/doc/specs/stdlib_stringlist.md new file mode 100644 index 000000000..a214ce565 --- /dev/null +++ b/doc/specs/stdlib_stringlist.md @@ -0,0 +1,487 @@ +--- +title: stringlist +--- +# Lists of strings + +[TOC] + +## Introduction + +Fortran has supported variable-length strings since the 2003 standard, +but it does not have a native type to handle collections of strings of +different lengths. Such collections are quite useful though and the +language allows us to define a derived type that can handle such +collections. + +The `stdlib_stringlist` module defines a derived type that is capable of +storing a list of strings and of manipulating them. + +Methods include: + +* inserting strings at a given position +* replacing strings at a given position +* deleting a single string or a range of strings +* retrieving a string or a range of strings at a given position +* finding the position of a particular string or a string which contains some substring +* sorting the list + +## Positions in a list of strings + +The module implements what are effectively infinitely long lists: a position is +represented as a positive integer, but there is no "out-of-bound" index. That is, +the following piece of code will simply work: + +```fortran +type(stringlist_type) :: list + +! Add two strings ... +call list%insert( list_head, "The first string" ) +call list%insert( 20, "The last string" ) + +write(*,*) 'The last: ', list%get(list_end) +write(*,*) 'Beyond that: ', list%get(30) +``` +The special position `list_head` represents *the first element*, though a value +of 1 is equivalent. Likewise, the special position `list_end` represents the position +of the *last* element and the position `list_after_end` the position directly after +the last element. You can use these positions to insert a string before the current +first string that is already in the list or to insert after the last string that +has been inserted. + +If you specify a position beyond the last, the `list%get()` method simply returns an empty +string. The same holds for *zero* or *negative* indices. + +For inserting one or more elements, a *zero* or *negative* index is interpreted to mean the first, +an index beyond the last as the one *after* the last - this means effectively that the element is appended. + +If you do: + +```fortran +call list%insert( 1, 'The first string' ) +call list%insert( -10, 'A new first string' ) +``` + +the second inserted string will become the string at the *first* position (1) and all other strings +are shifted by one: + +```none +element 1: 'A new first string' +element 2: 'The first string' +element 3: ... +``` + +If you need the last but one string, you can do so in this way: + +```fortran +write(*,*) 'The last but one: ', list%get(list_end-1) +``` + +So, it is possible to do simple arithmetic. + + +## The derived type: stringlist_type + +### Status + +Experimental + +### Description + +The type holds a small number of components and gives access to a number of procedures, +some of which are implemented as subroutines, others as functions or as operations. + + +### Public `stringlist_type` methods + +The following methods are defined: + +Method | Class | Description +---------------------|------------|------------ +[`delete`](./stdlib_stringlist.html#delete-delete_one_or_more_strings) | Subroutine | Delete one or more strings from the list +[`destroy`](./stdlib_stringlist.html#destroy_destroy_all_strings_in_the_list) | Subroutine | Destroy the contents of the list +[`get`](./stdlib_stringlist.html#get-get_a_single_string_from_a_list) | Function | Get a string from a particular position +[`index`](./stdlib_stringlist.html#index-find_the_index_of_a_particular_string_in_the_list) | Function | Find the index of a string in a list +[`index_sub`](./stdlib_stringlist.html#index_sub-find_the_index_of_a_particular_string_containing_the_given_substring) | Function | Find the index of a string containing a partilcar substring +[`insert`](./stdlib_stringlist.html#insert-insert_one_or_more_strings_after_a_given_position) | Subroutine | Insert a string or a list after a given position +[`length`](./stdlib_stringlist.html#length-return_the_length_of_the_list) | Function | Return the index of the last set position +[`range`](./stdlib_stringlist.html#range-retrieve_a_range_of_string_from_the_list) | Function | Retrieve a range of strings from the list +[`replace`](./stdlib_stringlist.html#replace-replace_one_or_more_strings_between_two_given_positions) | Subroutine | Replace one or more stringa between two positions +[`sort`](./stdlib_stringlist.html#sort-return_a_sorted_list) | Function | Sort the list and return the result as a new list +[`=`](./stdlib_stringlist.html#assign-copy_the_contents_of_a_list) | Assignment | Copy a list +[`//`](./stdlib_stringlist.html#//-concatenate_a_list_with_one_or_more_strings) | Operation | Concatenate a list with a string or concatenate two lists + + +## Details of the methods + +### `delete` - delete one or more strings + +#### Status + +Experimental + +#### Description + +Delete one or more strings from the list via a given position or positions. + +#### Syntax + +`call list % [[stringlist_type(type):delete(bound)]]( first [, last] )` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable from which to delete one or more strings + +`first`: the index of the first string to be deleted + +`last` (optional): the index of the last string to be deleted. If left out, only one string is deleted. +If the value is lower than that of `first`, the range is considered to be empty and nothing is deleted. + + +### `destroy` - destroy all strings in the list + +#### Status + +Experimental + +#### Description + +Destroy the entire contents of the list. As the variable holding the list is simply a derived type, the variable +itself is not destroyed. + +#### Syntax + +`call list % [[stringlist_type(type):destroy(bound)]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable from which to delete all strings + + +### `get` - get a single string from the list + +#### Status + +Experimental + +#### Description + +Get the string at the given position. + +#### Syntax + +`string = list % [[stringlist_type(type):get(bound) ( idx )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`idx`: the index of the string to be retrieved (see [`the section on positions`](./stdlib_stringlist.html#position-in-a-list-of-strings) + +#### Result value + +A copy of the string stored at the indicated position. + + +### `index` - find the index of a particular string in the list + +#### Status + +Experimental + +#### Description + +Get the position of the first stored string that matches the given string, if `back` is not present or false. If `back` is +false, return the position of the last stored string that matches. Note that trailing blanks are ignored. + +#### Syntax + +`idx = list % [[stringlist_type(type):index(bound) ( string, back )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`string`: the string to be found in the list + +`back` (optional): logical argument indicating the first occurrence should be returned (`false`) or the last (`true`) + +#### Result value + +The result is either the index of the string in the list or -1 if the string was not found + +#### Example + +Because trailing blanks are ignored, the following calls will give the same result: + +```fortran + write(*,*) list%index( 'A' ) + write(*,*) list%index( 'A ' ) +``` + + +### `index_sub` - find the index of a string containing the given substring in the list + +#### Status + +Experimental + +#### Description + +Get the position of the first stored string that contains the given substring, if `back` is not present or false. If `back` is +false, return the position of the last stored string that contains it. + +#### Syntax + +`idx = list % [[stringlist_type(type):index_sub(bound) ( substring, back )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve a string from + +`substring`: the substring in question + +`back` (optional): logical argument indicating the first occurrence should be returned (`false`) or the last (`true`) + +#### Result value + +The result is either the index of the string in the list or -1 if the string was not found + + +### `insert` - insert one or more strings after a given position + +#### Status + +Experimental + +#### Description + +Insert one or more strings at a given position. The position may be anything as explained in the section on positions. +A single string may be inserted, another list of strings or a plain array of strings. In all cases trailing blanks, if any, +are retained. + +#### Syntax + +`idx = list % [[stringlist_type(type):insert(bound) ( idx, string )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable to insert the string(s) into + +`idx`: the position after which the strings should be inserted + +`string`: the string to be inserted, a list of strings or a plain array of strings + + +### `length` - return the length of the list + +#### Status + +Experimental + +#### Description + +Return the length of the list, defined as the highest index for which a string has been assigned. You can place strings +in any position without needing to fill in the intervening positions. + +#### Syntax + +`length = list % [[stringlist_type(type):length(bound) ()]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to retrieve the length from + +#### Result value + +Returns the highest index of a string that has been set. + + + +### `range` - retrieve a range of strings from the list + +#### Status + +Experimental + +#### Description + +Retrieve the strings occurring between the given positions as a new list. + +#### Syntax + +`rangelist = list % [[stringlist_type(type):range(bound) ( first, last )]]` + +#### Class + +Function + +#### Arguments + +`list`: the stringlist variable to insert the string(s) into + +`first`: the position of the first string to be retrieved + +`last`: the position of the last string to be retrieved + +#### Result value + +The result is a new list containing all the strings that appear from the first to the last position, inclusively. + + + +### `replace` - replace one or more strings between two given positions + +#### Status + +Experimental + +#### Description + +Replace one or more strings between two given positions. The new strings may be given as a single string, a list of +strings or a plain array. + +#### Syntax + +`call list % [[stringlist_type(type):replace(bound) ( first, last, string )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable to replace the string(s) in + + +`first`: the position of the first string to be retrieved + +`last`: the position of the last string to be retrieved. If only one string needs to be replaced by another string, +then this argument can be left out. + +`string`: the string to be inserted, a list of strings or a plain array of strings + + + +### `sort` - return a sorted list + +#### Status + +Experimental + +#### Description + +Create a new list consisting of the sorted strings of the given list. The strings are sorted according to ASCII, either +in ascending order or descending order. + +#### Syntax + +`sortedlist = list % [[stringlist_type(type):sort(bound) ( ascending )]]` + +#### Class + +Subroutine + +#### Arguments + +`list`: the stringlist variable of which the contents should be copied + +`ascending` (optional): if not present or true, sort the list in ascending order, otherwise descending + +#### Result value + +The contents of the given list is sorted and then stored in the new list. + + +### `=` - copy the contents of a list + +#### Status + +Experimental + +#### Description + +Copy an existing list to a new one. The original list remains unchanged. + +#### Syntax + +`copylist = list` + +#### Class + +Assignment + +#### Operands + +`list`: the stringlist variable to be copied + + + +### `//` - concatenate a list with one or more strings + +#### Status + +Experimental + +#### Description + +Concatenate a list with a string, a list of strings or a plain array + +#### Syntax + +`concatenatedlist = list // string` + +`concatenatedlist = string // list` + +#### Class + +Assignment + +#### Operands + +`list`: the stringlist variable to be concatenated + +`string`: the string to be concatenated, a list of strings or a plain array of strings + +#### Result value + +A stringlist that contains the concatenation of the two operands. + + + +## TODO + +Additional methods: + +filter + +map + +Suggestions from the discussion diff --git a/src/stdlib_stringlist.f90 b/src/stdlib_stringlist.f90 new file mode 100644 index 000000000..4dfb192ed --- /dev/null +++ b/src/stdlib_stringlist.f90 @@ -0,0 +1,996 @@ +! stdlib_stringlist.f90 -- +! Module for storing and manipulating lists of strings +! The strings may have arbitrary lengths, not necessarily the same +! +! Note: very preliminary +! +! TODO: +! insert( list_end, ... ) in an empty list? +! concatenate two string lists +! +! Not implemented yet: +! insert a list or an array of character strings +! replace a string, list or an array of character strings +! concatenate a list with another list or an array +! +! Limited to implemented routines +! +module stdlib_stringlist + implicit none + + private + public :: stringlist_type + public :: operator(//) + public :: operator(+) + public :: operator(-) + public :: list_end + + type stringlist_index_type + private + logical :: head + integer :: offset + end type stringlist_index_type + + type(stringlist_index_type), parameter :: list_head = stringlist_index_type( .true., 1 ) + type(stringlist_index_type), parameter :: list_end = stringlist_index_type( .false., 0 ) + type(stringlist_index_type), parameter :: list_after_end = stringlist_index_type( .false., 1 ) + + interface operator(+) + module procedure stringlist_index_add + end interface + + interface operator(-) + module procedure stringlist_index_subtract + end interface + + type string_type + character(len=:), allocatable :: value + end type string_type + + type stringlist_type + private + integer :: size = 0 + type(string_type), dimension(:), allocatable :: string + contains + private + procedure, public :: destroy => destroy_list + procedure :: insert_string_idx => insert_string_idx_wrap + procedure :: insert_string_int => insert_string_int_impl + procedure :: insert_stringlist_idx => insert_stringlist_idx_wrap + procedure :: insert_stringlist_int => insert_stringlist_int_impl + procedure :: insert_stringarray_idx => insert_stringarray_idx_wrap + procedure :: insert_stringarray_int => insert_stringarray_int_impl + generic, public :: insert => insert_string_int, insert_string_idx, & + insert_stringlist_int, insert_stringlist_idx, & + insert_stringarray_int, insert_stringarray_idx + procedure :: get_string_int => get_string_int_impl + procedure :: get_string_idx => get_string_idx_wrap + generic, public :: get => get_string_int, get_string_idx + procedure, public :: length => length_list + procedure, public :: sort => sort_list + procedure, public :: index => index_of_string + procedure, public :: index_sub => index_of_substring + procedure :: delete_strings_int_int => delete_strings_int_int_impl + procedure :: delete_strings_idx_int => delete_strings_idx_int_wrap + procedure :: delete_strings_int_idx => delete_strings_int_idx_wrap + procedure :: delete_strings_idx_idx => delete_strings_idx_idx_wrap + generic, public :: delete => delete_strings_int_int, delete_strings_idx_int, & + delete_strings_int_idx, delete_strings_idx_idx + procedure :: range_list_int_int => range_list_int_int_impl + procedure :: range_list_idx_int => range_list_idx_int_wrap + procedure :: range_list_int_idx => range_list_int_idx_wrap + procedure :: range_list_idx_idx => range_list_idx_idx_wrap + generic, public :: range => range_list_int_int, range_list_idx_idx, & + range_list_int_idx, range_list_idx_int + procedure :: replace_string_idx => replace_string_idx_wrap + procedure :: replace_string_int => replace_string_int_impl + procedure :: replace_string_int_int => replace_string_int_int_impl + procedure :: replace_stringarray_int_int => replace_stringarray_int_int_impl + procedure :: replace_stringlist_int_int => replace_stringlist_int_int_impl + procedure :: replace_string_idx_idx => replace_string_idx_idx_wrap + procedure :: replace_stringarray_idx_idx => replace_stringarray_idx_idx_wrap + procedure :: replace_stringlist_idx_idx => replace_stringlist_idx_idx_wrap + procedure :: replace_string_idx_int => replace_string_idx_int_wrap + procedure :: replace_stringarray_idx_int => replace_stringarray_idx_int_wrap + procedure :: replace_stringlist_idx_int => replace_stringlist_idx_int_wrap + procedure :: replace_string_int_idx => replace_string_int_idx_wrap + procedure :: replace_stringarray_int_idx => replace_stringarray_int_idx_wrap + procedure :: replace_stringlist_int_idx => replace_stringlist_int_idx_wrap + generic, public :: replace => replace_string_int_int, replace_stringarray_int_int, & + replace_stringlist_int_int, & + replace_string_idx, replace_string_int, & + replace_string_idx_idx, replace_stringarray_idx_idx, & + replace_stringlist_idx_idx, & + replace_string_idx_int, replace_stringarray_idx_int, & + replace_stringlist_idx_int, & + replace_string_int_idx, replace_stringarray_int_idx, & + replace_stringlist_int_idx + end type stringlist_type + + interface operator(<) + module procedure string_lower + end interface + + interface operator(>) + module procedure string_greater + end interface + + interface operator(==) + module procedure string_equal + end interface + + interface operator(//) + module procedure append_string + module procedure prepend_string + module procedure append_stringlist + module procedure append_stringarray + module procedure prepend_stringarray + end interface +contains + +! stringlist_index_add -- +! Add an integer offset to the special index +! +! Arguments: +! index Special index +! offset Offset to be added +! +function stringlist_index_add( index, offset ) + type(stringlist_index_type), intent(in) :: index + integer, intent(in) :: offset + + type(stringlist_index_type) :: stringlist_index_add + + stringlist_index_add = index + stringlist_index_add%offset = stringlist_index_add%offset + offset +end function stringlist_index_add + +! stringlist_index_substract -- +! Subtract an integer offset to the special index +! +! Arguments: +! index Special index +! offset Offset to be substracted +! +function stringlist_index_subtract( index, offset ) + type(stringlist_index_type), intent(in) :: index + integer, intent(in) :: offset + + type(stringlist_index_type) :: stringlist_index_subtract + + stringlist_index_subtract = index + stringlist_index_subtract%offset = stringlist_index_subtract%offset - offset +end function stringlist_index_subtract + +! compare string_type derived types +! Required by sorting functions +! +elemental logical function string_lower( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_lower = string1%value < string2%value +end function string_lower + +elemental logical function string_greater( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_greater = string1%value > string2%value +end function string_greater + +elemental logical function string_equal( string1, string2 ) + type(string_type), intent(in) :: string1 + type(string_type), intent(in) :: string2 + + string_equal = string1%value == string2%value +end function string_equal + +function append_string( list, string ) + type(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: string + type(stringlist_type) :: append_string + + append_string = list + call append_string%insert( list_after_end, string ) +end function append_string + +function prepend_string( string, list ) + character(len=*), intent(in) :: string + type(stringlist_type), intent(in) :: list + type(stringlist_type) :: prepend_string + + prepend_string = list + call prepend_string%insert( list_head, string ) +end function prepend_string + +function append_stringlist( slist, list ) + type(stringlist_type), intent(in) :: list + type(stringlist_type), intent(in) :: slist + type(stringlist_type) :: append_stringlist + + append_stringlist = list + call append_stringlist%insert( list_after_end, slist ) +end function append_stringlist + +function append_stringarray( list, sarray ) + type(stringlist_type), intent(in) :: list + character(len=*), dimension(:), intent(in) :: sarray + type(stringlist_type) :: append_stringarray + + append_stringarray = list + call append_stringarray%insert( list_after_end, sarray ) +end function append_stringarray + +function prepend_stringarray( sarray, list ) + character(len=*), dimension(:), intent(in) :: sarray + type(stringlist_type), intent(in) :: list + type(stringlist_type) :: prepend_stringarray + + prepend_stringarray = list + call prepend_stringarray%insert( list_head, sarray ) +end function prepend_stringarray + + +! destroy_list -- +! Destroy the contetns of the list +! +! Arguments: +! list The list of strings in question +! +subroutine destroy_list( list ) + class(stringlist_type), intent(inout) :: list + + list%size = 0 + deallocate( list%string ) +end subroutine destroy_list + +! length_list -- +! Return the size (length) of the list +! +! Arguments: +! list The list of strings to retrieve the string from +! +integer function length_list( list ) + class(stringlist_type), intent(in) :: list + + length_list = list%size +end function length_list + +! insert_string -- +! Insert a new string (or an array of strings of another list) into the list +! +! Arguments: +! list The list of strings where the new string(s) should be inserted +! idx Index at which to insert the string +! string The string in question +! +subroutine insert_string_idx_wrap( list, idx, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, string ) +end subroutine insert_string_idx_wrap + +subroutine insert_stringlist_idx_wrap( list, idx, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + class(stringlist_type), intent(in) :: slist + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, slist ) +end subroutine insert_stringlist_idx_wrap + +subroutine insert_stringarray_idx_wrap( list, idx, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), dimension(:), intent(in) :: sarray + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%insert( idxabs, sarray ) +end subroutine insert_stringarray_idx_wrap + +! insert_empty_positions +! Insert a number of positions for new strings +! +! Arguments: +! list The list of strings where the empty positions should be inserted +! idxn Index at which the positions should be inserted +! number Number of positions +! +subroutine insert_empty_positions( list, idxn, number ) + class(stringlist_type), intent(inout) :: list + integer, intent(inout) :: idxn + integer, intent(in) :: number + + integer :: i, inew + integer :: lastidx + type(string_type), dimension(:), allocatable :: new_string + + ! + ! Clip the index between 1 and size+1 + ! + idxn = max( 1, min(list%size+1, idxn ) ) + + ! + ! Check if the array list%string is large enough + ! Make room in any case + ! + if ( .not. allocated(list%string) ) then + allocate(list%string(1) ) + endif + + lastidx = list%size + number + + ! + ! Do we need a copy? + ! + if ( size(list%string) < lastidx ) then + allocate( new_string(lastidx) ) + + do i = 1,idxn-1 + call move_alloc( list%string(i)%value, new_string(i)%value ) + enddo + + do i = idxn, list%size + inew = i + number + call move_alloc( list%string(i)%value, new_string(inew)%value ) + enddo + call move_alloc( new_string, list%string ) + else + do i = idxn, list%size + inew = i + number + call move_alloc( list%string(i)%value, list%string(inew)%value ) + enddo + endif + + list%size = list%size + number + +end subroutine insert_empty_positions + +! insert_string_int_impl -- +! Insert a new string into the list - specific implementation +! +subroutine insert_string_int_impl( list, idx, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxn + type(string_type) :: new_element + type(string_type), dimension(:), allocatable :: new_string + + idxn = idx + call insert_empty_positions( list, idxn, 1 ) + + list%string(idxn)%value = string + +end subroutine insert_string_int_impl + +! insert_stringlist_int_impl -- +! Insert a list of strings into the list - specific implementation +! +subroutine insert_stringlist_int_impl( list, idx, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + class(stringlist_type), intent(in) :: slist + + integer :: i + integer :: idxn, idxnew + + idxn = idx + call insert_empty_positions( list, idxn, slist%size ) + + do i = 1, slist%size + idxnew = max( 1, idxn ) + i - 1 + list%string(idxnew)%value = slist%string(i)%value + enddo + +end subroutine insert_stringlist_int_impl + +! insert_stringarray_int_impl -- +! Insert an array of strings into the list - specific implementatinon +! +subroutine insert_stringarray_int_impl( list, idx, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), dimension(:), intent(in) :: sarray + + integer :: i + integer :: idxn, idxnew + + idxn = idx + call insert_empty_positions( list, idxn, size(sarray) ) + + do i = 1, size(sarray) + idxnew = max( 1, idxn ) + i - 1 + list%string(idxnew)%value = sarray(i) + enddo + +end subroutine insert_stringarray_int_impl + +! get_string -- +! Get the string at a particular index +! +! Arguments: +! list The list of strings to retrieve the string from +! idx Index after which to insert the string +! +function get_string_idx_wrap( list, idx ) + class(stringlist_type), intent(in) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=:), allocatable :: get_string_idx_wrap + + integer :: idxabs + + idxabs = merge( idx%offset, list%size + idx%offset, idx%head ) + + get_string_idx_wrap = list%get( idxabs ) +end function get_string_idx_wrap + +function get_string_int_impl( list, idx ) + class(stringlist_type), intent(in) :: list + integer, intent(in) :: idx + character(len=:), allocatable :: get_string_int_impl + + integer :: idxnew + + ! + ! Examine the actual index: + ! - if the index is larger than the size, return an empty string + ! - if the index is equal to list_head, interpret it as index 1 + ! - if the index is negative, calculate the absolute index + ! + if ( idx > list%size .or. idx < 1 ) then + get_string_int_impl = '' + else + get_string_int_impl = list%string(idx)%value + endif +end function get_string_int_impl + +! sort_list -- +! Sort the list and return the result as a new list +! +! Arguments: +! list The list of strings to retrieve the string from +! ascending Whether to sort as ascending (true) or not (false) +! +function sort_list( list, ascending ) + class(stringlist_type), intent(in) :: list + logical, intent(in), optional :: ascending + + integer :: i + integer, dimension(:), allocatable :: idx + class(stringlist_type), allocatable :: sort_list + logical :: ascending_order + + ! + ! Allocate and fill the index array, then sort the indices + ! based on the strings + ! + idx = [ (i ,i=1,list%size) ] + + ascending_order = .true. + if ( present(ascending) ) then + ascending_order = ascending + endif + + if ( ascending_order ) then + idx = sort_ascending( idx ) + else + idx = sort_descending( idx ) + endif + + allocate( sort_list ) + allocate( sort_list%string(list%size) ) + + do i = 1,list%size + sort_list%string(i) = list%string(idx(i)) + enddo + sort_list%size = list%size + +contains +recursive function sort_ascending( idx ) result(idxnew) + integer, dimension(:) :: idx + integer, dimension(size(idx)) :: idxnew + + if ( size(idx) > 1 ) then + idxnew = [ sort_ascending( pack( idx, list%string(idx) < list%string(idx(1)) ) ), & + pack( idx, list%string(idx) == list%string(idx(1)) ) , & + sort_ascending( pack( idx, list%string(idx) > list%string(idx(1)) ) ) ] + else + idxnew = idx + endif +end function sort_ascending + +recursive function sort_descending( idx ) result(idxnew) + integer, dimension(:) :: idx + integer, dimension(size(idx)) :: idxnew + + if ( size(idx) > 1 ) then + idxnew = [ sort_descending( pack( idx, list%string(idx) > list%string(idx(1)) ) ), & + pack( idx, list%string(idx) == list%string(idx(1)) ) , & + sort_descending( pack( idx, list%string(idx) < list%string(idx(1)) ) ) ] + else + idxnew = idx + endif +end function sort_descending + +end function sort_list + +! index_of_string -- +! Return the index in the list of a particular string +! +! Arguments: +! list The list of strings in which to search the string +! string The string to be found +! back Whether to search from the end (true) or not (false, default) +! +integer function index_of_string( list, string, back ) + class(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: string + logical, intent(in), optional :: back + + integer :: idx + integer :: i + logical :: start_backwards + + start_backwards = .false. + if ( present(back) ) then + start_backwards = back + endif + + idx = 0 + if ( start_backwards) then + do i = list%size,1,-1 + if ( list%string(i)%value == string ) then + idx = i + exit + endif + enddo + else + do i = 1,list%size + if ( list%string(i)%value == string ) then + idx = i + exit + endif + enddo + endif + + index_of_string = idx +end function index_of_string + +! index_of_substring -- +! Return the index in the list of a string containing a particular substring +! +! Arguments: +! list The list of strings in which to search the string +! substring The substring to be found +! back Whether to search from the end (true) or not (false, default) +! +integer function index_of_substring( list, substring, back ) + class(stringlist_type), intent(in) :: list + character(len=*), intent(in) :: substring + logical, intent(in), optional :: back + + integer :: idx + integer :: i + logical :: start_backwards + + start_backwards = .false. + if ( present(back) ) then + start_backwards = back + endif + + idx = 0 + if ( start_backwards) then + do i = list%size,1,-1 + if ( index(list%string(i)%value, substring) > 0 ) then + idx = i + exit + endif + enddo + else + do i = 1,list%size + if ( index(list%string(i)%value, substring) > 0 ) then + idx = i + exit + endif + enddo + endif + + index_of_substring = idx +end function index_of_substring + +! delete_strings -- +! Delete one or more strings from the list +! +! Arguments: +! list The list of strings in which to search the string +! first The position of the first string to be deleted +! last The position of the last string to be deleted +! +! Note: +! If the range defined by first and last has a zero length or first > last, +! then nothing happens. +! +subroutine delete_strings_idx_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_idx_idx_wrap + +subroutine delete_strings_int_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + + integer :: firstpos + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_int_idx_wrap + +subroutine delete_strings_idx_int_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%delete( firstpos, lastpos ) +end subroutine delete_strings_idx_int_wrap + +subroutine delete_strings_int_int_impl( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + + integer :: firstpos + integer :: lastpos + integer :: i + integer :: j + + if ( first > list%size .or. last < 1 ) then + return + endif + + firstpos = max( 1, min(list%size, first ) ) + lastpos = max( 1, min(list%size, last ) ) + + if ( firstpos > lastpos ) then + return + else + do i = lastpos+1,list%size + j = firstpos + i - lastpos - 1 + call move_alloc( list%string(i)%value, list%string(j)%value ) + enddo + do i = list%size - (lastpos-firstpos), list%size + list%string(i)%value = '' + enddo + + list%size = list%size - (lastpos-firstpos + 1) + endif +end subroutine delete_strings_int_int_impl + +! range_list -- +! Return a sublist given by the first and last position +! +! Arguments: +! list The list of strings in which to search the string +! first The position of the first string to be deleted +! last The position of the last string to be deleted +! +! Note: +! If the range defined by first and last has a zero length or first > last, +! then return an empty list +! +function range_list_idx_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), allocatable :: range_list_idx_idx_wrap + + integer :: firstpos + integer :: lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + range_list_idx_idx_wrap = list%range( firstpos, lastpos ) + +end function range_list_idx_idx_wrap + +function range_list_int_idx_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), allocatable :: range_list_int_idx_wrap + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + range_list_int_idx_wrap = list%range( first, lastpos ) + +end function range_list_int_idx_wrap + +function range_list_idx_int_wrap( list, first, last ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), allocatable :: range_list_idx_int_wrap + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + range_list_idx_int_wrap = list%range( firstpos, last ) + +end function range_list_idx_int_wrap + +function range_list_int_int_impl( list, first, last ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), allocatable :: range_list_int_int_impl + + integer :: firstpos + integer :: lastpos + + allocate( range_list_int_int_impl ) + + if ( first > list%size .or. last < 1 ) then + allocate( range_list_int_int_impl%string(0) ) + return + endif + + firstpos = max( 1, min(list%size, first ) ) + lastpos = max( 1, min(list%size, last ) ) + + if ( firstpos > lastpos ) then + allocate( range_list_int_int_impl%string(0) ) + return + else + range_list_int_int_impl%size = lastpos - firstpos + 1 + range_list_int_int_impl%string = list%string(firstpos:lastpos) + endif +end function range_list_int_int_impl + + +! replace_string -- +! Replace a string in the list +! +! Arguments: +! list The list of strings in which to replace a string (or a range of strings) +! first First index of the string(s) to be replaced +! last Last index of the string(s) to be replaced +! string The string in question (array of strings or another string list) +! +! Note: +! For convenience a version that simply replaces a single string is provided +! +subroutine replace_string_idx_wrap( list, idx, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxpos + + idxpos = merge( idx%offset, list%size + idx%offset, idx%head ) + + call list%replace( idxpos, string ) +end subroutine replace_string_idx_wrap + +subroutine replace_string_int_impl( list, idx, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: idx + character(len=*), intent(in) :: string + + integer :: idxpos + + if ( idx < 1 .or. idx > list%size ) then + return + endif + + list%string(idx)%value = string +end subroutine replace_string_int_impl + +subroutine replace_string_idx_idx_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), intent(in) :: string + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, string ) +end subroutine replace_string_idx_idx_wrap + +subroutine replace_string_int_idx_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), intent(in) :: string + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, string ) +end subroutine replace_string_int_idx_wrap + +subroutine replace_string_idx_int_wrap( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + character(len=*), intent(in) :: string + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, string ) +end subroutine replace_string_idx_int_wrap + +subroutine replace_string_int_int_impl( list, first, last, string ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + character(len=*), intent(in) :: string + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, string ) +end subroutine replace_string_int_int_impl + + +subroutine replace_stringlist_idx_idx_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, slist ) +end subroutine replace_stringlist_idx_idx_wrap + +subroutine replace_stringlist_int_idx_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, slist ) +end subroutine replace_stringlist_int_idx_wrap + +subroutine replace_stringlist_idx_int_wrap( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), intent(in) :: slist + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, slist ) +end subroutine replace_stringlist_idx_int_wrap + +subroutine replace_stringlist_int_int_impl( list, first, last, slist ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + class(stringlist_type), intent(in) :: slist + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, slist ) +end subroutine replace_stringlist_int_int_impl + + +subroutine replace_stringarray_idx_idx_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: firstpos, lastpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( firstpos, lastpos, sarray ) +end subroutine replace_stringarray_idx_idx_wrap + +subroutine replace_stringarray_int_idx_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + type(stringlist_index_type), intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: lastpos + + lastpos = merge( last%offset, list%size + last%offset, last%head ) + + call list%replace( first, lastpos, sarray ) +end subroutine replace_stringarray_int_idx_wrap + +subroutine replace_stringarray_idx_int_wrap( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + type(stringlist_index_type), intent(in) :: first + integer, intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + integer :: firstpos + + firstpos = merge( first%offset, list%size + first%offset, first%head ) + + call list%replace( firstpos, last, sarray ) +end subroutine replace_stringarray_idx_int_wrap + +subroutine replace_stringarray_int_int_impl( list, first, last, sarray ) + class(stringlist_type), intent(inout) :: list + integer, intent(in) :: first + integer, intent(in) :: last + character(len=*), dimension(:), intent(in) :: sarray + + if ( first > list%size .or. last < 1 ) then + return + endif + if ( first > last ) then + return + endif + + call list%delete( first, last ) + call list%insert( first, sarray ) +end subroutine replace_stringarray_int_int_impl + +end module stdlib_stringlist diff --git a/src/tests/stringlist/CMakeLists.txt b/src/tests/stringlist/CMakeLists.txt new file mode 100644 index 000000000..7bf83a41a --- /dev/null +++ b/src/tests/stringlist/CMakeLists.txt @@ -0,0 +1,4 @@ +ADDTEST(insert) +ADDTEST(delete) +ADDTEST(find) +ADDTEST(replace_append) diff --git a/src/tests/stringlist/test_delete.f90 b/src/tests/stringlist/test_delete.f90 new file mode 100644 index 000000000..5c3cf0870 --- /dev/null +++ b/src/tests/stringlist/test_delete.f90 @@ -0,0 +1,57 @@ +! test_delete.f90 -- +! Test the delete routine +! +program test_deletion + use stdlib_stringlist + + type(stringlist_type) :: list + + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + call list%delete( 1, 1 ) + + write(*,*) 'Expected: B, C, D, E, F (5)' + call print_list( list ) + + call list%delete( list_end, list_end ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( list_end+1, list_end+1 ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( 3, 2 ) + + write(*,*) 'Expected: B, C, D, E (4)' + call print_list( list ) + + call list%delete( 2, 3 ) + + write(*,*) 'Expected: B, E (2)' + call print_list( list ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_deletion diff --git a/src/tests/stringlist/test_find.f90 b/src/tests/stringlist/test_find.f90 new file mode 100644 index 000000000..3db7bd806 --- /dev/null +++ b/src/tests/stringlist/test_find.f90 @@ -0,0 +1,72 @@ +! test_find.f90 -- +! Test the various retrieval routines +! +program test_find + use stdlib_stringlist + + type(stringlist_type) :: list, sublist + character(len=:), allocatable :: string + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + write(*,*) 'Expected: A' + write(*,*) list%get(1) + write(*,*) list%get(list_head) + write(*,*) 'Expected: B' + write(*,*) list%get(list_head+1) + write(*,*) 'Expected: F' + write(*,*) list%get(list_end) + write(*,*) 'Expected: (nothing)' + write(*,*) list%get(list_end+1) + + call list%destroy + call list%insert( 1, ["AA", "BA", "CA", "AA", "BA", "CA"] ) + write(*,*) 'Expected: 1' + write(*,*) list%index("AA") + write(*,*) 'Expected: 4' + write(*,*) list%index("AA", .true.) + write(*,*) 'Expected: 0' + write(*,*) list%index("XXXX") + + write(*,*) 'Expected: 2' + write(*,*) list%index_sub("B") + write(*,*) 'Expected: 5' + write(*,*) list%index_sub("B", .true.) + write(*,*) 'Expected: 0' + write(*,*) list%index_sub("X") + + write(*,*) 'Expected: 6', list%length() + + sublist = list%range(1, 2) + write(*,*) 'Expected: AA, BA' + call print_list( sublist ) + + sublist = list%range(list_end-1, list_end+2) + write(*,*) 'Expected: BA, CA' + call print_list( sublist ) + + sublist = list%range(-1, 3) + write(*,*) 'Expected: AA, BA, CA' + call print_list( sublist ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_find diff --git a/src/tests/stringlist/test_insert.f90 b/src/tests/stringlist/test_insert.f90 new file mode 100644 index 000000000..6aa6b1198 --- /dev/null +++ b/src/tests/stringlist/test_insert.f90 @@ -0,0 +1,91 @@ +! test_insert.f90 -- +! Test the insertion routine +! +program test_insertion + use stdlib_stringlist + + type(stringlist_type) :: list, second_list + character(len=10), dimension(3) :: sarray + + + call list%insert( 1, "C" ) + call list%insert( 1, "B" ) + call list%insert( 1, "A" ) + + write(*,*) 'Expected: A, B, C (3)' + call print_list( list ) + + call list%insert( 6, "D" ) + + write(*,*) 'Expected: A, B, C, D (4)' + call print_list( list ) + + call list%insert( -1, "X" ) + + write(*,*) 'Expected: X, A, B, C, D (5)' + call print_list( list ) + + call list%insert( list_end-1, "Y" ) + + write(*,*) 'Expected: X, A, B, Y, C, D (6)' + call print_list( list ) + + call list%insert( list_end+1, "Z" ) + + write(*,*) 'Expected: X, A, B, Y, C, D, Z (7)' + call print_list( list ) + + ! + ! Try inserting a second list + ! + call renew_list( list ) + + call second_list%insert( 1, "SecondA" ) + call second_list%insert( 2, "SecondB" ) + + call list%insert( 2, second_list ) + call print_list( list ) + + call renew_list( list ) + + call list%insert( list_after_end, second_list ) + call print_list( list ) + + ! + ! Try inserting an array + ! + call renew_list( list ) + + sarray(1) = "ThirdA" + sarray(2) = "ThirdB" + sarray(3) = "ThirdC" + + call list%insert( list_head, sarray ) + call print_list( list ) + + call renew_list( list ) + + call list%insert( 2, sarray ) + call print_list( list ) + +contains +subroutine renew_list( list ) + type(stringlist_type), intent(inout) :: list + + call list%destroy + call list%insert( 1, "A" ) + call list%insert( 2, "B" ) + call list%insert( 3, "C" ) +end subroutine renew_list + +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_insertion diff --git a/src/tests/stringlist/test_replace_append.f90 b/src/tests/stringlist/test_replace_append.f90 new file mode 100644 index 000000000..b7c0c26ed --- /dev/null +++ b/src/tests/stringlist/test_replace_append.f90 @@ -0,0 +1,88 @@ +! test_replace_append.f90 -- +! Test the replace and append routines +! +program test_replace_append + use stdlib_stringlist + + type(stringlist_type) :: list, newlist + + call list%insert( 1, ["A", "B", "C", "D", "E", "F"] ) + + newlist = 'Long string' // list + + write(*,*) 'Expected: "Long string, A, B, C, D, E, F (7)' + call print_list( newlist ) + + newlist = list // 'Long string' + + write(*,*) 'Expected: A, B, C, D, E, F, "Long string" (7)' + call print_list( newlist ) + + newlist = list // list + + write(*,*) 'Expected: A, B, C, D, E, F (twice, 12 elements)' + call print_list( newlist ) + + newlist = ['AA', 'BB'] // list + write(*,*) 'Expected: AA, BB, A, B, C, D, E, F (8)' + call print_list( newlist ) + + newlist = list // ['AA', 'BB'] + write(*,*) 'Expected: A, B, C, D, E, F, AA, BB (8)' + call print_list( newlist ) + + ! + ! Replace ... quite a variety + ! + newlist = list + call newlist%replace( 1, "New string" ) + write(*,*) 'Expected: "New string", B, C, D, E, F (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_head, "New string" ) + write(*,*) 'Expected: "New string", B, C, D, E, F (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end, "New string" ) + write(*,*) 'Expected: A, B, C, D, E, F, "New string" (6)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 5, list_end, "X" ) + write(*,*) 'Expected: A, B, C, D, X (5)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 5, list_end-2, "X" ) + write(*,*) 'Expected: A, B, C, D, E, F (6 - no change)' + call print_list( newlist ) + + newlist = list + call newlist%replace( 1, 2, ["WW", "XX", "YY", "ZZ"] ) + write(*,*) 'Expected: WW, XX, YY, ZZ, C, D, E, F (8)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end-1, list_end, ["WW", "XX", "YY", "ZZ"] ) + write(*,*) 'Expected: A, B, C, D, WW, XX, YY, ZZ (8)' + call print_list( newlist ) + + newlist = list + call newlist%replace( list_end-1, list_end, list ) + write(*,*) 'Expected: A, B, C, D, A, B, C, D, E, F (10)' + call print_list( newlist ) + +contains +subroutine print_list( list ) + type(stringlist_type), intent(in) :: list + + write(*,*) list%length() + + do i = 1,list%length() + write(*,*) '>', list%get(i), '<' + enddo +end subroutine print_list + +end program test_replace_append From 90b06ff89ac3dce00e6c1d2f770beca38b837e34 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 4 Feb 2021 10:38:57 +0100 Subject: [PATCH 02/20] Correct typo There was a typo in some comments - corrected --- src/stdlib_stringlist.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stringlist.f90 b/src/stdlib_stringlist.f90 index 4dfb192ed..570927d7b 100644 --- a/src/stdlib_stringlist.f90 +++ b/src/stdlib_stringlist.f90 @@ -145,12 +145,12 @@ function stringlist_index_add( index, offset ) stringlist_index_add%offset = stringlist_index_add%offset + offset end function stringlist_index_add -! stringlist_index_substract -- +! stringlist_index_subtract -- ! Subtract an integer offset to the special index ! ! Arguments: ! index Special index -! offset Offset to be substracted +! offset Offset to be subtracted ! function stringlist_index_subtract( index, offset ) type(stringlist_index_type), intent(in) :: index From 024b078b56cfe645344234b952e4a4274d1c481a Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 18 Sep 2022 14:36:02 +0200 Subject: [PATCH 03/20] Documentation and corrected source code for linked lists Document the linked_list type, including examples, and correct a few minor mistakes in the code. --- doc/specs/stdlib_linked_list.md | 497 +++++++++++++ example/linked_list/example_absorb.f90 | 44 ++ example/linked_list/example_clear.f90 | 28 + example/linked_list/example_get.f90 | 41 ++ example/linked_list/example_insert.f90 | 32 + example/linked_list/example_pop.f90 | 33 + example/linked_list/example_push.f90 | 33 + example/linked_list/example_remove.f90 | 33 + example/linked_list/example_replace.f90 | 33 + example/linked_list/example_reverse.f90 | 33 + example/linked_list/example_size.f90 | 23 + example/linked_list/example_slice.f90 | 40 ++ example/linked_list/example_splice.f90 | 37 + example/linked_list/linked_list_aux.f90 | 36 + example/linked_list/stdlib_child_list.f90 | 369 ++++++++++ example/linked_list/stdlib_linked_list.f90 | 778 +++++++++++++++++++++ test/linked_list/test_performance.f90 | 71 ++ 17 files changed, 2161 insertions(+) create mode 100644 doc/specs/stdlib_linked_list.md create mode 100644 example/linked_list/example_absorb.f90 create mode 100644 example/linked_list/example_clear.f90 create mode 100644 example/linked_list/example_get.f90 create mode 100644 example/linked_list/example_insert.f90 create mode 100644 example/linked_list/example_pop.f90 create mode 100644 example/linked_list/example_push.f90 create mode 100644 example/linked_list/example_remove.f90 create mode 100644 example/linked_list/example_replace.f90 create mode 100644 example/linked_list/example_reverse.f90 create mode 100644 example/linked_list/example_size.f90 create mode 100644 example/linked_list/example_slice.f90 create mode 100644 example/linked_list/example_splice.f90 create mode 100644 example/linked_list/linked_list_aux.f90 create mode 100644 example/linked_list/stdlib_child_list.f90 create mode 100644 example/linked_list/stdlib_linked_list.f90 create mode 100644 test/linked_list/test_performance.f90 diff --git a/doc/specs/stdlib_linked_list.md b/doc/specs/stdlib_linked_list.md new file mode 100644 index 000000000..68097f730 --- /dev/null +++ b/doc/specs/stdlib_linked_list.md @@ -0,0 +1,497 @@ +--- +title: linked lists +--- + +# The `stdlib_linked_list` module + +[TOC] + +## Introduction + +The `stdlib_linked_list` module defines a class and its interface to handle linked lists that +store any type of data. The list may contain data of the same type or of various types. + + +## Types + +### `type(linked_list)` + +Linked lists are variables of the type `linked_list`. The type provides all the methods +required for storing and retrieving data. + + +## Procedures and methods provided + + + +### `size` + +#### Description + +Return the number of data items in the list. + +#### Syntax + +`number = [[stdlib_linked_list(module):list%size]] ()` + +#### Status + +Experimental + +#### Class + +Pure function. + +#### Argument + +None + +#### Result value + +The result is the number of items currently contained in the list. + +#### Example + +```fortran +{!example/linked_list/example_size.f90!} +``` + + + +### `clear` + +#### Description + +Remove all items from the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%clear]]` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +None + + +#### Example + +```fortran +{!example/strings/example_clear.f90!} +``` + + + +### `get` + +#### Description + +Get the data item at a given position (node) in the list + +#### Syntax + +`item = [[stdlib_linked_list(module):list%get(interface)]] (node_index)` + +#### Status + +Experimental + +#### Class + +Function. + +#### Argument + +- `node_index`: Position in the list for the new item (integer) + This argument is intent(in). + +#### Result value + +The data item (of type class(*)) that is stored at the given position. + +Notes: + +- If the index is 0 or less, the first item in the list is returned. +- If the index is larger than the number of items, the last item in the list is returned. + +#### Example + +```fortran +{!example/strings/example_get.f90!} +``` + + + +### `insert` + +#### Description + +Insert a new item at a given position (node) in the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%insert(interface)]] (item, node_index)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `item`: Data item to be stored (any type). + This argument is intent(in). +- `node_index`: Position in the list for the new item (integer) + This argument is intent(in). + +#### Result value + +The list is extended with the new data item at the given position. + +Notes: + +- If the index is 0 or less, the item is stored at the first position. +- If the index is larger than the number of items, it will be appended to the end of the list. + +#### Example + +```fortran +{!example/strings/example_insert.f90!} +``` + + + +### `replace` + +#### Description + +Replace an existing data by a new item at a given position (node) in the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%insert(interface)]] (new_item, node_index)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `item`: The new data item to be stored (any type). + This argument is intent(in). +- `node_index`: Position in the list for the item to be replaced (integer) + This argument is intent(in). + +#### Result value + +The new data item is stored and the existing one removed. + +Notes: + +- If the index is 0 or less, or it is larger than the number of items, nothing is done. + +#### Example + +```fortran +{!example/strings/example_replace.f90!} +``` + + + +### `remove` + +#### Description + +Remove an items at a given position (node) in the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%remove(interface)]] (node_index)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `node_index`: Position in the list for the item to be removed (integer) + This argument is intent(in). + +#### Result value + +The indicated item has been removed from the list. + +Notes: + +- If the index is 0 or less or the index is larger than the number of items, nothing is done. + +#### Example + +```fortran +{!example/strings/example_remove.f90!} +``` + + +### `push` + +#### Description + +Append a new item to the end of the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%push(interface)]] (item)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `item`: Data item to be stored (any type). + This argument is intent(in). + +#### Result value + +The list is extended with the new data item at the tail. + +#### Example + +```fortran +{!example/strings/example_push.f90!} +``` + + + +### `pop` + +#### Description + +Remove the last item in the list + +#### Syntax + +`call [[stdlib_linked_list(module):list%pop(interface)]]` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +None + +#### Result value + +The list item in the list is removed. + +#### Example + +```fortran +{!example/strings/example_pop.f90!} +``` + + + +### `reverse` + +#### Description + +Reconstruct the list in reverse order + +#### Syntax + +`call [[stdlib_linked_list(module):list%reverse(interface)]]` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +None + +#### Result value + +The list now contains the items in reverse order. + +#### Example + +```fortran +{!example/strings/example_reverse.f90!} +``` + + + +### `concat` + +#### Description + +Concatenate a list to another list + +#### Syntax + +`call [[stdlib_linked_list(module):list%concat(interface)]] (list_to_concat)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `list_to_concat`: list whose data items are to be appended to the given list (type(linked_list) + this argument is intent(in). + +#### Result value + +The given list is extended with the data items in the second list. The second list remains intact. + +#### Example + +```fortran +{!example/strings/example_concat.f90!} +``` + + + +### `absorb` + +#### Description + +Absorb a list into another list + +#### Syntax + +`call [[stdlib_linked_list(module):list%absorb(interface)]] (list_to_concat)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `list_to_absorb`: list whose data items will be appended to the given list (type(linked_list) + this argument is intent(inout). + +#### Result value + +The given list is extended with the data items in the second list. The second list is emptied. + +#### Example + +```fortran +{!example/strings/example_absorb.f90!} +``` + + + +### `slice` + +#### Description + +Return a sublist of a list + +#### Syntax + +`sublist = [[stdlib_linked_list(module):list%slice(interface)]] (start, end)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `start`: first item to store in the sublist (integer) + this argument is intent(in). +- `end`: last item to store in the sublist (integer) + this argument is intent(in). + +#### Result value + +Sublist consisting of the indicated data items. Note that the items themselves are copied from the original +list, so that the two lists are independent. + +#### Example + +```fortran +{!example/strings/example_slice.f90!} +``` + + + +### `splice` + +#### Description + +Remove a sublist from a list, based on a start and end index. + +#### Syntax + +`call [[stdlib_linked_list(module):list%splice(interface)]] (start, end)` + +#### Status + +Experimental + +#### Class + +Subroutine. + +#### Argument + +- `start`: first item to be removed in the sublist (integer) + this argument is intent(in). +- `end`: last item to be removed in the sublist (integer) + this argument is intent(in). + +#### Result value + +The data items in the given range are removed from the list. + +#### Example + +```fortran +{!example/strings/example_splice.f90!} +``` diff --git a/example/linked_list/example_absorb.f90 b/example/linked_list/example_absorb.f90 new file mode 100644 index 000000000..935966eb2 --- /dev/null +++ b/example/linked_list/example_absorb.f90 @@ -0,0 +1,44 @@ +! example_absorb.f90 -- +! Demonstrate the absorb method +! +program example_absorb + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list, list_to_absorb + + ! + ! Add a few elements to the two lists + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call list_to_absorb%insert( 5, 1 ) + call list_to_absorb%insert( 6, 2 ) + + write(*,*) 'List 1:' + call print_list( list ) + write(*,*) 'List 2:' + call print_list( list_to_absorb ) + + ! + ! Now absorb the second list to the first one + ! + + call list%absorb( list_to_absorb ) + + ! + ! Print the resulting list + ! + write(*,*) 'New list:' + call print_list( list ) + + ! + ! Print the second list (it is untouched) + write(*,*) 'List that was absorbed (should be empty):' + call print_list( list_to_absorb ) + +end program example_absorb diff --git a/example/linked_list/example_clear.f90 b/example/linked_list/example_clear.f90 new file mode 100644 index 000000000..8fd4befb0 --- /dev/null +++ b/example/linked_list/example_clear.f90 @@ -0,0 +1,28 @@ +! example_clear.f90 -- +! Demonstrate the clear method +! +program example_clear + use stdlib_linked_list + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + ! + ! Clean up the list + ! + call list%clear() + + ! + ! The program should print 0 + ! + write(*,*) 'Size of the list: ', list%size() + +end program example_clear diff --git a/example/linked_list/example_get.f90 b/example/linked_list/example_get.f90 new file mode 100644 index 000000000..5a77f2ed7 --- /dev/null +++ b/example/linked_list/example_get.f90 @@ -0,0 +1,41 @@ +! example_get.f90 -- +! Demonstrate the get method +! +program example_get + use stdlib_linked_list + + implicit none + + type(linked_list) :: list + class(*), pointer :: list_item + integer :: i + + ! + ! Add a few elements + ! + call list%insert( "String element ", 1 ) ! Note the trailing blanks + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + ! + ! Print the contents of the list + ! + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo + +end program example_get diff --git a/example/linked_list/example_insert.f90 b/example/linked_list/example_insert.f90 new file mode 100644 index 000000000..b0260cc08 --- /dev/null +++ b/example/linked_list/example_insert.f90 @@ -0,0 +1,32 @@ +! example_insert.f90 -- +! Demonstrate the insert method +! +program example_insert + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + ! + ! Now insert an element in the middle + ! + + call list%insert( "Another string", 2 ) + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_insert diff --git a/example/linked_list/example_pop.f90 b/example/linked_list/example_pop.f90 new file mode 100644 index 000000000..88d2f746c --- /dev/null +++ b/example/linked_list/example_pop.f90 @@ -0,0 +1,33 @@ +! example_pop.f90 -- +! Demonstrate the pop method +! +program example_pop + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + + ! + ! Now pop the last element from the list + ! + + call list%pop + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_pop diff --git a/example/linked_list/example_push.f90 b/example/linked_list/example_push.f90 new file mode 100644 index 000000000..f12a990dd --- /dev/null +++ b/example/linked_list/example_push.f90 @@ -0,0 +1,33 @@ +! example_push.f90 -- +! Demonstrate the push method +! +program example_push + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + + ! + ! Now push a new element to the end + ! + + call list%push( 3 ) + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_push diff --git a/example/linked_list/example_remove.f90 b/example/linked_list/example_remove.f90 new file mode 100644 index 000000000..5783d495f --- /dev/null +++ b/example/linked_list/example_remove.f90 @@ -0,0 +1,33 @@ +! example_remove.f90 -- +! Demonstrate the remove method +! +program example_remove + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + + ! + ! Now remove the second element + ! + + call list%remove( 2 ) + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_remove diff --git a/example/linked_list/example_replace.f90 b/example/linked_list/example_replace.f90 new file mode 100644 index 000000000..ef742a35b --- /dev/null +++ b/example/linked_list/example_replace.f90 @@ -0,0 +1,33 @@ +! example_replace.f90 -- +! Demonstrate the replace method +! +program example_replace + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + + ! + ! Now replace the second element by a string + ! + + call list%replace( "Another string", 2 ) + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_replace diff --git a/example/linked_list/example_reverse.f90 b/example/linked_list/example_reverse.f90 new file mode 100644 index 000000000..456390c74 --- /dev/null +++ b/example/linked_list/example_reverse.f90 @@ -0,0 +1,33 @@ +! example_reverse.f90 -- +! Demonstrate the reverse method +! +program example_reverse + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call print_list( list ) + + ! + ! Now reverse the whole list + ! + + call list%reverse + + ! + ! Print the list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_reverse diff --git a/example/linked_list/example_size.f90 b/example/linked_list/example_size.f90 new file mode 100644 index 000000000..4409553b2 --- /dev/null +++ b/example/linked_list/example_size.f90 @@ -0,0 +1,23 @@ +! example_size.f90 -- +! Demonstrate the size method +! +program example_size + use stdlib_linked_list + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + ! + ! The program should print 3 + ! + write(*,*) 'Size of the list: ', list%size() + +end program example_size diff --git a/example/linked_list/example_slice.f90 b/example/linked_list/example_slice.f90 new file mode 100644 index 000000000..540b04052 --- /dev/null +++ b/example/linked_list/example_slice.f90 @@ -0,0 +1,40 @@ +! example_slice.f90 -- +! Demonstrate the slice method +! +program example_slice + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list, sublist + + ! + ! Add a few elements to the list + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + call list%insert( 5, 4 ) + call list%insert( 6, 5 ) + + write(*,*) 'Full list:' + call print_list( list ) + + ! + ! Now construct a sublist via the slice method + ! + sublist = list%slice( 2, 4 ) + + ! + ! Print the resulting list + ! + write(*,*) 'Original list:' + call print_list( list ) + + ! + ! Print the second list + write(*,*) 'Sublist:' + call print_list( sublist) + +end program example_slice diff --git a/example/linked_list/example_splice.f90 b/example/linked_list/example_splice.f90 new file mode 100644 index 000000000..61e280735 --- /dev/null +++ b/example/linked_list/example_splice.f90 @@ -0,0 +1,37 @@ +! example_splice.f90 -- +! Demonstrate the splice method +! +program example_splice + use stdlib_linked_list + use linked_list_aux + + implicit none + + type(linked_list) :: list + + ! + ! Add a few elements to the list + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + call list%insert( 5, 1 ) + call list%insert( 6, 2 ) + + write(*,*) 'Full list:' + call print_list( list ) + + ! + ! Now remove a part of the list via the splice method + ! + + write(*,*) 'splicing ...' + call list%splice( 2, 4 ) + + ! + ! Print the resulting list + ! + write(*,*) 'New list:' + call print_list( list ) + +end program example_splice diff --git a/example/linked_list/linked_list_aux.f90 b/example/linked_list/linked_list_aux.f90 new file mode 100644 index 000000000..c7074f98a --- /dev/null +++ b/example/linked_list/linked_list_aux.f90 @@ -0,0 +1,36 @@ +! linked_list_aux.f90 -- +! Auxiliary module for printing the contents of a linked list +! +module linked_list_aux + use stdlib_linked_list + + implicit none + +contains +subroutine print_list( list ) + type(linked_list), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list + +end module linked_list_aux + diff --git a/example/linked_list/stdlib_child_list.f90 b/example/linked_list/stdlib_child_list.f90 new file mode 100644 index 000000000..ba43f6a04 --- /dev/null +++ b/example/linked_list/stdlib_child_list.f90 @@ -0,0 +1,369 @@ +!> Implementation of a Child list type to hold various types of data. +!> +!> The child list module provides a heterogeneous generic linked list +!> that acts as a basic building block for the linked list module + + +module stdlib_child_list + implicit none + + ! making Node and child_list struct globally available + public:: Node, child_list + + !> Defining Node + !> + !> The purpose of this node is to hold an item + !> and links to previous and next Node. + type Node + type(Node), pointer :: next => null() + type(Node), pointer :: prev => null() + class(*), allocatable :: item + contains + procedure :: clear => node_destroyed + procedure, private :: clear_all => all_nodes_destroyed + end type Node + + !> Defining Child List + !> + !> This linked list is single-dimensional chain of Nodes. + !> It is a doubly-linked heterogeneous generic list . + type child_list + integer, private :: num_nodes = 0 + type(Node), pointer :: head => null() + type(Node), pointer :: tail => null() + contains + procedure:: push => push_at_tail + procedure:: insert => insert_at_index + procedure:: pop => pop_node_at_tail + procedure:: remove => remove_node_at_index + procedure:: get => get_node_at_index + procedure:: size => get_length + procedure:: set_size => set_length + procedure:: replace => replace_at_index + procedure:: reverse => reverse_child_list + procedure:: clear => destroy_whole_child_list + end type child_list + + contains + + !> Creates a Node that contains 'new_item' as its child + !> + !> Returns the new parent node + pure function initialize_node( new_item ) result( new_node ) + type(node) :: new_node + class(*), intent(in), optional :: new_item + + ! allocating new_item to the new node's item + allocate(new_node%item, source=new_item) + end function initialize_node + + !> Delete a node and frees the memory in the item. + pure subroutine node_destroyed( this_node ) + class(node), intent(inout) :: this_node + + !Deallocate it's item + if (allocated(this_node%item)) deallocate(this_node%item) + + !Nullify it's pointers + nullify(this_node%next) + nullify(this_node%prev) + end subroutine node_destroyed + + + pure subroutine all_nodes_destroyed( this_node ) + !Entrada: + class(node), intent(inout) :: this_node + !Local: + type(node), pointer :: current_node + type(node), pointer :: next_node + !Deallocate it's item + current_node = this_node + next_node => current_node%next + do + deallocate(current_node) + if (.not. associated(next_node)) exit + current_node => next_node + next_node => current_node%next + end do + end subroutine all_nodes_destroyed + + + !> Insert 'item' at the tail of the input child list + pure subroutine push_at_tail( this_child_list, item ) + + class(child_list), intent(inout) :: this_child_list + class(*), intent(in) :: item + + ! Finding if its a first node or the child_list already have a node + if (associated(this_child_list%tail)) then + allocate(this_child_list%tail%next, source=initialize_node(item)) + this_child_list%tail%next%prev => this_child_list%tail + this_child_list%tail => this_child_list%tail%next + else + allocate(this_child_list%head, source=initialize_node(item)) + this_child_list%tail => this_child_list%head + end if + + this_child_list%num_nodes = this_child_list%num_nodes + 1 + end subroutine push_at_tail + + + !> Insert 'item' at the given 'node_index' of the input child list + pure subroutine insert_at_index( this_child_list, item ,node_index ) + class(child_list), intent(inout) :: this_child_list + integer, intent(in) :: node_index + class(*), intent(in) :: item + type(node), pointer :: current_node + type(node), pointer :: next_node + + integer :: index + + ! This index will be used for iteraing + index = node_index-1; + + ! will insert after tail when the input is more than size of the child list + if(index >=this_child_list%num_nodes) then + call this_child_list%push(item) + return + else if(index <=0) then + ! will insert after tail when the input is more than size of the child list + current_node => this_child_list%head + allocate(this_child_list%head,source = initialize_node(item)) + this_child_list%head%next => current_node + current_node%prev => this_child_list%head + else + current_node => this_child_list%head + do while(index >1) + index = index -1; + current_node => current_node%next; + end do + next_node => current_node%next + allocate(current_node%next,source = initialize_node(item)) + current_node%next%prev => current_node + current_node%next%next => next_node + current_node => current_node%next + current_node%next%prev => current_node + end if + this_child_list%num_nodes = this_child_list%num_nodes + 1; + end subroutine insert_at_index + + + !> Removing the last node from the input child list + pure subroutine pop_node_at_tail( this_child_list ) + + class(child_list), intent(inout) :: this_child_list + + type(node), pointer:: current_node + + ! return if the size of the child list is 0 + if(this_child_list%num_nodes == 0) return; + + + ! poping the last node of the child list + current_node => this_child_list%tail + if (associated(current_node%prev).and.associated(current_node%next)) then + !child_list Node is in mid + current_node%next%prev => current_node%prev + current_node%prev%next => current_node%next + + else if (associated(current_node%prev)) then + !child_list tail + nullify(current_node%prev%next) + this_child_list%tail => current_node%prev + + else if (associated(current_node%next)) then + !child_list head + nullify(current_node%next%prev) + this_child_list%head => current_node%next + else + nullify(this_child_list%head) + nullify(this_child_list%tail) + end if + + !Destroy node content and Free it's memory + call current_node%clear() + deallocate(current_node) + + !Reduce the count by 1 + this_child_list%num_nodes = this_child_list%num_nodes - 1 + end subroutine pop_node_at_tail + + !> Removing the node at the given 'node_index' from the input child list + pure subroutine remove_node_at_index( this_child_list, node_index ) + + class(child_list), intent(inout) :: this_child_list + integer, intent(in):: node_index + type(node), pointer:: current_node + + ! This index will be reference for child list + integer:: index + + !iterating through the child_list to reach the nth node + current_node => this_child_list%head + + ! return if the given node index is not in range of 1 to size of linked list + if(node_index<=0) return; + if(node_index>this_child_list%num_nodes) return; + index = 1 + do while ( associated(current_node) ) + if (index==node_index) then + if (associated(current_node%prev).and.associated(current_node%next)) then + !child_list Node is in mid + current_node%next%prev => current_node%prev + current_node%prev%next => current_node%next + + else if (associated(current_node%prev)) then + !child_list tail + nullify(current_node%prev%next) + this_child_list%tail => current_node%prev + + else if (associated(current_node%next)) then + !child_list head + nullify(current_node%next%prev) + this_child_list%head => current_node%next + else + !only node in list + nullify(this_child_list%head) + nullify(this_child_list%tail) + end if + + !Destroy node content and Free it's memory + call current_node%clear() + deallocate(current_node) + + !Reduce the index by 1 + this_child_list%num_nodes = this_child_list%num_nodes - 1 + return + end if + current_node => current_node%next + index = index+1 + end do + end subroutine remove_node_at_index + + + !> Returns the pointer to the item stored at 'node_index' in the input child list + !> + !> Returns a pointer + function get_node_at_index( this_child_list, node_index ) result (return_item) + + class(child_list), intent(inout) :: this_child_list + integer, intent(in):: node_index + class(*), pointer :: return_item + type(node), pointer:: current_node + integer:: index + + !iterating through the child_list to reach the nth node + current_node => this_child_list%head + index = 1 + do while ( associated(current_node) ) + + if (index == node_index) then + ! Return the pointer to item stored at specified index + return_item => current_node%item + nullify(current_node) + return + end if + current_node => current_node%next + index = index+1 + + end do + nullify(current_node) + nullify(return_item) + + end function get_node_at_index + + !> Returns the total number of nodes in the input child list + !> + !> Returns an integer + pure function get_length ( this_child_list ) result ( length ) + class(child_list), intent(in) :: this_child_list + integer :: length + + length = this_child_list%num_nodes + + end function get_length + + + !> Changes the size of the input child list to 'length' + pure subroutine set_length ( this_child_list, length ) + class(child_list), intent(inout) :: this_child_list + integer, intent(in) :: length + + this_child_list%num_nodes = length + + end subroutine set_length + + + + !> Replaces the item stored in node at 'node_index' of the input child list with 'new_item' + pure subroutine replace_at_index( this_child_list, item ,node_index ) + + class(child_list), intent(inout) :: this_child_list + integer, intent(in) :: node_index + class(*), intent(in) :: item + type(node), pointer :: current_node + integer :: index + + + ! This index will be reference for child list + index = node_index; + + ! return if the given node index is not in range of 1 to size of child list + if(index<1 .or. index>this_child_list%num_nodes) return; + + + ! Iterating through parent nodes while size of the child list is smaller than index + current_node => this_child_list%head; + do while(index>1) + index = index-1; + current_node => current_node%next; + end do + current_node%item = item + + end subroutine replace_at_index + + !> Reverses the input child list + pure subroutine reverse_child_list (this_child_list) + class(child_list), intent(inout) :: this_child_list + type(node), pointer :: temp_node + type(node), pointer :: curr_node + + nullify(temp_node) + + ! Swapping head of the child node with tail of the child node + curr_node => this_child_list%head + do while (associated(curr_node)) + temp_node => curr_node%prev; + curr_node%prev => curr_node%next; + curr_node%next => temp_node; + curr_node => curr_node%prev; + end do + + temp_node=> this_child_list%head + this_child_list%head => this_child_list%tail + this_child_list%tail => temp_node + + end subroutine reverse_child_list + + !> Destroy the whole given linked list + !> Free the allocated memory + !> Nullify all the variables + pure subroutine destroy_whole_child_list( this_child_list ) + !Entrada: + class(child_list), intent(inout) :: this_child_list + !Local: + type(node), pointer:: current_node + + do while (this_child_list%num_nodes>0) + current_node => this_child_list%head + if (associated(current_node%next)) then + nullify(current_node%next%prev) + this_child_list%head => current_node%next + end if + call current_node%clear() + deallocate(current_node) + this_child_list%num_nodes = this_child_list%num_nodes - 1 + end do + + end subroutine destroy_whole_child_list +end module stdlib_child_list diff --git a/example/linked_list/stdlib_linked_list.f90 b/example/linked_list/stdlib_linked_list.f90 new file mode 100644 index 000000000..94858ed7d --- /dev/null +++ b/example/linked_list/stdlib_linked_list.f90 @@ -0,0 +1,778 @@ +!> Implementation of a linked list type to hold various types of data. +!> +!> This module provides a heterogeneous generic linked list. +!> + +module stdlib_linked_list + use stdlib_child_list + implicit none + + ! making Parent_Node and linked_list struct globally available + public :: Parent_Node + public :: linked_list + + ! Maximum size of the child linked list + integer, private, parameter :: MAX_SIZE = 10000 + + ! The number of child list's nodes after which splitting of the parent node begins + integer, private, parameter :: SPLIT_POINT = INT(0.9*MAX_SIZE) + + !> Defining Parent Node + !> + !> The purpose of this node is to hold a child list + !> and links to previous and next Parent Node. + type Parent_Node + type(Parent_Node), pointer :: next => null() + type(Parent_Node), pointer :: prev => null() + type(child_list) , allocatable :: child + contains + procedure :: size => child_length + procedure :: split => split_into_two_nodes + procedure, private :: destroy => parent_node_destroyed + end type Parent_Node + + !> Defining Linked List + !> + !> This linked list is single-dimensional chain of Parent Nodes. + !> It is a doubly-linked heterogeneous generic list . + type linked_list + integer, private :: num_parent_nodes = 0 + integer, private :: total_nodes = 0 + type(Parent_Node), pointer :: head => null() + type(Parent_Node), pointer :: tail => null() + contains + procedure :: push => append_at_child_tail + procedure :: insert => insert_in_parent_at_index + procedure :: pop => pop_node_at_tail_parent + procedure :: remove => remove_node_at_index_parent + procedure :: get => get_element_at_index_in_parent + procedure :: number_of_parent_nodes => get_number_of_parent_nodes + procedure :: set_number_of_parent_nodes => set_number_of_parent_nodes + procedure :: size => get_total_nodes + procedure :: set_size => set_size_of_list + procedure :: replace => replace_in_parent_at_index + procedure :: reverse => reverse_linked_list + procedure :: clear => clear_whole_linked_list + procedure :: concat => concat_at_end_of_list + procedure :: absorb => absorb_another_list + procedure :: slice => slice_a_part_of_list + procedure :: splice => splice_a_part_of_list + end type linked_list + + contains + + !> Creates a Parent Node that contains 'item' as its child + !> + !> Returns the new parent node + pure function initialize_parent_node( item ) result( new_node ) + type(Parent_Node) :: new_node + type(child_list), intent(in) :: item + + ! allocating item to the new node's child + allocate(new_node%child, source=item) + + end function initialize_parent_node + + + !> Returns the number of nodes stored in the input parent node's child list + pure function child_length( this_parent_node ) result( size ) + class(Parent_Node), intent(in) :: this_parent_node + integer :: size + + size = this_parent_node%child%size() + + end function child_length + + !> Splits the input parent node into two half and + !> connects them with next and prev references + pure subroutine split_into_two_nodes( this_parent_node ) + + ! + class(Parent_Node), intent(inout) :: this_parent_node; + type(Parent_Node), pointer :: next_parent_node; + type(node), pointer :: old_child_tail; + type(child_list) :: new_child_list + integer :: node_child_size + integer :: i + + + node_child_size = this_parent_node%child%size()/2; + + ! Iterating to the mid point of the list to find tail for old child + i = 1 + old_child_tail => this_parent_node%child%head + do while( i < node_child_size) + i = i+1 + old_child_tail => old_child_tail%next + end do + + ! Associating new child's head and tail + new_child_list%head => old_child_tail%next + new_child_list%tail => this_parent_node%child%tail + + ! Associating old child's tail + this_parent_node%child%tail => old_child_tail + + ! Change the size of the linked lists + call new_child_list%set_size(this_parent_node%child%size()-node_child_size) + call this_parent_node%child%set_size(node_child_size) + + ! Fitting in the new parent node with proper next and prev references + if( associated(this_parent_node%next) ) then + next_parent_node => this_parent_node%next + allocate(this_parent_node%next, source=initialize_parent_node(new_child_list)) + this_parent_node%next%next => next_parent_node + this_parent_node%next%prev => next_parent_node%prev + next_parent_node%prev => this_parent_node%next + else + allocate(this_parent_node%next, source=initialize_parent_node(new_child_list)) + next_parent_node = this_parent_node + next_parent_node%next%prev => next_parent_node + end if + + end subroutine split_into_two_nodes + + + !> Delete a node and frees the memory in the item. + pure subroutine parent_node_destroyed( this_linked_list ) + class(parent_node), intent(inout) :: this_linked_list + + !Deallocate it's child + if ( allocated(this_linked_list%child) ) deallocate(this_linked_list%child) + + !Nullify it's pointers + nullify(this_linked_list%next) + nullify(this_linked_list%prev) + + end subroutine parent_node_destroyed + + + !> Insert 'item' at the tail of the input linked list + subroutine append_at_child_tail( this_linked_list, item ) + + class(linked_list), intent(inout) :: this_linked_list + class(*), intent(in) :: item + integer :: temp + real :: r + type(child_list) :: new_child + + ! Finding if its a first node or the list already have a node + + if( this_linked_list%num_parent_nodes == 0 ) then + ! Linked List is empty. Associating head and tail of the input linked list + call new_child%push(item) + allocate(this_linked_list%head, source=initialize_parent_node(new_child)) + this_linked_list%tail => this_linked_list%head + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1 + else + ! Checking if the tail node of linked list is needed to break into two parent nodes. + if( this_linked_list%tail%child%size() > SPLIT_POINT ) then + temp = MAX_SIZE-this_linked_list%tail%child%size() + call random_number(r); + if( r*( MAX_SIZE-SPLIT_POINT ) >= temp ) then + call this_linked_list%tail%split(); + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1; + if( associated(this_linked_list%tail%next) ) this_linked_list%tail => this_linked_list%tail%next + end if + end if + call this_linked_list%tail%child%push(item) + end if + this_linked_list%total_nodes = this_linked_list%total_nodes + 1 + + end subroutine append_at_child_tail + + + !> Insert 'item' at the given 'node_index' of the input parent list + subroutine insert_in_parent_at_index( this_linked_list, item, node_index ) + class(linked_list), intent(inout) :: this_linked_list + integer, intent(in):: node_index + class(*), intent(in) :: item + type(Parent_Node), pointer:: current_node + real :: r + integer :: index, temp + + ! This index will be reference for child list + index = node_index + current_node => this_linked_list%head + if( this_linked_list%total_nodes == 0 ) then + call this_linked_list%push(item); + return + end if + + ! will insert before head when the input index is less than 1 + if( index <= 0 ) index = 1; + + ! will insert after tail when the input is more than size of the linked list + if( index > this_linked_list%total_nodes ) index = this_linked_list%total_nodes+1; + + ! Iterating through parent nodes while size of the child list is smaller than index + do while( index > current_node%child%size()+1 ) + index = index - current_node%child%size() + current_node => current_node%next + end do + + ! Checking if the current node is needed to split into two parent nodes. + if( current_node%child%size() > (MAX_SIZE-1000) ) then + temp = MAX_SIZE-current_node%child%size() + call random_number(r); + if( r*1000 >= temp ) then + call current_node%split(); + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1; + if( associated(this_linked_list%tail%next) ) this_linked_list%tail => this_linked_list%tail%next + end if + end if + + do while( index > current_node%child%size()+1 ) + index = index - current_node%child%size() + current_node => current_node%next + end do + + ! Insert 'item' in the child list at index + call current_node%child%insert(item,index); + this_linked_list%total_nodes = this_linked_list%total_nodes + 1 + + end subroutine insert_in_parent_at_index + + + !> Removing the last node from the input linked list + pure subroutine pop_node_at_tail_parent( this_linked_list ) + + class(linked_list), intent(inout) :: this_linked_list + type(Parent_Node), pointer :: current_node + + ! return if the size of the linked list is 0 + if( this_linked_list%total_nodes == 0 ) return; + + ! pop the last node of the child list of the tail parent node + current_node => this_linked_list%tail + call current_node%child%pop() + + ! if child list of tail parent node is empty, remove the tail parent node + if ( current_node%child%size() == 0 ) then + if ( associated(current_node%prev) .and. associated(current_node%next) ) then + !Parent Node is in mid + current_node%prev%child%tail%next => current_node%next%child%head + current_node%next%child%head%prev => current_node%prev%child%tail + current_node%next%prev => current_node%prev + current_node%prev%next => current_node%next + + else if ( associated(current_node%prev) ) then + !Parent Node is tail + nullify(current_node%prev%child%tail%next) + nullify(current_node%prev%next) + this_linked_list%tail => current_node%prev + + else if ( associated(current_node%next) ) then + !Parent Node is head + nullify(current_node%next%child%head%prev) + nullify(current_node%next%prev) + this_linked_list%head => current_node%next + + else + !Parent Node is the Last Node + nullify(this_linked_list%head) + nullify(this_linked_list%tail) + end if + + !Destroy Paret Node's content and Free it's memory + call current_node%destroy() + deallocate(current_node) + + !Reduce the number of parent nodes by 1 + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes - 1 + end if + + this_linked_list%total_nodes = this_linked_list%total_nodes-1 + + end subroutine pop_node_at_tail_parent + + + !> Removing the node at the given 'node_index' from the input linked list + pure subroutine remove_node_at_index_parent( this_linked_list, node_index ) + + class(linked_list), intent(inout) :: this_linked_list + integer, intent(in):: node_index + + type(Parent_Node), pointer:: current_node + integer:: index + + ! This index will be reference for child list + index = node_index + current_node => this_linked_list%head + + ! return if the given node index is not in range of 1 to size of linked list + if( node_index <= 0 ) return; + if( node_index > this_linked_list%total_nodes ) return; + + + ! Iterating through parent nodes while size of the child list is smaller index + do while( index > current_node%child%size() ) + index=index-current_node%child%size() + current_node => current_node%next + end do + call current_node%child%remove(index); + + ! if child list of current parent node is empty, remove the current parent node + if ( current_node%child%size() == 0 ) then + if ( associated(current_node%prev) .and. associated(current_node%next) ) then + !Parent Node is in mid + current_node%prev%child%tail%next => current_node%next%child%head + current_node%next%child%head%prev => current_node%prev%child%tail + current_node%next%prev => current_node%prev + current_node%prev%next => current_node%next + + else if ( associated(current_node%prev) ) then + !Parent Node is tail + nullify(current_node%prev%child%tail%next) + nullify(current_node%prev%next) + this_linked_list%tail => current_node%prev + + else if ( associated(current_node%next) ) then + !Parent Node is head + nullify(current_node%next%child%head%prev) + nullify(current_node%next%prev) + this_linked_list%head => current_node%next + + else + !Parent Node is the Last Node + nullify(this_linked_list%head) + nullify(this_linked_list%tail) + end if + + !Destroy Paret Node's content and Free it's memory + call current_node%destroy() + deallocate(current_node) + + !Reduce the number of parent nodes by 1 + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes - 1 + end if + + this_linked_list%total_nodes = this_linked_list%total_nodes-1 + + end subroutine remove_node_at_index_parent + + + !> Returns the pointer to the item stored at 'node_index' in the input linked list + !> + !> Returns a pointer + function get_element_at_index_in_parent( this_linked_list, node_index ) result ( return_item ) + class(linked_list), intent(in) :: this_linked_list + integer, intent(in):: node_index + class(*), pointer :: return_item + type(Parent_Node), pointer:: current_node + integer:: index + + nullify(return_item) + + ! return if the input linked list is empty + if( this_linked_list%total_nodes == 0 ) return + + ! This index will be reference for child list + index = node_index + + ! Handling out of range index cases + if( index <= 0 ) index = 1; + if( index >= this_linked_list%total_nodes ) index = this_linked_list%total_nodes; + + ! Iterating through parent nodes while size of the child list is smaller index + current_node => this_linked_list%head + do while ( associated(current_node) ) + + if( index <= current_node%child%size() ) then + ! Return the pointer to item stored at specified index + return_item => current_node%child%get(index) + return + else + index = index - current_node%child%size() + current_node => current_node%next + end if + end do + nullify(current_node) + + end function get_element_at_index_in_parent + + + !> Returns the number of parent nodes in the input linked list + !> + !> Returns an integer + pure function get_number_of_parent_nodes ( this_linked_list ) result ( length ) + class(linked_list), intent(in) :: this_linked_list + integer :: length + + length = this_linked_list%num_parent_nodes + + end function get_number_of_parent_nodes + + + !> Returns the total number of nodes in the input linked list + !> + !> Returns an integer + pure function get_total_nodes ( this_linked_list ) result ( length ) + class(linked_list), intent(in) :: this_linked_list + integer :: length + + length = this_linked_list%total_nodes + + end function get_total_nodes + + + !> Changes the size of the input linked list to 'length' + pure subroutine set_size_of_list (this_linked_list, length) + class(linked_list), intent(inout) :: this_linked_list + integer, intent(in) :: length + + this_linked_list%total_nodes = length + + end subroutine set_size_of_list + + + !> Changes the number of parent nodes of the input linked list to 'length' + pure subroutine set_number_of_parent_nodes (this_linked_list, length) + class(linked_list), intent(inout) :: this_linked_list + integer, intent(in) :: length + + this_linked_list%num_parent_nodes = length + + end subroutine set_number_of_parent_nodes + + !> Replaces the item stored in node at 'node_index' of the input linked list with 'new_item' + pure subroutine replace_in_parent_at_index( this_linked_list, new_item, node_index ) + + class(linked_list), intent(inout) :: this_linked_list + integer, intent(in) :: node_index + class(*), intent(in) :: new_item + type(Parent_Node), pointer :: current_node + integer :: index + + ! This index will be reference for child list + index = node_index; + + ! return if the given node index is not in range of 1 to size of linked list + if( index < 1 .or. index > this_linked_list%total_nodes) return; + + ! Iterating through parent nodes while size of the child list is smaller than index + current_node => this_linked_list%head; + do while( index > current_node%child%size() ) + index = index-current_node%child%size(); + current_node => current_node%next; + end do + + call current_node%child%replace(new_item, index) + + end subroutine replace_in_parent_at_index + + + !> Reverses the input linked list + pure subroutine reverse_linked_list ( this_linked_list ) + class(linked_list), intent(inout) :: this_linked_list + type(parent_node), pointer :: temp_parent_node + type(node), pointer :: temp_child_node + type(parent_node), pointer :: curr_parent_node + type(node), pointer :: curr_child_node + + ! return if the linked list is empty + if( this_linked_list%total_nodes == 0 ) return; + + nullify(temp_child_node) + + ! Reversing all the child lists + curr_child_node => this_linked_list%head%child%head + do while ( associated(curr_child_node) ) + temp_child_node => curr_child_node%prev; + curr_child_node%prev => curr_child_node%next; + curr_child_node%next => temp_child_node; + curr_child_node => curr_child_node%prev; + end do + + ! Reversing all the Parent nodes and + ! Swapping head of the child node with tail of the child node + nullify(temp_parent_node) + curr_parent_node => this_linked_list%head + do while ( associated(curr_parent_node) ) + + ! Swapping head with tail (child list) + temp_child_node => curr_parent_node%child%head + curr_parent_node%child%head => curr_parent_node%child%tail + curr_parent_node%child%tail => temp_child_node + + ! Reversing Connections of Parent Nodes + temp_parent_node => curr_parent_node%prev; + curr_parent_node%prev => curr_parent_node%next; + curr_parent_node%next => temp_parent_node; + + curr_parent_node => curr_parent_node%prev; + end do + + ! Swapping the head of the linked list with tail of the linked list + temp_parent_node=> this_linked_list%head + this_linked_list%head => this_linked_list%tail + this_linked_list%tail => temp_parent_node + + end subroutine reverse_linked_list + + + !> Destroy the whole given linked list + !> Free all the allocated memory + !> Nullify all the variables + pure subroutine clear_whole_linked_list( this_linked_list ) + class(linked_list), intent(inout) :: this_linked_list + type(Parent_Node), pointer:: current_node + + !> Iterating through the parent nodes to destroy them + do while ( this_linked_list%num_parent_nodes > 0 ) + + current_node => this_linked_list%head + if ( associated(current_node%next) ) then + nullify(current_node%next%prev) + this_linked_list%head => current_node%next + end if + + !destroy the whole child list + call current_node%child%clear() + + ! Destroy the current node + call current_node%destroy() + deallocate(current_node) + + !Decrement the number of parent nodes + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes - 1 + end do + + this_linked_list%total_nodes = 0 + + end subroutine clear_whole_linked_list + + + !> Concat one input linked list (list_to_concat) + !> at the end of other input linked list (this_linked_list) + !> + !> Creates a deep copy of the list_to_concat and + !> appends it at the end of this_linked_list + subroutine concat_at_end_of_list( this_linked_list, list_to_concat ) + class(linked_list), intent(inout) :: this_linked_list + type(linked_list), intent(inout) :: list_to_concat + type(node), pointer :: current_node + + ! Return if list to append is empty + if(list_to_concat%size() == 0) return; + + ! Push every item from list_of _concat to this_linked_list + current_node => list_to_concat%head%child%head + do while(associated(current_node)) + call this_linked_list%push(current_node%item) + current_node => current_node%next + end do + + end subroutine concat_at_end_of_list + + !> Absorb one input linked list (list_to_concat) + !> at the end of other input linked list (this_linked_list) + !> + !> Creates a shallow copy of the list_to_concat and + !> appends it at the end of this_linked_list + subroutine absorb_another_list( this_linked_list, list_to_absorb ) + class(linked_list), intent(inout) :: this_linked_list + type(linked_list), intent(inout) :: list_to_absorb + integer :: total + + ! Return if list to append is empty + if(list_to_absorb%size() == 0) return + + ! if this_linked_list is empty + if(this_linked_list%size() == 0) then + this_linked_list%head => list_to_absorb%head; + this_linked_list%tail => list_to_absorb%tail; + else + this_linked_list%tail%next => list_to_absorb%head + list_to_absorb%head%prev => this_linked_list%tail + this_linked_list%tail%child%tail%next => list_to_absorb%head%child%head + list_to_absorb%head%child%head%prev => this_linked_list%tail%child%tail + this_linked_list%tail => list_to_absorb%tail; + end if + + nullify(list_to_absorb%head) + nullify(list_to_absorb%tail) + + ! Change the size of the linked lists + call this_linked_list%set_size(this_linked_list%size() + list_to_absorb%size()) + total = this_linked_list%number_of_parent_nodes() + list_to_absorb%number_of_parent_nodes(); + + call this_linked_list%set_number_of_parent_nodes(total) + call list_to_absorb%set_size(0) + call list_to_absorb%set_number_of_parent_nodes(0) + + end subroutine absorb_another_list + + + !> Returns a linked list that is a slice part of the input linked list + !> Starting from index start till end + !> Returns a linked list + + function slice_a_part_of_list( this_linked_list, start_in, end_in ) result ( return_list ) + class(linked_list), intent(in) :: this_linked_list + type(linked_list) :: return_list + type(node), pointer :: current_node + integer, intent(in) :: start_in + integer, intent(in) :: end_in + integer :: i + integer :: start + integer :: end + + ! return if the index is out-side range of 1 to size of linked list + if(this_linked_list%size() == 0) return; + if(start_in > end_in) return; + start = max(start_in,1) + start = min(start_in,this_linked_list%size()) + end = max(end_in,1) + end = min(end_in,this_linked_list%size()) + + !iterating to find start + i = 1 + current_node => this_linked_list%head%child%head + do while(i < start) + current_node => current_node%next + i = i+1 + end do + + !iterating to find end + do while(associated(current_node) .and. (i <= end)) + call return_list%push(current_node%item) + current_node => current_node%next + i = i+1 + end do + + end function slice_a_part_of_list + + + + subroutine splice_a_part_of_list (this_linked_list, start_in, end_in) + class(linked_list), intent(inout) :: this_linked_list + type(parent_node), pointer :: start_parent_node + type(parent_node), pointer :: end_parent_node + type(node), pointer :: current_node + type(node), pointer :: next_node + type(node), pointer :: prev_node + integer, intent(in) :: start_in + integer, intent(in) :: end_in + integer :: ptr + integer :: count + integer :: nodes_in_start_parent_node + integer :: nodes_in_end_parent_node + integer :: start + integer :: end + class(*), pointer :: data + + !nullify every pointer + nullify(start_parent_node) + nullify(end_parent_node) + nullify(current_node) + nullify(next_node) + nullify(prev_node) + + ! return if the input linked list is empty + if(this_linked_list%size() == 0) return; + + ! return if input start is nore than input end + if(start_in>end_in) return; + + ! handling the out of range index + start = max(start_in,1) + start = min(start_in,this_linked_list%size()) + end = max(end_in,1) + end = min(end_in,this_linked_list%size()) + + ! destroy the whole llist + if(end == this_linked_list%size() .and. start == 1) then + call this_linked_list%clear() + return + end if + count = 0 + + !iterating through the linked list to find the end parent node + end_parent_node => this_linked_list%head; + ptr = 0 + do while(associated(end_parent_node)) + if(ptr+end_parent_node%child%size() > end) exit; + ptr = ptr + end_parent_node%child%size() + end_parent_node => end_parent_node%next + count = count+1; + end do + nodes_in_end_parent_node = ptr + + + !iterating through the linked list to find the end parent node + if(start /= 1) then + start_parent_node => this_linked_list%head; + ptr = 1 + do while(associated(start_parent_node)) + if(ptr+start_parent_node%child%size() >= start) exit; + ptr = ptr + start_parent_node%child%size() + start_parent_node => start_parent_node%next + count = count-1 + end do + nodes_in_start_parent_node = ptr-1; + end if + + ! iterating to the find the start_node + ptr = 1 + current_node => this_linked_list%head%child%head + do while(ptr < start) + current_node => current_node%next + ptr = ptr+1 + end do + prev_node => current_node%prev + if(associated(prev_node)) then + end if + + ! iterating to find the last node to splice + do while(associated(current_node) .and. (ptr <= end)) + next_node => current_node%next + if (associated(current_node%prev).and.associated(current_node%next)) then + current_node%next%prev => current_node%prev + current_node%prev%next => current_node%next + else if (associated(current_node%prev)) then + nullify(current_node%prev%next) + else if (associated(current_node%next)) then + nullify(current_node%next%prev) + end if + call current_node%clear() + deallocate(current_node) + current_node => next_node + ptr = ptr+1 + end do + + ! Connecting the parent nodes + if(count == 0) then + if(associated(start_parent_node)) call start_parent_node%child%set_size(start_parent_node%child%size() - (end-start+1)) + else + if(associated(start_parent_node)) then + if(start-nodes_in_start_parent_node-1>0) call start_parent_node%child%set_size(start-nodes_in_start_parent_node-1) + start_parent_node%next => end_parent_node + start_parent_node%child%tail => prev_node + end if + if(associated(end_parent_node)) then + call end_parent_node%child%set_size(end_parent_node%child%size() + nodes_in_end_parent_node - end) + end_parent_node%prev => start_parent_node + end_parent_node%child%head => current_node + end if + end if + + ! setting up new linked list tail if needed + if(end == this_linked_list%size()) then + count = count+1 + this_linked_list%tail => start_parent_node + end if + + ! setting up new linked list head if needed + if(start == 1) then + count = count + 1 + this_linked_list%head => end_parent_node + end if + + ! Changing size of the linked list corrospondingly + call this_linked_list%set_size( this_linked_list%size() - (end - start + 1) ) + if(count>1) call this_linked_list%set_number_of_parent_nodes(this_linked_list%number_of_parent_nodes() - count + 1) + + end subroutine splice_a_part_of_list + +end module stdlib_linked_list diff --git a/test/linked_list/test_performance.f90 b/test/linked_list/test_performance.f90 new file mode 100644 index 000000000..28b68dd70 --- /dev/null +++ b/test/linked_list/test_performance.f90 @@ -0,0 +1,71 @@ +program test_link + use stdlib_linked_list + implicit none + + type struct + integer:: a=1,b=2,c=3 + double precision::d=5 + end type struct + type(struct):: Vel2 + + type vector + double precision, dimension(3):: vec + end type vector + type(vector)::Vel + + type(linked_list):: L + integer :: i,j,length + real :: T1,T2,F, r + integer :: cnt1, cnt2, count_rate + + class(*), pointer :: data + + do i=1,size(Vel%vec) + Vel%vec(i) = i + end do + ! !------------- + ! !Append items + ! !------------- + print*, "Length Of Required List" + read(*,*) length + + call system_clock( cnt1, count_rate = count_rate ) + call cpu_time(T1) + do i=1,length + call L%append(i) + end do + call cpu_time(T2) + call system_clock( cnt2, count_rate = count_rate ) + i = 1 + + write(*,*) T2-T1, (cnt2 - cnt1)/real(count_rate) + + call system_clock( cnt1, count_rate = count_rate ) + call cpu_time(T1) + do while (i<=100) + call random_number( r ) + j = r*length + data => L%get(j) + select type (data) + type is (integer) + end select + i = i+1 + end do + call cpu_time(T2) + call system_clock( cnt2, count_rate = count_rate ) + + write(*,*) (T2-T1), (cnt2 - cnt1)/real(count_rate) + write(*,*)'Done' + + !------------- + !Destroy the list and frees the memmory + !------------- + call system_clock( cnt1, count_rate = count_rate ) + call cpu_time(T1) + call L%destroy() + call cpu_time(T2) + call system_clock( cnt2, count_rate = count_rate ) + + write(*,*) T2-T1, (cnt2 - cnt1)/real(count_rate) + +end program test_link From 4379fb4e99c7195a8572b96c6f097bd30f3e6218 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 18 Sep 2022 14:41:36 +0200 Subject: [PATCH 04/20] Correct subdirectory for examples Correct the subdirectory for the examples in the documentation. --- doc/specs/stdlib_linked_list.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_linked_list.md b/doc/specs/stdlib_linked_list.md index 68097f730..099018428 100644 --- a/doc/specs/stdlib_linked_list.md +++ b/doc/specs/stdlib_linked_list.md @@ -84,7 +84,7 @@ None #### Example ```fortran -{!example/strings/example_clear.f90!} +{!example/linked_list/example_clear.f90!} ``` @@ -124,7 +124,7 @@ Notes: #### Example ```fortran -{!example/strings/example_get.f90!} +{!example/linked_list/example_get.f90!} ``` @@ -166,7 +166,7 @@ Notes: #### Example ```fortran -{!example/strings/example_insert.f90!} +{!example/linked_list/example_insert.f90!} ``` @@ -207,7 +207,7 @@ Notes: #### Example ```fortran -{!example/strings/example_replace.f90!} +{!example/linked_list/example_replace.f90!} ``` @@ -246,7 +246,7 @@ Notes: #### Example ```fortran -{!example/strings/example_remove.f90!} +{!example/linked_list/example_remove.f90!} ``` @@ -280,7 +280,7 @@ The list is extended with the new data item at the tail. #### Example ```fortran -{!example/strings/example_push.f90!} +{!example/linked_list/example_push.f90!} ``` @@ -314,7 +314,7 @@ The list item in the list is removed. #### Example ```fortran -{!example/strings/example_pop.f90!} +{!example/linked_list/example_pop.f90!} ``` @@ -348,7 +348,7 @@ The list now contains the items in reverse order. #### Example ```fortran -{!example/strings/example_reverse.f90!} +{!example/linked_list/example_reverse.f90!} ``` @@ -383,7 +383,7 @@ The given list is extended with the data items in the second list. The second li #### Example ```fortran -{!example/strings/example_concat.f90!} +{!example/linked_list/example_concat.f90!} ``` @@ -418,7 +418,7 @@ The given list is extended with the data items in the second list. The second li #### Example ```fortran -{!example/strings/example_absorb.f90!} +{!example/linked_list/example_absorb.f90!} ``` @@ -456,7 +456,7 @@ list, so that the two lists are independent. #### Example ```fortran -{!example/strings/example_slice.f90!} +{!example/linked_list/example_slice.f90!} ``` @@ -493,5 +493,5 @@ The data items in the given range are removed from the list. #### Example ```fortran -{!example/strings/example_splice.f90!} +{!example/linked_list/example_splice.f90!} ``` From 3067b9ac07e3d5324d01bdb32b6f02ec136f0ed8 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 18 Sep 2022 16:47:46 +0200 Subject: [PATCH 05/20] Move the implementations of the linked_list modules to src Move the actual implementations of the linked list type (the linked list itself and the child list component) to the directory src. --- example/linked_list/mk.bat | 17 +++++++++++++++++ .../linked_list => src}/stdlib_child_list.f90 | 0 .../linked_list => src}/stdlib_linked_list.f90 | 0 3 files changed, 17 insertions(+) create mode 100644 example/linked_list/mk.bat rename {example/linked_list => src}/stdlib_child_list.f90 (100%) rename {example/linked_list => src}/stdlib_linked_list.f90 (100%) diff --git a/example/linked_list/mk.bat b/example/linked_list/mk.bat new file mode 100644 index 000000000..febf3b0ea --- /dev/null +++ b/example/linked_list/mk.bat @@ -0,0 +1,17 @@ +rem gfortran -c stdlib_child_list.f90 +gfortran -c stdlib_linked_list.f90 +rem gfortran -c linked_list_aux.f90 + +rem gfortran -o example_size example_size.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_clear example_clear.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_get example_get.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_insert example_insert.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_replace example_replace.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_remove example_remove.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_push example_push.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_pop example_pop.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_reverse example_reverse.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_concat example_concat.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +rem gfortran -o example_absorb example_absorb.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +gfortran -o example_slice example_slice.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +gfortran -o example_splice example_splice.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o diff --git a/example/linked_list/stdlib_child_list.f90 b/src/stdlib_child_list.f90 similarity index 100% rename from example/linked_list/stdlib_child_list.f90 rename to src/stdlib_child_list.f90 diff --git a/example/linked_list/stdlib_linked_list.f90 b/src/stdlib_linked_list.f90 similarity index 100% rename from example/linked_list/stdlib_linked_list.f90 rename to src/stdlib_linked_list.f90 From 3cf3d850e5f934d6adda5bc3af1532e204dd9e08 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 18 Sep 2022 16:58:42 +0200 Subject: [PATCH 06/20] Use an include statement to get the auxiliary subroutine in Use an include statement instead of relying on the automatic module identification to get access to the print_list subroutine. As it is merely an auxiliary, it should not become part of the "official" source code. --- example/linked_list/example_absorb.f90 | 2 ++ example/linked_list/example_insert.f90 | 2 ++ example/linked_list/example_pop.f90 | 2 ++ example/linked_list/example_push.f90 | 2 ++ example/linked_list/example_remove.f90 | 2 ++ example/linked_list/example_replace.f90 | 2 ++ example/linked_list/example_reverse.f90 | 2 ++ example/linked_list/example_slice.f90 | 2 ++ example/linked_list/example_splice.f90 | 2 ++ 9 files changed, 18 insertions(+) diff --git a/example/linked_list/example_absorb.f90 b/example/linked_list/example_absorb.f90 index 935966eb2..48a23519a 100644 --- a/example/linked_list/example_absorb.f90 +++ b/example/linked_list/example_absorb.f90 @@ -1,6 +1,8 @@ ! example_absorb.f90 -- ! Demonstrate the absorb method ! +include 'linked_list_aux.f90' + program example_absorb use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_insert.f90 b/example/linked_list/example_insert.f90 index b0260cc08..dc32fce9d 100644 --- a/example/linked_list/example_insert.f90 +++ b/example/linked_list/example_insert.f90 @@ -1,6 +1,8 @@ ! example_insert.f90 -- ! Demonstrate the insert method ! +include 'linked_list_aux.f90' + program example_insert use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_pop.f90 b/example/linked_list/example_pop.f90 index 88d2f746c..1282a939c 100644 --- a/example/linked_list/example_pop.f90 +++ b/example/linked_list/example_pop.f90 @@ -1,6 +1,8 @@ ! example_pop.f90 -- ! Demonstrate the pop method ! +include 'linked_list_aux.f90' + program example_pop use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_push.f90 b/example/linked_list/example_push.f90 index f12a990dd..850cd8308 100644 --- a/example/linked_list/example_push.f90 +++ b/example/linked_list/example_push.f90 @@ -1,6 +1,8 @@ ! example_push.f90 -- ! Demonstrate the push method ! +include 'linked_list_aux.f90' + program example_push use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_remove.f90 b/example/linked_list/example_remove.f90 index 5783d495f..d28fa597d 100644 --- a/example/linked_list/example_remove.f90 +++ b/example/linked_list/example_remove.f90 @@ -1,6 +1,8 @@ ! example_remove.f90 -- ! Demonstrate the remove method ! +include 'linked_list_aux.f90' + program example_remove use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_replace.f90 b/example/linked_list/example_replace.f90 index ef742a35b..75a6d5507 100644 --- a/example/linked_list/example_replace.f90 +++ b/example/linked_list/example_replace.f90 @@ -1,6 +1,8 @@ ! example_replace.f90 -- ! Demonstrate the replace method ! +include 'linked_list_aux.f90' + program example_replace use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_reverse.f90 b/example/linked_list/example_reverse.f90 index 456390c74..1bd3dcad9 100644 --- a/example/linked_list/example_reverse.f90 +++ b/example/linked_list/example_reverse.f90 @@ -1,6 +1,8 @@ ! example_reverse.f90 -- ! Demonstrate the reverse method ! +include 'linked_list_aux.f90' + program example_reverse use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_slice.f90 b/example/linked_list/example_slice.f90 index 540b04052..e9ef73cf3 100644 --- a/example/linked_list/example_slice.f90 +++ b/example/linked_list/example_slice.f90 @@ -1,6 +1,8 @@ ! example_slice.f90 -- ! Demonstrate the slice method ! +include 'linked_list_aux.f90' + program example_slice use stdlib_linked_list use linked_list_aux diff --git a/example/linked_list/example_splice.f90 b/example/linked_list/example_splice.f90 index 61e280735..529eab2f1 100644 --- a/example/linked_list/example_splice.f90 +++ b/example/linked_list/example_splice.f90 @@ -1,6 +1,8 @@ ! example_splice.f90 -- ! Demonstrate the splice method ! +include 'linked_list_aux.f90' + program example_splice use stdlib_linked_list use linked_list_aux From edd20fd622e0605047d7af5b015428754cf552bb Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 18 Sep 2022 17:13:51 +0200 Subject: [PATCH 07/20] Use an internal routine instead for print_list Use an internal routine for print_list instead of an included module, as the buil process still wants to find the module's source. --- example/linked_list/example_absorb.f90 | 6 ++-- example/linked_list/example_concat.f90 | 46 +++++++++++++++++++++++++ example/linked_list/example_insert.f90 | 5 +-- example/linked_list/example_pop.f90 | 6 ++-- example/linked_list/example_push.f90 | 6 ++-- example/linked_list/example_remove.f90 | 6 ++-- example/linked_list/example_replace.f90 | 6 ++-- example/linked_list/example_reverse.f90 | 6 ++-- example/linked_list/example_slice.f90 | 6 ++-- example/linked_list/example_splice.f90 | 5 +-- example/linked_list/linked_list_aux.f90 | 11 +----- 11 files changed, 74 insertions(+), 35 deletions(-) create mode 100644 example/linked_list/example_concat.f90 diff --git a/example/linked_list/example_absorb.f90 b/example/linked_list/example_absorb.f90 index 48a23519a..516f04c1e 100644 --- a/example/linked_list/example_absorb.f90 +++ b/example/linked_list/example_absorb.f90 @@ -1,11 +1,8 @@ ! example_absorb.f90 -- ! Demonstrate the absorb method ! -include 'linked_list_aux.f90' - program example_absorb use stdlib_linked_list - use linked_list_aux implicit none @@ -43,4 +40,7 @@ program example_absorb write(*,*) 'List that was absorbed (should be empty):' call print_list( list_to_absorb ) +contains +include 'linked_list_aux.f90' + end program example_absorb diff --git a/example/linked_list/example_concat.f90 b/example/linked_list/example_concat.f90 new file mode 100644 index 000000000..5f383b22b --- /dev/null +++ b/example/linked_list/example_concat.f90 @@ -0,0 +1,46 @@ +! example_concat.f90 -- +! Demonstrate the concat method +! +program example_concat + use stdlib_linked_list + + implicit none + + type(linked_list) :: list, list_to_concat + + ! + ! Add a few elements to the two lists + ! + call list%insert( "String element", 1 ) + call list%insert( 2, 2 ) + call list%insert( 3.3, 3 ) + + call list_to_concat%insert( 5, 1 ) + call list_to_concat%insert( 6, 2 ) + + write(*,*) 'List 1:' + call print_list( list ) + write(*,*) 'List 2:' + call print_list( list_to_concat ) + + ! + ! Now concat the second list to the first one + ! + + call list%concat( list_to_concat ) + + ! + ! Print the resulting list + ! + write(*,*) 'New list:' + call print_list( list ) + + ! + ! Print the second list (it is untouched) + write(*,*) 'List that was concatenated (remains intact):' + call print_list( list_to_concat ) + +contains +include 'linked_list_aux.f90' + +end program example_concat diff --git a/example/linked_list/example_insert.f90 b/example/linked_list/example_insert.f90 index dc32fce9d..441336aac 100644 --- a/example/linked_list/example_insert.f90 +++ b/example/linked_list/example_insert.f90 @@ -1,11 +1,9 @@ ! example_insert.f90 -- ! Demonstrate the insert method ! -include 'linked_list_aux.f90' program example_insert use stdlib_linked_list - use linked_list_aux implicit none @@ -31,4 +29,7 @@ program example_insert write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_insert diff --git a/example/linked_list/example_pop.f90 b/example/linked_list/example_pop.f90 index 1282a939c..d8d15c7a4 100644 --- a/example/linked_list/example_pop.f90 +++ b/example/linked_list/example_pop.f90 @@ -1,11 +1,8 @@ ! example_pop.f90 -- ! Demonstrate the pop method ! -include 'linked_list_aux.f90' - program example_pop use stdlib_linked_list - use linked_list_aux implicit none @@ -32,4 +29,7 @@ program example_pop write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_pop diff --git a/example/linked_list/example_push.f90 b/example/linked_list/example_push.f90 index 850cd8308..dd7f6f0d3 100644 --- a/example/linked_list/example_push.f90 +++ b/example/linked_list/example_push.f90 @@ -1,11 +1,8 @@ ! example_push.f90 -- ! Demonstrate the push method ! -include 'linked_list_aux.f90' - program example_push use stdlib_linked_list - use linked_list_aux implicit none @@ -32,4 +29,7 @@ program example_push write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_push diff --git a/example/linked_list/example_remove.f90 b/example/linked_list/example_remove.f90 index d28fa597d..dac0be92a 100644 --- a/example/linked_list/example_remove.f90 +++ b/example/linked_list/example_remove.f90 @@ -1,11 +1,8 @@ ! example_remove.f90 -- ! Demonstrate the remove method ! -include 'linked_list_aux.f90' - program example_remove use stdlib_linked_list - use linked_list_aux implicit none @@ -32,4 +29,7 @@ program example_remove write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_remove diff --git a/example/linked_list/example_replace.f90 b/example/linked_list/example_replace.f90 index 75a6d5507..50c6b0e97 100644 --- a/example/linked_list/example_replace.f90 +++ b/example/linked_list/example_replace.f90 @@ -1,11 +1,8 @@ ! example_replace.f90 -- ! Demonstrate the replace method ! -include 'linked_list_aux.f90' - program example_replace use stdlib_linked_list - use linked_list_aux implicit none @@ -32,4 +29,7 @@ program example_replace write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_replace diff --git a/example/linked_list/example_reverse.f90 b/example/linked_list/example_reverse.f90 index 1bd3dcad9..dcd51fe8d 100644 --- a/example/linked_list/example_reverse.f90 +++ b/example/linked_list/example_reverse.f90 @@ -1,11 +1,8 @@ ! example_reverse.f90 -- ! Demonstrate the reverse method ! -include 'linked_list_aux.f90' - program example_reverse use stdlib_linked_list - use linked_list_aux implicit none @@ -32,4 +29,7 @@ program example_reverse write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_reverse diff --git a/example/linked_list/example_slice.f90 b/example/linked_list/example_slice.f90 index e9ef73cf3..d3cd73fb2 100644 --- a/example/linked_list/example_slice.f90 +++ b/example/linked_list/example_slice.f90 @@ -1,11 +1,8 @@ ! example_slice.f90 -- ! Demonstrate the slice method ! -include 'linked_list_aux.f90' - program example_slice use stdlib_linked_list - use linked_list_aux implicit none @@ -39,4 +36,7 @@ program example_slice write(*,*) 'Sublist:' call print_list( sublist) +contains +include 'linked_list_aux.f90' + end program example_slice diff --git a/example/linked_list/example_splice.f90 b/example/linked_list/example_splice.f90 index 529eab2f1..fbdd0de2f 100644 --- a/example/linked_list/example_splice.f90 +++ b/example/linked_list/example_splice.f90 @@ -1,11 +1,9 @@ ! example_splice.f90 -- ! Demonstrate the splice method ! -include 'linked_list_aux.f90' program example_splice use stdlib_linked_list - use linked_list_aux implicit none @@ -36,4 +34,7 @@ program example_splice write(*,*) 'New list:' call print_list( list ) +contains +include 'linked_list_aux.f90' + end program example_splice diff --git a/example/linked_list/linked_list_aux.f90 b/example/linked_list/linked_list_aux.f90 index c7074f98a..5b9a507f1 100644 --- a/example/linked_list/linked_list_aux.f90 +++ b/example/linked_list/linked_list_aux.f90 @@ -1,12 +1,6 @@ ! linked_list_aux.f90 -- -! Auxiliary module for printing the contents of a linked list +! Auxiliary routine for printing the contents of a linked list ! -module linked_list_aux - use stdlib_linked_list - - implicit none - -contains subroutine print_list( list ) type(linked_list), intent(in) :: list @@ -31,6 +25,3 @@ subroutine print_list( list ) end select enddo end subroutine print_list - -end module linked_list_aux - From 86d2fe45a7435d64ba7b01157ed681ad9232eac3 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Tue, 20 Sep 2022 11:11:17 +0200 Subject: [PATCH 08/20] Add a CMakeLists.txt for building the examples Add the subdirectory "linked_list" to the overall CMake file and add a specific CMake file for the examples therein. --- example/CMakeLists.txt | 1 + example/linked_list/CMakeLists.txt | 14 ++++++++++++++ 2 files changed, 15 insertions(+) create mode 100644 example/linked_list/CMakeLists.txt diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 3dd43694f..d71d2f4cc 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -14,6 +14,7 @@ add_subdirectory(hashmaps) add_subdirectory(hash_procedures) add_subdirectory(io) add_subdirectory(linalg) +add_subdirectory(linked_list) add_subdirectory(logger) add_subdirectory(math) add_subdirectory(optval) diff --git a/example/linked_list/CMakeLists.txt b/example/linked_list/CMakeLists.txt new file mode 100644 index 000000000..c6acea430 --- /dev/null +++ b/example/linked_list/CMakeLists.txt @@ -0,0 +1,14 @@ +include_directories(${CMAKE_CURRENT_LIST_DIR}) +ADD_EXAMPLE(absorb) +ADD_EXAMPLE(clear) +ADD_EXAMPLE(concat) +ADD_EXAMPLE(get) +ADD_EXAMPLE(insert) +ADD_EXAMPLE(pop) +ADD_EXAMPLE(push) +ADD_EXAMPLE(remove) +ADD_EXAMPLE(replace) +ADD_EXAMPLE(reverse) +ADD_EXAMPLE(size) +ADD_EXAMPLE(slice) +ADD_EXAMPLE(splice) From 327c8c17887828ff9eb72c7650558ea8bb256dd8 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Tue, 20 Sep 2022 19:01:19 +0200 Subject: [PATCH 09/20] Rename the examples to avoid conflicts Rename the examples so that the names of the targets do not conflict with existing examples for other modules (notably in the strings subdirectory --- example/linked_list/CMakeLists.txt | 26 ++++++++-------- ...e_absorb.f90 => example_linked_absorb.f90} | 0 ...ple_clear.f90 => example_linked_clear.f90} | 0 ...e_concat.f90 => example_linked_concat.f90} | 0 ...example_get.f90 => example_linked_get.f90} | 0 ...e_insert.f90 => example_linked_insert.f90} | 0 ...example_pop.f90 => example_linked_pop.f90} | 0 ...ample_push.f90 => example_linked_push.f90} | 0 ...e_remove.f90 => example_linked_remove.f90} | 0 ...replace.f90 => example_linked_replace.f90} | 0 ...reverse.f90 => example_linked_reverse.f90} | 0 ...ample_size.f90 => example_linked_size.f90} | 0 ...ple_slice.f90 => example_linked_slice.f90} | 0 ...e_splice.f90 => example_linked_splice.f90} | 0 example/linked_list/mk.bat | 30 +++++++++---------- 15 files changed, 28 insertions(+), 28 deletions(-) rename example/linked_list/{example_absorb.f90 => example_linked_absorb.f90} (100%) rename example/linked_list/{example_clear.f90 => example_linked_clear.f90} (100%) rename example/linked_list/{example_concat.f90 => example_linked_concat.f90} (100%) rename example/linked_list/{example_get.f90 => example_linked_get.f90} (100%) rename example/linked_list/{example_insert.f90 => example_linked_insert.f90} (100%) rename example/linked_list/{example_pop.f90 => example_linked_pop.f90} (100%) rename example/linked_list/{example_push.f90 => example_linked_push.f90} (100%) rename example/linked_list/{example_remove.f90 => example_linked_remove.f90} (100%) rename example/linked_list/{example_replace.f90 => example_linked_replace.f90} (100%) rename example/linked_list/{example_reverse.f90 => example_linked_reverse.f90} (100%) rename example/linked_list/{example_size.f90 => example_linked_size.f90} (100%) rename example/linked_list/{example_slice.f90 => example_linked_slice.f90} (100%) rename example/linked_list/{example_splice.f90 => example_linked_splice.f90} (100%) diff --git a/example/linked_list/CMakeLists.txt b/example/linked_list/CMakeLists.txt index c6acea430..f23cd8452 100644 --- a/example/linked_list/CMakeLists.txt +++ b/example/linked_list/CMakeLists.txt @@ -1,14 +1,14 @@ include_directories(${CMAKE_CURRENT_LIST_DIR}) -ADD_EXAMPLE(absorb) -ADD_EXAMPLE(clear) -ADD_EXAMPLE(concat) -ADD_EXAMPLE(get) -ADD_EXAMPLE(insert) -ADD_EXAMPLE(pop) -ADD_EXAMPLE(push) -ADD_EXAMPLE(remove) -ADD_EXAMPLE(replace) -ADD_EXAMPLE(reverse) -ADD_EXAMPLE(size) -ADD_EXAMPLE(slice) -ADD_EXAMPLE(splice) +ADD_EXAMPLE(linked_absorb) +ADD_EXAMPLE(linked_clear) +ADD_EXAMPLE(linked_concat) +ADD_EXAMPLE(linked_get) +ADD_EXAMPLE(linked_insert) +ADD_EXAMPLE(linked_pop) +ADD_EXAMPLE(linked_push) +ADD_EXAMPLE(linked_remove) +ADD_EXAMPLE(linked_replace) +ADD_EXAMPLE(linked_reverse) +ADD_EXAMPLE(linked_size) +ADD_EXAMPLE(linked_slice) +ADD_EXAMPLE(linked_splice) diff --git a/example/linked_list/example_absorb.f90 b/example/linked_list/example_linked_absorb.f90 similarity index 100% rename from example/linked_list/example_absorb.f90 rename to example/linked_list/example_linked_absorb.f90 diff --git a/example/linked_list/example_clear.f90 b/example/linked_list/example_linked_clear.f90 similarity index 100% rename from example/linked_list/example_clear.f90 rename to example/linked_list/example_linked_clear.f90 diff --git a/example/linked_list/example_concat.f90 b/example/linked_list/example_linked_concat.f90 similarity index 100% rename from example/linked_list/example_concat.f90 rename to example/linked_list/example_linked_concat.f90 diff --git a/example/linked_list/example_get.f90 b/example/linked_list/example_linked_get.f90 similarity index 100% rename from example/linked_list/example_get.f90 rename to example/linked_list/example_linked_get.f90 diff --git a/example/linked_list/example_insert.f90 b/example/linked_list/example_linked_insert.f90 similarity index 100% rename from example/linked_list/example_insert.f90 rename to example/linked_list/example_linked_insert.f90 diff --git a/example/linked_list/example_pop.f90 b/example/linked_list/example_linked_pop.f90 similarity index 100% rename from example/linked_list/example_pop.f90 rename to example/linked_list/example_linked_pop.f90 diff --git a/example/linked_list/example_push.f90 b/example/linked_list/example_linked_push.f90 similarity index 100% rename from example/linked_list/example_push.f90 rename to example/linked_list/example_linked_push.f90 diff --git a/example/linked_list/example_remove.f90 b/example/linked_list/example_linked_remove.f90 similarity index 100% rename from example/linked_list/example_remove.f90 rename to example/linked_list/example_linked_remove.f90 diff --git a/example/linked_list/example_replace.f90 b/example/linked_list/example_linked_replace.f90 similarity index 100% rename from example/linked_list/example_replace.f90 rename to example/linked_list/example_linked_replace.f90 diff --git a/example/linked_list/example_reverse.f90 b/example/linked_list/example_linked_reverse.f90 similarity index 100% rename from example/linked_list/example_reverse.f90 rename to example/linked_list/example_linked_reverse.f90 diff --git a/example/linked_list/example_size.f90 b/example/linked_list/example_linked_size.f90 similarity index 100% rename from example/linked_list/example_size.f90 rename to example/linked_list/example_linked_size.f90 diff --git a/example/linked_list/example_slice.f90 b/example/linked_list/example_linked_slice.f90 similarity index 100% rename from example/linked_list/example_slice.f90 rename to example/linked_list/example_linked_slice.f90 diff --git a/example/linked_list/example_splice.f90 b/example/linked_list/example_linked_splice.f90 similarity index 100% rename from example/linked_list/example_splice.f90 rename to example/linked_list/example_linked_splice.f90 diff --git a/example/linked_list/mk.bat b/example/linked_list/mk.bat index febf3b0ea..4fcd73774 100644 --- a/example/linked_list/mk.bat +++ b/example/linked_list/mk.bat @@ -1,17 +1,17 @@ -rem gfortran -c stdlib_child_list.f90 -gfortran -c stdlib_linked_list.f90 +gfortran -c ../../src/stdlib_child_list.f90 +gfortran -c ../../src/stdlib_linked_list.f90 rem gfortran -c linked_list_aux.f90 -rem gfortran -o example_size example_size.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_clear example_clear.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_get example_get.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_insert example_insert.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_replace example_replace.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_remove example_remove.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_push example_push.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_pop example_pop.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_reverse example_reverse.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_concat example_concat.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -rem gfortran -o example_absorb example_absorb.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -gfortran -o example_slice example_slice.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o -gfortran -o example_splice example_splice.f90 stdlib_linked_list.o stdlib_child_list.o linked_list_aux.o +gfortran -o example_size example_size.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_clear example_clear.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_get example_get.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_insert example_insert.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_replace example_replace.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_remove example_remove.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_push example_push.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_pop example_pop.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_reverse example_reverse.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_concat example_concat.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_absorb example_absorb.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_slice example_slice.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_splice example_splice.f90 stdlib_linked_list.o stdlib_child_list.o From 8f2f1fadcf95b214e9569eedd430f2efccd734e6 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Tue, 20 Sep 2022 19:15:05 +0200 Subject: [PATCH 10/20] Define a new macro to take care of the include directory Use a dedicated macro to make sure that the include directory is registered per target. It did not show up in the earlier attempt. --- example/linked_list/CMakeLists.txt | 38 +++++++++++++++++++----------- 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/example/linked_list/CMakeLists.txt b/example/linked_list/CMakeLists.txt index f23cd8452..4db0d4763 100644 --- a/example/linked_list/CMakeLists.txt +++ b/example/linked_list/CMakeLists.txt @@ -1,14 +1,24 @@ -include_directories(${CMAKE_CURRENT_LIST_DIR}) -ADD_EXAMPLE(linked_absorb) -ADD_EXAMPLE(linked_clear) -ADD_EXAMPLE(linked_concat) -ADD_EXAMPLE(linked_get) -ADD_EXAMPLE(linked_insert) -ADD_EXAMPLE(linked_pop) -ADD_EXAMPLE(linked_push) -ADD_EXAMPLE(linked_remove) -ADD_EXAMPLE(linked_replace) -ADD_EXAMPLE(linked_reverse) -ADD_EXAMPLE(linked_size) -ADD_EXAMPLE(linked_slice) -ADD_EXAMPLE(linked_splice) +#include_directories(${CMAKE_CURRENT_LIST_DIR}) + +macro(ADD_EXAMPLE_INCLUDE name) + add_executable(example_${name} example_${name}.f90) + target_include_drectories(example_${name} ${CMAKE_CURRENT_SOURCE_DIR}) + target_link_libraries(example_${name} "${PROJECT_NAME}") + add_test(NAME ${name} + COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +endmacro(ADD_EXAMPLE_INCLUDE) + +ADD_EXAMPLE_INCLUDE(linked_absorb) +ADD_EXAMPLE_INCLUDE(linked_clear) +ADD_EXAMPLE_INCLUDE(linked_concat) +ADD_EXAMPLE_INCLUDE(linked_get) +ADD_EXAMPLE_INCLUDE(linked_insert) +ADD_EXAMPLE_INCLUDE(linked_pop) +ADD_EXAMPLE_INCLUDE(linked_push) +ADD_EXAMPLE_INCLUDE(linked_remove) +ADD_EXAMPLE_INCLUDE(linked_replace) +ADD_EXAMPLE_INCLUDE(linked_reverse) +ADD_EXAMPLE_INCLUDE(linked_size) +ADD_EXAMPLE_INCLUDE(linked_slice) +ADD_EXAMPLE_INCLUDE(linked_splice) From 09b72669edf222565987dd78dd24264cfe250abe Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 25 Sep 2022 16:45:16 +0200 Subject: [PATCH 11/20] Adjust the CMake and CI build set-ups Correct the CMakeLists.txt file in the src directory to include the linked list modules , also adjust the fpm-deployment.sh to copy any auxiliary source files from the example directory. --- ci/fpm-deployment.sh | 1 + example/linked_list/CMakeLists.txt | 35 +++++++++++------------------- src/CMakeLists.txt | 16 ++++++++------ 3 files changed, 23 insertions(+), 29 deletions(-) diff --git a/ci/fpm-deployment.sh b/ci/fpm-deployment.sh index bdd3c2b6e..339819df7 100644 --- a/ci/fpm-deployment.sh +++ b/ci/fpm-deployment.sh @@ -50,6 +50,7 @@ find src -maxdepth 1 -iname "*.f90" -exec cp {} "$destdir/src/" \; find test -name "test_*.f90" -exec cp {} "$destdir/test/" \; find test -name "*.dat" -exec cp {} "$destdir/" \; find example -name "example_*.f90" -exec cp {} "$destdir/example/" \; +find example -name "*_aux.f90" -exec cp {} "$destdir/example/" \; # Include additional files cp "${include[@]}" "$destdir/" diff --git a/example/linked_list/CMakeLists.txt b/example/linked_list/CMakeLists.txt index 4db0d4763..888bafb97 100644 --- a/example/linked_list/CMakeLists.txt +++ b/example/linked_list/CMakeLists.txt @@ -1,24 +1,15 @@ #include_directories(${CMAKE_CURRENT_LIST_DIR}) -macro(ADD_EXAMPLE_INCLUDE name) - add_executable(example_${name} example_${name}.f90) - target_include_drectories(example_${name} ${CMAKE_CURRENT_SOURCE_DIR}) - target_link_libraries(example_${name} "${PROJECT_NAME}") - add_test(NAME ${name} - COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} - WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) -endmacro(ADD_EXAMPLE_INCLUDE) - -ADD_EXAMPLE_INCLUDE(linked_absorb) -ADD_EXAMPLE_INCLUDE(linked_clear) -ADD_EXAMPLE_INCLUDE(linked_concat) -ADD_EXAMPLE_INCLUDE(linked_get) -ADD_EXAMPLE_INCLUDE(linked_insert) -ADD_EXAMPLE_INCLUDE(linked_pop) -ADD_EXAMPLE_INCLUDE(linked_push) -ADD_EXAMPLE_INCLUDE(linked_remove) -ADD_EXAMPLE_INCLUDE(linked_replace) -ADD_EXAMPLE_INCLUDE(linked_reverse) -ADD_EXAMPLE_INCLUDE(linked_size) -ADD_EXAMPLE_INCLUDE(linked_slice) -ADD_EXAMPLE_INCLUDE(linked_splice) +ADD_EXAMPLE(linked_absorb) +ADD_EXAMPLE(linked_clear) +ADD_EXAMPLE(linked_concat) +ADD_EXAMPLE(linked_get) +ADD_EXAMPLE(linked_insert) +ADD_EXAMPLE(linked_pop) +ADD_EXAMPLE(linked_push) +ADD_EXAMPLE(linked_remove) +ADD_EXAMPLE(linked_replace) +ADD_EXAMPLE(linked_reverse) +ADD_EXAMPLE(linked_size) +ADD_EXAMPLE(linked_slice) +ADD_EXAMPLE(linked_splice) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0fb95a2d3..6ead6dfdf 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -6,14 +6,14 @@ set(fppFiles stdlib_bitsets.fypp stdlib_bitsets_64.fypp stdlib_bitsets_large.fypp - stdlib_hash_32bit.fypp + stdlib_hash_32bit.fypp stdlib_hash_32bit_fnv.fypp - stdlib_hash_32bit_nm.fypp - stdlib_hash_32bit_water.fypp - stdlib_hash_64bit.fypp - stdlib_hash_64bit_fnv.fypp - stdlib_hash_64bit_pengy.fypp - stdlib_hash_64bit_spookyv2.fypp + stdlib_hash_32bit_nm.fypp + stdlib_hash_32bit_water.fypp + stdlib_hash_64bit.fypp + stdlib_hash_64bit_fnv.fypp + stdlib_hash_64bit_pengy.fypp + stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp stdlib_io_npy.fypp stdlib_io_npy_load.fypp @@ -65,11 +65,13 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) set(SRC stdlib_array.f90 + stdlib_child_list.f90 stdlib_error.f90 stdlib_hashmap_wrappers.f90 stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 + stdlib_linked_list.f90 stdlib_logger.f90 stdlib_system.F90 stdlib_specialfunctions.f90 From af8dd6861e9b6037beb2c32cfa1bd2c1eb2348af Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 25 Sep 2022 16:57:01 +0200 Subject: [PATCH 12/20] Rename the include file Rename the include file to "*.inc" so that it is no longer recognised by the build system. Of course, the example source files had to be adapted as well. --- ci/fpm-deployment.sh | 2 +- example/linked_list/example_linked_absorb.f90 | 2 +- example/linked_list/example_linked_concat.f90 | 2 +- example/linked_list/example_linked_insert.f90 | 2 +- example/linked_list/example_linked_pop.f90 | 2 +- example/linked_list/example_linked_push.f90 | 2 +- example/linked_list/example_linked_remove.f90 | 2 +- example/linked_list/example_linked_replace.f90 | 2 +- example/linked_list/example_linked_reverse.f90 | 2 +- example/linked_list/example_linked_slice.f90 | 2 +- example/linked_list/example_linked_splice.f90 | 2 +- .../linked_list/{linked_list_aux.f90 => linked_list_aux.inc} | 0 12 files changed, 11 insertions(+), 11 deletions(-) rename example/linked_list/{linked_list_aux.f90 => linked_list_aux.inc} (100%) diff --git a/ci/fpm-deployment.sh b/ci/fpm-deployment.sh index 339819df7..9c9b5e146 100644 --- a/ci/fpm-deployment.sh +++ b/ci/fpm-deployment.sh @@ -50,7 +50,7 @@ find src -maxdepth 1 -iname "*.f90" -exec cp {} "$destdir/src/" \; find test -name "test_*.f90" -exec cp {} "$destdir/test/" \; find test -name "*.dat" -exec cp {} "$destdir/" \; find example -name "example_*.f90" -exec cp {} "$destdir/example/" \; -find example -name "*_aux.f90" -exec cp {} "$destdir/example/" \; +find example -name "*.inc" -exec cp {} "$destdir/example/" \; # Include additional files cp "${include[@]}" "$destdir/" diff --git a/example/linked_list/example_linked_absorb.f90 b/example/linked_list/example_linked_absorb.f90 index 516f04c1e..569aeac51 100644 --- a/example/linked_list/example_linked_absorb.f90 +++ b/example/linked_list/example_linked_absorb.f90 @@ -41,6 +41,6 @@ program example_absorb call print_list( list_to_absorb ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_absorb diff --git a/example/linked_list/example_linked_concat.f90 b/example/linked_list/example_linked_concat.f90 index 5f383b22b..5c96a092c 100644 --- a/example/linked_list/example_linked_concat.f90 +++ b/example/linked_list/example_linked_concat.f90 @@ -41,6 +41,6 @@ program example_concat call print_list( list_to_concat ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_concat diff --git a/example/linked_list/example_linked_insert.f90 b/example/linked_list/example_linked_insert.f90 index 441336aac..6d9a92fa3 100644 --- a/example/linked_list/example_linked_insert.f90 +++ b/example/linked_list/example_linked_insert.f90 @@ -30,6 +30,6 @@ program example_insert call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_insert diff --git a/example/linked_list/example_linked_pop.f90 b/example/linked_list/example_linked_pop.f90 index d8d15c7a4..935af5357 100644 --- a/example/linked_list/example_linked_pop.f90 +++ b/example/linked_list/example_linked_pop.f90 @@ -30,6 +30,6 @@ program example_pop call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_pop diff --git a/example/linked_list/example_linked_push.f90 b/example/linked_list/example_linked_push.f90 index dd7f6f0d3..c3ccefb72 100644 --- a/example/linked_list/example_linked_push.f90 +++ b/example/linked_list/example_linked_push.f90 @@ -30,6 +30,6 @@ program example_push call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_push diff --git a/example/linked_list/example_linked_remove.f90 b/example/linked_list/example_linked_remove.f90 index dac0be92a..b5e412124 100644 --- a/example/linked_list/example_linked_remove.f90 +++ b/example/linked_list/example_linked_remove.f90 @@ -30,6 +30,6 @@ program example_remove call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_remove diff --git a/example/linked_list/example_linked_replace.f90 b/example/linked_list/example_linked_replace.f90 index 50c6b0e97..361323445 100644 --- a/example/linked_list/example_linked_replace.f90 +++ b/example/linked_list/example_linked_replace.f90 @@ -30,6 +30,6 @@ program example_replace call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_replace diff --git a/example/linked_list/example_linked_reverse.f90 b/example/linked_list/example_linked_reverse.f90 index dcd51fe8d..f48f17717 100644 --- a/example/linked_list/example_linked_reverse.f90 +++ b/example/linked_list/example_linked_reverse.f90 @@ -30,6 +30,6 @@ program example_reverse call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_reverse diff --git a/example/linked_list/example_linked_slice.f90 b/example/linked_list/example_linked_slice.f90 index d3cd73fb2..3a423ac92 100644 --- a/example/linked_list/example_linked_slice.f90 +++ b/example/linked_list/example_linked_slice.f90 @@ -37,6 +37,6 @@ program example_slice call print_list( sublist) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_slice diff --git a/example/linked_list/example_linked_splice.f90 b/example/linked_list/example_linked_splice.f90 index fbdd0de2f..d939ed70d 100644 --- a/example/linked_list/example_linked_splice.f90 +++ b/example/linked_list/example_linked_splice.f90 @@ -35,6 +35,6 @@ program example_splice call print_list( list ) contains -include 'linked_list_aux.f90' +include 'linked_list_aux.inc' end program example_splice diff --git a/example/linked_list/linked_list_aux.f90 b/example/linked_list/linked_list_aux.inc similarity index 100% rename from example/linked_list/linked_list_aux.f90 rename to example/linked_list/linked_list_aux.inc From fae33a41fd6504685b9039f174fce034bc082835 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 25 Sep 2022 17:06:12 +0200 Subject: [PATCH 13/20] Correct the test program Correct the performance test program - apparently it was using some deprecated names and it was not built using the CMake build system. --- test/CMakeLists.txt | 1 + test/linked_list/test_performance.f90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index de332abb3..66a5c72f1 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -23,6 +23,7 @@ add_subdirectory(hash_functions_perf) add_subdirectory(hashmaps) add_subdirectory(io) add_subdirectory(linalg) +add_subdirectory(linked_list) add_subdirectory(logger) add_subdirectory(optval) add_subdirectory(selection) diff --git a/test/linked_list/test_performance.f90 b/test/linked_list/test_performance.f90 index 28b68dd70..03178c766 100644 --- a/test/linked_list/test_performance.f90 +++ b/test/linked_list/test_performance.f90 @@ -32,7 +32,7 @@ program test_link call system_clock( cnt1, count_rate = count_rate ) call cpu_time(T1) do i=1,length - call L%append(i) + call L%push(i) end do call cpu_time(T2) call system_clock( cnt2, count_rate = count_rate ) @@ -62,7 +62,7 @@ program test_link !------------- call system_clock( cnt1, count_rate = count_rate ) call cpu_time(T1) - call L%destroy() + call L%clear() call cpu_time(T2) call system_clock( cnt2, count_rate = count_rate ) From 41417f40f7834791aea309a066a50b414b6e838f Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 25 Sep 2022 17:14:32 +0200 Subject: [PATCH 14/20] Update test_performance.f90 Update the test program to NOT read from stdin - that does not work in the CI build and execute environment. --- test/linked_list/test_performance.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/linked_list/test_performance.f90 b/test/linked_list/test_performance.f90 index 03178c766..53422dddb 100644 --- a/test/linked_list/test_performance.f90 +++ b/test/linked_list/test_performance.f90 @@ -27,7 +27,8 @@ program test_link ! !Append items ! !------------- print*, "Length Of Required List" - read(*,*) length + !read(*,*) length + length = 1000000 call system_clock( cnt1, count_rate = count_rate ) call cpu_time(T1) From b8c18eaa9bfedb9048a6f848b755ec730e8a7406 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sun, 25 Sep 2022 17:21:21 +0200 Subject: [PATCH 15/20] Create CMakeLists.txt file for performance test program Create the missing CMake file for the test program. --- test/linked_list/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 test/linked_list/CMakeLists.txt diff --git a/test/linked_list/CMakeLists.txt b/test/linked_list/CMakeLists.txt new file mode 100644 index 000000000..0fc8ff782 --- /dev/null +++ b/test/linked_list/CMakeLists.txt @@ -0,0 +1 @@ +ADDTEST(test_performance) From 5644454ef83f2ed2f7c401ea86ff91fc47fabd46 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 28 Dec 2023 15:14:00 +0100 Subject: [PATCH 16/20] Updated documentation and source code Updated the documentation after review by jvdp1. Adjusted the type name (suffix _type) and applied several cosmetic changes. Also added a more extensive test program and fixed several bugs. --- doc/specs/stdlib_linked_list.md | 84 +-- example/linked_list/mk.bat | 26 +- src/stdlib_child_list.f90 | 144 ++--- src/stdlib_linked_list.f90 | 256 +++++---- test/linked_list/test_linked_list.f90 | 781 ++++++++++++++++++++++++++ test/linked_list/test_performance.f90 | 6 +- 6 files changed, 1043 insertions(+), 254 deletions(-) create mode 100644 test/linked_list/test_linked_list.f90 diff --git a/doc/specs/stdlib_linked_list.md b/doc/specs/stdlib_linked_list.md index 099018428..87343ea3f 100644 --- a/doc/specs/stdlib_linked_list.md +++ b/doc/specs/stdlib_linked_list.md @@ -14,9 +14,9 @@ store any type of data. The list may contain data of the same type or of various ## Types -### `type(linked_list)` +### `type(linked_list_type)` -Linked lists are variables of the type `linked_list`. The type provides all the methods +Linked lists are variables of the type `linked_list_type`. The type provides all the methods required for storing and retrieving data. @@ -24,7 +24,7 @@ required for storing and retrieving data. -### `size` +### `size` - Return the number of data items in the list #### Description @@ -48,7 +48,7 @@ None #### Result value -The result is the number of items currently contained in the list. +The result is an integer scalar, equal to the number of items currently contained in the list. #### Example @@ -58,7 +58,7 @@ The result is the number of items currently contained in the list. -### `clear` +### `clear` - Remove all items from the list #### Description @@ -89,7 +89,7 @@ None -### `get` +### `get` - Get the data item at a given position (node) in the list #### Description @@ -109,12 +109,12 @@ Function. #### Argument -- `node_index`: Position in the list for the new item (integer) - This argument is intent(in). +- `node_index`: Shall be a scalar integer equal to the position in the list for the new item. + This argument is `intent(in)`. #### Result value -The data item (of type class(*)) that is stored at the given position. +The data item (of type `class(*)`) that is stored at the given position. Notes: @@ -129,7 +129,7 @@ Notes: -### `insert` +### `insert` - Insert a new item at a given position (node) in the list #### Description @@ -150,9 +150,9 @@ Subroutine. #### Argument - `item`: Data item to be stored (any type). - This argument is intent(in). -- `node_index`: Position in the list for the new item (integer) - This argument is intent(in). + This argument is `intent(in)`. +- `node_index`: Shall be an integer scalar equal to the position in the list for the new item. + This argument is `intent(in)`. #### Result value @@ -171,7 +171,7 @@ Notes: -### `replace` +### `replace` - Replace an existing data by a new item at a given position (node) in the list #### Description @@ -191,10 +191,10 @@ Subroutine. #### Argument -- `item`: The new data item to be stored (any type). - This argument is intent(in). -- `node_index`: Position in the list for the item to be replaced (integer) - This argument is intent(in). +- `new_item`: The new data item to be stored (any type). + This argument is `intent(in)`. +- `node_index`: Shall be an integer scalar equal to the position in the list for the item to be replaced. + This argument is `intent(in)`. #### Result value @@ -212,7 +212,7 @@ Notes: -### `remove` +### `remove` - Remove an items at a given position (node) in the list #### Description @@ -232,8 +232,8 @@ Subroutine. #### Argument -- `node_index`: Position in the list for the item to be removed (integer) - This argument is intent(in). +- `node_index`: Shall be an integer scalar equal to the position in the list for the item to be removed. + This argument is `intent(in)`. #### Result value @@ -250,7 +250,7 @@ Notes: ``` -### `push` +### `push` - Append a new item to the end of the list #### Description @@ -271,7 +271,7 @@ Subroutine. #### Argument - `item`: Data item to be stored (any type). - This argument is intent(in). + This argument is `intent(in)`. #### Result value @@ -285,7 +285,7 @@ The list is extended with the new data item at the tail. -### `pop` +### `pop` - Remove the last item in the list #### Description @@ -319,7 +319,7 @@ The list item in the list is removed. -### `reverse` +### `reverse` - Reconstruct the list in reverse order #### Description @@ -353,7 +353,7 @@ The list now contains the items in reverse order. -### `concat` +### `concat` - Concatenate a list to another list #### Description @@ -373,8 +373,8 @@ Subroutine. #### Argument -- `list_to_concat`: list whose data items are to be appended to the given list (type(linked_list) - this argument is intent(in). +- `list_to_concat`: list whose data items are to be appended to the given `linked_list_type` derived type. + this argument is `intent(in)`. #### Result value @@ -388,7 +388,7 @@ The given list is extended with the data items in the second list. The second li -### `absorb` +### `absorb` - Absorb a list into another list #### Description @@ -396,7 +396,7 @@ Absorb a list into another list #### Syntax -`call [[stdlib_linked_list(module):list%absorb(interface)]] (list_to_concat)` +`call [[stdlib_linked_list(module):list%absorb(interface)]] (list_to_absorb)` #### Status @@ -408,8 +408,8 @@ Subroutine. #### Argument -- `list_to_absorb`: list whose data items will be appended to the given list (type(linked_list) - this argument is intent(inout). +- `list_to_absorb`: list whose data items will be appended to the given `linked_list_type` derived type. + this argument is `intent(inout)`. #### Result value @@ -423,7 +423,7 @@ The given list is extended with the data items in the second list. The second li -### `slice` +### `slice` - Return a sublist of a list #### Description @@ -443,10 +443,10 @@ Subroutine. #### Argument -- `start`: first item to store in the sublist (integer) - this argument is intent(in). -- `end`: last item to store in the sublist (integer) - this argument is intent(in). +- `start`: Shall be an integer scalar equal to the first item to store in the sublist. + this argument is `intent(in)`. +- `end`: Shall be an integer scalar equal to the last item to store in the sublist. + this argument is `intent(in)`. #### Result value @@ -461,7 +461,7 @@ list, so that the two lists are independent. -### `splice` +### `splice` - Remove a sublist from a list, based on a start and end index. #### Description @@ -481,10 +481,10 @@ Subroutine. #### Argument -- `start`: first item to be removed in the sublist (integer) - this argument is intent(in). -- `end`: last item to be removed in the sublist (integer) - this argument is intent(in). +- `start`: Shall be an integer scalar equal to the first item to be removed from the list. + this argument is `intent(in)`. +- `end`: Shall be an integer scalar equal to the last item to be removed from the list. + this argument is `intent(in)`. #### Result value diff --git a/example/linked_list/mk.bat b/example/linked_list/mk.bat index 4fcd73774..fbfcbd1cf 100644 --- a/example/linked_list/mk.bat +++ b/example/linked_list/mk.bat @@ -2,16 +2,16 @@ gfortran -c ../../src/stdlib_child_list.f90 gfortran -c ../../src/stdlib_linked_list.f90 rem gfortran -c linked_list_aux.f90 -gfortran -o example_size example_size.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_clear example_clear.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_get example_get.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_insert example_insert.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_replace example_replace.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_remove example_remove.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_push example_push.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_pop example_pop.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_reverse example_reverse.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_concat example_concat.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_absorb example_absorb.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_slice example_slice.f90 stdlib_linked_list.o stdlib_child_list.o -gfortran -o example_splice example_splice.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_size example_linked_size.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_clear example_linked_clear.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_get example_linked_get.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_insert example_linked_insert.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_replace example_linked_replace.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_remove example_linked_remove.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_push example_linked_push.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_pop example_linked_pop.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_reverse example_linked_reverse.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_concat example_linked_concat.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_absorb example_linked_absorb.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_slice example_linked_slice.f90 stdlib_linked_list.o stdlib_child_list.o +gfortran -o example_linked_splice example_linked_splice.f90 stdlib_linked_list.o stdlib_child_list.o diff --git a/src/stdlib_child_list.f90 b/src/stdlib_child_list.f90 index ba43f6a04..d957ce1df 100644 --- a/src/stdlib_child_list.f90 +++ b/src/stdlib_child_list.f90 @@ -1,6 +1,6 @@ !> Implementation of a Child list type to hold various types of data. !> -!> The child list module provides a heterogeneous generic linked list +!> The child list module provides a heterogeneous generic linked list !> that acts as a basic building block for the linked list module @@ -14,14 +14,14 @@ module stdlib_child_list !> !> The purpose of this node is to hold an item !> and links to previous and next Node. - type Node - type(Node), pointer :: next => null() - type(Node), pointer :: prev => null() + type node_type + type(node_type), pointer :: next => null() + type(node_type), pointer :: prev => null() class(*), allocatable :: item contains procedure :: clear => node_destroyed procedure, private :: clear_all => all_nodes_destroyed - end type Node + end type node_type !> Defining Child List !> @@ -29,8 +29,8 @@ module stdlib_child_list !> It is a doubly-linked heterogeneous generic list . type child_list integer, private :: num_nodes = 0 - type(Node), pointer :: head => null() - type(Node), pointer :: tail => null() + type(node_type), pointer :: head => null() + type(node_type), pointer :: tail => null() contains procedure:: push => push_at_tail procedure:: insert => insert_at_index @@ -48,18 +48,18 @@ module stdlib_child_list !> Creates a Node that contains 'new_item' as its child !> - !> Returns the new parent node + !> Returns the new parent node pure function initialize_node( new_item ) result( new_node ) - type(node) :: new_node + type(node_type) :: new_node class(*), intent(in), optional :: new_item - + ! allocating new_item to the new node's item allocate(new_node%item, source=new_item) end function initialize_node - + !> Delete a node and frees the memory in the item. - pure subroutine node_destroyed( this_node ) - class(node), intent(inout) :: this_node + subroutine node_destroyed( this_node ) + class(node_type), intent(inout) :: this_node !Deallocate it's item if (allocated(this_node%item)) deallocate(this_node%item) @@ -72,10 +72,10 @@ end subroutine node_destroyed pure subroutine all_nodes_destroyed( this_node ) !Entrada: - class(node), intent(inout) :: this_node + class(node_type), intent(inout) :: this_node !Local: - type(node), pointer :: current_node - type(node), pointer :: next_node + type(node_type), pointer :: current_node + type(node_type), pointer :: next_node !Deallocate it's item current_node = this_node next_node => current_node%next @@ -91,7 +91,7 @@ end subroutine all_nodes_destroyed !> Insert 'item' at the tail of the input child list pure subroutine push_at_tail( this_child_list, item ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list class(*), intent(in) :: item ! Finding if its a first node or the child_list already have a node @@ -110,16 +110,16 @@ end subroutine push_at_tail !> Insert 'item' at the given 'node_index' of the input child list pure subroutine insert_at_index( this_child_list, item ,node_index ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list integer, intent(in) :: node_index class(*), intent(in) :: item - type(node), pointer :: current_node - type(node), pointer :: next_node + type(node_type), pointer :: current_node + type(node_type), pointer :: next_node - integer :: index + integer :: index ! This index will be used for iteraing - index = node_index-1; + index = node_index-1 ! will insert after tail when the input is more than size of the child list if(index >=this_child_list%num_nodes) then @@ -134,8 +134,8 @@ pure subroutine insert_at_index( this_child_list, item ,node_index ) else current_node => this_child_list%head do while(index >1) - index = index -1; - current_node => current_node%next; + index = index -1 + current_node => current_node%next end do next_node => current_node%next allocate(current_node%next,source = initialize_node(item)) @@ -144,19 +144,19 @@ pure subroutine insert_at_index( this_child_list, item ,node_index ) current_node => current_node%next current_node%next%prev => current_node end if - this_child_list%num_nodes = this_child_list%num_nodes + 1; + this_child_list%num_nodes = this_child_list%num_nodes + 1 end subroutine insert_at_index !> Removing the last node from the input child list - pure subroutine pop_node_at_tail( this_child_list ) + subroutine pop_node_at_tail( this_child_list ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list - type(node), pointer:: current_node + type(node_type), pointer:: current_node ! return if the size of the child list is 0 - if(this_child_list%num_nodes == 0) return; + if(this_child_list%num_nodes == 0) return ! poping the last node of the child list @@ -189,21 +189,21 @@ pure subroutine pop_node_at_tail( this_child_list ) end subroutine pop_node_at_tail !> Removing the node at the given 'node_index' from the input child list - pure subroutine remove_node_at_index( this_child_list, node_index ) + subroutine remove_node_at_index( this_child_list, node_index ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list integer, intent(in):: node_index - type(node), pointer:: current_node - + type(node_type), pointer:: current_node + ! This index will be reference for child list integer:: index !iterating through the child_list to reach the nth node current_node => this_child_list%head - + ! return if the given node index is not in range of 1 to size of linked list - if(node_index<=0) return; - if(node_index>this_child_list%num_nodes) return; + if(node_index<=0) return + if(node_index>this_child_list%num_nodes) return index = 1 do while ( associated(current_node) ) if (index==node_index) then @@ -224,7 +224,7 @@ pure subroutine remove_node_at_index( this_child_list, node_index ) else !only node in list nullify(this_child_list%head) - nullify(this_child_list%tail) + nullify(this_child_list%tail) end if !Destroy node content and Free it's memory @@ -242,21 +242,21 @@ end subroutine remove_node_at_index !> Returns the pointer to the item stored at 'node_index' in the input child list - !> + !> !> Returns a pointer function get_node_at_index( this_child_list, node_index ) result (return_item) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list integer, intent(in):: node_index class(*), pointer :: return_item - type(node), pointer:: current_node + type(node_type), pointer:: current_node integer:: index - + !iterating through the child_list to reach the nth node current_node => this_child_list%head index = 1 do while ( associated(current_node) ) - + if (index == node_index) then ! Return the pointer to item stored at specified index return_item => current_node%item @@ -265,58 +265,58 @@ function get_node_at_index( this_child_list, node_index ) result (return_item) end if current_node => current_node%next index = index+1 - + end do nullify(current_node) nullify(return_item) - + end function get_node_at_index !> Returns the total number of nodes in the input child list - !> + !> !> Returns an integer pure function get_length ( this_child_list ) result ( length ) - class(child_list), intent(in) :: this_child_list + class(child_list_type), intent(in) :: this_child_list integer :: length - + length = this_child_list%num_nodes - + end function get_length - + !> Changes the size of the input child list to 'length' pure subroutine set_length ( this_child_list, length ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list integer, intent(in) :: length - + this_child_list%num_nodes = length - + end subroutine set_length - - + + !> Replaces the item stored in node at 'node_index' of the input child list with 'new_item' pure subroutine replace_at_index( this_child_list, item ,node_index ) - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list integer, intent(in) :: node_index class(*), intent(in) :: item - type(node), pointer :: current_node + type(node_type), pointer :: current_node integer :: index ! This index will be reference for child list - index = node_index; + index = node_index ! return if the given node index is not in range of 1 to size of child list - if(index<1 .or. index>this_child_list%num_nodes) return; + if(index<1 .or. index>this_child_list%num_nodes) return ! Iterating through parent nodes while size of the child list is smaller than index - current_node => this_child_list%head; + current_node => this_child_list%head do while(index>1) - index = index-1; - current_node => current_node%next; + index = index-1 + current_node => current_node%next end do current_node%item = item @@ -324,19 +324,19 @@ end subroutine replace_at_index !> Reverses the input child list pure subroutine reverse_child_list (this_child_list) - class(child_list), intent(inout) :: this_child_list - type(node), pointer :: temp_node - type(node), pointer :: curr_node + class(child_list_type), intent(inout) :: this_child_list + type(node_type), pointer :: temp_node + type(node_type), pointer :: curr_node nullify(temp_node) ! Swapping head of the child node with tail of the child node curr_node => this_child_list%head do while (associated(curr_node)) - temp_node => curr_node%prev; - curr_node%prev => curr_node%next; - curr_node%next => temp_node; - curr_node => curr_node%prev; + temp_node => curr_node%prev + curr_node%prev => curr_node%next + curr_node%next => temp_node + curr_node => curr_node%prev end do temp_node=> this_child_list%head @@ -347,12 +347,12 @@ end subroutine reverse_child_list !> Destroy the whole given linked list !> Free the allocated memory - !> Nullify all the variables - pure subroutine destroy_whole_child_list( this_child_list ) + !> Nullify all the variables + subroutine destroy_whole_child_list( this_child_list ) !Entrada: - class(child_list), intent(inout) :: this_child_list + class(child_list_type), intent(inout) :: this_child_list !Local: - type(node), pointer:: current_node + type(node_type), pointer:: current_node do while (this_child_list%num_nodes>0) current_node => this_child_list%head diff --git a/src/stdlib_linked_list.f90 b/src/stdlib_linked_list.f90 index 94858ed7d..174068715 100644 --- a/src/stdlib_linked_list.f90 +++ b/src/stdlib_linked_list.f90 @@ -22,9 +22,9 @@ module stdlib_linked_list !> The purpose of this node is to hold a child list !> and links to previous and next Parent Node. type Parent_Node - type(Parent_Node), pointer :: next => null() - type(Parent_Node), pointer :: prev => null() - type(child_list) , allocatable :: child + type(Parent_Node_type), pointer :: next => null() + type(Parent_Node_type), pointer :: prev => null() + type(child_list_type) , allocatable :: child contains procedure :: size => child_length procedure :: split => split_into_two_nodes @@ -37,9 +37,9 @@ module stdlib_linked_list !> It is a doubly-linked heterogeneous generic list . type linked_list integer, private :: num_parent_nodes = 0 - integer, private :: total_nodes = 0 - type(Parent_Node), pointer :: head => null() - type(Parent_Node), pointer :: tail => null() + integer, private :: total_nodes = 0 + type(Parent_Node_type), pointer :: head => null() + type(Parent_Node_type), pointer :: tail => null() contains procedure :: push => append_at_child_tail procedure :: insert => insert_in_parent_at_index @@ -65,8 +65,8 @@ module stdlib_linked_list !> !> Returns the new parent node pure function initialize_parent_node( item ) result( new_node ) - type(Parent_Node) :: new_node - type(child_list), intent(in) :: item + type(Parent_Node_type) :: new_node + type(child_list_type), intent(in) :: item ! allocating item to the new node's child allocate(new_node%child, source=item) @@ -76,7 +76,7 @@ end function initialize_parent_node !> Returns the number of nodes stored in the input parent node's child list pure function child_length( this_parent_node ) result( size ) - class(Parent_Node), intent(in) :: this_parent_node + class(parent_node_type), intent(in) :: this_parent_node integer :: size size = this_parent_node%child%size() @@ -88,15 +88,15 @@ end function child_length pure subroutine split_into_two_nodes( this_parent_node ) ! - class(Parent_Node), intent(inout) :: this_parent_node; - type(Parent_Node), pointer :: next_parent_node; - type(node), pointer :: old_child_tail; - type(child_list) :: new_child_list + class(parent_node_type), intent(inout), target :: this_parent_node + type(Parent_Node_type), pointer :: next_parent_node + type(node_type), pointer :: old_child_tail + type(child_list_type) :: new_child_list integer :: node_child_size integer :: i - node_child_size = this_parent_node%child%size()/2; + node_child_size = this_parent_node%child%size()/2 ! Iterating to the mid point of the list to find tail for old child i = 1 @@ -126,7 +126,7 @@ pure subroutine split_into_two_nodes( this_parent_node ) next_parent_node%prev => this_parent_node%next else allocate(this_parent_node%next, source=initialize_parent_node(new_child_list)) - next_parent_node = this_parent_node + next_parent_node => this_parent_node next_parent_node%next%prev => next_parent_node end if @@ -135,7 +135,7 @@ end subroutine split_into_two_nodes !> Delete a node and frees the memory in the item. pure subroutine parent_node_destroyed( this_linked_list ) - class(parent_node), intent(inout) :: this_linked_list + class(parent_node_type), intent(inout) :: this_linked_list !Deallocate it's child if ( allocated(this_linked_list%child) ) deallocate(this_linked_list%child) @@ -150,14 +150,13 @@ end subroutine parent_node_destroyed !> Insert 'item' at the tail of the input linked list subroutine append_at_child_tail( this_linked_list, item ) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list class(*), intent(in) :: item integer :: temp real :: r - type(child_list) :: new_child + type(child_list_type) :: new_child ! Finding if its a first node or the list already have a node - if( this_linked_list%num_parent_nodes == 0 ) then ! Linked List is empty. Associating head and tail of the input linked list call new_child%push(item) @@ -168,10 +167,10 @@ subroutine append_at_child_tail( this_linked_list, item ) ! Checking if the tail node of linked list is needed to break into two parent nodes. if( this_linked_list%tail%child%size() > SPLIT_POINT ) then temp = MAX_SIZE-this_linked_list%tail%child%size() - call random_number(r); + call random_number(r) if( r*( MAX_SIZE-SPLIT_POINT ) >= temp ) then - call this_linked_list%tail%split(); - this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1; + call this_linked_list%tail%split() + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1 if( associated(this_linked_list%tail%next) ) this_linked_list%tail => this_linked_list%tail%next end if end if @@ -184,10 +183,10 @@ end subroutine append_at_child_tail !> Insert 'item' at the given 'node_index' of the input parent list subroutine insert_in_parent_at_index( this_linked_list, item, node_index ) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in):: node_index class(*), intent(in) :: item - type(Parent_Node), pointer:: current_node + type(Parent_Node_type), pointer:: current_node real :: r integer :: index, temp @@ -195,15 +194,15 @@ subroutine insert_in_parent_at_index( this_linked_list, item, node_index ) index = node_index current_node => this_linked_list%head if( this_linked_list%total_nodes == 0 ) then - call this_linked_list%push(item); + call this_linked_list%push(item) return end if ! will insert before head when the input index is less than 1 - if( index <= 0 ) index = 1; + if( index <= 0 ) index = 1 ! will insert after tail when the input is more than size of the linked list - if( index > this_linked_list%total_nodes ) index = this_linked_list%total_nodes+1; + if( index > this_linked_list%total_nodes ) index = this_linked_list%total_nodes+1 ! Iterating through parent nodes while size of the child list is smaller than index do while( index > current_node%child%size()+1 ) @@ -214,10 +213,10 @@ subroutine insert_in_parent_at_index( this_linked_list, item, node_index ) ! Checking if the current node is needed to split into two parent nodes. if( current_node%child%size() > (MAX_SIZE-1000) ) then temp = MAX_SIZE-current_node%child%size() - call random_number(r); + call random_number(r) if( r*1000 >= temp ) then - call current_node%split(); - this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1; + call current_node%split() + this_linked_list%num_parent_nodes = this_linked_list%num_parent_nodes + 1 if( associated(this_linked_list%tail%next) ) this_linked_list%tail => this_linked_list%tail%next end if end if @@ -228,20 +227,20 @@ subroutine insert_in_parent_at_index( this_linked_list, item, node_index ) end do ! Insert 'item' in the child list at index - call current_node%child%insert(item,index); + call current_node%child%insert(item,index) this_linked_list%total_nodes = this_linked_list%total_nodes + 1 end subroutine insert_in_parent_at_index !> Removing the last node from the input linked list - pure subroutine pop_node_at_tail_parent( this_linked_list ) + subroutine pop_node_at_tail_parent( this_linked_list ) - class(linked_list), intent(inout) :: this_linked_list - type(Parent_Node), pointer :: current_node + class(linked_list_type), intent(inout) :: this_linked_list + type(Parent_Node_type), pointer :: current_node ! return if the size of the linked list is 0 - if( this_linked_list%total_nodes == 0 ) return; + if( this_linked_list%total_nodes == 0 ) return ! pop the last node of the child list of the tail parent node current_node => this_linked_list%tail @@ -288,12 +287,12 @@ end subroutine pop_node_at_tail_parent !> Removing the node at the given 'node_index' from the input linked list - pure subroutine remove_node_at_index_parent( this_linked_list, node_index ) + subroutine remove_node_at_index_parent( this_linked_list, node_index ) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in):: node_index - type(Parent_Node), pointer:: current_node + type(Parent_Node_type), pointer:: current_node integer:: index ! This index will be reference for child list @@ -301,8 +300,8 @@ pure subroutine remove_node_at_index_parent( this_linked_list, node_index ) current_node => this_linked_list%head ! return if the given node index is not in range of 1 to size of linked list - if( node_index <= 0 ) return; - if( node_index > this_linked_list%total_nodes ) return; + if( node_index <= 0 ) return + if( node_index > this_linked_list%total_nodes ) return ! Iterating through parent nodes while size of the child list is smaller index @@ -310,7 +309,7 @@ pure subroutine remove_node_at_index_parent( this_linked_list, node_index ) index=index-current_node%child%size() current_node => current_node%next end do - call current_node%child%remove(index); + call current_node%child%remove(index) ! if child list of current parent node is empty, remove the current parent node if ( current_node%child%size() == 0 ) then @@ -356,10 +355,10 @@ end subroutine remove_node_at_index_parent !> !> Returns a pointer function get_element_at_index_in_parent( this_linked_list, node_index ) result ( return_item ) - class(linked_list), intent(in) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in):: node_index class(*), pointer :: return_item - type(Parent_Node), pointer:: current_node + type(Parent_Node_type), pointer:: current_node integer:: index nullify(return_item) @@ -371,8 +370,8 @@ function get_element_at_index_in_parent( this_linked_list, node_index ) result ( index = node_index ! Handling out of range index cases - if( index <= 0 ) index = 1; - if( index >= this_linked_list%total_nodes ) index = this_linked_list%total_nodes; + if( index <= 0 ) index = 1 + if( index >= this_linked_list%total_nodes ) index = this_linked_list%total_nodes ! Iterating through parent nodes while size of the child list is smaller index current_node => this_linked_list%head @@ -396,7 +395,7 @@ end function get_element_at_index_in_parent !> !> Returns an integer pure function get_number_of_parent_nodes ( this_linked_list ) result ( length ) - class(linked_list), intent(in) :: this_linked_list + class(linked_list_type), intent(in) :: this_linked_list integer :: length length = this_linked_list%num_parent_nodes @@ -408,7 +407,7 @@ end function get_number_of_parent_nodes !> !> Returns an integer pure function get_total_nodes ( this_linked_list ) result ( length ) - class(linked_list), intent(in) :: this_linked_list + class(linked_list_type), intent(in) :: this_linked_list integer :: length length = this_linked_list%total_nodes @@ -418,7 +417,7 @@ end function get_total_nodes !> Changes the size of the input linked list to 'length' pure subroutine set_size_of_list (this_linked_list, length) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in) :: length this_linked_list%total_nodes = length @@ -428,7 +427,7 @@ end subroutine set_size_of_list !> Changes the number of parent nodes of the input linked list to 'length' pure subroutine set_number_of_parent_nodes (this_linked_list, length) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in) :: length this_linked_list%num_parent_nodes = length @@ -438,23 +437,23 @@ end subroutine set_number_of_parent_nodes !> Replaces the item stored in node at 'node_index' of the input linked list with 'new_item' pure subroutine replace_in_parent_at_index( this_linked_list, new_item, node_index ) - class(linked_list), intent(inout) :: this_linked_list + class(linked_list_type), intent(inout) :: this_linked_list integer, intent(in) :: node_index class(*), intent(in) :: new_item - type(Parent_Node), pointer :: current_node + type(Parent_Node_type), pointer :: current_node integer :: index ! This index will be reference for child list - index = node_index; + index = node_index ! return if the given node index is not in range of 1 to size of linked list - if( index < 1 .or. index > this_linked_list%total_nodes) return; + if( index < 1 .or. index > this_linked_list%total_nodes) return ! Iterating through parent nodes while size of the child list is smaller than index - current_node => this_linked_list%head; + current_node => this_linked_list%head do while( index > current_node%child%size() ) - index = index-current_node%child%size(); - current_node => current_node%next; + index = index-current_node%child%size() + current_node => current_node%next end do call current_node%child%replace(new_item, index) @@ -464,24 +463,24 @@ end subroutine replace_in_parent_at_index !> Reverses the input linked list pure subroutine reverse_linked_list ( this_linked_list ) - class(linked_list), intent(inout) :: this_linked_list - type(parent_node), pointer :: temp_parent_node - type(node), pointer :: temp_child_node - type(parent_node), pointer :: curr_parent_node - type(node), pointer :: curr_child_node + class(linked_list_type), intent(inout) :: this_linked_list + type(parent_node_type), pointer :: temp_parent_node + type(node_type), pointer :: temp_child_node + type(parent_node_type), pointer :: curr_parent_node + type(node_type), pointer :: curr_child_node ! return if the linked list is empty - if( this_linked_list%total_nodes == 0 ) return; + if( this_linked_list%total_nodes == 0 ) return nullify(temp_child_node) ! Reversing all the child lists curr_child_node => this_linked_list%head%child%head do while ( associated(curr_child_node) ) - temp_child_node => curr_child_node%prev; - curr_child_node%prev => curr_child_node%next; - curr_child_node%next => temp_child_node; - curr_child_node => curr_child_node%prev; + temp_child_node => curr_child_node%prev + curr_child_node%prev => curr_child_node%next + curr_child_node%next => temp_child_node + curr_child_node => curr_child_node%prev end do ! Reversing all the Parent nodes and @@ -496,11 +495,11 @@ pure subroutine reverse_linked_list ( this_linked_list ) curr_parent_node%child%tail => temp_child_node ! Reversing Connections of Parent Nodes - temp_parent_node => curr_parent_node%prev; - curr_parent_node%prev => curr_parent_node%next; - curr_parent_node%next => temp_parent_node; + temp_parent_node => curr_parent_node%prev + curr_parent_node%prev => curr_parent_node%next + curr_parent_node%next => temp_parent_node - curr_parent_node => curr_parent_node%prev; + curr_parent_node => curr_parent_node%prev end do ! Swapping the head of the linked list with tail of the linked list @@ -514,9 +513,9 @@ end subroutine reverse_linked_list !> Destroy the whole given linked list !> Free all the allocated memory !> Nullify all the variables - pure subroutine clear_whole_linked_list( this_linked_list ) - class(linked_list), intent(inout) :: this_linked_list - type(Parent_Node), pointer:: current_node + subroutine clear_whole_linked_list( this_linked_list ) + class(linked_list_type), intent(inout) :: this_linked_list + type(Parent_Node_type), pointer:: current_node !> Iterating through the parent nodes to destroy them do while ( this_linked_list%num_parent_nodes > 0 ) @@ -549,12 +548,12 @@ end subroutine clear_whole_linked_list !> Creates a deep copy of the list_to_concat and !> appends it at the end of this_linked_list subroutine concat_at_end_of_list( this_linked_list, list_to_concat ) - class(linked_list), intent(inout) :: this_linked_list - type(linked_list), intent(inout) :: list_to_concat - type(node), pointer :: current_node + class(linked_list_type), intent(inout) :: this_linked_list + type(linked_list_type), intent(inout) :: list_to_concat + type(node_type), pointer :: current_node ! Return if list to append is empty - if(list_to_concat%size() == 0) return; + if(list_to_concat%size() == 0) return ! Push every item from list_of _concat to this_linked_list current_node => list_to_concat%head%child%head @@ -571,8 +570,8 @@ end subroutine concat_at_end_of_list !> Creates a shallow copy of the list_to_concat and !> appends it at the end of this_linked_list subroutine absorb_another_list( this_linked_list, list_to_absorb ) - class(linked_list), intent(inout) :: this_linked_list - type(linked_list), intent(inout) :: list_to_absorb + class(linked_list_type), intent(inout) :: this_linked_list + type(linked_list_type), intent(inout) :: list_to_absorb integer :: total ! Return if list to append is empty @@ -580,14 +579,14 @@ subroutine absorb_another_list( this_linked_list, list_to_absorb ) ! if this_linked_list is empty if(this_linked_list%size() == 0) then - this_linked_list%head => list_to_absorb%head; - this_linked_list%tail => list_to_absorb%tail; + this_linked_list%head => list_to_absorb%head + this_linked_list%tail => list_to_absorb%tail else this_linked_list%tail%next => list_to_absorb%head list_to_absorb%head%prev => this_linked_list%tail this_linked_list%tail%child%tail%next => list_to_absorb%head%child%head list_to_absorb%head%child%head%prev => this_linked_list%tail%child%tail - this_linked_list%tail => list_to_absorb%tail; + this_linked_list%tail => list_to_absorb%tail end if nullify(list_to_absorb%head) @@ -595,7 +594,7 @@ subroutine absorb_another_list( this_linked_list, list_to_absorb ) ! Change the size of the linked lists call this_linked_list%set_size(this_linked_list%size() + list_to_absorb%size()) - total = this_linked_list%number_of_parent_nodes() + list_to_absorb%number_of_parent_nodes(); + total = this_linked_list%number_of_parent_nodes() + list_to_absorb%number_of_parent_nodes() call this_linked_list%set_number_of_parent_nodes(total) call list_to_absorb%set_size(0) @@ -608,26 +607,24 @@ end subroutine absorb_another_list !> Starting from index start till end !> Returns a linked list - function slice_a_part_of_list( this_linked_list, start_in, end_in ) result ( return_list ) - class(linked_list), intent(in) :: this_linked_list - type(linked_list) :: return_list - type(node), pointer :: current_node - integer, intent(in) :: start_in - integer, intent(in) :: end_in - integer :: i - integer :: start - integer :: end + function slice_a_part_of_list( this_linked_list, start, end ) result ( return_list ) + class(linked_list_type), intent(inout) :: this_linked_list + type(linked_list_type) :: return_list + type(node_type), pointer :: current_node + integer, value :: start + integer, value :: end + integer :: i = 1 ! return if the index is out-side range of 1 to size of linked list - if(this_linked_list%size() == 0) return; - if(start_in > end_in) return; - start = max(start_in,1) - start = min(start_in,this_linked_list%size()) - end = max(end_in,1) - end = min(end_in,this_linked_list%size()) + if(this_linked_list%size() == 0) return + if(start>end) return + start = max(start,1) + start = min(start,this_linked_list%size()) + end = max(end,1) + end = min(end,this_linked_list%size()) + !iterating to find start - i = 1 current_node => this_linked_list%head%child%head do while(i < start) current_node => current_node%next @@ -645,22 +642,21 @@ end function slice_a_part_of_list - subroutine splice_a_part_of_list (this_linked_list, start_in, end_in) - class(linked_list), intent(inout) :: this_linked_list - type(parent_node), pointer :: start_parent_node - type(parent_node), pointer :: end_parent_node - type(node), pointer :: current_node - type(node), pointer :: next_node - type(node), pointer :: prev_node - integer, intent(in) :: start_in - integer, intent(in) :: end_in + subroutine splice_a_part_of_list (this_linked_list, start, end) + class(linked_list_type), intent(inout) :: this_linked_list + type(parent_node_type), pointer :: start_parent_node + type(parent_node_type), pointer :: end_parent_node + type(node_type), pointer :: current_node + type(node_type), pointer :: next_node + type(node_type), pointer :: prev_node + integer, value :: start + integer, value :: end integer :: ptr integer :: count integer :: nodes_in_start_parent_node integer :: nodes_in_end_parent_node - integer :: start - integer :: end class(*), pointer :: data + logical :: remove_start !nullify every pointer nullify(start_parent_node) @@ -669,17 +665,26 @@ subroutine splice_a_part_of_list (this_linked_list, start_in, end_in) nullify(next_node) nullify(prev_node) + ! return if the input linked list is empty - if(this_linked_list%size() == 0) return; + if(this_linked_list%size() == 0) return - ! return if input start is nore than input end - if(start_in>end_in) return; + ! return if input start is more than input end + if(start>end) return + + ! workaround: delete the first element later (if needed) + if ( start <= 1 ) then + start = 2 + remove_start = .true. + else + remove_start = .false. + endif ! handling the out of range index - start = max(start_in,1) - start = min(start_in,this_linked_list%size()) - end = max(end_in,1) - end = min(end_in,this_linked_list%size()) + start = max(start,1) + start = min(start,this_linked_list%size()) + end = max(end,1) + end = min(end,this_linked_list%size()) ! destroy the whole llist if(end == this_linked_list%size() .and. start == 1) then @@ -689,28 +694,27 @@ subroutine splice_a_part_of_list (this_linked_list, start_in, end_in) count = 0 !iterating through the linked list to find the end parent node - end_parent_node => this_linked_list%head; + end_parent_node => this_linked_list%head ptr = 0 do while(associated(end_parent_node)) - if(ptr+end_parent_node%child%size() > end) exit; + if(ptr+end_parent_node%child%size() > end) exit ptr = ptr + end_parent_node%child%size() end_parent_node => end_parent_node%next - count = count+1; + count = count+1 end do nodes_in_end_parent_node = ptr - !iterating through the linked list to find the end parent node if(start /= 1) then - start_parent_node => this_linked_list%head; + start_parent_node => this_linked_list%head ptr = 1 do while(associated(start_parent_node)) - if(ptr+start_parent_node%child%size() >= start) exit; + if(ptr+start_parent_node%child%size() >= start) exit ptr = ptr + start_parent_node%child%size() start_parent_node => start_parent_node%next count = count-1 end do - nodes_in_start_parent_node = ptr-1; + nodes_in_start_parent_node = ptr-1 end if ! iterating to the find the start_node @@ -773,6 +777,10 @@ subroutine splice_a_part_of_list (this_linked_list, start_in, end_in) call this_linked_list%set_size( this_linked_list%size() - (end - start + 1) ) if(count>1) call this_linked_list%set_number_of_parent_nodes(this_linked_list%number_of_parent_nodes() - count + 1) + if ( remove_start ) then + call this_linked_list%remove( 1 ) + endif + end subroutine splice_a_part_of_list end module stdlib_linked_list diff --git a/test/linked_list/test_linked_list.f90 b/test/linked_list/test_linked_list.f90 new file mode 100644 index 000000000..a05128f41 --- /dev/null +++ b/test/linked_list/test_linked_list.f90 @@ -0,0 +1,781 @@ +! test_linked_list.f90 -- +! Tests for the linked list module +! +! TODO: +! - absorb +! - splice <-- Crash +! +! Also: attention to large lists with multiple parent nodes +! +! Note: +! Methods set_size, set_number_of_parent_nodes should be private! +! Perhaps even number_of_parent_nodes +! +! Note: +! slice probably does not work correctly with large lists! +! +program test_linked_list + use stdlib_error, only: check + use stdlib_linked_list + + implicit none + + integer :: iunit + + open( newunit = iunit, file = 'test_linked_list.out' ) + write( iunit, '(a)') 'Tests for the linked list module' + write( iunit, '(a)') '' + + call test_size + call test_get + call test_pop + call test_insert + call test_reverse + call test_clear + call test_replace + call test_concat + call test_remove + call test_slice + call test_absorb + call test_splice + + !call test_absorb + + ! + ! Tests with large lists + ! + call test_size_large + + write( iunit, '(a)') '' + write( iunit, '(a)') 'Tests completed' +contains + +! test_size -- +! Check that the size as returned is correct +! +subroutine test_size + type(linked_list_type) :: list + integer :: i + + ! + ! An empty list should return zero + ! + write(iunit, '(/,a)') 'Test: sizes' + write(iunit, '(a,i0)') 'Size of empty list: ', list%size(); flush(iunit) + call check( 0 == list%size(), "Empty list does not return a zero size", warn=.true. ) + + do i = 1,10 + call list%push( i ) + write(iunit, '(a,i0,a,i0)') 'Size of list with ', i, ' elements: ', list%size(); flush(iunit) + call check( i == list%size(), "List does not return the right size", warn=.true. ) + enddo + + call list%clear + write(iunit, '(a,i0)') 'Size of cleared list: ', list%size(); flush(iunit) + call check( 0 == list%size(), "Cleared list does not return a zero size", warn=.true. ) +end subroutine test_size + +! test_get -- +! Check that stored elements are returned correctly via the get function +! +subroutine test_get + type(linked_list_type) :: list + integer :: i + integer :: int_val + real :: real_val + character(len=20) :: string_val + + ! + ! Note: the list does not store arrays, so hide it + ! + type real_array_type + real :: array(20) + end type real_array_type + + type(real_array_type) :: ra + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: get' + ! + ! Store the elements + ! + int_val = 1 + real_val = 2.0 + string_val = "three" + ra%array = [(real(i), i = 1,size(ra%array))] + + call list%push( int_val ) + call list%push( real_val ) + call list%push( string_val ) + call list%push( ra ) + + ! + ! Retrieve them in reverse order (just for fun) + ! + do i = 4,1,-1 + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( i == 1, "List item 1 not an integer", warn=.true. ) + type is (real) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is real with value ', d; flush(iunit) + call check( i == 2, "List item 2 not a real", warn=.true. ) + type is (character(*)) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is string with value ', d; flush(iunit) + call check( i == 3, "List item 3 not a string", warn=.true. ) + type is (real_array_type) + write(iunit, '(a,i0,a,*(g0,1x))') 'Item ', i, ' is derived type containing a real array with values ', d%array + flush(iunit) + call check( i == 4, "List item 4 not a derived type 'real_array'", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + ! + ! Change the value of the item - it is a pointer after all. + ! + data => list%get(1) + + select type ( d => data ) + type is (integer) + d = 101 + end select + + data => list%get(1) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Value of item ', i, ' changed to ', d; flush(iunit) + call check( d == 101, "List item 1 does not have the right value (101)", warn=.true. ) + end select + + call list%clear +end subroutine test_get + +! test_pop -- +! Check that stored elements are popped off the list correctly +! +subroutine test_pop + type(linked_list_type) :: list + integer :: i, last + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: pop' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Pop the list (remove the last element) one by one + ! + do i = 10,1,-1 + call list%pop + + last = list%size() + data => list%get(last) + write(iunit, '(a,i0,a,g0)') 'Size after popping item is ', last; flush(iunit) + call check( last == i-1, "List size is not correct after popping an element", warn=.true. ) + + if ( associated(data) ) then + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Last item ', last, ' is integer with value ', d; flush(iunit) + call check( i-1 == d, "List item does not have the right value", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + else + write(iunit, '(a,i0,a,g0)') 'Empty list - pointer is dissociated'; flush(iunit) + endif + enddo + + call list%clear +end subroutine test_pop + +! test_insert -- +! Check that an element is inserted at the given position (so that the original +! element is shifted down). +! +subroutine test_insert + type(linked_list_type) :: list + integer :: i + integer :: expected(1:2) + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: insert' + ! + ! Store the elements + ! + expected = [500, 5] + + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Insert a new value at the fifth position - the fifth element now comes at position 6. + ! + call list%insert( 500, 5 ) + + write(iunit, '(a,i0,a,g0)') 'Size after inserting a new item is ', list%size(); flush(iunit) + call check( list%size() == 11, "List size is not correct after inserting an element", warn=.true. ) + + + do i = 5,6 + data => list%get( i ) + if ( associated(data) ) then + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item at position ', i, ' is integer with value ', d; flush(iunit) + call check( d == expected(i-4), "List item does not have the right value", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + else + write(iunit, '(a,i0,a)') 'No such element ', i, ' - pointer is dissociated'; flush(iunit) + call check( .false., "List item is missing", warn=.true. ) + endif + enddo + + ! + ! Insert at the beginning and after the end + ! + call list%insert( 1000, -1) + call list%insert( 2000, 100) + + expected = [1000, 2000] + + do i = 1,2 + if ( i == 1 ) then + data => list%get( 1 ) + else + data => list%get( list%size() ) + endif + + if ( associated(data) ) then + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item at position ', i, ' is integer with value ', d; flush(iunit) + call check( d == expected(i), "List item does not have the right value", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + else + write(iunit, '(a,i0,a)') 'No such element ', i, ' - pointer is dissociated'; flush(iunit) + call check( .false., "List item is missing", warn=.true. ) + endif + enddo + + + call list%clear +end subroutine test_insert + +! test_reverse -- +! Check that a list is properly reversed +! +subroutine test_reverse + type(linked_list_type) :: list + integer :: i + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: reverse' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Reverse the list and check the elements + ! + call list%reverse + + write(iunit, '(a,i0,a,g0)') 'Size after reversing is ', list%size(); flush(iunit) + call check( list%size() == 10, "List size is not correct after reversing", warn=.true. ) + + + do i = 1,list%size() + data => list%get( i ) + if ( associated(data) ) then + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item at position ', i, ' is integer with value ', d; flush(iunit) + call check( d == list%size()+1-i, "List item does not have the right value", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + else + write(iunit, '(a,i0,a)') 'No such element ', i, ' - pointer is dissociated'; flush(iunit) + call check( .false., "List item is missing", warn=.true. ) + endif + enddo + + call list%clear +end subroutine test_reverse + +! test_clear -- +! Check that a cleared list does not have any elements +! +subroutine test_clear + type(linked_list_type) :: list + integer :: i + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: clear' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Reverse the list and check the elements + ! + call list%clear + + write(iunit, '(a,i0,a,g0)') 'Size after clearing is ', list%size(); flush(iunit) + call check( list%size() == 0, "List size is not correct after clearing", warn=.true. ) + + data => list%get( 1 ) + + write(iunit, '(2a)') 'Element 1 exists? - pointer is ', merge( 'associated ', 'dissociated', associated(data) ); flush(iunit) + call check( .not. associated(data), "There should be no list item returned", warn=.true. ) + + call list%clear +end subroutine test_clear + +! test_replace -- +! Check that an element is properly replaced +! +subroutine test_replace + type(linked_list_type) :: list + integer :: i + integer :: int_val + character(len=20) :: string_val + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: replace' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Replace element 2 by a string + ! + call list%replace( "TWO", 2 ) + + ! + ! Check the list + ! + write(iunit, '(a,i0,a,g0)') 'Size after replacing is ', list%size(); flush(iunit) + call check( list%size() == 10, "List size is not correct after replacing", warn=.true. ) + + + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( i /= 2, "List item is not an integer", warn=.true. ) + type is (character(*)) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is string with value ', d; flush(iunit) + call check( i == 2, "List item 2 is not a string", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear +end subroutine test_replace + + +! +! Tests for large lists +! + +! test_size_large -- +! Check that the size of large lists as returned is correct +! +subroutine test_size_large + type(linked_list_type) :: list + integer :: i + + write(iunit, '(/,a)') 'Test: size of large lists' + + do i = 1,100000 + call list%push( i ) + + if ( mod(i,5001) == 1 ) then + write(iunit, '(a,i0,a,i0)') 'Size of list with ', i, ' elements: ', list%size(); flush(iunit) + write(iunit, '(a,i0,a,i0)') 'Number of parent nodes: ', list%number_of_parent_nodes(); flush(iunit) + call check( i == list%size(), "List does not return the right size", warn=.true. ) + endif + enddo + + call list%clear +end subroutine test_size_large + +! test_concat -- +! Check that a list is correctly concatenated to the end of the original list +! +subroutine test_concat + type(linked_list_type) :: list, sublist + integer :: i + character(len=20) :: string_val + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: concat' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + call sublist%push( 'ONE' ) + call sublist%push( 'TWO' ) + call sublist%push( 'THREE' ) + call sublist%push( 'FOUR' ) + + ! + ! Concatenate the sublist + ! + call list%concat( sublist ) + + write(iunit, '(a,i0,a,i0)') 'Size of concatenated list is: ', list%size(); flush(iunit) + call check( list%size() == 14, "Concatenated list does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( i <= 10, "Item in concatenated list is not an integer", warn=.true. ) + type is (character(*)) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is string with value ', d + call check( i > 10, "item in concatenated list is not a string", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear +end subroutine test_concat + +! test_absorb -- +! Check that an abosrbed list is correctly moved to the absorbing list +! +subroutine test_absorb + type(linked_list_type) :: list, sublist + integer :: i + character(len=20) :: string_val + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: absorb' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + call sublist%push( 'ONE' ) + call sublist%push( 'TWO' ) + call sublist%push( 'THREE' ) + call sublist%push( 'FOUR' ) + + ! + ! Concatenate the sublist and + ! check that the absorbed list is now empty + ! + call list%absorb( sublist ) + + write(iunit, '(a,i0,a,i0)') 'Size of absorbing list is: ', list%size(); flush(iunit) + call check( list%size() == 14, "Absorbing list does not return the right size", warn=.true. ) + + write(iunit, '(a,i0,a,i0)') 'Size of absorbed list is: ', sublist%size(); flush(iunit) + call check( sublist%size() == 0, "Absorbed list does not return the right size", warn=.true. ) + + ! + ! Check the contents of the absorbing list + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( i <= 10, "Item in concatenated list is not an integer", warn=.true. ) + type is (character(*)) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is string with value ', d; flush(iunit) + call check( i > 10, "item in concatenated list is not a string", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + + call list%clear +end subroutine test_absorb + +! test_remove -- +! Check that a list element is properly removed +! +subroutine test_remove + type(linked_list_type) :: list + integer :: i + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: remove' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Remove the first and the last elements + ! + call list%remove( 10 ) + call list%remove( 1 ) + + write(iunit, '(a,i0,a,i0)') 'Size of list with two removed is: ', list%size(); flush(iunit) + call check( list%size() == 8, "List with removed elements does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( d > 1 .and. d < 10, "Item in list is out of range", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear +end subroutine test_remove + +! test_slice -- +! Check that the proper slice of a list is returned +! +subroutine test_slice + type(linked_list_type) :: list, slice + integer :: i + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: slice' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Get a slice of the list + ! + slice = list%slice( 2, 4 ) + + write(iunit, '(a,i0,a,i0)') 'Size of slice is: ', slice%size(); flush(iunit) + call check( slice%size() == 3, "Slice does not return the right size", warn=.true. ) + + write(iunit, '(a,i0,a,i0)') 'Size of original list is: ', list%size(); flush(iunit) + call check( list%size() == 10, "Original list does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,slice%size() + data => slice%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( d >= 2 .and. d <= 4, "Item in list is out of range", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear + call slice%clear +end subroutine test_slice + +! test_splice -- +! Check that a list is properly spliced (a piece is removed) +! +subroutine test_splice + type(linked_list_type) :: list + integer :: i + + ! + ! Variable returned can be of any type + ! + class(*), pointer :: data + + write(iunit, '(/,a)') 'Test: splice' + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Remove the middle part of the list + ! + call list%splice( 2, 9 ) + + write(iunit, '(a,i0,a,i0)') 'Size of spliced list is: ', list%size(); flush(iunit) + call check( list%size() == 2, "Spliced list does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( d == 1 .or. d == 10, "Item in list is out of range", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear + + ! Further tests: remove first half, remove last half + ! + ! Store the elements + ! + do i = 1,10 + call list%push( i ) + enddo + + ! + ! Remove the first half + ! + call list%splice( -1, 5 ) !<== Removing the first element gives trouble! + + write(iunit, '(a,i0,a,i0)') 'Size of spliced list (first half removed) is: ', list%size(); flush(iunit) + call check( list%size() == 5, "Spliced list (first half removed) does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( d > 5, "Item in list is out of range", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + ! + ! Remove the second half + ! + call list%splice( 3, 10 ) + + write(iunit, '(a,i0,a,i0)') 'Size of spliced list (second half removed) is: ', list%size(); flush(iunit) + call check( list%size() == 2, "Spliced list (second half removed) does not return the right size", warn=.true. ) + + ! + ! Check the contents + ! + do i = 1,list%size() + data => list%get(i) + + select type ( d => data ) + type is (integer) + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is integer with value ', d; flush(iunit) + call check( d >= 6 .and. d <= 7, "Item in list is out of range", warn=.true. ) + class default + write(iunit, '(a,i0,a,g0)') 'Item ', i, ' is of unknown type'; flush(iunit) + call check( .false., "List item encountered of unknown type", warn=.true. ) + end select + enddo + + call list%clear +end subroutine test_splice + +end program test_linked_list diff --git a/test/linked_list/test_performance.f90 b/test/linked_list/test_performance.f90 index 53422dddb..6aa7a3aaf 100644 --- a/test/linked_list/test_performance.f90 +++ b/test/linked_list/test_performance.f90 @@ -6,14 +6,14 @@ program test_link integer:: a=1,b=2,c=3 double precision::d=5 end type struct - type(struct):: Vel2 + type(struct) :: Vel2 type vector double precision, dimension(3):: vec end type vector - type(vector)::Vel + type(vector) ::Vel - type(linked_list):: L + type(linked_list_type) :: L integer :: i,j,length real :: T1,T2,F, r integer :: cnt1, cnt2, count_rate From e23b1ea0f047c6234a2fa5ee54ddc48681980f8a Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 28 Dec 2023 15:29:20 +0100 Subject: [PATCH 17/20] Adjusting the examples and fixing an INTENT() error As the type is now "linked_list_type", the examples had to be adjusted. There turned out to be a bug regarding the intent for the get() function. This has been repaired. --- example/linked_list/example_linked_absorb.f90 | 2 +- example/linked_list/example_linked_clear.f90 | 2 +- example/linked_list/example_linked_concat.f90 | 2 +- example/linked_list/example_linked_get.f90 | 6 +++--- example/linked_list/example_linked_insert.f90 | 2 +- example/linked_list/example_linked_pop.f90 | 2 +- example/linked_list/example_linked_push.f90 | 2 +- example/linked_list/example_linked_remove.f90 | 2 +- example/linked_list/example_linked_replace.f90 | 2 +- example/linked_list/example_linked_reverse.f90 | 2 +- example/linked_list/example_linked_size.f90 | 2 +- example/linked_list/example_linked_slice.f90 | 2 +- example/linked_list/example_linked_splice.f90 | 2 +- example/linked_list/linked_list_aux.inc | 2 +- src/stdlib_child_list.f90 | 6 +++--- src/stdlib_linked_list.f90 | 18 +++++++++--------- 16 files changed, 28 insertions(+), 28 deletions(-) diff --git a/example/linked_list/example_linked_absorb.f90 b/example/linked_list/example_linked_absorb.f90 index 569aeac51..832eb3c8f 100644 --- a/example/linked_list/example_linked_absorb.f90 +++ b/example/linked_list/example_linked_absorb.f90 @@ -6,7 +6,7 @@ program example_absorb implicit none - type(linked_list) :: list, list_to_absorb + type(linked_list_type) :: list, list_to_absorb ! ! Add a few elements to the two lists diff --git a/example/linked_list/example_linked_clear.f90 b/example/linked_list/example_linked_clear.f90 index 8fd4befb0..df7da3b74 100644 --- a/example/linked_list/example_linked_clear.f90 +++ b/example/linked_list/example_linked_clear.f90 @@ -6,7 +6,7 @@ program example_clear implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_concat.f90 b/example/linked_list/example_linked_concat.f90 index 5c96a092c..0757e43c6 100644 --- a/example/linked_list/example_linked_concat.f90 +++ b/example/linked_list/example_linked_concat.f90 @@ -6,7 +6,7 @@ program example_concat implicit none - type(linked_list) :: list, list_to_concat + type(linked_list_type) :: list, list_to_concat ! ! Add a few elements to the two lists diff --git a/example/linked_list/example_linked_get.f90 b/example/linked_list/example_linked_get.f90 index 5a77f2ed7..5162866ca 100644 --- a/example/linked_list/example_linked_get.f90 +++ b/example/linked_list/example_linked_get.f90 @@ -6,9 +6,9 @@ program example_get implicit none - type(linked_list) :: list - class(*), pointer :: list_item - integer :: i + type(linked_list_type) :: list + class(*), pointer :: list_item + integer :: i ! ! Add a few elements diff --git a/example/linked_list/example_linked_insert.f90 b/example/linked_list/example_linked_insert.f90 index 6d9a92fa3..30658fc4a 100644 --- a/example/linked_list/example_linked_insert.f90 +++ b/example/linked_list/example_linked_insert.f90 @@ -7,7 +7,7 @@ program example_insert implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_pop.f90 b/example/linked_list/example_linked_pop.f90 index 935af5357..7fcacc743 100644 --- a/example/linked_list/example_linked_pop.f90 +++ b/example/linked_list/example_linked_pop.f90 @@ -6,7 +6,7 @@ program example_pop implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_push.f90 b/example/linked_list/example_linked_push.f90 index c3ccefb72..f71138c60 100644 --- a/example/linked_list/example_linked_push.f90 +++ b/example/linked_list/example_linked_push.f90 @@ -6,7 +6,7 @@ program example_push implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_remove.f90 b/example/linked_list/example_linked_remove.f90 index b5e412124..78f375483 100644 --- a/example/linked_list/example_linked_remove.f90 +++ b/example/linked_list/example_linked_remove.f90 @@ -6,7 +6,7 @@ program example_remove implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_replace.f90 b/example/linked_list/example_linked_replace.f90 index 361323445..52b49f206 100644 --- a/example/linked_list/example_linked_replace.f90 +++ b/example/linked_list/example_linked_replace.f90 @@ -6,7 +6,7 @@ program example_replace implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_reverse.f90 b/example/linked_list/example_linked_reverse.f90 index f48f17717..0d547ffdf 100644 --- a/example/linked_list/example_linked_reverse.f90 +++ b/example/linked_list/example_linked_reverse.f90 @@ -6,7 +6,7 @@ program example_reverse implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_size.f90 b/example/linked_list/example_linked_size.f90 index 4409553b2..ef1a4ea61 100644 --- a/example/linked_list/example_linked_size.f90 +++ b/example/linked_list/example_linked_size.f90 @@ -6,7 +6,7 @@ program example_size implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements diff --git a/example/linked_list/example_linked_slice.f90 b/example/linked_list/example_linked_slice.f90 index 3a423ac92..02b2a1c10 100644 --- a/example/linked_list/example_linked_slice.f90 +++ b/example/linked_list/example_linked_slice.f90 @@ -6,7 +6,7 @@ program example_slice implicit none - type(linked_list) :: list, sublist + type(linked_list_type) :: list, sublist ! ! Add a few elements to the list diff --git a/example/linked_list/example_linked_splice.f90 b/example/linked_list/example_linked_splice.f90 index d939ed70d..1d2e6ef95 100644 --- a/example/linked_list/example_linked_splice.f90 +++ b/example/linked_list/example_linked_splice.f90 @@ -7,7 +7,7 @@ program example_splice implicit none - type(linked_list) :: list + type(linked_list_type) :: list ! ! Add a few elements to the list diff --git a/example/linked_list/linked_list_aux.inc b/example/linked_list/linked_list_aux.inc index 5b9a507f1..45c71bf70 100644 --- a/example/linked_list/linked_list_aux.inc +++ b/example/linked_list/linked_list_aux.inc @@ -2,7 +2,7 @@ ! Auxiliary routine for printing the contents of a linked list ! subroutine print_list( list ) - type(linked_list), intent(in) :: list + type(linked_list_type), intent(in) :: list integer :: i class(*), pointer :: list_item diff --git a/src/stdlib_child_list.f90 b/src/stdlib_child_list.f90 index d957ce1df..dfd88119e 100644 --- a/src/stdlib_child_list.f90 +++ b/src/stdlib_child_list.f90 @@ -8,7 +8,7 @@ module stdlib_child_list implicit none ! making Node and child_list struct globally available - public:: Node, child_list + public:: node_type, child_list_type !> Defining Node !> @@ -27,7 +27,7 @@ module stdlib_child_list !> !> This linked list is single-dimensional chain of Nodes. !> It is a doubly-linked heterogeneous generic list . - type child_list + type child_list_type integer, private :: num_nodes = 0 type(node_type), pointer :: head => null() type(node_type), pointer :: tail => null() @@ -42,7 +42,7 @@ module stdlib_child_list procedure:: replace => replace_at_index procedure:: reverse => reverse_child_list procedure:: clear => destroy_whole_child_list - end type child_list + end type child_list_type contains diff --git a/src/stdlib_linked_list.f90 b/src/stdlib_linked_list.f90 index 174068715..c8d30a2b8 100644 --- a/src/stdlib_linked_list.f90 +++ b/src/stdlib_linked_list.f90 @@ -8,8 +8,8 @@ module stdlib_linked_list implicit none ! making Parent_Node and linked_list struct globally available - public :: Parent_Node - public :: linked_list + public :: parent_node_type + public :: linked_list_type ! Maximum size of the child linked list integer, private, parameter :: MAX_SIZE = 10000 @@ -21,21 +21,21 @@ module stdlib_linked_list !> !> The purpose of this node is to hold a child list !> and links to previous and next Parent Node. - type Parent_Node - type(Parent_Node_type), pointer :: next => null() - type(Parent_Node_type), pointer :: prev => null() + type parent_node_type + type(parent_node_type), pointer :: next => null() + type(parent_node_type), pointer :: prev => null() type(child_list_type) , allocatable :: child contains procedure :: size => child_length procedure :: split => split_into_two_nodes procedure, private :: destroy => parent_node_destroyed - end type Parent_Node + end type parent_node_type !> Defining Linked List !> !> This linked list is single-dimensional chain of Parent Nodes. !> It is a doubly-linked heterogeneous generic list . - type linked_list + type linked_list_type integer, private :: num_parent_nodes = 0 integer, private :: total_nodes = 0 type(Parent_Node_type), pointer :: head => null() @@ -57,7 +57,7 @@ module stdlib_linked_list procedure :: absorb => absorb_another_list procedure :: slice => slice_a_part_of_list procedure :: splice => splice_a_part_of_list - end type linked_list + end type linked_list_type contains @@ -355,7 +355,7 @@ end subroutine remove_node_at_index_parent !> !> Returns a pointer function get_element_at_index_in_parent( this_linked_list, node_index ) result ( return_item ) - class(linked_list_type), intent(inout) :: this_linked_list + class(linked_list_type), intent(in) :: this_linked_list integer, intent(in):: node_index class(*), pointer :: return_item type(Parent_Node_type), pointer:: current_node From ebb84b8c214e1b1a8691a18b70681b5b4262546a Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 28 Dec 2023 15:34:21 +0100 Subject: [PATCH 18/20] Add explicit include directory The file "linked_list_aux.inc" was not found - fpm test. --- example/linked_list/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/linked_list/CMakeLists.txt b/example/linked_list/CMakeLists.txt index 888bafb97..2428c1f5c 100644 --- a/example/linked_list/CMakeLists.txt +++ b/example/linked_list/CMakeLists.txt @@ -1,4 +1,4 @@ -#include_directories(${CMAKE_CURRENT_LIST_DIR}) +include_directories(${CMAKE_CURRENT_LIST_DIR}) ADD_EXAMPLE(linked_absorb) ADD_EXAMPLE(linked_clear) From b31023978dd24f288ba2d24e7285d85ad47f9109 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 28 Dec 2023 15:42:46 +0100 Subject: [PATCH 19/20] Incorporate the auxiliary routine directly Something went wrong with the included routine in the examples. So instead, simply copy the source code for it in all examples. --- example/linked_list/example_linked_absorb.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_concat.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_insert.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_pop.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_push.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_remove.f90 | 26 ++++++++++++++++++- .../linked_list/example_linked_replace.f90 | 26 ++++++++++++++++++- .../linked_list/example_linked_reverse.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_slice.f90 | 26 ++++++++++++++++++- example/linked_list/example_linked_splice.f90 | 26 ++++++++++++++++++- test/linked_list/CMakeLists.txt | 1 + 11 files changed, 251 insertions(+), 10 deletions(-) diff --git a/example/linked_list/example_linked_absorb.f90 b/example/linked_list/example_linked_absorb.f90 index 832eb3c8f..9e493d137 100644 --- a/example/linked_list/example_linked_absorb.f90 +++ b/example/linked_list/example_linked_absorb.f90 @@ -41,6 +41,30 @@ program example_absorb call print_list( list_to_absorb ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_absorb diff --git a/example/linked_list/example_linked_concat.f90 b/example/linked_list/example_linked_concat.f90 index 0757e43c6..181d6d9ec 100644 --- a/example/linked_list/example_linked_concat.f90 +++ b/example/linked_list/example_linked_concat.f90 @@ -41,6 +41,30 @@ program example_concat call print_list( list_to_concat ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_concat diff --git a/example/linked_list/example_linked_insert.f90 b/example/linked_list/example_linked_insert.f90 index 30658fc4a..2a15e7094 100644 --- a/example/linked_list/example_linked_insert.f90 +++ b/example/linked_list/example_linked_insert.f90 @@ -30,6 +30,30 @@ program example_insert call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_insert diff --git a/example/linked_list/example_linked_pop.f90 b/example/linked_list/example_linked_pop.f90 index 7fcacc743..7e35a73ed 100644 --- a/example/linked_list/example_linked_pop.f90 +++ b/example/linked_list/example_linked_pop.f90 @@ -30,6 +30,30 @@ program example_pop call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_pop diff --git a/example/linked_list/example_linked_push.f90 b/example/linked_list/example_linked_push.f90 index f71138c60..ec5238a8e 100644 --- a/example/linked_list/example_linked_push.f90 +++ b/example/linked_list/example_linked_push.f90 @@ -30,6 +30,30 @@ program example_push call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_push diff --git a/example/linked_list/example_linked_remove.f90 b/example/linked_list/example_linked_remove.f90 index 78f375483..609452966 100644 --- a/example/linked_list/example_linked_remove.f90 +++ b/example/linked_list/example_linked_remove.f90 @@ -30,6 +30,30 @@ program example_remove call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_remove diff --git a/example/linked_list/example_linked_replace.f90 b/example/linked_list/example_linked_replace.f90 index 52b49f206..b816c00cb 100644 --- a/example/linked_list/example_linked_replace.f90 +++ b/example/linked_list/example_linked_replace.f90 @@ -30,6 +30,30 @@ program example_replace call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_replace diff --git a/example/linked_list/example_linked_reverse.f90 b/example/linked_list/example_linked_reverse.f90 index 0d547ffdf..939f5e29c 100644 --- a/example/linked_list/example_linked_reverse.f90 +++ b/example/linked_list/example_linked_reverse.f90 @@ -30,6 +30,30 @@ program example_reverse call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_reverse diff --git a/example/linked_list/example_linked_slice.f90 b/example/linked_list/example_linked_slice.f90 index 02b2a1c10..fce6136b3 100644 --- a/example/linked_list/example_linked_slice.f90 +++ b/example/linked_list/example_linked_slice.f90 @@ -37,6 +37,30 @@ program example_slice call print_list( sublist) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_slice diff --git a/example/linked_list/example_linked_splice.f90 b/example/linked_list/example_linked_splice.f90 index 1d2e6ef95..35e517f88 100644 --- a/example/linked_list/example_linked_splice.f90 +++ b/example/linked_list/example_linked_splice.f90 @@ -35,6 +35,30 @@ program example_splice call print_list( list ) contains -include 'linked_list_aux.inc' +!include 'linked_list_aux.inc' +subroutine print_list( list ) + type(linked_list_type), intent(in) :: list + + integer :: i + class(*), pointer :: list_item + + do i = 1,list%size() + list_item => list%get(i) + + select type( item => list_item ) + type is (integer) + write(*,*) i, item, ' (integer)' + + type is (real) + write(*,*) i, item, ' (real)' + + type is (character(*)) + write(*,*) i, ' >', item, '< (string)' + + class default + write(*,*) i, ' (type unknown)' + end select + enddo +end subroutine print_list end program example_splice diff --git a/test/linked_list/CMakeLists.txt b/test/linked_list/CMakeLists.txt index 0fc8ff782..4d67f475e 100644 --- a/test/linked_list/CMakeLists.txt +++ b/test/linked_list/CMakeLists.txt @@ -1 +1,2 @@ ADDTEST(test_performance) +ADDTEST(test_linked_list) From 220791aea9c4985a267bdb717bb8f9c2ad59b9ad Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Thu, 28 Dec 2023 15:48:06 +0100 Subject: [PATCH 20/20] Correct the name of the test programs --- test/linked_list/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/linked_list/CMakeLists.txt b/test/linked_list/CMakeLists.txt index 4d67f475e..bd1b8094b 100644 --- a/test/linked_list/CMakeLists.txt +++ b/test/linked_list/CMakeLists.txt @@ -1,2 +1,2 @@ -ADDTEST(test_performance) -ADDTEST(test_linked_list) +ADDTEST(performance) +ADDTEST(linked_list)