├── .github └── workflows │ ├── check_code_format.yml │ └── ci.yml ├── .gitignore ├── CMakeLists.txt ├── CONTRIBUTING.md ├── DIRECTORY.md ├── LICENSE ├── README.md ├── examples ├── maths │ ├── euclid_gcd.f90 │ ├── factorial.f90 │ ├── fibonacci.f90 │ └── numerical_integration │ │ ├── gaussian_legendre.f90 │ │ ├── midpoint.f90 │ │ ├── monte_carlo.f90 │ │ ├── simpson.f90 │ │ └── trapezoid.f90 ├── searches │ ├── example_linear_search.f90 │ ├── example_ternary_search_array_based.f90 │ ├── example_ternary_search_function_based.f90 │ └── recursive_linear_search.f90 └── sorts │ ├── example_recursive_bubble_sort.f90 │ ├── example_usage_bubble_sort.f90 │ ├── example_usage_gnome_sort.f90 │ ├── example_usage_heap_sort.f90 │ ├── example_usage_merge_sort.f90 │ ├── example_usage_quick_sort.f90 │ └── example_usage_radix_sort.f90 ├── modules ├── maths │ ├── euclid_gcd.f90 │ ├── factorial.f90 │ ├── fibonacci.f90 │ └── numerical_integration │ │ ├── gaussian_legendre.f90 │ │ ├── midpoint.f90 │ │ ├── monte_carlo.f90 │ │ ├── simpson.f90 │ │ └── trapezoid.f90 ├── searches │ ├── linear_search.f90 │ ├── recursive_linear_search.f90 │ └── ternary_search_module.f90 └── sorts │ ├── bubble_sort.f90 │ ├── gnome_sort.f90 │ ├── heap_sort.f90 │ ├── merge_sort.f90 │ ├── quick_sort.f90 │ ├── radix_sort.f90 │ └── recursive_bubble_sort.f90 └── tests ├── maths ├── eculid_gcd.f90 ├── factorial.f90 ├── fibonacci.f90 └── numerical_integration │ ├── gaussin_legendre.f90 │ ├── midpoint.f90 │ ├── monte_carlo.f90 │ ├── simpson.f90 │ └── trapezoid.f90 ├── searches ├── linear_search.f90 ├── recursive_linear_search.f90 ├── ternary_search_array.f90 └── ternary_search_function.f90 └── sorts ├── bubble_sort.f90 ├── gnome_sort.f90 ├── heap_sort.f90 ├── merge_sort.f90 ├── quick_sort.f90 ├── radix_sort.f90 └── recursive_bubbe_sort.f90 /.github/workflows/check_code_format.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: check_code_format 3 | 4 | 'on': 5 | workflow_dispatch: 6 | push: 7 | branches: 8 | - main 9 | pull_request: 10 | 11 | jobs: 12 | check_format_code: 13 | name: check format code 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@v4 17 | 18 | - name: Install fprettify 19 | run: pip install fprettify 20 | 21 | - name: Display fprettify version 22 | run: fprettify --version 23 | 24 | - name: Format code 25 | run: | 26 | git clean -f -x -d 27 | fprettify --indent 4 --recursive . 28 | 29 | - name: Fail if needs reformatting 30 | run: | 31 | if [[ $(git status --porcelain) ]]; then 32 | echo "please reformat/fprettify these files:" 33 | git status --porcelain=v1 34 | exit 1 35 | fi 36 | 37 | - name: Exact diff of needed reformatting 38 | if: failure() 39 | run: git diff 40 | ... 41 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: ci 3 | 4 | 'on': 5 | workflow_dispatch: 6 | push: 7 | branches: 8 | - main 9 | pull_request: 10 | 11 | env: 12 | build_path: ${{github.workspace}}/build 13 | 14 | jobs: 15 | build_and_test: 16 | runs-on: ${{matrix.os}} 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | os: [ubuntu-22.04, ubuntu-24.04] 21 | 22 | steps: 23 | - name: Checkout 24 | uses: actions/checkout@v4 25 | 26 | - name: Display versions 27 | run: | 28 | gfortran --version 29 | cmake --version 30 | 31 | - name: Create Build Directory 32 | run: cmake -E make_directory ${{env.build_path}} 33 | 34 | - name: Configure CMake 35 | working-directory: ${{env.build_path}} 36 | run: cmake ../ 37 | 38 | - name: Build 39 | working-directory: ${{env.build_path}} 40 | run: cmake --build . 41 | 42 | - name: Test 43 | working-directory: ${{env.build_path}} 44 | run: ctest --output-on-failure 45 | 46 | - name: Run examples 47 | working-directory: ${{env.build_path}} 48 | run: make run_all_examples 49 | ... 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Prerequisites 2 | *.d 3 | 4 | # Compiled Object files 5 | *.slo 6 | *.lo 7 | *.o 8 | *.obj 9 | 10 | # Precompiled Headers 11 | *.gch 12 | *.pch 13 | 14 | # Compiled Dynamic libraries 15 | *.so 16 | *.dylib 17 | *.dll 18 | 19 | # Fortran module files 20 | *.mod 21 | *.smod 22 | 23 | # Compiled Static libraries 24 | *.lai 25 | *.la 26 | *.a 27 | *.lib 28 | 29 | # Executables 30 | *.exe 31 | *.out 32 | *.app 33 | 34 | .idea/ 35 | 36 | /build/ 37 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.16) 2 | project(FortranProject LANGUAGES Fortran) 3 | 4 | add_compile_options( 5 | -Wall 6 | -Wextra 7 | -Wpedantic 8 | -Waliasing 9 | -Wconversion-extra 10 | -Wimplicit-interface 11 | -Wimplicit-procedure 12 | -Wsurprising 13 | -Werror) 14 | 15 | function(add_fortran_sources DIR SOURCES) 16 | file(GLOB_RECURSE NEW_SOURCES "${DIR}/*.f90") 17 | list(APPEND ${SOURCES} ${NEW_SOURCES}) 18 | set(${SOURCES} ${${SOURCES}} PARENT_SCOPE) 19 | endfunction() 20 | 21 | set(MODULE_SOURCES) 22 | add_fortran_sources(${CMAKE_SOURCE_DIR}/modules MODULE_SOURCES) 23 | 24 | add_library(modules STATIC ${MODULE_SOURCES}) 25 | 26 | function(create_unique_name FILE_NAME OUTPUT_NAME) 27 | file(RELATIVE_PATH REL_PATH "${CMAKE_SOURCE_DIR}" "${FILE_NAME}") 28 | get_filename_component(CUR_EXT "${REL_PATH}" LAST_EXT) 29 | string(REPLACE "/" "_" UNIQUE_NAME "${REL_PATH}") 30 | string(REPLACE "${CUR_EXT}" "" UNIQUE_NAME "${UNIQUE_NAME}") 31 | set(${OUTPUT_NAME} ${UNIQUE_NAME} PARENT_SCOPE) 32 | endfunction() 33 | 34 | 35 | file(GLOB_RECURSE TEST_FILES "${CMAKE_SOURCE_DIR}/tests/*.f90") 36 | 37 | foreach(TEST_FILE ${TEST_FILES}) 38 | create_unique_name(${TEST_FILE} TEST_NAME) 39 | add_executable(${TEST_NAME} ${TEST_FILE}) 40 | target_link_libraries(${TEST_NAME} modules) 41 | add_test(NAME ${TEST_NAME} COMMAND ${TEST_NAME}) 42 | endforeach() 43 | 44 | file(GLOB_RECURSE EXAMPLE_FILES "${CMAKE_SOURCE_DIR}/examples/*.f90") 45 | 46 | foreach(EXAMPLE_FILE ${EXAMPLE_FILES}) 47 | create_unique_name(${EXAMPLE_FILE} EXAMPLE_NAME) 48 | add_executable(${EXAMPLE_NAME} ${EXAMPLE_FILE}) 49 | target_link_libraries(${EXAMPLE_NAME} modules) 50 | list(APPEND EXAMPLE_NAME_LIST run_${EXAMPLE_NAME}) 51 | add_custom_target(run_${EXAMPLE_NAME} 52 | COMMAND ${EXAMPLE_NAME} 53 | DEPENDS ${EXAMPLE_NAME} 54 | COMMENT "Running example: ${EXAMPLE_NAME}") 55 | endforeach() 56 | 57 | enable_testing() 58 | 59 | add_custom_target(run_all_examples DEPENDS ${EXAMPLE_NAME_LIST}) 60 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing Guidelines 2 | 3 | Welcome to [TheAlgorithms/Fortran](https://github.com/TheAlgorithms/Fortran)! 4 | 5 | Welcome to Fortran! This repository is meant to be referenced and used by learners worldwide, and we aspire to maintain the highest possible quality of the code presented here! If you have any questions or concerns about this guide, please feel free to [state them clearly in an issue](https://github.com/TheAlgorithms/Fortran/issues/new) or ask the community in [Discord](https://the-algorithms.com/discord). 6 | 7 | ## Table Of Contents 8 | 9 | * [What is an Algorithm?](#what-is-an-algorithm) 10 | * [Contributor agreement](#contributor-agreement) 11 | * [Contribution guidelines](#contribution-guidelines) 12 | + [Implementation requirements](#implementation-requirements) 13 | + [Fortran Coding Style](#Fortran-coding-style) 14 | - [Readability and naming conventions](#readability-and-naming-conventions) 15 | - [Compilation](#compilation) 16 | - [Types](#types) 17 | - [Exceptions and side-effects](#exceptions-and-side-effects) 18 | - [Documentation, examples, and tests](#documentation-examples-and-tests) 19 | - [Other](#other) 20 | + [Minimal example](#Minimal-example) 21 | + [Submissions Requirements](#submissions-requirements) 22 | 23 | ## What is an Algorithm? 24 | 25 | An Algorithm is one or more functions that: 26 | 27 | - take one or more inputs, 28 | - perform some internal calculations or data manipulations, 29 | - return one or more outputs, 30 | - have minimal side effects (Examples of side effects: `print`, `read`). 31 | 32 | ## Contributor Agreement 33 | 34 | Being one of our contributors, you agree and confirm that: 35 | 36 | - Your work will be distributed under [MIT License](LICENSE) once your pull request is merged. 37 | - Your work meets the standards of this guideline. 38 | 39 | ## Contribution Guidelines 40 | 41 | We appreciate any contribution, from fixing a grammar mistake in a comment to implementing complex algorithms. Please check the [directory](DIRECTORY.md) and [issues](https://github.com/TheAlgorithms/Fortran/issues/) for an existing (or declined) implementation of your algorithm and relevant discussions. 42 | 43 | **New implementations** are welcome! This includes new solutions for a problem, different representations for a data structure, and algorithm design with different complexity or features. 44 | 45 | **Improving documentation and comments** and **adding tests** is also highly welcome. 46 | 47 | **Identical implementations** are not allowed. 48 | 49 | ### Environment 50 | The environment that I am using is `GNU Fortran (Ubuntu 9.4.0-1ubuntu1~20.04.1) 9.4.0`, a quite stable version of Fortran. Lower versions of Fortran are also acceptable. 51 | 52 | ### Implementation requirements 53 | 54 | - The unit of implementation we expect is a [**Fortran Module**](https://fortran-lang.org/en/learn/best_practices/modules_programs/). Although the main goals of this repository are educational, the module form mirrors a real-world scenario and makes it easy to use the code from this repository in other projects. 55 | - The first line must contain the canonical title of the module prefixed by double hashes (`## Title Of The Module`). This title is used in this repository's automation for populating the [Directory](DIRECTORY.md). 56 | - The module should be thoroughly documented with doc comments. Follow the [Fortran documentation style](https://dftbplus-develguide.readthedocs.io/en/latest/fortranstyle.html#comments). 57 | - The file begins with the module-level documentation with the general description and explanation of the algorithm/data-structure: 58 | * Any restrictions of the implementation and any constraints for the input data. 59 | * An overview of the use cases. 60 | * Recommendations for when to use or avoid using it. 61 | * Comparison with the alternatives. 62 | * Links to source materials and further reading. 63 | - Use intuitive and descriptive names for objects, functions, and variables. 64 | - Return all calculation results instead of printing or plotting them. 65 | - Avoid importing third-party libraries. Only use those for complicated algorithms and only if the alternatives of relying on the standard library or including a short amount of the appropriately-licensed external code are not feasible. 66 | ### Fortran Coding Style 67 | 68 | #### Readability and naming conventions 69 | 70 | We want your work to be readable by others; therefore, we encourage you to follow the official [Fortran Coding Style](https://fortran-lang.org/en/learn/best_practices/style_guide/#naming-convention). 71 | 72 | - Help your readers by using **descriptive names** that eliminate the need for redundant comments. 73 | - Avoid single-letter variable names, unless it has a Minimal lifespan. If your variable comes from a mathematical context or no confusion is possible with another variable, you may use single-letter variables. Generally, single-letter variables stop being OK if there are more than just a couple of them in scope. Some examples: 74 | * Prefer `index` or `idx` to `i` for loops. 75 | * Prefer `src` and `dst` to `a` and `b`. 76 | * Prefer `remainder` to `r` and `prefix` to `p`. 77 | - Expand acronyms. Prefer `greatest_common_divisor()` to `gcd()`, as the former is easier to understand than the latter, especially for non-native English speakers. 78 | 79 | ### Minimal example 80 | 81 | ```Fortran 82 | !> My Algorithm 83 | !! 84 | !! Description, explanation, recommendations, sources, links. 85 | 86 | !! This simple program adds two numbers 87 | program addNumbers 88 | 89 | implicit none 90 | 91 | !! Type declarations 92 | real :: a, b, result 93 | 94 | !! Executable statements 95 | a = 12.0 96 | b = 15.0 97 | result = a + b 98 | print *, 'The total is ', result 99 | 100 | end program addNumbers 101 | ``` 102 | 103 | ### Submissions Requirements 104 | 105 | - Make sure the code compiles before submitting. 106 | - Look up the name of your algorithm in other active repositories of [TheAlgorithms](https://github.com/TheAlgorithms/), like [TheAlgorithms/Python](https://github.com/TheAlgorithms/Python). By reusing the same name, your implementation will be appropriately grouped alongside other implementations on the [project's website](https://the-algorithms.com/). 107 | - Please help us keep our issue list small by adding fixes: Add the number of the issue you solved — even if only partially — to the commit message of your pull request. 108 | - Use *snake_case* (words separated with an underscore `_`) for the filename. 109 | - Try to fit your work into the existing directory structure as much as possible. Please open an issue first if you want to create a new subdirectory. 110 | - Writing documentation, be concise, and check your spelling and grammar. 111 | - Add a corresponding explanation to [Algorithms-Explanation](https://github.com/TheAlgorithms/Algorithms-Explanation) (optional but recommended). 112 | - Implementing the modules is not just enough. We strongly recommend you make an [example usage](https://github.com/TheAlgorithms/Fortran/tree/main/examples) and a [test file](https://github.com/TheAlgorithms/Fortran/tree/main/tests) of your code, and put it under the "examples" and "tests" directories, under the category of your algorithm. 113 | - Most importantly, **be consistent in the use of these guidelines**. 114 | 115 | **Happy coding!** 116 | 117 | --- 118 | 119 | Authors: [@SatinWukerORIG](https://github.com/SatinWukerORIG) 120 | -------------------------------------------------------------------------------- /DIRECTORY.md: -------------------------------------------------------------------------------- 1 | # The Algorithms - Directory of Fortran 2 | ## Maths 3 | * numerical_integration 4 | * [trapezoidal_rule](/modules/maths/numerical_integration/trapezoid.f90) 5 | * [simpson_rule](/modules/maths/numerical_integration/simpson.f90) 6 | * [midpoint_rule](/modules/maths/numerical_integration/midpoint.f90) 7 | * [monte_carlo](/modules/maths/numerical_integration/monte_carlo.f90) 8 | * [gauss_legendre](/modules/maths/numerical_integration/gaussian_legendre.f90) 9 | * [euclid_gcd](/modules/maths/euclid_gcd.f90) 10 | * [factorial](/modules/maths/factorial.f90) 11 | * [fibonacci](/modules/maths/fibonacci.f90) 12 | ## Searches 13 | * [linear_search](/modules/searches/linear_search.f90) 14 | * [recursive_linear_search](/modules/searches/recursive_linear_search.f90) 15 | * [ternary_search](/modules/searches/ternary_search_module.f90) 16 | ## Sorts 17 | * [bubble_sort](/modules/sorts/bubble_sort.f90) 18 | * [recursive_bubble_sort](/modules/sorts/recursive_bubble_sort.f90) 19 | * [merge_sort](/modules/sorts/merge_sort.f90) 20 | * [heap_sort](/modules/sorts/heap_sort.f90) 21 | * [gnome_sort](/modules/sorts/gnome_sort.f90) 22 | * [quick_sort](/sorts/quick_sort.f90) 23 | * [radix_sort](/sorts/gnome_sort.f90) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 The Algorithms 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 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 |
3 | 4 | 5 | 6 | 7 |

The Algorithms - Fortran

