├── .gitignore ├── Algorithms.f ├── Arrays ├── Arrays.f └── Shift.f ├── Core ├── Error.f └── Threads │ ├── PTData.c │ ├── PTData.f │ ├── PTData.h │ ├── PTInterface.f │ ├── PThreads.c │ ├── PThreads.f │ └── PThreads.h ├── Examples ├── Example.f ├── PingPong.f └── RubiksCube │ ├── Analyser.f │ ├── Common.f │ ├── Cube.f │ ├── Rotator.f │ ├── RubiksCube.f │ └── Search.f ├── Exercises ├── Exercises.f ├── alg1p1e1.f ├── alg1p2e1.f ├── alg1p3e1.f └── alg1p5e1.f ├── Experiments ├── Arrays │ └── RubiksCube.f └── Experiments.f ├── Features ├── Arrays │ ├── Arrays.f │ └── Reallocation.f ├── Feature.f ├── Inheritance │ ├── Animal.f │ ├── Cat.f │ ├── Circle.f │ ├── Dog.f │ ├── Inheritance.f │ └── Shape.f └── OpenMP │ ├── Example1.f │ ├── Example2.f │ ├── Example3.f │ └── Example4.f ├── Foundation ├── Array.f ├── Date.f ├── Foundation.f ├── Number.f ├── Object.f └── String.f ├── Graphs ├── BreadthFirstSearch.f ├── DepthFirstSearch.f ├── Graph.f └── Vertex.f ├── LICENSE ├── Makefile ├── Math ├── Fibonacci.f ├── GreatestCommonDivisir.f └── Pi.f ├── Networks ├── HopfieldNetwork.f ├── Neuron.f └── SingleLayerPerceptron.f ├── Problems ├── Problems.f └── ProjectEuler │ ├── Problem1.f │ ├── Problem10.f │ ├── Problem11.f │ ├── Problem12.f │ ├── Problem13.f │ ├── Problem14.f │ ├── Problem15.f │ ├── Problem2.f │ ├── Problem3.f │ ├── Problem4.f │ ├── Problem5.f │ ├── Problem6.f │ ├── Problem7.f │ ├── Problem8.f │ ├── Problem9.f │ └── ProjectEuler.f ├── README.md ├── Randoms ├── IntrinsicRandom.f ├── LinearCongruential.f └── Random.f ├── Samples ├── 1000_list_of_integers ├── 100_list_of_integers ├── 10_list_of_integers ├── 10_list_of_integers_reversed ├── AdjacencyList_8_1 ├── IntegerArray ├── QuickSort ├── QuickSort Samples ├── dijkstraData ├── dijkstraData_4_1 ├── dijkstraData_4_2 ├── kargerMinCut ├── kargerMinCut_40 ├── kargerMinCut_4_1 ├── kargerMinCut_8_1 ├── kargerMinCut_8_2 ├── kargerMinCut_8_3 ├── kargerMinCut_8_4 └── kargerMinCut_8_5 ├── Searches ├── BinarySearch.f ├── Search.f └── SequenceSearch.f ├── Sorts ├── BubbleSort.f ├── InsertionSort.f ├── MergeSort.f ├── QuickSort.f ├── RadixSort.f ├── SelectionSort.f ├── ShellSort.f └── Sort.f ├── Structures ├── ArrayQueue.f ├── ArrayStack.f ├── Heap.f ├── Iterator.f ├── LinkedList.f ├── LinkedListEntry.f ├── LinkedListIterator.f ├── List.f ├── ListEntry.f ├── ListIterator.f ├── Queue.f └── Stack.f ├── Units ├── Arrays │ └── Shift.f ├── Asserts.f ├── Foundation │ ├── ArrayCount.f │ ├── ArrayInitWithFArray.f │ ├── ArraySortedArrayUsingFunction.f │ ├── ObjectEquals.f │ ├── ObjectInheritance.f │ ├── ObjectInit.f │ ├── StringAssignFString.f │ ├── StringEquals.f │ ├── StringInitWithFString.f │ └── UFoundation.f ├── Graphs │ ├── BreadthFirstSearch.f │ └── DepthFirstSearch.f ├── Math │ ├── Fibonacci.f │ ├── GreatestCommonDivisor.f │ └── Pi.f ├── Parameters.f ├── Randoms │ └── LinearCongruential.f ├── Report.f ├── Searches │ └── Search.f ├── Sorts │ ├── BubbleSort.f │ ├── InsertionSort.f │ ├── MergeSort.f │ ├── QuickSort.f │ ├── RadixSort.f │ ├── SelectionSort.f │ ├── ShellSort.f │ └── Sort.f ├── Structures │ ├── ArrayQueue.f │ ├── ArrayStack.f │ └── LinkedList.f └── Unit.f └── Utils └── FileReader.f /.gitignore: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ### Project build directory # 3 | ################################################################################ 4 | Modules/ 5 | Objects/ 6 | 7 | ################################################################################ 8 | ### Compiled source # 9 | ################################################################################ 10 | *.mod 11 | *.o 12 | 13 | ################################################################################ 14 | ### OS generated files # 15 | ################################################################################ 16 | .DS_Store 17 | .DS_Store? 18 | ._* 19 | .Spotlight-V100 20 | .Trashes 21 | Icon? 22 | ehthumbs.db 23 | Thumbs.db 24 | -------------------------------------------------------------------------------- /Algorithms.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | program Algorithms 28 | 29 | use MExample 30 | use MExercises 31 | use MExperiments 32 | use MFeature 33 | use MProblems 34 | use MUnit 35 | 36 | implicit none 37 | 38 | type(TExample) example 39 | type(TExercises) exercises 40 | type(TExperiments) experiments 41 | type(TFeature) feature 42 | type(TProblems) problems 43 | type(TUnit) unit 44 | 45 | write (*, '(A)') 'The Laboratory of Algorithms' 46 | write (*, '(A,/)') '(C) 2011-2018 Andrey Pudov' 47 | 48 | call example%present() 49 | !call exercises%present() 50 | !call experiments%present() 51 | !call feature%present() 52 | !call problems%present() 53 | !call unit%present() 54 | end program 55 | -------------------------------------------------------------------------------- /Arrays/Shift.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MShift 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: TShift 33 | contains 34 | procedure, nopass :: shift => shiftByLoop 35 | procedure, nopass :: shiftBack => shiftBackByLoop 36 | 37 | procedure, nopass :: shiftByLoop 38 | procedure, nopass :: shiftByAssignment 39 | procedure, nopass :: shiftByIntrinsic 40 | 41 | procedure, nopass :: shiftBackByLoop 42 | end type 43 | 44 | contains 45 | subroutine shiftByLoop(array) 46 | integer, dimension(:), intent(in out) :: array 47 | 48 | integer index 49 | 50 | do index = size(array) - 1, 1, -1 51 | array(index + 1) = array(index) 52 | end do 53 | end subroutine 54 | 55 | subroutine shiftByAssignment(array) 56 | integer, dimension(:), intent(in out) :: array 57 | 58 | array(2:size(array)) = array(1:size(array) - 1) 59 | end subroutine 60 | 61 | subroutine shiftByIntrinsic(array) 62 | integer, dimension(:), intent(in out) :: array 63 | 64 | array = cshift(array, -1) 65 | array(1) = array(2) ! replace the last element of an array by first element 66 | end subroutine 67 | 68 | subroutine shiftBackByLoop(array) 69 | integer, dimension(:), intent(in out) :: array 70 | 71 | integer index 72 | 73 | do index = 1, size(array) - 1 74 | array(index) = array(index + 1) 75 | end do 76 | end subroutine 77 | end module 78 | -------------------------------------------------------------------------------- /Core/Error.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MError 28 | 29 | implicit none 30 | public 31 | 32 | integer, parameter :: NumberFormatException = 1 33 | 34 | ! the global error number indicator 35 | integer, private :: error_number = 0 36 | 37 | ! the global error message provided in user code 38 | character(len=80), private :: error_message = "" 39 | contains 40 | subroutine throw(error, message) 41 | integer, intent(in) :: error 42 | character(len=*), optional, intent(in) :: message 43 | 44 | error_number = error 45 | if (present(message)) then 46 | error_message = message 47 | else 48 | error_message = "" 49 | end if 50 | end subroutine 51 | end module 52 | -------------------------------------------------------------------------------- /Core/Threads/PTData.c: -------------------------------------------------------------------------------- 1 | /* 2 | * The Laboratory of Algorithms 3 | * 4 | * The MIT License 5 | * 6 | * Copyright 2011-2015 Andrey Pudov. 7 | * 8 | * Permission is hereby granted, free of charge, to any person obtaining a copy 9 | * of this software and associated documentation files (the 'Software'), to deal 10 | * in the Software without restriction, including without limitation the rights 11 | * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | * copies of the Software, and to permit persons to whom the Software is 13 | * furnished to do so, subject to the following conditions: 14 | * 15 | * The above copyright notice and this permission notice shall be included in 16 | * all copies or substantial portions of the Software. 17 | * 18 | * THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | * THE SOFTWARE. 25 | */ 26 | 27 | #include "PTData.h" 28 | #include 29 | 30 | void array_init(array_t **array, int size) { 31 | if (*array == NULL) { 32 | *array = (array_t*) malloc(sizeof(array_t)); 33 | } 34 | 35 | pthread_mutex_init(&((*array)->mutex),NULL); 36 | (*array)->data = (void**) malloc(sizeof(void*) * size); 37 | 38 | for(int index = 0; index < size; ++index) { 39 | (*array)->data[index] = NULL; 40 | } 41 | 42 | (*array)->size = size; 43 | (*array)->after = 0; 44 | } 45 | 46 | void array_resize(array_t **array, int size) { 47 | (*array)->data = (void**) realloc((*array)->data, sizeof(void*) * size); 48 | (*array)->size = size; 49 | 50 | for(int index = (*array)->after; index < size; ++index) { 51 | (*array)->data[index] = NULL; 52 | } 53 | } 54 | 55 | void array_delete(array_t *array) { 56 | free(array->data); 57 | free(array); 58 | } 59 | 60 | void varray_init(varray_t **array, int size) { 61 | if (*array == NULL) { 62 | *array = (varray_t*) malloc(sizeof(varray_t)); 63 | } 64 | 65 | pthread_mutex_init(&((*array)->mutex),NULL); 66 | (*array)->data = (volatile void**) malloc(sizeof(void*) * size); 67 | 68 | for(int index = 0; index < size; ++index) { 69 | (*array)->data[index] = NULL; 70 | } 71 | 72 | (*array)->size = size; 73 | (*array)->after = 0; 74 | } 75 | 76 | void varray_resize(varray_t **array, int size) { 77 | (*array)->data = (volatile void**)realloc((*array)->data,sizeof(volatile void*)*size); 78 | (*array)->size = size; 79 | 80 | for(int index = (*array)->after; index < size; ++index) { 81 | (*array)->data[index] = NULL; 82 | } 83 | } 84 | 85 | void varray_delete(varray_t *array) { 86 | free(array->data); 87 | free(array); 88 | } 89 | 90 | int is_valid(array_t *array, int id) { 91 | return ((id >= 0) && (id < array->after) && (array->data[id] != NULL)) ? 1 : 0; 92 | } 93 | -------------------------------------------------------------------------------- /Core/Threads/PTData.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MPTData 28 | 29 | implicit none 30 | public 31 | 32 | abstract interface 33 | subroutine IRunnable(argument) 34 | integer :: argument 35 | end subroutine 36 | end interface 37 | 38 | type TRunnable 39 | procedure(IRunnable), pointer, nopass :: run 40 | integer, pointer :: argument 41 | end type 42 | 43 | type TRunnablePointer 44 | type(TRunnable), pointer :: value => null() 45 | end type 46 | 47 | type(TRunnablePointer), dimension(:), pointer :: routine_table => null() 48 | integer, parameter :: init_size = 16 49 | integer :: routine_table_size 50 | integer :: routine_table_mutex 51 | 52 | contains 53 | function start_routine(argument) bind(c) result(routine) 54 | use iso_c_binding 55 | implicit none 56 | 57 | type(c_ptr), value, intent(in) :: argument 58 | type(c_ptr) :: routine 59 | 60 | type(TRunnable), pointer :: runnable 61 | integer, pointer :: value 62 | 63 | call c_f_pointer(argument, runnable) 64 | call runnable%run(runnable%argument) 65 | 66 | routine = c_null_ptr 67 | end function 68 | end module 69 | -------------------------------------------------------------------------------- /Core/Threads/PTData.h: -------------------------------------------------------------------------------- 1 | /* 2 | * The Laboratory of Algorithms 3 | * 4 | * The MIT License 5 | * 6 | * Copyright 2011-2015 Andrey Pudov. 7 | * 8 | * Permission is hereby granted, free of charge, to any person obtaining a copy 9 | * of this software and associated documentation files (the 'Software'), to deal 10 | * in the Software without restriction, including without limitation the rights 11 | * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | * copies of the Software, and to permit persons to whom the Software is 13 | * furnished to do so, subject to the following conditions: 14 | * 15 | * The above copyright notice and this permission notice shall be included in 16 | * all copies or substantial portions of the Software. 17 | * 18 | * THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | * THE SOFTWARE. 25 | */ 26 | 27 | #ifndef PT_DATA_H_ 28 | #define PT_DATA_H_ 29 | 30 | #include 31 | 32 | #define INIT_SIZE 4 33 | #define FT_OK 0 34 | #define FT_EINIT -1 35 | #define FT_EINVALID -2 36 | 37 | #define false 0 38 | #define true 1 39 | 40 | typedef struct array_tag { 41 | void **data; 42 | int size; 43 | int after; 44 | pthread_mutex_t mutex; 45 | } array_t; 46 | 47 | typedef struct varray_tag { 48 | volatile void **data; 49 | int size; 50 | int after; 51 | pthread_mutex_t mutex; 52 | } varray_t; 53 | 54 | int is_initialized; 55 | 56 | array_t *threads; 57 | array_t *mutexes; 58 | 59 | array_t *thread_attributes; 60 | array_t *mutex_attributes; 61 | 62 | array_t *thread_keys; 63 | array_t *once_ctrls; 64 | 65 | void array_init(array_t **array, int size); 66 | void array_resize(array_t **array, int size); 67 | void array_delete(array_t *array); 68 | 69 | void varray_init(varray_t **array, int size); 70 | void varray_resize(varray_t **array, int size); 71 | void varray_delete(varray_t *array); 72 | 73 | int is_valid(array_t *arr, int id); 74 | 75 | #endif 76 | -------------------------------------------------------------------------------- /Core/Threads/PThreads.h: -------------------------------------------------------------------------------- 1 | /* 2 | * The Laboratory of Algorithms 3 | * 4 | * The MIT License 5 | * 6 | * Copyright 2011-2015 Andrey Pudov. 7 | * 8 | * Permission is hereby granted, free of charge, to any person obtaining a copy 9 | * of this software and associated documentation files (the 'Software'), to deal 10 | * in the Software without restriction, including without limitation the rights 11 | * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | * copies of the Software, and to permit persons to whom the Software is 13 | * furnished to do so, subject to the following conditions: 14 | * 15 | * The above copyright notice and this permission notice shall be included in 16 | * all copies or substantial portions of the Software. 17 | * 18 | * THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | * THE SOFTWARE. 25 | */ 26 | 27 | void thread_init(int *info); 28 | void thread_alloc(int *thread_id, int *info); 29 | void thread_create(int *thread_id, int *attribute_id, void *(**routine)(void *), 30 | void *argument, int* info); 31 | void thread_join(int *thread_id, void **value_pointer, int *info); 32 | void thread_cancel(int *thread_id, int *info); 33 | void thread_exit(void *value_pointer); 34 | void thread_destroy(int* info); 35 | 36 | void thread_mutex_init(int *mutex_id, int *attribute_id, int *info); 37 | void thread_mutex_lock(int *mutex_id, int *info); 38 | void thread_mutex_unlock(int *mutex_id, int *info); 39 | void thread_mutex_destroy(int *mutex_id, int *info); 40 | -------------------------------------------------------------------------------- /Examples/Example.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MExample 28 | 29 | use MEPingPong 30 | use MERubiksCube 31 | 32 | implicit none 33 | private 34 | 35 | type, public :: TExample 36 | contains 37 | procedure :: present 38 | end type 39 | 40 | contains 41 | subroutine present(instance) 42 | class(TExample), intent(in) :: instance 43 | 44 | type(TEPingPong) pingPong 45 | type(TERubiksCube) rubiksCube 46 | 47 | !call pingPong%present() 48 | call rubiksCube%present() 49 | end subroutine 50 | end module 51 | -------------------------------------------------------------------------------- /Examples/RubiksCube/Analyser.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2018 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MERubiksCubeAnalyser 28 | 29 | use MERubiksCubeCube 30 | use MERubiksCubeCommon 31 | 32 | implicit none 33 | private 34 | 35 | type, public :: TEAnalyser 36 | contains 37 | procedure, nopass :: cubiclesRate 38 | end type 39 | 40 | contains 41 | ! total number of cubicles related to their side 42 | function cubiclesRate(cube) result(value) 43 | class(TECube), intent(in) :: cube 44 | integer value 45 | 46 | value = count(cube%cube(1:3, 1:3, WHITE) == WHITE) & 47 | + count(cube%cube(1:3, 1:3, BLUE) == BLUE) & 48 | + count(cube%cube(1:3, 1:3, RED) == RED) & 49 | + count(cube%cube(1:3, 1:3, GREEN) == GREEN) & 50 | + count(cube%cube(1:3, 1:3, ORANGE) == ORANGE) & 51 | + count(cube%cube(1:3, 1:3, YELLOW) == YELLOW) 52 | end function 53 | end module -------------------------------------------------------------------------------- /Exercises/Exercises.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MExercises 28 | 29 | use MExAlg1p1e1 30 | use MExAlg1p2e1 31 | use MExAlg1p3e1 32 | !use MExAlg1p4e1 33 | use MExAlg1p5e1 34 | 35 | implicit none 36 | private 37 | 38 | type, public :: TExercises 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | contains 43 | subroutine present() 44 | type(TExAlg1p1e1) alg1p1e1 45 | type(TExAlg1p2e1) alg1p2e1 46 | type(TExAlg1p3e1) alg1p3e1 47 | !type(TExAlg1p4e1) alg1p5e1 48 | type(TExAlg1p5e1) alg1p5e1 49 | 50 | !call alg1p1e1%present() 51 | !call alg1p2e1%present() 52 | call alg1p3e1%present() 53 | !call alg1p4e1%present() 54 | !call alg1p5e1%present() 55 | end subroutine 56 | end module 57 | -------------------------------------------------------------------------------- /Exercises/alg1p1e1.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MExAlg1p1e1 28 | 29 | use MFileReader 30 | use MUReport 31 | 32 | implicit none 33 | private 34 | 35 | type, public :: TExAlg1p1e1 36 | contains 37 | procedure, nopass :: present 38 | end type 39 | contains 40 | subroutine present() 41 | call sortSequential() 42 | end subroutine 43 | 44 | subroutine sortSequential() 45 | type(TFileReader) fileReader 46 | 47 | integer, dimension(:), allocatable :: array 48 | integer(kind = 8) :: count = 0 49 | integer value 50 | integer index 51 | integer jndex 52 | real start 53 | 54 | call cpu_time(start) 55 | call fileReader%readListOfIntegers('Samples/IntegerArray', array) 56 | do index = 1, size(array) 57 | do jndex = index + 1, size(array) 58 | if (array(jndex) < array(index)) then 59 | value = array(jndex) 60 | array(jndex) = array(index) 61 | array(index) = value 62 | 63 | count = count + 1 64 | end if 65 | end do 66 | end do 67 | 68 | call report('Alg1p1e1', 'Sequential', '', start) 69 | print '(A,I)', 'Number of reverses: ', count 70 | 71 | deallocate(array) 72 | end subroutine 73 | end module 74 | -------------------------------------------------------------------------------- /Exercises/alg1p5e1.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MExAlg1p5e1 28 | 29 | use MIntrinsicRandom 30 | use MFileReader 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | type, public :: TExAlg1p5e1 37 | contains 38 | procedure, nopass :: present 39 | end type 40 | contains 41 | subroutine present() 42 | integer, dimension(:,:), allocatable :: list 43 | 44 | type(TFileReader) fileReader 45 | 46 | real start 47 | 48 | call fileReader%readAdjacencyWeightedList('Samples/dijkstraData_4_1', list) 49 | 50 | call cpu_time(start) 51 | call dijkstrasShortestPath(list) 52 | 53 | call report('Alg1p5e1', 'Dijkstra''s shortest-path', '', start) 54 | print '(A,I)', 'Shortest-path distances: ', 1 55 | 56 | deallocate(list) 57 | end subroutine 58 | 59 | recursive subroutine dijkstrasShortestPath(list) 60 | integer, dimension(:,:), allocatable, intent(in out) :: list 61 | 62 | integer index, jndex 63 | 64 | do index = 1, size(list, 1) 65 | do jndex = 1, size(list, 2) 66 | print '(I2\)', list(index, jndex) 67 | end do 68 | print *, '' 69 | end do 70 | end subroutine 71 | end module 72 | -------------------------------------------------------------------------------- /Experiments/Experiments.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MExperiments 28 | 29 | use MEXArraysRubiksCube 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TExperiments 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | contains 39 | subroutine present() 40 | type(RubiksCube) rubiksCube 41 | 42 | call rubiksCube%present() 43 | end subroutine 44 | end module 45 | -------------------------------------------------------------------------------- /Features/Arrays/Reallocation.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFReallocation 28 | 29 | use MArrays 30 | use MUAsserts 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | integer, parameter :: NUMBER_OF_ELEMENTS = 5 37 | 38 | type, public :: TFReallocation 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | contains 43 | subroutine present() 44 | call oneDimensional() 45 | call twoDimensional() 46 | 47 | print *, '' 48 | end subroutine present 49 | 50 | subroutine oneDimensional() 51 | integer, dimension(:), allocatable :: array 52 | integer, dimension(:), allocatable :: temporary_array 53 | 54 | type(TArrays) Arrays 55 | real start 56 | 57 | call cpu_time(start) 58 | 59 | allocate(array(NUMBER_OF_ELEMENTS)) 60 | call Arrays.fillWithSequence(array) 61 | allocate(temporary_array(NUMBER_OF_ELEMENTS + 2)) 62 | temporary_array(1:size(array)) = array 63 | 64 | call report('Reallocation', 'OneDimension', '', start) 65 | call assert_equals(temporary_array(1:size(array)), array) 66 | 67 | deallocate(array) 68 | call move_alloc(temporary_array, array) 69 | 70 | deallocate(array) 71 | end subroutine 72 | 73 | subroutine twoDimensional() 74 | integer, dimension(:,:), allocatable :: array 75 | integer, dimension(:,:), allocatable :: temporary_array 76 | 77 | type(TArrays) Arrays 78 | real start 79 | 80 | call cpu_time(start) 81 | 82 | allocate(array(NUMBER_OF_ELEMENTS, NUMBER_OF_ELEMENTS)) 83 | 84 | call Arrays.fillWithSequence(array) 85 | allocate(temporary_array(NUMBER_OF_ELEMENTS + 2, NUMBER_OF_ELEMENTS + 2)) 86 | temporary_array(1:size(array, 1), 1:size(array, 2)) = array 87 | 88 | call report('Reallocation', 'TwoDimension', '', start) 89 | call assert_equals(temporary_array(1:size(array, 1), 1:size(array, 2)), array) 90 | 91 | deallocate(array) 92 | call move_alloc(temporary_array, array) 93 | 94 | deallocate(array) 95 | end subroutine 96 | end module 97 | -------------------------------------------------------------------------------- /Features/Feature.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFeature 28 | 29 | use MFArrays 30 | use MFReallocation 31 | 32 | use MFInheritance 33 | !use MFConstructor 34 | 35 | use MFOpemMPExample1 36 | use MFOpemMPExample2 37 | use MFOpemMPExample3 38 | use MFOpemMPExample4 39 | 40 | implicit none 41 | private 42 | 43 | type, public :: TFeature 44 | contains 45 | procedure :: present 46 | end type 47 | contains 48 | subroutine present(instance) 49 | class(TFeature), intent(in) :: instance 50 | 51 | type(TFArrays) arrays 52 | type(TFReallocation) reallocation 53 | 54 | type(TFInheritance) inheritance 55 | !type(TFConstructor) constructor 56 | 57 | type(TFExample1) openMPEx1 58 | type(TFExample2) openMPEx2 59 | type(TFExample3) openMPEx3 60 | type(TFExample4) openMPEx4 61 | 62 | !constructor = TFConstructor(6) 63 | !call constructor%method() 64 | 65 | !call arrays%present() 66 | !call reallocation%present() 67 | 68 | !call inheritance%present() 69 | 70 | !call openMPEx1%present() 71 | !call openMPEx2%present() 72 | !call openMPEx3%present() 73 | call openMPEx4%present() 74 | end subroutine 75 | end module 76 | -------------------------------------------------------------------------------- /Features/Inheritance/Animal.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFAnimal 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TFAnimal 33 | contains 34 | procedure(ISay), deferred :: say 35 | end type 36 | 37 | abstract interface 38 | function ISay(instance) result(say) 39 | import TFAnimal 40 | 41 | class(TFAnimal), intent(in) :: instance 42 | character(len=80) :: say 43 | end function 44 | end interface 45 | end module 46 | -------------------------------------------------------------------------------- /Features/Inheritance/Cat.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFCat 28 | 29 | use MFAnimal 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TFAnimal), public :: TFCat 35 | contains 36 | procedure :: say 37 | end type 38 | contains 39 | function say(instance) 40 | class(TFCat), intent(in) :: instance 41 | character(len=80) :: say 42 | 43 | say = 'Myaw' 44 | end function 45 | end module 46 | -------------------------------------------------------------------------------- /Features/Inheritance/Circle.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFCircle 28 | 29 | use MFShape 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TFShape), public :: TFCircle 35 | contains 36 | procedure :: getArea 37 | end type 38 | 39 | interface TFCircle 40 | module procedure init 41 | end interface 42 | contains 43 | function init(radius) result(circle) 44 | real, intent(in) :: radius 45 | type(TFCircle) :: circle 46 | 47 | circle%width = radius 48 | end function 49 | 50 | function getArea(this) result(area) 51 | class(TFCircle), intent(in) :: this 52 | real :: area 53 | 54 | area = this%width * this%width * 3.14159265 / 4.0 55 | end function 56 | end module 57 | -------------------------------------------------------------------------------- /Features/Inheritance/Dog.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFDog 28 | 29 | use MFAnimal 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TFAnimal), public :: TFDog 35 | contains 36 | procedure :: say 37 | end type 38 | contains 39 | function say(instance) 40 | class(TFDog), intent(in) :: instance 41 | character(len=80) :: say 42 | 43 | say = 'Guaw' 44 | end function 45 | end module 46 | -------------------------------------------------------------------------------- /Features/Inheritance/Inheritance.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFInheritance 28 | 29 | use MFAnimal 30 | use MFCat 31 | use MFDog 32 | 33 | use MFShape 34 | use MFCircle 35 | 36 | use MUAsserts 37 | use MUReport 38 | 39 | implicit none 40 | private 41 | 42 | type, public :: TFInheritance 43 | contains 44 | procedure :: present 45 | end type 46 | contains 47 | subroutine present(instance) 48 | class(TFInheritance), intent(in) :: instance 49 | type(TFCat) cat 50 | type(TFCircle) circle 51 | 52 | ! construct the circle 53 | circle = TFCircle(17.0) 54 | 55 | call say(cat) 56 | call area(circle) 57 | end subroutine 58 | 59 | subroutine say(animal) 60 | class(TFAnimal), intent(in) :: animal 61 | character(len=80) :: word 62 | real start 63 | 64 | call cpu_time(start) 65 | word = animal%say() 66 | 67 | call report('Inheritance', 'Say', '', start) 68 | call assert_equals(trim(word), 'Myaw') 69 | end subroutine 70 | 71 | subroutine area(shape) 72 | class(TFShape), intent(in) :: shape 73 | real value 74 | real start 75 | 76 | call cpu_time(start) 77 | value = shape%getArea() 78 | 79 | call report('Inheritance', 'Area', '', start) 80 | call assert_equals(value, 17 * 17 * 3.14159265 / 4.0) 81 | end subroutine 82 | end module 83 | -------------------------------------------------------------------------------- /Features/Inheritance/Shape.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFShape 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TFShape 33 | real :: width 34 | real :: height 35 | contains 36 | procedure(IGetArea), deferred :: getArea 37 | end type 38 | 39 | abstract interface 40 | function IGetArea(this) result(area) 41 | import TFShape 42 | 43 | class(TFShape), intent(in) :: this 44 | real :: area 45 | end function 46 | end interface 47 | end module 48 | -------------------------------------------------------------------------------- /Features/OpenMP/Example1.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFOpemMPExample1 28 | 29 | use omp_lib 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TFExample1 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | contains 39 | subroutine present() 40 | integer :: nthreads 41 | integer :: myid 42 | 43 | !$omp parallel private(nthreads, myid) 44 | 45 | myid = OMP_GET_THREAD_NUM() 46 | print '(A,I)', 'Hello I am thread ', myid 47 | 48 | !$omp master 49 | nthreads = OMP_GET_NUM_THREADS() 50 | print '(A,I)', 'Number of threads ', nthreads 51 | !$omp end master 52 | 53 | !$omp end parallel 54 | end subroutine 55 | end module 56 | -------------------------------------------------------------------------------- /Features/OpenMP/Example2.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFOpemMPExample2 28 | 29 | use omp_lib 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TFExample2 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | contains 39 | subroutine present() 40 | integer(selected_int_kind(18)), parameter :: intervals = 1e7 41 | integer(selected_int_kind(18)) :: i 42 | integer :: nthreads, threadid 43 | 44 | real(kind(1.d0)), parameter :: PI25DT = acos(-1.d0) 45 | real(kind(1.d0)) :: dx, sum, x 46 | real(kind(1.d0)) :: f, pi 47 | 48 | real(kind(1.d0)) :: time1, time2 49 | 50 | !$omp parallel 51 | nthreads = OMP_GET_NUM_THREADS() 52 | threadid = OMP_GET_THREAD_NUM() 53 | if (threadid == 0) then 54 | print '(A,I)', 'The number of threads: ', nthreads 55 | end if 56 | !$omp end parallel 57 | 58 | print '(A, I)', 'The number of intervals: ', intervals 59 | sum = 0.d0 60 | dx = 1.d0 / intervals 61 | time1 = omp_get_wtime() 62 | 63 | !$omp parallel do private(x, f) & 64 | !$omp reduction(+:sum) 65 | do i = intervals, 1, -1 66 | x = dx * (i - 0.5d0) 67 | f = 4.d0 / (1.d0 + x * x) 68 | sum = sum + f 69 | end do 70 | !$omp end parallel do 71 | 72 | pi = dx * sum 73 | time2 = omp_get_wtime() 74 | 75 | print '(a13,2x,f30.25)', 'Computed PI = ', pi 76 | print '(a13,2x,f30.25)', 'The true PI = ', PI25DT 77 | print '(a13,2x,f30.25)', 'Error ', PI25DT - pi 78 | print '(X)' 79 | print *, 'Elapsed time ', time2 - time1, ' s.' 80 | end subroutine 81 | end module 82 | -------------------------------------------------------------------------------- /Features/OpenMP/Example3.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFOpemMPExample3 28 | 29 | use omp_lib 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TFExample3 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | contains 39 | subroutine present() 40 | integer, parameter :: N = 3 41 | integer, parameter :: K = 3 42 | 43 | integer, dimension(0:K) :: buffer 44 | integer nthreads, threadid 45 | integer index, jndex 46 | integer start, end 47 | real divider 48 | 49 | integer count 50 | 51 | !$omp parallel private(nthreads, threadid, buffer) reduction(+:count) 52 | 53 | nthreads = OMP_GET_NUM_THREADS() 54 | threadid = OMP_GET_THREAD_NUM() 55 | buffer = 0 56 | start = -1 57 | end = -1 58 | 59 | do while (buffer(0) == 0 .and. buffer(1) /= end) 60 | if (start == -1) then 61 | divider = N / real(nthreads) 62 | start = floor(divider * threadid + 1.0) 63 | end = ceiling(start + divider - 1) 64 | 65 | buffer(1) = start - 1 66 | end if 67 | 68 | print '(I3,4X,4I2)', threadid, buffer(1:K) + 1 69 | count = count + 1 70 | 71 | buffer(K) = buffer(K) + 1 72 | index = K 73 | do while (buffer(index) == N) 74 | buffer(index) = 0 75 | index = index - 1 76 | buffer(index) = buffer(index) + 1 77 | end do 78 | end do 79 | 80 | !$omp end parallel 81 | 82 | print '(A,I,A,I)', 'Expected: ', N ** K, ' Processed: ', count 83 | end subroutine 84 | end module 85 | -------------------------------------------------------------------------------- /Features/OpenMP/Example4.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFOpemMPExample4 28 | 29 | use omp_lib 30 | 31 | implicit none 32 | private 33 | 34 | integer(kind=omp_lock_kind) :: lock 35 | logical :: pingpong 36 | 37 | type, public :: TFExample4 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | 44 | call omp_init_lock(lock) 45 | pingpong = .false. 46 | 47 | !$omp parallel default(none) shared(lock, pingpong) 48 | !$omp sections 49 | 50 | !$omp section 51 | call ping() 52 | 53 | !$omp section 54 | call pong() 55 | 56 | !$omp end sections 57 | !$omp end parallel 58 | 59 | call omp_destroy_lock(lock) 60 | end subroutine 61 | 62 | subroutine ping() 63 | integer index 64 | index = 0 65 | 66 | do while (index <= 10) 67 | call omp_set_lock(lock) 68 | 69 | if (pingpong) then 70 | print '(A)', 'Ping' 71 | 72 | pingpong = .false. 73 | index = index + 1 74 | end if 75 | 76 | !$omp flush(pingpong) 77 | 78 | call omp_unset_lock(lock) 79 | end do 80 | end subroutine 81 | 82 | subroutine pong() 83 | integer index 84 | index = 0 85 | 86 | do while (index <= 10) 87 | call omp_set_lock(lock) 88 | 89 | if (pingpong .ne. .true.) then 90 | print '(A)', 'Pong' 91 | 92 | pingpong = .true. 93 | index = index + 1 94 | end if 95 | 96 | !$omp flush(pingpong) 97 | 98 | call omp_unset_lock(lock) 99 | end do 100 | end subroutine 101 | end module 102 | -------------------------------------------------------------------------------- /Foundation/Date.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (Foundation) Date 28 | contains 29 | module subroutine date_init(self) 30 | class(Date), intent(in out) :: self 31 | end subroutine 32 | 33 | module subroutine date_initWithString(self, text) 34 | class(Date), intent(in out) :: self 35 | class(String), intent(in) :: text 36 | end subroutine 37 | end submodule 38 | -------------------------------------------------------------------------------- /Foundation/Object.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (Foundation) Object 28 | contains 29 | module subroutine object_init(self) 30 | class(Object), intent(in out) :: self 31 | end subroutine 32 | 33 | module subroutine object_destroy(self) 34 | class(Object), intent(in out) :: self 35 | end subroutine 36 | 37 | module function object_equals(self, any) result(value) 38 | class(Object), target, intent(in) :: self 39 | class(Object), target, intent(in) :: any 40 | logical :: value 41 | 42 | class(Object), pointer :: any_pointer 43 | any_pointer => any 44 | 45 | value = associated(any_pointer, self) 46 | end function 47 | 48 | module function object_description(self) result(value) 49 | class(Object), intent(in) :: self 50 | type(String) :: value 51 | 52 | type(String) string 53 | 54 | value = string 55 | end function 56 | end submodule 57 | -------------------------------------------------------------------------------- /Graphs/Vertex.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MVertex 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: TVertex 33 | private 34 | integer :: value 35 | logical :: visited 36 | contains 37 | procedure :: getValue 38 | procedure :: setValue 39 | 40 | procedure :: isVisited 41 | procedure :: setVisited 42 | 43 | procedure :: init 44 | procedure :: destroy 45 | end type 46 | contains 47 | function getValue(instance) result(value) 48 | class(TVertex), intent(in) :: instance 49 | integer :: value 50 | 51 | value = instance%value 52 | end function 53 | 54 | subroutine setValue(instance, value) 55 | class(TVertex), intent(in out) :: instance 56 | integer, intent(in) :: value 57 | 58 | instance%value = value 59 | end subroutine 60 | 61 | function isVisited(instance) result(value) 62 | class(TVertex), intent(in) :: instance 63 | logical :: value 64 | 65 | value = instance%visited 66 | end function 67 | 68 | subroutine setVisited(instance, value) 69 | class(TVertex), intent(in out) :: instance 70 | logical, intent(in) :: value 71 | 72 | instance%visited = value 73 | end subroutine 74 | 75 | subroutine init(instance, value, visited) 76 | class(TVertex), intent(in out) :: instance 77 | integer, optional, intent(in) :: value 78 | logical, optional, intent(in) :: visited 79 | 80 | if ((present(value) == .false.) .or. (present(visited) == .false.)) then 81 | instance%value = 0 82 | instance%visited = .false. 83 | 84 | return 85 | end if 86 | 87 | instance%value = value 88 | instance%visited = visited 89 | end subroutine 90 | 91 | subroutine destroy(instance) 92 | class(TVertex), intent(in out) :: instance 93 | 94 | instance%value = 0 95 | instance%visited = .false. 96 | end subroutine 97 | end module 98 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Andrey Pudov 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 | FC = ifort 2 | CC = clang 3 | FFLAGS = -c -free -module Modules -reentrancy threaded -qopenmp -ipo -g3 -warn all -warn nounused # -fast -parallel -O3 4 | CFLAGS = -c -pthread -openmp -g 5 | LDFLAGS = -qopenmp 6 | 7 | INTERFACES = Arrays/Arrays.f \ 8 | Units/Asserts.f Units/Report.f \ 9 | Examples/RubiksCube/Common.f Examples/RubiksCube/Cube.f \ 10 | Examples/RubiksCube/Analyser.f Examples/RubiksCube/Rotator.f \ 11 | Examples/RubiksCube/Search.f Examples/RubiksCube/RubiksCube.f \ 12 | Features/Inheritance/Animal.f Features/Inheritance/Shape.f \ 13 | Foundation/Foundation.f \ 14 | Randoms/Random.f \ 15 | Searches/Search.f \ 16 | Structures/Iterator.f Structures/ListIterator.f \ 17 | Structures/ListEntry.f Structures/LinkedListEntry.f \ 18 | Structures/LinkedListIterator.f Structures/List.f Structures/Queue.f Structures/Stack.f \ 19 | Sorts/Sort.f \ 20 | Graphs/Vertex.f Graphs/Graph.f \ 21 | Structures/ArrayStack.f Structures/ArrayQueue.f \ 22 | Units/Foundation/UFoundation.f Units/Parameters.f 23 | INCLUDES = $(foreach d, $(shell find . -name '*.h'), -I$d) 24 | EXCLUDES = $(patsubst %, ! -path './%', Algorithms.f Examples/* Exercises/* Features/* Problems/*) \ 25 | $(patsubst %, ! -path './%', $(INTERFACES)) 26 | SOURCES = $(INTERFACES) \ 27 | $(shell find . -name '*.c' $(EXCLUDES) | sort) \ 28 | $(shell find . -name '*.f' $(EXCLUDES) | sort) \ 29 | $(shell find Examples -name '*.f' ! -name 'Example.f' | sort) Examples/Example.f \ 30 | $(shell find Exercises -name '*.f' ! -name 'Exercises.f' | sort) Exercises/Exercises.f \ 31 | $(shell find Features -name '*.f' ! -name 'Feature.f' | sort) Features/Feature.f \ 32 | $(shell find Problems -name '*.f' ! -name 'Problems.f' | sort) Problems/Problems.f \ 33 | Algorithms.f 34 | OBJECTS = $(patsubst %.f, Objects/%.o, $(patsubst %.c, Objects/%_c.o, $(SOURCES))) 35 | EXECUTABLE = algorithms 36 | 37 | all: $(SOURCES) $(EXECUTABLE) 38 | 39 | $(EXECUTABLE): $(OBJECTS) 40 | @echo 'Linking to $@...' 41 | @$(FC) $(LDFLAGS) $(OBJECTS) -o Objects/$@ 42 | 43 | Objects/%.o: %.f 44 | @echo 'Compiling $@...' 45 | @mkdir -p Modules 46 | @mkdir -p $(dir $@) 47 | @$(FC) $(FFLAGS) -c $< -o $@ 48 | 49 | Objects/%_c.o: %.c 50 | @echo 'Compiling $@...' 51 | @mkdir -p $(dir $@) 52 | @$(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ 53 | 54 | clean: 55 | @echo "Cleaning..." 56 | @rm -rf Modules Objects $(EXECUTABLE) 57 | -------------------------------------------------------------------------------- /Math/Fibonacci.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MFibonacci 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: TFibonacci 33 | contains 34 | procedure, nopass :: fibonacci => fibonacciRecursive 35 | 36 | procedure, nopass :: fibonacciRecursive 37 | procedure, nopass :: fibonacciIterate 38 | end type 39 | contains 40 | recursive function fibonacciRecursive(position) result(fibonacci) 41 | integer, intent(in) :: position 42 | integer :: fibonacci 43 | 44 | if (position <= 2) then 45 | fibonacci = 1 46 | return 47 | end if 48 | 49 | fibonacci = fibonacciRecursive(position - 1) + fibonacciRecursive(position - 2) 50 | end function 51 | 52 | function fibonacciIterate(position) result(fibonacci) 53 | integer, intent(in) :: position 54 | integer :: fibonacci 55 | 56 | integer, dimension(10), save :: buffer 57 | integer, save :: index = 3 58 | buffer(1) = 1 59 | buffer(2) = 1 60 | 61 | if (buffer(position) == 0) then 62 | do index = index, position 63 | buffer(index) = buffer(index - 1) + buffer(index - 2) 64 | end do 65 | end if 66 | 67 | fibonacci = buffer(position) 68 | end function 69 | end module 70 | -------------------------------------------------------------------------------- /Math/GreatestCommonDivisir.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MGreatestCommonDivisor 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: TGreatestCommonDivisor 33 | contains 34 | procedure, nopass :: gcd => gcdOriginal 35 | 36 | procedure, nopass :: gcdOriginal 37 | end type 38 | contains 39 | function gcdOriginal(value1, value2) result(gcd) 40 | integer, intent(in) :: value1 41 | integer, intent(in) :: value2 42 | integer :: gcd 43 | integer :: v1 44 | integer :: v2 45 | 46 | v1 = value1 47 | v2 = value2 48 | 49 | do while (v1 > 0) 50 | if (v1 < v2) then 51 | gcd = v1 52 | v1 = v2 53 | v2 = gcd 54 | end if 55 | 56 | v1 = v1 - v2 57 | end do 58 | 59 | gcd = v2 60 | end function 61 | end module 62 | -------------------------------------------------------------------------------- /Networks/HopfieldNetwork.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MHopfieldNetwork 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: THopfieldNetwork 33 | private 34 | integer, dimension(:,:), allocatable :: weights 35 | integer :: neurons 36 | contains 37 | !procedure :: train 38 | !procedure :: recognize 39 | 40 | procedure :: init 41 | procedure :: destroy 42 | end type 43 | contains 44 | subroutine init(this, neurons) 45 | class(THopfieldNetwork), intent(in out) :: this 46 | integer, intent(in) :: neurons 47 | 48 | allocate(this%weights(neurons, neurons)) 49 | this%weights = 0 50 | this%neurons = neurons 51 | end subroutine 52 | 53 | subroutine destroy(this) 54 | class(THopfieldNetwork), intent(in out) :: this 55 | 56 | deallocate(this%weights) 57 | this%neurons = 0 58 | end subroutine 59 | end module 60 | -------------------------------------------------------------------------------- /Networks/Neuron.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MNeuron 28 | 29 | implicit none 30 | private 31 | 32 | type, public :: TNeuron 33 | private 34 | integer, dimension(4) :: weights 35 | integer :: activation 36 | contains 37 | procedure :: activate 38 | 39 | final :: destroy 40 | end type 41 | 42 | interface TNeuron 43 | procedure :: init 44 | end interface 45 | contains 46 | function activate(this, pattern) result(activation) 47 | class(TNeuron), intent(in out) :: this 48 | integer, dimension(:), intent(in) :: pattern 49 | integer :: activation 50 | integer :: index 51 | 52 | do index = 1, size(pattern) 53 | activation = activation + pattern(index) * this%weights(index) 54 | end do 55 | end function 56 | 57 | function init() result(object) 58 | type(TNeuron) :: object 59 | 60 | object%activation = 0 61 | object%weights = 0 62 | end function 63 | 64 | subroutine destroy(this) 65 | type(TNeuron), intent(in out) :: this 66 | 67 | this%activation = 0 68 | this%weights = 0 69 | end subroutine 70 | end module 71 | -------------------------------------------------------------------------------- /Networks/SingleLayerPerceptron.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! 28 | ! Introduced by F. Rosenbalt in 1958 29 | ! 30 | ! Sample structure 31 | ! 32 | ! Input Values 33 | ! | | | 34 | ! O O O Input Layer 35 | ! \ / \ / Weight Matrix 36 | ! O O Output Layer 37 | ! | | 38 | ! Output Values 39 | ! 40 | ! Type Feedforward 41 | ! Neuron Layers 1 input layer 42 | ! 1 output layer 43 | ! Input Value Types Binary 44 | ! Activation Function Hard limiter 45 | ! Learning Method Supervised 46 | ! Learning Algorithm Hebb learning rule 47 | ! Mainly Used In Single logical operations 48 | ! Pattern classification 49 | ! 50 | 51 | module MSingleLayerPerceptron 52 | 53 | implicit none 54 | private 55 | 56 | type, public :: TSingleLayerPerceptron 57 | private 58 | integer, dimension(:,:), allocatable :: weights 59 | integer :: inputNeurons 60 | integer :: outputNeurons 61 | contains 62 | !procedure :: train 63 | !procedure :: recognize 64 | 65 | procedure :: init 66 | procedure :: destroy 67 | end type 68 | contains 69 | subroutine init(this, inputNeurons, outputNeurons) 70 | class(TSingleLayerPerceptron), intent(in out) :: this 71 | integer, intent(in) :: inputNeurons 72 | integer, intent(in) :: outputNeurons 73 | 74 | allocate(this%weights(inputNeurons, outputNeurons)) 75 | this%inputNeurons = inputNeurons 76 | this%outputNeurons = outputNeurons 77 | end subroutine 78 | 79 | subroutine destroy(this) 80 | class(TSingleLayerPerceptron), intent(in out) :: this 81 | 82 | deallocate(this%weights) 83 | this%inputNeurons = 0 84 | this%outputNeurons = 0 85 | end subroutine 86 | end module 87 | -------------------------------------------------------------------------------- /Problems/Problems.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MProblems 28 | 29 | use MProjectEuler 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TProblems 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | contains 39 | subroutine present() 40 | type(TProjectEuler) projectEuler 41 | 42 | call projectEuler%present() 43 | end subroutine 44 | end module 45 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem10.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17. 28 | ! 29 | ! Find the sum of all the primes below two million. 30 | module MPEProblem10 31 | 32 | implicit none 33 | private 34 | 35 | type, public :: TPEProblem10 36 | contains 37 | procedure, nopass :: present 38 | end type 39 | contains 40 | subroutine present 41 | write (*, '(A)') 'Problem 10. Summation of primes.' 42 | 43 | write (*, '(A, I)') 'Sum 1: ', sum1() 44 | end subroutine 45 | 46 | pure function sum1() 47 | integer(8), parameter :: limit = 2000000 48 | integer(8), dimension(limit) :: list 49 | 50 | integer(8) :: sum1 51 | integer(8) :: index 52 | integer(8) :: iterator 53 | 54 | ! initial value 55 | sum1 = 0 56 | iterator = 1 57 | 58 | ! fill the list of prime numbers 59 | do index = 2, limit 60 | if (isPrime(index)) then 61 | list(iterator) = index 62 | sum1 = sum1 + index 63 | 64 | iterator = iterator + 1 65 | end if 66 | end do 67 | end function 68 | 69 | pure function isPrime(number) 70 | integer(8), intent(in) :: number 71 | 72 | integer(8) devider 73 | logical(8) isPrime 74 | 75 | ! initial value 76 | isPrime = .true. 77 | 78 | do devider = 2, sqrt(real(number)) 79 | if (mod(number, devider) .eq. 0) then 80 | isPrime = .false. 81 | exit 82 | end if 83 | end do 84 | end function 85 | end module 86 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem12.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Highly divisible triangular number 28 | ! 29 | ! The sequence of triangle numbers is generated by adding the natural numbers. 30 | ! So the 7th trianlge number would be 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first 31 | ! ten terms would be: 32 | ! 33 | ! 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ... 34 | ! 35 | ! Let us list the factors of the first seven triangle numbers: 36 | ! 1: 1 37 | ! 3: 1, 3 38 | ! 6: 1, 2, 3, 6 39 | ! 10: 1, 2, 5, 10 40 | ! 15: 1, 3, 5, 15 41 | ! 21: 1, 3, 7, 21 42 | ! 28: 1, 2, 4, 7, 14, 28 43 | ! 44 | ! We can see that 28 is the first triangle number to have over five divisirs. 45 | ! What is the value of the first triangle number to have over five hundred divisors? 46 | module MPEProblem12 47 | 48 | implicit none 49 | private 50 | 51 | type, public :: TPEProblem12 52 | contains 53 | procedure, nopass :: present 54 | end type 55 | contains 56 | subroutine present 57 | write (*, '(A)') 'Problem 12. Highly divisible triangular number.' 58 | 59 | write (*, '(A, I)') 'Triangle 1: ', triangle1() 60 | end subroutine 61 | 62 | pure function triangle1() 63 | integer*8 triangle1 64 | 65 | integer number 66 | integer base 67 | integer divisors 68 | 69 | ! initial values 70 | triangle1 = 1 71 | number = 1 72 | 73 | do while (.true.) 74 | divisors = 0 75 | do base = 1, sqrt(real(triangle1)) 76 | if (mod(triangle1, base) .eq. 0) then 77 | divisors = divisors + 1 78 | end if 79 | end do 80 | 81 | ! the number of divisors is two times less in case of sqr 82 | if (divisors .ge. 250) then 83 | return 84 | end if 85 | 86 | number = number + 1 87 | triangle1 = triangle1 + number 88 | end do 89 | end function 90 | end module 91 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem15.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Lattice paths 28 | ! 29 | ! Starting in the top left corner of a 2x2 grid, and only being able to move to 30 | ! the right and down, there are exactly 6 routes to the bottom right corner. 31 | ! 32 | ! ¯¯| ¯|_ ¯| |__ |_ | 33 | ! | | |_ | |_ |__ 34 | ! 35 | ! How many such routes are there through a 20x20 grid? 36 | module MPEProblem15 37 | 38 | implicit none 39 | private 40 | 41 | ! global variable to store available pathes 42 | integer :: pathes 43 | 44 | type, public :: TPEProblem15 45 | contains 46 | procedure, nopass :: present 47 | end type 48 | contains 49 | subroutine present 50 | write (*, '(A)') 'Problem 15. Lattice paths.' 51 | call path(2, 2) 52 | write (*, '(A, I)') 'Path 1: ', pathes 53 | end subroutine 54 | 55 | ! 56 | ! Offered solution implements following loop: 57 | ! 1) step right if not visited 58 | ! 2) step down if not visited and inverse all accesible steps (right and down) 59 | ! 3) step back 60 | ! 61 | subroutine path(width, height) 62 | integer, intent(in) :: width 63 | integer, intent(in) :: height 64 | 65 | 66 | end subroutine 67 | end module 68 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem2.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Even Fibonacci numbers 28 | ! 29 | ! Each new term in the Fibonacci sequence is generated by adding the previous 30 | ! two terms. By starting with 1 and 2, the first 10 terms will be: 31 | ! 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ... 32 | ! By considering the terms in the Fibonacci sequence whose values do not exceed 33 | ! four million, find the sum of the even-valued terms. 34 | module MPEProblem2 35 | 36 | implicit none 37 | private 38 | 39 | type, public :: TPEProblem2 40 | contains 41 | procedure, nopass :: present 42 | end type 43 | contains 44 | subroutine present 45 | write (*, '(A)') 'Problem 2. Even Fibonacci numbers.' 46 | 47 | write (*, '(A, I)') 'Even 1: ', even1() 48 | write (*, '(A, I)') 'Even 2: ', even2() 49 | end subroutine 50 | 51 | ! A direct translation of the problem statement 52 | function even1() 53 | integer even1 54 | integer prev 55 | integer cur 56 | integer temp 57 | 58 | ! initial values 59 | even1 = 0 60 | prev = 1 61 | cur = 1 62 | temp = 0 63 | 64 | do while (cur <= 4000000) 65 | if (mod(cur, 2) .eq. 0) then 66 | even1 = even1 + cur 67 | end if 68 | 69 | temp = cur 70 | cur = cur + prev 71 | prev = temp 72 | end do 73 | end function 74 | 75 | ! only every third number is added 76 | function even2() 77 | integer even2 78 | integer prev 79 | integer cur 80 | integer temp 81 | 82 | ! initial values 83 | even2 = 0 84 | prev = 1 85 | cur = 1 86 | temp = prev + cur 87 | 88 | do while (temp < 4000000) 89 | even2 = even2 + temp 90 | prev = cur + temp 91 | cur = temp + prev 92 | temp = prev + cur 93 | end do 94 | end function 95 | end module 96 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem3.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Largest prime factor 28 | ! 29 | ! The prime factors of 13195 are 5, 7, 13 and 29. 30 | ! What is the largest prime factor of the number 600851475143 ? 31 | module MPEProblem3 32 | 33 | implicit none 34 | private 35 | 36 | type, public :: TPEProblem3 37 | contains 38 | procedure, nopass :: present 39 | end type 40 | contains 41 | subroutine present 42 | write (*, '(A)') 'Problem 3. Largest prime factor.' 43 | 44 | write (*, '(A, I)') 'Factor 1: ', factor() 45 | end subroutine 46 | 47 | function factor() 48 | integer*8 factor 49 | integer*8 index 50 | 51 | factor = 600851475143 52 | index = 2 53 | 54 | do while ((index ** 2) .le. factor) 55 | if (mod(factor, index) .eq. 0) then 56 | factor = factor / index 57 | else 58 | index = index + 1 59 | end if 60 | end do 61 | end function 62 | end module 63 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem4.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Largest palindrome product 28 | ! 29 | ! A palindromic number reads the same both ways. The largest palindrome made 30 | ! from the product of two 2-digit numbers is 9009 = 91x99.? 31 | ! Find the largest palindrome made from the product of two 3-digit numbers. 32 | module MPEProblem4 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TPEProblem4 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present 43 | write (*, '(A)') 'Problem 4. Largest palindrome product.' 44 | 45 | write (*, '(A, I)') 'Palindrome 1: ', palindrome() 46 | end subroutine 47 | 48 | function palindrome() 49 | integer palindrome 50 | integer current 51 | integer number1 52 | integer number2 53 | 54 | integer number 55 | integer digit 56 | integer remaining 57 | 58 | palindrome = 0 59 | 60 | do number1 = 999, 100, -1 61 | do number2 = 999, 100, -1 62 | current = number1 * number2 63 | 64 | number = current 65 | remaining = 0 66 | do while (number .gt. 0) 67 | digit = mod(number, 10) 68 | remaining = remaining * 10 + digit 69 | number = number / 10 70 | end do 71 | 72 | if (remaining .eq. current) then 73 | if (current .gt. palindrome) then 74 | palindrome = current 75 | end if 76 | end if 77 | end do 78 | end do 79 | end function 80 | end module 81 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem5.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Smallest multiple 28 | ! 29 | ! 2520 is the smallest number that can be divided by each of the numbers 30 | ! from 1 to 10 without any remainder. 31 | ! 32 | ! What is the smallest positive number that is evenly divisible by all of 33 | ! the numbers from 1 to 20? 34 | module MPEProblem5 35 | 36 | implicit none 37 | private 38 | 39 | type, public :: TPEProblem5 40 | contains 41 | procedure, nopass :: present 42 | end type 43 | contains 44 | subroutine present 45 | write (*, '(A)') 'Problem 5. Smallest multiple.' 46 | 47 | write (*, '(A, I)') 'Multiple 1: ', multiple1() 48 | write (*, '(A, I)') 'Multiple 2: ', multiple2() 49 | end subroutine 50 | 51 | function multiple1() 52 | integer multiple1 53 | integer base 54 | logical flag 55 | 56 | do multiple1 = 1, huge(multiple1) 57 | flag = .true. 58 | 59 | do base = 1, 20 60 | if (mod(multiple1, base) .ne. 0) then 61 | flag = .false. 62 | end if 63 | end do 64 | 65 | if (flag .eq. .true.) then 66 | return 67 | end if 68 | end do 69 | end function 70 | 71 | function multiple2() 72 | integer multiple2 73 | integer base 74 | logical flag 75 | 76 | do multiple2 = 1, huge(multiple2) 77 | flag = .true. 78 | 79 | do base = 2, 20 80 | if (mod(multiple2, base) .ne. 0) then 81 | flag = .false. 82 | exit 83 | end if 84 | end do 85 | 86 | if (flag .eq. .true.) then 87 | return 88 | end if 89 | end do 90 | end function 91 | end module 92 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem6.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Sum square difference 28 | ! 29 | ! The sum of the squares of the first ten natural numbers is, 30 | ! 1^2 + 2^2 + ... + 10^2 = 385 31 | ! 32 | ! The square of the sum of the first ten natural numbers is, 33 | ! (1 + 2 + ... + 10)^2 = 55^2 = 3025 34 | ! 35 | ! Hence the difference between the sum of the squares of the first ten natural 36 | ! numbers and the square of the sum is 3025 - 385 = 2640. 37 | ! 38 | ! Find the difference between the sum of the squares of the first one hundred 39 | ! natural numbers and the square of the sum. 40 | module MPEProblem6 41 | 42 | implicit none 43 | private 44 | 45 | type, public :: TPEProblem6 46 | contains 47 | procedure, nopass :: present 48 | end type 49 | contains 50 | subroutine present 51 | write (*, '(A)') 'Problem 6. Sum square difference.' 52 | 53 | write (*, '(A, I)') 'Difference 1: ', difference1() 54 | end subroutine 55 | 56 | function difference1() 57 | integer difference1 58 | integer sum 59 | integer square 60 | integer index 61 | 62 | ! initial values 63 | sum = 0 64 | square = 0 65 | 66 | do concurrent (index = 1:100) 67 | ! the sum of the squares 68 | sum = sum + index ** 2 69 | 70 | ! the square of the sum 71 | square = square + index 72 | end do 73 | 74 | square = square ** 2 75 | 76 | difference1 = square - sum 77 | end function 78 | end module 79 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem7.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! Sum square difference 28 | ! 29 | ! By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th prime is 13. 30 | ! 31 | ! What is the 10 001st prime number? 32 | module MPEProblem7 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TPEProblem7 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present 43 | write (*, '(A)') 'Problem 7. 10001st prime.' 44 | 45 | write (*, '(A, I)') 'Prime 1: ', prime1() 46 | end subroutine 47 | 48 | function prime1() 49 | integer index 50 | integer count 51 | integer prime1 52 | 53 | ! initial value 54 | index = 1 55 | count = 0 56 | 57 | do while (count .lt. 10001) 58 | index = index + 1 59 | 60 | if (isPrime(index) .eq. .true.) then 61 | count = count + 1 62 | end if 63 | end do 64 | 65 | prime1 = index 66 | end function 67 | 68 | function isPrime(number) 69 | integer number 70 | integer devider 71 | logical isPrime 72 | 73 | ! initial value 74 | isPrime = .true. 75 | 76 | do devider = 2, sqrt(real(number)) 77 | if (mod(number, devider) .eq. 0) then 78 | isPrime = .false. 79 | exit 80 | end if 81 | end do 82 | end function 83 | end module 84 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/Problem9.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | ! A Pythagorean triplet is a set of three natural numbers, a < b < c, for which, 28 | ! 29 | ! a^2 + b^2 = c^2 30 | ! 31 | ! For example, 3^2 + 4^2 = 9 + 16 = 25 = 5^2. 32 | ! There exists exactly one Pythagorean triplet for which a + b + c = 1000. 33 | ! Find the product abc. 34 | module MPEProblem9 35 | 36 | implicit none 37 | private 38 | 39 | type, public :: TPEProblem9 40 | contains 41 | procedure, nopass :: present 42 | end type 43 | contains 44 | subroutine present 45 | write (*, '(A)') 'Problem 9. Special Pythagorean triplet.' 46 | 47 | write (*, '(A, I)') 'Product 1: ', product1() 48 | end subroutine 49 | 50 | pure function product1() 51 | integer, parameter:: limit = 1000 52 | integer product1 53 | integer a 54 | integer b 55 | integer c 56 | 57 | ! initial value 58 | product1 = 0 59 | 60 | do c = 1, limit 61 | do b = 1, c - 1 62 | do a = 1, b - 1 63 | if (a + b + c .eq. limit) then 64 | if ((a**2) + (b**2) .eq. (c**2)) then 65 | product1 = a * b * c 66 | 67 | return 68 | end if 69 | end if 70 | end do 71 | end do 72 | end do 73 | end function 74 | end module 75 | -------------------------------------------------------------------------------- /Problems/ProjectEuler/ProjectEuler.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MProjectEuler 28 | 29 | use MPEProblem1 30 | use MPEProblem2 31 | use MPEProblem3 32 | use MPEProblem4 33 | use MPEProblem5 34 | use MPEProblem6 35 | use MPEProblem7 36 | use MPEProblem8 37 | use MPEProblem9 38 | 39 | use MPEProblem10 40 | use MPEProblem11 41 | use MPEProblem12 42 | use MPEProblem13 43 | use MPEProblem14 44 | use MPEProblem15 45 | 46 | implicit none 47 | private 48 | 49 | type, public :: TProjectEuler 50 | contains 51 | procedure, nopass :: present 52 | end type 53 | contains 54 | subroutine present() 55 | type(TPEProblem1) problem1 56 | type(TPEProblem2) problem2 57 | type(TPEProblem3) problem3 58 | type(TPEProblem4) problem4 59 | type(TPEProblem5) problem5 60 | type(TPEProblem6) problem6 61 | type(TPEProblem7) problem7 62 | type(TPEProblem8) problem8 63 | type(TPEProblem9) problem9 64 | 65 | type(TPEProblem10) problem10 66 | type(TPEProblem11) problem11 67 | type(TPEProblem12) problem12 68 | type(TPEProblem13) problem13 69 | type(TPEProblem14) problem14 70 | type(TPEProblem15) problem15 71 | 72 | !call problem1%present() 73 | !call problem2%present() 74 | !call problem3%present() 75 | !call problem4%present() 76 | !call problem5%present() 77 | !call problem6%present() 78 | !call problem7%present() 79 | !call problem8%present() 80 | !call problem9%present() 81 | 82 | !call problem10%present() 83 | !call problem11%present() 84 | !call problem12%present() 85 | !call problem13%present() 86 | !call problem14%present() 87 | call problem15%present() 88 | end subroutine 89 | end module 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Algorithms 2 | The Laboratory of Algorithms 3 | -------------------------------------------------------------------------------- /Randoms/IntrinsicRandom.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MIntrinsicRandom 28 | 29 | use MRandom 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TRandom), public :: TIntrinsicRandom 35 | logical initialized 36 | contains 37 | procedure :: random 38 | end type 39 | contains 40 | function random(instance, from, to) 41 | class(TIntrinsicRandom), intent(in out) :: instance 42 | integer, optional, intent(in) :: from 43 | integer, optional, intent(in) :: to 44 | integer :: random 45 | 46 | integer :: low 47 | integer :: high 48 | 49 | real value 50 | 51 | if (present(from) .and. present(to)) then 52 | low = from 53 | high = to 54 | else 55 | low = 1 56 | high = 256 57 | end if 58 | 59 | if (instance%initialized == .false.) then 60 | call initialize() 61 | instance%initialized = .true. 62 | end if 63 | 64 | call random_number(value) 65 | random = from + floor((to + 1 - from) * value) 66 | end function 67 | 68 | subroutine initialize() 69 | integer :: index, size, clock 70 | integer, dimension(:), allocatable :: seed 71 | 72 | call random_seed(size = size) 73 | allocate(seed(size)) 74 | 75 | call system_clock(count = clock) 76 | 77 | seed = clock + 37 * (/ (index - 1, index = 1, size) /) 78 | call random_seed(put = seed) 79 | 80 | deallocate(seed) 81 | end subroutine 82 | end module 83 | -------------------------------------------------------------------------------- /Randoms/LinearCongruential.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MLinearCongruential 28 | 29 | use MRandom 30 | 31 | implicit none 32 | private 33 | 34 | integer, parameter :: m = 100000000 35 | integer, parameter :: m1 = 10000 36 | integer, parameter :: b = 31415821 37 | 38 | type, extends(TRandom), public :: TLinearCongruential 39 | contains 40 | procedure :: random 41 | end type 42 | contains 43 | function random(instance, from, to) 44 | class(TLinearCongruential), intent(in out) :: instance 45 | integer, optional, intent(in) :: from 46 | integer, optional, intent(in) :: to 47 | integer :: random 48 | 49 | integer, save :: value = 1234567 50 | value = mod(multiply(value, b) + 1, m) 51 | 52 | random = value 53 | end function 54 | 55 | ! 56 | ! Computes (value1 * value2 mod m) with no overflow. 57 | ! 58 | function multiply(value1, value2) 59 | integer, intent(in) :: value1 60 | integer, intent(in) :: value2 61 | integer :: multiply 62 | 63 | integer p1 64 | integer p0 65 | integer q1 66 | integer q0 67 | 68 | p1 = value1 / m1 69 | p0 = mod(value1, m1) 70 | 71 | q1 = value2 / m1 72 | q0 = mod(value2, m1) 73 | 74 | multiply = mod((mod(p0 * q1 + p1 * q0, m1) * m1 + p0 * q0), m) 75 | end function 76 | end module 77 | -------------------------------------------------------------------------------- /Randoms/Random.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MRandom 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TRandom 33 | contains 34 | procedure(IRandom), deferred :: random 35 | end type 36 | 37 | abstract interface 38 | function IRandom(instance, from, to) result(random) 39 | import TRandom 40 | 41 | class(TRandom), intent(in out) :: instance 42 | integer, optional, intent(in) :: from 43 | integer, optional, intent(in) :: to 44 | integer :: random 45 | end function 46 | end interface 47 | end module 48 | -------------------------------------------------------------------------------- /Samples/100_list_of_integers: -------------------------------------------------------------------------------- 1 | 57 2 | 97 3 | 17 4 | 31 5 | 54 6 | 98 7 | 87 8 | 27 9 | 89 10 | 81 11 | 18 12 | 70 13 | 3 14 | 34 15 | 63 16 | 100 17 | 46 18 | 30 19 | 99 20 | 10 21 | 33 22 | 65 23 | 96 24 | 38 25 | 48 26 | 80 27 | 95 28 | 6 29 | 16 30 | 19 31 | 56 32 | 61 33 | 1 34 | 47 35 | 12 36 | 73 37 | 49 38 | 41 39 | 37 40 | 40 41 | 59 42 | 67 43 | 93 44 | 26 45 | 75 46 | 44 47 | 58 48 | 66 49 | 8 50 | 55 51 | 94 52 | 74 53 | 83 54 | 7 55 | 15 56 | 86 57 | 42 58 | 50 59 | 5 60 | 22 61 | 90 62 | 13 63 | 69 64 | 53 65 | 43 66 | 24 67 | 92 68 | 51 69 | 23 70 | 39 71 | 78 72 | 85 73 | 4 74 | 25 75 | 52 76 | 36 77 | 60 78 | 68 79 | 9 80 | 64 81 | 79 82 | 14 83 | 45 84 | 2 85 | 77 86 | 84 87 | 11 88 | 71 89 | 35 90 | 72 91 | 28 92 | 76 93 | 82 94 | 88 95 | 32 96 | 21 97 | 20 98 | 91 99 | 62 100 | 29 -------------------------------------------------------------------------------- /Samples/10_list_of_integers: -------------------------------------------------------------------------------- 1 | 3 2 | 9 3 | 8 4 | 4 5 | 6 6 | 10 7 | 2 8 | 5 9 | 7 10 | 1 -------------------------------------------------------------------------------- /Samples/10_list_of_integers_reversed: -------------------------------------------------------------------------------- 1 | 10 2 | 9 3 | 8 4 | 7 5 | 6 6 | 5 7 | 4 8 | 3 9 | 2 10 | 1 -------------------------------------------------------------------------------- /Samples/AdjacencyList_8_1: -------------------------------------------------------------------------------- 1 | 1 1 2 3 4 5 6 7 8 8 2 | 2 2 3 4 5 6 7 8 3 | 3 3 4 5 6 7 8 4 | 4 4 5 6 7 8 5 | 5 5 6 7 8 6 | 6 6 7 8 7 | 7 7 8 8 | 8 8 -------------------------------------------------------------------------------- /Samples/QuickSort Samples: -------------------------------------------------------------------------------- 1 | Programming Assignment #2 2 | 3 | size first last median 4 | 10 25 29 21 5 | 100 615 587 518 6 | 1000 10297 10184 8921 7 | 8 | left: 499,500 9 | right: 499,500 10 | median: 7,987 -------------------------------------------------------------------------------- /Samples/dijkstraData_4_1: -------------------------------------------------------------------------------- 1 | 1 2,1 3,4 2 | 2 3,2 4,5 3 | 3 4,3 4 | 4 -------------------------------------------------------------------------------- /Samples/dijkstraData_4_2: -------------------------------------------------------------------------------- 1 | 1 2,1 3,4 2 | 2 3,2 4,5 3 | 3 4,3 4 | 6 7,1 -------------------------------------------------------------------------------- /Samples/kargerMinCut_40: -------------------------------------------------------------------------------- 1 | 1 19 15 36 23 18 39 2 | 2 36 23 4 18 26 9 3 | 3 35 6 16 11 4 | 4 23 2 18 24 5 | 5 14 8 29 21 6 | 6 34 35 3 16 7 | 7 30 33 38 28 8 | 8 12 14 5 29 31 9 | 9 39 13 20 10 17 2 10 | 10 9 20 12 14 29 11 | 11 3 16 30 33 26 12 | 12 20 10 14 8 13 | 13 24 39 9 20 14 | 14 10 12 8 5 15 | 15 26 19 1 36 16 | 16 6 3 11 30 17 35 32 17 | 17 38 28 32 40 9 16 18 | 18 2 4 24 39 1 19 | 19 27 26 15 1 20 | 20 13 9 10 12 21 | 21 5 29 25 37 22 | 22 32 40 34 35 23 | 23 1 36 2 4 24 | 24 4 18 39 13 25 | 25 29 21 37 31 26 | 26 31 27 19 15 11 2 27 | 27 37 31 26 19 29 28 | 28 7 38 17 32 29 | 29 8 5 21 25 10 27 30 | 30 16 11 33 7 37 31 | 31 25 37 27 26 8 32 | 32 28 17 40 22 16 33 | 33 11 30 7 38 34 | 34 40 22 35 6 35 | 35 22 34 6 3 16 36 | 36 15 1 23 2 37 | 37 21 25 31 27 30 38 | 38 33 7 28 17 40 39 | 39 18 24 13 9 1 40 | 40 17 32 22 34 38 -------------------------------------------------------------------------------- /Samples/kargerMinCut_4_1: -------------------------------------------------------------------------------- 1 | 1 2 3 4 2 | 2 1 3 3 | 3 1 2 4 4 | 4 1 3 -------------------------------------------------------------------------------- /Samples/kargerMinCut_8_1: -------------------------------------------------------------------------------- 1 | 1 2 3 4 7 2 | 2 1 3 4 3 | 3 1 2 4 4 | 4 1 2 3 5 5 | 5 4 6 7 8 6 | 6 5 7 8 7 | 7 1 5 6 8 8 | 8 5 6 7 -------------------------------------------------------------------------------- /Samples/kargerMinCut_8_2: -------------------------------------------------------------------------------- 1 | 1 4 2 7 3 2 | 2 4 1 3 3 | 3 1 2 4 4 | 4 5 1 2 3 5 | 5 8 7 6 4 6 | 6 8 5 7 7 | 7 6 8 5 1 8 | 8 7 6 5 -------------------------------------------------------------------------------- /Samples/kargerMinCut_8_3: -------------------------------------------------------------------------------- 1 | 1 2 3 4 2 | 2 1 3 4 3 | 3 1 2 4 4 | 4 1 2 3 5 5 | 5 4 6 7 8 6 | 6 5 7 8 7 | 7 5 6 8 8 | 8 5 6 7 -------------------------------------------------------------------------------- /Samples/kargerMinCut_8_4: -------------------------------------------------------------------------------- 1 | 1 3 4 2 2 | 2 1 4 3 3 | 3 1 2 4 4 | 4 5 3 2 1 5 | 5 4 8 6 7 6 | 6 8 7 5 7 | 7 5 8 6 8 | 8 5 7 6 -------------------------------------------------------------------------------- /Samples/kargerMinCut_8_5: -------------------------------------------------------------------------------- 1 | 1 2 3 4 5 2 | 2 3 4 1 3 | 3 4 1 2 4 | 4 1 2 3 8 5 | 5 1 6 7 8 6 | 6 7 8 5 7 | 7 8 5 6 8 | 8 4 6 5 7 -------------------------------------------------------------------------------- /Searches/BinarySearch.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MBinarySearch 28 | 29 | use MSearch 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TSearch), public :: TBinarySearch 35 | contains 36 | procedure, nopass :: search 37 | end type 38 | 39 | contains 40 | function search(array, key, begin, end) result(position) 41 | integer, dimension(:), intent(in) :: array 42 | integer, intent(in) :: key 43 | integer, optional, intent(in) :: begin 44 | integer, optional, intent(in) :: end 45 | integer :: position 46 | 47 | integer low 48 | integer middle 49 | integer high 50 | 51 | if (present(begin) .and. present(end)) then 52 | low = begin 53 | high = end 54 | else 55 | low = 1 56 | high = size(array) 57 | end if 58 | 59 | ! binary search 60 | 61 | do while (low <= high) 62 | middle = low + ((high - low) / 2) 63 | 64 | if (key < array(middle)) then 65 | high = middle - 1 66 | else if (key > array(middle)) then 67 | low = middle + 1 68 | else 69 | position = middle 70 | return 71 | end if 72 | end do 73 | 74 | position = -(low) 75 | end function 76 | end module 77 | -------------------------------------------------------------------------------- /Searches/Search.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MSearch 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TSearch 33 | contains 34 | procedure(ISearch), nopass, deferred :: search 35 | end type 36 | 37 | abstract interface 38 | function ISearch(array, key, begin, end) result(position) 39 | integer, dimension(:), intent(in) :: array 40 | integer, intent(in) :: key 41 | integer, optional, intent(in) :: begin 42 | integer, optional, intent(in) :: end 43 | integer :: position 44 | end function 45 | end interface 46 | end module 47 | -------------------------------------------------------------------------------- /Searches/SequenceSearch.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MSequenceSearch 28 | 29 | use MSearch 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TSearch), public :: TSequenceSearch 35 | contains 36 | procedure, nopass :: search 37 | end type 38 | 39 | contains 40 | function search(array, key, begin, end) result(position) 41 | integer, dimension(:), intent(in) :: array 42 | integer, intent(in) :: key 43 | integer, optional, intent(in) :: begin 44 | integer, optional, intent(in) :: end 45 | integer :: position 46 | 47 | integer low 48 | integer high 49 | integer index 50 | 51 | if (present(begin) .and. present(end)) then 52 | low = begin 53 | high = end 54 | else 55 | low = 1 56 | high = size(array) 57 | end if 58 | 59 | ! sequence search 60 | 61 | do index = low, high 62 | if (array(index) .eq. key) then 63 | position = index 64 | return 65 | end if 66 | end do 67 | 68 | position = -1 69 | end function 70 | end module 71 | -------------------------------------------------------------------------------- /Sorts/InsertionSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MInsertionSort 28 | 29 | use MSort 30 | use MBinarySearch 31 | 32 | implicit none 33 | private 34 | 35 | type, extends(TSort), public :: TInsertionSort 36 | contains 37 | procedure, nopass :: sort => sortBinary 38 | 39 | procedure, nopass :: sortOriginal 40 | procedure, nopass :: sortBinary 41 | end type 42 | 43 | contains 44 | subroutine sortOriginal(array) 45 | integer, dimension(:), intent(in out) :: array 46 | 47 | integer index 48 | integer location 49 | integer key 50 | 51 | do index = 2, size(array) 52 | key = array(index) 53 | location = index - 1 54 | 55 | do while ((location > 0) .and. (array(location) > key)) 56 | array(location + 1) = array(location) 57 | location = location - 1 58 | end do 59 | 60 | array(location + 1) = key 61 | end do 62 | end subroutine 63 | 64 | subroutine sortBinary(array) 65 | integer, dimension(:), intent(in out) :: array 66 | 67 | type(TBinarySearch) :: BinarySearch 68 | 69 | integer index 70 | integer jndex 71 | integer location 72 | integer key 73 | 74 | do index = 2, size(array) 75 | key = array(index) 76 | location = BinarySearch%search(array, key, 1, index) 77 | 78 | if (location < 1) then 79 | location = -location 80 | end if 81 | 82 | !array(location + 1:index) = array(location:index - 1) 83 | 84 | do jndex = index - 1, location, -1 85 | array(jndex + 1) = array(jndex) 86 | end do 87 | 88 | array(location) = key 89 | end do 90 | end subroutine 91 | end module 92 | -------------------------------------------------------------------------------- /Sorts/SelectionSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MSelectionSort 28 | 29 | use MSort 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TSort), public :: TSelectionSort 35 | contains 36 | procedure, nopass :: sort => sortOriginal 37 | 38 | procedure, nopass :: sortOriginal 39 | end type 40 | 41 | contains 42 | subroutine sortOriginal(array) 43 | integer, dimension(:), intent(in out) :: array 44 | 45 | integer index 46 | integer jndex 47 | integer buffer 48 | integer min 49 | 50 | do index = 1, size(array) 51 | min = index 52 | 53 | do jndex = index + 1, size(array) 54 | if (array(jndex) < array(min)) then 55 | min = jndex 56 | end if 57 | end do 58 | 59 | buffer = array(min) 60 | array(min) = array(index) 61 | array(index) = buffer 62 | end do 63 | end subroutine 64 | end module 65 | -------------------------------------------------------------------------------- /Sorts/ShellSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MShellSort 28 | 29 | use MSort 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TSort), public :: TShellSort 35 | contains 36 | procedure, nopass :: sort => sortOriginal 37 | 38 | procedure, nopass :: sortOriginal 39 | end type 40 | 41 | contains 42 | subroutine sortOriginal(array) 43 | integer, dimension(:), intent(in out) :: array 44 | 45 | integer index 46 | integer jndex 47 | integer head 48 | integer value 49 | 50 | head = 1 51 | do while (head <= size(array) / 9) 52 | head = 3 * head + 1 53 | end do 54 | 55 | do while (head > 0) 56 | do index = head + 1, size(array) 57 | value = array(index) 58 | jndex = index 59 | 60 | do while ((jndex > head) .and. (array(jndex - head) > value)) 61 | array(jndex) = array(jndex - head) 62 | jndex = jndex - head 63 | end do 64 | 65 | array(jndex) = value 66 | end do 67 | 68 | head = head / 3 69 | end do 70 | end subroutine 71 | end module 72 | -------------------------------------------------------------------------------- /Sorts/Sort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MSort 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TSort 33 | contains 34 | procedure(ISort), nopass, deferred :: sort 35 | end type 36 | 37 | abstract interface 38 | subroutine ISort(array) 39 | import TSort 40 | 41 | integer, dimension(:), intent(in out) :: array 42 | end subroutine 43 | end interface 44 | end module 45 | -------------------------------------------------------------------------------- /Structures/Iterator.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MIterator 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TIterator 33 | contains 34 | procedure(IHasNext), deferred :: hasNext 35 | procedure(INext), deferred :: next 36 | procedure(IRemove), deferred :: remove 37 | end type 38 | 39 | abstract interface 40 | function IHasNext(instance) result(value) 41 | import TIterator 42 | 43 | class(TIterator), intent(in) :: instance 44 | logical :: value 45 | end function 46 | 47 | function INext(instance) result(value) 48 | import TIterator 49 | 50 | class(TIterator), intent(in out) :: instance 51 | integer :: value 52 | end function 53 | 54 | subroutine IRemove(instance) 55 | import TIterator 56 | 57 | class(TIterator), intent(in out) :: instance 58 | end subroutine 59 | end interface 60 | end module 61 | -------------------------------------------------------------------------------- /Structures/LinkedListEntry.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MLinkedListEntry 28 | 29 | use MListEntry 30 | 31 | implicit none 32 | private 33 | 34 | type, extends(TListEntry), public :: TLinkedListEntry 35 | type(TLinkedListEntry), pointer :: next => null() 36 | type(TLinkedListEntry), pointer :: previous => null() 37 | end type 38 | end module 39 | -------------------------------------------------------------------------------- /Structures/LinkedListIterator.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MLinkedListIterator 28 | 29 | use MListIterator 30 | use MLinkedListEntry 31 | 32 | implicit none 33 | private 34 | 35 | type, extends(TListIterator), public :: TLinkedListIterator 36 | private 37 | type(TLinkedListEntry), pointer :: entry => null() 38 | contains 39 | procedure :: hasNext 40 | procedure :: next 41 | procedure :: remove 42 | ! hasPrevious 43 | ! previous 44 | ! nextIndex 45 | ! previousIndex 46 | ! set 47 | ! add 48 | 49 | procedure :: init 50 | end type 51 | 52 | contains 53 | function hasNext(instance) result(value) 54 | class(TLinkedListIterator), intent(in) :: instance 55 | logical :: value 56 | 57 | value = (associated(instance%entry%next) == .true.) 58 | end function 59 | 60 | function next(instance) result(value) 61 | class(TLinkedListIterator), intent(in out) :: instance 62 | integer :: value 63 | 64 | type(TLinkedListEntry), pointer :: entry 65 | entry => instance%entry 66 | 67 | value = instance%entry%value 68 | instance%entry => instance%entry%next 69 | end function 70 | 71 | subroutine remove(instance) 72 | class(TLinkedListIterator), intent(in out) :: instance 73 | end subroutine 74 | 75 | subroutine init(instance, entry) 76 | class(TLinkedListIterator), intent(in out) :: instance 77 | type(TLinkedListEntry), pointer, intent(in) :: entry 78 | 79 | instance%entry => entry; 80 | end subroutine 81 | end module 82 | -------------------------------------------------------------------------------- /Structures/ListEntry.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MListEntry 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TListEntry 33 | integer :: value 34 | end type 35 | end module 36 | -------------------------------------------------------------------------------- /Structures/ListIterator.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MListIterator 28 | 29 | use MIterator 30 | 31 | implicit none 32 | public 33 | 34 | type, extends(TIterator), abstract :: TListIterator 35 | contains 36 | ! the method defined in TIterator can be removed 37 | !procedure(INextIndex), deferred :: nextIndex 38 | !procedure(IPreviousIndex), deferred :: previousIndex 39 | 40 | !procedure(ILIHasNext), deferred :: hasNext 41 | !procedure(ILINext), deferred :: next 42 | !procedure(IHasNext), deferred :: hasPrevious 43 | !procedure(INext), deferred :: previous 44 | 45 | !procedure(IAdd), deferred :: add 46 | !procedure(ILIRemove), deferred :: remove 47 | !procedure(ISet), deferred :: set 48 | end type 49 | end module 50 | -------------------------------------------------------------------------------- /Structures/Queue.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MQueue 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TQueue 33 | contains 34 | procedure(IPeek), deferred :: peek 35 | procedure(IPop), deferred :: pop 36 | procedure(IPush), deferred :: push 37 | end type 38 | 39 | abstract interface 40 | function IPeek(instance) result(value) 41 | import TQueue 42 | 43 | class(TQueue), intent(in) :: instance 44 | integer :: value 45 | end function 46 | 47 | function IPop(instance) result(value) 48 | import TQueue 49 | 50 | class(TQueue), intent(in out) :: instance 51 | integer :: value 52 | end function 53 | 54 | subroutine IPush(instance, value) 55 | import TQueue 56 | 57 | class(TQueue), intent(in out) :: instance 58 | integer, intent(in) :: value 59 | end subroutine 60 | end interface 61 | end module 62 | -------------------------------------------------------------------------------- /Structures/Stack.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MStack 28 | 29 | implicit none 30 | public 31 | 32 | type, abstract :: TStack 33 | contains 34 | procedure(IPeek), deferred :: peek 35 | procedure(IPop), deferred :: pop 36 | procedure(IPush), deferred :: push 37 | 38 | procedure(IEmpty), deferred :: empty 39 | end type 40 | 41 | abstract interface 42 | function IPeek(instance) result(value) 43 | import TStack 44 | 45 | class(TStack), intent(in) :: instance 46 | integer :: value 47 | end function 48 | 49 | function IPop(instance) result(value) 50 | import TStack 51 | 52 | class(TStack), intent(in out) :: instance 53 | integer :: value 54 | end function 55 | 56 | subroutine IPush(instance, value) 57 | import TStack 58 | 59 | class(TStack), intent(in out) :: instance 60 | integer, intent(in) :: value 61 | end subroutine 62 | 63 | function IEmpty(instance) result(value) 64 | import TStack 65 | 66 | class(TStack), intent(in) :: instance 67 | logical :: value 68 | end function 69 | end interface 70 | end module 71 | -------------------------------------------------------------------------------- /Units/Arrays/Shift.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUShift 28 | 29 | use MArrays 30 | use MShift 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | type, public :: TUShift 37 | contains 38 | procedure, nopass :: present 39 | end type 40 | contains 41 | subroutine present() 42 | type(TArrays) :: arrays 43 | 44 | integer, parameter :: NUMBER_OF_ELEMENTS = 1000000 45 | integer, dimension(NUMBER_OF_ELEMENTS) :: ARRAY 46 | 47 | call arrays%fillWithSequence(ARRAY) 48 | 49 | ! 1, 2, 3, 4, 5 => 1, 1, 2, 3, 4 50 | 51 | call shiftByIntrinsic(ARRAY) 52 | call shiftByAssignment(ARRAY) 53 | call shiftByLoop(ARRAY) 54 | 55 | print *, '' 56 | end subroutine 57 | 58 | subroutine shiftByLoop(array) 59 | integer, dimension(:), intent(in) :: array 60 | 61 | type(TShift) :: shift 62 | integer, dimension(size(array)) :: copy 63 | integer index 64 | real start 65 | 66 | copy = array 67 | call cpu_time(start) 68 | call shift%shiftByLoop(copy) 69 | 70 | call report('Shift', 'Loop', '', start) 71 | end subroutine 72 | 73 | subroutine shiftByAssignment(array) 74 | integer, dimension(:), intent(in) :: array 75 | 76 | type(TShift) :: shift 77 | integer, dimension(size(array)) :: copy 78 | real start 79 | 80 | copy = array 81 | call cpu_time(start) 82 | call shift%shiftByAssignment(copy) 83 | 84 | call report('Shift', 'Assignment', '', start) 85 | end subroutine 86 | 87 | subroutine shiftByIntrinsic(array) 88 | integer, dimension(:), intent(in) :: array 89 | 90 | type(TShift) :: shift 91 | integer, dimension(size(array)) :: copy 92 | real start 93 | 94 | copy = array 95 | call cpu_time(start) 96 | call shift%shiftByIntrinsic(copy) 97 | 98 | call report('Shift', 'Intrinsic', '', start) 99 | end subroutine 100 | end module 101 | -------------------------------------------------------------------------------- /Units/Foundation/ArrayCount.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) ArrayCount 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | contains 35 | module subroutine presentArrayCount() 36 | class(Object), pointer :: value 37 | integer, dimension(6) :: intArray 38 | 39 | type(Array) arrayInt 40 | integer index 41 | real start 42 | 43 | intArray = (/ 0, 1, 2, 3, 4, 5 /) 44 | 45 | call cpu_time(start) 46 | 47 | call arrayInt%initWithFArray(intArray) 48 | 49 | call assert_equals(arrayInt%count(), size(intArray)) 50 | 51 | call arrayInt%destroy() 52 | 53 | call report('Foundation', 'Array', 'Count', start) 54 | end subroutine 55 | end submodule 56 | -------------------------------------------------------------------------------- /Units/Foundation/ObjectEquals.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) ObjectEquals 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | ! Base object in hierarchy. 35 | type, extends(Object) :: Shape 36 | integer :: color 37 | end type 38 | 39 | type, extends(Shape) :: Circle 40 | integer :: radius 41 | end type 42 | 43 | contains 44 | module subroutine presentObjectEquals() 45 | type(Shape), target :: shape_object 46 | type(Circle), target :: circle_object 47 | 48 | type(Shape), pointer :: shape_pointer 49 | type(Circle), pointer :: circle_pointer 50 | 51 | class(Object), pointer :: object_shape_pointer 52 | class(Object), pointer :: object_circle_pointer 53 | 54 | real start 55 | 56 | call cpu_time(start) 57 | 58 | shape_pointer => shape_object 59 | circle_pointer => circle_object 60 | 61 | object_shape_pointer => shape_object 62 | object_circle_pointer => circle_object 63 | 64 | call assert_ok(associated(shape_pointer, shape_object), '[1]') 65 | 66 | call assert_ok(shape_object%equals(shape_pointer), '[2]') 67 | call assert_ok(shape_pointer%equals(shape_object), '[3]') 68 | call assert_ok(circle_object%equals(circle_pointer), '[4]') 69 | call assert_ok(circle_pointer%equals(circle_object), '[5]') 70 | call assert_ok(.not. shape_object%equals(circle_pointer), '[6]') 71 | call assert_ok(.not. circle_object%equals(shape_pointer), '[7]') 72 | 73 | call assert_ok(shape_object%equals(object_shape_pointer), '[8]') 74 | call assert_ok(circle_object%equals(object_circle_pointer), '[9]') 75 | call assert_ok(.not. shape_object%equals(object_circle_pointer), '[10]') 76 | call assert_ok(.not. circle_object%equals(object_shape_pointer), '[11]') 77 | 78 | call report('Foundation', 'Object', 'Equals', start) 79 | end subroutine 80 | end submodule 81 | -------------------------------------------------------------------------------- /Units/Foundation/ObjectInheritance.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) ObjectInheritance 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | ! Base object in hierarchy. 35 | type, extends(Object) :: Shape 36 | integer :: color 37 | contains 38 | procedure :: getColor 39 | procedure :: setColor 40 | end type 41 | 42 | type, extends(Shape) :: Circle 43 | integer :: radius 44 | contains 45 | procedure :: getRadius 46 | procedure :: setRadius 47 | end type 48 | 49 | contains 50 | module subroutine presentObjectInheritance() 51 | type(Shape) :: shape 52 | type(Circle) :: circle 53 | 54 | real start 55 | 56 | call cpu_time(start) 57 | 58 | call shape%setColor(1) 59 | call circle%setColor(3) 60 | call circle%setRadius(32) 61 | 62 | call assert_equals(shape%getColor(), 1) 63 | call assert_equals(circle%getColor(), 3) 64 | call assert_equals(circle%getRadius(), 32) 65 | 66 | call report('Foundation', 'Object', 'Inherit.', start) 67 | end subroutine 68 | 69 | function getColor(self) result(color) 70 | class(Shape), intent(in) :: self 71 | integer :: color 72 | 73 | color = self%color 74 | end function 75 | 76 | subroutine setColor(self, color) 77 | class(Shape), intent(in out) :: self 78 | integer, intent(in) :: color 79 | 80 | self%color = color 81 | end subroutine 82 | 83 | function getRadius(self) result(radius) 84 | class(Circle), intent(in) :: self 85 | integer :: radius 86 | 87 | radius = self%radius 88 | end function 89 | 90 | subroutine setRadius(self, radius) 91 | class(Circle), intent(in out) :: self 92 | integer, intent(in) :: radius 93 | 94 | self%radius = radius 95 | end subroutine 96 | end submodule 97 | -------------------------------------------------------------------------------- /Units/Foundation/ObjectInit.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) ObjectInit 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | type, extends(Object) :: Shape 35 | integer :: color 36 | contains 37 | procedure :: init 38 | procedure :: initWithColor 39 | end type 40 | 41 | contains 42 | module subroutine presentObjectInit() 43 | type(Shape), pointer :: shape_dynamic 44 | type(Shape) :: shape_static 45 | 46 | real start 47 | 48 | call cpu_time(start) 49 | 50 | allocate(shape_dynamic) 51 | call shape_dynamic%init() 52 | call shape_static%init() 53 | 54 | call assert_ok(associated(shape_dynamic), '[1]') 55 | 56 | call shape_dynamic%destroy() 57 | call shape_static%destroy() 58 | deallocate(shape_dynamic) 59 | 60 | call report('Foundation', 'Object', 'Init', start) 61 | end subroutine 62 | 63 | subroutine init(self) 64 | class(Shape), intent(in out) :: self 65 | 66 | ! call initializer subroutine of object class 67 | call self%object%init() 68 | 69 | self%color = 0 70 | end subroutine 71 | 72 | subroutine initWithColor(self, color) 73 | class(Shape), intent(in out) :: self 74 | integer, intent(in) :: color 75 | 76 | ! call default initializer of shape object 77 | call self%init() 78 | 79 | self%color = color 80 | end subroutine 81 | end submodule 82 | -------------------------------------------------------------------------------- /Units/Foundation/StringAssignFString.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) StringAssignFString 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | contains 35 | module subroutine presentStringAssignFString() 36 | type(String), pointer :: string_dynamic 37 | type(String) :: string_static 38 | character(len=13) :: fstring 39 | 40 | real start 41 | 42 | call cpu_time(start) 43 | 44 | fstring = 'Hello, World!' 45 | 46 | allocate(string_dynamic) 47 | string_dynamic = fstring 48 | string_static = fstring 49 | 50 | call assert_equals(string_dynamic%getFString(), fstring) 51 | call assert_equals(string_static%getFString(), fstring) 52 | 53 | call string_dynamic%destroy() 54 | call string_static%destroy() 55 | 56 | deallocate(string_dynamic) 57 | 58 | call report('Foundation', 'String', 'AssignFS', start) 59 | end subroutine 60 | end submodule 61 | -------------------------------------------------------------------------------- /Units/Foundation/StringEquals.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) StringEquals 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | type, extends(String) :: Text 35 | integer :: kind 36 | end type 37 | contains 38 | module subroutine presentStringEquals() 39 | type(String) :: string1 40 | type(String) :: string2 41 | type(String) :: string3 42 | 43 | type(Text) :: text1 44 | 45 | real start 46 | 47 | call cpu_time(start) 48 | 49 | string1 = 'Hello, World!' 50 | string2 = 'Привет, Мир!' 51 | string3 = 'Hello, World!' 52 | text1 = 'Привет, Мир!' 53 | 54 | call assert_ok(string1%equals(string3), '[1]') 55 | call assert_ok(.not. string1%equals(string2), '[2]') 56 | call assert_ok(string2%equals(text1), '[3]') 57 | 58 | call string1%destroy() 59 | call string2%destroy() 60 | call string3%destroy() 61 | call text1%destroy() 62 | 63 | call report('Foundation', 'String', 'Equals', start) 64 | end subroutine 65 | end submodule 66 | -------------------------------------------------------------------------------- /Units/Foundation/StringInitWithFString.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | submodule (UFoundation) StringInitWithFString 28 | 29 | use Foundation 30 | 31 | use MUAsserts 32 | use MUReport 33 | 34 | contains 35 | module subroutine presentStringInitWithFString() 36 | character(len=13) :: fstring1 37 | 38 | type(String), pointer :: string_dynamic 39 | type(String) :: string_static 40 | 41 | real start 42 | 43 | call cpu_time(start) 44 | 45 | fstring1 = 'Hello, World!' 46 | 47 | allocate(string_dynamic) 48 | call string_dynamic%initWithFString(fstring1) 49 | call string_static%initWithFString(fstring1) 50 | 51 | call assert_equals(fstring1, string_dynamic%getFString()) 52 | call assert_equals(fstring1, string_static%getFString()) 53 | 54 | call string_dynamic%destroy() 55 | call string_static%destroy() 56 | 57 | deallocate(string_dynamic) 58 | 59 | call report('Foundation', 'String', 'IWFStr.', start) 60 | end subroutine 61 | end submodule 62 | -------------------------------------------------------------------------------- /Units/Foundation/UFoundation.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2016 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module UFoundation 28 | 29 | use Foundation 30 | 31 | implicit none 32 | private 33 | 34 | type, public :: TUFoundation 35 | contains 36 | procedure, nopass :: present 37 | end type 38 | 39 | interface 40 | module subroutine presentObjectInit() 41 | end subroutine 42 | 43 | module subroutine presentObjectEquals() 44 | end subroutine 45 | 46 | module subroutine presentObjectInheritance() 47 | end subroutine 48 | 49 | module subroutine presentArrayInitWithFArray() 50 | end subroutine 51 | 52 | module subroutine presentArrayCount() 53 | end subroutine 54 | 55 | module subroutine presentArraySortedArrayUsingFunction() 56 | end subroutine 57 | 58 | module subroutine presentStringInitWithFString() 59 | end subroutine 60 | 61 | module subroutine presentStringEquals() 62 | end subroutine 63 | 64 | module subroutine presentStringAssignFString() 65 | end subroutine 66 | end interface 67 | contains 68 | subroutine present() 69 | call presentObjectInit() 70 | call presentObjectEquals() 71 | call presentObjectInheritance() 72 | 73 | call presentArrayInitWithFArray() 74 | call presentArrayCount() 75 | call presentArraySortedArrayUsingFunction() 76 | 77 | call presentStringInitWithFString() 78 | call presentStringEquals() 79 | call presentStringAssignFString() 80 | end subroutine 81 | end module 82 | -------------------------------------------------------------------------------- /Units/Graphs/BreadthFirstSearch.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUBreadthFirstSearch 28 | 29 | use MBreadthFirstSearch 30 | use MGraph 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TUBreadthFirstSearch 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TBreadthFirstSearch) bfs 44 | type(TGraph) graph 45 | 46 | integer, dimension(:), pointer :: sequence 47 | real :: start 48 | 49 | call graph%init() 50 | 51 | call graph%addVertex(1) 52 | call graph%addVertex(2) 53 | call graph%addVertex(3) 54 | call graph%addVertex(4) 55 | call graph%addVertex(5) 56 | call graph%addVertex(6) 57 | 58 | 59 | ! 2 - 3 - 6 60 | ! / 61 | ! 1 62 | ! \ 63 | ! 4 - 5 64 | 65 | ! expected to have 1 - 2 - 4 - 3 - 5 - 6 66 | 67 | call graph%addEdge(1, 2) 68 | call graph%addEdge(2, 3) 69 | call graph%addEdge(3, 6) 70 | call graph%addEdge(1, 4) 71 | call graph%addEdge(4, 5) 72 | 73 | call cpu_time(start) 74 | 75 | sequence => bfs%search(graph) 76 | 77 | call report('Graph', 'BreadthFirstSearch', '', start) 78 | call assert_equals(sequence(1:6), (/ 1, 2, 4, 3, 5, 6 /)) 79 | 80 | call graph%destroy() 81 | deallocate(sequence) 82 | 83 | print *, '' 84 | end subroutine 85 | end module 86 | -------------------------------------------------------------------------------- /Units/Graphs/DepthFirstSearch.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUDepthFirstSearch 28 | 29 | use MDepthFirstSearch 30 | use MGraph 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TUDepthFirstSearch 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TDepthFirstSearch) dfs 44 | type(TGraph) graph 45 | 46 | integer, dimension(:), pointer :: sequence 47 | real :: start 48 | 49 | call graph%init() 50 | 51 | call graph%addVertex(1) 52 | call graph%addVertex(2) 53 | call graph%addVertex(3) 54 | call graph%addVertex(4) 55 | call graph%addVertex(5) 56 | call graph%addVertex(6) 57 | 58 | 59 | ! 2 - 3 - 6 60 | ! / 61 | ! 1 62 | ! \ 63 | ! 4 - 5 64 | 65 | ! expected to have 1 - 2 - 3 - 6 - 4 - 5 66 | 67 | call graph%addEdge(1, 2) 68 | call graph%addEdge(2, 3) 69 | call graph%addEdge(3, 6) 70 | call graph%addEdge(1, 4) 71 | call graph%addEdge(4, 5) 72 | 73 | call cpu_time(start) 74 | 75 | sequence => dfs%search(graph) 76 | 77 | call report('Graph', 'DepthFirstSearch', '', start) 78 | call assert_equals(sequence(1:6), (/ 1, 2, 3, 6, 4, 5 /)) 79 | 80 | call graph%destroy() 81 | deallocate(sequence) 82 | 83 | print *, '' 84 | end subroutine 85 | end module 86 | -------------------------------------------------------------------------------- /Units/Math/Fibonacci.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUFibonacci 28 | 29 | use MFibonacci 30 | use MUAsserts 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | integer, parameter :: NUMBER_OF_ITERATIONS = 6000000 37 | 38 | type, public :: TUFibonacci 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | 43 | contains 44 | subroutine present() 45 | call fibonacciRecursive() 46 | call fibonacciIterate() 47 | print *, '' 48 | end subroutine 49 | 50 | subroutine fibonacciRecursive() 51 | type(TFibonacci) :: fibonacci 52 | integer index 53 | integer value 54 | real start 55 | 56 | call cpu_time(start) 57 | 58 | do index = 1, NUMBER_OF_ITERATIONS 59 | value = fibonacci%fibonacciRecursive(10) 60 | call assert_equals(value, 55) 61 | end do 62 | 63 | call report('Fibonacci', 'Recursive', '', start) 64 | end subroutine 65 | 66 | subroutine fibonacciIterate() 67 | type(TFibonacci) :: fibonacci 68 | integer index 69 | integer value 70 | real start 71 | 72 | call cpu_time(start) 73 | 74 | do index = 1, NUMBER_OF_ITERATIONS 75 | value = fibonacci%fibonacciIterate(10) 76 | call assert_equals(value, 55) 77 | end do 78 | 79 | call report('Fibonacci', 'Iterate', '', start) 80 | end subroutine 81 | end module 82 | -------------------------------------------------------------------------------- /Units/Math/GreatestCommonDivisor.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUGreatestCommonDivisor 28 | 29 | use MGreatestCommonDivisor 30 | use MUAsserts 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | integer, parameter :: NUMBER_OF_ITERATIONS = 10000000 37 | 38 | type, public :: TUGreatestCommonDivisor 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | 43 | contains 44 | subroutine present() 45 | call gcdOriginal() 46 | end subroutine 47 | 48 | subroutine gcdOriginal() 49 | type(TGreatestCommonDivisor) :: greatestCommonDivisor 50 | integer index 51 | integer gcd 52 | real start 53 | 54 | call cpu_time(start) 55 | 56 | do index = 1, NUMBER_OF_ITERATIONS 57 | gcd = greatestCommonDivisor%gcdOriginal(461952, 116298) 58 | call assert_equals(gcd, 18) 59 | end do 60 | 61 | call report('GCD', 'Original', '', start) 62 | 63 | print *, '' 64 | end subroutine 65 | end module 66 | -------------------------------------------------------------------------------- /Units/Math/Pi.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUPi 28 | 29 | use MPi 30 | use MUAsserts 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | real, parameter :: PI_VALUE = 3.1415926 37 | 38 | type, public :: TUPi 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | contains 43 | subroutine present() 44 | call vietesSeries() 45 | call wallisSeries() 46 | call leibnizSeries() 47 | call nilakanthaSeries() 48 | 49 | print *, '' 50 | end subroutine 51 | 52 | subroutine vietesSeries() 53 | type(TPi) :: pi 54 | real value 55 | real start 56 | 57 | call cpu_time(start) 58 | value = pi%vietesSeries() 59 | call assert_equals(value, PI_VALUE) 60 | call report('Pi', 'Vietes', '', start) 61 | end subroutine 62 | 63 | subroutine wallisSeries() 64 | type(TPi) :: pi 65 | real value 66 | real start 67 | 68 | call cpu_time(start) 69 | value = pi%wallisSeries() 70 | call assert_equals(value, PI_VALUE) 71 | call report('Pi', 'Wallis', '', start) 72 | end subroutine 73 | 74 | subroutine leibnizSeries() 75 | type(TPi) :: pi 76 | real value 77 | real start 78 | 79 | call cpu_time(start) 80 | value = pi%leibnizSeries() 81 | call assert_equals(value, PI_VALUE) 82 | call report('Pi', 'Leibniz', '', start) 83 | end subroutine 84 | 85 | subroutine nilakanthaSeries() 86 | type(TPi) :: pi 87 | real value 88 | real start 89 | 90 | call cpu_time(start) 91 | value = pi%nilakanthaSeries() 92 | call assert_equals(value, PI_VALUE) 93 | call report('Pi', 'Nilakantha', '', start) 94 | end subroutine 95 | end module 96 | -------------------------------------------------------------------------------- /Units/Parameters.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUParameters 28 | 29 | implicit none 30 | private 31 | 32 | ! constant complexity O(1) 33 | integer, parameter, public :: CONSTANT_COMPLEXITY = 10000 34 | 35 | ! logarithmic complexity O(logN) 36 | integer, parameter, public :: LOGARITHMIC_COMPLEXITY = 10000 37 | 38 | ! linear complexity O(N) 39 | integer, parameter, public :: LINEAR_COMPLEXITY = 10000 40 | 41 | ! linearithmic complexity O(NlogN) 42 | integer, parameter, public :: LINEARITHMIC_COMPLEXITY = 10000 43 | 44 | ! quadratic complexity O(N^2) 45 | integer, parameter, public :: QUADRATIC_COMPLEXITY = 25000 46 | 47 | ! cubic complexity O(N^3) 48 | integer, parameter, public :: CUBIC_COMPLEXITY = 10000 49 | 50 | ! exponential complexity O(2^N) 51 | integer, parameter, public :: EXPONENTIAL_COMPLEXITY = 10000 52 | end module 53 | -------------------------------------------------------------------------------- /Units/Randoms/LinearCongruential.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MULinearCongruential 28 | 29 | use MLinearCongruential 30 | use MUAsserts 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | integer, parameter :: NUMBER_OF_ITERATIONS = 6!000000 37 | 38 | type, public :: TULinearCongruential 39 | contains 40 | procedure, nopass :: present 41 | end type 42 | 43 | contains 44 | subroutine present() 45 | call random() 46 | print *, '' 47 | end subroutine 48 | 49 | subroutine random() 50 | type(TLinearCongruential) :: linearCongruential 51 | integer index 52 | integer value 53 | real start 54 | 55 | call cpu_time(start) 56 | 57 | do index = 1, NUMBER_OF_ITERATIONS 58 | value = linearCongruential%random() 59 | !call assert_equals(value, 55) 60 | end do 61 | 62 | call report('LinearCongr.', 'Original', '', start) 63 | end subroutine 64 | end module 65 | -------------------------------------------------------------------------------- /Units/Report.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUReport 28 | 29 | implicit none 30 | public 31 | 32 | contains 33 | subroutine report(algorithm, version, sequence, start) 34 | character(len=*), intent(in) :: algorithm 35 | character(len=*), intent(in) :: version 36 | character(len=*), intent(in) :: sequence 37 | real, intent(in) :: start 38 | 39 | character(len=*), parameter :: format1 = '(t1, a14, a2, a14, a2, a8, a2, f6.3, a)' 40 | character(len=*), parameter :: format2 = '(t1, a14, a2, a24, a0, a0, a2, f6.3, a)' 41 | character(len=80) :: format 42 | real finish 43 | 44 | character(len=14) :: algorithm_ 45 | character(len=24) :: version_ 46 | character(len=8) :: sequence_ 47 | 48 | format = format1 49 | algorithm_ = algorithm 50 | version_ = version 51 | sequence_ = sequence 52 | 53 | ! increase version field in case sequence is empty 54 | if (len(trim(sequence_)) == 0) then 55 | format = format2 56 | end if 57 | 58 | call cpu_time(finish) 59 | print format, algorithm_, ': ', version_, ' ',sequence_, ' ', finish - start, "s." 60 | end subroutine 61 | end module 62 | -------------------------------------------------------------------------------- /Units/Sorts/MergeSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUMergeSort 28 | 29 | use MArrays 30 | use MMergeSort 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TUMergeSort 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TArrays) :: arrays 44 | 45 | integer, parameter :: NUMBER_OF_ELEMENTS = 25000 46 | integer, dimension(NUMBER_OF_ELEMENTS, 4) :: ARRAY 47 | 48 | character(len=24), dimension(4) :: SEQUENCES = & 49 | (/ 'Sorted', 'Dirty', 'Random', 'Inversed' /) 50 | 51 | call arrays%fillWithSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 1)) 52 | call arrays%fillWithDirtySequence(ARRAY(1:NUMBER_OF_ELEMENTS, 2)) 53 | call arrays%fillWithRandom(ARRAY(1:NUMBER_OF_ELEMENTS, 3)) 54 | call arrays%fillWithInversedSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 4)) 55 | 56 | call sortOriginal(ARRAY, SEQUENCES) 57 | end subroutine 58 | 59 | subroutine sortOriginal(arrays, sequences) 60 | integer, dimension(:,:), intent(in) :: arrays 61 | character(len=*), dimension(:), intent(in) :: sequences 62 | 63 | type(TMergeSort) :: mergeSort 64 | integer, dimension(size(arrays, 1)) :: copy 65 | integer index 66 | real start 67 | 68 | do index = 1, size(arrays, 2) 69 | copy = arrays(1:size(arrays, 1), index) 70 | 71 | call cpu_time(start) 72 | call mergeSort%sortOriginalWrapper(copy) 73 | 74 | call report('MergeSort', 'Original', sequences(index), start) 75 | call assert_sorted(copy) 76 | end do 77 | 78 | print *, '' 79 | end subroutine 80 | end module 81 | -------------------------------------------------------------------------------- /Units/Sorts/RadixSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MURadixSort 28 | 29 | use MArrays 30 | use MRadixSort 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TURadixSort 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TArrays) :: arrays 44 | 45 | integer, parameter :: NUMBER_OF_ELEMENTS = 25000 46 | integer, dimension(NUMBER_OF_ELEMENTS, 4) :: ARRAY 47 | 48 | character(len=24), dimension(4) :: SEQUENCES = & 49 | (/ 'Sorted', 'Dirty', 'Random', 'Inversed' /) 50 | 51 | call arrays%fillWithSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 1)) 52 | call arrays%fillWithDirtySequence(ARRAY(1:NUMBER_OF_ELEMENTS, 2)) 53 | call arrays%fillWithRandom(ARRAY(1:NUMBER_OF_ELEMENTS, 3)) 54 | call arrays%fillWithInversedSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 4)) 55 | 56 | call sortExchange(ARRAY, SEQUENCES) 57 | end subroutine 58 | 59 | subroutine sortExchange(arrays, sequences) 60 | integer, dimension(:,:), intent(in) :: arrays 61 | character(len=*), dimension(:), intent(in) :: sequences 62 | 63 | type(TRadixSort) :: radixSort 64 | integer, dimension(size(arrays, 1)) :: copy 65 | integer index 66 | real start 67 | 68 | do index = 1, size(arrays, 2) 69 | copy = arrays(1:size(arrays, 1), index) 70 | 71 | call cpu_time(start) 72 | call radixSort%sortExchange(copy) 73 | 74 | call report('RadixSort', 'Exchange', sequences(index), start) 75 | call assert_sorted(copy) 76 | end do 77 | 78 | print *, '' 79 | end subroutine 80 | end module 81 | -------------------------------------------------------------------------------- /Units/Sorts/SelectionSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUSelectionSort 28 | 29 | use MArrays 30 | use MSelectionSort 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TUSelectionSort 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TArrays) :: arrays 44 | 45 | integer, parameter :: NUMBER_OF_ELEMENTS = 25000 46 | integer, dimension(NUMBER_OF_ELEMENTS, 4) :: ARRAY 47 | 48 | character(len=24), dimension(4) :: SEQUENCES = & 49 | (/ 'Sorted', 'Dirty', 'Random', 'Inversed' /) 50 | 51 | call arrays%fillWithSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 1)) 52 | call arrays%fillWithDirtySequence(ARRAY(1:NUMBER_OF_ELEMENTS, 2)) 53 | call arrays%fillWithRandom(ARRAY(1:NUMBER_OF_ELEMENTS, 3)) 54 | call arrays%fillWithInversedSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 4)) 55 | 56 | call sortOriginal(ARRAY, SEQUENCES) 57 | end subroutine 58 | 59 | subroutine sortOriginal(arrays, sequences) 60 | integer, dimension(:,:), intent(in) :: arrays 61 | character(len=*), dimension(:), intent(in) :: sequences 62 | 63 | type(TSelectionSort) :: selectionSort 64 | integer, dimension(size(arrays, 1)) :: copy 65 | integer index 66 | real start 67 | 68 | do index = 1, size(arrays, 2) 69 | copy = arrays(1:size(arrays, 1), index) 70 | 71 | call cpu_time(start) 72 | call selectionSort%sortOriginal(copy) 73 | 74 | call report('SelectionSort', 'Original', sequences(index), start) 75 | call assert_sorted(copy) 76 | end do 77 | 78 | print *, '' 79 | end subroutine 80 | end module 81 | -------------------------------------------------------------------------------- /Units/Sorts/ShellSort.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUShellSort 28 | 29 | use MArrays 30 | use MShellSort 31 | use MUAsserts 32 | use MUReport 33 | 34 | implicit none 35 | private 36 | 37 | type, public :: TUShellSort 38 | contains 39 | procedure, nopass :: present 40 | end type 41 | contains 42 | subroutine present() 43 | type(TArrays) :: arrays 44 | 45 | integer, parameter :: NUMBER_OF_ELEMENTS = 25000 46 | integer, dimension(NUMBER_OF_ELEMENTS, 4) :: ARRAY 47 | 48 | character(len=24), dimension(4) :: SEQUENCES = & 49 | (/ 'Sorted', 'Dirty', 'Random', 'Inversed' /) 50 | 51 | call arrays%fillWithSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 1)) 52 | call arrays%fillWithDirtySequence(ARRAY(1:NUMBER_OF_ELEMENTS, 2)) 53 | call arrays%fillWithRandom(ARRAY(1:NUMBER_OF_ELEMENTS, 3)) 54 | call arrays%fillWithInversedSequence(ARRAY(1:NUMBER_OF_ELEMENTS, 4)) 55 | 56 | call sortOriginal(ARRAY, SEQUENCES) 57 | end subroutine 58 | 59 | subroutine sortOriginal(arrays, sequences) 60 | integer, dimension(:,:), intent(in) :: arrays 61 | character(len=*), dimension(:), intent(in) :: sequences 62 | 63 | type(TShellSort) :: shellSort 64 | integer, dimension(size(arrays, 1)) :: copy 65 | integer index 66 | real start 67 | 68 | do index = 1, size(arrays, 2) 69 | copy = arrays(1:size(arrays, 1), index) 70 | 71 | call cpu_time(start) 72 | call shellSort%sortOriginal(copy) 73 | 74 | call report('ShellSort', 'Original', sequences(index), start) 75 | call assert_sorted(copy) 76 | end do 77 | 78 | print *, '' 79 | end subroutine 80 | end module 81 | -------------------------------------------------------------------------------- /Units/Structures/ArrayQueue.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUArrayQueue 28 | 29 | use MArrays 30 | use MArrayQueue 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | type, public :: TUArrayQueue 37 | contains 38 | procedure, nopass :: present 39 | end type 40 | contains 41 | subroutine present() 42 | integer, parameter :: NUMBER_OF_ELEMENTS = 2000000 43 | integer, dimension(NUMBER_OF_ELEMENTS) :: ARRAY 44 | 45 | integer element 46 | integer index 47 | real start 48 | 49 | type(TArrayQueue) :: queue 50 | type(TArrays) :: arrays 51 | 52 | call arrays%fillWithRandom(ARRAY) 53 | 54 | ! add elemenets to stack 55 | call cpu_time(start) 56 | call queue%init() 57 | 58 | do index = 1, size(ARRAY) 59 | call queue%push(ARRAY(index)) 60 | end do 61 | call report('ArrayQueue', 'Push', '', start) 62 | 63 | call cpu_time(start) 64 | do index = 1, size(ARRAY) 65 | element = queue%peek() 66 | if (element /= ARRAY(1)) then 67 | print '(t1, a)', 'FAILED. The return value of peek operation is incorrect.' 68 | print '(t9, a, i10, a, i10)', 'Expected: ', ARRAY(size(ARRAY) - index), ', Value: ', element 69 | return 70 | end if 71 | end do 72 | call report('ArrayQueue', 'Peek', '', start) 73 | 74 | call cpu_time(start) 75 | do index = 1, size(ARRAY) 76 | element = queue%pop() 77 | if (element /= ARRAY(index)) then 78 | print '(t1, a)', 'FAILED. The return value of pop operation is incorrect.' 79 | print '(t9, a, i10, a, i10)', 'Expected: ', ARRAY(index), ', Value: ', element 80 | print *, ARRAY 81 | return 82 | end if 83 | end do 84 | call report('ArrayQueue', 'Pop', '', start) 85 | 86 | call queue%destroy() 87 | 88 | print *, '' 89 | end subroutine 90 | end module 91 | -------------------------------------------------------------------------------- /Units/Structures/ArrayStack.f: -------------------------------------------------------------------------------- 1 | ! 2 | ! The Laboratory of Algorithms 3 | ! 4 | ! The MIT License 5 | ! 6 | ! Copyright 2011-2015 Andrey Pudov. 7 | ! 8 | ! Permission is hereby granted, free of charge, to any person obtaining a copy 9 | ! of this software and associated documentation files (the 'Software'), to deal 10 | ! in the Software without restriction, including without limitation the rights 11 | ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 12 | ! copies of the Software, and to permit persons to whom the Software is 13 | ! furnished to do so, subject to the following conditions: 14 | ! 15 | ! The above copyright notice and this permission notice shall be included in 16 | ! all copies or substantial portions of the Software. 17 | ! 18 | ! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 | ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 21 | ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 22 | ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 23 | ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 24 | ! THE SOFTWARE. 25 | ! 26 | 27 | module MUArrayStack 28 | 29 | use MArrays 30 | use MArrayStack 31 | use MUReport 32 | 33 | implicit none 34 | private 35 | 36 | type, public :: TUArrayStack 37 | contains 38 | procedure, nopass :: present 39 | end type 40 | contains 41 | subroutine present() 42 | integer, parameter :: NUMBER_OF_ELEMENTS = 2000000 43 | integer, dimension(NUMBER_OF_ELEMENTS) :: ARRAY 44 | 45 | integer element 46 | integer index 47 | real start 48 | 49 | type(TArrayStack) :: stack 50 | type(TArrays) :: arrays 51 | 52 | call arrays%fillWithRandom(ARRAY) 53 | 54 | ! add elemenets to stack 55 | call cpu_time(start) 56 | call stack%init() 57 | 58 | do index = 1, size(ARRAY) 59 | call stack%push(ARRAY(index)) 60 | end do 61 | call report('ArrayStack', 'Push', '', start) 62 | 63 | call cpu_time(start) 64 | do index = 1, size(ARRAY) 65 | element = stack%peek() 66 | if (element /= ARRAY(size(ARRAY))) then 67 | print '(t1, a)', 'FAILED. The return value of peek operation is incorrect.' 68 | print '(t9, a, i10, a, i10)', 'Expected: ', ARRAY(size(ARRAY) - index), ', Value: ', element 69 | return 70 | end if 71 | end do 72 | call report('ArrayStack', 'Peek', '', start) 73 | 74 | call cpu_time(start) 75 | do index = 1, size(ARRAY) 76 | element = stack%pop() 77 | if (element /= ARRAY(size(ARRAY) - index + 1)) then 78 | print '(t1, a)', 'FAILED. The return value of pop operation is incorrect.' 79 | print '(t9, a, i10, a, i10)', 'Expected: ', ARRAY(size(ARRAY) - index + 1), ', Value: ', element 80 | return 81 | end if 82 | end do 83 | call report('ArrayStack', 'Pop', '', start) 84 | 85 | call stack%destroy() 86 | 87 | print *, '' 88 | end subroutine 89 | end module 90 | --------------------------------------------------------------------------------