├── .gitattributes ├── .gitignore ├── .hlint.yaml ├── .stylish-haskell.yaml ├── .yamllint ├── LICENSE ├── README.md ├── bash └── release ├── cabal.project └── fast-arithmetic ├── .atsfmt.toml ├── .ctags ├── .ghci ├── .hspec ├── CHANGELOG.md ├── LICENSE ├── README.md ├── TODO.md ├── ats-src ├── bench.dats ├── combinatorics.dats ├── combinatorics.sats ├── number-theory.dats ├── number-theory.sats ├── numerics-internal.dats ├── numerics.dats └── numerics.sats ├── atspkg.dhall ├── bench.dhall ├── bench └── Bench.hs ├── common └── Numeric │ └── Haskell.hs ├── fast-arithmetic.cabal ├── include └── fast_arithmetic.h ├── lib.dhall ├── pkg.dhall ├── source.dhall ├── src └── Numeric │ ├── Combinatorics.hs │ ├── Common.hs │ └── NumberTheory.hs └── test └── Spec.hs /.gitattributes: -------------------------------------------------------------------------------- 1 | fast-arithmetic/cbits/*.c linguist-generated=true 2 | .atspkg/contrib/* linguist-vendored=true 3 | fast-arithmetic/include/fast-arithmetic.h linguist-language=c 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.deb 2 | *.tar.gz 3 | target 4 | .ghc.* 5 | .hspec-failures 6 | .atspkg 7 | ats-deps 8 | tags 9 | *.c 10 | dist-newstyle 11 | dist 12 | .stack-work 13 | *.o 14 | *.so 15 | *.a 16 | build 17 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | - functions: 3 | - {name: fromJust, within: []} 4 | 5 | - error: {lhs: "convertBool . f . fromIntegral", rhs: "asTest f", name: "Use asTest"} 6 | - error: {lhs: "fromIntegral . f . fromIntegral", rhs: "conjugate f", name: "Use conjugate"} 7 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | steps: 3 | - simple_align: 4 | cases: true 5 | top_level_patterns: true 6 | records: true 7 | - imports: 8 | align: global 9 | list_align: after_alias 10 | pad_module_names: true 11 | long_list_align: inline 12 | empty_list_align: inherit 13 | list_padding: 4 14 | separate_lists: true 15 | space_surround: false 16 | - language_pragmas: 17 | style: vertical 18 | align: true 19 | remove_redundant: false 20 | 21 | - trailing_whitespace: {} 22 | columns: 80 23 | newline: native 24 | language_extensions: [] 25 | -------------------------------------------------------------------------------- /.yamllint: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | rules: 4 | braces: 5 | min-spaces-inside: 0 6 | max-spaces-inside: 0 7 | min-spaces-inside-empty: -1 8 | max-spaces-inside-empty: -1 9 | brackets: 10 | min-spaces-inside: 0 11 | max-spaces-inside: 0 12 | min-spaces-inside-empty: -1 13 | max-spaces-inside-empty: -1 14 | colons: 15 | max-spaces-before: 0 16 | max-spaces-after: 1 17 | commas: 18 | max-spaces-before: 0 19 | min-spaces-after: 1 20 | max-spaces-after: 1 21 | comments: 22 | level: warning 23 | require-starting-space: true 24 | min-spaces-from-content: 2 25 | comments-indentation: 26 | level: warning 27 | document-end: disable 28 | document-start: 29 | level: warning 30 | present: true 31 | empty-lines: 32 | max: 2 33 | max-start: 0 34 | max-end: 0 35 | hyphens: 36 | max-spaces-after: 1 37 | key-duplicates: enable 38 | line-length: disable 39 | new-line-at-end-of-file: enable 40 | new-lines: 41 | type: unix 42 | trailing-spaces: enable 43 | truthy: disable 44 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2018 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # hs-ats 2 | 3 | Various libraries facilitating calling ATS from Haskell (and vice versa). 4 | 5 | ## Contents 6 | 7 | ``` 8 | ------------------------------------------------------------------------------- 9 | Language Files Lines Code Comments Blanks 10 | ------------------------------------------------------------------------------- 11 | ATS 8 833 706 37 90 12 | Bash 1 26 19 0 7 13 | C Header 1 11 10 0 1 14 | Cabal 1 120 106 0 14 15 | Cabal Project 1 9 6 0 3 16 | Dhall 5 118 101 0 17 17 | Haskell 5 309 239 22 48 18 | Justfile 1 22 18 0 4 19 | Markdown 4 170 137 0 33 20 | TOML 1 3 3 0 0 21 | YAML 4 138 129 0 9 22 | ------------------------------------------------------------------------------- 23 | Total 32 1759 1474 59 226 24 | ------------------------------------------------------------------------------- 25 | ``` 26 | -------------------------------------------------------------------------------- /bash/release: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -e pipefail 4 | 5 | sn clean 6 | atspkg pack fast-arithmetic 7 | 8 | cabal="$(fd '\.cabal$' -d1 fast-arithmetic)" 9 | version="$(grep -P -o '\d+\.\d+\.\d+\.\d+' "$cabal" | head -n1 | sed 's/ /\./g')" 10 | token=$(cat "$HOME"/.git-token) 11 | 12 | git commit -am "release" 13 | git tag "$version" 14 | git push origin --tags 15 | git push origin master 16 | git tag -d "$version" 17 | 18 | cd fast-arithmetic 19 | atspkg build --pkg-args './lib.dhall' target/fast-arithmetic.deb 20 | cd ../ 21 | 22 | github-release release -s "$token" -u vmchale -r atspkg -t "$version" 23 | github-release upload --replace -s "$token" -u vmchale -r hs-ats -n fast-arithmetic.tar.gz -f fast-arithmetic.tar.gz -t "$version" 24 | github-release upload --replace -s "$token" -u vmchale -r hs-ats -n fast-arithmetic.deb -f fast-arithmetic/target/fast-arithmetic.deb -t "$version" 25 | 26 | rm -f fast-arithmetic.tar.gz 27 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: fast-arithmetic 2 | 3 | max-backjumps: 400000 4 | 5 | constraints: 6 | fast-arithmetic -development 7 | -------------------------------------------------------------------------------- /fast-arithmetic/.atsfmt.toml: -------------------------------------------------------------------------------- 1 | ribbon = 1.0 # maximum ribbon fraction 2 | width = 130 # maximum width 3 | clang-format = false # call clang-format on inline code 4 | -------------------------------------------------------------------------------- /fast-arithmetic/.ctags: -------------------------------------------------------------------------------- 1 | --langdef=ATS 2 | --langmap=ATS:.dats 3 | --langmap=ATS:+.sats 4 | --regex-ATS=/^fun *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 5 | --regex-ATS=/^fn *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 6 | --regex-ATS=/^castfn *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 7 | --regex-ATS=/^prfun *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 8 | --regex-ATS=/^fnx *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/f,function/ 9 | --regex-ATS=/^praxi *([[:lower:]][[:alnum:]_]+)[[:blank:]]*[\(\[\{)]/\1/p,proof/ 10 | --regex-ATS=/^typedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 11 | --regex-ATS=/^datatype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 12 | --regex-ATS=/^sortdef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 13 | --regex-ATS=/^viewtypedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 14 | --regex-ATS=/^vtypedef *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 15 | --regex-ATS=/^dataviewtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 16 | --regex-ATS=/^datavtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 17 | --regex-ATS=/^dataprop *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 18 | --regex-ATS=/^dataviewprop *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,proof/ 19 | --regex-ATS=/^absvtype *([[:lower:]][[:alnum:]_]+)[[:blank:]]*=/\1/t,type/ 20 | -------------------------------------------------------------------------------- /fast-arithmetic/.ghci: -------------------------------------------------------------------------------- 1 | :set -fno-warn-type-defaults 2 | -------------------------------------------------------------------------------- /fast-arithmetic/.hspec: -------------------------------------------------------------------------------- 1 | --fail-fast 2 | --failure-report .hspec-failures 3 | --rerun 4 | --rerun-all-on-success 5 | -------------------------------------------------------------------------------- /fast-arithmetic/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # fast-arithmetic 2 | 3 | ## 0.6.7.0 4 | 5 | * Add `risingFac` function 6 | 7 | ## 0.6.6.0 8 | 9 | * Export `bell` function 10 | 11 | ## 0.6.5.1 12 | 13 | * Documentation fixes 14 | * Fix performance of `tau`; it now beats Haskell implementation from arithmoi 15 | again. 16 | 17 | # 0.6.5.0 18 | 19 | * Add `isSemiprime` 20 | 21 | ## 0.6.4.3 22 | 23 | * Improved documentation 24 | * Update for latest `ats-includes` package 25 | * Remove unsafe casts and don't bother with `intinfGt(0)` types 26 | * Use internal library `pure-haskell` for benchmarks/test suite 27 | * Drop some older GHC support 28 | 29 | ## 0.6.4.2 30 | 31 | * Fix bug in `include/fast_arithmetic.h` 32 | * Put some documentation in `.sats` files rather than `.dats` files 33 | * Fix `.dhall` files 34 | 35 | ## 0.6.4.1 36 | 37 | * Use `hgmp` internally 38 | 39 | ## 0.6.4.0 40 | 41 | * Add `bell` to the ATS library 42 | * Add `stirling2` for computing Stirling numbers of the second kind. 43 | * Add `radical` to `fast_arithmetic.h`, for users of the C library 44 | 45 | ## 0.6.3.0 46 | 47 | * Patch `isPrime` 48 | 49 | ## 0.6.2.1 50 | 51 | * Export `radical` 52 | 53 | ## 0.6.2.0 54 | 55 | * Add `radical` for computing radicals of integers 56 | 57 | ## 0.6.1.2 58 | 59 | * Add `fast_arithmetic.h` for those wanting to use the C library. 60 | 61 | ## 0.6.1.1 62 | 63 | * Add niche function for a problem of combinatorial geometry. 64 | 65 | ## 0.6.1.0 66 | 67 | * Add `permutations` function 68 | * Minor performance improvements 69 | * Add debian package 70 | * Improvements to the ATS library 71 | 72 | ## 0.6.0.9 73 | 74 | * Fix builds on older GHCs 75 | 76 | ## 0.6.0.8 77 | 78 | * Improved performance slightly 79 | * Updated `pkg.dhall` 80 | -------------------------------------------------------------------------------- /fast-arithmetic/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Vanessa McHale (c) 2017-2021 2 | 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 4 | 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 6 | 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 8 | 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. 10 | 11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 12 | -------------------------------------------------------------------------------- /fast-arithmetic/README.md: -------------------------------------------------------------------------------- 1 | # fast-arithmetic 2 | 3 | [![Build Status](https://travis-ci.org/vmchale/hs-ats.svg?branch=master)](https://travis-ci.org/vmchale/hs-ats) 4 | [![Hackage](https://img.shields.io/hackage/v/fast-arithmetic.svg)](http://hackage.haskell.org/package/fast-arithmetic) 5 | [![Dependencies of latest version on Hackage](https://img.shields.io/hackage-deps/v/fast-arithmetic.svg)](https://hackage.haskell.org/package/fast-arithmetic) 6 | 7 | This is a library for fast arithmetical functions using ATS, with a Haskell 8 | wrapper. 9 | 10 | It is intended to supplement (but not replace) 11 | [arithmoi](https://hackage.haskell.org/package/arithmoi) and 12 | [combinat](https://hackage.haskell.org/package/combinat) where speed is 13 | important. In particular, this library provides a fast primality check and fast 14 | computation of basic combinatorial functions. 15 | 16 | ## Benchmarks 17 | 18 | | Computation | Version (ATS/Haskell) | Time | 19 | | ----------- | --------------------- | ---- | 20 | | `isPrime 2017` | ATS | 117.2 ns | 21 | | `isPrime 2017` | Haskell | 425.0 ns | 22 | | `φ(2016)` | ATS | 191.5 ns | 23 | | `φ(2016)` | Haskell | 384.8 ns | 24 | | `τ(3018)` | ATS | 337.0 ns | 25 | | `τ(3018)` | Haskell | 660.2 ns | 26 | | `σ(115)` | ATS | 45.41 ns | 27 | | `σ(115)` | Haskell | 322.4 ns | 28 | | `ω(91)` | ATS | 65.52 ns | 29 | | `ω(91)` | Haskell | 345.2 ns | 30 | | `160!` | ATS | 2.363 μs | 31 | | `160!` | Haskell | 6.134μs | 32 | | `79!!` | ATS | 556.2 ns | 33 | | `79!!` | Haskell | 1.355 μs | 34 | | ``322 `choose` 16`` | ATS | 467.6 ns | 35 | | ``322 `choose` 16`` | Haskell | 956.7 ns | 36 | | `catalan 300` | ATS | 13.74 μs | 37 | | `catalan 300` | Haskell | 28.76 μs | 38 | | `permutations 20 10` | ATS | 202.8 ns | 39 | | `permutations 20 10` | Haskell | 362.6 ns | 40 | | `maxRegions 45000` | ATS | 624.1 ns | 41 | | `maxRegions 45000` | Haskell | 1.064 μs | 42 | | `stirling2 25 8` | ATS | 3.108 μs | 43 | | `stirling2 25 8` | Haskell | 9.494 μs | 44 | 45 | ## Building 46 | 47 | The Haskell library comes with the C bundled, however you will likely want to build from 48 | source if you are hacking on the library. To that end, you can install 49 | [atspkg](http://hackage.haskell.org/package/ats-pkg) and build with 50 | 51 | ```bash 52 | atspkg build --pkg-args "./source.dhall" 53 | cabal build 54 | ``` 55 | 56 | ## Documentation 57 | 58 | You can find documentation for the Haskell library on 59 | [Hackage](https://hackage.haskell.org/package/fast-arithmetic/). 60 | Unfortunately, there is no documentation for the ATS library, however, 61 | the bundled source code is commented. 62 | -------------------------------------------------------------------------------- /fast-arithmetic/TODO.md: -------------------------------------------------------------------------------- 1 | # ATS library 2 | - [ ] stack-allocated big integers? 3 | - [x] Package debianization 4 | - [ ] Header files that work with GMP 5 | # Haskell library 6 | - [ ] Consider backpack and/or pure haskell library for when ATS fails? 7 | # Performance 8 | - [ ] Consider view type for appending arrays? 9 | - [ ] make `jacobi` faster 10 | - [ ] make `totientSum` use the right algorithm 11 | - [ ] Use factorial etc. for derangement formula? 12 | - [ ] `bell` is slow compared to haskell? 13 | # Functions 14 | - [ ] big omega 15 | - [ ] Primorials (`*/ p:` in J) 16 | - [ ] quadratic residues 17 | - [ ] Jacobi symbol 18 | - [ ] Chinese remainder theorem 19 | - [ ] factor a number (with multiplicity) 20 | - [ ] elliptic curves 21 | - [ ] bernoulli numbers 22 | - [ ] striling numbers of the first kind 23 | - [ ] https://en.wikipedia.org/wiki/Stirling_numbers_of_the_first_kind#Recurrence_relation 24 | - [ ] quadratic residues 25 | - [ ] modular exponentiation 26 | - [ ] https://en.wikipedia.org/wiki/Pieri's_formula 27 | - [ ] https://snappy.math.uic.edu/ 28 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/bench.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "share/HATS/atspre_staload_prelude.hats" 3 | #include "share/HATS/atspre_staload_libats_ML.hats" 4 | #include "share/HATS/atslib_staload_libats_libc.hats" 5 | #include "ats-src/combinatorics.dats" 6 | #include "$PATSHOMELOCS/ats-bench-0.3.3/bench.dats" 7 | 8 | fn factorial_bench() : void = 9 | { 10 | val x = fact(160) 11 | val () = intinf_free(x) 12 | } 13 | 14 | fn double_factorial_bench() : void = 15 | { 16 | val x = dfact(79) 17 | val () = intinf_free(x) 18 | } 19 | 20 | fn choose_bench() : void = 21 | { 22 | val x = choose(322, 16) 23 | val () = intinf_free(x) 24 | } 25 | 26 | fn catalan_bench() : void = 27 | { 28 | val x = catalan(300) 29 | val () = intinf_free(x) 30 | } 31 | 32 | fn permutations_bench() : void = 33 | { 34 | val x = permutations(20, 10) 35 | val () = intinf_free(x) 36 | } 37 | 38 | fn bell_bench() : void = 39 | { 40 | val x = bell(30) 41 | val () = intinf_free(x) 42 | } 43 | 44 | fn stirling2_bench() : void = 45 | { 46 | val x = stirling2(25, 8) 47 | val () = intinf_free(x) 48 | } 49 | 50 | fn derangement_bench() : void = 51 | { 52 | val x = derangements(35) 53 | val () = intinf_free(x) 54 | } 55 | 56 | val factorial_delay: io = lam () => factorial_bench() 57 | val double_factorial_delay: io = lam () => double_factorial_bench() 58 | val choose_delay: io = lam () => double_factorial_bench() 59 | val catalan_delay: io = lam () => catalan_bench() 60 | val permutations_delay: io = lam () => permutations_bench() 61 | val bell_delay: io = lam () => bell_bench() 62 | val derangement_delay: io = lam () => derangement_bench() 63 | val stirling2_delay: io = lam () => stirling2_bench() 64 | 65 | implement main0 () = 66 | { 67 | // FIXME - for some reason this is negative 68 | // val k = max_regions(46342) 69 | // val () = println!(k) 70 | // val () = intinf_free(k) 71 | val () = print_slope("factorial", 12, factorial_delay) 72 | val () = print_slope("double factorial", 12, double_factorial_delay) 73 | val () = print_slope("choose", 13, choose_delay) 74 | val () = print_slope("catalan", 9, catalan_delay) 75 | val () = print_slope("permutations", 13, permutations_delay) 76 | val () = print_slope("stirling2", 10, stirling2_delay) 77 | val () = print_slope("bell", 8, bell_delay) 78 | val () = print_slope("derangements", 12, derangement_delay) 79 | } 80 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/combinatorics.dats: -------------------------------------------------------------------------------- 1 | #define ATS_MAINATSFLAG 1 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mydepies.hats" 5 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mylibies.hats" 6 | 7 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 8 | staload UN = "prelude/SATS/unsafe.sats" 9 | staload "ats-src/combinatorics.sats" 10 | 11 | fn derangements {n:nat}(n : int(n)) : Intinf = 12 | let 13 | fun loop { n : nat | n > 1 }{ i : nat | i <= n } .. (n : int(n), i : int(i), n1 : Intinf, n2 : Intinf) : Intinf = 14 | if i < n then 15 | let 16 | var x = add_intinf0_intinf1(n2, n1) 17 | var y = mul_intinf0_int(x, i) 18 | in 19 | loop(n, i + 1, y, n1) 20 | end 21 | else 22 | let 23 | var x = add_intinf0_intinf1(n2, n1) 24 | val _ = intinf_free(n1) 25 | var y = mul_intinf0_int(x, i) 26 | in 27 | y 28 | end 29 | in 30 | case+ n of 31 | | 0 => int2intinf(1) 32 | | 1 =>> int2intinf(0) 33 | | 2 =>> int2intinf(1) 34 | | n =>> loop(n - 1, 2, int2intinf(1), int2intinf(0)) 35 | end 36 | 37 | fun fact_ref {n:nat} .. (k : int(n), ret : &Intinf? >> Intinf) : void = 38 | case+ k of 39 | | 0 => ret := int2intinf(1) 40 | | 1 => ret := int2intinf(1) 41 | | k =>> let 42 | val () = fact_ref(k - 1, ret) 43 | in 44 | ret := mul_intinf0_int(ret, k) 45 | end 46 | 47 | fn fact {n:nat}(k : int(n)) : Intinf = 48 | let 49 | var ret: intinfGte(1) 50 | val () = fact_ref(k, ret) 51 | in 52 | ret 53 | end 54 | 55 | fun dfact_ref {n:nat} .. (k : int(n), ret : &Intinf? >> Intinf) : void = 56 | case+ k of 57 | | 0 => ret := int2intinf(1) 58 | | 1 => ret := int2intinf(1) 59 | | k =>> let 60 | val () = dfact_ref(k - 2, ret) 61 | var y = mul_intinf0_int(ret, k) 62 | in 63 | ret := y 64 | end 65 | 66 | fun dfact {n:nat} .. (k : int(n)) : Intinf = 67 | let 68 | var ret: intinfGte(1) 69 | val () = dfact_ref(k, ret) 70 | in 71 | ret 72 | end 73 | 74 | fn permutations {n:nat}{ k : nat | k <= n && k > 0 }(n : int(n), k : int(k)) : Intinf = 75 | let 76 | fun loop { i : nat | i >= n-k+1 } .. (i : int(i), ret : &Intinf? >> Intinf) : void = 77 | if i > n - k + 1 then 78 | (loop(i - 1, ret) ; ret := mul_intinf0_int(ret, i)) 79 | else 80 | ret := int2intinf(n - k + 1) 81 | 82 | var ret: Intinf 83 | val () = loop(n, ret) 84 | in 85 | ret 86 | end 87 | 88 | fn catalan {n:nat}(n : int(n)) : Intinf = 89 | let 90 | fun numerator_loop { i : nat | i > 1 } .. (i : int(i)) : Intinf = 91 | case+ i of 92 | | 2 => int2intinf(n + 2) 93 | | i =>> let 94 | var x = numerator_loop(i - 1) 95 | var y = mul_intinf0_int(x, n + i) 96 | in 97 | y 98 | end 99 | in 100 | case+ n of 101 | | 0 => int2intinf(1) 102 | | 1 => int2intinf(1) 103 | | k =>> let 104 | var x = numerator_loop(k) 105 | var y = fact(k) 106 | var z = div_intinf0_intinf1(x, y) 107 | val _ = intinf_free(y) 108 | in 109 | z 110 | end 111 | end 112 | 113 | fn choose {n:nat}{m:nat}(n : int(n), k : int(m)) : Intinf = 114 | let 115 | fun numerator_loop { m : nat | m > 1 } .. (i : int(m), ret : &Intinf? >> Intinf) : void = 116 | case+ i of 117 | | 1 => ret := int2intinf(n) 118 | | 2 => ret := int2intinf((n - 1) * n) 119 | | i =>> let 120 | val () = numerator_loop(i - 1, ret) 121 | var y = mul_intinf0_int(ret, n + 1 - i) 122 | in 123 | ret := y 124 | end 125 | in 126 | case+ k of 127 | | 0 => int2intinf(1) 128 | | 1 => int2intinf(n) 129 | | k when k > n => int2intinf(0) 130 | | k =>> let 131 | var x: Intinf 132 | val () = numerator_loop(k, x) 133 | var y = fact(k) 134 | var z = div_intinf0_intinf1(x, y) 135 | val _ = intinf_free(y) 136 | in 137 | z 138 | end 139 | end 140 | 141 | fn stirling2 { n, k : nat }(n : int(n), k : int(k)) : Intinf = 142 | ifcase 143 | | k = 0 && n = 0 => int2intinf(1) 144 | | k > n => int2intinf(0) 145 | | _ => let 146 | fun top_loop {i:nat} .. (i : int(i), acc : &Intinf? >> Intinf) : void = 147 | case+ i of 148 | | 0 => acc := int2intinf(0) 149 | | i =>> { 150 | fn negate_if_odd(n : int, k : Intinf) : Intinf = 151 | if n % 2 = 0 then 152 | k 153 | else 154 | neg_intinf0(k) 155 | 156 | val () = top_loop(i - 1, acc) 157 | var add = choose(k, i) 158 | var factor = pow_int_int(i, n) 159 | var multiplier = negate_if_odd(k - i, factor) 160 | var factor_add = mul_intinf0_intinf1(add, multiplier) 161 | val () = acc := add_intinf0_intinf1(acc, factor_add) 162 | val () = intinf_free(multiplier) 163 | val () = intinf_free(factor_add) 164 | } 165 | 166 | var top: Intinf 167 | val () = top_loop(k, top) 168 | var bot = fact(k) 169 | var result = div_intinf0_intinf1(top, bot) 170 | val () = intinf_free(bot) 171 | in 172 | result 173 | end 174 | 175 | fn bell {n:nat}(n : int(n)) : Intinf = 176 | let 177 | fun sum_loop { k : nat | k >= 1 } .. (k : int(k), acc : &Intinf? >> Intinf) : void = 178 | case+ k of 179 | | 1 => acc := stirling2(n, 1) 180 | | k =>> { 181 | val () = sum_loop(k - 1, acc) 182 | var add = stirling2(n, k) 183 | val () = acc := add_intinf0_intinf1(acc, add) 184 | val () = intinf_free(add) 185 | } 186 | in 187 | case+ n of 188 | | 0 => int2intinf(1) 189 | | n =>> let 190 | var ret: Intinf 191 | val () = sum_loop(n, ret) 192 | in 193 | ret 194 | end 195 | end 196 | 197 | fn max_regions {n:nat}(n : int(n)) : Intinf = 198 | let 199 | fun loop {m:nat} .. (m : int(m), ret : &Intinf? >> Intinf) : void = 200 | case+ m of 201 | | 0 => ret := int2intinf(1) 202 | | _ =>> { 203 | val () = loop(m - 1, ret) 204 | var c = choose(n, m) 205 | val () = ret := add_intinf0_intinf1(ret, c) 206 | val () = intinf_free(c) 207 | } 208 | 209 | var x: Intinf 210 | val () = loop(4, x) 211 | in 212 | x 213 | end 214 | 215 | implement choose_ats (n, k) = 216 | choose(n, k) 217 | 218 | implement double_factorial_ats (m) = 219 | dfact(m) 220 | 221 | implement factorial_ats (m) = 222 | fact(m) 223 | 224 | implement catalan_ats (n) = 225 | catalan(n) 226 | 227 | implement derangements_ats (n) = 228 | derangements(n) 229 | 230 | implement permutations_ats (n, k) = 231 | permutations(n, k) 232 | 233 | implement stirling2_ats (n, k) = 234 | stirling2(n, k) 235 | 236 | implement max_regions_ats (n) = 237 | max_regions(n) 238 | 239 | implement bell_ats (n) = 240 | bell(n) 241 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/combinatorics.sats: -------------------------------------------------------------------------------- 1 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 2 | 3 | // Bell numbers. See http://mathworld.wolfram.com/BellNumber.html 4 | fn bell_ats {n:nat} : int(n) -> Intinf = 5 | "ext#" 6 | 7 | // Stirling numbers of the second kind. See 8 | // http://mathworld.wolfram.com/StirlingNumberoftheSecondKind.html 9 | fn stirling2_ats { n, m : nat } : (int(n), int(m)) -> Intinf = 10 | "ext#" 11 | 12 | // Number of combinations of n objects using k at a time. 13 | // When k > n, this returns 0. 14 | fn choose_ats {n:nat}{ m : nat | m <= n } : (int(n), int(m)) -> Intinf = 15 | "ext#" 16 | 17 | // Double factorial http://mathworld.wolfram.com/DoubleFactorial.html 18 | fn double_factorial_ats {n:nat} : int(n) -> Intinf = 19 | "ext#" 20 | 21 | fn factorial_ats {n:nat} : int(n) -> Intinf = 22 | "ext#" 23 | 24 | // Catalan numbers, indexing starting at zero. 25 | fn catalan_ats {n:nat} : int(n) -> Intinf = 26 | "ext#" 27 | 28 | // See [here](http://mathworld.wolfram.com/Derangement.html). 29 | fn derangements_ats {n:nat} : int(n) -> Intinf = 30 | "ext#" 31 | 32 | // Number of permutations on n objects using k at a time. 33 | fn permutations_ats {n:nat}{ k : nat | k <= n && k > 0 } : (int(n), int(k)) -> Intinf = 34 | "ext#" 35 | 36 | fn max_regions_ats {n:nat} : int(n) -> Intinf = 37 | "ext#" 38 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/number-theory.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mydepies.hats" 3 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mylibies.hats" 4 | #include "ats-src/numerics-internal.dats" 5 | 6 | staload "ats-src/numerics.sats" 7 | staload "ats-src/number-theory.sats" 8 | staload "prelude/SATS/integer.sats" 9 | staload UN = "prelude/SATS/unsafe.sats" 10 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 11 | 12 | #define ATS_MAINATSFLAG 1 13 | 14 | implement divides (m, n) = 15 | n % m = 0 16 | 17 | implement gcd (m, n) = 18 | if n != 0 then 19 | gcd(n, witness(m % n)) 20 | else 21 | m 22 | 23 | implement lcm (m, n) = 24 | (m / gcd(m, n)) * n 25 | 26 | implement coprime (m, n) = 27 | gcd(m, n) = 1 28 | 29 | implement divisors (n) = 30 | case+ n of 31 | | 1 => $ldelay(stream_vt_cons(1, $ldelay(stream_vt_nil))) 32 | | _ => let 33 | fun loop { k : nat | k > 0 }{ m : nat | m > 0 }(n : int(k), acc : int(m)) : stream_vt(int) = 34 | if acc >= sqrt_int(n) then 35 | if n % acc = 0 then 36 | if n / acc != acc then 37 | let 38 | var x: int = n / acc 39 | in 40 | $ldelay(stream_vt_cons(acc, $ldelay(stream_vt_cons(x, $ldelay(stream_vt_nil))))) 41 | end 42 | else 43 | let 44 | 45 | in 46 | $ldelay(stream_vt_cons(acc, $ldelay(stream_vt_nil))) 47 | end 48 | else 49 | $ldelay(stream_vt_nil) 50 | else 51 | if n % acc = 0 then 52 | let 53 | var x: int = n / acc 54 | in 55 | $ldelay(stream_vt_cons(acc, $ldelay(stream_vt_cons(x, (loop(n, acc + 1)))))) 56 | end 57 | else 58 | loop(n, acc + 1) 59 | in 60 | loop(n, 1) 61 | end 62 | 63 | extern 64 | fn mpz_primorial_ui(x : &$GMP.mpz >> _, n : ullint) : void = 65 | "mac#" 66 | 67 | fn primorial_gmp(k : [ k : nat | k >= 1 ] ullint(k)) : Intinf = 68 | let 69 | var z = ptr_alloc() 70 | val () = $GMP.mpz_init(!(z.2)) 71 | val () = mpz_primorial_ui(!(z.2), k) 72 | in 73 | $UN.castvwtp0(z) 74 | end 75 | 76 | // if n >= 0, p > 1, then n/p >= 0 77 | fn div_gt_zero(n : intGte(0), p : intGt(1)) : intGte(0) = 78 | $UN.cast(n / p) 79 | 80 | // Jacobi symbol for positive integers. See here: http://mathworld.wolfram.com/JacobiSymbol.html 81 | // fails on 7 5 82 | fun jacobi(a : intGte(0), n : Odd) : int = 83 | let 84 | // TODO make this take p prime only. 85 | fun legendre { p : int | p >= 2 }(a : intGte(0), p : int(p)) : intBtwe(~1, 1) = 86 | case+ p % a of 87 | | 0 => 0 88 | | _ => let 89 | // TODO require that p be prime 90 | fun exp_mod_prime(a : intGte(0), n : intGte(0), p : intGt(1)) : int = 91 | let 92 | var a1 = a % p 93 | var n1 = n % (p - 1) 94 | in 95 | case+ a of 96 | | 0 => 0 97 | | x =>> 98 | begin 99 | if n > 0 then 100 | let 101 | var n2: intGte(0) = $UN.cast(half(n1)) 102 | var i2 = n1 % 2 103 | var sq_a: intGte(0) = $UN.cast(a * a % p) 104 | in 105 | if i2 = 0 then 106 | exp_mod_prime(sq_a, n2, p) 107 | else 108 | let 109 | var y = a * exp_mod_prime(sq_a, n2, p) 110 | in 111 | y 112 | end 113 | end 114 | else 115 | 1 116 | end 117 | end 118 | 119 | var i = exp_mod_prime(a, (p - 1) / 2, p) 120 | in 121 | case+ i of 122 | | i when i % (p - 1) = 0 => ~1 123 | | i when i % p = 0 => 0 124 | | _ => 1 125 | end 126 | 127 | fun get_multiplicity(n : intGte(0), p : intGt(1)) : intGte(0) = 128 | case+ n % p of 129 | | 0 => 1 + get_multiplicity(div_gt_zero(n, p), p) 130 | | _ => 0 131 | 132 | fun loop { m : int | m > 1 }(acc : int(m)) : int = 133 | if acc > n then 134 | 1 135 | else 136 | if a = 0 then 137 | 0 138 | else 139 | if a % acc = 0 && is_prime(acc) then 140 | loop(acc + 1) * exp(legendre(acc, n), get_multiplicity(a, acc)) 141 | else 142 | loop(acc + 1) 143 | in 144 | loop(2) 145 | end 146 | 147 | // this doesn't actually work but it should be faster once it's done 148 | fun jacobi2 {m:int}{n:int}(a : int(m), n : int(n)) : int = 149 | case+ a of 150 | | 0 => 0 151 | | 1 => 1 152 | | _ when a > n => jacobi2($UN.cast(a % n), n) 153 | | _ when a % 2 = 0 => if n % 8 = 1 || n % 8 = ~1 then 154 | jacobi2(a / 2, n) 155 | else 156 | ~jacobi2(a / 2, n) 157 | | _ when a % 4 = 3 && n % 4 = 3 => jacobi2(n, a) 158 | | _ => ~jacobi2(n, a) 159 | 160 | implement count_divisors_ats (n) = 161 | let 162 | fun loop { k : nat | k > 0 }(k : int(k)) : int = 163 | if k >= sqrt_int(n) then 164 | if n % k = 0 then 165 | if n / k != k then 166 | 2 167 | else 168 | 1 169 | else 170 | 0 171 | else 172 | if n % k = 0 then 173 | 2 + loop(k + 1) 174 | else 175 | loop(k + 1) 176 | in 177 | loop(1) 178 | end 179 | 180 | implement sum_divisors_ats (n) = 181 | let 182 | fun loop { k : nat | k > 0 }{ m : nat | m > 0 }(n : int(k), acc : int(m)) : int = 183 | if acc >= sqrt_int(n) then 184 | if n % acc = 0 then 185 | if n / acc != acc then 186 | let 187 | var x: int = n / acc 188 | in 189 | acc + x 190 | end 191 | else 192 | acc 193 | else 194 | 0 195 | else 196 | if n % acc = 0 then 197 | let 198 | var x: int = n / acc 199 | in 200 | acc + x + loop(n, acc + 1) 201 | end 202 | else 203 | loop(n, acc + 1) 204 | in 205 | loop(n, 1) 206 | end 207 | 208 | implement is_perfect_ats (n) = 209 | sum_divisors_ats(n) = n 210 | 211 | fun rip { n : nat | n > 0 }{ p : nat | p > 0 } .. (n : int(n), p : int(p)) :<> [ r : nat | r <= n && r > 0 ] int(r) = 212 | if n % p != 0 then 213 | n 214 | else 215 | if n / p > 0 then 216 | let 217 | var n1 = n / p 218 | in 219 | if n1 < n then 220 | rip(n1, p) 221 | else 222 | 1 223 | end 224 | else 225 | 1 226 | 227 | implement prime_factors (n) = 228 | let 229 | fun loop { k : nat | k > 0 }{ m : nat | m > 0 }(n : int(k), acc : int(m)) : stream_vt(int) = 230 | if acc >= n then 231 | if is_prime(n) then 232 | $ldelay(stream_vt_cons(n, $ldelay(stream_vt_nil))) 233 | else 234 | $ldelay(stream_vt_nil) 235 | else 236 | if n % acc = 0 && is_prime(acc) then 237 | if n / acc > 0 then 238 | $ldelay(stream_vt_cons(acc, loop(rip(n, acc), 1))) 239 | else 240 | $ldelay(stream_vt_cons(acc, $ldelay(stream_vt_nil))) 241 | else 242 | loop(n, acc + 1) 243 | in 244 | loop(n, 1) 245 | end 246 | 247 | implement little_omega_ats (n) = 248 | let 249 | fun loop { k : nat | k > 0 }{ m : nat | m > 0 }(n : int(k), acc : int(m)) : int = 250 | if acc >= n then 251 | if is_prime(n) then 252 | 1 253 | else 254 | 0 255 | else 256 | if n % acc = 0 && is_prime(acc) then 257 | if n / acc > 0 then 258 | 1 + loop(rip(n, acc), 1) 259 | else 260 | 1 261 | else 262 | loop(n, acc + 1) 263 | in 264 | loop(n, 1) 265 | end 266 | 267 | implement radical_ats (n) = 268 | case+ n of 269 | | 1 => 1 270 | | n =>> let 271 | var x: stream_vt(int) = prime_factors(n) 272 | 273 | fun product(ys : stream_vt(int)) : int = 274 | case+ !ys of 275 | | ~stream_vt_cons (z, zs) => z * product(zs) 276 | | ~stream_vt_nil() => 1 277 | in 278 | product(x) 279 | end 280 | 281 | fn totient(n : intGte(1)) : int = 282 | case+ n of 283 | | 1 => 1 284 | | n =>> let 285 | vtypedef pair = @{ first = int, second = int } 286 | 287 | fn adjust_contents(x : pair, y : int) : pair = 288 | @{ first = g0int_mul(x.first, y - 1), second = g0int_mul(x.second, y) } 289 | 290 | var x: stream_vt(int) = prime_factors(n) 291 | var empty_pair = @{ first = 1, second = 1 } : pair 292 | var y = stream_vt_foldleft_cloptr(x, empty_pair, lam (acc, next) => adjust_contents(acc, next)) : pair 293 | in 294 | g0int_div(g0int_mul(n, y.first), y.second) 295 | end 296 | 297 | implement totient_sum (n) = 298 | let 299 | fun loop { n : nat | n >= 1 }{ m : nat | m >= n } .. (i : int(n), bound : int(m)) : Intinf = 300 | if i < bound then 301 | let 302 | var x = loop(i + 1, bound) 303 | var y = add_intinf0_int(x, witness(totient(i))) 304 | in 305 | y 306 | end 307 | else 308 | int2intinf(witness(totient(i))) 309 | in 310 | loop(1, n) 311 | end 312 | 313 | implement totient_ats (n) = 314 | totient(n) 315 | 316 | implement jacobi_ats (m, n) = 317 | jacobi(m, $UN.cast(n)) 318 | 319 | implement primorial (k) = 320 | primorial_gmp(k) 321 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/number-theory.sats: -------------------------------------------------------------------------------- 1 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 2 | staload "ats-src/numerics.sats" 3 | 4 | // GMP wrapper but this is for the ATS library 5 | fn primorial(k : [ k : nat | k >= 1 ] ullint(k)) : Intinf 6 | 7 | // m | n 8 | fn divides(m : intGt(0), n : intGte(0)) :<> bool 9 | 10 | // Euclid's algorithm 11 | fn gcd {k:nat}{l:nat} (m : int(l), n : int(k)) : int 12 | 13 | fn lcm {k:nat}{l:nat} (m : int(l), n : int(k)) : int 14 | 15 | // stream all divisors of an integer. 16 | fn divisors(n : intGte(1)) : stream_vt(int) 17 | 18 | // prime factors of an integer 19 | fn prime_factors(n : intGte(1)) : stream_vt(int) 20 | 21 | // The sum of all φ(m) for m between 1 and n. Note the use of refinement types 22 | // to prevent 0 from being passed as an argument. This function is 23 | // slower than it should be. 24 | fn totient_sum : intGte(1) -> Intinf 25 | 26 | fn coprime {k:nat}{n:nat} : (int(k), int(n)) -> bool 27 | 28 | // radical of an integer: https://oeis.org/A007947 29 | fn radical_ats { k : nat | k >= 1 }(int(k)) : int = 30 | "ext#" 31 | 32 | // Euler's totient function. 33 | fn totient_ats { k : nat | k >= 2 }(int(k)) : int = 34 | "ext#" 35 | 36 | fn count_divisors_ats { k : nat | k >= 2 }(int(k)) : int = 37 | "ext#" 38 | 39 | // distinct prime divisors 40 | fn little_omega_ats { n : nat | n > 0 } : int(n) -> int = 41 | "ext#" 42 | 43 | // aka σ in number theory 44 | // technically this is unsafe because it might overflow 45 | fn sum_divisors_ats : { n : nat | n > 1 } int(n) -> int = 46 | "ext#" 47 | 48 | fn jacobi_ats : (intGte(0), Odd) -> int = 49 | "ext#" 50 | 51 | fn is_perfect_ats : intGt(1) -> bool = 52 | "ext#" 53 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/numerics-internal.dats: -------------------------------------------------------------------------------- 1 | #include "share/atspre_staload.hats" 2 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mydepies.hats" 3 | #include "$PATSHOMELOCS/atscntrb-hx-intinf/mylibies.hats" 4 | 5 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 6 | staload "libats/libc/SATS/math.sats" 7 | staload UN = "prelude/SATS/unsafe.sats" 8 | staload "ats-src/numerics.sats" 9 | 10 | // TODO: lucas numbers? 11 | // Fast computation of Fibonacci numbers via GMP bindings. 12 | fn fib_gmp(n : uintGte(0)) : Intinf = 13 | let 14 | var z = ptr_alloc() 15 | val () = $GMP.mpz_init(!(z.2)) 16 | val () = $GMP.mpz_fib_uint(!(z.2), n) 17 | in 18 | $UN.castvwtp0(z) 19 | end 20 | 21 | // rising pochammer symbol 22 | fun rising_fac_ref {a:nat}{n:nat}(a : int(a), n : int(n), ret : &Intinf? >> Intinf) : void = 23 | case+ n of 24 | | 0 => ret := int2intinf(1) 25 | | 1 => ret := int2intinf(a) 26 | | k =>> let 27 | val () = rising_fac_ref(a + 1, n - 1, ret) 28 | in 29 | ret := mul_intinf0_int(ret, a) 30 | end 31 | 32 | fn rising_fac {a:nat}{n:nat}(a : int(a), n : int(n)) : Intinf = 33 | let 34 | var ret: intinfGte(0) 35 | val () = rising_fac_ref(a, n, ret) 36 | in 37 | ret 38 | end 39 | 40 | // Fast integer exponentiation. This performs O(log n) multiplications. This 41 | // function is mostly useful for exponentiation in modular arithmetic, as 42 | // it can overflow. 43 | fun exp {n:nat} .. (x : int, n : int(n)) : int = 44 | case+ x of 45 | | 0 => 0 46 | | x =>> 47 | begin 48 | if n > 0 then 49 | let 50 | var n2 = half(n) 51 | var i2 = n % 2 52 | in 53 | if i2 = 0 then 54 | exp(x * x, n2) 55 | else 56 | let 57 | var y = x * exp(x * x, n2) 58 | in 59 | y 60 | end 61 | end 62 | else 63 | 1 64 | end 65 | 66 | // Fast integer exponentiation. 67 | fun big_exp {n:nat} .. (x : Intinf, n : int(n)) : Intinf = 68 | if compare_intinf_int(x, 0) = 0 then 69 | x 70 | else 71 | if n > 0 then 72 | let 73 | var n2 = half(n) 74 | var i2 = n % 2 75 | in 76 | if i2 = 0 then 77 | let 78 | var c = square_intinf0(x) 79 | in 80 | big_exp(c, n2) 81 | end 82 | else 83 | let 84 | var c0 = square_intinf1(x) 85 | var c1 = big_exp(c0, n2) 86 | var c = mul_intinf0_intinf1(c1, x) 87 | val () = intinf_free(x) 88 | in 89 | c 90 | end 91 | end 92 | else 93 | (intinf_free(x) ; int2intinf(1)) 94 | 95 | // square root is bounded for bounded k. 96 | fn sqrt_int(k : intGt(0)) :<> [m:nat] int(m) = 97 | let 98 | var bound = g0float2int(sqrt_double(g0int2float_int_double(k))) 99 | in 100 | witness(bound) 101 | end 102 | 103 | // function to check primality 104 | fn is_prime(k : intGt(0)) :<> bool = 105 | case+ k of 106 | | 1 => false 107 | | k => 108 | begin 109 | let 110 | fun loop {n:nat}{m:nat} .. (i : int(n), bound : int(m)) :<> bool = 111 | if i < bound then 112 | if k % i = 0 then 113 | false 114 | else 115 | loop(i + 1, bound) 116 | else 117 | if i = bound then 118 | if k % i = 0 then 119 | false 120 | else 121 | true 122 | else 123 | true 124 | in 125 | loop(2, sqrt_int(k)) 126 | end 127 | end 128 | 129 | fn is_semiprime(k : intGt(0)) :<> bool = 130 | case+ k of 131 | | 1 => false 132 | | k => 133 | begin 134 | let 135 | fun loop { n : nat | n > 0 }{m:nat} .. (i : int(n), bound : int(m)) :<> bool = 136 | if i < bound then 137 | if k % i = 0 then 138 | if is_prime(i) then 139 | is_prime($UN.cast(k / i)) 140 | else 141 | false 142 | else 143 | loop(i + 1, bound) 144 | else 145 | if i = bound then 146 | if k % i = 0 then 147 | if is_prime(i) then 148 | is_prime($UN.cast(k / i)) 149 | else 150 | false 151 | else 152 | false 153 | else 154 | false 155 | in 156 | loop(2, sqrt_int(k)) 157 | end 158 | end 159 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/numerics.dats: -------------------------------------------------------------------------------- 1 | #define ATS_DYNLOADFLAG 0 2 | 3 | #include "share/atspre_staload.hats" 4 | #include "ats-src/numerics-internal.dats" 5 | 6 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 7 | staload "ats-src/numerics.sats" 8 | 9 | %{^ 10 | #ifndef LIBRARY_BUILD 11 | #define ATS_MEMALLOC_LIBC 12 | #include "ccomp/runtime/pats_ccomp_memalloc_libc.h" 13 | #include "ccomp/runtime/pats_ccomp_runtime_memalloc.c" 14 | #endif 15 | %} 16 | 17 | implement is_prime_ats (n) = 18 | is_prime(n) 19 | 20 | implement rising_fac_ats (a, n) = 21 | rising_fac(a, n) 22 | 23 | implement is_semiprime_ats (n) = 24 | is_semiprime(n) 25 | 26 | implement exp_ats (m, n) = 27 | exp(m, n) 28 | -------------------------------------------------------------------------------- /fast-arithmetic/ats-src/numerics.sats: -------------------------------------------------------------------------------- 1 | staload "$PATSHOMELOCS/atscntrb-hx-intinf/SATS/intinf_vt.sats" 2 | 3 | // Existential types for even and odd numbers. 4 | typedef Even = [n:nat] int(2*n) 5 | typedef Odd = [n:nat] int(2*n+1) 6 | 7 | // Existential types for prime numbers. 8 | typedef gprime(tk: tk, p: int) = { m, n : nat | m < 1 && m <= n && n < p && m*n != p && p > 1 } g1int(tk, p) 9 | typedef prime(p: int) = gprime(int_kind, p) 10 | typedef Prime = [p:nat] prime(p) 11 | 12 | castfn witness(n : int) :<> [m:nat] int(m) 13 | 14 | fn rising_fac_ats {a:nat}{n:nat} : (int(a), int(n)) -> Intinf = 15 | "ext#" 16 | 17 | fn exp_ats {m:nat} : ([n:nat] int(n), int(m)) -> int = 18 | "ext#" 19 | 20 | fn is_prime_ats { n : nat | n > 0 } : int(n) -> bool = 21 | "ext#" 22 | 23 | fn is_semiprime_ats { n : nat | n > 0 } : int(n) -> bool = 24 | "ext#" 25 | -------------------------------------------------------------------------------- /fast-arithmetic/atspkg.dhall: -------------------------------------------------------------------------------- 1 | {- Imports -} 2 | let prelude = 3 | https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall sha256:69bdde38a8cc01c91a1808ca3f45c29fe754c9ac96e91e6abd785508466399b4 4 | 5 | let map = 6 | https://raw.githubusercontent.com/dhall-lang/dhall-lang/9f259cd68870b912fbf2f2a08cd63dc3ccba9dc3/Prelude/List/map sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680 7 | 8 | let not = 9 | https://raw.githubusercontent.com/dhall-lang/dhall-lang/9f259cd68870b912fbf2f2a08cd63dc3ccba9dc3/Prelude/Bool/not sha256:723df402df24377d8a853afed08d9d69a0a6d86e2e5b2bac8960b0d4756c7dc4 10 | 11 | let PreSrc = { atsSrc : Text, cTarget : Text } 12 | 13 | let asDats = λ(x : Text) → "ats-src/${x}.dats" 14 | 15 | let hsDatsSrc = λ(x : Text) → { atsSrc = asDats x, cTarget = "cbits/${x}.c" } 16 | 17 | let mapDatsSrc = λ(x : List Text) → map Text PreSrc hsDatsSrc x 18 | 19 | let moduleNames = [ "combinatorics", "number-theory", "numerics" ] 20 | 21 | in λ(cfg : { sourceBld : Bool, staticLib : Bool, withBench : Bool }) → 22 | let test = 23 | if cfg.withBench 24 | then [ prelude.bin 25 | ⫽ { src = "ats-src/bench.dats" 26 | , target = "${prelude.atsProject}/bench" 27 | , libs = [ "gmp" ] 28 | , gcBin = True 29 | } 30 | ] 31 | else prelude.emptyBin 32 | 33 | let atsSource = 34 | if cfg.sourceBld 35 | then prelude.mapSrc (mapDatsSrc moduleNames) 36 | else prelude.emptySrc 37 | 38 | let libraries = 39 | if not cfg.sourceBld 40 | then let libCommon = 41 | { name = "numbertheory" 42 | , src = map Text Text asDats moduleNames 43 | , includes = [ "include/fast_arithmetic.h" ] 44 | } 45 | 46 | in if cfg.staticLib 47 | then [ prelude.staticLib 48 | ⫽ libCommon 49 | ⫽ { libTarget = 50 | "${prelude.atsProject}/libnumbertheory.a" 51 | } 52 | ] 53 | else [ prelude.lib 54 | ⫽ libCommon 55 | ⫽ { libTarget = 56 | "${prelude.atsProject}/libnumbertheory.so" 57 | } 58 | ] 59 | else prelude.emptyLib 60 | 61 | let dependencies = 62 | prelude.mapPlainDeps 63 | ( [ "atscntrb-hx-intinf" ] 64 | # (if cfg.sourceBld then [ "ats-includes" ] else [] : List Text) 65 | # (if cfg.withBench then [ "ats-bench" ] else [] : List Text) 66 | ) 67 | 68 | let libBuildFlag = 69 | if cfg.sourceBld then [] : List Text else [ "-DLIBRARY_BUILD" ] 70 | 71 | let cc = prelude.cc 72 | 73 | in prelude.default 74 | ⫽ { atsSource 75 | , test 76 | , libraries 77 | , dependencies 78 | , cflags = libBuildFlag # prelude.ccFlags cc 79 | , ccompiler = prelude.printCompiler cc 80 | , compiler = [ 0, 4, 2 ] 81 | , version = [ 0, 4, 2 ] 82 | , debPkg = 83 | prelude.mkDeb 84 | ( prelude.debian "fast-arithmetic" 85 | ⫽ { version = [ 0, 6, 4, 1 ] 86 | , maintainer = "Vanessa McHale " 87 | , description = "Library for fast arithmetic in ATS" 88 | , libraries = 89 | [ "${prelude.atsProject}/libnumbertheory.a" ] 90 | , headers = [ "include/fast_arithmetic.h" ] 91 | } 92 | ) 93 | } 94 | -------------------------------------------------------------------------------- /fast-arithmetic/bench.dhall: -------------------------------------------------------------------------------- 1 | { sourceBld = True, staticLib = False, withBench = True } 2 | -------------------------------------------------------------------------------- /fast-arithmetic/bench/Bench.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Criterion.Main 4 | import qualified Math.Combinat.Numbers as Ext 5 | import qualified Math.Combinatorics.Exact.Binomial as Exact 6 | import qualified Math.Combinatorics.Exact.Factorial as Exact 7 | import qualified Math.NumberTheory.ArithmeticFunctions as Ext 8 | import Numeric.Combinatorics 9 | import Numeric.Haskell 10 | import Numeric.NumberTheory 11 | 12 | main :: IO () 13 | main = 14 | defaultMain [ bgroup "primality check" 15 | [ bench "isPrime" $ nf isPrime 2017 16 | , bench "hsIsPrime" $ nf hsIsPrime (2017 :: Int) 17 | ] 18 | , bgroup "semiprimality check" 19 | [ bench "isSemiprime" $ nf isSemiprime 57 20 | , bench "hsIsSemiprime" $ nf hsIsSemiprime (57 :: Int) 21 | ] 22 | , bgroup "factorial" 23 | [ bench "factorial" $ nf factorial 160 24 | , bench "Ext.factorial" $ nf Ext.factorial (160 :: Integer) 25 | , bench "Exact.factorial" $ nf (Exact.factorial :: Int -> Integer) 160 26 | ] 27 | , bgroup "φ" 28 | [ bench "totient" $ nf totient 2016 29 | , bench "Ext.totient" $ nf Ext.totient (2016 :: Int) 30 | ] 31 | , bgroup "τ" 32 | [ bench "tau" $ nf tau 3018 33 | , bench "Ext.tau" $ nf (Ext.tau :: Int -> Int) 3018 34 | ] 35 | , bgroup "ω" 36 | [ bench "littleOmega" $ nf littleOmega 91 37 | , bench "Ext.smallOmega" $ nf (Ext.smallOmega :: Int -> Int) 91 38 | ] 39 | , bgroup "σ" 40 | [ bench "sumDivisors" $ nf sumDivisors 115 41 | , bench "Ext.sigma" $ nf ((Ext.sigma :: Word -> Int -> Int) 1) (115 :: Int) 42 | ] 43 | , bgroup "doubleFactorial" 44 | [ bench "doubleFactorial" $ nf doubleFactorial 79 45 | , bench "Ext.doubleFactorial" $ nf Ext.doubleFactorial (79 :: Integer) 46 | ] 47 | , bgroup "choose" 48 | [ bench "choose" $ nf (choose 322) 16 49 | , bench "Ext.binomial" $ nf (Ext.binomial 322) (16 :: Int) 50 | , bench "Exact.choose" $ nf (Exact.choose 322) (16 :: Integer) 51 | ] 52 | , bgroup "catalan" 53 | [ bench "catalan" $ nf catalan 300 54 | , bench "Ext.catalan" $ nf Ext.catalan (300 :: Int) 55 | ] 56 | , bgroup "permutations" 57 | [ bench "permutations" $ nf (permutations 10) 20 58 | , bench "hsPermutations" $ nf (hsPermutations 10) (20 :: Integer) 59 | ] 60 | , bgroup "maxRegions" 61 | [ bench "maxRegions" $ nf maxRegions (45000 :: Int) 62 | , bench "hsMaxRegions" $ nf hsMaxRegions (45000 :: Int) 63 | ] 64 | , bgroup "stirling" 65 | [ bench "stirling2" $ nf (stirling2 25) 8 66 | , bench "Ext.stirling2nd" $ nf (Ext.stirling2nd (25 :: Int)) 8 67 | ] 68 | , bgroup "bell" 69 | [ bench "bell" $ nf bell (30 :: Int) 70 | , bench "Ext.bell" $ nf Ext.bellNumber (30 :: Int) 71 | ] 72 | ] 73 | -------------------------------------------------------------------------------- /fast-arithmetic/common/Numeric/Haskell.hs: -------------------------------------------------------------------------------- 1 | -- | This module contains functions that are common to the benchmark and test 2 | -- suites. 3 | module Numeric.Haskell ( hsPermutations 4 | , hsIsPrime 5 | , hsMaxRegions 6 | , hsDerangement 7 | , hsIsSemiprime 8 | , hsPrimorial 9 | , hsRisingFac 10 | ) where 11 | 12 | import qualified Math.Combinat.Numbers as Ext 13 | import Math.NumberTheory.Primes (primes, unPrime) 14 | 15 | hsRisingFac :: (Num a, Integral b) => a -> b -> a 16 | hsRisingFac a n = product [a+fromIntegral i | i <- [0..(n-1)] ] 17 | 18 | {-# SPECIALIZE hsIsSemiprime :: Int -> Bool #-} 19 | hsIsSemiprime :: Integral a => a -> Bool 20 | hsIsSemiprime 1 = False 21 | hsIsSemiprime x = case filter ((== 0) . (x `rem`)) [2..up] of 22 | [] -> False 23 | [y] -> hsIsPrime (x `quot` y) 24 | _ -> False 25 | where up = floor (sqrt (fromIntegral x :: Double)) 26 | 27 | {-# SPECIALIZE hsPermutations :: Integer -> Integer -> Integer #-} 28 | hsPermutations :: Integral a => a -> a -> a 29 | hsPermutations n k = product [(n-k+1)..n] 30 | 31 | {-# SPECIALIZE hsIsPrime :: Int -> Bool #-} 32 | hsIsPrime :: (Integral a) => a -> Bool 33 | hsIsPrime 1 = False 34 | hsIsPrime x = all ((/=0) . (x `rem`)) [2..up] 35 | where up = floor (sqrt (fromIntegral x :: Double)) 36 | 37 | {-# SPECIALIZE hsMaxRegions :: Int -> Integer #-} 38 | hsMaxRegions :: (Integral a) => a -> Integer 39 | hsMaxRegions n = sum $ fmap (n `Ext.binomial`) [0..4] 40 | 41 | {-# SPECIALIZE hsDerangement :: Int -> Integer #-} 42 | hsDerangement :: (Integral a) => Int -> a 43 | hsDerangement n = derangements !! n 44 | 45 | derangements :: (Integral a) => [a] 46 | derangements = fmap snd g 47 | where g = (0, 1) : (1, 0) : zipWith step g (tail g) 48 | step (_, n) (i, m) = (i + 1, i * (n + m)) 49 | 50 | {-# SPECIALIZE hsPrimorial :: Int -> Integer #-} 51 | hsPrimorial :: Integral a => Int -> a 52 | hsPrimorial n = product (unPrime <$> take n primes) 53 | -------------------------------------------------------------------------------- /fast-arithmetic/fast-arithmetic.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.0 2 | name: fast-arithmetic 3 | version: 0.6.7.0 4 | license: BSD3 5 | license-file: LICENSE 6 | copyright: Copyright: (c) 2018-2021 Vanessa McHale 7 | maintainer: vamchale@gmail.com 8 | author: Vanessa McHale 9 | tested-with: 10 | ghc ==8.2.2 ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.7 11 | ghc ==9.0.2 ghc ==9.2.1 12 | 13 | bug-reports: https://github.com/vmchale/hs-ats/issues 14 | synopsis: Fast functions on integers. 15 | description: 16 | Fast functions for number theory and combinatorics with a high level of safety guaranteed by [ATS](http://www.ats-lang.org/). 17 | 18 | category: 19 | Numerics, Math, Algorithms, Number Theory, Combinatorics, FFI, ATS 20 | 21 | build-type: Simple 22 | extra-source-files: 23 | atspkg.dhall 24 | pkg.dhall 25 | lib.dhall 26 | source.dhall 27 | bench.dhall 28 | ats-src/*.dats 29 | ats-src/*.sats 30 | .atspkg/contrib/ats-includes-0.3.13/ccomp/runtime/*.h 31 | .atspkg/contrib/ats-includes-0.3.13/ccomp/runtime/*.c 32 | .atspkg/contrib/ats-includes-0.3.13/prelude/CATS/*.cats 33 | .atspkg/contrib/ats-includes-0.3.13/libats/libc/CATS/*.cats 34 | .atspkg/contrib/ats-includes-0.3.13/libats/libc/CATS/sys/*.cats 35 | .atspkg/contrib/atscntrb-hx-intinf/*.hats 36 | .atspkg/contrib/atscntrb-hx-libgmp/CATS/*.cats 37 | 38 | extra-doc-files: 39 | README.md 40 | CHANGELOG.md 41 | 42 | source-repository head 43 | type: git 44 | location: git@github.com:vmchale/hs-ats.git 45 | 46 | flag development 47 | description: Enable `-Werror`. 48 | default: False 49 | manual: True 50 | 51 | library 52 | exposed-modules: 53 | Numeric.NumberTheory 54 | Numeric.Combinatorics 55 | 56 | c-sources: 57 | cbits/number-theory.c 58 | cbits/numerics.c 59 | cbits/combinatorics.c 60 | 61 | hs-source-dirs: src 62 | other-modules: Numeric.Common 63 | default-language: Haskell2010 64 | include-dirs: 65 | .atspkg/contrib/ats-includes-0.3.13/ccomp/runtime 66 | .atspkg/contrib/ats-includes-0.3.13/ .atspkg/contrib 67 | 68 | ghc-options: -Wall 69 | build-depends: 70 | base >=4.10 && <5, 71 | hgmp 72 | 73 | if os(windows) 74 | buildable: False 75 | 76 | if impl(ghc >=8.0) 77 | ghc-options: 78 | -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat 79 | 80 | if flag(development) 81 | ghc-options: -Werror 82 | 83 | library pure-haskell 84 | exposed-modules: Numeric.Haskell 85 | hs-source-dirs: common 86 | default-language: Haskell2010 87 | ghc-options: -Wall -O2 88 | build-depends: 89 | base >=4.3 && <5, 90 | combinat, 91 | arithmoi >=0.9.0.0 92 | 93 | if impl(ghc >=8.0) 94 | ghc-options: 95 | -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat 96 | 97 | if flag(development) 98 | ghc-options: -Werror 99 | 100 | test-suite fast-arithmetic-test 101 | type: exitcode-stdio-1.0 102 | main-is: Spec.hs 103 | hs-source-dirs: test 104 | default-language: Haskell2010 105 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 106 | build-depends: 107 | base, 108 | fast-arithmetic, 109 | hspec, 110 | QuickCheck, 111 | arithmoi >=0.4.3.0, 112 | combinat, 113 | pure-haskell 114 | 115 | if flag(development) 116 | ghc-options: -Werror 117 | 118 | if impl(ghc >=8.0) 119 | ghc-options: 120 | -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat 121 | 122 | benchmark fast-arithmetic-bench 123 | type: exitcode-stdio-1.0 124 | main-is: Bench.hs 125 | hs-source-dirs: bench 126 | default-language: Haskell2010 127 | ghc-options: -Wall -O2 128 | build-depends: 129 | base, 130 | fast-arithmetic, 131 | criterion, 132 | arithmoi >=0.4.3.0, 133 | combinat, 134 | exact-combinatorics, 135 | pure-haskell 136 | 137 | if flag(development) 138 | ghc-options: -Werror 139 | 140 | if impl(ghc >=8.0) 141 | ghc-options: 142 | -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat 143 | -------------------------------------------------------------------------------- /fast-arithmetic/include/fast_arithmetic.h: -------------------------------------------------------------------------------- 1 | // see ats-src/combinatorics.sats and ats-src/number-theory.sats for 2 | // documentation 3 | 4 | bool is_prime_ats(int); 5 | bool is_semiprime_ats(int); 6 | bool is_perfect_ats(int); 7 | int exp_ats(int, int); 8 | int totient_ats(int); 9 | int count_divisors_ats(int); 10 | int little_omega_ats(int); 11 | int sum_divisors_ats(int); 12 | int radical_ats(int); 13 | -------------------------------------------------------------------------------- /fast-arithmetic/lib.dhall: -------------------------------------------------------------------------------- 1 | { sourceBld = False, staticLib = True, withBench = False } 2 | -------------------------------------------------------------------------------- /fast-arithmetic/pkg.dhall: -------------------------------------------------------------------------------- 1 | let prelude = 2 | https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/dhall/atspkg-prelude.dhall 3 | 4 | in λ(x : List Natural) → 5 | prelude.makeHsPkg { x, name = "fast-arithmetic" } 6 | ⫽ { libDeps = prelude.mapPlainDeps [ "atscntrb-hx-intinf" ] 7 | , description = Some "Library for number theory & combinatorics in ATS" 8 | } 9 | -------------------------------------------------------------------------------- /fast-arithmetic/source.dhall: -------------------------------------------------------------------------------- 1 | { sourceBld = True, staticLib = False, withBench = False } 2 | -------------------------------------------------------------------------------- /fast-arithmetic/src/Numeric/Combinatorics.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Numeric.Combinatorics 3 | Copyright : Copyright (c) 2018 Vanessa McHale 4 | 5 | This provides facilities for working with common combinatorial 6 | functions. 7 | -} 8 | 9 | module Numeric.Combinatorics ( choose 10 | , doubleFactorial 11 | , catalan 12 | , factorial 13 | , derangement 14 | , permutations 15 | , maxRegions 16 | , stirling2 17 | , bell 18 | , risingFac 19 | ) where 20 | 21 | import Foreign.C 22 | import Foreign.Ptr 23 | import Numeric.GMP.Raw.Unsafe (mpz_clear) 24 | import Numeric.GMP.Types 25 | import Numeric.GMP.Utils 26 | import System.IO.Unsafe (unsafeDupablePerformIO) 27 | 28 | foreign import ccall unsafe double_factorial_ats :: CInt -> IO (Ptr MPZ) 29 | foreign import ccall unsafe factorial_ats :: CInt -> IO (Ptr MPZ) 30 | foreign import ccall unsafe choose_ats :: CInt -> CInt -> IO (Ptr MPZ) 31 | foreign import ccall unsafe catalan_ats :: CInt -> IO (Ptr MPZ) 32 | foreign import ccall unsafe derangements_ats :: CInt -> IO (Ptr MPZ) 33 | foreign import ccall unsafe permutations_ats :: CInt -> CInt -> IO (Ptr MPZ) 34 | foreign import ccall unsafe max_regions_ats :: CInt -> IO (Ptr MPZ) 35 | foreign import ccall unsafe stirling2_ats :: CInt -> CInt -> IO (Ptr MPZ) 36 | foreign import ccall unsafe bell_ats :: CInt -> IO (Ptr MPZ) 37 | foreign import ccall unsafe rising_fac_ats :: CInt -> CInt -> IO (Ptr MPZ) 38 | 39 | conjugateMPZ :: (CInt -> IO (Ptr MPZ)) -> Int -> Integer 40 | conjugateMPZ f n = unsafeDupablePerformIO $ do 41 | mPtr <- f (fromIntegral n) 42 | peekInteger mPtr <* mpz_clear mPtr 43 | 44 | conjugateMPZ' :: (CInt -> CInt -> IO (Ptr MPZ)) -> Int -> Int -> Integer 45 | conjugateMPZ' f n k = unsafeDupablePerformIO $ do 46 | mPtr <- f (fromIntegral n) (fromIntegral k) 47 | peekInteger mPtr <* mpz_clear mPtr 48 | 49 | -- | Rising factorial/Pochammer symbol 50 | -- 51 | -- \( a^{(n)} = a(a+1)\cdots(a+n-1) \) 52 | -- 53 | -- @since 0.6.7.0 54 | risingFac :: Int -> Int -> Integer 55 | risingFac = conjugateMPZ' rising_fac_ats 56 | 57 | -- | \( !n \) 58 | -- 59 | -- > λ:> derangement <$> [0..10] 60 | -- > [1,0,1,2,9,44,265,1854,14833,133496,1334961] 61 | derangement :: Int -> Integer 62 | derangement = conjugateMPZ derangements_ats 63 | 64 | -- | The @n@th Catalan number, with indexing beginning at @0@. 65 | -- 66 | -- > λ:> catalan <$> [0..9] 67 | -- > [1,1,2,5,14,42,132,429,1430,4862] 68 | catalan :: Int -> Integer 69 | catalan = conjugateMPZ catalan_ats 70 | 71 | -- | \( \binom{n}{k} \) 72 | choose :: Int -> Int -> Integer 73 | choose = conjugateMPZ' choose_ats 74 | 75 | permutations :: Int -> Int -> Integer 76 | permutations = conjugateMPZ' permutations_ats 77 | 78 | -- | Stirling numbers of the second kind. 79 | stirling2 :: Int -> Int -> Integer 80 | stirling2 = conjugateMPZ' stirling2_ats 81 | 82 | factorial :: Int -> Integer 83 | factorial = conjugateMPZ factorial_ats 84 | 85 | -- | \( n!! \) 86 | doubleFactorial :: Int -> Integer 87 | doubleFactorial = conjugateMPZ double_factorial_ats 88 | 89 | -- | Compute the maximal number of regions obtained by joining \( n \) points 90 | -- about a circle by straight lines. See [here](https://oeis.org/A000127). 91 | maxRegions :: Int -- ^ \( n \) 92 | -> Integer 93 | maxRegions = conjugateMPZ max_regions_ats 94 | 95 | bell :: Int -> Integer 96 | bell = conjugateMPZ bell_ats 97 | -------------------------------------------------------------------------------- /fast-arithmetic/src/Numeric/Common.hs: -------------------------------------------------------------------------------- 1 | module Numeric.Common ( conjugate 2 | , asTest 3 | , conjugateMPZ 4 | ) where 5 | 6 | import Foreign.C 7 | import Foreign.Ptr (Ptr) 8 | import Numeric.GMP.Raw.Unsafe (mpz_clear) 9 | import Numeric.GMP.Types 10 | import Numeric.GMP.Utils 11 | import System.IO.Unsafe (unsafeDupablePerformIO) 12 | 13 | conjugateMPZ :: (CInt -> IO (Ptr MPZ)) -> Int -> Integer 14 | conjugateMPZ f n = unsafeDupablePerformIO $ do 15 | mPtr <- f (fromIntegral n) 16 | peekInteger mPtr <* mpz_clear mPtr 17 | 18 | asTest :: Integral a => (CInt -> CBool) -> a -> Bool 19 | asTest f = convertBool . f . fromIntegral 20 | 21 | conjugate :: (Integral a, Integral b) => (CInt -> CInt) -> a -> b 22 | conjugate f = fromIntegral . f . fromIntegral 23 | 24 | convertBool :: CBool -> Bool 25 | convertBool = toEnum . fromEnum 26 | -------------------------------------------------------------------------------- /fast-arithmetic/src/Numeric/NumberTheory.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Numeric.NumberTheory 3 | Copyright : Copyright (c) 2018 Vanessa McHale 4 | 5 | This module provides fast number theoretic functions. 6 | -} 7 | 8 | module Numeric.NumberTheory ( totient 9 | , tau 10 | , littleOmega 11 | , isPerfect 12 | , sumDivisors 13 | , isPrime 14 | , radical 15 | , isSemiprime 16 | ) where 17 | 18 | import Foreign.C 19 | import Numeric.Common 20 | 21 | foreign import ccall unsafe totient_ats :: CInt -> CInt 22 | foreign import ccall unsafe count_divisors_ats :: CInt -> CInt 23 | foreign import ccall unsafe sum_divisors_ats :: CInt -> CInt 24 | foreign import ccall unsafe little_omega_ats :: CInt -> CInt 25 | foreign import ccall unsafe is_perfect_ats :: CInt -> CBool 26 | foreign import ccall unsafe is_prime_ats :: CInt -> CBool 27 | foreign import ccall unsafe is_semiprime_ats :: CInt -> CBool 28 | foreign import ccall unsafe radical_ats :: CInt -> CInt 29 | 30 | -- | Radical of an integer 31 | -- 32 | -- \( \text{rad}(n) = \displaystyle\prod_{p | n} p \) 33 | radical :: Int -> Int 34 | radical = conjugate radical_ats 35 | 36 | -- | \( O(\sqrt(n)) \) 37 | isPrime :: Int -> Bool 38 | isPrime = asTest is_prime_ats 39 | 40 | -- | @since 0.6.5.0 41 | isSemiprime :: Int -> Bool 42 | isSemiprime = asTest is_semiprime_ats 43 | 44 | -- | See [here](http://mathworld.wolfram.com/PerfectNumber.html) 45 | isPerfect :: Int -> Bool 46 | isPerfect = asTest is_perfect_ats 47 | 48 | -- | Sum of proper divisors. May overflow. 49 | sumDivisors :: Int -> Int 50 | sumDivisors = conjugate sum_divisors_ats 51 | 52 | -- | Number of distinct prime factors 53 | littleOmega :: Int -> Int 54 | littleOmega = conjugate little_omega_ats 55 | 56 | -- | Number of distinct divisors. 57 | tau :: Int -> Int 58 | tau = conjugate count_divisors_ats 59 | 60 | -- | Euler totient function. 61 | totient :: Int -> Int 62 | totient = conjugate totient_ats 63 | -------------------------------------------------------------------------------- /fast-arithmetic/test/Spec.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import qualified Math.Combinat.Numbers as Ext 4 | import qualified Math.NumberTheory.ArithmeticFunctions as Ext 5 | import Numeric.Combinatorics 6 | import Numeric.Haskell 7 | import Numeric.NumberTheory 8 | import Test.Hspec 9 | import Test.Hspec.QuickCheck 10 | import Test.QuickCheck hiding (choose) 11 | 12 | agreeL :: (Eq a, Show b, Integral b, Arbitrary b) => b -> String -> (b -> a) -> (b -> a) -> SpecWith () 13 | agreeL lower s f g = describe s $ 14 | prop "should agree with the pure Haskell function" $ 15 | \n -> n < lower || f n == g n 16 | 17 | agree :: (Eq a, Show b, Integral b, Arbitrary b) => String -> (b -> a) -> (b -> a) -> SpecWith () 18 | agree = agreeL 1 19 | 20 | main :: IO () 21 | main = hspec $ parallel $ do 22 | 23 | sequence_ $ zipWith3 agree 24 | ["totient", "tau", "littleOmega", "sumDivisors"] 25 | [totient, tau, littleOmega, sumDivisors] 26 | [Ext.totient, Ext.tau, Ext.smallOmega, Ext.sigma 1] 27 | 28 | sequence_ $ zipWith3 (agreeL 0) 29 | ["catalan", "doubleFactorial", "factorial", "maxRegions", "bell"] 30 | [catalan, doubleFactorial, factorial, maxRegions, bell] 31 | [Ext.catalan, Ext.doubleFactorial, Ext.factorial, hsMaxRegions, Ext.bellNumber] 32 | 33 | sequence_ $ zipWith3 agree 34 | ["isPrime", "isSemiprime"] 35 | [isPrime, isSemiprime] 36 | [hsIsPrime, hsIsSemiprime] 37 | 38 | describe "jacobi" $ 39 | prop "should match the arithmoi function" $ 40 | pendingWith "not yet" -- \p q -> p < 0 || not (isPrime q) || q <= 2 || jacobi p q == toInt (Ext.jacobi p q) 41 | describe "risingFac" $ 42 | prop "should agree" $ 43 | \n a -> n <= 0 || a <= 0 || risingFac a n == hsRisingFac (fromIntegral a) (fromIntegral n :: Int) 44 | describe "stirling2" $ 45 | prop "should agree" $ 46 | \n k -> n < 0 || k < 0 || stirling2 n k == Ext.stirling2nd n k 47 | describe "choose" $ 48 | prop "should agree" $ 49 | \a b -> a < 0 || b < 0 || choose b a == Ext.binomial b a 50 | describe "derangement" $ 51 | prop "should agree" $ 52 | \a -> a < 1 || derangement a == hsDerangement a 53 | describe "permutations" $ 54 | prop "should agree" $ 55 | \n k -> k < 1 || k > n || permutations n k == hsPermutations (fromIntegral n) (fromIntegral k) 56 | describe "derangement" $ 57 | prop "should be equal to [n!/e]" $ 58 | \n -> n < 1 || n > 18 || (derangement n :: Integer) == floor ((fromIntegral (Ext.factorial (fromIntegral n :: Int) :: Integer) :: Double) / exp 1 + 0.5) 59 | describe "totient" $ 60 | prop "should satisfy Fermat's little theorem" $ 61 | \a m -> a < 1 || m < 2 || gcd a m /= 1 || ((a ^ totient (fromIntegral m)) `mod` m == (1 :: Integer)) 62 | describe "totient" $ 63 | prop "should be equal to p-1 for p prime" $ 64 | \p -> p < 1 || not (isPrime p) || totient p == p - 1 65 | describe "stirling" $ 66 | prop "should obey the identity I found on Wolfram MathWorld" $ 67 | \n -> n <= 1 || sum [ ((-1) ^ m) * factorial (m-1) * stirling2 n m | m <- [1..n] ] == 0 68 | --------------------------------------------------------------------------------