├── .gitignore ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── dict_mod.f90 ├── dtypes.h ├── sample.f90 ├── test ├── add_erase_random │ ├── Makefile │ ├── add_erase_random.f90 │ └── dtypes.h ├── get_kth │ ├── Makefile │ ├── dtypes.h │ └── get_kth.f90 └── speedtest │ ├── .gitignore │ ├── Makefile │ ├── dtypes.h │ ├── speedtest.f90 │ ├── std_map │ ├── Makefile │ └── main.cc │ └── visual │ ├── main.py │ └── out.png └── treap_struct.f90 /.gitignore: -------------------------------------------------------------------------------- 1 | *.mod 2 | *.o 3 | *.out 4 | *.gch 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | 3 | sudo: required 4 | 5 | install: 6 | - sudo apt-get install gfortran valgrind 7 | 8 | script: 9 | - make && ./a.out 10 | - valgrind --leak-check=full --error-exitcode=87 ./a.out 11 | - cd ${TRAVIS_BUILD_DIR}/test/add_erase_random && make && ./a.out 12 | - valgrind --leak-check=full --error-exitcode=87 ./a.out 13 | - cd ${TRAVIS_BUILD_DIR}/test/get_kth && make && ./a.out 14 | - valgrind --leak-check=full --error-exitcode=87 ./a.out 15 | - cd ${TRAVIS_BUILD_DIR}/test/speedtest && make && ./a.out 16 | 17 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Takuma Yoshida 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | TARGET = a.out 2 | FC = gfortran 3 | DEBUG = yes 4 | 5 | ifeq ($(DEBUG),yes) 6 | FFLAGS := -cpp -Wall -Wuninitialized -O0 -g3 -fbounds-check \ 7 | -fbacktrace -fdump-core -ffpe-trap=invalid,zero,overflow -fimplicit-none \ 8 | -finit-real=snan -finit-integer=-858993460 9 | else 10 | FFLAGS := -cpp -Ofast -march=native -fbacktrace -fdump-core 11 | endif 12 | INCLUDE := -I. 13 | 14 | $(TARGET): sample.o dict_mod.o treap_struct.o 15 | $(FC) $(MACROS) $(FFLAGS) $(INCLUDE) $^ -o $@ 16 | 17 | %.o: %.f90 18 | $(FC) $(MACROS) -c $(FFLAGS) $(INCLUDE) $< 19 | 20 | %.mod: %.o %.f90 21 | @: 22 | 23 | sample.o: dict_mod.mod 24 | dict_mod.o: treap_struct.mod dtypes.h 25 | treap_struct.o: dtypes.h 26 | 27 | clean: 28 | rm -rf *.o *.mod *.gch *.log $(TARGET) core.* 29 | 30 | .PHONY: clean 31 | 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Fortran associative array [![Build Status](https://travis-ci.org/ysdtkm/fortran_associative_array.svg?branch=master)](https://travis-ci.org/ysdtkm/fortran_associative_array) 2 | A scalable associative array (known as **hash table** or **dictionary**) for Fortran 3 | 4 | ## Specifications 5 | * Internal data structure is treap (randomized binary search tree) 6 | * Roughly corresponds to `std::map` (C++) or `dict` (Python) 7 | * A **key** can be `characters` (either fixed or arbitrary length), an `integer`, or a `real` 8 | * A **value** can be any fortran intrinsic data type (with fixed length or kind). A *copy* of the value is stored in the `dict` object 9 | * Does not affect Fortran's intrinsic random state 10 | * Implemented operations 11 | 12 | |Operation |Cost |Implementation | 13 | |---- |---- |---- | 14 | |Insertion/assignment |O(log n) |Subroutine `insert_or_assign(dict, key, val)` | 15 | |Deletion |O(log n) |Subroutine `remove(dict, key)`
(Error if not exist) | 16 | |Existence of a key |O(log n) |Logical function `exists(dict, key)` | 17 | |Reference |O(log n) |Valuetype function `get_val(dict, key)`
(Error if not exist) | 18 | |Get max/min/k-th key |O(log n) |Keytype function `get_kth_key(dict, k)`
(Error if out of bounds; 1-based)| 19 | |Count |O(1) |Integer function `get_size(dict)` | 20 | |Retrieve sorted array |O(n) |Subroutine `get_keys_vals(dict, keys, vals, n)`
(Not for arbitrary length keys)| 21 | |Clear |O(n) |Implicitly called as a destructor | 22 | 23 | * Other operations allowed by the data structure (not implemented) 24 | 25 | |Operation |Cost |Note | 26 | |---- |---- |---- | 27 | |Merge/split |O(log n) |Destructive | 28 | |lower_bound/upper_bound |O(log n) | | 29 | |Range search |O(log n + elements found)| | 30 | |Deep copy |O(n) |Preorder DFS | 31 | 32 | * Speed comparison with `gfortran`/`g++`, without compiler optimization 33 | 34 | 35 | 36 | ## Usage 37 | * See `sample.f90` for sample usage 38 | * Edit `dtypes.h` if using another data types 39 | * For string key (arbitrary length), `keytype1` should be `character(:),allocatable` and `keytype2` should be `character(*)` 40 | * For other key types, `keytype1` and `keytype2` are the same 41 | 42 | ## References 43 | * Treap https://en.wikipedia.org/wiki/Treap 44 | * Treap https://www.slideshare.net/iwiwi/2-12188757 45 | 46 | -------------------------------------------------------------------------------- /dict_mod.f90: -------------------------------------------------------------------------------- 1 | #include 2 | module dict_mod 3 | ! High level wrapper of dictionary data structure 4 | 5 | use treap_struct, only: node, my_count, insert, erase, find_node, kth_node, delete_all, inorder 6 | implicit none 7 | 8 | private 9 | public :: dict, get_val, insert_or_assign, exists, remove, get_keys_vals, get_size, get_kth_key 10 | 11 | type dict 12 | type(node), pointer :: root => null() 13 | integer :: randstate = 1231767121 14 | contains 15 | final :: destruct_dict 16 | end type dict 17 | 18 | contains 19 | 20 | pure function xorshift32(i) 21 | implicit none 22 | integer(4), intent(in) :: i 23 | integer(4) :: xorshift32 24 | if (i == 0) then 25 | xorshift32 = 1231767121 26 | else 27 | xorshift32 = i 28 | end if 29 | xorshift32 = ieor(xorshift32, ishft(xorshift32, 13)) 30 | xorshift32 = ieor(xorshift32, ishft(xorshift32, -17)) 31 | xorshift32 = ieor(xorshift32, ishft(xorshift32, 15)) 32 | end function xorshift32 33 | 34 | function get_val(t, key) 35 | implicit none 36 | type(dict), intent(in) :: t 37 | keytype2, intent(in) :: key 38 | type(node), pointer :: nd 39 | valtype :: get_val 40 | nd => find_node(t%root, key) 41 | if (.not. associated(nd)) then 42 | stop 105 43 | end if 44 | get_val = nd%val 45 | end function get_val 46 | 47 | function exists(t, key) 48 | implicit none 49 | type(dict), intent(in) :: t 50 | keytype2, intent(in) :: key 51 | type(node), pointer :: nd 52 | logical :: exists 53 | nd => find_node(t%root, key) 54 | exists = (associated(nd)) 55 | end function exists 56 | 57 | subroutine insert_or_assign(t, key, val) 58 | implicit none 59 | type(dict), intent(inout) :: t 60 | keytype2, intent(in) :: key 61 | valtype, intent(in) :: val 62 | type(node), pointer :: nd 63 | nd => find_node(t%root, key) 64 | if (associated(nd)) then 65 | nd%val = val 66 | else ! This implementation is not optimal 67 | t%root => insert(t%root, key, val, t%randstate) 68 | t%randstate = xorshift32(t%randstate) 69 | end if 70 | end subroutine insert_or_assign 71 | 72 | subroutine remove(t, key) 73 | implicit none 74 | type(dict), intent(inout) :: t 75 | keytype2, intent(in) :: key 76 | t%root => erase(t%root, key) 77 | end subroutine remove 78 | 79 | function get_kth_key(t, k) 80 | implicit none 81 | type(dict), intent(in) :: t 82 | integer, intent(in) :: k 83 | type(node), pointer :: res 84 | keytype1 :: get_kth_key 85 | if (k < 1 .or. k > my_count(t%root)) then 86 | print *, "get_kth_key failed" 87 | stop 2 88 | else 89 | res => kth_node(t%root, k) 90 | get_kth_key = res%key 91 | end if 92 | end function get_kth_key 93 | 94 | subroutine get_keys_vals(t, keys, vals, n) 95 | implicit none 96 | type(dict), intent(in) :: t 97 | integer, intent(in) :: n 98 | keytype2, intent(out) :: keys(n) 99 | valtype, intent(out) :: vals(n) 100 | integer :: counter 101 | if (my_count(t%root) /= n) stop 5 102 | counter = 0 103 | call inorder(t%root, keys, vals, counter) 104 | end subroutine get_keys_vals 105 | 106 | function get_size(t) 107 | implicit none 108 | type(dict), intent(in) :: t 109 | integer :: get_size 110 | get_size = my_count(t%root) 111 | end function get_size 112 | 113 | subroutine destruct_dict(t) 114 | implicit none 115 | type(dict), intent(inout) :: t 116 | call delete_all(t%root) 117 | end subroutine destruct_dict 118 | 119 | end module dict_mod 120 | -------------------------------------------------------------------------------- /dtypes.h: -------------------------------------------------------------------------------- 1 | #define keytype1 character(:),allocatable 2 | #define keytype2 character(*) 3 | #define valtype integer 4 | 5 | -------------------------------------------------------------------------------- /sample.f90: -------------------------------------------------------------------------------- 1 | program sample 2 | use dict_mod, only: dict, exists, get_size, get_val, insert_or_assign, remove 3 | implicit none 4 | 5 | type(dict) :: ages ! Initialized empty 6 | 7 | call insert_or_assign(ages, "Alice", 28) 8 | call insert_or_assign(ages, "Bob", 13) 9 | call insert_or_assign(ages, "Carol", 47) 10 | call insert_or_assign(ages, "Alice", 35) ! Updated 11 | 12 | print *, "Alice is", get_val(ages, "Alice"), "years old" ! 35 13 | print *, "Do we know Dave's age?", exists(ages, "Dave") ! False 14 | 15 | call remove(ages, "Bob") 16 | 17 | print *, "Now we know the ages of", get_size(ages), "people" ! Alice and Carol 18 | end program sample 19 | 20 | -------------------------------------------------------------------------------- /test/add_erase_random/Makefile: -------------------------------------------------------------------------------- 1 | TARGET = a.out 2 | FC = gfortran 3 | DEBUG = yes 4 | vpath %.f90 ../../ 5 | 6 | ifeq ($(DEBUG),yes) 7 | FFLAGS := -cpp -Wall -Wuninitialized -O0 -g3 -fbounds-check \ 8 | -fbacktrace -fdump-core -ffpe-trap=invalid,zero,overflow -fimplicit-none \ 9 | -finit-real=snan -finit-integer=-858993460 10 | else 11 | FFLAGS := -cpp -Ofast -march=native -fbacktrace -fdump-core 12 | endif 13 | INCLUDES = -I. 14 | 15 | $(TARGET): add_erase_random.o dict_mod.o treap_struct.o 16 | $(FC) $(INCLUDES) $(FFLAGS) $^ -o $@ 17 | 18 | %.o: %.f90 19 | $(FC) $(INCLUDES) -c $(FFLAGS) $< 20 | 21 | %.mod: %.o %.f90 22 | @: 23 | 24 | add_erase_random.o: dict_mod.mod 25 | dict_mod.o: treap_struct.mod 26 | 27 | clean: 28 | rm -rf *.o *.cgh *.mod *.log $(TARGET) core.* 29 | 30 | .PHONY: clean 31 | 32 | -------------------------------------------------------------------------------- /test/add_erase_random/add_erase_random.f90: -------------------------------------------------------------------------------- 1 | #include 2 | program add_erase_random 3 | use dict_mod, only: dict, insert_or_assign, get_val, remove, get_size, exists 4 | implicit none 5 | 6 | integer, parameter :: n = 10000 7 | type(dict) :: t 8 | integer :: i, a(n), seed(100) 9 | real(8) :: r 10 | valtype :: b 11 | 12 | seed(:) = 0 13 | call random_seed(put=seed) 14 | 15 | do i = 1, n 16 | call random_number(r) 17 | a(i) = floor(r * n) 18 | end do 19 | 20 | do i = 1, n 21 | call insert_or_assign(t, a(i), float(a(i))) 22 | end do 23 | 24 | do i = 1, n 25 | b = get_val(t, a(i)) 26 | if (abs(b - a(i)) > 0.0001) stop 2 27 | end do 28 | 29 | do i = 1, n 30 | if (exists(t, a(i))) then 31 | call remove(t, a(i)) 32 | end if 33 | end do 34 | 35 | if (get_size(t) /= 0) stop 4 36 | 37 | do i = 1, n 38 | call insert_or_assign(t, a(i), float(a(i))) 39 | end do 40 | end program add_erase_random 41 | 42 | -------------------------------------------------------------------------------- /test/add_erase_random/dtypes.h: -------------------------------------------------------------------------------- 1 | #define keytype1 integer(4) 2 | #define keytype2 integer(4) 3 | #define valtype real(4) 4 | 5 | -------------------------------------------------------------------------------- /test/get_kth/Makefile: -------------------------------------------------------------------------------- 1 | TARGET = a.out 2 | FC = gfortran 3 | DEBUG = yes 4 | vpath %.f90 ../../ 5 | 6 | ifeq ($(DEBUG),yes) 7 | FFLAGS := -cpp -Wall -Wuninitialized -O0 -g3 -fbounds-check \ 8 | -fbacktrace -fdump-core -ffpe-trap=invalid,zero,overflow -fimplicit-none \ 9 | -finit-real=snan -finit-integer=-858993460 10 | else 11 | FFLAGS := -cpp -Ofast -march=native -fbacktrace -fdump-core 12 | endif 13 | INCLUDES = -I. 14 | 15 | $(TARGET): get_kth.o dict_mod.o treap_struct.o 16 | $(FC) $(INCLUDES) $(FFLAGS) $^ -o $@ 17 | 18 | %.o: %.f90 19 | $(FC) $(INCLUDES) -c $(FFLAGS) $< 20 | 21 | %.mod: %.o %.f90 22 | @: 23 | 24 | get_kth.o: dict_mod.mod 25 | dict_mod.o: treap_struct.mod 26 | 27 | clean: 28 | rm -rf *.o *.gch *.mod *.log $(TARGET) core.* 29 | 30 | .PHONY: clean 31 | 32 | -------------------------------------------------------------------------------- /test/get_kth/dtypes.h: -------------------------------------------------------------------------------- 1 | #define keytype1 integer(4) 2 | #define keytype2 integer(4) 3 | #define valtype real(4) 4 | 5 | -------------------------------------------------------------------------------- /test/get_kth/get_kth.f90: -------------------------------------------------------------------------------- 1 | program get_kth 2 | use dict_mod, only: dict, insert_or_assign, get_val, get_kth_key 3 | implicit none 4 | 5 | integer, parameter :: n = 10000 6 | type(dict) :: t 7 | integer :: i 8 | real(4), parameter :: eps = 1e-6 9 | 10 | do i = 1, n 11 | call insert_or_assign(t, i, float(i)) 12 | end do 13 | 14 | do i = 1, n 15 | if (abs(get_val(t, get_kth_key(t, i)) - i) > eps) stop 2 16 | end do 17 | end program get_kth 18 | 19 | -------------------------------------------------------------------------------- /test/speedtest/.gitignore: -------------------------------------------------------------------------------- 1 | *.png 2 | -------------------------------------------------------------------------------- /test/speedtest/Makefile: -------------------------------------------------------------------------------- 1 | TARGET = a.out 2 | FC = gfortran 3 | DEBUG = yes 4 | vpath %.f90 ../../ 5 | 6 | ifeq ($(DEBUG),yes) 7 | FFLAGS := -cpp -Wall -Wuninitialized -O0 -g3 -fbounds-check \ 8 | -fbacktrace -fdump-core -ffpe-trap=invalid,zero,overflow -fimplicit-none \ 9 | -finit-real=snan -finit-integer=-858993460 10 | else 11 | FFLAGS := -cpp -Ofast -march=native -fbacktrace -fdump-core 12 | endif 13 | INCLUDES = -I. 14 | 15 | $(TARGET): speedtest.o dict_mod.o treap_struct.o 16 | $(FC) $(INCLUDES) $(FFLAGS) $^ -o $@ 17 | 18 | %.o: %.f90 19 | $(FC) $(INCLUDES) -c $(FFLAGS) $< 20 | 21 | %.mod: %.o %.f90 22 | @: 23 | 24 | speedtest.o: dict_mod.mod 25 | dict_mod.o: treap_struct.mod 26 | 27 | clean: 28 | rm -rf *.o *.cgh *.mod *.log $(TARGET) core.* 29 | 30 | .PHONY: clean 31 | 32 | -------------------------------------------------------------------------------- /test/speedtest/dtypes.h: -------------------------------------------------------------------------------- 1 | #define keytype1 integer(4) 2 | #define keytype2 integer(4) 3 | #define valtype real(4) 4 | 5 | -------------------------------------------------------------------------------- /test/speedtest/speedtest.f90: -------------------------------------------------------------------------------- 1 | #define jmax 20 2 | #define ljmax 16 3 | program speedtest 4 | use dict_mod, only: dict, insert_or_assign, get_val, remove, get_size, exists 5 | implicit none 6 | 7 | type linear_set 8 | integer :: cnt = 0 9 | integer :: keys(2 ** ljmax) 10 | real(4) :: vals(2 ** ljmax) 11 | end type linear_set 12 | 13 | integer :: b, j, seed(100), itr, itrmax, dt, dummy, t_rate, n 14 | real(4) :: r 15 | 16 | seed(:) = 0 17 | call random_seed(put=seed) 18 | call system_clock(dummy, t_rate) 19 | 20 | do b = 0, 1 21 | do j = 1, jmax 22 | if (b == 0 .and. j > ljmax) cycle 23 | if (b == 0) then 24 | itrmax = 2 ** (ljmax - j) 25 | else 26 | itrmax = 2 ** (jmax - j) 27 | end if 28 | 29 | dt = 0 30 | n = 2 ** j 31 | do itr = 1, itrmax 32 | if (b == 0) then 33 | dt = dt + test_linear(n) 34 | else 35 | dt = dt + test_treap(n) 36 | end if 37 | end do 38 | print *, n, dt / (dble(itrmax) * dble(t_rate) * n) 39 | end do 40 | end do 41 | 42 | contains 43 | 44 | function test_treap(n) 45 | implicit none 46 | integer, intent(in) :: n 47 | integer :: i, t1, t2 48 | integer :: a(n) 49 | integer :: test_treap 50 | type(dict) :: t 51 | do i = 1, n 52 | call random_number(r) 53 | a(i) = floor(r * n) 54 | end do 55 | 56 | call system_clock(t1) 57 | do i = 1, n 58 | call insert_or_assign(t, a(i), float(a(i))) 59 | end do 60 | call system_clock(t2) 61 | test_treap = t2 - t1 62 | end function test_treap 63 | 64 | function test_linear(n) 65 | implicit none 66 | integer, intent(in) :: n 67 | integer :: i, t1, t2 68 | integer :: a(n) 69 | type(linear_set) :: ls 70 | integer :: test_linear 71 | do i = 1, n 72 | call random_number(r) 73 | a(i) = floor(r * n) 74 | end do 75 | 76 | call system_clock(t1) 77 | do i = 1, n 78 | call linear_insert_or_assign(ls, a(i), float(a(i))) 79 | end do 80 | call system_clock(t2) 81 | test_linear = t2 - t1 82 | end function test_linear 83 | 84 | subroutine linear_insert_or_assign(ls, key, val) 85 | implicit none 86 | type(linear_set), intent(inout) :: ls 87 | integer, intent(in) :: key 88 | real(4), intent(in) :: val 89 | integer :: k 90 | 91 | k = linear_exists(ls, key) 92 | 93 | if (k > 0) then 94 | ls%vals(k) = val 95 | else 96 | ls%cnt = ls%cnt + 1 97 | ls%keys(ls%cnt) = key 98 | ls%vals(ls%cnt) = val 99 | end if 100 | end subroutine linear_insert_or_assign 101 | 102 | function linear_exists(ls, key) 103 | implicit none 104 | type(linear_set), intent(in) :: ls 105 | integer, intent(in) :: key 106 | integer :: linear_exists 107 | integer :: i 108 | linear_exists = -1 109 | do i = 1, ls%cnt 110 | if (ls%keys(i) == key) then 111 | linear_exists = i 112 | exit 113 | end if 114 | end do 115 | end function linear_exists 116 | end program speedtest 117 | 118 | -------------------------------------------------------------------------------- /test/speedtest/std_map/Makefile: -------------------------------------------------------------------------------- 1 | TARGET = a.out 2 | DEBUG = yes 3 | STD = c++17 4 | 5 | CXX = g++ 6 | ifeq ($(DEBUG),yes) 7 | CXXFLAGS = -std=$(STD) -O0 -g3 -Wall -Wextra 8 | else 9 | CXXFLAGS = -std=$(STD) -O2 -match=native 10 | endif 11 | 12 | $(TARGET): main.cc 13 | $(CXX) $(CXXFLAGS) $< -o $@ 14 | 15 | clean: 16 | rm -rf *.o *.mod *.log $(TARGET) core.* 17 | 18 | .PHONY: clean debug 19 | 20 | -------------------------------------------------------------------------------- /test/speedtest/std_map/main.cc: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | const int jmax = 22; 4 | int a[1 << jmax]; 5 | 6 | using namespace std; 7 | 8 | int main() { 9 | int i, j, n, itr, itrmax; 10 | for (j = 5; j <= jmax; j++) { 11 | itrmax = 1 << (jmax - j); 12 | double dt = 0.0; 13 | for (itr = 0; itr < itrmax; itr++) { 14 | map mp; 15 | 16 | n = 1 << j; 17 | srand(0); 18 | for (i = 0; i < n; i++) { 19 | a[i] = rand() % n; 20 | } 21 | 22 | auto t1 = chrono::high_resolution_clock::now(); 23 | for (i = 0; i < n; i++) { 24 | mp.insert_or_assign(a[i], (float) a[i]); 25 | } 26 | auto t2 = chrono::high_resolution_clock::now(); 27 | dt += (double) (t2 - t1).count(); // nanosec 28 | } 29 | cout << n << " " << dt / (n * 1.0e9 * itr) << endl; 30 | } 31 | return 0; 32 | } 33 | -------------------------------------------------------------------------------- /test/speedtest/visual/main.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | 3 | import matplotlib.pyplot as plt 4 | import numpy as np 5 | 6 | def get_linear(): 7 | res = '''32 6.1035156250000001E-008 8 | 64 9.1552734375000002E-008 9 | 128 1.3732910156249999E-007 10 | 256 2.8991699218749999E-007 11 | 512 4.2724609375000001E-007 12 | 1024 8.8500976562500004E-007 13 | 2048 1.5563964843749999E-006 14 | 4096 2.9907226562500001E-006 15 | 8192 6.0729980468750003E-006 16 | 16384 1.2283325195312501E-005 17 | 32768 2.4154663085937499E-005 18 | 65536 4.8141479492187497E-005''' 19 | return res 20 | 21 | 22 | 23 | def get_treap(): 24 | res = '''32 1.5640258789062501E-007 25 | 64 1.9550323486328124E-007 26 | 128 2.2888183593749999E-007 27 | 256 2.6035308837890627E-007 28 | 512 2.8705596923828124E-007 29 | 1024 3.1471252441406251E-007 30 | 2048 3.3760070800781248E-007 31 | 4096 3.7860870361328127E-007 32 | 8192 4.2533874511718751E-007 33 | 16384 5.0258636474609377E-007 34 | 32768 5.9700012207031250E-007 35 | 65536 6.9332122802734373E-007 36 | 131072 7.5817108154296879E-007 37 | 262144 9.6321105957031251E-007 38 | 524288 1.2388229370117187E-006 39 | 1048576 1.5335083007812501E-006''' 40 | return res 41 | 42 | def get_map(): 43 | res = '''32 3.76313e-07 44 | 64 4.38184e-07 45 | 128 4.21282e-07 46 | 256 4.59784e-07 47 | 512 4.8752e-07 48 | 1024 5.29837e-07 49 | 2048 5.59647e-07 50 | 4096 5.90503e-07 51 | 8192 6.25697e-07 52 | 16384 6.86414e-07 53 | 32768 7.49547e-07 54 | 65536 8.56623e-07 55 | 131072 1.07595e-06 56 | 262144 1.16947e-06 57 | 524288 1.30604e-06 58 | 1048576 1.44749e-06''' 59 | return res 60 | 61 | def lines_to_array(ls): 62 | res = [] 63 | for l in ls.split("\n"): 64 | n, t = l.split() 65 | res.append([float(n), float(t)]) 66 | return np.array(res).T 67 | 68 | def main(): 69 | lin = lines_to_array(get_linear()) 70 | tre = lines_to_array(get_treap()) 71 | map = lines_to_array(get_map()) 72 | 73 | plt.rcParams["font.size"] = 16 74 | fig, ax = plt.subplots(tight_layout=True) 75 | ax.loglog(lin[0], lin[1], label="Linear array") 76 | ax.loglog(tre[0], tre[1], label="This module") 77 | ax.loglog(map[0], map[1], label="std::map") 78 | ax.legend() 79 | ax.set_title("Cost of insert_or_assign") 80 | ax.set_xlabel("Number of elements") 81 | ax.set_ylabel("Time per element [sec]") 82 | fig.savefig("out.png") 83 | plt.close(fig) 84 | 85 | if __name__ == "__main__": 86 | main() 87 | -------------------------------------------------------------------------------- /test/speedtest/visual/out.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ysdtkm/fortran_associative_array/89f63efed52ef5c62a4d21bcc602222bed0b9d51/test/speedtest/visual/out.png -------------------------------------------------------------------------------- /treap_struct.f90: -------------------------------------------------------------------------------- 1 | #include 2 | module treap_struct 3 | ! Low level data structure and operations of treap. 4 | ! This allows multiple nodes with a same key. 5 | 6 | implicit none 7 | 8 | type node 9 | type(node), pointer :: left => null(), right => null() 10 | keytype1 :: key 11 | valtype :: val 12 | integer :: pri ! min-heap 13 | integer :: cnt = 1 14 | end type node 15 | 16 | contains 17 | 18 | subroutine update(root) 19 | implicit none 20 | type(node), pointer, intent(in) :: root 21 | root%cnt = my_count(root%left) + my_count(root%right) + 1 22 | end subroutine update 23 | 24 | function my_count(root) 25 | implicit none 26 | type(node), pointer, intent(in) :: root 27 | integer :: my_count 28 | if (associated(root)) then 29 | my_count = root%cnt 30 | else 31 | my_count = 0 32 | end if 33 | end function my_count 34 | 35 | function rotate_ccw(root) 36 | implicit none 37 | type(node), pointer, intent(in) :: root 38 | type(node), pointer :: tmp, rotate_ccw 39 | if (.not. associated(root%right)) stop 1 40 | tmp => root%right 41 | root%right => tmp%left 42 | tmp%left => root 43 | rotate_ccw => tmp 44 | call update(root) 45 | call update(tmp) 46 | end function rotate_ccw 47 | 48 | function rotate_cw(root) 49 | implicit none 50 | type(node), pointer, intent(in) :: root 51 | type(node), pointer :: tmp, rotate_cw 52 | if (.not. associated(root%left)) stop 1 53 | tmp => root%left 54 | root%left => tmp%right 55 | tmp%right => root 56 | rotate_cw => tmp 57 | call update(root) 58 | call update(tmp) 59 | end function rotate_cw 60 | 61 | recursive function insert(root, key, val, pri) result(res) 62 | implicit none 63 | type(node), pointer, intent(in) :: root 64 | integer, intent(in) :: pri 65 | keytype2, intent(in) :: key 66 | valtype, intent(in) :: val 67 | type(node), pointer :: res 68 | 69 | if (.not. associated(root)) then 70 | allocate(res) 71 | res%key = key 72 | res%pri = pri 73 | res%val = val 74 | else 75 | res => root 76 | if (key > root%key) then 77 | root%right => insert(root%right, key, val, pri) 78 | call update(root) 79 | if (root%pri > root%right%pri) then 80 | res => rotate_ccw(res) 81 | end if 82 | else 83 | root%left => insert(root%left, key, val, pri) 84 | call update(root) 85 | if (root%pri > root%left%pri) then 86 | res => rotate_cw(res) 87 | end if 88 | end if 89 | end if 90 | end function insert 91 | 92 | recursive function erase(root, key) result(res) 93 | implicit none 94 | type(node), pointer, intent(in) :: root 95 | keytype2, intent(in) :: key 96 | type(node), pointer :: res, tmp 97 | 98 | if (.not. associated(root)) then 99 | print *, "Erase failed" 100 | stop 1 101 | end if 102 | 103 | if (key < root%key) then 104 | root%left => erase(root%left, key) 105 | res => root 106 | else if (key > root%key) then 107 | root%right => erase(root%right, key) 108 | res => root 109 | else 110 | if ((.not. associated(root%left)) .or. (.not. associated(root%right))) then 111 | tmp => root 112 | if (.not. associated(root%left)) then 113 | res => root%right 114 | else 115 | res => root%left 116 | end if 117 | deallocate(tmp) 118 | else 119 | if (root%left%pri < root%right%pri) then 120 | res => rotate_ccw(root) 121 | res%left => erase(res%left, key) 122 | else 123 | res => rotate_cw(root) 124 | res%right => erase(res%right, key) 125 | end if 126 | end if 127 | end if 128 | if (associated(res)) call update(res) 129 | end function erase 130 | 131 | recursive function find_node(root, key) result(res) 132 | implicit none 133 | type(node), pointer, intent(in) :: root 134 | keytype2, intent(in) :: key 135 | type(node), pointer :: res 136 | if (.not. associated(root)) then 137 | res => null() 138 | else if (root%key == key) then 139 | res => root 140 | else if (key < root%key) then 141 | res => find_node(root%left, key) 142 | else 143 | res => find_node(root%right, key) 144 | end if 145 | end function find_node 146 | 147 | recursive function kth_node(root, k) result(res) 148 | implicit none 149 | type(node), pointer, intent(in) :: root 150 | integer, intent(in) :: k 151 | type(node), pointer :: res 152 | if (.not. associated(root)) then 153 | res => null() 154 | else if (k <= my_count(root%left)) then 155 | res => kth_node(root%left, k) 156 | else if (k == my_count(root%left) + 1) then 157 | res => root 158 | else 159 | res => kth_node(root%right, k - my_count(root%left) - 1) 160 | end if 161 | end function kth_node 162 | 163 | recursive subroutine delete_all(root) 164 | implicit none 165 | type(node), pointer, intent(inout) :: root 166 | if (.not. associated(root)) return 167 | 168 | call delete_all(root%left) 169 | call delete_all(root%right) 170 | deallocate(root) 171 | nullify(root) 172 | end subroutine delete_all 173 | 174 | recursive subroutine inorder(root, keys, vals, counter) 175 | implicit none 176 | type(node), pointer, intent(in) :: root 177 | keytype2, intent(inout) :: keys(:) 178 | valtype, intent(inout) :: vals(:) 179 | integer, intent(inout) :: counter 180 | if (.not. associated(root)) return 181 | 182 | call inorder(root%left, keys, vals, counter) 183 | counter = counter + 1 184 | keys(counter) = root%key 185 | vals(counter) = root%val 186 | call inorder(root%right, keys, vals, counter) 187 | end subroutine inorder 188 | end module treap_struct 189 | 190 | --------------------------------------------------------------------------------