8 | All Algorithms implemented in Fortran, Making Fortran Great Again! 9 |
10 |
11 | 12 | 13 | 14 | Contributions Welcome 15 | 16 | 17 | Discord chat 18 | 19 | 20 | Gitter chat 21 | 22 | 23 | [![HitCount](https://hits.dwyl.com/TheAlgorithms/Fortran.svg?style=flat-square)](http://hits.dwyl.com/TheAlgorithms/Fortran) 24 | 25 |
26 | 27 | GitHub Workflow Status 28 | 29 | 30 | pre-commit 31 | 32 | 33 | code style: black 34 | 35 | 36 |

All algorithms implemented in Fortran - for education

37 |
38 | 39 | ## Getting Started 40 | 41 | Read through our [Contribution Guidelines](CONTRIBUTING.md) before you contribute. 42 | 43 | ## Community Channels 44 | 45 | We are on [Discord](https://the-algorithms.com/discord) and [Gitter](https://gitter.im/TheAlgorithms/community)! Community channels are a great way for you to ask questions and get help. Please join us! 46 | 47 | ## List of Algorithms 48 | 49 | See our [directory](DIRECTORY.md) for easier navigation and a better overview of the project. 50 | -------------------------------------------------------------------------------- /examples/maths/euclid_gcd.f90: -------------------------------------------------------------------------------- 1 | !> Program to compute the GCD of two numbers using the gcd_module 2 | 3 | program euclid_gcd_program 4 | use gcd_module 5 | implicit none 6 | integer :: a, b, val 7 | 8 | a = 56 9 | b = 98 10 | 11 | val = gcd(a, b) 12 | print *, 'The greatest common divisor of ', a, ' and ', b, ' is: ', val 13 | 14 | end program euclid_gcd_program 15 | -------------------------------------------------------------------------------- /examples/maths/factorial.f90: -------------------------------------------------------------------------------- 1 | !> Factorial Example Program 2 | !! This program demonstrates the use of the factorial functions 3 | !! defined in the `factorial_module`. It calculates and prints 4 | !! the factorial of a number using both iterative and recursive methods. 5 | 6 | program factorial_program 7 | use factorial_module 8 | implicit none 9 | 10 | Print *, factorial(5) 11 | Print *, recursive_factorial(5) 12 | 13 | end program factorial_program 14 | -------------------------------------------------------------------------------- /examples/maths/fibonacci.f90: -------------------------------------------------------------------------------- 1 | !> Example program to use the Fibonacci module 2 | !> Prints the nth Fibonacci number using both recursive and iterative implementations. 3 | 4 | program example_fibonacci 5 | use fibonacci_module 6 | implicit none 7 | integer :: n 8 | 9 | n = 7 10 | 11 | print *, 'The Fibonacci number for the position', n, ' is:' 12 | print *, 'Recursive solution: ', fib_rec(n) 13 | print *, 'Iterative solution: ', fib_itr(n) 14 | 15 | end program example_fibonacci 16 | -------------------------------------------------------------------------------- /examples/maths/numerical_integration/gaussian_legendre.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Gaussian-Legendre Quadrature Module 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #25 5 | !! https://github.com/TheAlgorithms/Fortran/pull/25 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of Gaussian-Legendre Quadrature Module for numerical integration. 11 | !! 12 | !! It sets the integration limits and the number of quadrature points (n), and calls the 13 | !! gauss_legendre_quadrature subroutine to compute the approximate value of the definite integral 14 | !! of the specified function. 15 | !! 16 | !! Example function: f(x) = exp(-x^2) * cos(2.0_dp * x) 17 | 18 | program example_gaussian_quadrature 19 | use gaussian_legendre_quadrature 20 | implicit none 21 | 22 | real(dp) :: lower_bound, upper_bound, integral_result 23 | integer :: quadrature_points_number 24 | 25 | ! Set the integration limits and number of quadrature points 26 | lower_bound = -1.0_dp 27 | upper_bound = 1.0_dp 28 | quadrature_points_number = 5 !! Number of quadrature points (order of accuracy) up to 5 29 | 30 | ! Call Gaussian quadrature to compute the integral with the function passed as an argument 31 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, quadrature_points_number, function) 32 | 33 | write (*, '(A, F12.6)') "Gaussian Quadrature result: ", integral_result !! ≈ 0.858574 34 | 35 | contains 36 | 37 | function function(x) result(fx) 38 | implicit none 39 | real(dp), intent(in) :: x 40 | real(dp) :: fx 41 | 42 | fx = exp(-x**2)*cos(2.0_dp*x) !! Example function to integrate 43 | end function function 44 | 45 | end program example_gaussian_quadrature 46 | -------------------------------------------------------------------------------- /examples/maths/numerical_integration/midpoint.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Midpoint Rule 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #25 5 | !! https://github.com/TheAlgorithms/Fortran/pull/25 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of Midpoint Rule for numerical integration. 11 | !! 12 | !! It sets the integration limits and number of subintervals (panels), and calls the 13 | !! midpoint subroutine to compute the approximate value of the definite integral 14 | !! of the specified function. 15 | !! 16 | !! Example function: f(x) = exp(-x^2) * cos(2.0_dp * x) 17 | 18 | program example_midpoint 19 | use midpoint_rule 20 | implicit none 21 | 22 | real(dp) :: lower_bound, upper_bound, integral_result 23 | integer :: panels_number 24 | 25 | ! Set the integration limits and number of panels 26 | lower_bound = -1.0_dp 27 | upper_bound = 1.0_dp 28 | panels_number = 400 !! Number of subdivisions 29 | 30 | ! Call the midpoint rule subroutine with the function passed as an argument 31 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, function) 32 | 33 | write (*, '(A, F12.6)') "Midpoint rule yields: ", integral_result !! ≈ 0.858196 34 | 35 | contains 36 | 37 | function function(x) result(fx) 38 | implicit none 39 | real(dp), intent(in) :: x 40 | real(dp) :: fx 41 | 42 | fx = exp(-x**2)*cos(2.0_dp*x) !! Example function to integrate 43 | end function function 44 | 45 | end program example_midpoint 46 | -------------------------------------------------------------------------------- /examples/maths/numerical_integration/monte_carlo.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Monte Carlo Integration 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #25 5 | !! https://github.com/TheAlgorithms/Fortran/pull/25 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of Monte Carlo module for numerical integration. 11 | !! 12 | !! It sets the integration limits and number of random samples, and calls the 13 | !! monte_carlo subroutine to compute the approximate value of the definite integral 14 | !! of the specified function. 15 | !! 16 | !! Example function: f(x) = exp(-x^2) * cos(2.0_dp * x) 17 | 18 | program example_monte_carlo 19 | use monte_carlo_integration 20 | implicit none 21 | 22 | real(dp) :: lower_bound, upper_bound, integral_result, error_estimate 23 | integer :: random_samples_number 24 | 25 | ! Set the integration limits and number of random samples 26 | lower_bound = -1.0_dp 27 | upper_bound = 1.0_dp 28 | random_samples_number = 1000000 !! 1E6 Number of random samples 29 | 30 | ! Call Monte Carlo integration with the function passed as an argument 31 | call monte_carlo(integral_result, error_estimate, lower_bound, upper_bound, random_samples_number, function) 32 | 33 | write (*, '(A, F12.6, A, F12.6)') "Monte Carlo result: ", integral_result, " +- ", error_estimate !! ≈ 0.858421 34 | 35 | contains 36 | 37 | function function(x) result(fx) 38 | implicit none 39 | real(dp), intent(in) :: x 40 | real(dp) :: fx 41 | 42 | fx = exp(-x**2)*cos(2.0_dp*x) !! Example function to integrate 43 | end function function 44 | 45 | end program example_monte_carlo 46 | -------------------------------------------------------------------------------- /examples/maths/numerical_integration/simpson.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Simpson's Rule 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #25 5 | !! https://github.com/TheAlgorithms/Fortran/pull/25 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of Simpson's rule for numerical integration. 11 | !! 12 | !! It sets the integration limits and number of panels, and calls the 13 | !! simpson subroutine to compute the approximate value of the definite integral 14 | !! of the specified function. 15 | !! 16 | !! Example function: f(x) = exp(-x^2) * cos(2.0_dp * x) 17 | 18 | program example_simpson 19 | use simpson_rule 20 | implicit none 21 | 22 | real(dp) :: lower_bound, upper_bound, integral_result 23 | integer :: panels_number 24 | 25 | ! Set the integration limits and number of panels 26 | lower_bound = -1.0_dp 27 | upper_bound = 1.0_dp 28 | panels_number = 100 !! Number of subdivisions (must be even) 29 | 30 | ! Call Simpson's rule with the function passed as an argument 31 | call simpson(integral_result, lower_bound, upper_bound, panels_number, function) 32 | 33 | write (*, '(A, F12.8)') "Simpson's rule yields: ", integral_result !! ≈ 0.85819555 34 | 35 | contains 36 | 37 | function function(x) result(fx) 38 | implicit none 39 | real(dp), intent(in) :: x 40 | real(dp) :: fx 41 | 42 | fx = exp(-x**2)*cos(2.0_dp*x) !! Example function to integrate 43 | end function function 44 | 45 | end program example_simpson 46 | -------------------------------------------------------------------------------- /examples/maths/numerical_integration/trapezoid.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Trapezoidal Rule 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #25 5 | !! https://github.com/TheAlgorithms/Fortran/pull/25 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the Trapezoidal rule for numerical integration. 11 | !! 12 | !! It sets the integration limits and number of panels, and calls the 13 | !! trapezoid subroutine to compute the approximate value of the definite integral 14 | !! of the specified function. 15 | !! 16 | !! Example function: f(x) = exp(-x^2) * cos(2.0_dp * x) 17 | 18 | program example_tapezoid 19 | use trapezoidal_rule 20 | implicit none 21 | 22 | real(dp) :: lower_bound, upper_bound, integral_result 23 | integer :: panels_number 24 | 25 | ! Set the integration limits and number of panels 26 | lower_bound = -1.0_dp 27 | upper_bound = 1.0_dp 28 | panels_number = 1000000 !! 1E6 Number of subdivisions 29 | 30 | ! Call the trapezoidal rule with the function passed as an argument 31 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, function) 32 | 33 | write (*, '(A, F12.6)') 'Trapezoidal rule yields: ', integral_result !! ≈ 0.858195 34 | 35 | contains 36 | 37 | function function(x) result(fx) 38 | implicit none 39 | real(dp), intent(in) :: x 40 | real(dp) :: fx 41 | 42 | fx = exp(-x**2)*cos(2.0_dp*x) !! Example function to integrate 43 | end function function 44 | 45 | end program example_tapezoid 46 | -------------------------------------------------------------------------------- /examples/searches/example_linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Example program for the Linear Search algorithm 2 | !! 3 | !! This program demonstrates the use of the the linear_search_module to search for targets within arrays. 4 | 5 | program linear_search_program 6 | use linear_search_module 7 | implicit none 8 | 9 | integer, dimension(5) :: array 10 | 11 | array = (/540, 6, 10, 100, 3/) 12 | 13 | !! Search for the number 6 in array. 14 | print *, "Target = 6: ", linear_search(array, 6) !! Prints 2. 15 | 16 | !! Search for the number 5 in array. 17 | print *, "Target = 5: ", linear_search(array, 5) !! Prints -1 because item 5 is not found. 18 | 19 | end program linear_search_program 20 | -------------------------------------------------------------------------------- /examples/searches/example_ternary_search_array_based.f90: -------------------------------------------------------------------------------- 1 | ! Example Program: Array-based Ternary Search 2 | ! This program demonstrates how to use the array-based ternary search algorithm 3 | ! implemented in the `ternary_search` module to find a target element in a sorted array. 4 | 5 | program example_ternary_search_array 6 | use ternary_search 7 | implicit none 8 | integer :: result ! Holds the index of the found target 9 | integer, dimension(10) :: arr = [1, 3, 5, 7, 9, 11, 13, 15, 17, 19] ! Sorted Test Array 10 | integer :: target ! Target value to search for 11 | 12 | target = 17 13 | result = ternary_search_array(arr, target, 1, size(arr)) 14 | 15 | if (result /= -1) then 16 | print *, "Target found at index:", result 17 | else 18 | print *, "Target not found." 19 | end if 20 | end program example_ternary_search_array 21 | -------------------------------------------------------------------------------- /examples/searches/example_ternary_search_function_based.f90: -------------------------------------------------------------------------------- 1 | !> Example Program: Function-based Ternary Search for Minimum and Maximum 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #24 5 | !! https://github.com/TheAlgorithms/Fortran/pull/24 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates how to use the function-based ternary search algorithm 11 | !! from the `ternary_search` module to find the minimum and maximum of unimodal functions. 12 | 13 | program ternary_search_function_based 14 | use ternary_search 15 | implicit none 16 | 17 | ! Define the variables 18 | integer, parameter :: dp = kind(0.0d0) ! Define double precision kind 19 | real(8) :: result_min, result_max ! Results for minimum and maximum values 20 | real(8) :: min_point, max_point ! Points where minimum and maximum occur 21 | real(8) :: left, right, tol ! Left and right bounds, and tolerance 22 | 23 | interface 24 | ! Function with a minimum (example function - defined externally) 25 | real(8) function f_min(x) 26 | real(8), intent(in) :: x 27 | end function f_min 28 | 29 | ! Function with a maximum (example function - defined externally) 30 | real(8) function f_max(x) 31 | real(8), intent(in) :: x 32 | end function f_max 33 | end interface 34 | 35 | ! The boundary values can vary depending on the problem context. 36 | ! In this example, they are chosen arbitrarily. 37 | left = 0.0d0 38 | right = 10.0d0 39 | 40 | ! The tolerance value defines how close the left and right bounds must be for the search to terminate. 41 | tol = 1.0e-6_dp 42 | 43 | ! Call the ternary search to find the minimum point of f_min 44 | min_point = ternary_search_minimum(f_min, left, right, tol) 45 | result_min = f_min(min_point) 46 | 47 | ! Call the ternary search to find the maximum point of f_max 48 | max_point = ternary_search_maximum(f_max, left, right, tol) 49 | result_max = f_max(max_point) 50 | 51 | print *, "Minimum of the function f_min is at x =", min_point, "with value =", result_min 52 | print *, "Maximum of the function f_max is at x =", max_point, "with value =", result_max 53 | 54 | end program ternary_search_function_based 55 | 56 | ! Define the unimodal function f_min with a minimum near x = 5.0 57 | ! The quadratic term (x - 5.0)**2 defines a parabola that is concave upward with a minimum at x = 5.0 58 | ! and values increasing as x moves away from 5. 59 | ! The cosine term introduces oscillations, affecting the exact location of the minimum slightly away from 5.0. 60 | 61 | real(8) function f_min(x) 62 | real(8), intent(in) :: x 63 | f_min = (x - 5.0d0)**2 + cos(x) ! Example of a quadratic function with a cosine oscillation 64 | end function f_min 65 | 66 | ! Define the unimodal function f_max with a maximum near x = 5.0 67 | ! The quadratic term -(x - 5.0)**2 defines a parabola that is concave downward with a maximum at x = 5.0 68 | ! and values decreasing as x moves away from 5. 69 | ! The cosine term introduces oscillations, affecting the exact location of the maximum slightly away from 5.0. 70 | 71 | real(8) function f_max(x) 72 | real(8), intent(in) :: x 73 | f_max = -(x - 5.0d0)**2 + cos(x) ! Example of a quadratic function with a cosine oscillation 74 | end function f_max 75 | -------------------------------------------------------------------------------- /examples/searches/recursive_linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Example program demonstrating Recursive Linear Search 2 | !! 3 | !! This program demonstrates the use of the `recursive_linear_search_module` to search for target values within arrays. 4 | 5 | program recursive_linear_search_example 6 | use recursive_linear_search_module 7 | implicit none 8 | 9 | integer, dimension(5) :: array 10 | 11 | array = (/306, 1005, 5, 62, 0/) 12 | 13 | !! Search for the number 62 in the array 14 | print *, "Target = 62: ", recursive_linear_search(array, size(array), 62) !! Prints 4. 15 | 16 | !! Search for the number 10 in the array 17 | print *, "Target = 10: ", recursive_linear_search(array, size(array), 10) !! Prints -1 because item 10 is not found. 18 | 19 | end program recursive_linear_search_example 20 | -------------------------------------------------------------------------------- /examples/sorts/example_recursive_bubble_sort.f90: -------------------------------------------------------------------------------- 1 | !> Example Program for Recursive Bubble Sort 2 | !! 3 | !! This program demonstrates the use of the `recursive_bubble_sort_module` to sort an array using the recursive bubble sort algorithm. 4 | 5 | program recursive_bubble_sort_example 6 | use recursive_bubble_sort_module 7 | implicit none 8 | 9 | real :: array(5) 10 | 11 | !! Fill the array with random numbers. 12 | call random_number(array) 13 | 14 | print *, "Before:", array 15 | 16 | !! Bubble sort subroutine call. 17 | call recursive_bubble_sort(array, size(array)) 18 | 19 | print *, "After:", array 20 | 21 | end program recursive_bubble_sort_example 22 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_bubble_sort.f90: -------------------------------------------------------------------------------- 1 | !> Example program demonstrating Bubble Sort 2 | !! 3 | !! This program demonstrates the use of the `bubble_sort_module` to sort an array using the bubble sort algorithm. 4 | 5 | program bubble_sort_example 6 | use bubble_sort_module 7 | implicit none 8 | 9 | real :: array(5) 10 | 11 | !! Fill the array with random numbers 12 | call random_number(array) 13 | 14 | print *, "Before:", array 15 | 16 | !! Call the bubble_sort subroutine to sort the array 17 | call bubble_sort(array) 18 | 19 | print *, "After:", array 20 | 21 | end program bubble_sort_example 22 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_gnome_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Gnome Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #09 5 | !! https://github.com/TheAlgorithms/Fortran/pull/9 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the gnome_sort_module by sorting an array of integers. 11 | 12 | program test_gnome_sort 13 | use gnome_sort_module 14 | implicit none 15 | integer, dimension(10) :: array ! Test array 16 | integer :: n, i 17 | 18 | ! Initialize the test array 19 | array = (/-5, 2, 9, 1, 5, 6, -7, 8, 15, -20/) 20 | n = size(array) 21 | 22 | ! Call gnome_sort from the module to sort the array 23 | call gnome_sort(array) 24 | 25 | print *, "Sorted array:" 26 | do i = 1, n 27 | print *, array(i) 28 | end do 29 | end program test_gnome_sort 30 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_heap_sort.f90: -------------------------------------------------------------------------------- 1 | !> Example program for the Heap Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #8 5 | !! https://github.com/TheAlgorithms/Fortran/pull/8 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the heap_sort_module by sorting an array of integers. 11 | 12 | program test_heap_sort 13 | use heap_sort_module 14 | implicit none 15 | integer, parameter :: n = 12 16 | integer :: i 17 | integer, dimension(n) :: array(n) ! Test array 18 | 19 | ! Initialize the test array 20 | array = (/12, 11, 13, 5, 6, 7, 3, 9, -1, 2, -12, 1/) 21 | 22 | ! Print the original array 23 | print *, "Original array:" 24 | do i = 1, n 25 | print *, array(i) 26 | end do 27 | 28 | ! Call heap_sort from the module to sort the array 29 | call heap_sort(array, n) 30 | 31 | ! Print the sorted array 32 | print *, "Sorted array:" 33 | do i = 1, n 34 | print *, array(i) 35 | end do 36 | 37 | end program test_heap_sort 38 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_merge_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Merge Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #7 5 | !! https://github.com/TheAlgorithms/Fortran/pull/7 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the merge_sort_module by sorting an array of integers. 11 | 12 | program test_merge_sort 13 | use merge_sort_module 14 | implicit none 15 | integer, dimension(8) :: array ! Test array 16 | integer :: n, i 17 | 18 | ! Initialize the test array 19 | array = (/-2, 3, -10, 11, 99, 100000, 100, -200/) 20 | n = size(array) 21 | 22 | ! Call merge_sort from the module to sort the array 23 | call merge_sort(array, n) 24 | 25 | print *, "Sorted array:" 26 | do i = 1, n 27 | print *, array(i) 28 | end do 29 | end program test_merge_sort 30 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_quick_sort.f90: -------------------------------------------------------------------------------- 1 | !> Example program for the Quick Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #10 5 | !! https://github.com/TheAlgorithms/Fortran/pull/10 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the quick_sort_module by sorting an array of integers. 11 | 12 | program test_quick_sort 13 | use quick_sort_module 14 | implicit none 15 | 16 | integer, dimension(10) :: array ! Test array 17 | integer :: n, i 18 | 19 | ! Initialize the test array 20 | array = (/10, 7, 8, 9, 1, 5, -2, 12, 0, -5/) 21 | n = size(array) 22 | 23 | ! Print the original array 24 | print *, "Original array:" 25 | do i = 1, n 26 | print *, array(i) 27 | end do 28 | 29 | ! Call quick_sort from the module to sort the array 30 | call quick_sort(array, 1, n) ! (1: low bound , n: high bound) of the array 31 | 32 | ! Print the sorted array 33 | print *, "Sorted array:" 34 | do i = 1, n 35 | print *, array(i) 36 | end do 37 | 38 | end program test_quick_sort 39 | -------------------------------------------------------------------------------- /examples/sorts/example_usage_radix_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Radix Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #11 5 | !! https://github.com/TheAlgorithms/Fortran/pull/11 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program demonstrates the use of the radix_sort_module by sorting an array of integers. 11 | !! The base parameter affects the internal digit processing but does not change the final sorted order 12 | !! of decimal integers. The output is always in decimal form. 13 | 14 | program test_radix_sort 15 | use radix_sort_module 16 | implicit none 17 | integer, dimension(10) :: array 18 | integer :: n, i 19 | integer, parameter :: base10 = 10, base2 = 2, base16 = 16 20 | 21 | ! Test for base 10 22 | print *, "Testing Radix Sort with base 10:" 23 | array = (/170, 45, 75, 90, 802, 24, 2, 66, 15, 40/) 24 | n = size(array) 25 | call radix_sort(array, n, base10) 26 | print *, "Sorted array in base 10:" 27 | do i = 1, n 28 | print *, array(i) 29 | end do 30 | 31 | ! Test for base 2 32 | print *, "Testing Radix Sort with base 2:" 33 | array = (/1010, 1101, 1001, 1110, 0010, 0101, 1111, 0110, 1000, 0001/) ! Binary values whose decimal: (/ 10, 13, 9, 14, 2, 5, 15, 6, 8, 1 /) 34 | n = size(array) 35 | call radix_sort(array, n, base2) 36 | print *, "Sorted binary array in Decimal:" 37 | do i = 1, n 38 | print *, array(i) 39 | end do 40 | 41 | ! Test for base 16 42 | print *, "Testing Radix Sort with base 16:" 43 | array = (/171, 31, 61, 255, 16, 5, 211, 42, 180, 0/) ! Hexadecimal values as decimal 44 | n = size(array) 45 | call radix_sort(array, n, base16) 46 | print *, "Sorted hexadecimal array in Decimal:" 47 | do i = 1, n 48 | print *, array(i) 49 | end do 50 | 51 | end program test_radix_sort 52 | 53 | -------------------------------------------------------------------------------- /modules/maths/euclid_gcd.f90: -------------------------------------------------------------------------------- 1 | !> Module implementing the Euclidean Algorithm for GCD 2 | !! 3 | !! Modified by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #31 5 | !! https://github.com/TheAlgorithms/Fortran/pull/31 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! Reference: https://en.wikipedia.org/wiki/Euclidean_algorithm 11 | 12 | module gcd_module 13 | implicit none 14 | contains 15 | 16 | !! Function to compute the GCD of two integers using the Euclidean algorithm 17 | function gcd(a, b) result(val) 18 | integer, value :: a, b 19 | integer :: t, val 20 | 21 | ! Ensure the GCD is non-negative 22 | a = abs(a) 23 | b = abs(b) 24 | 25 | ! Euclidean algorithm for GCD 26 | do while (b /= 0) 27 | t = b 28 | b = mod(a, b) 29 | a = t 30 | end do 31 | val = a 32 | end function gcd 33 | 34 | end module gcd_module 35 | -------------------------------------------------------------------------------- /modules/maths/factorial.f90: -------------------------------------------------------------------------------- 1 | !> Factorial Module 2 | !! This module implements factorial calculation functions. 3 | !! https://en.wikipedia.org/wiki/Factorial 4 | !! The module contains two functions: one for calculating factorial iteratively 5 | !! and another one recursively. 6 | 7 | module factorial_module 8 | implicit none 9 | 10 | contains 11 | 12 | !! This function calculates the factorial of a given number using a loop. 13 | function factorial(number) result(factorial_number) 14 | integer, intent(in) :: number !! Number to calculate factorial of 15 | integer :: factorial_number !! Resulting factorial 16 | 17 | integer :: counter 18 | counter = number 19 | 20 | factorial_number = 1 21 | do while (counter > 1) 22 | factorial_number = factorial_number*counter 23 | counter = counter - 1 24 | end do 25 | 26 | end function factorial 27 | 28 | !! This function calculates the factorial of a given number using a recursive function. 29 | recursive function recursive_factorial(number) result(factorial_number) 30 | integer, intent(in) :: number !! Number to calculate factorial of 31 | integer :: factorial_number !! Resulting factorial 32 | 33 | if (number .lt. 1) then 34 | factorial_number = 1 35 | else 36 | factorial_number = number*recursive_factorial(number - 1) 37 | end if 38 | 39 | end function recursive_factorial 40 | 41 | end module factorial_module 42 | -------------------------------------------------------------------------------- /modules/maths/fibonacci.f90: -------------------------------------------------------------------------------- 1 | !> Module for Fibonacci series calculations 2 | !! 3 | !! Modified by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #31 5 | !! https://github.com/TheAlgorithms/Fortran/pull/31 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! Provides both recursive and iterative implementations. 11 | !! Reference: https://en.wikipedia.org/wiki/Fibonacci_number 12 | 13 | module fibonacci_module 14 | implicit none 15 | contains 16 | 17 | !! Recursive function to compute the nth Fibonacci number 18 | recursive function fib_rec(n) result(f) 19 | integer, intent(in), value :: n 20 | integer :: f 21 | if (n < 0) then 22 | f = -1 ! signal error condition 23 | else if (n <= 1) then 24 | f = n 25 | else 26 | f = fib_rec(n - 1) + fib_rec(n - 2) 27 | end if 28 | end function fib_rec 29 | 30 | !! Iterative function to compute the nth Fibonacci number 31 | function fib_itr(n) result(f) 32 | integer, intent(in) :: n 33 | integer :: f, tmp, f_1 34 | integer :: i 35 | if (n < 0) then 36 | f = -1 ! signal error condition 37 | else if (n <= 1) then 38 | f = n 39 | else 40 | f_1 = 0 41 | f = 1 42 | do i = 2, n 43 | tmp = f 44 | f = f + f_1 45 | f_1 = tmp 46 | end do 47 | end if 48 | end function fib_itr 49 | 50 | end module fibonacci_module 51 | -------------------------------------------------------------------------------- /modules/maths/numerical_integration/gaussian_legendre.f90: -------------------------------------------------------------------------------- 1 | !> Gaussian-Legendre Quadrature Module 2 | !! 3 | !! This module provides the implementation of Gaussian-Legendre Quadrature. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #25 7 | !! https://github.com/TheAlgorithms/Fortran/pull/25 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! The method approximates the definite integral of a function over a specified interval [a, b]. 13 | !! 14 | !! The quadrature method works by transforming nodes and weights from the reference interval [-1, 1] to the 15 | !! interval [a, b] and then evaluating the function at these nodes. The integral is then approximated by summing 16 | !! the product of function values and corresponding weights. 17 | !! 18 | !! Contents: 19 | !! - `gauss_legendre_quadrature`: A subroutine to perform Gaussian-Legendre quadrature using provided nodes and weights. 20 | !! - `gauss_legendre_weights`: A helper subroutine to initialize the quadrature nodes and weights for different orders (n). 21 | !! 22 | !! Input: 23 | !! - `a`: Lower bound of integration (real(dp)) 24 | !! - `b`: Upper bound of integration (real(dp)) 25 | !! - `n`: Number of quadrature points (integer) 26 | !! - `func`: The function to integrate (interface) 27 | !! 28 | !! Output: 29 | !! - `integral_result`: Approximate value of the integral (real(dp)) 30 | 31 | module gaussian_legendre_quadrature 32 | implicit none 33 | integer, parameter :: dp = kind(1.0d0) !! Double precision parameter 34 | 35 | contains 36 | 37 | ! General Gaussian Quadrature for definite integral 38 | subroutine gauss_legendre_quadrature(integral_result, a, b, n, func) 39 | implicit none 40 | real(dp), intent(out) :: integral_result 41 | real(dp), intent(in) :: a, b 42 | integer, intent(in) :: n !! Number of quadrature points (order of accuracy) 43 | 44 | real(dp), dimension(n) :: t, w, x 45 | real(dp), dimension(:), allocatable :: fx 46 | integer :: i 47 | 48 | ! Interface for the function 49 | interface 50 | real(kind(0.d0)) function func(x) result(fx) 51 | real(kind(0.d0)), intent(in) :: x 52 | end function func 53 | end interface 54 | 55 | ! Initialize nodes and weights for Gauss-Legendre quadrature based on n 56 | call gauss_legendre_weights(t, w, n) 57 | 58 | ! Allocate the function value array 59 | allocate (fx(n)) 60 | 61 | ! Transform the nodes from the reference interval [-1, 1] to [a, b] 62 | x = (b + a)/2.0_dp + (b - a)*t/2.0_dp 63 | 64 | ! Compute function values at the transformed points 65 | do i = 1, n 66 | fx(i) = func(x(i)) 67 | end do 68 | 69 | ! Apply the Gaussian-Legendre quadrature formula 70 | integral_result = sum(w*fx)*(b - a)/2.0_dp 71 | 72 | ! Deallocate fx array 73 | deallocate (fx) 74 | 75 | end subroutine gauss_legendre_quadrature 76 | 77 | ! Subroutine to initialize Gauss-Legendre nodes and weights 78 | subroutine gauss_legendre_weights(t, w, n) 79 | implicit none 80 | integer, intent(in) :: n 81 | real(dp), intent(out), dimension(n) :: t, w !! Nodes (t) and weights (w) 82 | 83 | ! Predefined nodes and weights for different values of n 84 | select case (n) 85 | case (1) 86 | t = [0.0_dp] !! Single node at the center for n = 1 87 | w = [2.0_dp] !! Weight of 2 for the single point 88 | case (2) 89 | t = [-0.5773502692_dp, 0.5773502692_dp] !! Symmetric nodes for n = 2 90 | w = [1.0_dp, 1.0_dp] !! Equal weights for n = 2 91 | case (3) 92 | t = [-0.7745966692_dp, 0.0_dp, 0.7745966692_dp] !! Symmetric nodes for n = 3 93 | w = [0.5555555556_dp, 0.8888888889_dp, 0.5555555556_dp] !! Weights for n = 3 94 | case (4) 95 | t = [-0.8611363116_dp, -0.3399810436_dp, 0.3399810436_dp, 0.8611363116_dp] !! Nodes for n = 4 96 | w = [0.3478548451_dp, 0.6521451549_dp, 0.6521451549_dp, 0.3478548451_dp] !! Weights for n = 4 97 | case (5) 98 | t = [-0.9061798459_dp, -0.5384693101_dp, 0.0_dp, 0.5384693101_dp, 0.9061798459_dp] !! Nodes for n = 5 99 | w = [0.2369268851_dp, 0.4786286705_dp, 0.5688888889_dp, 0.4786286705_dp, 0.2369268851_dp] !! Weights for n = 5 100 | ! You can add more cases to support higher values of n. 101 | case default 102 | print *, 'Gauss-Legendre quadrature for n > 5 is not implemented.' 103 | end select 104 | 105 | end subroutine gauss_legendre_weights 106 | 107 | end module gaussian_legendre_quadrature 108 | -------------------------------------------------------------------------------- /modules/maths/numerical_integration/midpoint.f90: -------------------------------------------------------------------------------- 1 | !> Midpoint rule Module 2 | !! 3 | !! This module implements Midpoint rule for numerical integration. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #25 7 | !! https://github.com/TheAlgorithms/Fortran/pull/25 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! The midpoint rule approximates the integral by calculating the function 13 | !! value at the midpoint of each subinterval and summing these values, multiplied 14 | !! by the width of the subintervals. 15 | !! 16 | !! Note: This implementation is valid for one-dimensional functions 17 | !! 18 | !! Input: 19 | !! - `a`: Lower bound of integration (real(dp)) 20 | !! - `b`: Upper bound of integration (real(dp)) 21 | !! - `n`: Number of panels (integer) 22 | !! - `func`: The function to integrate (interface) 23 | !! 24 | !! Output: 25 | !! - `integral_result`: Approximate value of the integral (real(dp)) 26 | 27 | module midpoint_rule 28 | implicit none 29 | integer, parameter :: dp = kind(0.d0) !! Double precision parameter 30 | 31 | contains 32 | 33 | subroutine midpoint(integral_result, a, b, n, func) 34 | implicit none 35 | integer, intent(in) :: n 36 | real(dp), intent(in) :: a, b 37 | real(dp), intent(out) :: integral_result 38 | 39 | real(dp), dimension(:), allocatable :: x, fx 40 | real(dp) :: h 41 | integer :: i 42 | 43 | ! Interface for the function 44 | interface 45 | real(kind(0.d0)) function func(x) 46 | real(kind(0.d0)), intent(in) :: x 47 | end function func 48 | end interface 49 | 50 | ! Step size 51 | h = (b - a)/real(n, dp) 52 | 53 | ! Allocate array for midpoints 54 | allocate (x(1:n), fx(1:n)) 55 | 56 | ! Calculate midpoints 57 | x = [(a + (real(i, dp) - 0.5_dp)*h, i=1, n)] 58 | 59 | ! Apply function to each midpoint 60 | do i = 1, n 61 | fx(i) = func(x(i)) 62 | end do 63 | 64 | ! Final integral value 65 | integral_result = h*sum(fx) 66 | 67 | ! Deallocate arrays 68 | deallocate (x, fx) 69 | 70 | end subroutine midpoint 71 | 72 | end module midpoint_rule 73 | -------------------------------------------------------------------------------- /modules/maths/numerical_integration/monte_carlo.f90: -------------------------------------------------------------------------------- 1 | !> Monte Carlo Integration Module 2 | !! 3 | !! This module estimates the integral of a function over a specified range 4 | !! using the Monte Carlo method (with OpenMP parallelization) and provides an error estimate. 5 | !! 6 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 7 | !! in Pull Request: #25 8 | !! https://github.com/TheAlgorithms/Fortran/pull/25 9 | !! 10 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 11 | !! addressing bugs/corrections to this file. Thank you! 12 | !! 13 | !! The method works by randomly sampling points within the integration range [a, b] 14 | !! and evaluating the function at those points to estimate the integral. 15 | !! 16 | !! Note: This implementation is valid for one-dimensional functions 17 | !! 18 | !! Input: 19 | !! - `a`: Lower bound of integration (real(dp)) 20 | !! - `b`: Upper bound of integration (real(dp)) 21 | !! - `n`: Number of random samples (integer) 22 | !! - `func`: The function to integrate (interface) 23 | !! 24 | !! Output: 25 | !! - `integral_result`: Approximate value of the integral (real(dp)) 26 | !! - `error_estimate`: Estimated error of the integral approximation (real(dp)) 27 | 28 | module monte_carlo_integration 29 | use omp_lib !! OpenMP library for parallelization 30 | implicit none 31 | integer, parameter :: dp = kind(0.d0) !! Double precision parameter 32 | 33 | contains 34 | 35 | subroutine monte_carlo(integral_result, error_estimate, a, b, n, func) 36 | implicit none 37 | integer, intent(in) :: n 38 | real(dp) :: n_dp !! Hold n as double precision 39 | real(dp), intent(in) :: a, b 40 | real(dp), intent(out) :: integral_result, error_estimate 41 | 42 | real(dp), dimension(:), allocatable :: uniform_sample, fx 43 | real(dp) :: sum_fx, sum_fx_squared 44 | integer :: i 45 | 46 | ! Interface for the function 47 | interface 48 | real(kind(0.d0)) function func(x) 49 | real(kind(0.d0)), intent(in) :: x 50 | end function func 51 | end interface 52 | 53 | ! Allocate arrays for random samples and function values 54 | allocate (uniform_sample(1:n), fx(1:n)) 55 | 56 | ! Generate uniform random points in [a, b] 57 | call random_number(uniform_sample) 58 | uniform_sample = a + (b - a)*uniform_sample !! Scale to the interval [a, b] 59 | 60 | ! Evaluate the function at all random points in parallel 61 | !$omp parallel do !! OpenMP parallelization to distribute the loop across multiple threads 62 | do i = 1, n 63 | fx(i) = func(uniform_sample(i)) 64 | end do 65 | !$omp end parallel do 66 | 67 | ! Sum of function values and sum of function values squared (for error estimation) 68 | sum_fx = sum(fx) 69 | sum_fx_squared = sum(fx**2) 70 | 71 | ! Compute the Monte Carlo estimate of the integral 72 | integral_result = (b - a)*(sum_fx/real(n, dp)) 73 | 74 | ! Estimate the error using the variance of the function values 75 | n_dp = real(n, dp) 76 | error_estimate = sqrt((sum_fx_squared/n_dp - (sum_fx/n_dp)**2)/(n_dp - 1))*(b - a) 77 | 78 | ! Deallocate arrays 79 | deallocate (uniform_sample, fx) 80 | 81 | end subroutine monte_carlo 82 | 83 | end module monte_carlo_integration 84 | -------------------------------------------------------------------------------- /modules/maths/numerical_integration/simpson.f90: -------------------------------------------------------------------------------- 1 | !> Simpson's Rule Module 2 | !! 3 | !! This module implements Simpson's rule for numerical integration. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #25 7 | !! https://github.com/TheAlgorithms/Fortran/pull/25 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! Simpson's rule approximates the definite integral of a function by 13 | !! dividing the area under the curve into parabolic segments and summing 14 | !! their areas, providing a higher degree of accuracy than the Trapezoidal rule. 15 | !! 16 | !! Note: This implementation is valid for one-dimensional functions 17 | !! 18 | !! Input: 19 | !! - `a`: Lower bound of the integration (real(dp)) 20 | !! - `b`: Upper bound of the integration (real(dp)) 21 | !! - `n`: Number of panels (integer, must be even) 22 | !! - `func`: The function to integrate (interface) 23 | !! 24 | !! Output: 25 | !! - `integral_result`: Approximate value of the definite integral (real(dp)) 26 | !! 27 | 28 | module simpson_rule 29 | implicit none 30 | integer, parameter :: dp = kind(0.d0) !! Double precision parameter 31 | 32 | contains 33 | 34 | ! Simpson's rule with function passed via interface 35 | subroutine simpson(integral_result, a, b, n, func) 36 | implicit none 37 | integer, intent(in) :: n 38 | real(dp), intent(in) :: a, b 39 | real(dp), intent(out) :: integral_result 40 | 41 | real(dp), dimension(:), allocatable :: x, fx 42 | real(dp) :: h 43 | integer :: i 44 | 45 | ! Interface for the function 46 | interface 47 | real(kind(0.d0)) function func(x) 48 | real(kind(0.d0)), intent(in) :: x 49 | end function func 50 | end interface 51 | 52 | ! Check if n is even 53 | if (mod(n, 2) /= 0) then 54 | write (*, *) 'Error: The number of panels (n) must be even.' 55 | stop 56 | end if 57 | 58 | ! Step size 59 | h = (b - a)/real(n, dp) 60 | 61 | ! Allocate arrays 62 | allocate (x(0:n), fx(0:n)) 63 | 64 | ! Create an array of x values, contains the endpoints and the midpoints. 65 | x = [(a + (real(i, dp))*h, i=0, n)] 66 | 67 | ! Apply the function to each x value 68 | do i = 0, n 69 | fx(i) = func(x(i)) 70 | end do 71 | 72 | ! Apply Simpson's rule using array slicing 73 | integral_result = (fx(0) + fx(n) + 4.0_dp*sum(fx(1:n - 1:2)) + 2.0_dp*sum(fx(2:n - 2:2)))*(h/3.0_dp) 74 | 75 | ! Deallocate arrays 76 | deallocate (x, fx) 77 | end subroutine simpson 78 | 79 | end module simpson_rule 80 | -------------------------------------------------------------------------------- /modules/maths/numerical_integration/trapezoid.f90: -------------------------------------------------------------------------------- 1 | !> Trapezoidal Rule Module 2 | !! 3 | !! This module implements the Trapezoidal rule for numerical integration. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #25 7 | !! https://github.com/TheAlgorithms/Fortran/pull/25 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! The Trapezoidal rule approximates the definite integral of a function by 13 | !! dividing the area under the curve into trapezoids and summing their areas. 14 | !! 15 | !! Note: This implementation is valid for one-dimensional functions 16 | !! 17 | !! Input: 18 | !! - `a`: Lower bound of the integration (real(dp)) 19 | !! - `b`: Upper bound of the integration (real(dp)) 20 | !! - `n`: Number of panels (integer) 21 | !! - `func`: The function to integrate (interface) 22 | !! 23 | !! Output: 24 | !! - `integral_result`: Approximate value of the definite integral (real(dp)) 25 | !! 26 | 27 | module trapezoidal_rule 28 | implicit none 29 | integer, parameter :: dp = kind(0.d0) !! Double precision parameter 30 | 31 | contains 32 | 33 | ! Trapezoidal rule with function passed via interface 34 | subroutine trapezoid(integral_result, a, b, n, func) 35 | implicit none 36 | integer, intent(in) :: n 37 | real(dp), intent(in) :: a, b 38 | real(dp), intent(out) :: integral_result 39 | 40 | real(dp), dimension(:), allocatable :: x, fx 41 | real(dp) :: h 42 | integer :: i 43 | 44 | ! Interface for the function 45 | interface 46 | real(kind(0.d0)) function func(x) 47 | real(kind(0.d0)), intent(in) :: x 48 | end function func 49 | end interface 50 | 51 | ! Step size 52 | h = (b - a)/real(n, dp) 53 | 54 | ! Allocate arrays 55 | allocate (x(0:n), fx(0:n)) 56 | 57 | ! Create an array of x values 58 | x = [(a + (real(i, dp))*h, i=0, n)] 59 | 60 | ! Apply the function to each x value 61 | do i = 0, n 62 | fx(i) = func(x(i)) 63 | end do 64 | 65 | ! Apply trapezoidal rule using array slicing 66 | integral_result = ((fx(0) + fx(n))*0.5_dp + sum(fx(1:n)))*h 67 | 68 | ! Deallocate arrays 69 | deallocate (x, fx) 70 | end subroutine trapezoid 71 | 72 | end module trapezoidal_rule 73 | -------------------------------------------------------------------------------- /modules/searches/linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Linear Search 2 | !> Module implementing the linear search algorithm in Fortran. 3 | 4 | module linear_search_module 5 | implicit none 6 | 7 | contains 8 | 9 | !! This function searches for a target in a given collection. 10 | !! Returns the index of the found target or -1 if target is not found. 11 | function linear_search(collection, target) result(target_index) 12 | integer, dimension(:), intent(in) :: collection !! A collection for elements of type integer 13 | integer, intent(in) :: target !! Target value to be searched. 14 | integer :: target_index !! Target's index in the collection to return. 15 | 16 | integer :: i, collection_size 17 | 18 | collection_size = size(collection) 19 | 20 | do i = 1, collection_size 21 | if (collection(i) .eq. target) then 22 | target_index = i !! Set the target index if target found. 23 | return !! Exit the function. 24 | end if 25 | end do 26 | 27 | target_index = -1 !! Set the index to -1 if target not found. 28 | 29 | end function linear_search 30 | 31 | end module linear_search_module 32 | -------------------------------------------------------------------------------- /modules/searches/recursive_linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Recursive Linear Search Module 2 | !! 3 | !! This module contains a recursive implementation of the linear search algorithm. 4 | !! It includes the `recursive_linear_search` function to search for a target value within a given collection. 5 | 6 | module recursive_linear_search_module 7 | implicit none 8 | contains 9 | 10 | !! This recursive function searches for a target in a collection. 11 | !! Returns the index of the found target or -1 if target is not found. 12 | recursive function recursive_linear_search(collection, index, target) result(target_index) 13 | integer, dimension(:), intent(in) :: collection !! A collection of integer elements 14 | integer, intent(in) :: index !! The current index in the collection 15 | integer, intent(in) :: target !! The target value to be searched 16 | integer :: target_index !! The index where the target is found 17 | 18 | !! Base case: if index is 0 and target is not found, return -1 19 | if (index .eq. 0) then 20 | target_index = -1 21 | return 22 | end if 23 | 24 | !! Check if the target is at the current index 25 | if (collection(index) .eq. target) then 26 | target_index = index 27 | else 28 | !! Recursively search in the remaining part of the collection 29 | target_index = recursive_linear_search(collection, index - 1, target) 30 | end if 31 | 32 | end function recursive_linear_search 33 | 34 | end module recursive_linear_search_module 35 | -------------------------------------------------------------------------------- /modules/searches/ternary_search_module.f90: -------------------------------------------------------------------------------- 1 | !> Ternary Search Algorithm Module 2 | !! 3 | !! This module implements two types of ternary search algorithm: array-based and function-based. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #24 7 | !! https://github.com/TheAlgorithms/Fortran/pull/24 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! The array-based ternary search is used to find a target element within a sorted array, while the function-based 13 | !! approach is used to find the minimum or maximum of a unimodal function. 14 | !! 15 | !! Array-based ternary search: 16 | !! - Given a sorted array and a target, it splits the array into three parts and recursively searches for the target. 17 | !! 18 | !! Function-based ternary search: 19 | !! - Used for unimodal functions, which have a single peak (maximum) or valley (minimum). 20 | !! This method divides the function’s search space into thirds to converge on the minimum or maximum. 21 | !! 22 | 23 | module ternary_search 24 | implicit none 25 | contains 26 | 27 | !> Array-based ternary search algorithm 28 | !! This recursive function searches for the target value in a sorted array. 29 | !! 30 | !! Input: 31 | !! - arr: The sorted array to search within. 32 | !! - target: The value to search for. 33 | !! - left, right: The range of indices within which to search. 34 | !! 35 | !! Output: 36 | !! - The index of the target element if found, otherwise -1. 37 | recursive integer function ternary_search_array(arr, target, left, right) result(result_index) 38 | implicit none 39 | integer, intent(in) :: arr(:) ! Array to search within 40 | integer, intent(in) :: target ! Target value to search for 41 | integer, intent(in) :: left, right ! Left and right indices 42 | integer :: mid1, mid2 ! Midpoints 43 | integer :: new_left, new_right ! Temporary indices 44 | 45 | ! Base case: if the range is invalid, return -1 (not found) 46 | if (right < left) then 47 | result_index = -1 48 | return 49 | end if 50 | 51 | ! Divide array into three parts 52 | mid1 = left + (right - left)/3 53 | mid2 = right - (right - left)/3 54 | 55 | ! Check if the target is at mid1 or mid2 56 | if (arr(mid1) == target) then 57 | result_index = mid1 58 | return 59 | else if (arr(mid2) == target) then 60 | result_index = mid2 61 | return 62 | end if 63 | 64 | ! Recursive search in the appropriate third of the array 65 | if (target < arr(mid1)) then 66 | new_right = mid1 - 1 67 | result_index = ternary_search_array(arr, target, left, new_right) 68 | else if (target > arr(mid2)) then 69 | new_left = mid2 + 1 70 | result_index = ternary_search_array(arr, target, new_left, right) 71 | else 72 | new_left = mid1 + 1 73 | new_right = mid2 - 1 74 | result_index = ternary_search_array(arr, target, new_left, new_right) 75 | end if 76 | end function ternary_search_array 77 | 78 | !> Function-based ternary search to find the minimum of a unimodal function 79 | !! This function finds the minimum point of a unimodal function using the ternary search algorithm. 80 | !! 81 | !! Input: 82 | !! - f: The unimodal function to search. 83 | !! - left, right: The range within which to search for the minimum. 84 | !! - tol: The tolerance to determine convergence. 85 | !! 86 | !! Output: 87 | !! - The point at which the function achieves its minimum value. 88 | recursive real(8) function ternary_search_minimum(f, left, right, tol) result(minimum) 89 | implicit none 90 | interface 91 | real(8) function f(x) 92 | real(8), intent(in) :: x 93 | end function f 94 | end interface 95 | real(8), intent(in) :: left, right, tol 96 | real(8) :: mid1, mid2 97 | real(8) :: l, r 98 | 99 | l = left 100 | r = right 101 | 102 | ! Termination condition based on tolerance 103 | do while (r - l > tol) 104 | mid1 = l + (r - l)/3.0d0 105 | mid2 = r - (r - l)/3.0d0 106 | 107 | ! Compare function values at midpoints 108 | if (f(mid1) < f(mid2)) then 109 | r = mid2 110 | else 111 | l = mid1 112 | end if 113 | end do 114 | 115 | ! The minimum point is approximately at the midpoint 116 | minimum = (l + r)/2.0d0 117 | end function ternary_search_minimum 118 | 119 | !> Function-based ternary search to find the maximum of a unimodal function 120 | !! This function finds the maximum point of a unimodal function using the ternary search algorithm. 121 | !! 122 | !! Input: 123 | !! - f: The unimodal function to search. 124 | !! - left, right: The range within which to search for the maximum. 125 | !! - tol: The tolerance to determine convergence. 126 | !! 127 | !! Output: 128 | !! - The point at which the function achieves its maximum value. 129 | recursive real(8) function ternary_search_maximum(f, left, right, tol) result(maximum) 130 | implicit none 131 | interface 132 | real(8) function f(x) 133 | real(8), intent(in) :: x 134 | end function f 135 | end interface 136 | real(8), intent(in) :: left, right, tol 137 | real(8) :: mid1, mid2 138 | real(8) :: l, r 139 | 140 | l = left 141 | r = right 142 | 143 | ! Termination condition based on tolerance 144 | do while (r - l > tol) 145 | mid1 = l + (r - l)/3.0d0 146 | mid2 = r - (r - l)/3.0d0 147 | 148 | ! Compare function values at midpoints 149 | if (f(mid1) > f(mid2)) then 150 | r = mid2 151 | else 152 | l = mid1 153 | end if 154 | end do 155 | 156 | ! The maximum point is approximately at the midpoint 157 | maximum = (l + r)/2.0d0 158 | end function ternary_search_maximum 159 | 160 | end module ternary_search 161 | -------------------------------------------------------------------------------- /modules/sorts/bubble_sort.f90: -------------------------------------------------------------------------------- 1 | !> Bubble Sort Module 2 | !! 3 | !! This module contains a subroutine for sorting a collection using the bubble sort algorithm. 4 | 5 | module bubble_sort_module 6 | implicit none 7 | 8 | contains 9 | 10 | !! This subroutine sorts the collection using bubble sort. 11 | subroutine bubble_sort(collection) 12 | real, dimension(:), intent(inout) :: collection !! A collection of real numbers to be sorted 13 | 14 | integer :: i, j, collection_size 15 | real :: temp 16 | logical :: swapped 17 | 18 | !! Determine the size of the collection 19 | collection_size = size(collection) 20 | 21 | !! Perform bubble sort 22 | do j = collection_size - 1, 1, -1 23 | 24 | swapped = .false. 25 | 26 | do i = 1, j 27 | if (collection(i) .gt. collection(i + 1)) then 28 | !! Swap values if they are out of order in [i, i+1] region 29 | temp = collection(i) 30 | collection(i) = collection(i + 1) 31 | collection(i + 1) = temp 32 | 33 | swapped = .true. !! Set swapped flag to true 34 | end if 35 | end do 36 | 37 | !! Stop iterating if collection is sorted. 38 | if (.not. swapped) exit 39 | end do 40 | 41 | end subroutine bubble_sort 42 | 43 | end module bubble_sort_module 44 | -------------------------------------------------------------------------------- /modules/sorts/gnome_sort.f90: -------------------------------------------------------------------------------- 1 | !> Gnome Sort Algorithm 2 | !! 3 | !! This module implements the Gnome Sort algorithm. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #09 7 | !! https://github.com/TheAlgorithms/Fortran/pull/9 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! Gnome Sort is a simple comparison-based sorting algorithm. 13 | !! It iterates through the array, comparing and swapping elements if needed. 14 | !! 15 | !! Time Complexity: O(n^2) where n is the number of elements in the input array. 16 | !! 17 | !! Input: 18 | !! - An array of integers. 19 | !! 20 | !! Output: 21 | !! - A sorted array of integers. 22 | !! 23 | module gnome_sort_module 24 | implicit none 25 | 26 | contains 27 | 28 | !> Subroutine to sort an array using Gnome Sort 29 | subroutine gnome_sort(array) 30 | implicit none 31 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 32 | integer :: i, n 33 | 34 | n = size(array) 35 | i = 1 36 | 37 | ! Gnome Sort algorithm 38 | do while (i <= n) 39 | if (i == 1 .or. array(i) >= array(i - 1)) then 40 | i = i + 1 41 | else 42 | ! Swap elements 43 | call swap(array(i), array(i - 1)) 44 | i = i - 1 45 | end if 46 | end do 47 | 48 | end subroutine gnome_sort 49 | 50 | !> Helper subroutine to swap two elements in an array 51 | subroutine swap(x, y) 52 | implicit none 53 | integer, intent(inout) :: x, y 54 | integer :: temp 55 | 56 | temp = x 57 | x = y 58 | y = temp 59 | 60 | end subroutine swap 61 | 62 | end module gnome_sort_module 63 | -------------------------------------------------------------------------------- /modules/sorts/heap_sort.f90: -------------------------------------------------------------------------------- 1 | !> Heap Sort Algorithm 2 | !! 3 | !! This module implements the Heap Sort algorithm. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #8 7 | !! https://github.com/TheAlgorithms/Fortran/pull/8 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! Heap Sort is a comparison-based sorting algorithm that uses a binary heap data structure. 13 | !! It first builds a max heap from the input data and then repeatedly extracts the maximum 14 | !! element from the heap and reconstructs the heap until the array is sorted. 15 | !! 16 | !! Time Complexity: O(n log n) where n is the number of elements in the input array. 17 | !! 18 | !! Input: 19 | !! - An array of integers. 20 | !! 21 | !! Output: 22 | !! - A sorted array of integers. 23 | !! 24 | module heap_sort_module 25 | implicit none 26 | 27 | contains 28 | 29 | !> Subroutine to perform heap sort on an array 30 | subroutine heap_sort(array, n) 31 | implicit none 32 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 33 | integer, intent(in) :: n ! Size of the array 34 | integer :: i 35 | 36 | ! Build the max heap 37 | do i = n/2, 1, -1 38 | call heapify(array, n, i) 39 | end do 40 | 41 | ! Extract elements one by one from the heap 42 | do i = n, 2, -1 43 | ! Move the current root to the end 44 | call swap(array, 1, i) 45 | 46 | ! Call max heapify on the reduced heap 47 | call heapify(array, i - 1, 1) 48 | end do 49 | 50 | end subroutine heap_sort 51 | 52 | !> Subroutine to maintain the heap property 53 | recursive subroutine heapify(array, n, i) 54 | implicit none 55 | integer, dimension(:), intent(inout) :: array ! Input/output array to be heapified 56 | integer, intent(in) :: n ! Size of the heap 57 | integer, intent(in) :: i ! Index of the root 58 | integer :: largest, left, right 59 | 60 | largest = i 61 | left = 2*i 62 | right = 2*i + 1 63 | 64 | ! Is Left Child is larger than Root? 65 | if (left <= n .and. array(left) > array(largest)) then 66 | largest = left 67 | end if 68 | 69 | ! Is Right Child larger than Largest so far? 70 | if (right <= n .and. array(right) > array(largest)) then 71 | largest = right 72 | end if 73 | 74 | ! Swap and heapify if Root is not the Largest 75 | if (largest /= i) then 76 | call swap(array, i, largest) 77 | call heapify(array, n, largest) 78 | end if 79 | 80 | end subroutine heapify 81 | 82 | !> Subroutine helper to swap two elements in an array 83 | subroutine swap(array, i, j) 84 | implicit none 85 | integer, dimension(:), intent(inout) :: array ! Input/output array in which elements are swapped 86 | integer, intent(in) :: i, j ! Indices of the elements to be swapped 87 | integer :: temp 88 | 89 | temp = array(i) 90 | array(i) = array(j) 91 | array(j) = temp 92 | 93 | end subroutine swap 94 | 95 | end module heap_sort_module 96 | -------------------------------------------------------------------------------- /modules/sorts/merge_sort.f90: -------------------------------------------------------------------------------- 1 | !> Merge Sort Algorithm 2 | !! 3 | !! This module implements the Merge Sort algorithm. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #7 7 | !! https://github.com/TheAlgorithms/Fortran/pull/7 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! Merge Sort is a divide-and-conquer algorithm. It divides the input array into two halves, recursively sorts them, 13 | !! and then merges the two sorted halves. 14 | !! 15 | !! Time Complexity: O(n log n) where n is the number of elements in the input array. 16 | !! 17 | !! Input: 18 | !! - An array of integers. 19 | !! 20 | !! Output: 21 | !! - A sorted array of integers. 22 | !! 23 | module merge_sort_module 24 | implicit none 25 | 26 | contains 27 | 28 | !> Recursive subroutine to sort an array using merge sort 29 | recursive subroutine merge_sort(array, n) 30 | implicit none 31 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 32 | integer, intent(in) :: n ! Size of the array 33 | integer :: middle 34 | integer, dimension(:), allocatable :: left_half, right_half, sorted_array 35 | 36 | ! Base case: return if the array has 1 or fewer elements 37 | if (n <= 1) return 38 | 39 | ! Calculate the middle point to split the array 40 | middle = n/2 41 | 42 | ! Allocate space for the two halves 43 | allocate (left_half(middle), right_half(n - middle), sorted_array(n)) 44 | 45 | ! Split array into two halves 46 | left_half = array(1:middle) 47 | right_half = array(middle + 1:n) 48 | 49 | ! Recursively sort each half 50 | call merge_sort(left_half, middle) 51 | call merge_sort(right_half, n - middle) 52 | 53 | ! Merge the sorted halves 54 | call merge(left_half, middle, right_half, n - middle, sorted_array) 55 | 56 | ! Copy the sorted array back 57 | array = sorted_array 58 | 59 | ! Deallocate the temporary arrays 60 | deallocate (left_half, right_half, sorted_array) 61 | 62 | end subroutine merge_sort 63 | 64 | !> Subroutine to merge two sorted halves of an array 65 | subroutine merge(left_half, n_left, right_half, n_right, sorted_array) 66 | implicit none 67 | integer, dimension(:), intent(in) :: left_half, right_half ! Input sorted halves 68 | integer, dimension(:), intent(out) :: sorted_array ! Output sorted array 69 | integer, intent(in) :: n_left, n_right ! Sizes of the input halves 70 | integer :: i, j, k ! Loop counters 71 | 72 | i = 1 73 | j = 1 74 | k = 1 75 | 76 | ! Merge the two halves 77 | do while (i <= n_left .and. j <= n_right) 78 | if (left_half(i) < right_half(j)) then 79 | sorted_array(k) = left_half(i) 80 | i = i + 1 81 | else 82 | sorted_array(k) = right_half(j) 83 | j = j + 1 84 | end if 85 | k = k + 1 86 | end do 87 | 88 | ! Copy remaining elements of left_half, if any 89 | do while (i <= n_left) 90 | sorted_array(k) = left_half(i) 91 | i = i + 1 92 | k = k + 1 93 | end do 94 | 95 | ! Copy remaining elements of right_half, if any 96 | do while (j <= n_right) 97 | sorted_array(k) = right_half(j) 98 | j = j + 1 99 | k = k + 1 100 | end do 101 | 102 | end subroutine merge 103 | 104 | end module merge_sort_module 105 | -------------------------------------------------------------------------------- /modules/sorts/quick_sort.f90: -------------------------------------------------------------------------------- 1 | !> Quick Sort Algorithm 2 | !! 3 | !! This module implements the Quick Sort algorithm, a highly efficient 4 | !! sorting technique that uses the divide-and-conquer strategy. 5 | !! 6 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 7 | !! in Pull Request: #10 8 | !! https://github.com/TheAlgorithms/Fortran/pull/10 9 | !! 10 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 11 | !! addressing bugs/corrections to this file. Thank you! 12 | !! 13 | !! Quick Sort works by selecting a pivot element and partitioning the 14 | !! array into elements less than the pivot and elements greater than the pivot. 15 | !! 16 | !! Time Complexity: O(n log n) on average, though it can degrade to O(n^2) 17 | !! in the worst case (depending on the pivot choice). 18 | !! 19 | !! Input: 20 | !! - An array of integers. 21 | !! 22 | !! Output: 23 | !! - A sorted array of integers. 24 | !! 25 | module quick_sort_module 26 | implicit none 27 | 28 | contains 29 | 30 | !> Subroutine to sort an array using Quick Sort 31 | recursive subroutine quick_sort(array, low, high) 32 | implicit none 33 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 34 | integer, intent(in) :: low, high ! Indices of the array 35 | 36 | integer :: pivot_index 37 | 38 | if (low < high) then 39 | ! Partition the array and get the pivot index 40 | pivot_index = partition(array, low, high) 41 | 42 | ! Recursively sort elements before and after partition 43 | call quick_sort(array, low, pivot_index - 1) 44 | call quick_sort(array, pivot_index + 1, high) 45 | end if 46 | 47 | end subroutine quick_sort 48 | 49 | !> Subroutine to partition the array based on the pivot element 50 | function partition(array, low, high) result(pivot_index) 51 | implicit none 52 | integer, dimension(:), intent(inout) :: array ! Input/output array to be partitioned 53 | integer, intent(in) :: low, high ! Indices of the array 54 | integer :: pivot, pivot_index, i, j 55 | 56 | pivot = array(high) 57 | i = low - 1 58 | 59 | do j = low, high - 1 60 | if (array(j) <= pivot) then 61 | i = i + 1 62 | call swap(array, i, j) 63 | end if 64 | end do 65 | 66 | call swap(array, i + 1, high) 67 | pivot_index = i + 1 68 | 69 | end function partition 70 | 71 | !> Helper subroutine to swap two elements in the array 72 | subroutine swap(array, i, j) 73 | implicit none 74 | integer, dimension(:), intent(inout) :: array 75 | integer, intent(in) :: i, j 76 | integer :: temp 77 | 78 | temp = array(i) 79 | array(i) = array(j) 80 | array(j) = temp 81 | end subroutine swap 82 | 83 | end module quick_sort_module 84 | -------------------------------------------------------------------------------- /modules/sorts/radix_sort.f90: -------------------------------------------------------------------------------- 1 | !> Radix Sort Algorithm 2 | !! 3 | !! This module implements the Radix Sort algorithm with configurable base. 4 | !! 5 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 6 | !! in Pull Request: #11 7 | !! https://github.com/TheAlgorithms/Fortran/pull/11 8 | !! 9 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 10 | !! addressing bugs/corrections to this file. Thank you! 11 | !! 12 | !! Radix Sort is a non-comparison-based sorting algorithm that sorts numbers by processing individual digits. 13 | !! It is particularly efficient for sorting large lists of integers with a fixed number of digits. 14 | !! 15 | !! Time Complexity: O(d * (n + k)) where n is the number of elements, d is the number of digits, and k is the range of digits. 16 | !! 17 | !! Input: 18 | !! - An array of non-negative integers. 19 | !! - Base (radix) of the numbers to be sorted. 20 | !! 21 | !! Output: 22 | !! - A sorted array of integers. 23 | !! 24 | module radix_sort_module 25 | implicit none 26 | 27 | contains 28 | 29 | !> Subroutine to perform Radix Sort on an array 30 | subroutine radix_sort(array, n, base) 31 | implicit none 32 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 33 | integer, intent(in) :: n ! Size of the array 34 | integer, intent(in) :: base ! Base (radix) for sorting 35 | integer :: max_digit, exp 36 | 37 | ! Check if base is valid 38 | if (base < 2) then 39 | print *, "Error: Base must be greater than or equal to 2." 40 | return 41 | end if 42 | 43 | ! Find the maximum number to determine the number of digits 44 | max_digit = maxval(array) 45 | exp = 1 46 | 47 | ! Perform Counting Sort for each digit 48 | do while (max_digit/exp >= 1) 49 | call counting_sort(array, n, exp, base) 50 | exp = exp*base 51 | end do 52 | 53 | end subroutine radix_sort 54 | 55 | !> Subroutine to perform Counting Sort based on the digit represented by exp 56 | subroutine counting_sort(array, n, exp, base) 57 | implicit none 58 | integer, dimension(:), intent(inout) :: array ! Input/output array to be sorted 59 | integer, intent(in) :: n ! Size of the array 60 | integer, intent(in) :: exp ! Exponent for digit place 61 | integer, intent(in) :: base ! Base (radix) for sorting 62 | integer :: i, count_size, digit 63 | integer, dimension(:), allocatable :: count, output 64 | 65 | count_size = base 66 | allocate (count(count_size), output(n)) 67 | 68 | ! Initialize count array 69 | count = 0 70 | 71 | ! Store count of occurrences 72 | do i = 1, n 73 | digit = mod(array(i)/exp, base) 74 | count(digit + 1) = count(digit + 1) + 1 75 | end do 76 | 77 | ! Change count[i] so that count[i] contains the actual position of this digit in output[] 78 | do i = 2, count_size 79 | count(i) = count(i) + count(i - 1) 80 | end do 81 | 82 | ! Build the output array 83 | do i = n, 1, -1 84 | digit = mod(array(i)/exp, base) 85 | output(count(digit + 1)) = array(i) 86 | count(digit + 1) = count(digit + 1) - 1 87 | end do 88 | 89 | ! Copy the sorted elements into the original array 90 | array = output 91 | 92 | ! Deallocate temporary arrays 93 | deallocate (count, output) 94 | 95 | end subroutine counting_sort 96 | 97 | end module radix_sort_module 98 | -------------------------------------------------------------------------------- /modules/sorts/recursive_bubble_sort.f90: -------------------------------------------------------------------------------- 1 | !> Recursive Bubble Sort Module 2 | !! 3 | !! This module contains a subroutine for sorting a collection using the recursive bubble sort algorithm. 4 | 5 | module recursive_bubble_sort_module 6 | implicit none 7 | contains 8 | 9 | !! This subroutine sorts the collection recursively using bubble sort. 10 | !! Recursive keyword at the start declares that the function is recursive. 11 | recursive subroutine recursive_bubble_sort(collection, collection_size) 12 | real, dimension(:), intent(inout) :: collection !! A collection for elements of type real. 13 | integer, intent(in) :: collection_size !! Collection's size. 14 | 15 | integer :: i 16 | real :: temp 17 | 18 | !! Perform bubble sort on the collection. 19 | do i = 1, collection_size - 1 20 | if (collection(i) .gt. collection(i + 1)) then 21 | !! Swap values if they are out of order in [i, i + 1] region. 22 | temp = collection(i) 23 | collection(i) = collection(i + 1) 24 | collection(i + 1) = temp 25 | end if 26 | end do 27 | 28 | !! Recursively call the subroutine with (collection_size - 1) if size > 2. 29 | if (collection_size .gt. 2) then 30 | call recursive_bubble_sort(collection, collection_size - 1) 31 | end if 32 | 33 | end subroutine recursive_bubble_sort 34 | 35 | end module recursive_bubble_sort_module 36 | -------------------------------------------------------------------------------- /tests/maths/eculid_gcd.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the GCD module 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #31 5 | !! https://github.com/TheAlgorithms/Fortran/pull/31 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the GCD function in the gcd_module. 11 | 12 | program tests_gcd_module 13 | use gcd_module 14 | implicit none 15 | integer :: result, expected 16 | 17 | ! Run test cases 18 | call test_gcd_positive_numbers() 19 | call test_gcd_with_zero() 20 | call test_gcd_negative_numbers() 21 | call test_gcd_same_numbers() 22 | call test_gcd_large_numbers() 23 | 24 | print *, "All tests completed." 25 | 26 | contains 27 | 28 | ! Test case 1: GCD of two positive numbers 29 | subroutine test_gcd_positive_numbers() 30 | integer :: a, b 31 | a = 48 32 | b = 18 33 | expected = 6 34 | result = gcd(a, b) 35 | call assert_test(result, expected, "Test 1: GCD of two positive numbers") 36 | end subroutine test_gcd_positive_numbers 37 | 38 | ! Test case 2: GCD with one number as zero 39 | subroutine test_gcd_with_zero() 40 | integer :: a, b 41 | a = 0 42 | b = 5 43 | expected = 5 44 | result = gcd(a, b) 45 | call assert_test(result, expected, "Test 2: GCD with one number as zero") 46 | end subroutine test_gcd_with_zero 47 | 48 | ! Test case 3: GCD of two negative numbers 49 | subroutine test_gcd_negative_numbers() 50 | integer :: a, b 51 | a = -48 52 | b = -18 53 | expected = 6 54 | result = gcd(a, b) 55 | call assert_test(result, expected, "Test 3: GCD of two negative numbers") 56 | end subroutine test_gcd_negative_numbers 57 | 58 | ! Test case 4: GCD of the same number 59 | subroutine test_gcd_same_numbers() 60 | integer :: a, b 61 | a = 42 62 | b = 42 63 | expected = 42 64 | result = gcd(a, b) 65 | call assert_test(result, expected, "Test 4: GCD of the same number") 66 | end subroutine test_gcd_same_numbers 67 | 68 | ! Test case 5: GCD of large numbers 69 | subroutine test_gcd_large_numbers() 70 | integer :: a, b 71 | a = 123456 72 | b = 789012 73 | expected = 12 74 | result = gcd(a, b) 75 | call assert_test(result, expected, "Test 5: GCD of large numbers") 76 | end subroutine test_gcd_large_numbers 77 | 78 | !> Subroutine to assert the test results 79 | subroutine assert_test(actual, expected, test_name) 80 | integer, intent(in) :: actual, expected 81 | character(len=*), intent(in) :: test_name 82 | 83 | if (actual == expected) then 84 | print *, test_name, " PASSED" 85 | else 86 | print *, test_name, " FAILED" 87 | print *, "Expected: ", expected 88 | print *, "Got: ", actual 89 | stop 1 90 | end if 91 | 92 | end subroutine assert_test 93 | 94 | end program tests_gcd_module 95 | -------------------------------------------------------------------------------- /tests/maths/factorial.f90: -------------------------------------------------------------------------------- 1 | !> Test program for factorial functions 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #31 5 | !! https://github.com/TheAlgorithms/Fortran/pull/31 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the two facotrial functions in the factorial_module. 11 | 12 | program tests_factorial 13 | use factorial_module 14 | implicit none 15 | 16 | integer :: result, expected 17 | 18 | ! Run test cases 19 | call test_factorial() 20 | call test_recursive_factorial() 21 | 22 | print *, "All tests completed." 23 | 24 | contains 25 | 26 | ! Test case for iterative factorial for known values 27 | subroutine test_factorial() 28 | expected = 120 29 | result = factorial(5) 30 | call assert_test(result, expected, "Test 1: Iterative Factorial of 5") 31 | 32 | expected = 1 33 | result = factorial(0) 34 | call assert_test(result, expected, "Test 2: Iterative Factorial of edge case: 0") 35 | 36 | expected = 1 37 | result = factorial(1) 38 | call assert_test(result, expected, "Test 3: Iterative Factorial of edge case: 1") 39 | 40 | expected = 40320 41 | result = factorial(8) 42 | call assert_test(result, expected, "Test 4: Iterative Factorial of 8") 43 | 44 | expected = 720 45 | result = factorial(6) 46 | call assert_test(result, expected, "Test 5: Iterative Factorial of 6") 47 | end subroutine test_factorial 48 | 49 | ! Test case for recursive factorial for known values 50 | subroutine test_recursive_factorial() 51 | expected = 120 52 | result = recursive_factorial(5) 53 | call assert_test(result, expected, "Test 1: Recursive Factorial of 5") 54 | 55 | expected = 1 56 | result = recursive_factorial(0) 57 | call assert_test(result, expected, "Test 2: Recursive Factorial of edge case: 0") 58 | 59 | expected = 1 60 | result = recursive_factorial(1) 61 | call assert_test(result, expected, "Test 3: Recursive Factorial of edge case: 1") 62 | 63 | expected = 40320 64 | result = recursive_factorial(8) 65 | call assert_test(result, expected, "Test 4: Recursive Factorial of 8") 66 | 67 | expected = 720 68 | result = recursive_factorial(6) 69 | call assert_test(result, expected, "Test 5: Recursive Factorial of 6") 70 | end subroutine test_recursive_factorial 71 | 72 | !> Subroutine to assert the test results 73 | subroutine assert_test(actual, expected, test_name) 74 | integer, intent(in) :: actual, expected 75 | character(len=*), intent(in) :: test_name 76 | 77 | if (actual == expected) then 78 | print *, test_name, " PASSED" 79 | else 80 | print *, test_name, " FAILED" 81 | print *, "Expected: ", expected 82 | print *, "Got: ", actual 83 | stop 1 84 | end if 85 | end subroutine assert_test 86 | 87 | end program tests_factorial 88 | -------------------------------------------------------------------------------- /tests/maths/fibonacci.f90: -------------------------------------------------------------------------------- 1 | !> Test program for Fibonacci functions 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #31 5 | !! https://github.com/TheAlgorithms/Fortran/pull/31 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the two fibonacci functions in the fibonacci_module. 11 | 12 | program tests_fibonacci 13 | use fibonacci_module 14 | implicit none 15 | 16 | integer :: result, expected 17 | 18 | ! Run test cases 19 | call test_fib_zero() 20 | call test_fib_one() 21 | call test_fib_two() 22 | call test_fib_three() 23 | call test_fib_five() 24 | call test_fib_thirty() 25 | call test_fib_negative_one() 26 | call test_fib_negative_five() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Fibonacci of 0 33 | subroutine test_fib_zero() 34 | expected = 0 35 | result = fib_rec(0) 36 | call assert_test(result, expected, "Test 1: Fibonacci of 0 (Recursive)") 37 | result = fib_itr(0) 38 | call assert_test(result, expected, "Test 1: Fibonacci of 0 (Iterative)") 39 | end subroutine test_fib_zero 40 | 41 | ! Test case 2: Fibonacci of 1 42 | subroutine test_fib_one() 43 | expected = 1 44 | result = fib_rec(1) 45 | call assert_test(result, expected, "Test 2: Fibonacci of 1 (Recursive)") 46 | result = fib_itr(1) 47 | call assert_test(result, expected, "Test 2: Fibonacci of 1 (Iterative)") 48 | end subroutine test_fib_one 49 | 50 | ! Test case 3: Fibonacci of 2 51 | subroutine test_fib_two() 52 | expected = 1 53 | result = fib_rec(2) 54 | call assert_test(result, expected, "Test 3: Fibonacci of 2 (Recursive)") 55 | result = fib_itr(2) 56 | call assert_test(result, expected, "Test 3: Fibonacci of 2 (Iterative)") 57 | end subroutine test_fib_two 58 | 59 | ! Test case 4: Fibonacci of 3 60 | subroutine test_fib_three() 61 | expected = 2 62 | result = fib_rec(3) 63 | call assert_test(result, expected, "Test 4: Fibonacci of 3 (Recursive)") 64 | result = fib_itr(3) 65 | call assert_test(result, expected, "Test 4: Fibonacci of 3 (Iterative)") 66 | end subroutine test_fib_three 67 | 68 | ! Test case 5: Fibonacci of 5 69 | subroutine test_fib_five() 70 | expected = 5 71 | result = fib_rec(5) 72 | call assert_test(result, expected, "Test 5: Fibonacci of 5 (Recursive)") 73 | result = fib_itr(5) 74 | call assert_test(result, expected, "Test 5: Fibonacci of 5 (Iterative)") 75 | end subroutine test_fib_five 76 | 77 | ! Test case 6: Fibonacci of 30 78 | subroutine test_fib_thirty() 79 | expected = 832040 80 | result = fib_rec(30) 81 | call assert_test(result, expected, "Test 5: Fibonacci of 30 (Recursive)") 82 | result = fib_itr(30) 83 | call assert_test(result, expected, "Test 5: Fibonacci of 30 (Iterative)") 84 | end subroutine test_fib_thirty 85 | 86 | ! Test case 7: Fibonacci of negative input 87 | subroutine test_fib_negative_one() 88 | expected = -1 89 | result = fib_rec(-9) 90 | call assert_test(result, expected, "Test 6: Fibonacci of -1 (Recursive)") 91 | result = fib_itr(-9) 92 | call assert_test(result, expected, "Test 6: Fibonacci of -1 (Iterative)") 93 | end subroutine test_fib_negative_one 94 | 95 | ! Test case 8: Fibonacci of negative input 96 | subroutine test_fib_negative_five() 97 | expected = -1 98 | result = fib_rec(-9) 99 | call assert_test(result, expected, "Test 7: Fibonacci of -5 (Recursive)") 100 | result = fib_itr(-9) 101 | call assert_test(result, expected, "Test 7: Fibonacci of -5 (Iterative)") 102 | end subroutine test_fib_negative_five 103 | 104 | !> Subroutine to assert the test results 105 | subroutine assert_test(actual, expected, test_name) 106 | integer, intent(in) :: actual, expected 107 | character(len=*), intent(in) :: test_name 108 | 109 | if (actual == expected) then 110 | print *, test_name, " PASSED" 111 | else 112 | print *, test_name, " FAILED" 113 | print *, "Expected: ", expected 114 | print *, "Got: ", actual 115 | stop 1 116 | end if 117 | 118 | end subroutine assert_test 119 | 120 | end program tests_fibonacci 121 | 122 | -------------------------------------------------------------------------------- /tests/maths/numerical_integration/gaussin_legendre.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Gaussian Legendre Quadrature module 2 | !! 3 | !! Created by: Your Name (https://github.com/YourGitHub) 4 | !! in Pull Request: #32 5 | !! https://github.com/TheAlgorithms/Fortran/pull/32 6 | !! 7 | !! This program provides test cases to validate the gaussian_legendre_quadrature module against known integral values. 8 | 9 | program test_gaussian_legendre_quadrature 10 | use gaussian_legendre_quadrature 11 | implicit none 12 | 13 | ! Run test cases 14 | call test_integral_x_squared_0_to_1() 15 | call test_integral_e_x_0_to_1() 16 | call test_integral_sin_0_to_pi() 17 | call test_integral_cos_0_to_pi_over_2() 18 | call test_integral_1_over_x_1_to_e() 19 | call test_integral_x_cubed_0_to_1() 20 | call test_integral_sin_squared_0_to_pi() 21 | call test_integral_1_over_x_1_to_e() 22 | 23 | print *, "All tests completed." 24 | 25 | contains 26 | 27 | ! Test case 1: ∫ x^2 dx from 0 to 1 (Exact result = 1/3 ≈ 0.3333) 28 | subroutine test_integral_x_squared_0_to_1() 29 | real(dp) :: lower_bound, upper_bound, integral_result, expected 30 | integer :: panels_number 31 | lower_bound = 0.0_dp 32 | upper_bound = 1.0_dp 33 | panels_number = 5 ! Adjust the number of quadrature points as needed from 1 to 5 34 | expected = 1.0_dp/3.0_dp 35 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 36 | call assert_test(integral_result, expected, "Test 1: ∫ x^2 dx from 0 to 1") 37 | end subroutine test_integral_x_squared_0_to_1 38 | 39 | ! Test case 2: ∫ e^x dx from 0 to 1 (Exact result = e - 1 ≈ 1.7183) 40 | subroutine test_integral_e_x_0_to_1() 41 | real(dp) :: lower_bound, upper_bound, integral_result, expected 42 | integer :: panels_number 43 | lower_bound = 0.0_dp 44 | upper_bound = 1.0_dp 45 | panels_number = 3 46 | expected = exp(1.0_dp) - 1.0_dp 47 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, exp_function) 48 | call assert_test(integral_result, expected, "Test 2: ∫ e^x dx from 0 to 1") 49 | end subroutine test_integral_e_x_0_to_1 50 | 51 | ! Test case 3: ∫ sin(x) dx from 0 to π (Exact result = 2) 52 | subroutine test_integral_sin_0_to_pi() 53 | real(dp) :: lower_bound, upper_bound, integral_result, expected 54 | integer :: panels_number 55 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 56 | lower_bound = 0.0_dp 57 | upper_bound = pi 58 | panels_number = 5 59 | expected = 2.0_dp 60 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, sin_function) 61 | call assert_test(integral_result, expected, "Test 3: ∫ sin(x) dx from 0 to π") 62 | end subroutine test_integral_sin_0_to_pi 63 | 64 | ! Test case 4: ∫ cos(x) dx from 0 to π/2 (Exact result = 1) 65 | subroutine test_integral_cos_0_to_pi_over_2() 66 | real(dp) :: lower_bound, upper_bound, integral_result, expected 67 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 68 | integer :: panels_number 69 | lower_bound = 0.0_dp 70 | upper_bound = pi/2.0_dp 71 | panels_number = 5 72 | expected = 1.0_dp 73 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, cos_function) 74 | call assert_test(integral_result, expected, "Test 4: ∫ cos(x) dx from 0 to π/2") 75 | end subroutine test_integral_cos_0_to_pi_over_2 76 | 77 | ! Test case 5: ∫ (1/x) dx from 1 to e (Exact result = 1) 78 | subroutine test_integral_1_over_x_1_to_e() 79 | real(dp) :: lower_bound, upper_bound, integral_result, expected 80 | integer :: panels_number 81 | lower_bound = 1.0_dp 82 | upper_bound = exp(1.0_dp) 83 | panels_number = 5 84 | expected = 1.0_dp 85 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, log_function) 86 | call assert_test(integral_result, expected, "Test 5: ∫ (1/x) dx from 1 to e") 87 | end subroutine test_integral_1_over_x_1_to_e 88 | 89 | ! Test case 6: ∫ x^3 dx from 0 to 1 (Exact result = 1/4 = 0.25) 90 | subroutine test_integral_x_cubed_0_to_1() 91 | real(dp) :: lower_bound, upper_bound, integral_result, expected 92 | integer :: panels_number 93 | lower_bound = 0.0_dp 94 | upper_bound = 1.0_dp 95 | panels_number = 4 96 | expected = 0.25_dp 97 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, f_x_cubed) 98 | call assert_test(integral_result, expected, "Test 6: ∫ x^3 dx from 0 to 1") 99 | end subroutine test_integral_x_cubed_0_to_1 100 | 101 | ! Test case 7: ∫ sin^2(x) dx from 0 to π (Exact result = π/2 ≈ 1.5708) 102 | subroutine test_integral_sin_squared_0_to_pi() 103 | real(dp) :: lower_bound, upper_bound, integral_result, expected 104 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 105 | integer :: panels_number 106 | lower_bound = 0.0_dp 107 | upper_bound = pi 108 | panels_number = 5 109 | expected = 1.57084_dp ! Approximate value, adjust tolerance as needed 110 | call gauss_legendre_quadrature(integral_result, lower_bound, upper_bound, panels_number, sin_squared_function) 111 | call assert_test(integral_result, expected, "Test 7: ∫ sin^2(x) dx from 0 to π") 112 | end subroutine test_integral_sin_squared_0_to_pi 113 | 114 | ! Function for x^2 115 | real(dp) function f_x_squared(x) 116 | real(dp), intent(in) :: x 117 | f_x_squared = x**2 118 | end function f_x_squared 119 | 120 | ! Function for e^x 121 | real(dp) function exp_function(x) 122 | real(dp), intent(in) :: x 123 | exp_function = exp(x) 124 | end function exp_function 125 | 126 | ! Function for 1/x 127 | real(dp) function log_function(x) 128 | real(dp), intent(in) :: x 129 | log_function = 1.0_dp/x 130 | end function log_function 131 | 132 | ! Function for cos(x) 133 | real(dp) function cos_function(x) 134 | real(dp), intent(in) :: x 135 | cos_function = cos(x) 136 | end function cos_function 137 | 138 | ! Function for x^3 139 | real(dp) function f_x_cubed(x) 140 | real(dp), intent(in) :: x 141 | f_x_cubed = x**3 142 | end function f_x_cubed 143 | 144 | ! Function for sin(x) 145 | real(dp) function sin_function(x) 146 | real(dp), intent(in) :: x 147 | sin_function = sin(x) 148 | end function sin_function 149 | 150 | ! Function for sin^2(x) 151 | real(dp) function sin_squared_function(x) 152 | real(dp), intent(in) :: x 153 | sin_squared_function = sin(x)**2 154 | end function sin_squared_function 155 | 156 | !> Subroutine to assert the test results 157 | subroutine assert_test(actual, expected, test_name) 158 | real(dp), intent(in) :: actual, expected 159 | character(len=*), intent(in) :: test_name 160 | real(dp), parameter :: tol = 1.0e-5_dp 161 | 162 | if (abs(actual - expected) < tol) then 163 | print *, test_name, " PASSED" 164 | else 165 | print *, test_name, " FAILED" 166 | print *, " Expected: ", expected 167 | print *, " Got: ", actual 168 | stop 1 169 | end if 170 | end subroutine assert_test 171 | 172 | end program test_gaussian_legendre_quadrature 173 | -------------------------------------------------------------------------------- /tests/maths/numerical_integration/midpoint.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Midpoint Rule module 2 | !! 3 | !! Created by: Your Name (https://github.com/YourGitHub) 4 | !! in Pull Request: #32 5 | !! https://github.com/TheAlgorithms/Fortran/pull/32 6 | !! 7 | !! This program provides test cases to validate the midpoint_rule module against known integral values. 8 | 9 | program test_midpoint_rule 10 | use midpoint_rule 11 | implicit none 12 | 13 | ! Run test cases 14 | call test_integral_x_squared_0_to_1() 15 | call test_integral_x_squared_0_to_2() 16 | call test_integral_sin_0_to_pi() 17 | call test_integral_e_x_0_to_1() 18 | call test_integral_1_over_x_1_to_e() 19 | call test_integral_cos_0_to_pi_over_2() 20 | call test_integral_x_cubed_0_to_1() 21 | call test_integral_sin_x_squared_0_to_1() 22 | 23 | print *, "All tests completed." 24 | 25 | contains 26 | 27 | ! Test case 1: ∫ x^2 dx from 0 to 1 (Exact result = 1/3 ≈ 0.3333) 28 | subroutine test_integral_x_squared_0_to_1() 29 | real(dp) :: lower_bound, upper_bound, integral_result, expected 30 | integer :: panels_number 31 | lower_bound = 0.0_dp 32 | upper_bound = 1.0_dp 33 | panels_number = 1000000 ! Must be a positive integer 34 | expected = 1.0_dp/3.0_dp 35 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 36 | call assert_test(integral_result, expected, "Test 1: ∫ x^2 dx from 0 to 1") 37 | end subroutine test_integral_x_squared_0_to_1 38 | 39 | ! Test case 2: ∫ x^2 dx from 0 to 2 (Exact result = 8/3 ≈ 2.6667) 40 | subroutine test_integral_x_squared_0_to_2() 41 | real(dp) :: lower_bound, upper_bound, integral_result, expected 42 | integer :: panels_number 43 | lower_bound = 0.0_dp 44 | upper_bound = 2.0_dp 45 | panels_number = 1000000 ! Must be a positive integer 46 | expected = 8.0_dp/3.0_dp 47 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 48 | call assert_test(integral_result, expected, "Test 2: ∫ x^2 dx from 0 to 2") 49 | end subroutine test_integral_x_squared_0_to_2 50 | 51 | ! Test case 3: ∫ sin(x) dx from 0 to π (Exact result = 2) 52 | subroutine test_integral_sin_0_to_pi() 53 | real(dp) :: lower_bound, upper_bound, integral_result, expected 54 | integer :: panels_number 55 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 56 | lower_bound = 0.0_dp 57 | upper_bound = pi 58 | panels_number = 1000000 ! Must be a positive integer 59 | expected = 2.0_dp 60 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, sin_function) 61 | call assert_test(integral_result, expected, "Test 3: ∫ sin(x) dx from 0 to π") 62 | end subroutine test_integral_sin_0_to_pi 63 | 64 | ! Test case 4: ∫ e^x dx from 0 to 1 (Exact result = e - 1 ≈ 1.7183) 65 | subroutine test_integral_e_x_0_to_1() 66 | real(dp) :: lower_bound, upper_bound, integral_result, expected 67 | integer :: panels_number 68 | lower_bound = 0.0_dp 69 | upper_bound = 1.0_dp 70 | panels_number = 1000000 ! Must be a positive integer 71 | expected = exp(1.0_dp) - 1.0_dp 72 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, exp_function) 73 | call assert_test(integral_result, expected, "Test 4: ∫ e^x dx from 0 to 1") 74 | end subroutine test_integral_e_x_0_to_1 75 | 76 | ! Test case 5: ∫ (1/x) dx from 1 to e (Exact result = 1) 77 | subroutine test_integral_1_over_x_1_to_e() 78 | real(dp) :: lower_bound, upper_bound, integral_result, expected 79 | integer :: panels_number 80 | lower_bound = 1.0_dp 81 | upper_bound = exp(1.0_dp) 82 | panels_number = 1000000 ! Must be a positive integer 83 | expected = 1.0_dp 84 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, log_function) 85 | call assert_test(integral_result, expected, "Test 5: ∫ (1/x) dx from 1 to e") 86 | end subroutine test_integral_1_over_x_1_to_e 87 | 88 | ! Test case 6: ∫ cos(x) dx from 0 to π/2 (Exact result = 1) 89 | subroutine test_integral_cos_0_to_pi_over_2() 90 | real(dp) :: lower_bound, upper_bound, integral_result, expected 91 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 92 | integer :: panels_number 93 | lower_bound = 0.0_dp 94 | upper_bound = pi/2.0_dp 95 | panels_number = 1000000 ! Must be a positive integer 96 | expected = 1.0_dp 97 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, cos_function) 98 | call assert_test(integral_result, expected, "Test 6: ∫ cos(x) dx from 0 to π/2") 99 | end subroutine test_integral_cos_0_to_pi_over_2 100 | 101 | ! Test case 7: ∫ x^3 dx from 0 to 1 (Exact result = 1/4 = 0.25) 102 | subroutine test_integral_x_cubed_0_to_1() 103 | real(dp) :: lower_bound, upper_bound, integral_result, expected 104 | integer :: panels_number 105 | lower_bound = 0.0_dp 106 | upper_bound = 1.0_dp 107 | panels_number = 1000000 ! Must be a positive integer 108 | expected = 0.25_dp 109 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, f_x_cubed) 110 | call assert_test(integral_result, expected, "Test 7: ∫ x^3 dx from 0 to 1") 111 | end subroutine test_integral_x_cubed_0_to_1 112 | 113 | ! Test case 8: ∫ sin(x^2) dx from 0 to 1 (Approximate value) 114 | subroutine test_integral_sin_x_squared_0_to_1() 115 | real(dp) :: lower_bound, upper_bound, integral_result, expected 116 | integer :: panels_number 117 | lower_bound = 0.0_dp 118 | upper_bound = 1.0_dp 119 | panels_number = 1000000 ! Must be a positive integer 120 | expected = 0.310268_dp ! Approximate value, adjust tolerance as needed 121 | call midpoint(integral_result, lower_bound, upper_bound, panels_number, sin_squared_function) 122 | call assert_test(integral_result, expected, "Test 8: ∫ sin(x^2) dx from 0 to 1") 123 | end subroutine test_integral_sin_x_squared_0_to_1 124 | 125 | ! Function for x^2 126 | real(dp) function f_x_squared(x) 127 | real(dp), intent(in) :: x 128 | f_x_squared = x**2 129 | end function f_x_squared 130 | 131 | ! Function for e^x 132 | real(dp) function exp_function(x) 133 | real(dp), intent(in) :: x 134 | exp_function = exp(x) 135 | end function exp_function 136 | 137 | ! Function for 1/x 138 | real(dp) function log_function(x) 139 | real(dp), intent(in) :: x 140 | log_function = 1.0_dp/x 141 | end function log_function 142 | 143 | ! Function for cos(x) 144 | real(dp) function cos_function(x) 145 | real(dp), intent(in) :: x 146 | cos_function = cos(x) 147 | end function cos_function 148 | 149 | ! Function for x^3 150 | real(dp) function f_x_cubed(x) 151 | real(dp), intent(in) :: x 152 | f_x_cubed = x**3 153 | end function f_x_cubed 154 | 155 | ! Function for sin(x^2) 156 | real(dp) function sin_squared_function(x) 157 | real(dp), intent(in) :: x 158 | sin_squared_function = sin(x**2) 159 | end function sin_squared_function 160 | 161 | ! Function for sin(x) 162 | real(dp) function sin_function(x) 163 | real(dp), intent(in) :: x 164 | sin_function = sin(x) 165 | end function sin_function 166 | 167 | !> Subroutine to assert the test results 168 | subroutine assert_test(actual, expected, test_name) 169 | real(dp), intent(in) :: actual, expected 170 | character(len=*), intent(in) :: test_name 171 | real(dp), parameter :: tol = 1.0e-6_dp 172 | 173 | if (abs(actual - expected) < tol) then 174 | print *, test_name, " PASSED" 175 | else 176 | print *, test_name, " FAILED" 177 | print *, " Expected: ", expected 178 | print *, " Got: ", actual 179 | stop 1 180 | end if 181 | end subroutine assert_test 182 | 183 | end program test_midpoint_rule 184 | -------------------------------------------------------------------------------- /tests/maths/numerical_integration/monte_carlo.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Monte Carlo Integration module 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #32 5 | !! https://github.com/TheAlgorithms/Fortran/pull/32 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the monte_carlo_integration module against known integral values. 11 | 12 | program test_monte_carlo_integration 13 | use monte_carlo_integration 14 | implicit none 15 | 16 | ! Run test cases 17 | call test_integral_x_squared_0_to_1() 18 | call test_integral_e_x_0_to_1() 19 | call test_integral_sin_0_to_pi() 20 | call test_integral_cos_0_to_pi_over_2() 21 | call test_integral_1_over_x_1_to_e() 22 | call test_integral_x_cubed_0_to_1() 23 | call test_integral_sin_squared_0_to_1() 24 | 25 | print *, "All tests completed." 26 | 27 | contains 28 | 29 | ! Test case 1: ∫ x^2 dx from 0 to 1 (Exact result = 1/3 ≈ 0.3333) 30 | subroutine test_integral_x_squared_0_to_1() 31 | real(dp) :: a, b, integral_result, error_estimate, expected 32 | integer :: n 33 | a = 0.0_dp 34 | b = 1.0_dp 35 | n = 1000000 36 | expected = 1.0_dp/3.0_dp 37 | 38 | call monte_carlo(integral_result, error_estimate, a, b, n, f_x_squared) 39 | call assert_test(integral_result, expected, error_estimate, "Test 1: ∫ x^2 dx from 0 to 1") 40 | 41 | end subroutine test_integral_x_squared_0_to_1 42 | 43 | ! Test case 2: ∫ e^x dx from 0 to 1 (Exact result = e - 1 ≈ 1.7183) 44 | subroutine test_integral_e_x_0_to_1() 45 | real(dp) :: a, b, integral_result, error_estimate, expected 46 | integer :: n 47 | a = 0.0_dp 48 | b = 1.0_dp 49 | n = 1000000 50 | expected = exp(1.0_dp) - 1.0_dp 51 | 52 | call monte_carlo(integral_result, error_estimate, a, b, n, exp_function) 53 | call assert_test(integral_result, expected, error_estimate, "Test 2: ∫ e^x dx from 0 to 1") 54 | 55 | end subroutine test_integral_e_x_0_to_1 56 | 57 | ! Test case 3: ∫ sin(x) dx from 0 to π (Exact result = 2) 58 | subroutine test_integral_sin_0_to_pi() 59 | real(dp) :: a, b, integral_result, error_estimate, expected 60 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 61 | integer :: n 62 | a = 0.0_dp 63 | b = pi 64 | n = 1000000 65 | expected = 2.0_dp 66 | 67 | call monte_carlo(integral_result, error_estimate, a, b, n, sin_function) 68 | call assert_test(integral_result, expected, error_estimate, "Test 3: ∫ sin(x) dx from 0 to π") 69 | 70 | end subroutine test_integral_sin_0_to_pi 71 | 72 | ! Test case 4: ∫ cos(x) dx from 0 to π/2 (Exact result = 1) 73 | subroutine test_integral_cos_0_to_pi_over_2() 74 | real(dp) :: a, b, integral_result, error_estimate, expected 75 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 76 | integer :: n 77 | a = 0.0_dp 78 | b = pi/2.0_dp 79 | n = 1000000 80 | expected = 1.0_dp 81 | 82 | call monte_carlo(integral_result, error_estimate, a, b, n, cos_function) 83 | call assert_test(integral_result, expected, error_estimate, "Test 4: ∫ cos(x) dx from 0 to π/2") 84 | 85 | end subroutine test_integral_cos_0_to_pi_over_2 86 | 87 | ! Test case 5: ∫ (1/x) dx from 1 to e (Exact result = 1) 88 | subroutine test_integral_1_over_x_1_to_e() 89 | real(dp) :: a, b, integral_result, error_estimate, expected 90 | integer :: n 91 | a = 1.0_dp 92 | b = exp(1.0_dp) 93 | n = 1000000 94 | expected = 1.0_dp 95 | 96 | call monte_carlo(integral_result, error_estimate, a, b, n, log_function) 97 | call assert_test(integral_result, expected, error_estimate, "Test 5: ∫ (1/x) dx from 1 to e") 98 | 99 | end subroutine test_integral_1_over_x_1_to_e 100 | 101 | ! Test case 6: ∫ x^3 dx from 0 to 1 (Exact result = 1/4 = 0.25) 102 | subroutine test_integral_x_cubed_0_to_1() 103 | real(dp) :: a, b, integral_result, error_estimate, expected 104 | integer :: n 105 | a = 0.0_dp 106 | b = 1.0_dp 107 | n = 1000000 108 | expected = 0.25_dp 109 | 110 | call monte_carlo(integral_result, error_estimate, a, b, n, f_x_cubed) 111 | call assert_test(integral_result, expected, error_estimate, "Test 6: ∫ x^3 dx from 0 to 1") 112 | 113 | end subroutine test_integral_x_cubed_0_to_1 114 | 115 | ! Test case 7: ∫ sin(x^2) dx from 0 to 1 (Approximate value) 116 | subroutine test_integral_sin_squared_0_to_1() 117 | real(dp) :: a, b, integral_result, error_estimate, expected 118 | integer :: n 119 | a = 0.0_dp 120 | b = 1.0_dp 121 | n = 1000000 122 | expected = 0.31026_dp ! Approximate value, adjust tolerance as needed 123 | call monte_carlo(integral_result, error_estimate, a, b, n, sin_squared_function) 124 | call assert_test(integral_result, expected, error_estimate, "Test 7: ∫ sin(x^2) dx from 0 to 1") 125 | 126 | end subroutine test_integral_sin_squared_0_to_1 127 | 128 | ! Function for x^2 129 | real(dp) function f_x_squared(x) 130 | real(dp), intent(in) :: x 131 | f_x_squared = x**2 132 | end function f_x_squared 133 | 134 | ! Function for e^x 135 | real(dp) function exp_function(x) 136 | real(dp), intent(in) :: x 137 | exp_function = exp(x) 138 | end function exp_function 139 | 140 | ! Function for 1/x 141 | real(dp) function log_function(x) 142 | real(dp), intent(in) :: x 143 | log_function = 1.0_dp/x 144 | end function log_function 145 | 146 | ! Function for cos(x) 147 | real(dp) function cos_function(x) 148 | real(dp), intent(in) :: x 149 | cos_function = cos(x) 150 | end function cos_function 151 | 152 | ! Function for x^3 153 | real(dp) function f_x_cubed(x) 154 | real(dp), intent(in) :: x 155 | f_x_cubed = x**3 156 | end function f_x_cubed 157 | 158 | ! Function for sin(x^2) 159 | real(dp) function sin_squared_function(x) 160 | real(dp), intent(in) :: x 161 | sin_squared_function = sin(x**2) 162 | end function sin_squared_function 163 | 164 | ! Function for sin(x) 165 | real(dp) function sin_function(x) 166 | real(dp), intent(in) :: x 167 | sin_function = sin(x) 168 | end function sin_function 169 | 170 | !> Subroutine to assert the test results 171 | subroutine assert_test(actual, expected, error_estimate, test_name) 172 | real(dp), intent(in) :: actual, expected, error_estimate 173 | character(len=*), intent(in) :: test_name 174 | real(dp) :: tol 175 | 176 | ! Set the tolerance based on the error estimate 177 | tol = max(1.0e-5_dp, 10.0_dp*error_estimate) ! Adjust as needed 178 | 179 | if (abs(actual - expected) < tol) then 180 | print *, test_name, " PASSED" 181 | else 182 | print *, test_name, " FAILED" 183 | print *, " Expected: ", expected 184 | print *, " Got: ", actual 185 | stop 1 186 | end if 187 | end subroutine assert_test 188 | 189 | end program test_monte_carlo_integration 190 | -------------------------------------------------------------------------------- /tests/maths/numerical_integration/simpson.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Simpson Rule module 2 | !! 3 | !! Created by: Your Name (https://github.com/YourGitHub) 4 | !! in Pull Request: #32 5 | !! https://github.com/TheAlgorithms/Fortran/pull/32 6 | !! 7 | !! This program provides test cases to validate the simpson_rule module against known integral values. 8 | 9 | program test_simpson_rule 10 | use simpson_rule 11 | implicit none 12 | 13 | ! Run test cases 14 | call test_integral_x_squared_0_to_1() 15 | call test_integral_x_squared_0_to_2() 16 | call test_integral_sin_0_to_pi() 17 | call test_integral_e_x_0_to_1() 18 | call test_integral_1_over_x_1_to_e() 19 | call test_integral_cos_0_to_pi_over_2() 20 | call test_integral_x_cubed_0_to_1() 21 | call test_integral_sin_x_squared_0_to_1() 22 | 23 | print *, "All tests completed." 24 | 25 | contains 26 | 27 | ! Test case 1: ∫ x^2 dx from 0 to 1 (Exact result = 1/3 ≈ 0.3333) 28 | subroutine test_integral_x_squared_0_to_1() 29 | real(dp) :: lower_bound, upper_bound, integral_result, expected 30 | integer :: panels_number 31 | lower_bound = 0.0_dp 32 | upper_bound = 1.0_dp 33 | panels_number = 1000000 ! Must be even 34 | expected = 1.0_dp/3.0_dp 35 | call simpson(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 36 | call assert_test(integral_result, expected, "Test 1: ∫ x^2 dx from 0 to 1") 37 | end subroutine test_integral_x_squared_0_to_1 38 | 39 | ! Test case 2: ∫ x^2 dx from 0 to 2 (Exact result = 8/3 ≈ 2.6667) 40 | subroutine test_integral_x_squared_0_to_2() 41 | real(dp) :: lower_bound, upper_bound, integral_result, expected 42 | integer :: panels_number 43 | lower_bound = 0.0_dp 44 | upper_bound = 2.0_dp 45 | panels_number = 1000000 ! Must be even 46 | expected = 8.0_dp/3.0_dp 47 | call simpson(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 48 | call assert_test(integral_result, expected, "Test 2: ∫ x^2 dx from 0 to 2") 49 | end subroutine test_integral_x_squared_0_to_2 50 | 51 | ! Test case 3: ∫ sin(x) dx from 0 to π (Exact result = 2) 52 | subroutine test_integral_sin_0_to_pi() 53 | real(dp) :: lower_bound, upper_bound, integral_result, expected 54 | integer :: panels_number 55 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 56 | lower_bound = 0.0_dp 57 | upper_bound = pi 58 | panels_number = 1000000 ! Must be even 59 | expected = 2.0_dp 60 | call simpson(integral_result, lower_bound, upper_bound, panels_number, sin_function) 61 | call assert_test(integral_result, expected, "Test 3: ∫ sin(x) dx from 0 to π") 62 | end subroutine test_integral_sin_0_to_pi 63 | 64 | ! Test case 4: ∫ e^x dx from 0 to 1 (Exact result = e - 1 ≈ 1.7183) 65 | subroutine test_integral_e_x_0_to_1() 66 | real(dp) :: lower_bound, upper_bound, integral_result, expected 67 | integer :: panels_number 68 | lower_bound = 0.0_dp 69 | upper_bound = 1.0_dp 70 | panels_number = 1000000 ! Must be even 71 | expected = exp(1.0_dp) - 1.0_dp 72 | call simpson(integral_result, lower_bound, upper_bound, panels_number, exp_function) 73 | call assert_test(integral_result, expected, "Test 4: ∫ e^x dx from 0 to 1") 74 | end subroutine test_integral_e_x_0_to_1 75 | 76 | ! Test case 5: ∫ (1/x) dx from 1 to e (Exact result = 1) 77 | subroutine test_integral_1_over_x_1_to_e() 78 | real(dp) :: lower_bound, upper_bound, integral_result, expected 79 | integer :: panels_number 80 | lower_bound = 1.0_dp 81 | upper_bound = exp(1.0_dp) 82 | panels_number = 1000000 ! Must be even 83 | expected = 1.0_dp 84 | call simpson(integral_result, lower_bound, upper_bound, panels_number, log_function) 85 | call assert_test(integral_result, expected, "Test 5: ∫ (1/x) dx from 1 to e") 86 | end subroutine test_integral_1_over_x_1_to_e 87 | 88 | ! Test case 6: ∫ cos(x) dx from 0 to π/2 (Exact result = 1) 89 | subroutine test_integral_cos_0_to_pi_over_2() 90 | real(dp) :: lower_bound, upper_bound, integral_result, expected 91 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 92 | integer :: panels_number 93 | lower_bound = 0.0_dp 94 | upper_bound = pi/2.0_dp 95 | panels_number = 1000000 ! Must be even 96 | expected = 1.0_dp 97 | call simpson(integral_result, lower_bound, upper_bound, panels_number, cos_function) 98 | call assert_test(integral_result, expected, "Test 6: ∫ cos(x) dx from 0 to π/2") 99 | end subroutine test_integral_cos_0_to_pi_over_2 100 | 101 | ! Test case 7: ∫ x^3 dx from 0 to 1 (Exact result = 1/4 = 0.25) 102 | subroutine test_integral_x_cubed_0_to_1() 103 | real(dp) :: lower_bound, upper_bound, integral_result, expected 104 | integer :: panels_number 105 | lower_bound = 0.0_dp 106 | upper_bound = 1.0_dp 107 | panels_number = 1000000 ! Must be even 108 | expected = 0.25_dp 109 | call simpson(integral_result, lower_bound, upper_bound, panels_number, f_x_cubed) 110 | call assert_test(integral_result, expected, "Test 7: ∫ x^3 dx from 0 to 1") 111 | end subroutine test_integral_x_cubed_0_to_1 112 | 113 | ! Test case 8: ∫ sin(x^2) dx from 0 to 1 (Approximate value) 114 | subroutine test_integral_sin_x_squared_0_to_1() 115 | real(dp) :: lower_bound, upper_bound, integral_result, expected 116 | integer :: panels_number 117 | lower_bound = 0.0_dp 118 | upper_bound = 1.0_dp 119 | panels_number = 1000000 ! Must be even 120 | expected = 0.310268_dp ! Approximate value, adjust tolerance as needed 121 | call simpson(integral_result, lower_bound, upper_bound, panels_number, sin_squared_function) 122 | call assert_test(integral_result, expected, "Test 8: ∫ sin(x^2) dx from 0 to 1") 123 | end subroutine test_integral_sin_x_squared_0_to_1 124 | 125 | ! Function for x^2 126 | real(dp) function f_x_squared(x) 127 | real(dp), intent(in) :: x 128 | f_x_squared = x**2 129 | end function f_x_squared 130 | 131 | ! Function for e^x 132 | real(dp) function exp_function(x) 133 | real(dp), intent(in) :: x 134 | exp_function = exp(x) 135 | end function exp_function 136 | 137 | ! Function for 1/x 138 | real(dp) function log_function(x) 139 | real(dp), intent(in) :: x 140 | log_function = 1.0_dp/x 141 | end function log_function 142 | 143 | ! Function for cos(x) 144 | real(dp) function cos_function(x) 145 | real(dp), intent(in) :: x 146 | cos_function = cos(x) 147 | end function cos_function 148 | 149 | ! Function for x^3 150 | real(dp) function f_x_cubed(x) 151 | real(dp), intent(in) :: x 152 | f_x_cubed = x**3 153 | end function f_x_cubed 154 | 155 | ! Function for sin(x^2) 156 | real(dp) function sin_squared_function(x) 157 | real(dp), intent(in) :: x 158 | sin_squared_function = sin(x**2) 159 | end function sin_squared_function 160 | 161 | ! Function for sin(x) 162 | real(dp) function sin_function(x) 163 | real(dp), intent(in) :: x 164 | sin_function = sin(x) 165 | end function sin_function 166 | 167 | !> Subroutine to assert the test results 168 | subroutine assert_test(actual, expected, test_name) 169 | real(dp), intent(in) :: actual, expected 170 | character(len=*), intent(in) :: test_name 171 | real(dp), parameter :: tol = 1.0e-6_dp 172 | 173 | if (abs(actual - expected) < tol) then 174 | print *, test_name, " PASSED" 175 | else 176 | print *, test_name, " FAILED" 177 | print *, " Expected: ", expected 178 | print *, " Got: ", actual 179 | stop 1 180 | end if 181 | end subroutine assert_test 182 | 183 | end program test_simpson_rule 184 | -------------------------------------------------------------------------------- /tests/maths/numerical_integration/trapezoid.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Trapezoidal Rule module 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #32 5 | !! https://github.com/TheAlgorithms/Fortran/pull/32 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the trapezoidal_rule module against known integral values. 11 | 12 | program test_trapezoidal_rule 13 | use trapezoidal_rule 14 | implicit none 15 | 16 | ! Run test cases 17 | call test_integral_x_squared_0_to_1() 18 | call test_integral_x_squared_0_to_2() 19 | call test_integral_sin_0_to_pi() 20 | call test_integral_e_x_0_to_1() 21 | call test_integral_1_over_x_1_to_e() 22 | call test_integral_cos_0_to_pi_over_2() 23 | call test_integral_x_cubed_0_to_1() 24 | call test_integral_sin_x_squared_0_to_1() 25 | 26 | print *, "All tests completed." 27 | 28 | contains 29 | 30 | ! Test case 1: ∫ x^2 dx from 0 to 1 (Exact result = 1/3 ≈ 0.3333) 31 | subroutine test_integral_x_squared_0_to_1() 32 | real(dp) :: lower_bound, upper_bound, integral_result, expected 33 | integer :: panels_number 34 | lower_bound = 0.0_dp 35 | upper_bound = 1.0_dp 36 | panels_number = 1000000 37 | expected = 1.0_dp/3.0_dp 38 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 39 | call assert_test(integral_result, expected, "Test 1: ∫ x^2 dx from 0 to 1") 40 | end subroutine test_integral_x_squared_0_to_1 41 | 42 | ! Test case 2: ∫ x^2 dx from 0 to 2 (Exact result = 8/3 ≈ 2.6667) 43 | subroutine test_integral_x_squared_0_to_2() 44 | real(dp) :: lower_bound, upper_bound, integral_result, expected 45 | integer :: panels_number 46 | lower_bound = 0.0_dp 47 | upper_bound = 2.0_dp 48 | panels_number = 1000000 49 | expected = 8.0_dp/3.0_dp 50 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, f_x_squared) 51 | call assert_test(integral_result, expected, "Test 2: ∫ x^2 dx from 0 to 2") 52 | end subroutine test_integral_x_squared_0_to_2 53 | 54 | ! Test case 3: ∫ sin(x) dx from 0 to π (Exact result = 2) 55 | subroutine test_integral_sin_0_to_pi() 56 | real(dp) :: lower_bound, upper_bound, integral_result, expected 57 | integer :: panels_number 58 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 59 | lower_bound = 0.0_dp 60 | upper_bound = pi 61 | panels_number = 1000000 62 | expected = 2.0_dp 63 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, sin_function) 64 | call assert_test(integral_result, expected, "Test 3: ∫ sin(x) dx from 0 to π") 65 | end subroutine test_integral_sin_0_to_pi 66 | 67 | ! Test case 4: ∫ e^x dx from 0 to 1 (Exact result = e - 1 ≈ 1.7183) 68 | subroutine test_integral_e_x_0_to_1() 69 | real(dp) :: lower_bound, upper_bound, integral_result, expected 70 | integer :: panels_number 71 | lower_bound = 0.0_dp 72 | upper_bound = 1.0_dp 73 | panels_number = 1000000 74 | expected = exp(1.0_dp) - 1.0_dp 75 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, exp_function) 76 | call assert_test(integral_result, expected, "Test 4: ∫ e^x dx from 0 to 1") 77 | end subroutine test_integral_e_x_0_to_1 78 | 79 | ! Test case 5: ∫ (1/x) dx from 1 to e (Exact result = 1) 80 | subroutine test_integral_1_over_x_1_to_e() 81 | real(dp) :: lower_bound, upper_bound, integral_result, expected 82 | integer :: panels_number 83 | lower_bound = 1.0_dp 84 | upper_bound = exp(1.0_dp) 85 | panels_number = 1000000 86 | expected = 1.0_dp 87 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, log_function) 88 | call assert_test(integral_result, expected, "Test 5: ∫ (1/x) dx from 1 to e") 89 | end subroutine test_integral_1_over_x_1_to_e 90 | 91 | ! Test case 6: ∫ cos(x) dx from 0 to π/2 (Exact result = 1) 92 | subroutine test_integral_cos_0_to_pi_over_2() 93 | real(dp) :: lower_bound, upper_bound, integral_result, expected 94 | integer :: panels_number 95 | real(dp), parameter :: pi = 4.D0*DATAN(1.D0) ! Define Pi. Ensure maximum precision available on any architecture. 96 | lower_bound = 0.0_dp 97 | upper_bound = pi/2.0_dp 98 | panels_number = 1000000 99 | expected = 1.0_dp 100 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, cos_function) 101 | call assert_test(integral_result, expected, "Test 6: ∫ cos(x) dx from 0 to π/2") 102 | end subroutine test_integral_cos_0_to_pi_over_2 103 | 104 | ! Test case 7: ∫ x^3 dx from 0 to 1 (Exact result = 1/4 = 0.25) 105 | subroutine test_integral_x_cubed_0_to_1() 106 | real(dp) :: lower_bound, upper_bound, integral_result, expected 107 | integer :: panels_number 108 | lower_bound = 0.0_dp 109 | upper_bound = 1.0_dp 110 | panels_number = 1000000 111 | expected = 0.25_dp 112 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, f_x_cubed) 113 | call assert_test(integral_result, expected, "Test 7: ∫ x^3 dx from 0 to 1") 114 | end subroutine test_integral_x_cubed_0_to_1 115 | 116 | ! Test case 8: ∫ sin(x^2) dx from 0 to 1 (Approximate value) 117 | subroutine test_integral_sin_x_squared_0_to_1() 118 | real(dp) :: lower_bound, upper_bound, integral_result, expected 119 | integer :: panels_number 120 | lower_bound = 0.0_dp 121 | upper_bound = 1.0_dp 122 | panels_number = 1000000 123 | expected = 0.31026_dp ! Approximate value, you can adjust tolerance as needed 124 | call trapezoid(integral_result, lower_bound, upper_bound, panels_number, sin_squared_function) 125 | call assert_test(integral_result, expected, "Test 8: ∫ sin(x^2) dx from 0 to 1") 126 | end subroutine test_integral_sin_x_squared_0_to_1 127 | 128 | ! Function for x^2 129 | real(dp) function f_x_squared(x) 130 | real(dp), intent(in) :: x 131 | f_x_squared = x**2 132 | end function f_x_squared 133 | 134 | ! Function for e^x 135 | real(dp) function exp_function(x) 136 | real(dp), intent(in) :: x 137 | exp_function = exp(x) 138 | end function exp_function 139 | 140 | ! Function for 1/x 141 | real(dp) function log_function(x) 142 | real(dp), intent(in) :: x 143 | log_function = 1.0_dp/x 144 | end function log_function 145 | 146 | ! Function for cos(x) 147 | real(dp) function cos_function(x) 148 | real(dp), intent(in) :: x 149 | cos_function = cos(x) 150 | end function cos_function 151 | 152 | ! Function for x^3 153 | real(dp) function f_x_cubed(x) 154 | real(dp), intent(in) :: x 155 | f_x_cubed = x**3 156 | end function f_x_cubed 157 | 158 | ! Function for sin(x^2) 159 | real(dp) function sin_squared_function(x) 160 | real(dp), intent(in) :: x 161 | sin_squared_function = sin(x**2) 162 | end function sin_squared_function 163 | 164 | ! Function for sin(x) 165 | real(dp) function sin_function(x) 166 | real(dp), intent(in) :: x 167 | sin_function = sin(x) 168 | end function sin_function 169 | 170 | !> Subroutine to assert the test results 171 | subroutine assert_test(actual, expected, test_name) 172 | real(dp), intent(in) :: actual, expected 173 | character(len=*), intent(in) :: test_name 174 | real(dp), parameter :: tol = 1.0e-5_dp 175 | 176 | if (abs(actual - expected) < tol) then 177 | print *, test_name, " PASSED" 178 | else 179 | print *, test_name, " FAILED" 180 | print *, " Expected: ", expected 181 | print *, " Got: ", actual 182 | stop 1 183 | end if 184 | end subroutine assert_test 185 | 186 | end program test_trapezoidal_rule 187 | 188 | -------------------------------------------------------------------------------- /tests/searches/linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Linear Search algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #30 5 | !! https://github.com/TheAlgorithms/Fortran/pull/30 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the linear_search_module. 11 | 12 | program tests_linear_search 13 | use linear_search_module 14 | implicit none 15 | integer, dimension(:), allocatable :: array 16 | integer :: target, index, expected 17 | 18 | ! Run test cases 19 | call test_found() 20 | call test_not_found() 21 | call test_first_element() 22 | call test_last_element() 23 | call test_multiple_occurrences() 24 | call test_single_element_found() 25 | call test_single_element_not_found() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Target is found in the array 33 | subroutine test_found() 34 | array = (/30, 10, 20, 40, 55, 61, 72, 86, 97, 101/) 35 | target = 97 36 | expected = 9 37 | index = linear_search(array, target) 38 | call assert_test(index, expected, "Test 1: Target found in the array") 39 | end subroutine test_found 40 | 41 | ! Test case 2: Target is not found in the array 42 | subroutine test_not_found() 43 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/) 44 | target = 66 45 | expected = -1 46 | index = linear_search(array, target) 47 | call assert_test(index, expected, "Test 2: Target not found in the array") 48 | end subroutine test_not_found 49 | 50 | ! Test case 3: Target is the first element 51 | subroutine test_first_element() 52 | array = (/10, 20, 30, 40, 50/) 53 | target = array(1) 54 | expected = 1 55 | index = linear_search(array, target) 56 | call assert_test(index, expected, "Test 3: Target is the first element") 57 | end subroutine test_first_element 58 | 59 | ! Test case 4: Target is the last element 60 | subroutine test_last_element() 61 | array = (/10, 20, 30, 40, 50, 60, 70, 80/) 62 | target = array(size(array)) 63 | expected = size(array) 64 | index = linear_search(array, target) 65 | call assert_test(index, expected, "Test 4: Target is the last element") 66 | end subroutine test_last_element 67 | 68 | ! Test case 5: Multiple occurrences of the target 69 | subroutine test_multiple_occurrences() 70 | array = (/1, 2, 3, 2, 4, 2, 5, 2, 4/) 71 | target = 4 72 | expected = 5 73 | index = linear_search(array, target) 74 | call assert_test(index, expected, "Test 5: Target has multiple occurrences (first found)") 75 | end subroutine test_multiple_occurrences 76 | 77 | ! Test case 6: Single element found 78 | subroutine test_single_element_found() 79 | array = (/42/) 80 | target = 42 81 | expected = 1 82 | index = linear_search(array, target) 83 | call assert_test(index, expected, "Test 6: Single element found") 84 | end subroutine test_single_element_found 85 | 86 | ! Test case 7: Single element not found 87 | subroutine test_single_element_not_found() 88 | array = (/42/) 89 | target = 99 90 | expected = -1 91 | index = linear_search(array, target) 92 | call assert_test(index, expected, "Test 7: Single element not found") 93 | end subroutine test_single_element_not_found 94 | 95 | ! Test case 8: Empty array 96 | subroutine test_empty_array() 97 | if (allocated(array)) deallocate (array) 98 | allocate (array(0)) ! Empty array 99 | target = 1 100 | expected = -1 101 | index = linear_search(array, target) 102 | call assert_test(index, expected, "Test 8: Search in an empty array") 103 | end subroutine test_empty_array 104 | 105 | !> Subroutine to assert the test results 106 | subroutine assert_test(actual, expected, test_name) 107 | integer, intent(in) :: actual, expected 108 | character(len=*), intent(in) :: test_name 109 | 110 | if (actual == expected) then 111 | print *, test_name, " PASSED" 112 | else 113 | print *, test_name, " FAILED" 114 | print *, "Expected: ", expected 115 | print *, "Got: ", actual 116 | stop 1 117 | end if 118 | 119 | end subroutine assert_test 120 | 121 | end program tests_linear_search 122 | -------------------------------------------------------------------------------- /tests/searches/recursive_linear_search.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Recursive Linear Search algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #30 5 | !! https://github.com/TheAlgorithms/Fortran/pull/30 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the recursive_linear_search_module. 11 | 12 | program tests_recursive_linear_search 13 | use linear_search_module 14 | implicit none 15 | integer, dimension(:), allocatable :: array 16 | integer :: target, index, expected 17 | 18 | ! Run test cases 19 | call test_found() 20 | call test_not_found() 21 | call test_first_element() 22 | call test_last_element() 23 | call test_multiple_occurrences() 24 | call test_single_element_found() 25 | call test_single_element_not_found() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Target is found in the array 33 | subroutine test_found() 34 | array = (/30, 10, 20, 40, 55, 61, 72, 86, 97, 101/) 35 | target = 97 36 | expected = 9 37 | index = linear_search(array, target) 38 | call assert_test(index, expected, "Test 1: Target found in the array") 39 | end subroutine test_found 40 | 41 | ! Test case 2: Target is not found in the array 42 | subroutine test_not_found() 43 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/) 44 | target = 66 45 | expected = -1 46 | index = linear_search(array, target) 47 | call assert_test(index, expected, "Test 2: Target not found in the array") 48 | end subroutine test_not_found 49 | 50 | ! Test case 3: Target is the first element 51 | subroutine test_first_element() 52 | array = (/10, 20, 30, 40, 50/) 53 | target = array(1) 54 | expected = 1 55 | index = linear_search(array, target) 56 | call assert_test(index, expected, "Test 3: Target is the first element") 57 | end subroutine test_first_element 58 | 59 | ! Test case 4: Target is the last element 60 | subroutine test_last_element() 61 | array = (/10, 20, 30, 40, 50, 60, 70, 80/) 62 | target = array(size(array)) 63 | expected = size(array) 64 | index = linear_search(array, target) 65 | call assert_test(index, expected, "Test 4: Target is the last element") 66 | end subroutine test_last_element 67 | 68 | ! Test case 5: Multiple occurrences of the target 69 | subroutine test_multiple_occurrences() 70 | array = (/1, 2, 3, 2, 4, 2, 5, 2, 4/) 71 | target = 4 72 | expected = 5 73 | index = linear_search(array, target) 74 | call assert_test(index, expected, "Test 5: Target has multiple occurrences (first found)") 75 | end subroutine test_multiple_occurrences 76 | 77 | ! Test case 6: Single element found 78 | subroutine test_single_element_found() 79 | array = (/42/) 80 | target = 42 81 | expected = 1 82 | index = linear_search(array, target) 83 | call assert_test(index, expected, "Test 6: Single element found") 84 | end subroutine test_single_element_found 85 | 86 | ! Test case 7: Single element not found 87 | subroutine test_single_element_not_found() 88 | array = (/42/) 89 | target = 99 90 | expected = -1 91 | index = linear_search(array, target) 92 | call assert_test(index, expected, "Test 7: Single element not found") 93 | end subroutine test_single_element_not_found 94 | 95 | ! Test case 8: Empty array 96 | subroutine test_empty_array() 97 | if (allocated(array)) deallocate (array) 98 | allocate (array(0)) ! Empty array 99 | target = 1 100 | expected = -1 101 | index = linear_search(array, target) 102 | call assert_test(index, expected, "Test 8: Search in an empty array") 103 | end subroutine test_empty_array 104 | 105 | !> Subroutine to assert the test results 106 | subroutine assert_test(actual, expected, test_name) 107 | integer, intent(in) :: actual, expected 108 | character(len=*), intent(in) :: test_name 109 | 110 | if (actual == expected) then 111 | print *, test_name, " PASSED" 112 | else 113 | print *, test_name, " FAILED" 114 | print *, "Expected: ", expected 115 | print *, "Got: ", actual 116 | stop 1 117 | end if 118 | 119 | end subroutine assert_test 120 | 121 | end program tests_recursive_linear_search 122 | -------------------------------------------------------------------------------- /tests/searches/ternary_search_array.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Array-Based Ternary Search algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #30 5 | !! https://github.com/TheAlgorithms/Fortran/pull/30 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the array-based ternary_search module. 11 | 12 | program tests_ternary_search_array 13 | use ternary_search 14 | implicit none 15 | integer, dimension(:), allocatable :: sorted_array 16 | integer :: target, index, expected 17 | 18 | ! Run test cases 19 | call test_found() 20 | call test_not_found() 21 | call test_first_element() 22 | call test_last_element() 23 | call test_multiple_occurrences() 24 | call test_single_element_found() 25 | call test_single_element_not_found() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Target found 33 | subroutine test_found() 34 | sorted_array = (/1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25/) 35 | target = 21 36 | expected = 11 37 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 38 | call assert_test(index, expected, "Test 1: Target found in the array") 39 | end subroutine test_found 40 | 41 | ! Test case 2: Target not found 42 | subroutine test_not_found() 43 | sorted_array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12/) 44 | target = 110 45 | expected = -1 46 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 47 | call assert_test(index, -1, "Test 2: Target not found in the array") 48 | end subroutine test_not_found 49 | 50 | ! Test case 3: Target is the first element 51 | subroutine test_first_element() 52 | sorted_array = (/10, 20, 30, 40, 50, 60, 70, 80/) 53 | target = sorted_array(1) 54 | expected = 1 55 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 56 | call assert_test(index, expected, "Test 3: Target is the first element") 57 | end subroutine test_first_element 58 | 59 | ! Test case 4: Target is the last element 60 | subroutine test_last_element() 61 | sorted_array = (/100, 200, 300, 400, 500, 600, 700, 800, 900/) 62 | target = sorted_array(size(sorted_array)) 63 | expected = size(sorted_array) 64 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 65 | call assert_test(index, expected, "Test 4: Target is the last element") 66 | end subroutine test_last_element 67 | 68 | ! Test case 5: Multiple occurrences of the target 69 | subroutine test_multiple_occurrences() 70 | sorted_array = (/1, 1, 2, 3, 4, 4, 5, 5, 6, 7, 8, 8, 9, 10, 11, 12, 12/) 71 | target = 12 72 | expected = 16 73 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 74 | call assert_test(index, expected, "Test 5: Target has multiple occurrences (first found)") 75 | end subroutine test_multiple_occurrences 76 | 77 | ! Test case 6: Single element found 78 | subroutine test_single_element_found() 79 | sorted_array = (/59/) 80 | target = 59 81 | expected = 1 82 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 83 | call assert_test(index, expected, "Test 6: Single element found") 84 | end subroutine test_single_element_found 85 | 86 | ! Test case 7: Single element not found 87 | subroutine test_single_element_not_found() 88 | sorted_array = (/42/) 89 | target = 99 90 | expected = -1 91 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 92 | call assert_test(index, expected, "Test 7: Single element not found") 93 | end subroutine test_single_element_not_found 94 | 95 | ! Test case 8: Empty array 96 | subroutine test_empty_array() 97 | if (allocated(sorted_array)) deallocate (sorted_array) 98 | allocate (sorted_array(0)) ! Empty array 99 | target = 1 100 | expected = -1 101 | index = ternary_search_array(sorted_array, target, 1, size(sorted_array)) 102 | call assert_test(index, expected, "Test 8: Search in an empty array") 103 | end subroutine test_empty_array 104 | 105 | !> Subroutine to assert the test results 106 | subroutine assert_test(actual, expected, test_name) 107 | integer, intent(in) :: actual, expected 108 | character(len=*), intent(in) :: test_name 109 | 110 | if (actual == expected) then 111 | print *, test_name, " PASSED" 112 | else 113 | print *, test_name, " FAILED" 114 | print *, "Expected: ", expected 115 | print *, "Got: ", actual 116 | stop 1 117 | end if 118 | 119 | end subroutine assert_test 120 | 121 | end program tests_ternary_search_array 122 | -------------------------------------------------------------------------------- /tests/searches/ternary_search_function.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Function-Based Ternary Search algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #30 5 | !! https://github.com/TheAlgorithms/Fortran/pull/30 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides test cases to validate the function-based ternary search algorithms for known functions. 11 | 12 | program tests_ternary_search_function 13 | use ternary_search 14 | implicit none 15 | real(8) :: tol, left, right, result, expected 16 | 17 | tol = 1.0d-6 18 | left = -100.0d0 19 | right = 100.0d0 20 | 21 | ! Run test cases 22 | call test_find_min_parabola() 23 | call test_find_max_negative_parabola() 24 | call test_find_min_custom_function() 25 | 26 | print *, "All tests completed." 27 | 28 | contains 29 | 30 | ! Test case 1: Find minimum of a parabola (f(x) = x^2) 31 | subroutine test_find_min_parabola() 32 | result = ternary_search_minimum(parabola, left, right, tol) 33 | expected = 0.0d0 34 | call assert_test(abs(result), expected, "Test 1: Find minimum of f(x) = x^2") 35 | end subroutine test_find_min_parabola 36 | 37 | ! Test case 2: Find maximum of a negative parabola (f(x) = -x^2) 38 | subroutine test_find_max_negative_parabola() 39 | result = ternary_search_maximum(negative_parabola, left, right, tol) 40 | expected = 0.0d0 41 | call assert_test(abs(result), expected, "Test 2: Find maximum of f(x) = -x^2") 42 | end subroutine test_find_max_negative_parabola 43 | 44 | ! Test case 3: Find minimum of a custom unimodal function 45 | subroutine test_find_min_custom_function() 46 | result = ternary_search_minimum(custom_unimodal_function, left, right, tol) 47 | expected = 50.0d0 48 | call assert_test(result, 50.0d0, "Test 3: Find minimum of custom unimodal function") 49 | end subroutine test_find_min_custom_function 50 | 51 | !> Subroutine to assert the test results 52 | subroutine assert_test(actual, expected, test_name) 53 | real(8), intent(in) :: actual, expected 54 | character(len=*), intent(in) :: test_name 55 | 56 | if (abs(actual - expected) < tol) then 57 | print *, test_name, " PASSED" 58 | else 59 | print *, test_name, " FAILED" 60 | print *, "Expected: ", expected 61 | print *, "Got: ", actual 62 | stop 1 63 | end if 64 | 65 | end subroutine assert_test 66 | 67 | ! Parabola function: f(x) = x^2 68 | real(8) function parabola(x) 69 | real(8), intent(in) :: x 70 | parabola = x**2 71 | end function parabola 72 | 73 | ! Negative parabola function: f(x) = -x^2 74 | real(8) function negative_parabola(x) 75 | real(8), intent(in) :: x 76 | negative_parabola = -x**2 77 | end function negative_parabola 78 | 79 | ! Custom unimodal function: A function with a known minimum at x = 50 80 | real(8) function custom_unimodal_function(x) 81 | real(8), intent(in) :: x 82 | custom_unimodal_function = (x - 50.0d0)**2 + 100.0d0 83 | end function custom_unimodal_function 84 | 85 | end program tests_ternary_search_function 86 | -------------------------------------------------------------------------------- /tests/sorts/bubble_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Bubble Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #29 5 | !! https://github.com/TheAlgorithms/Fortran/pull/29 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program tests the bubble_sort_module for correct sorting behavior. 11 | 12 | program tests_bubble_sort 13 | use bubble_sort_module 14 | implicit none 15 | real, dimension(:), allocatable :: array, expected 16 | 17 | ! Run test cases 18 | call test_sorted_array() 19 | call test_reverse_sorted_array() 20 | call test_unsorted_array() 21 | call test_array_with_repeated_elements() 22 | call test_array_with_identical_elements() 23 | call test_single_element_array() 24 | call test_empty_array() 25 | 26 | print *, "All tests completed." 27 | 28 | contains 29 | 30 | ! Test case 1: Already sorted array 31 | subroutine test_sorted_array() 32 | array = (/1.0, 2.0, 3.0, 4.0, 5.0/) 33 | expected = array 34 | call run_test(array, expected, "Test 1: Already sorted array") 35 | end subroutine test_sorted_array 36 | 37 | ! Test case 2: Reverse sorted array 38 | subroutine test_reverse_sorted_array() 39 | array = (/5.0, 4.0, 3.0, 2.0, 1.0/) 40 | expected = (/1.0, 2.0, 3.0, 4.0, 5.0/) 41 | call run_test(array, expected, "Test 2: Reverse sorted array") 42 | end subroutine test_reverse_sorted_array 43 | 44 | ! Test case 3: Unsorted array 45 | subroutine test_unsorted_array() 46 | array = (/3.5, 1.2, 4.8, 2.7, 5.0/) 47 | expected = (/1.2, 2.7, 3.5, 4.8, 5.0/) 48 | call run_test(array, expected, "Test 3: Unsorted array") 49 | end subroutine test_unsorted_array 50 | 51 | ! Test case 4: Array with repeated elements 52 | subroutine test_array_with_repeated_elements() 53 | array = (/3.0, 1.0, 2.0, 3.0, 4.0, 3.0/) 54 | expected = (/1.0, 2.0, 3.0, 3.0, 3.0, 4.0/) 55 | call run_test(array, expected, "Test 4: Array with repeated elements") 56 | end subroutine test_array_with_repeated_elements 57 | 58 | ! Test case 5: Array with identical elements 59 | subroutine test_array_with_identical_elements() 60 | array = (/7.0, 7.0, 7.0, 7.0, 7.0/) 61 | expected = array 62 | call run_test(array, expected, "Test 5: Array with identical elements") 63 | end subroutine test_array_with_identical_elements 64 | 65 | ! Test case 6: Single element array 66 | subroutine test_single_element_array() 67 | array = (/42.0/) 68 | expected = array 69 | call run_test(array, expected, "Test 6: Single element array") 70 | end subroutine test_single_element_array 71 | 72 | ! Test case 7: Empty array 73 | subroutine test_empty_array() 74 | if (allocated(array)) deallocate (array) 75 | if (allocated(expected)) deallocate (expected) 76 | allocate (array(0)) 77 | allocate (expected(0)) 78 | call run_test(array, expected, "Test 7: Empty array") 79 | end subroutine test_empty_array 80 | 81 | !> Subroutine to run the bubble sort test 82 | subroutine run_test(array, expected, test_name) 83 | real, dimension(:), intent(inout) :: array 84 | real, dimension(:), intent(in) :: expected 85 | character(len=*), intent(in) :: test_name 86 | real :: tolerance 87 | 88 | ! Call bubble_sort in module 89 | call bubble_sort(array) 90 | 91 | ! Set an appropriate tolerance value 92 | tolerance = 1.0e-6 93 | 94 | ! Assert if the sorted values are sufficiently close to the expected array otherwise report failure 95 | if (all(abs(array - expected) < tolerance)) then 96 | print *, test_name, " PASSED" 97 | else 98 | print *, test_name, " FAILED" 99 | print *, "Expected: ", expected 100 | print *, "Got: ", array 101 | stop 1 102 | end if 103 | 104 | end subroutine run_test 105 | 106 | end program tests_bubble_sort 107 | 108 | -------------------------------------------------------------------------------- /tests/sorts/gnome_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Gnome Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #9 5 | !! https://github.com/TheAlgorithms/Fortran/pull/9 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the gnome_sort_module. 11 | 12 | program tests_gnome_sort 13 | 14 | use gnome_sort_module 15 | implicit none 16 | integer, dimension(:), allocatable :: array, expected 17 | 18 | ! Run test cases 19 | call test_repeated_elements() 20 | call test_already_sorted() 21 | call test_reverse_sorted() 22 | call test_negative_numbers() 23 | call test_single_element() 24 | call test_identical_elements() 25 | call test_alternating_values() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Array with repeated elements 33 | subroutine test_repeated_elements() 34 | array = (/5, 3, 8, 3, 1, 5, 7, 5, 10, 7, 3, 1/) 35 | expected = (/1, 1, 3, 3, 3, 5, 5, 5, 7, 7, 8, 10/) 36 | call run_test(array, expected, "Test 1: Array with repeated elements") 37 | end subroutine test_repeated_elements 38 | 39 | ! Test case 2: Already sorted array 40 | subroutine test_already_sorted() 41 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13/) 42 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13/) 43 | call run_test(array, expected, "Test 2: Already sorted array") 44 | end subroutine test_already_sorted 45 | 46 | ! Test case 3: Reverse sorted array 47 | subroutine test_reverse_sorted() 48 | array = (/11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1/) 49 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/) 50 | call run_test(array, expected, "Test 3: Reverse sorted array") 51 | end subroutine test_reverse_sorted 52 | 53 | ! Test case 4: Array with all negative numbers 54 | subroutine test_negative_numbers() 55 | array = (/-1, -5, -4, -7, -2, -1, -1, -9, -2/) 56 | expected = (/-9, -7, -5, -4, -2, -2, -1, -1, -1/) 57 | call run_test(array, expected, "Test 4: Array with all negative numbers") 58 | end subroutine test_negative_numbers 59 | 60 | ! Test case 5: Single element array 61 | subroutine test_single_element() 62 | array = (/73/) 63 | expected = (/73/) 64 | call run_test(array, expected, "Test 5: Single element array") 65 | end subroutine test_single_element 66 | 67 | ! Test case 6: Array with identical elements 68 | subroutine test_identical_elements() 69 | array = (/8, 8, 8, 8, 8/) 70 | expected = (/8, 8, 8, 8, 8/) 71 | call run_test(array, expected, "Test 6: Array with identical elements") 72 | end subroutine test_identical_elements 73 | 74 | ! Test case 7: Array with alternating high and low values 75 | subroutine test_alternating_values() 76 | array = (/1, 999, 2, 600, 3, 950/) 77 | expected = (/1, 2, 3, 600, 950, 999/) 78 | call run_test(array, expected, "Test 7: Array with alternating high and low values") 79 | end subroutine test_alternating_values 80 | 81 | ! Test case 8: Empty array 82 | subroutine test_empty_array() 83 | if (allocated(array)) deallocate (array) 84 | if (allocated(expected)) deallocate (expected) 85 | allocate (array(0)) 86 | allocate (expected(0)) 87 | call run_test(array, expected, "Test 8: Empty array") 88 | end subroutine test_empty_array 89 | 90 | !> Subroutine to run the heap sort test 91 | subroutine run_test(array, expected, test_name) 92 | integer, dimension(:), intent(inout) :: array 93 | integer, dimension(:), intent(in) :: expected 94 | character(len=*), intent(in) :: test_name 95 | 96 | ! Call gnome_sort in module 97 | call gnome_sort(array) 98 | 99 | ! Assert that the sorted array matches the expected array otherwise report failure for ctest 100 | if (all(array == expected)) then 101 | print *, test_name, " PASSED" 102 | else 103 | print *, test_name, " FAILED" 104 | print *, "Expected: ", expected 105 | print *, "Got: ", array 106 | stop 1 107 | end if 108 | 109 | end subroutine run_test 110 | 111 | end program tests_gnome_sort 112 | -------------------------------------------------------------------------------- /tests/sorts/heap_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Heap Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #8 5 | !! https://github.com/TheAlgorithms/Fortran/pull/8 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the heap_sort_module. 11 | 12 | program tests_heap_sort 13 | 14 | use heap_sort_module 15 | implicit none 16 | integer, dimension(:), allocatable :: array, expected 17 | 18 | ! Run test cases 19 | call test_repeated_elements() 20 | call test_already_sorted() 21 | call test_reverse_sorted() 22 | call test_negative_numbers() 23 | call test_single_element() 24 | call test_identical_elements() 25 | call test_alternating_values() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Array with repeated elements 33 | subroutine test_repeated_elements() 34 | array = (/5, 3, 8, 3, 1, 5, 7, 5, 10, 7, 3, 1/) 35 | expected = (/1, 1, 3, 3, 3, 5, 5, 5, 7, 7, 8, 10/) 36 | call run_test(array, expected, "Test 1: Array with repeated elements") 37 | end subroutine test_repeated_elements 38 | 39 | ! Test case 2: Already sorted array 40 | subroutine test_already_sorted() 41 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/) 42 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/) 43 | call run_test(array, expected, "Test 2: Already sorted array") 44 | end subroutine test_already_sorted 45 | 46 | ! Test case 3: Reverse sorted array 47 | subroutine test_reverse_sorted() 48 | array = (/9, 8, 7, 6, 5, 4, 3, 2, 1/) 49 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9/) 50 | call run_test(array, expected, "Test 3: Reverse sorted array") 51 | end subroutine test_reverse_sorted 52 | 53 | ! Test case 4: Array with all negative numbers 54 | subroutine test_negative_numbers() 55 | array = (/-110, -550, -430, -700, -20, -10, -150, -90, -250/) 56 | expected = (/-700, -550, -430, -250, -150, -110, -90, -20, -10/) 57 | call run_test(array, expected, "Test 4: Array with all negative numbers") 58 | end subroutine test_negative_numbers 59 | 60 | ! Test case 5: Single element array 61 | subroutine test_single_element() 62 | array = (/43/) 63 | expected = (/43/) 64 | call run_test(array, expected, "Test 5: Single element array") 65 | end subroutine test_single_element 66 | 67 | ! Test case 6: Array with identical elements 68 | subroutine test_identical_elements() 69 | array = (/7, 7, 7, 7, 7/) 70 | expected = (/7, 7, 7, 7, 7/) 71 | call run_test(array, expected, "Test 6: Array with identical elements") 72 | end subroutine test_identical_elements 73 | 74 | ! Test case 7: Array with alternating high and low values 75 | subroutine test_alternating_values() 76 | array = (/1, 1000, 2, 999, 3, 998/) 77 | expected = (/1, 2, 3, 998, 999, 1000/) 78 | call run_test(array, expected, "Test 7: Array with alternating high and low values") 79 | end subroutine test_alternating_values 80 | 81 | ! Test case 8: Empty array 82 | subroutine test_empty_array() 83 | if (allocated(array)) deallocate (array) 84 | if (allocated(expected)) deallocate (expected) 85 | allocate (array(0)) 86 | allocate (expected(0)) 87 | call run_test(array, expected, "Test 8: Empty array") 88 | end subroutine test_empty_array 89 | 90 | !> Subroutine to run the heap sort test 91 | subroutine run_test(array, expected, test_name) 92 | integer, dimension(:), intent(inout) :: array 93 | integer, dimension(:), intent(in) :: expected 94 | character(len=*), intent(in) :: test_name 95 | integer :: n 96 | 97 | n = size(array) 98 | 99 | ! Call heap_sort in module 100 | call heap_sort(array, n) 101 | 102 | ! Assert that the sorted array matches the expected array otherwise report failure for ctest 103 | if (all(array == expected)) then 104 | print *, test_name, " PASSED" 105 | else 106 | print *, test_name, " FAILED" 107 | print *, "Expected: ", expected 108 | print *, "Got: ", array 109 | stop 1 110 | end if 111 | 112 | end subroutine run_test 113 | 114 | end program tests_heap_sort 115 | -------------------------------------------------------------------------------- /tests/sorts/merge_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Merge Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #7 5 | !! https://github.com/TheAlgorithms/Fortran/pull/7 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the merge_sort_module. 11 | 12 | program tests_merge_sort 13 | 14 | use merge_sort_module 15 | implicit none 16 | integer, dimension(:), allocatable :: array, expected 17 | 18 | ! Run test cases 19 | call test_repeated_elements() 20 | call test_already_sorted() 21 | call test_reverse_sorted() 22 | call test_negative_numbers() 23 | call test_single_element() 24 | call test_identical_elements() 25 | call test_alternating_values() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Array with repeated elements 33 | subroutine test_repeated_elements() 34 | array = (/4, 2, 7, 3, 1, 4, 9, 5, 10, 9, 2, 1/) 35 | expected = (/1, 1, 2, 2, 3, 4, 4, 5, 7, 9, 9, 10/) 36 | call run_test(array, expected, "Test 1: Array with repeated elements") 37 | end subroutine test_repeated_elements 38 | 39 | ! Test case 2: Already sorted array 40 | subroutine test_already_sorted() 41 | array = (/1, 2, 3, 4, 5, 6, 7, 8/) 42 | expected = (/1, 2, 3, 4, 5, 6, 7, 8/) 43 | call run_test(array, expected, "Test 2: Already sorted array") 44 | end subroutine test_already_sorted 45 | 46 | ! Test case 3: Reverse sorted array 47 | subroutine test_reverse_sorted() 48 | array = (/8, 7, 6, 5, 4, 3, 2, 1/) 49 | expected = (/1, 2, 3, 4, 5, 6, 7, 8/) 50 | call run_test(array, expected, "Test 3: Reverse sorted array") 51 | end subroutine test_reverse_sorted 52 | 53 | ! Test case 4: Array with all negative numbers 54 | subroutine test_negative_numbers() 55 | array = (/-11, -55, -43, -70, -2, -1, -15, -9/) 56 | expected = (/-70, -55, -43, -15, -11, -9, -2, -1/) 57 | call run_test(array, expected, "Test 4: Array with all negative numbers") 58 | end subroutine test_negative_numbers 59 | 60 | ! Test case 5: Single element array 61 | subroutine test_single_element() 62 | array = (/62/) 63 | expected = (/62/) 64 | call run_test(array, expected, "Test 5: Single element array") 65 | end subroutine test_single_element 66 | 67 | ! Test case 6: Array with identical elements 68 | subroutine test_identical_elements() 69 | array = (/4, 4, 4, 4, 4/) 70 | expected = (/4, 4, 4, 4, 4/) 71 | call run_test(array, expected, "Test 6: Array with identical elements") 72 | end subroutine test_identical_elements 73 | 74 | ! Test case 7: Array with alternating high and low values 75 | subroutine test_alternating_values() 76 | array = (/10, 2000, 20, 888, 30, 798/) 77 | expected = (/10, 20, 30, 798, 888, 2000/) 78 | call run_test(array, expected, "Test 7: Array with alternating high and low values") 79 | end subroutine test_alternating_values 80 | 81 | ! Test case 8: Empty array 82 | subroutine test_empty_array() 83 | if (allocated(array)) deallocate (array) 84 | if (allocated(expected)) deallocate (expected) 85 | allocate (array(0)) 86 | allocate (expected(0)) 87 | call run_test(array, expected, "Test 8: Empty array") 88 | end subroutine test_empty_array 89 | 90 | !> Subroutine to run the merge sort test 91 | subroutine run_test(array, expected, test_name) 92 | integer, dimension(:), intent(inout) :: array 93 | integer, dimension(:), intent(in) :: expected 94 | character(len=*), intent(in) :: test_name 95 | integer :: n 96 | 97 | n = size(array) 98 | 99 | ! Call merge_sort in module 100 | call merge_sort(array, n) 101 | 102 | ! Assert that the sorted array matches the expected array otherwise report failure for ctest 103 | if (all(array == expected)) then 104 | print *, test_name, " PASSED" 105 | else 106 | print *, test_name, " FAILED" 107 | print *, "Expected: ", expected 108 | print *, "Got: ", array 109 | stop 1 110 | end if 111 | 112 | end subroutine run_test 113 | 114 | end program tests_merge_sort 115 | -------------------------------------------------------------------------------- /tests/sorts/quick_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Quick Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #10 5 | !! https://github.com/TheAlgorithms/Fortran/pull/10 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the quick_sort_module. 11 | 12 | program tests_quick_sort 13 | 14 | use quick_sort_module 15 | implicit none 16 | integer, dimension(:), allocatable :: array, expected 17 | 18 | ! Run test cases 19 | call test_repeated_elements() 20 | call test_already_sorted() 21 | call test_reverse_sorted() 22 | call test_negative_numbers() 23 | call test_single_element() 24 | call test_identical_elements() 25 | call test_alternating_values() 26 | call test_empty_array() 27 | 28 | print *, "All tests completed." 29 | 30 | contains 31 | 32 | ! Test case 1: Array with repeated elements 33 | subroutine test_repeated_elements() 34 | array = (/5, 3, 8, 3, 1, 5, 7, 5, 10, 7, 3, 1/) 35 | expected = (/1, 1, 3, 3, 3, 5, 5, 5, 7, 7, 8, 10/) 36 | call run_test(array, expected, "Test 1: Array with repeated elements") 37 | end subroutine test_repeated_elements 38 | 39 | ! Test case 2: Already sorted array 40 | subroutine test_already_sorted() 41 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12/) 42 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12/) 43 | call run_test(array, expected, "Test 2: Already sorted array") 44 | end subroutine test_already_sorted 45 | 46 | ! Test case 3: Reverse sorted array 47 | subroutine test_reverse_sorted() 48 | array = (/10, 9, 8, 7, 6, 5, 4, 3, 2, 1/) 49 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/) 50 | call run_test(array, expected, "Test 3: Reverse sorted array") 51 | end subroutine test_reverse_sorted 52 | 53 | ! Test case 4: Array with all negative numbers 54 | subroutine test_negative_numbers() 55 | array = (/-1, -5, -4, -7, -2, -1, -1, -9, -2/) 56 | expected = (/-9, -7, -5, -4, -2, -2, -1, -1, -1/) 57 | call run_test(array, expected, "Test 4: Array with all negative numbers") 58 | end subroutine test_negative_numbers 59 | 60 | ! Test case 5: Single element array 61 | subroutine test_single_element() 62 | array = (/23/) 63 | expected = (/23/) 64 | call run_test(array, expected, "Test 5: Single element array") 65 | end subroutine test_single_element 66 | 67 | ! Test case 6: Array with identical elements 68 | subroutine test_identical_elements() 69 | array = (/-9, -9, -9, -9, -9/) 70 | expected = (/-9, -9, -9, -9, -9/) 71 | call run_test(array, expected, "Test 6: Array with identical elements") 72 | end subroutine test_identical_elements 73 | 74 | ! Test case 7: Array with alternating high and low values 75 | subroutine test_alternating_values() 76 | array = (/1, 999, 2, 600, 3, 950/) 77 | expected = (/1, 2, 3, 600, 950, 999/) 78 | call run_test(array, expected, "Test 7: Array with alternating high and low values") 79 | end subroutine test_alternating_values 80 | 81 | ! Test case 8: Empty array 82 | subroutine test_empty_array() 83 | if (allocated(array)) deallocate (array) 84 | if (allocated(expected)) deallocate (expected) 85 | allocate (array(0)) 86 | allocate (expected(0)) 87 | call run_test(array, expected, "Test 8: Empty array") 88 | end subroutine test_empty_array 89 | 90 | !> Subroutine to run the quick sort test 91 | subroutine run_test(array, expected, test_name) 92 | integer, dimension(:), intent(inout) :: array 93 | integer, dimension(:), intent(in) :: expected 94 | character(len=*), intent(in) :: test_name 95 | integer :: n 96 | 97 | n = size(array) 98 | 99 | ! Call quick_sort in module 100 | call quick_sort(array, 1, n) ! (1: low bound , n: high bound) of the array 101 | 102 | ! Assert that the sorted array matches the expected array otherwise report failure for ctest 103 | if (all(array == expected)) then 104 | print *, test_name, " PASSED" 105 | else 106 | print *, test_name, " FAILED" 107 | print *, "Expected: ", expected 108 | print *, "Got: ", array 109 | stop 1 110 | end if 111 | 112 | end subroutine run_test 113 | 114 | end program tests_quick_sort 115 | -------------------------------------------------------------------------------- /tests/sorts/radix_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Radix Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #11 5 | !! https://github.com/TheAlgorithms/Fortran/pull/11 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program provides additional test cases to validate the radix_sort_module. 11 | !! The radix (base) parameter affects the internal digit processing for sorting, but the final output is always in decimal form. 12 | 13 | program tests_radix_sort 14 | use radix_sort_module 15 | implicit none 16 | integer, dimension(:), allocatable :: array, expected 17 | integer, parameter :: base10 = 10, base2 = 2, base16 = 16 18 | 19 | ! Run test cases 20 | call test_base10() 21 | call test_base2() 22 | call test_base16() 23 | call test_repeated_elements() 24 | call test_already_sorted() 25 | call test_reverse_sorted() 26 | call test_negative_numbers() 27 | call test_single_element() 28 | call test_identical_elements() 29 | call test_alternating_values() 30 | call test_empty_array() 31 | 32 | print *, "All tests completed." 33 | 34 | contains 35 | 36 | ! Test 1: sort with Base 10 37 | subroutine test_base10() 38 | array = (/170, 45, 75, 90, 802, 24, 2, 66, 15, 40/) 39 | expected = (/2, 15, 24, 40, 45, 66, 75, 90, 170, 802/) 40 | call run_test(array, expected, base10, "Test 1: Base 10") 41 | end subroutine test_base10 42 | 43 | ! Test 2: Sort with Base 2 44 | subroutine test_base2() 45 | array = (/10, 13, 9, 14, 2, 5, 15, 6, 8, 1/) ! Binary values as decimal 46 | expected = (/1, 2, 5, 6, 8, 9, 10, 13, 14, 15/) 47 | call run_test(array, expected, base2, "Test 2 Base 2") 48 | end subroutine test_base2 49 | 50 | ! Test 3: Sorth with Base 16 51 | subroutine test_base16() 52 | array = (/171, 31, 61, 255, 16, 5, 211, 42, 180, 0/) ! Hexadecimal values as decimal 53 | expected = (/0, 5, 16, 31, 42, 61, 171, 180, 211, 255/) 54 | call run_test(array, expected, base16, "Test 3: Base 16") 55 | end subroutine test_base16 56 | 57 | ! Test case 4: Array with repeated elements 58 | subroutine test_repeated_elements() 59 | array = (/5, 3, 8, 3, 1, 5, 7, 5, 10, 7, 3, 1/) 60 | expected = (/1, 1, 3, 3, 3, 5, 5, 5, 7, 7, 8, 10/) 61 | call run_test(array, expected, base10, "Test 4: Array with repeated elements") 62 | end subroutine test_repeated_elements 63 | 64 | ! Test case 5: Already sorted array 65 | subroutine test_already_sorted() 66 | array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13/) 67 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13/) 68 | call run_test(array, expected, base10, "Test 5: Already sorted array") 69 | end subroutine test_already_sorted 70 | 71 | ! Test 6: Reverse sorted array 72 | subroutine test_reverse_sorted() 73 | array = (/11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1/) 74 | expected = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/) 75 | call run_test(array, expected, base10, "Test 6: Reverse sorted array") 76 | end subroutine test_reverse_sorted 77 | 78 | ! Test 7: Array with all negative numbers (Note: Radix Sort only handles non-negative integers) 79 | subroutine test_negative_numbers() 80 | array = (/-1, -5, -3, -7, -2, -12, -15, -4/) 81 | expected = (/-1, -5, -3, -7, -2, -12, -15, -4/) 82 | call run_test(array, expected, base10, "Test 7: Array with all negative numbers (handled as base 10)") 83 | end subroutine test_negative_numbers 84 | 85 | ! Test 8: Single element array 86 | subroutine test_single_element() 87 | array = (/93/) 88 | expected = (/93/) 89 | call run_test(array, expected, base10, "Test 8: Single element array") 90 | end subroutine test_single_element 91 | 92 | ! Test 9: Array with identical elements 93 | subroutine test_identical_elements() 94 | array = (/8, 8, 8, 8, 8/) 95 | expected = (/8, 8, 8, 8, 8/) 96 | call run_test(array, expected, base10, "Test 9: Array with identical elements") 97 | end subroutine test_identical_elements 98 | 99 | ! Test 10: Array with alternating high and low values 100 | subroutine test_alternating_values() 101 | array = (/1, 999, 2, 600, 3, 950/) 102 | expected = (/1, 2, 3, 600, 950, 999/) 103 | call run_test(array, expected, base10, "Test 10: Array with alternating high and low values") 104 | end subroutine test_alternating_values 105 | 106 | ! Test 11: Empty array 107 | subroutine test_empty_array() 108 | if (allocated(array)) deallocate (array) 109 | if (allocated(expected)) deallocate (expected) 110 | allocate (array(0)) 111 | allocate (expected(0)) 112 | call run_test(array, expected, base10, "Test 11: Empty array") 113 | end subroutine test_empty_array 114 | 115 | !> Subroutine to run the radix sort test 116 | subroutine run_test(array, expected, base, test_name) 117 | integer, dimension(:), intent(inout) :: array 118 | integer, dimension(:), intent(in) :: expected 119 | integer, intent(in) :: base 120 | character(len=*), intent(in) :: test_name 121 | integer :: n 122 | 123 | n = size(array) 124 | 125 | ! Call radix_sort in module 126 | ! The parameters specify the array to sort, its size, and the base for sorting. 127 | call radix_sort(array, n, base) 128 | 129 | ! Assert that the sorted array matches the expected array otherwise report failure for ctest 130 | if (all(array == expected)) then 131 | print *, test_name, " PASSED" 132 | else 133 | print *, test_name, " FAILED" 134 | print *, "Expected: ", expected 135 | print *, "Got: ", array 136 | stop 1 137 | end if 138 | 139 | end subroutine run_test 140 | 141 | end program tests_radix_sort 142 | -------------------------------------------------------------------------------- /tests/sorts/recursive_bubbe_sort.f90: -------------------------------------------------------------------------------- 1 | !> Test program for the Bubble Sort algorithm 2 | !! 3 | !! Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) 4 | !! in Pull Request: #29 5 | !! https://github.com/TheAlgorithms/Fortran/pull/29 6 | !! 7 | !! Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request 8 | !! addressing bugs/corrections to this file. Thank you! 9 | !! 10 | !! This program tests the recursive_bubble_sort_module for correct sorting behavior. 11 | 12 | program tests_recursive_bubble_sort 13 | use recursive_bubble_sort_module 14 | implicit none 15 | real, dimension(:), allocatable :: array, expected 16 | 17 | ! Run test cases 18 | call test_sorted_array() 19 | call test_reverse_sorted_array() 20 | call test_unsorted_array() 21 | call test_array_with_repeated_elements() 22 | call test_array_with_identical_elements() 23 | call test_single_element_array() 24 | call test_empty_array() 25 | 26 | print *, "All tests completed." 27 | 28 | contains 29 | 30 | ! Test case 1: Already sorted array 31 | subroutine test_sorted_array() 32 | array = (/1.0, 2.0, 3.0, 4.0, 5.0/) 33 | expected = array 34 | call run_test(array, expected, "Test 1: Already sorted array") 35 | end subroutine test_sorted_array 36 | 37 | ! Test case 2: Reverse sorted array 38 | subroutine test_reverse_sorted_array() 39 | array = (/5.0, 4.0, 3.0, 2.0, 1.0/) 40 | expected = (/1.0, 2.0, 3.0, 4.0, 5.0/) 41 | call run_test(array, expected, "Test 2: Reverse sorted array") 42 | end subroutine test_reverse_sorted_array 43 | 44 | ! Test case 3: Unsorted array 45 | subroutine test_unsorted_array() 46 | array = (/3.5, 1.2, 4.8, 2.7, 5.0/) 47 | expected = (/1.2, 2.7, 3.5, 4.8, 5.0/) 48 | call run_test(array, expected, "Test 3: Unsorted array") 49 | end subroutine test_unsorted_array 50 | 51 | ! Test case 4: Array with repeated elements 52 | subroutine test_array_with_repeated_elements() 53 | array = (/3.0, 1.0, 2.0, 3.0, 4.0, 3.0/) 54 | expected = (/1.0, 2.0, 3.0, 3.0, 3.0, 4.0/) 55 | call run_test(array, expected, "Test 4: Array with repeated elements") 56 | end subroutine test_array_with_repeated_elements 57 | 58 | ! Test case 5: Array with identical elements 59 | subroutine test_array_with_identical_elements() 60 | array = (/7.0, 7.0, 7.0, 7.0, 7.0/) 61 | expected = array 62 | call run_test(array, expected, "Test 5: Array with identical elements") 63 | end subroutine test_array_with_identical_elements 64 | 65 | ! Test case 6: Single element array 66 | subroutine test_single_element_array() 67 | array = (/42.0/) 68 | expected = array 69 | call run_test(array, expected, "Test 6: Single element array") 70 | end subroutine test_single_element_array 71 | 72 | ! Test case 7: Empty array 73 | subroutine test_empty_array() 74 | if (allocated(array)) deallocate (array) 75 | if (allocated(expected)) deallocate (expected) 76 | allocate (array(0)) 77 | allocate (expected(0)) 78 | call run_test(array, expected, "Test 7: Empty array") 79 | end subroutine test_empty_array 80 | 81 | !> Subroutine to run the bubble sort test 82 | subroutine run_test(array, expected, test_name) 83 | real, dimension(:), intent(inout) :: array 84 | real, dimension(:), intent(in) :: expected 85 | character(len=*), intent(in) :: test_name 86 | real :: tolerance 87 | integer :: n 88 | 89 | n = size(array) 90 | 91 | ! Call bubble_sort in module 92 | call recursive_bubble_sort(array, n) 93 | 94 | ! Set an appropriate tolerance value 95 | tolerance = 1.0e-6 96 | 97 | ! Assert if the sorted values are sufficiently close to the expected array otherwise report failure 98 | if (all(abs(array - expected) < tolerance)) then 99 | print *, test_name, " PASSED" 100 | else 101 | print *, test_name, " FAILED" 102 | print *, "Expected: ", expected 103 | print *, "Got: ", array 104 | stop 1 105 | end if 106 | 107 | end subroutine run_test 108 | 109 | end program tests_recursive_bubble_sort 110 | 111 | --------------------------------------------------------------------------------