├── .github └── workflows │ └── test.yml ├── LICENSE ├── README.md ├── examples ├── dataset.dat ├── flann_c_example.f90 ├── flann_demo.f90 ├── kdtree_benchmark_flann.f90 └── testset.dat ├── fpm.toml └── src ├── flann.f90 ├── flann_c.f90 └── flann_params.f90 /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: fpm test 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | Build: 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | fail-fast: false 10 | matrix: 11 | os: [ubuntu-latest, macos-latest] 12 | include: 13 | - os: ubuntu-latest 14 | gcc_v: 9 15 | - os: macos-latest 16 | gcc_v: 9 17 | 18 | env: 19 | FC: gfortran 20 | GCC_V: ${{ matrix.gcc_v }} 21 | 22 | steps: 23 | - name: Checkout code 24 | uses: actions/checkout@v1 25 | 26 | 27 | - name: Install GFortran macOS 28 | if: contains(matrix.os, 'macos') 29 | run: | 30 | ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran 31 | which gfortran-${GCC_V} 32 | which gfortran 33 | 34 | - name: Install GFortran Linux 35 | if: contains(matrix.os, 'ubuntu') 36 | run: | 37 | sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ 38 | --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ 39 | --slave /usr/bingcov gcov /usr/bin/gcov-${GCC_V} 40 | 41 | - name: Install fpm 42 | uses: fortran-lang/setup-fpm@v3 43 | with: 44 | github-token: ${{ secrets.GITHUB_TOKEN }} 45 | 46 | - name: Install FLANN macOS 47 | if: contains(matrix.os, 'macos') 48 | run: brew install flann 49 | 50 | - name: Install FLANN Linux 51 | if: contains(matrix.os, 'ubuntu') 52 | run: sudo apt install libflann-dev libflann1.9 53 | 54 | - name: Build library 55 | run: | 56 | gfortran --version 57 | fpm build -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2020, Ivan Pribec 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | > :warning: 3 | > WARNING: Development of the Fortran FLANN binding is ongoing. This means the API is not yet stable and might be subject to changes. Several functions remain untested. The instructions given below might not be complete. 4 | > :warning: 5 | 6 | # Fortran FLANN binding 7 | 8 | [![GitHub license](https://img.shields.io/badge/License-BSD--3-blue)](https://github.com/ivan-pi/fortran-flann/blob/master/LICENSE) 9 | [![fpm test](https://github.com/ivan-pi/fortran-flann/workflows/fpm%20test/badge.svg?branch=master&event=push)](https://github.com/ivan-pi/fortran-flann/actions) 10 | 11 | Fortran bindings to the [FLANN](https://github.com/mariusmuja/flann 12 | ) library for performing fast approximate nearest neighbor searches in high dimensional spaces. 13 | 14 | * [Minimal usage example](#minimal-usage-example) 15 | * [Installing FLANN](#installing-flann) 16 | * [Using FLANN with fpm](#using-flann-with-fpm) 17 | * [Learn more](#learn-more) 18 | * [Contributing](#contributing) 19 | 20 | ## Minimal usage example 21 | 22 | The example below shows how to use a `flann_index` instance to find the 5 nearest neighbors for 1000 random test points from a 128-dimensional data set containing 10000 points: 23 | 24 | ```fortran 25 | use flann 26 | implicit none 27 | 28 | integer, parameter :: nn = 5, d = 128, ndata = 10000, ntest = 1000 29 | 30 | real, allocatable, dimension(:,:) :: dataset, testset, dists 31 | integer, allocatable :: indexes(:,:) 32 | type(flann_index) :: idx 33 | 34 | ! Allocate data and result arrays 35 | allocate(dataset(d,n),testset(d,ntest)) 36 | allocate(indexes(nn,ntest),dists(nn,ntest)) 37 | 38 | ! Insert some random values 39 | call random_number(dataset) 40 | call random_number(testset) 41 | 42 | ! Create a FLANN index instance 43 | idx = flann_index(dataset,kdtree_index_params(trees=8),'Euclidean') 44 | call idx%build_index() 45 | 46 | ! Perform K-nearest neighbor search 47 | call idx%knn_search(testset,indexes,dists,nn,search_params(checks=128)) 48 | 49 | end 50 | ``` 51 | 52 | ## Installing FLANN 53 | 54 | On Linux you can install FLANN using the command 55 | 56 | ``` 57 | sudo apt install libflann-doc libflann-dev libflann1.9 58 | ``` 59 | 60 | Windows users can follow the instructions provided in documentation of the [original FLANN project](https://github.com/mariusmuja/flann). 61 | 62 | ## Using FLANN with `fpm` 63 | 64 | To use FLANN in your project we recommed trying the new Fortran package manager - [`fpm`](https://github.com/fortran-lang/fpm). To integrate FLANN in your project add the following lines to the `[dependencies]` section of your TOML manifest file: 65 | 66 | ```toml 67 | fortran-flann = { git = "https://github.com/ivan-pi/fortran-flann.git" } 68 | ``` 69 | 70 | ## Learn more 71 | 72 | On Linux systems, assuming you installed the target `libflann-doc` under default path settings, you can view the original project documentation with the command: 73 | ``` 74 | /usr/share/doc/flann/manual.pdf 75 | ``` 76 | where the `` is a program like Atril, Okular, Evince, or others. Since this package only contains Fortran bindings, for the most part the API follows the original project in C++, with the important difference we decided to use "snake case" across all methods. 77 | 78 | A more complete explanation of the algorithms available in FLANN can be found in the paper: 79 | 80 | > Muja, M., & Lowe, D. G. (2009). Fast approximate nearest neighbors with automatic algorithm configuration. *Proceedings of the Fourth International Conference on Computer Vision Theory and Applications - Volume 1: VISAPP, (VISIGRAPP 2009)*, pages 331-340. DOI:[10.5220/0001787803310340](https://doi.org/10.5220/0001787803310340) 81 | 82 | PDF versions can be found easily with your favorite search engine. Some working links at the time of writing (2020/12/22) include: [(link 1)](https://lear.inrialpes.fr/~douze/enseignement/2014-2015/presentation_papers/muja_flann.pdf), [(link 2)](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.160.1721&rep=rep1&type=pdf), [(link 3)](http://image.ntua.gr/iva/files/MujaLowe_ICCVTA2009%20-%20Fast%20Approximate%20Nearest%20Neighbors%20with%20Automatic%20Algorithm%20Configuration.pdf) 83 | 84 | ## Contributing 85 | 86 | Feel welcome to submit bug reports or suggest changes to the Fortran bindings by opening a new [issue](https://github.com/ivan-pi/fortran-flann/issues). 87 | 88 | If you think you are facing an issue with the underlying FLANN library, you might be able to find an answer in the [list of open/closed issues](https://github.com/mariusmuja/flann/issues) of the original FLANN project. Unfortunately, the original project has gone stale and doesn't seem to be supported anymore. 89 | 90 | Since the Fortran bindings provided here are only a wrapper of the C interface exported in the original FLANN project, we are limited to a subset of the original FLANN functionality. 91 | 92 | 93 | 94 | 95 | -------------------------------------------------------------------------------- /examples/flann_c_example.f90: -------------------------------------------------------------------------------- 1 | program test_flann 2 | 3 | use flann_c 4 | use iso_c_binding 5 | 6 | implicit none 7 | 8 | type(FLANNParameters) :: p 9 | 10 | integer, parameter :: rows = 9000 11 | integer, parameter :: cols = 128 12 | integer, parameter :: tcount = 1000 13 | 14 | integer :: nn 15 | 16 | real, allocatable :: dataset(:,:), testset(:,:) 17 | 18 | integer, allocatable :: result(:,:) 19 | real, allocatable :: dists(:,:) 20 | 21 | real :: speedup, t1, t2, t3 22 | type(c_ptr) :: index_id 23 | integer, pointer :: index_int => null() 24 | integer :: ires 25 | 26 | allocate(dataset(cols,rows),testset(cols,tcount)) 27 | 28 | write(*,*) "Reading input data file." 29 | call read_points("dataset.dat",rows,cols,dataset) 30 | 31 | write(*,*) "Reading test data file." 32 | call read_points("testset.dat",tcount,cols,testset) 33 | 34 | nn = 3 35 | 36 | p%algorithm = FLANN_INDEX_KDTREE_SINGLE 37 | p%trees = 1 38 | p%log_level = FLANN_LOG_INFO 39 | p%checks = 128 40 | p%random_seed = 12345678 41 | 42 | write(*,*) "Computing index." 43 | 44 | call cpu_time(t1) 45 | index_id = flann_build_index_float(dataset,rows,cols,speedup,p) 46 | call cpu_time(t2) 47 | print *, "Building tree ", t2 - t1, " s" 48 | 49 | call c_f_pointer(index_id,index_int) 50 | print*, "pointer to integer = ", index_int 51 | 52 | allocate(result(nn,tcount)) 53 | allocate(dists(nn,tcount)) 54 | 55 | call cpu_time(t2) 56 | ires = flann_find_nearest_neighbors_index(index_id,testset,tcount,result,dists,nn,p) 57 | call cpu_time(t3) 58 | print *, "Query time ", t3 - t2, " s" 59 | 60 | print *, "Find neighbors ", ires 61 | 62 | call print_points("results_f.dat",result,dists) 63 | 64 | 65 | ! deallocate(index_int) 66 | 67 | 68 | ires = flann_free_index(index_id,p) 69 | deallocate(dataset,testset,result,dists) 70 | 71 | print*, "Clean memory ", ires 72 | ! call print_params(p) 73 | 74 | contains 75 | 76 | subroutine read_points(fname,rows,cols,points) 77 | character(len=*), intent(in) :: fname 78 | integer, intent(in) :: rows, cols 79 | real, intent(out) :: points(cols,rows) 80 | integer :: i,j,unit 81 | 82 | open(newunit=unit,file=fname,status='old') 83 | 84 | do i = 1, rows 85 | read(unit,*) (points(j,i),j=1,cols) 86 | end do 87 | 88 | close(unit) 89 | end subroutine 90 | 91 | subroutine print_points(fname,points, dists) 92 | character(len=*), intent(in) :: fname 93 | integer, intent(in) :: points(:,:) 94 | real, intent(in), optional :: dists(:,:) 95 | 96 | integer :: i, j, unit 97 | 98 | open(newunit=unit,file=fname,action="write") 99 | print *, "Writing data to file "//fname 100 | 101 | if (present(dists)) then 102 | do i = 1, size(points,2) 103 | write(unit,*) (points(j,i),j=1,size(points,1)), (dists(j,i),j=1,size(dists,1)) 104 | end do 105 | else 106 | do i = 1, size(points,2) 107 | write(unit,'(*(i0,:," "))') (points(j,i),j=1,size(points,1)) 108 | end do 109 | end if 110 | 111 | close(unit) 112 | end subroutine 113 | 114 | subroutine print_params(p) 115 | type(FLANNParameters), intent(in) :: p 116 | 117 | print '("algorithm ",(i0))',p%algorithm 118 | print '("checks ",(i0))',p%checks 119 | print '("eps ",(g0))',p%eps 120 | print '("sorted ",(i0))',p%sorted 121 | print '("max_neighbors ",(i0))',p%max_neighbors 122 | print '("cores ",(i0))',p%cores 123 | print '("trees ",(i0))',p%trees 124 | print '("leaf_max_size ",(i0))',p%leaf_max_size 125 | print '("branching ",(i0))',p%branching 126 | print '("iterations ",(i0))',p%iterations 127 | print '("centers_init ",(i0))',p%centers_init 128 | print '("cb_index ",(g0))',p%cb_index 129 | print '("target_precision ",(g0))',p%target_precision 130 | print '("build_weight ",(g0))',p%build_weight 131 | print '("memory_weight ",(g0))',p%memory_weight 132 | print '("sample_fraction ",(g0))',p%sample_fraction 133 | print '("table_number_ ",(i0))',p%table_number_ 134 | print '("key_size_ ",(i0))',p%key_size_ 135 | print '("multi_probe_level_ ",(i0))',p%multi_probe_level_ 136 | print '("log_level ",(i0))',p%log_level 137 | print '("random_seed ",(i0))',p%random_seed 138 | 139 | end subroutine 140 | 141 | end program -------------------------------------------------------------------------------- /examples/flann_demo.f90: -------------------------------------------------------------------------------- 1 | program flann_demo 2 | 3 | use iso_c_binding 4 | use flann 5 | 6 | implicit none 7 | 8 | integer, parameter :: nn = 3 9 | integer, parameter :: npoints = 9000 10 | integer, parameter :: dim = 128 11 | 12 | integer, parameter :: qcount = 1000 13 | 14 | real(c_float), allocatable :: dataset(:,:) 15 | real(c_float), allocatable :: query(:,:) 16 | 17 | type(flann_index) :: idx 18 | 19 | integer, allocatable :: indices(:,:) 20 | real(c_float), allocatable :: dists(:,:) 21 | 22 | call flann_log_verbosity(FLANN_LOG_DEBUG) 23 | 24 | allocate(dataset(dim,npoints)) 25 | allocate(query(dim,qcount)) 26 | 27 | call random_number(dataset) 28 | call random_number(query) 29 | 30 | !! Construct a randomized kd-tree index using 4 kd-trees 31 | idx = flann_index(dataset,KDTreeSingleIndexParams(),'Euclidean') 32 | 33 | call idx%build_index() 34 | 35 | allocate(indices(nn,qcount)) 36 | allocate(dists(nn,qcount)) 37 | 38 | indices = 0 39 | dists = 0 40 | 41 | !! Perform a knn searh, using 128 checks 42 | call idx%knn_search(query,indices,dists,nn,search_params(checks=128)) 43 | 44 | end program 45 | -------------------------------------------------------------------------------- /examples/kdtree_benchmark_flann.f90: -------------------------------------------------------------------------------- 1 | program kdtree_benchmark_flann 2 | 3 | use iso_c_binding 4 | use flann_c 5 | implicit none 6 | 7 | real(c_float), allocatable :: data(:,:) ! n by m 8 | real(c_float), allocatable :: queries(:,:) ! r by m 9 | 10 | type(FLANNParameters) :: params 11 | type(c_ptr) :: index_id = c_null_ptr 12 | real(c_float) :: speedup 13 | integer(c_int) :: ires 14 | 15 | real :: t0, t1, t2 16 | integer(c_int), parameter :: nn = 1 17 | integer, parameter :: m(3) = [3, 8, 16] 18 | integer, parameter :: n = 10000, r = 1000 19 | integer(c_int), allocatable :: idxs(:,:) 20 | real(c_float), allocatable :: dists(:,:) 21 | integer :: i, s 22 | integer, allocatable :: seed(:) 23 | 24 | call random_seed(size=s) 25 | allocate(seed(s)) 26 | seed = 1234 27 | call random_seed(put=seed) 28 | 29 | ! params comes initialized by default 30 | params%algorithm = FLANN_INDEX_KDTREE_SINGLE 31 | params%trees = 1 32 | params%log_level = FLANN_LOG_INFO 33 | 34 | allocate(idxs(nn,r)) 35 | ! idxs = 0 36 | allocate(dists(nn,r)) 37 | ! dists = 0 38 | 39 | do i = 1, 3 40 | 41 | write(*,*) "Dimension = ", m(i) 42 | 43 | ! FLANN expects a pointer to a rows x cols matrix stored in 44 | ! row-major order (one feature/data-point on each row). 45 | ! Since Fortran follows column major ordering, we must 46 | ! swap the dimensions. 47 | 48 | allocate(data(m(i),n)) 49 | call random_number(data) 50 | 51 | allocate(queries(m(i),r)) 52 | call random_number(queries) 53 | 54 | ! Populate tree 55 | call cpu_time(t0) 56 | ! call c_f_pointer(index_id,index_int) 57 | index_id = flann_build_index_float(data,n,m(i),speedup,params) 58 | call cpu_time(t1) 59 | 60 | ! Query random vectors 61 | ires = flann_find_nearest_neighbors_index_float(index_id,queries,r,idxs,dists,nn,params) 62 | call cpu_time(t2) 63 | 64 | write(*,*) "Tree build (s): ", t1 - t0 65 | write(*,*) "Tree query (s): ", t2 - t1 66 | 67 | ires = flann_free_index_float(index_id,params) 68 | deallocate(data) 69 | deallocate(queries) 70 | 71 | end do 72 | 73 | end program 74 | -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "fortran-flann" 2 | license = "BSD-2-Clause" 3 | author = "Ivan Pribec" 4 | maintainer = "ivan.pribec@gmail.com" 5 | copyright = "Copyright 2020 Ivan Pribec" 6 | description = "Fortran bindings to the FLANN library for approximate nearest neighbor searches" 7 | homepage = "https://github.com/ivan-pi/fortran-flann/" 8 | 9 | [library] 10 | source-dir = "src" 11 | 12 | [build] 13 | link = "flann" -------------------------------------------------------------------------------- /src/flann.f90: -------------------------------------------------------------------------------- 1 | module flann 2 | 3 | use iso_c_binding, only: c_ptr, c_float, c_int 4 | use flann_c 5 | use flann_params 6 | 7 | implicit none 8 | private 9 | 10 | integer, parameter :: wp = c_float 11 | 12 | ! 13 | ! Exposed constant from flann_c 14 | ! 15 | ! 16 | ! flann_centers_init_t 17 | public :: FLANN_CENTERS_RANDOM 18 | public :: FLANN_CENTERS_GONZALES 19 | public :: FLANN_CENTERS_KMEANSPP 20 | public :: FLANN_CENTERS_GROUPWISE 21 | 22 | ! 23 | ! flann_log_level_t 24 | public :: FLANN_LOG_NONE 25 | public :: FLANN_LOG_FATAL 26 | public :: FLANN_LOG_ERROR 27 | public :: FLANN_LOG_WARN 28 | public :: FLANN_LOG_INFO 29 | public :: FLANN_LOG_DEBUG 30 | 31 | ! 32 | ! flann_distance_t 33 | public :: FLANN_DIST_EUCLIDEAN 34 | public :: FLANN_DIST_L2 35 | public :: FLANN_DIST_MANHATTAN 36 | public :: FLANN_DIST_L1 37 | public :: FLANN_DIST_MINKOWSKI 38 | public :: FLANN_DIST_MAX 39 | public :: FLANN_DIST_HIST_INTERSECT 40 | public :: FLANN_DIST_HELLINGER 41 | public :: FLANN_DIST_CHI_SQUARE 42 | public :: FLANN_DIST_KULLBACK_LEIBLER 43 | public :: FLANN_DIST_HAMMING 44 | public :: FLANN_DIST_HAMMING_LUT 45 | public :: FLANN_DIST_HAMMING_POPCNT 46 | public :: FLANN_DIST_L2_SIMPLE 47 | 48 | ! 49 | ! Exposed entities from `flann_params` module. 50 | ! 51 | public :: flann_log_verbosity 52 | !! Set the log verbosity level. 53 | public :: search_params 54 | public :: LinearIndexParams 55 | public :: KDTreeIndexParams 56 | public :: KMeansIndexParams 57 | public :: CompositeIndexParams 58 | public :: KDTreeSingleIndexParams 59 | public :: HierarchicalClusteringIndexParams 60 | public :: LshIndexParams 61 | public :: AutotunedIndexParams 62 | 63 | ! 64 | ! Public entities from this module 65 | ! 66 | public :: flann_index 67 | !! The FLANN nearest neighbor type. 68 | public :: flann_hierarchical_clustering 69 | !! Clusters the given points by constructing a hierarchical k-means tree 70 | !! and choosing a cut in the tree that minimized the clusters' variance. 71 | 72 | 73 | !> The FLANN nearest neighbor index type. 74 | ! 75 | ! This derived type is used to abstract different types of 76 | ! nearest neighbor search indexes. 77 | type flann_index 78 | type(c_ptr) :: index_id = c_null_ptr 79 | type(FLANNParameters) :: params 80 | real(wp), pointer :: points(:,:) => null() 81 | integer(c_int) :: rows, cols 82 | contains 83 | private 84 | procedure :: build_index_v1 85 | procedure :: build_index_v2 86 | generic, public :: build_index => build_index_v1, build_index_v2 87 | !! Build the nearest neighbor index. There are two versions of 88 | !! this method, one that uses the points provided as argument and 89 | !! one that uses the the points provided when the object was 90 | !! constructed. 91 | procedure, public :: knn_search => index_knn_search 92 | !! Performs a K-nearest neighbor search for a set of query points. 93 | procedure, public :: radius_search => index_radius_search 94 | !! Performs a radius nearest neighbor search for a set of query points. 95 | procedure, public :: save => index_save 96 | !! Saves the index to a file. 97 | procedure, public :: veclen => index_veclen 98 | !! Returns number of features in this index. 99 | procedure, public :: size => index_size 100 | !! Returns the dimensionality of the points in this index. 101 | procedure, public :: get_type => index_get_type 102 | !! Returns the index type (kdtree, kmeans, ...). 103 | procedure, public :: used_memory => index_used_memory 104 | !! Returns the amount of memory (in bytes) used by the index. 105 | procedure, public :: get_parameters => index_get_parameters 106 | !! Returns the Index Parameters. 107 | final :: index_free 108 | end type 109 | 110 | interface flann_index 111 | !! Overload the structure constructor. 112 | module procedure index_new_int 113 | module procedure index_new_char 114 | module procedure index_new_int_points 115 | module procedure index_new_char_points 116 | end interface 117 | 118 | contains 119 | 120 | function distance_helper(distance) result(d) 121 | character(len=*), intent(in) :: distance 122 | integer(c_int) :: d 123 | 124 | character(len=:), allocatable :: upper 125 | upper = uppercase(trim(distance)) 126 | 127 | select case(upper) 128 | case('EUCLIDEAN','L2') 129 | d = FLANN_DIST_EUCLIDEAN 130 | case('MANHATTAN','L1') 131 | d = FLANN_DIST_MANHATTAN 132 | case('MINKOWSKI') 133 | d = FLANN_DIST_MINKOWSKI 134 | case('MAX_DIST') 135 | d = FLANN_DIST_MAX 136 | case('HIK','HIST_INTERSECT') 137 | d = FLANN_DIST_HIST_INTERSECT 138 | case('HELLINGER') 139 | d = FLANN_DIST_HELLINGER 140 | case('CS','CHI_SQUARE') 141 | d = FLANN_DIST_CHI_SQUARE 142 | case('KL','KULLBACK_LEIBLER') 143 | d = FLANN_DIST_KULLBACK_LEIBLER 144 | ! case('HAMMING') 145 | ! d = FLANN_DIST_HAMMING 146 | ! case('HAMMING_LUT') 147 | ! d = FLANN_DIST_HAMMING_LUT 148 | ! case('HAMMING_POPCNT') 149 | ! d = FLANN_DIST_HAMMING_POPCNT 150 | case('L2_SIMPLE') 151 | d = FLANN_DIST_L2_SIMPLE 152 | case default 153 | ! Unsupported flann_distance_t (an error will be raised on the C interface level.) 154 | d = 999 155 | end select 156 | 157 | contains 158 | 159 | function uppercase(str) result(upper_str) 160 | character(len=*), intent(in) :: str 161 | character(len=len(str)) :: upper_str 162 | integer :: i, ic, k 163 | character(len=26), parameter :: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 164 | character(len=26), parameter :: lower_case = 'abcdefghijklmnopqrstuvwxyz' 165 | 166 | do i = 1, len(str) 167 | ic = iachar(str(i:i)) 168 | if (ic >= iachar('a') .and. ic <= iachar('z')) then 169 | ! lower case 170 | k = index(lower_case,str(i:i)) 171 | upper_str(i:i) = upper_case(k:k) 172 | else 173 | ! upper case or non-alphabetic 174 | upper_str(i:i) = str(i:i) 175 | end if 176 | end do 177 | end function 178 | 179 | end function 180 | 181 | ! function Index_empty_char(params,distance) result(this) 182 | ! type(FLANNParameters), intent(in) :: params 183 | ! character(len=*), intent(in) :: distance 184 | ! type(flann_index) :: this 185 | 186 | 187 | 188 | ! end function 189 | 190 | function index_new_int(params,distance,order) result(this) 191 | type(FLANNParameters), intent(in) :: params 192 | integer(c_int), intent(in) :: distance 193 | integer(c_int), intent(in), optional :: order 194 | type(flann_index) :: this 195 | integer(c_int) :: order_ 196 | 197 | this%params = params 198 | 199 | order_ = 2 ! Euclidean distance 200 | if (present(order)) order_ = order 201 | 202 | call flann_set_distance_type(distance,order_) 203 | end function 204 | 205 | function index_new_char(params,distance,order) result(this) 206 | type(FLANNParameters), intent(in) :: params 207 | character(len=*), intent(in) :: distance 208 | integer(c_int), intent(in), optional :: order 209 | type(flann_index) :: this 210 | this = index_new_int(params,distance_helper(distance),order) 211 | end function 212 | 213 | function index_new_int_points(points,params,distance,order) result(this) 214 | real(wp), intent(in), target :: points(:,:) 215 | !! Array containing the points (features) that should be indexed, 216 | !! stored in a column-major order (one point/feature per column). 217 | !! The shape of the matrix is *(dimensionality)* × *(number of features)*. 218 | type(FLANNParameters), intent(in) :: params 219 | !! Structure containing the index parameters. 220 | integer(c_int), intent(in) :: distance 221 | integer(c_int), intent(in), optional :: order 222 | 223 | type(flann_index) :: this 224 | integer(c_int) :: order_ 225 | intrinsic :: size 226 | 227 | this%points => points 228 | this%rows = size(this%points,1) 229 | this%cols = size(this%points,2) 230 | 231 | this%params = params 232 | 233 | order_ = 2 ! Euclidean distance 234 | if (present(order)) order_ = order 235 | call flann_set_distance_type(distance,order_) 236 | 237 | end function 238 | 239 | function index_new_char_points(points,params,distance,order) result(this) 240 | real(wp), intent(in), target :: points(:,:) 241 | !! Array containing the points (features) that should be indexed, 242 | !! stored in a column-major order (one point/feature per column). 243 | !! The shape of the matrix is *(dimensionality)* × *(number of features)*. 244 | type(FLANNParameters), intent(in) :: params 245 | !! Structure containing the index parameters. 246 | character(len=*), intent(in) :: distance 247 | integer(c_int), intent(in), optional :: order 248 | 249 | type(flann_index) :: this 250 | 251 | this = index_new_int_points(points,params,distance_helper(distance),order) 252 | end function 253 | 254 | subroutine build_index_v1(self,speedup) 255 | class(flann_index), intent(inout) :: self 256 | real(c_float), intent(out), optional :: speedup 257 | 258 | real(c_float) :: speedup_ 259 | 260 | associate(points => self%points, & 261 | rows => self%rows, & 262 | cols => self%cols, & 263 | params => self%params) 264 | self%index_id = flann_build_index_float(points,cols,rows,speedup_,params) 265 | end associate 266 | if (present(speedup)) speedup = speedup_ 267 | end subroutine 268 | 269 | subroutine build_index_v2(self,points,speedup) 270 | class(flann_index), intent(inout) :: self 271 | real(wp), intent(in), target :: points(:,:) 272 | real(c_float), intent(out), optional :: speedup 273 | 274 | real(c_float) :: speedup_ 275 | intrinsic :: size 276 | 277 | self%points => points 278 | self%rows = size(self%points,1) 279 | self%cols = size(self%points,2) 280 | 281 | associate(points => self%points, & 282 | rows => self%rows, & 283 | cols => self%cols, & 284 | params => self%params) 285 | self%index_id = flann_build_index_float(points,cols,rows,speedup_,params) 286 | end associate 287 | if (present(speedup)) speedup = speedup_ 288 | end subroutine 289 | 290 | subroutine index_knn_search(self,queries,indices,dists,knn,params,stat) 291 | class(flann_index), intent(inout) :: self 292 | real(wp), intent(in) :: queries(:,:) 293 | !! Array containing the query points. 294 | !! Size of the array is *(dimensionality)* × *(number of queries)* 295 | integer(c_int), intent(inout) :: indices(:,:) 296 | !! Array that will contain the distances to the K-nearest neighbors found 297 | !! (size should be at least *(knn)* × *(number of queries)*). 298 | real(wp), intent(inout) :: dists(:,:) 299 | !! Array that will contain the distances to the K-nearest neighbors found 300 | !! (size should be at least *(knn)* × *(number of queries)*). 301 | !! Note: For Euclidean distances, FLANN computes squared distances, so the 302 | !! values returned here are squared distances as well. 303 | integer(c_int), intent(in) :: knn 304 | !! Number of nearest neighbors to search for. 305 | type(search_params), intent(in) :: params 306 | !! Search parameters. Structure containing parameters used during search. 307 | integer(c_int), intent(out), optional :: stat 308 | 309 | integer(c_int) :: stat_, qcols 310 | 311 | call copy_search_params(self%params,params) 312 | 313 | qcols = size(queries,2) 314 | 315 | if (size(indices,1) /= knn) error stop "Error in knnSearch 1" 316 | if (size(indices,2) /= qcols) error stop "Error in knnSearch 2" 317 | if (any(shape(indices) /= shape(dists))) error stop "Error in knnSearch 3" 318 | ! assert(size(indices,1) == knn) 319 | ! assert(size(indices,2) == qcols) 320 | ! assert(all(shape(indices) == shape(dists))) 321 | 322 | print *, c_associated(self%index_id) 323 | print *, "veclen", self%veclen(), "size ", self%size(), "qdims ", size(queries,1) 324 | 325 | 326 | print *,associated(self%points), shape(self%points) 327 | 328 | stat_ = flann_find_nearest_neighbors_index_float(self%index_id, & 329 | queries,qcols,indices,dists,knn,self%params) 330 | 331 | if (present(stat)) then 332 | stat = stat_ 333 | else 334 | if (stat_ /= 0) then 335 | error stop "Error in knnSearch" 336 | end if 337 | end if 338 | 339 | end subroutine 340 | 341 | subroutine index_radius_search(self,query,radius,indices,dists,nfound,params,stat) 342 | class(flann_index), intent(inout) :: self 343 | real(wp), intent(in) :: query(:) 344 | !! A single query point. 345 | real(wp), intent(in) :: radius 346 | !! Search radius (squared radius for Euclidean metric). 347 | integer(c_int), intent(out) :: indices(:) 348 | real(wp), intent(out) :: dists(size(indices)) 349 | integer(c_int), intent(out) :: nfound 350 | type(search_params), intent(in) :: params 351 | integer(c_int), intent(out), optional :: stat 352 | 353 | integer(c_int) :: stat_, max_nn 354 | 355 | ! assert(size(indices) == size(dists)) 356 | ! assert(size(queries) = self%rows) 357 | 358 | max_nn = size(indices) 359 | call copy_search_params(self%params,params) 360 | 361 | associate(index_id => self%index_id, & 362 | params => self%params) 363 | stat_ = flann_radius_search(index_id,query,indices,dists,max_nn,radius,params) 364 | end associate 365 | nfound = stat_ 366 | if (present(stat)) then 367 | stat = stat_ 368 | else 369 | if (stat < 0) then 370 | error stop "Error during radiusSearch." 371 | end if 372 | end if 373 | end subroutine 374 | 375 | !> Saves the index to a file. 376 | ! 377 | subroutine index_save(self,filename,stat) 378 | use iso_c_binding, only: c_null_char 379 | class(flann_index), intent(in) :: self 380 | character(len=*), intent(in) :: filename 381 | !! The file to save the index to 382 | integer(c_int), intent(out), optional :: stat 383 | !! Status flag. Zero on success, negative value on error. 384 | integer(c_int) :: stat_ 385 | 386 | ! int flann_save_index(flann_index_t index_id,char* filename); 387 | stat_ = flann_save_index_float(self%index_id,filename//c_null_char) 388 | if(present(stat)) then 389 | stat_ = stat 390 | else 391 | if (stat_ /= 0) then 392 | error stop "Error saving file." 393 | end if 394 | end if 395 | 396 | end subroutine 397 | 398 | subroutine index_free(self) 399 | type(flann_index), intent(inout) :: self 400 | 401 | integer(c_int) :: stat_ 402 | 403 | if(associated(self%points)) nullify(self%points) 404 | 405 | if (c_associated(self%index_id)) then 406 | stat_ = flann_free_index_float(self%index_id, self%params) 407 | if (stat_ /= 0) then 408 | write(*,*) "An error occured while freeing the index_id." 409 | write(*,*) "Stat = ", stat_ 410 | end if 411 | end if 412 | end subroutine 413 | 414 | !> Returns number of features (points) in this index. 415 | ! 416 | integer(c_int) function index_veclen(self) result(veclen) 417 | class(flann_index), intent(in) :: self 418 | veclen = self%cols 419 | end function 420 | 421 | !> Returns the dimensionality of the points in this index. 422 | ! 423 | integer(c_int) function index_size(self) result(size) 424 | class(flann_index), intent(in) :: self 425 | size = self%rows 426 | end function 427 | 428 | !> Returns the index type (kdtree, kmeans, ...). 429 | ! 430 | integer(c_int) function index_get_type(self) result(type) 431 | class(flann_index), intent(in) :: self 432 | type = self%params%algorithm 433 | end function 434 | 435 | !> Returns the amount of memory (in bytes) used by the index. 436 | ! 437 | integer(c_int) function index_used_memory(self) result(used_memory) 438 | class(flann_index), intent(in) :: self 439 | 440 | ! Retrieve the amount of memory on the C side. 441 | used_memory = flann_used_memory_float(self%index_id) 442 | 443 | ! Add the size of the meta-data stored on Fortran side 444 | ! TODO: Verify if storage_size returns a multiple of 8. 445 | used_memory = used_memory + storage_size(self)/8 446 | end function 447 | 448 | !> Returns the Index Parameters. 449 | ! 450 | type(FLANNParameters) function index_get_parameters(self) result(params) 451 | class(flann_index), intent(in) :: self 452 | params = self%params 453 | end function 454 | 455 | !> Clusters the given points by constructing a hierarchical k-means tree and 456 | ! and choosing a cut in the tree that minimizes the clusters' variance. 457 | ! 458 | subroutine flann_hierarchical_clustering(points,clusters,centers,params,distance,order,stat) 459 | real(wp), intent(in) :: points(:,:) 460 | !! The points to be clustered. 461 | integer, intent(inout) :: clusters 462 | !! On input contains the number of clusters desired. On output contains 463 | !! the number of clusters computed. If an error occured a value < 0 is returned. 464 | real(wp), intent(out) :: centers(size(points,1),clusters) 465 | !! The centers of the clusters obtained. The number of rows 466 | !! in this array should match the number of clusters desired 467 | !! (`size(centers,1) == clusters`). However, because of the way 468 | !! the cut in the hierarchical tree is choosen, the number of clusters 469 | !! computer will be the highest number of the form `(branching - 1)*k + 1` 470 | !! that's lower than the number of clusters desired, where `branching` is 471 | !! is the tree's branching factor. 472 | type(FLANNParameters), intent(in) :: params 473 | !! Parameters used in the construction of the hierarchical k-means tree 474 | !! using KMeansIndexParams(). 475 | integer(c_int), intent(in) :: distance 476 | integer(c_int), intent(in), optional :: order 477 | integer(c_int), intent(out), optional :: stat 478 | 479 | integer(c_int) :: rows, cols, order_ 480 | 481 | rows = size(points,1) 482 | cols = size(points,2) 483 | 484 | order_ = 2 485 | if (present(order)) order_ = order 486 | call flann_set_distance_type(distance,order_) 487 | 488 | clusters = flann_compute_cluster_centers(points,rows,cols,clusters,centers,params) 489 | 490 | if (present(stat)) then 491 | if (clusters >= 0) then 492 | stat = 0 493 | else 494 | stat = clusters 495 | end if 496 | else 497 | if (clusters < 0) then 498 | error stop "Error computing clusters." 499 | end if 500 | end if 501 | end subroutine 502 | 503 | end module 504 | -------------------------------------------------------------------------------- /src/flann_c.f90: -------------------------------------------------------------------------------- 1 | module flann_c 2 | 3 | use iso_c_binding 4 | implicit none 5 | 6 | public 7 | 8 | ! 9 | ! Nearest neighbour index algorithms 10 | ! flann_algorithm_t 11 | integer(c_int), parameter :: FLANN_INDEX_LINEAR = 0 12 | integer(c_int), parameter :: FLANN_INDEX_KDTREE = 1 13 | integer(c_int), parameter :: FLANN_INDEX_KMEANS = 2 14 | integer(c_int), parameter :: FLANN_INDEX_COMPOSITE = 3 15 | integer(c_int), parameter :: FLANN_INDEX_KDTREE_SINGLE = 4 16 | integer(c_int), parameter :: FLANN_INDEX_HIERARCHICAL = 5 17 | integer(c_int), parameter :: FLANN_INDEX_LSH = 6 18 | integer(c_int), parameter :: FLANN_INDEX_KDTREE_CUDA = 7 19 | integer(c_int), parameter :: FLANN_INDEX_SAVED = 254 20 | integer(c_int), parameter :: FLANN_INDEX_AUTOTUNED = 255 21 | 22 | ! 23 | ! flann_centers_init_t 24 | integer(c_int), parameter :: FLANN_CENTERS_RANDOM = 0 25 | integer(c_int), parameter :: FLANN_CENTERS_GONZALES = 1 26 | integer(c_int), parameter :: FLANN_CENTERS_KMEANSPP = 2 27 | integer(c_int), parameter :: FLANN_CENTERS_GROUPWISE = 3 28 | 29 | ! 30 | ! flann_log_level_t 31 | integer(c_int), parameter :: FLANN_LOG_NONE = 0 32 | integer(c_int), parameter :: FLANN_LOG_FATAL = 1 33 | integer(c_int), parameter :: FLANN_LOG_ERROR = 2 34 | integer(c_int), parameter :: FLANN_LOG_WARN = 3 35 | integer(c_int), parameter :: FLANN_LOG_INFO = 4 36 | integer(c_int), parameter :: FLANN_LOG_DEBUG = 5 37 | 38 | ! 39 | ! flann_distance_t 40 | integer(c_int), parameter :: FLANN_DIST_EUCLIDEAN = 1 41 | integer(c_int), parameter :: FLANN_DIST_L2 = 1 42 | integer(c_int), parameter :: FLANN_DIST_MANHATTAN = 2 43 | integer(c_int), parameter :: FLANN_DIST_L1 = 2 44 | integer(c_int), parameter :: FLANN_DIST_MINKOWSKI = 3 45 | integer(c_int), parameter :: FLANN_DIST_MAX = 4 46 | integer(c_int), parameter :: FLANN_DIST_HIST_INTERSECT = 5 47 | integer(c_int), parameter :: FLANN_DIST_HELLINGER = 6 48 | integer(c_int), parameter :: FLANN_DIST_CHI_SQUARE = 7 49 | integer(c_int), parameter :: FLANN_DIST_KULLBACK_LEIBLER = 8 50 | integer(c_int), parameter :: FLANN_DIST_HAMMING = 9 51 | integer(c_int), parameter :: FLANN_DIST_HAMMING_LUT = 10 52 | integer(c_int), parameter :: FLANN_DIST_HAMMING_POPCNT = 11 53 | integer(c_int), parameter :: FLANN_DIST_L2_SIMPLE = 12 54 | 55 | ! 56 | ! flann_datatype_t 57 | integer(c_int), parameter :: FLANN_NONE = -1 58 | integer(c_int), parameter :: FLANN_INT8 = 0 59 | integer(c_int), parameter :: FLANN_INT16 = 1 60 | integer(c_int), parameter :: FLANN_INT32 = 2 61 | integer(c_int), parameter :: FLANN_INT64 = 3 62 | integer(c_int), parameter :: FLANN_UINT8 = 4 63 | integer(c_int), parameter :: FLANN_UINT16 = 5 64 | integer(c_int), parameter :: FLANN_UINT32 = 6 65 | integer(c_int), parameter :: FLANN_UINT64 = 7 66 | integer(c_int), parameter :: FLANN_FLOAT32 = 8 67 | integer(c_int), parameter :: FLANN_FLOAT64 = 9 68 | 69 | ! 70 | ! flann_checks_t 71 | integer(c_int), parameter :: FLANN_CHECKS_UNLIMITED = -1 72 | integer(c_int), parameter :: FLANN_CHECKS_AUTOTUNED = -2 73 | 74 | 75 | type, bind(c) :: FLANNParameters 76 | 77 | integer(c_int) :: algorithm = FLANN_INDEX_KDTREE ! the algorithm to use 78 | 79 | ! search time parameters 80 | integer(c_int) :: checks = 32 ! how many leafs (features) to check in one search 81 | real(c_float) :: eps = 0.0_c_float ! eps parameter for eps-knn search 82 | integer(c_int) :: sorted = 0 ! indicates if results returned by radius search should be sorted or not 83 | integer(c_int) :: max_neighbors = -1 ! limits the maximum number of neighbors should be returned by radius search 84 | integer(c_int) :: cores = 0 ! number of paralel cores to use for searching 85 | 86 | ! kdtree index parameters 87 | integer(c_int) :: trees = 4 ! number of randomized trees to use (for kdtree) 88 | integer(c_int) :: leaf_max_size = 4 89 | 90 | ! kmeans index parameters 91 | integer(c_int) :: branching = 32 ! branching factor (for kmeans tree) 92 | integer(c_int) :: iterations = 11 ! max iterations to perform in one kmeans cluetering (kmeans tree) 93 | integer(c_int) :: centers_init = FLANN_CENTERS_RANDOM ! algorithm used for picking the initial cluster centers for kmeans tree 94 | real(c_float) :: cb_index = 0.2_c_float ! cluster boundary index. Used when searching the kmeans tree 95 | 96 | ! autotuned index parameters 97 | real(c_float) :: target_precision = 0.9_c_float ! precision desired (used for autotuning, -1 otherwise) 98 | real(c_float) :: build_weight = 0.01_c_float ! build tree time weighting factor 99 | real(c_float) :: memory_weight = 0 ! index memory weigthing factor 100 | real(c_float) :: sample_fraction = 0.1_c_float ! what fraction of the dataset to use for autotuning 101 | 102 | ! LSH parameters 103 | integer(c_int) :: table_number_ = 0 ! The number of hash tables to use 104 | integer(c_int) :: key_size_ = 0 ! The length of the key in the hash tables 105 | integer(c_int) :: multi_probe_level_ = 0 ! Number of levels to use in multi-probe LSH, 0 for standard LSH 106 | 107 | ! other parameters 108 | integer(c_int) :: log_level = FLANN_LOG_NONE ! determines the verbosity of each flann function 109 | integer(c_long) :: random_seed = 0 ! random seed to use 110 | end type 111 | 112 | 113 | interface 114 | ! 115 | ! Sets the log level used for all flann functions (unless 116 | ! specified in FLANNParameters for each call 117 | ! 118 | ! Params: 119 | ! level = verbosity level 120 | ! 121 | subroutine flann_log_verbosity(level) bind(c,name="flann_log_verbosity") 122 | import c_int 123 | integer(c_int), value :: level 124 | end subroutine 125 | 126 | ! 127 | ! Sets the distance type to use throughout FLANN. 128 | ! If distance type specified is MINKOWSKI, the second argument 129 | ! specifies which order the minkowski distance should have. 130 | ! 131 | subroutine flann_set_distance_type(distance_type,order) bind(c,name="flann_set_distance_type") 132 | import c_int 133 | integer(c_int), value :: distance_type 134 | integer(c_int), value :: order 135 | end subroutine 136 | 137 | ! 138 | ! Gets the distance type in use throughout FLANN. 139 | ! 140 | integer(c_int) function flann_get_distance_type() bind(c,name="flann_get_distance_type") 141 | import c_int 142 | end function 143 | 144 | ! 145 | ! Gets the distance order in use throughout FLANN (only applicable if minkowski distance 146 | ! is in use). 147 | ! 148 | integer(c_int) function flann_get_distance_order() bind(c,name="flann_get_distance_order") 149 | import c_int 150 | end function 151 | 152 | ! 153 | ! Builds and returns an index. It uses autotuning if the target_precision field of index_params 154 | ! is between 0 and 1, or the parameters specified if it's -1. 155 | ! 156 | ! Params: 157 | ! dataset = pointer to a data set stored in row major order 158 | ! rows = number of rows (features) in the dataset 159 | ! cols = number of columns in the dataset (feature dimensionality) 160 | ! speedup = speedup over linear search, estimated if using autotuning, output parameter 161 | ! index_params = index related parameters 162 | ! flann_params = generic flann parameters 163 | ! 164 | ! Returns: the newly created index or a number <0 for error 165 | ! 166 | type(c_ptr) function flann_build_index(dataset,rows,cols,speedup,flann_params) bind(c,name="flann_build_index") 167 | import c_float, c_int, c_ptr, FLANNParameters 168 | integer(c_int), intent(in), value :: rows 169 | integer(c_int), intent(in), value :: cols 170 | real(c_float), intent(in) :: dataset(cols,rows) 171 | real(c_float), intent(out) :: speedup 172 | type(FLANNParameters), intent(in) :: flann_params 173 | end function 174 | type(c_ptr) function flann_build_index_float(dataset,rows,cols,speedup,flann_params) bind(c,name="flann_build_index_float") 175 | import c_float, c_int, c_ptr, FLANNParameters 176 | integer(c_int), intent(in), value :: rows 177 | integer(c_int), intent(in), value :: cols 178 | real(c_float), intent(in) :: dataset(cols,rows) 179 | real(c_float), intent(out) :: speedup 180 | type(FLANNParameters), intent(in) :: flann_params 181 | end function 182 | type(c_ptr) function flann_build_index_double(dataset,rows,cols,speedup,flann_params) bind(c,name="flann_build_index_float") 183 | import c_float, c_int, c_ptr, c_double, FLANNParameters 184 | integer(c_int), intent(in), value :: rows 185 | integer(c_int), intent(in), value :: cols 186 | real(c_double), intent(in) :: dataset(cols,rows) 187 | real(c_float), intent(out) :: speedup 188 | type(FLANNParameters), intent(in) :: flann_params 189 | end function 190 | type(c_ptr) function flann_build_index_int(dataset,rows,cols,speedup,flann_params) bind(c,name="flann_build_index_float") 191 | import c_float, c_int, c_ptr, FLANNParameters 192 | integer(c_int), intent(in), value :: rows 193 | integer(c_int), intent(in), value :: cols 194 | integer(c_int), intent(in) :: dataset(cols,rows) 195 | real(c_float), intent(out) :: speedup 196 | type(FLANNParameters), intent(in) :: flann_params 197 | end function 198 | 199 | ! 200 | ! Adds points to pre-built index. 201 | ! 202 | ! Params: 203 | ! index_ptr = pointer to index, must already be built 204 | ! points = pointer to array of points 205 | ! rows = number of points to add 206 | ! columns = feature dimensionality 207 | ! rebuild_threshold = reallocs index when it grows by factor of 208 | ! `rebuild_threshold`. A smaller value results is more space efficient 209 | ! but less computationally efficient. Must be greater than 1. 210 | ! 211 | ! Returns: 0 if success otherwise -1 212 | ! 213 | integer(c_int) function flann_add_points(index_id,points,rows,cols,rebuild_threshold) & 214 | bind(c,name="flann_add_points") 215 | import c_int,c_ptr,c_float 216 | type(c_ptr), value :: index_id 217 | integer(c_int), intent(in), value :: rows, cols 218 | real(c_float), intent(in) :: points(cols,rows) 219 | real(c_float), intent(in), value :: rebuild_threshold 220 | end function 221 | integer(c_int) function flann_add_points_float(index_id,points,rows,cols,rebuild_threshold) & 222 | bind(c,name="flann_add_points_float") 223 | import c_int,c_ptr,c_float 224 | type(c_ptr), value :: index_id 225 | integer(c_int), intent(in), value :: rows, cols 226 | real(c_float), intent(in) :: points(cols,rows) 227 | real(c_float), intent(in), value :: rebuild_threshold 228 | end function 229 | integer(c_int) function flann_add_points_double(index_id,points,rows,cols,rebuild_threshold) & 230 | bind(c,name="flann_add_points_double") 231 | import c_int,c_ptr,c_float, c_double 232 | type(c_ptr), value :: index_id 233 | integer(c_int), intent(in), value :: rows, cols 234 | real(c_double), intent(in) :: points(cols,rows) 235 | real(c_float), intent(in), value :: rebuild_threshold 236 | end function 237 | integer(c_int) function flann_add_points_int(index_id,points,rows,cols,rebuild_threshold) & 238 | bind(c,name="flann_add_points_int") 239 | import c_int,c_ptr,c_float 240 | type(c_ptr), value :: index_id 241 | integer(c_int), intent(in), value :: rows, cols 242 | real(c_float), intent(in) :: points(cols,rows) 243 | real(c_float), intent(in), value :: rebuild_threshold 244 | end function 245 | 246 | ! 247 | ! Removes a point from a pre-built index. 248 | ! 249 | ! index_ptr = pointer to pre-built index. 250 | ! point_id = index of datapoint to remove. 251 | ! 252 | integer(c_int) function flann_remove_point(index_ptr,point_id) bind(C,name="flann_remove_point") 253 | import c_int, c_ptr 254 | type(c_ptr), value :: index_ptr 255 | integer(c_int), intent(in), value :: point_id 256 | end function 257 | integer(c_int) function flann_remove_point_float(index_ptr,point_id) bind(C,name="flann_remove_point_float") 258 | import c_int, c_ptr 259 | type(c_ptr), value :: index_ptr 260 | integer(c_int), intent(in), value :: point_id 261 | end function 262 | integer(c_int) function flann_remove_point_double(index_ptr,point_id) bind(C,name="flann_remove_point_double") 263 | import c_int, c_ptr 264 | type(c_ptr), value :: index_ptr 265 | integer(c_int), intent(in), value :: point_id 266 | end function 267 | integer(c_int) function flann_remove_point_int(index_ptr,point_id) bind(C,name="flann_remove_point_int") 268 | import c_int, c_ptr 269 | type(c_ptr), value :: index_ptr 270 | integer(c_int), intent(in), value :: point_id 271 | end function 272 | 273 | ! 274 | ! Gets a point from a given index position. 275 | ! 276 | ! index_ptr = pointer to pre-built index. 277 | ! point_id = index of datapoint to get. 278 | ! 279 | ! Returns: pointer to datapoint or NULL on miss 280 | ! 281 | type(c_ptr) function flann_get_point(index_ptr,point_id) bind(C,name="flann_get_point") 282 | import c_ptr, c_int, c_float 283 | type(c_ptr), intent(in), value :: index_ptr 284 | integer(c_int), intent(in), value :: point_id 285 | end function 286 | type(c_ptr) function flann_get_point_float(index_ptr,point_id) bind(C,name="flann_get_point_float") 287 | import c_ptr, c_int, c_float 288 | type(c_ptr), intent(in), value :: index_ptr 289 | integer(c_int), intent(in), value :: point_id 290 | end function 291 | type(c_ptr) function flann_get_point_double(index_ptr,point_id) bind(C,name="flann_get_point_double") 292 | import c_ptr, c_int, c_double 293 | type(c_ptr), intent(in), value :: index_ptr 294 | integer(c_int), intent(in), value :: point_id 295 | end function 296 | type(c_ptr) function flann_get_point_int(index_ptr,point_id) bind(C,name="flann_get_point_int") 297 | import c_ptr, c_int 298 | type(c_ptr), intent(in), value :: index_ptr 299 | integer(c_int), intent(in), value :: point_id 300 | end function 301 | 302 | ! 303 | ! Returns the number of datapoints stored in index. 304 | ! 305 | ! index_ptr = pointer to pre-built index. 306 | ! 307 | integer(c_int) function flann_veclen(index_ptr) bind(C,name="flann_veclen") 308 | import c_int, c_ptr 309 | type(c_ptr), intent(in), value :: index_ptr 310 | end function 311 | integer(c_int) function flann_veclen_float(index_ptr) bind(C,name="flann_veclen_float") 312 | import c_int, c_ptr 313 | type(c_ptr), intent(in), value :: index_ptr 314 | end function 315 | integer(c_int) function flann_veclen_double(index_ptr) bind(C,name="flann_veclen_double") 316 | import c_int, c_ptr 317 | type(c_ptr), intent(in), value :: index_ptr 318 | end function 319 | integer(c_int) function flann_veclen_int(index_ptr) bind(C,name="flann_veclen_int") 320 | import c_int, c_ptr 321 | type(c_ptr), intent(in), value :: index_ptr 322 | end function 323 | 324 | ! 325 | ! Returns the dimensionality of datapoints stored in index. 326 | ! 327 | ! index_ptr = pointer to pre-built index. 328 | ! 329 | integer(c_int) function flann_size(index_ptr) bind(c,name="flann_size") 330 | import c_int, c_ptr 331 | type(c_ptr), value :: index_ptr 332 | end function 333 | integer(c_int) function flann_size_float(index_ptr) bind(c,name="flann_size_float") 334 | import c_int, c_ptr 335 | type(c_ptr), value :: index_ptr 336 | end function 337 | integer(c_int) function flann_size_double(index_ptr) bind(c,name="flann_size_double") 338 | import c_int, c_ptr 339 | type(c_ptr), value :: index_ptr 340 | end function 341 | ! integer(c_int) function flann_size_byte(index_ptr) bind(c,name="flann_size_byte") 342 | ! import c_int, c_ptr 343 | ! type(c_ptr), value :: index_ptr 344 | ! end function 345 | integer(c_int) function flann_size_int(index_ptr) bind(c,name="flann_size_int") 346 | import c_int, c_ptr 347 | type(c_ptr), value :: index_ptr 348 | end function 349 | 350 | ! 351 | ! Returns the number of bytes consumed by the index. 352 | ! 353 | ! index_ptr = pointer to pre-built index. 354 | ! 355 | integer(c_int) function flann_used_memory(index_ptr) bind(c,name="flann_used_memory") 356 | import c_int, c_ptr 357 | type(c_ptr), value :: index_ptr 358 | end function 359 | integer(c_int) function flann_used_memory_float(index_ptr) bind(c,name="flann_used_memory_float") 360 | import c_int, c_ptr 361 | type(c_ptr), value :: index_ptr 362 | end function 363 | integer(c_int) function flann_used_memory_double(index_ptr) bind(c,name="flann_used_memory_double") 364 | import c_int, c_ptr 365 | type(c_ptr), value :: index_ptr 366 | end function 367 | ! integer(c_int) function flann_used_memory_byte(index_ptr) bind(c,name="flann_used_memory_byte") 368 | ! import c_int, c_ptr 369 | ! type(c_ptr), value :: index_ptr 370 | ! end function 371 | integer(c_int) function flann_used_memory_int(index_ptr) bind(c,name="flann_used_memory_int") 372 | import c_int, c_ptr 373 | type(c_ptr), value :: index_ptr 374 | end function 375 | 376 | ! 377 | ! Saves the index to a file. Only the index is saved into the file, the dataset corresponding to the index is not saved. 378 | ! 379 | ! @param index_id The index that should be saved 380 | ! @param filename The filename the index should be saved to 381 | ! @return Returns 0 on success, negative value on error. 382 | ! 383 | integer(c_int) function flann_save_index(index_id,filename) bind(C,name="flann_save_index") 384 | import c_int,c_ptr,c_char 385 | type(c_ptr), intent(in), value :: index_id 386 | character(kind=c_char), intent(in) :: filename(*) 387 | end function 388 | integer(c_int) function flann_save_index_float(index_id,filename) bind(C,name="flann_save_index_float") 389 | import c_int,c_ptr,c_char 390 | type(c_ptr), intent(in), value :: index_id 391 | character(kind=c_char), intent(in) :: filename(*) 392 | end function 393 | integer(c_int) function flann_save_index_double(index_id,filename) bind(C,name="flann_save_index_double") 394 | import c_int,c_ptr,c_char 395 | type(c_ptr), intent(in), value :: index_id 396 | character(kind=c_char), intent(in) :: filename(*) 397 | end function 398 | integer(c_int) function flann_save_index_int(index_id,filename) bind(C,name="flann_save_index_int") 399 | import c_int,c_ptr,c_char 400 | type(c_ptr), intent(in), value :: index_id 401 | character(kind=c_char), intent(in) :: filename(*) 402 | end function 403 | 404 | ! 405 | ! Loads an index from a file. 406 | ! 407 | ! @param filename File to load the index from. 408 | ! @param dataset The dataset corresponding to the index. 409 | ! @param rows Dataset tors 410 | ! @param cols Dataset columns 411 | ! @return 412 | ! 413 | type(c_ptr) function flann_load_index(filename,dataset,rows,cols) bind(C,name="flann_load_index") 414 | import c_char,c_int,c_float,c_ptr 415 | character(kind=c_char), intent(in) :: filename(*) 416 | integer(c_int), intent(in), value :: rows,cols 417 | real(c_float), intent(out) :: dataset(cols,rows) 418 | end function 419 | type(c_ptr) function flann_load_index_float(filename,dataset,rows,cols) bind(C,name="flann_load_index_float") 420 | import c_char,c_int,c_float,c_ptr 421 | character(kind=c_char), intent(in) :: filename(*) 422 | integer(c_int), intent(in), value :: rows,cols 423 | real(c_float), intent(out) :: dataset(cols,rows) 424 | end function 425 | type(c_ptr) function flann_load_index_double(filename,dataset,rows,cols) bind(C,name="flann_load_index_double") 426 | import c_char,c_int,c_double,c_ptr 427 | character(kind=c_char), intent(in) :: filename(*) 428 | integer(c_int), intent(in), value :: rows,cols 429 | real(c_double), intent(out) :: dataset(cols,rows) 430 | end function 431 | type(c_ptr) function flann_load_index_int(filename,dataset,rows,cols) bind(C,name="flann_load_index_int") 432 | import c_char,c_int,c_ptr 433 | character(kind=c_char), intent(in) :: filename(*) 434 | integer(c_int), intent(in), value :: rows,cols 435 | integer(c_int), intent(out) :: dataset(cols,rows) 436 | end function 437 | 438 | ! 439 | ! Builds an index and uses it to find nearest neighbors. 440 | ! 441 | ! Params: 442 | ! dataset = pointer to a data set stored in row major order 443 | ! rows = number of rows (features) in the dataset 444 | ! cols = number of columns in the dataset (feature dimensionality) 445 | ! testset = pointer to a query set stored in row major order 446 | ! trows = number of rows (features) in the query dataset (same dimensionality as features in the dataset) 447 | ! indices = pointer to matrix for the indices of the nearest neighbors of the testset features in the dataset 448 | ! (must have trows number of rows and nn number of columns) 449 | ! nn = how many nearest neighbors to return 450 | ! flann_params = generic flann parameters 451 | ! 452 | ! Returns: zero or -1 for error 453 | ! 454 | integer(c_int) function flann_find_nearest_neighbors(dataset,rows,cols,testset,trows,indices,dists,nn,flann_params) & 455 | bind(C,name="flann_find_nearest_neighbors") 456 | import c_int, c_float, FLANNParameters 457 | integer(c_int), intent(in), value :: rows, cols 458 | real(c_float), intent(in) :: dataset(cols,rows) 459 | integer(c_int), intent(in), value :: trows 460 | real(c_float), intent(in) :: testset(cols,trows) 461 | integer(c_int), intent(in), value :: nn 462 | integer(c_int), intent(out) :: indices(nn,trows) 463 | real(c_float), intent(out) :: dists(nn,trows) 464 | type(FLANNParameters), intent(in) :: flann_params 465 | end function 466 | integer(c_int) function flann_find_nearest_neighbors_float(dataset,rows,cols,testset,trows,indices,dists,nn,flann_params) & 467 | bind(C,name="flann_find_nearest_neighbors_float") 468 | import c_int, c_float, FLANNParameters 469 | integer(c_int), intent(in), value :: rows, cols 470 | real(c_float), intent(in) :: dataset(cols,rows) 471 | integer(c_int), intent(in), value :: trows 472 | real(c_float), intent(in) :: testset(cols,trows) 473 | integer(c_int), intent(in), value :: nn 474 | integer(c_int), intent(out) :: indices(nn,trows) 475 | real(c_float), intent(out) :: dists(nn,trows) 476 | type(FLANNParameters), intent(in) :: flann_params 477 | end function 478 | integer(c_int) function flann_find_nearest_neighbors_double(dataset,rows,cols,testset,trows,indices,dists,nn,flann_params) & 479 | bind(C,name="flann_find_nearest_neighbors_double") 480 | import c_int, c_double, FLANNParameters 481 | integer(c_int), intent(in), value :: rows, cols 482 | real(c_double), intent(in) :: dataset(cols,rows) 483 | integer(c_int), intent(in), value :: trows 484 | real(c_double), intent(in) :: testset(cols,trows) 485 | integer(c_int), intent(in), value :: nn 486 | integer(c_int), intent(out) :: indices(nn,trows) 487 | real(c_double), intent(out) :: dists(nn,trows) 488 | type(FLANNParameters), intent(in) :: flann_params 489 | end function 490 | integer(c_int) function flann_find_nearest_neighbors_int(dataset,rows,cols,testset,trows,indices,dists,nn,flann_params) & 491 | bind(C,name="flann_find_nearest_neighbors_int") 492 | import c_int, c_float, FLANNParameters 493 | integer(c_int), intent(in), value :: rows, cols 494 | integer(c_int), intent(in) :: dataset(cols,rows) 495 | integer(c_int), intent(in), value :: trows 496 | integer(c_int), intent(in) :: testset(cols,trows) 497 | integer(c_int), intent(in), value :: nn 498 | integer(c_int), intent(out) :: indices(nn,trows) 499 | real(c_float), intent(out) :: dists(nn,trows) 500 | type(FLANNParameters), intent(in) :: flann_params 501 | end function 502 | 503 | ! 504 | ! Searches for nearest neighbors using the index provided 505 | ! 506 | ! Params: 507 | ! index_id = the index (constructed previously using flann_build_index). 508 | ! testset = pointer to a query set stored in row major order 509 | ! trows = number of rows (features) in the query dataset (same dimensionality as features in the dataset) 510 | ! indices = pointer to matrix for the indices of the nearest neighbors of the testset features in the dataset 511 | ! (must have trows number of rows and nn number of columns) 512 | ! dists = pointer to matrix for the distances of the nearest neighbors of the testset features in the dataset 513 | ! (must have trows number of rows and 1 column) 514 | ! nn = how many nearest neighbors to return 515 | ! flann_params = generic flann parameters 516 | ! 517 | ! Returns: zero or a number <0 for error 518 | ! 519 | integer(c_int) function flann_find_nearest_neighbors_index(index_id,testset,trows,indices,dists,nn,flann_params) & 520 | bind(c,name="flann_find_nearest_neighbors_index") 521 | import c_int, c_ptr, c_float, FLANNParameters 522 | type(c_ptr), value :: index_id 523 | integer(c_int), intent(in), value :: trows 524 | real(c_float), intent(in) :: testset(*) 525 | integer(c_int), intent(in), value :: nn 526 | integer(c_int) :: indices(nn,trows) 527 | real(c_float) :: dists(nn,trows) 528 | type(FLANNParameters) :: flann_params 529 | end function 530 | integer(c_int) function flann_find_nearest_neighbors_index_float(index_id,testset,trows,indices,dists,nn,flann_params) & 531 | bind(c,name="flann_find_nearest_neighbors_index_float") 532 | import c_int, c_ptr, c_float, FLANNParameters 533 | type(c_ptr), value :: index_id 534 | integer(c_int), intent(in), value :: trows 535 | real(c_float), intent(in) :: testset(*) 536 | integer(c_int) :: indices(*) 537 | real(c_float) :: dists(*) 538 | integer(c_int), intent(in), value :: nn 539 | type(FLANNParameters) :: flann_params 540 | end function 541 | integer(c_int) function flann_find_nearest_neighbors_index_double(index_id,testset,trows,indices,dists,nn,flann_params) & 542 | bind(c,name="flann_find_nearest_neighbors_index_double") 543 | import c_int, c_ptr, c_float, c_double, FLANNParameters 544 | type(c_ptr), value :: index_id 545 | integer(c_int), intent(in), value :: trows 546 | real(c_double), intent(in) :: testset(*) 547 | integer(c_int) :: indices(*) 548 | real(c_double) :: dists(*) 549 | integer(c_int), intent(in), value :: nn 550 | type(FLANNParameters) :: flann_params 551 | end function 552 | ! integer(c_int) function flann_find_nearest_neighbors_index_byte(index_id,testset,trows,indices,dists,nn,flann_params) & 553 | ! bind(c,name="flann_find_nearest_neighbors_index_byte") 554 | ! import c_int, c_ptr, c_float, FLANNParameters 555 | ! type(c_ptr), value :: index_id 556 | 557 | ! integer(c_int), intent(in), value :: trows 558 | ! integer(c_int), intent(out) :: indices(trows,*) 559 | ! integer(c_int), intent(out) :: dists(trows) 560 | ! integer(c_int), intent(in), value :: nn 561 | ! type(FLANNParameters) :: flann_params 562 | ! end function 563 | integer(c_int) function flann_find_nearest_neighbors_index_int(index_id,testset,trows,indices,dists,nn,flann_params) & 564 | bind(c,name="flann_find_nearest_neighbors_index_int") 565 | import c_int, c_ptr, c_float, FLANNParameters 566 | type(c_ptr), value :: index_id 567 | integer(c_int), intent(in), value :: trows 568 | integer(c_int), intent(in) :: testset(*) 569 | integer(c_int) :: indices(*) 570 | real(c_float) :: dists(*) 571 | integer(c_int), intent(in), value :: nn 572 | type(FLANNParameters) :: flann_params 573 | end function 574 | 575 | ! 576 | ! Performs an radius search using an already constructed index. 577 | ! 578 | ! In case of radius search, instead of always returning a predetermined 579 | ! number of nearest neighbours (for example the 10 nearest neighbours), the 580 | ! search will return all the neighbours found within a search radius 581 | ! of the query point. 582 | ! 583 | ! The check parameter in the FLANNParameters below sets the level of approximation 584 | ! for the search by only visiting "checks" number of features in the index 585 | ! (the same way as for the KNN search). A lower value for checks will give 586 | ! a higher search speedup at the cost of potentially not returning all the 587 | ! neighbours in the specified radius. 588 | ! 589 | ! Returns: count of points within search radius or a number <0 for error 590 | ! 591 | integer(c_int) function flann_radius_search(index_ptr,query,indices,dists,max_nn,radius,flann_params) & 592 | bind(C,name="flann_radius_search") 593 | import c_int, c_ptr, c_float, FLANNParameters 594 | type(c_ptr), value :: index_ptr 595 | real(c_float), intent(in) :: query(*) 596 | integer(c_int), intent(in), value :: max_nn 597 | integer(c_int), intent(out) :: indices(max_nn) 598 | real(c_float), intent(out) :: dists(max_nn) 599 | real(c_float), intent(in), value :: radius 600 | type(FLANNParameters), intent(in) :: flann_params 601 | end function 602 | integer(c_int) function flann_radius_search_float(index_ptr,query,indices,dists,max_nn,radius,flann_params) & 603 | bind(C,name="flann_radius_search_float") 604 | import c_int, c_ptr, c_float, FLANNParameters 605 | type(c_ptr), value :: index_ptr 606 | real(c_float), intent(in) :: query(*) 607 | integer(c_int), intent(in), value :: max_nn 608 | integer(c_int), intent(out) :: indices(max_nn) 609 | real(c_float), intent(out) :: dists(max_nn) 610 | real(c_float), intent(in), value :: radius 611 | type(FLANNParameters), intent(in) :: flann_params 612 | end function 613 | integer(c_int) function flann_radius_search_double(index_ptr,query,indices,dists,max_nn,radius,flann_params) & 614 | bind(C,name="flann_radius_search_double") 615 | import c_int, c_ptr, c_float, c_double, FLANNParameters 616 | type(c_ptr), value :: index_ptr 617 | real(c_double), intent(in) :: query(*) 618 | integer(c_int), intent(in), value :: max_nn 619 | integer(c_int), intent(out) :: indices(max_nn) 620 | real(c_double), intent(out) :: dists(max_nn) 621 | real(c_float), intent(in), value :: radius 622 | type(FLANNParameters), intent(in) :: flann_params 623 | end function 624 | integer(c_int) function flann_radius_search_int(index_ptr,query,indices,dists,max_nn,radius,flann_params) & 625 | bind(C,name="flann_radius_search_int") 626 | import c_int, c_ptr, c_float, FLANNParameters 627 | type(c_ptr), value :: index_ptr 628 | integer(c_int), intent(in) :: query(*) 629 | integer(c_int), intent(in), value :: max_nn 630 | integer(c_int), intent(out) :: indices(max_nn) 631 | integer(c_int), intent(out) :: dists(max_nn) 632 | real(c_float), intent(in), value :: radius 633 | type(FLANNParameters), intent(in) :: flann_params 634 | end function 635 | 636 | ! 637 | ! Deletes an index and releases the memory used by it. 638 | ! 639 | ! Params: 640 | ! index_id = the index (constructed previously using flann_build_index). 641 | ! flann_params = generic flann parameters 642 | ! 643 | ! Returns: zero or a number <0 for error 644 | ! 645 | integer(c_int) function flann_free_index(index_id,flann_params) bind(c,name="flann_free_index") 646 | import c_int, c_ptr, FLANNParameters 647 | type(c_ptr), value :: index_id 648 | type(FLANNParameters) :: flann_params 649 | end function 650 | integer(c_int) function flann_free_index_float(index_id,flann_params) bind(c,name="flann_free_index_float") 651 | import c_int, c_ptr, FLANNParameters 652 | type(c_ptr), value :: index_id 653 | type(FLANNParameters) :: flann_params 654 | end function 655 | integer(c_int) function flann_free_index_double(index_id,flann_params) bind(c,name="flann_free_index_double") 656 | import c_int, c_ptr, FLANNParameters 657 | type(c_ptr), value :: index_id 658 | type(FLANNParameters) :: flann_params 659 | end function 660 | ! integer(c_int) function flann_free_index_byte(index_id,flann_params) bind(c,name="flann_free_index_byte") 661 | ! import c_int, c_ptr, FLANNParameters 662 | ! type(c_ptr), value :: index_id 663 | ! type(FLANNParameters) :: flann_params 664 | ! end function 665 | integer(c_int) function flann_free_index_int(index_id,flann_params) bind(c,name="flann_free_index_int") 666 | import c_int, c_ptr, FLANNParameters 667 | type(c_ptr), value :: index_id 668 | type(FLANNParameters) :: flann_params 669 | end function 670 | 671 | ! 672 | ! Clusters the features in the dataset using a hierarchical kmeans clustering approach. 673 | ! This is significantly faster than using a flat kmeans clustering for a large number 674 | ! of clusters. 675 | ! 676 | ! Params: 677 | ! dataset = pointer to a data set stored in row major order 678 | ! rows = number of rows (features) in the dataset 679 | ! cols = number of columns in the dataset (feature dimensionality) 680 | ! clusters = number of cluster to compute 681 | ! result = memory buffer where the output cluster centers are storred 682 | ! index_params = used to specify the kmeans tree parameters (branching factor, max number of iterations to use) 683 | ! flann_params = generic flann parameters 684 | ! 685 | ! Returns: number of clusters computed or a number <0 for error. This number can be different than the number of clusters requested, due to the 686 | ! way hierarchical clusters are computed. The number of clusters returned will be the highest number of the form 687 | ! (branch_size-1)*K+1 smaller than the number of clusters requested. 688 | ! 689 | integer(c_int) function flann_compute_cluster_centers(dataset,rows,cols,clusters,result,flann_params) & 690 | bind(C,name="flann_compute_cluster_centers") 691 | import c_int, c_float, FLANNParameters 692 | integer(c_int), intent(in), value :: rows,cols 693 | real(c_float), intent(in) :: dataset(cols,rows) 694 | integer(c_int), intent(in), value :: clusters 695 | real(c_float), intent(out) :: result(clusters,cols) 696 | type(FLANNParameters), intent(in) :: flann_params 697 | end function 698 | integer(c_int) function flann_compute_cluster_centers_float(dataset,rows,cols,clusters,result,flann_params) & 699 | bind(C,name="flann_compute_cluster_centers_float") 700 | import c_int, c_float, FLANNParameters 701 | integer(c_int), intent(in), value :: rows,cols 702 | real(c_float), intent(in) :: dataset(cols,rows) 703 | integer(c_int), intent(in), value :: clusters 704 | real(c_float), intent(out) :: result(clusters,cols) 705 | type(FLANNParameters), intent(in) :: flann_params 706 | end function 707 | integer(c_int) function flann_compute_cluster_centers_double(dataset,rows,cols,clusters,result,flann_params) & 708 | bind(C,name="flann_compute_cluster_centers_double") 709 | import c_int, c_double, FLANNParameters 710 | integer(c_int), intent(in), value :: rows,cols 711 | real(c_double), intent(in) :: dataset(cols,rows) 712 | integer(c_int), intent(in), value :: clusters 713 | real(c_double), intent(out) :: result(clusters,cols) 714 | type(FLANNParameters), intent(in) :: flann_params 715 | end function 716 | integer(c_int) function flann_compute_cluster_centers_int(dataset,rows,cols,clusters,result,flann_params) & 717 | bind(C,name="flann_compute_cluster_centers_int") 718 | import c_int, c_float, FLANNParameters 719 | integer(c_int), intent(in), value :: rows,cols 720 | integer(c_int), intent(in) :: dataset(cols,rows) 721 | integer(c_int), intent(in), value :: clusters 722 | real(c_float), intent(out) :: result(clusters,cols) 723 | type(FLANNParameters), intent(in) :: flann_params 724 | end function 725 | 726 | end interface 727 | 728 | end module -------------------------------------------------------------------------------- /src/flann_params.f90: -------------------------------------------------------------------------------- 1 | module flann_params 2 | 3 | use iso_c_binding, only: c_int, c_float 4 | use flann_c 5 | 6 | implicit none 7 | private 8 | 9 | public :: log_verbosity 10 | 11 | public :: search_params, copy_search_params 12 | 13 | public :: LinearIndexParams 14 | public :: KDTreeIndexParams 15 | public :: KMeansIndexParams 16 | public :: CompositeIndexParams 17 | public :: KDTreeSingleIndexParams 18 | public :: HierarchicalClusteringIndexParams 19 | public :: LshIndexParams 20 | public :: AutotunedIndexParams 21 | 22 | type :: search_params 23 | integer(c_int) :: checks = 32 24 | !! Specified the maximum leafs to visit when searching for neighbors. 25 | !! A higher value for this parameter would give better search precision, 26 | !! but also take more time. For all leafs to be checked use the value 27 | !! `FLANN_CHECKS_UNLIMITED`. If automatic configuration was used when 28 | !! the index was created, the number of checks required to achieve the 29 | !! specified precision was also computed, to use that value specify 30 | !! `FLANN_CHECKS_AUTOTUNED`. 31 | real(c_float) :: eps = 0.0_c_float 32 | !! Search for eps-approximate neighbors (only used by KDTreeSingleIndex). 33 | logical :: sorted = .true. 34 | !! Used only by radius search, specifies if the neighbors 35 | !! returned should be sorted by distance. 36 | integer(c_int) :: max_neighbors = -1 37 | !! Specifies the maximum number of neighbors radius 38 | !! search should return (default: -1 = unlimited). Only 39 | !! used for radius search. 40 | integer(c_int) :: cores = 0 41 | !! How many cores to assign to the search (specify 0 for 42 | !! automatic core selection). 43 | end type 44 | 45 | ! interface search_params 46 | ! module procedure search_params_constructor 47 | ! end interface 48 | 49 | integer(c_int), protected :: GLOBAL_log_level = FLANN_LOG_NONE 50 | 51 | contains 52 | 53 | subroutine log_verbosity(level) 54 | use flann_c, only: flann_log_verbosity 55 | integer, intent(in) :: level 56 | 57 | ! Store a copy of the log verbosity in order to 58 | ! be able to initialize the FLANN Parameters struct 59 | GLOBAL_log_level = level 60 | 61 | ! Set the verbosity on the C side 62 | call flann_log_verbosity(level) 63 | end subroutine 64 | 65 | ! function search_params_constructor(checks,eps,sorted) result(this) 66 | ! integer(c_int), intent(in), optional :: checks 67 | ! real(c_float), intent(in), optional :: eps 68 | ! logical, intent(in), optional :: sorted 69 | ! type(search_params) :: this 70 | ! if (present(checks)) this%checks = checks 71 | ! if (present(checks)) this%eps = eps 72 | ! if (present(sorted)) this%sorted = sorted 73 | ! end function 74 | 75 | subroutine copy_search_params(params,params_in) 76 | type(FLANNParameters), intent(inout) :: params 77 | type(search_params), intent(in) :: params_in 78 | 79 | params%checks = params_in%checks 80 | params%eps = params_in%eps 81 | ! if (params_in%sorted) then 82 | ! params%sorted = 1_c_int 83 | ! else 84 | ! params%sorted = 0_c_int 85 | ! end if 86 | params%max_neighbors = params_in%max_neighbors 87 | params%cores = params_in%cores 88 | end subroutine 89 | 90 | function LinearIndexParams() result(this) 91 | type(FLANNParameters) :: this 92 | this%algorithm = FLANN_INDEX_LINEAR 93 | this%log_level = GLOBAL_log_level 94 | end function 95 | 96 | function KDTreeIndexParams(trees) result(this) 97 | integer(c_int), intent(in), optional :: trees 98 | !! The number of parallel kd-trees to use. Good values are in the 99 | !! range from 1 to 16. 100 | type(FLANNParameters) :: this 101 | this%algorithm = FLANN_INDEX_KDTREE 102 | if (present(trees)) this%trees = trees 103 | this%log_level = GLOBAL_log_level 104 | end function 105 | 106 | function KMeansIndexParams(branching,iterations,centers_init,cb_index) result(this) 107 | integer(c_int), intent(in), optional :: branching 108 | !! The branching factor to use for the hierarchical k-means tree. 109 | integer(c_int), intent(in), optional :: iterations 110 | !! The maximum number of iterations to use in the k-means clustering 111 | !! stage when building the k-means tree. If a value of -1 is used here, 112 | !! it means that the k-means tree clustering should be iterated until 113 | !! convergence. 114 | integer(c_int), intent(in), optional :: centers_init 115 | !! The algorithm to use when performing a k-means clustering step. The 116 | !! possible values are: 117 | !! 118 | real(c_float), intent(in), optional :: cb_index 119 | !! This parameter (cluster boundary index) influences the way 120 | !! exploration is performed in the hierarchical k-means tree. 121 | !! When cb_index is zero the next k-means domain to be explores is 122 | !! choosen to be the one with the closest center. A value greater then 123 | !! zero also takes into account the size of the domain. 124 | 125 | type(FLANNParameters) :: this 126 | 127 | this%algorithm = FLANN_INDEX_KMEANS 128 | if (present(branching)) this%branching = branching 129 | if (present(iterations)) this%iterations = iterations 130 | if (present(centers_init)) this%centers_init = centers_init 131 | if (present(cb_index)) this%cb_index = cb_index 132 | this%log_level = GLOBAL_log_level 133 | end function 134 | 135 | function CompositeIndexParams(trees,branching,iterations,centers_init,cb_index) result(this) 136 | integer(c_int), intent(in), optional :: trees 137 | integer(c_int), intent(in), optional :: branching 138 | integer(c_int), intent(in), optional :: iterations 139 | integer(c_int), intent(in), optional :: centers_init 140 | real(c_float), intent(in), optional :: cb_index 141 | type(FLANNParameters) :: this 142 | 143 | this%algorithm = FLANN_INDEX_COMPOSITE 144 | if (present(trees)) this%trees = trees 145 | if (present(branching)) this%branching = branching 146 | if (present(iterations)) this%iterations = iterations 147 | if (present(centers_init)) this%centers_init = centers_init 148 | if (present(cb_index)) this%cb_index = cb_index 149 | this%log_level = GLOBAL_log_level 150 | end function 151 | 152 | function KDTreeSingleIndexParams(leaf_max_size) result(this) 153 | integer(c_int), intent(in), optional :: leaf_max_size 154 | type(FLANNParameters) :: this 155 | this%algorithm = FLANN_INDEX_KDTREE_SINGLE 156 | if (present(leaf_max_size)) this%leaf_max_size = leaf_max_size 157 | this%log_level = GLOBAL_log_level 158 | end function 159 | 160 | function HierarchicalClusteringIndexParams(branching,centers_init,trees,leaf_max_size) result(this) 161 | integer(c_int), intent(in), optional :: branching 162 | integer(c_int), intent(in), optional :: centers_init 163 | integer(c_int), intent(in), optional :: trees 164 | integer(c_int), intent(in), optional :: leaf_max_size 165 | type(FLANNParameters) :: this 166 | this%algorithm = FLANN_INDEX_HIERARCHICAL 167 | if (present(branching)) this%branching = branching 168 | if (present(centers_init)) this%centers_init = centers_init 169 | if (present(trees)) this%trees = trees 170 | if (present(leaf_max_size)) this%leaf_max_size = leaf_max_size 171 | this%log_level = GLOBAL_log_level 172 | end function 173 | 174 | function LshIndexParams(table_number,key_size,multi_probe_level) result(this) 175 | integer(c_int), intent(in), optional :: table_number 176 | integer(c_int), intent(in), optional :: key_size 177 | integer(c_int), intent(in), optional :: multi_probe_level 178 | type(FLANNParameters) :: this 179 | this%algorithm = FLANN_INDEX_LSH 180 | if (present(table_number)) this%table_number_ = table_number 181 | if (present(key_size)) this%key_size_ = key_size 182 | if (present(multi_probe_level)) this%multi_probe_level_ = multi_probe_level 183 | this%log_level = GLOBAL_log_level 184 | end function 185 | 186 | function AutotunedIndexParams(target_precision,build_weight,memory_weight,sample_fraction) result(this) 187 | real(c_float), intent(in), optional :: target_precision 188 | real(c_float), intent(in), optional :: build_weight 189 | real(c_float), intent(in), optional :: memory_weight 190 | real(c_float), intent(in), optional :: sample_fraction 191 | type(FLANNParameters) :: this 192 | this%algorithm = FLANN_INDEX_AUTOTUNED 193 | if (present(target_precision)) this%target_precision = target_precision 194 | if (present(build_weight)) this%build_weight = build_weight 195 | if (present(memory_weight)) this%memory_weight = memory_weight 196 | if (present(sample_fraction)) this%sample_fraction = sample_fraction 197 | this%log_level = GLOBAL_log_level 198 | end function 199 | 200 | end module --------------------------------------------------------------------------------