├── .projectile ├── .gitattributes ├── cabal.project ├── .ghci ├── .gitignore ├── test └── doctests.hs ├── .hlint.yaml ├── src ├── NumHask │ ├── Exception.hs │ ├── Data │ │ ├── Wrapped.hs │ │ ├── Complex.hs │ │ ├── Positive.hs │ │ ├── Rational.hs │ │ └── Integral.hs │ ├── Algebra │ │ ├── Action.hs │ │ ├── Group.hs │ │ ├── Ring.hs │ │ ├── Multiplicative.hs │ │ ├── Additive.hs │ │ ├── Lattice.hs │ │ ├── Field.hs │ │ └── Metric.hs │ └── Prelude.hs └── NumHask.hs ├── LICENSE ├── stack.yaml ├── .github └── workflows │ └── haskell-ci.yml ├── ChangeLog.md ├── numhask.cabal ├── readme.md └── other ├── nh11.svg └── nh12.svg /.projectile: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | other/* linguist-documentation 2 | *.dhall linguist-documentation 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: numhask.cabal 2 | 3 | write-ghc-environment-files: always 4 | -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | :set -XRebindableSyntax 2 | :set -XOverloadedStrings 3 | :set -Wno-type-defaults 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | */.stack-work/ 3 | TAGS 4 | .DS_Store 5 | .stack-work 6 | /dist-newstyle 7 | /stack.yaml.lock 8 | .ghc.environment* 9 | /cabal.project.local 10 | /.hie/ 11 | /.hkgr/ 12 | /checklist.org 13 | -------------------------------------------------------------------------------- /test/doctests.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment (getArgs) 4 | import Test.DocTest (mainFromCabal) 5 | import Prelude (IO, (=<<)) 6 | 7 | main :: IO () 8 | main = mainFromCabal "numhask" =<< getArgs 9 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | - ignore: {name: Use if} 2 | - ignore: {name: Use tan, within: NumHask.Algebra.Field} 3 | - ignore: {name: Use logBase, within: NumHask.Algebra.Field} 4 | - ignore: {name: Use -} 5 | - ignore: {name: Eta reduce} 6 | - ignore: {name: Use bimap} 7 | - ignore: {name: Redundant fromInteger} 8 | -------------------------------------------------------------------------------- /src/NumHask/Exception.hs: -------------------------------------------------------------------------------- 1 | -- | Exceptions arising within numhask. 2 | module NumHask.Exception 3 | ( NumHaskException (..), 4 | throw, 5 | ) 6 | where 7 | 8 | import Control.Exception 9 | import Prelude qualified as P 10 | 11 | -- | A numhask exception. 12 | newtype NumHaskException = NumHaskException {errorMessage :: P.String} 13 | deriving (P.Show) 14 | 15 | instance Exception NumHaskException 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Tony Day 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Tony Day nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /src/NumHask/Data/Wrapped.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE UndecidableInstances #-} 3 | 4 | -- | Wrapped numhask instances, useful for derivingvia situations to quickly specifiy a numhask friendly numerical type. 5 | module NumHask.Data.Wrapped 6 | ( Wrapped (..), 7 | ) 8 | where 9 | 10 | import NumHask.Algebra.Action 11 | import NumHask.Algebra.Additive 12 | import NumHask.Algebra.Field 13 | import NumHask.Algebra.Lattice 14 | import NumHask.Algebra.Metric 15 | import NumHask.Algebra.Multiplicative 16 | import NumHask.Algebra.Ring 17 | import NumHask.Data.Integral 18 | import NumHask.Data.Rational 19 | import Prelude qualified as P 20 | 21 | -- | Wrapped numhask instances 22 | newtype Wrapped a = Wrapped {unWrapped :: a} 23 | deriving 24 | ( P.Show, 25 | P.Eq, 26 | P.Ord, 27 | Additive, 28 | Subtractive, 29 | Multiplicative, 30 | Divisive, 31 | ExpField, 32 | TrigField, 33 | StarSemiring, 34 | InvolutiveRing, 35 | Integral, 36 | FromInteger, 37 | FromRational, 38 | MeetSemiLattice, 39 | JoinSemiLattice, 40 | LowerBounded, 41 | UpperBounded, 42 | Basis, 43 | Direction, 44 | Epsilon, 45 | AdditiveAction, 46 | SubtractiveAction, 47 | MultiplicativeAction, 48 | DivisiveAction 49 | ) 50 | 51 | instance 52 | (P.Ord a, P.Eq (Whole a), Integral (Whole a), Subtractive (Whole a), Subtractive a, QuotientField a) => 53 | QuotientField (Wrapped a) 54 | where 55 | type Whole (Wrapped a) = Whole a 56 | properFraction (Wrapped a) = let (i, r) = properFraction a in (i, Wrapped r) 57 | 58 | instance (FromIntegral a b) => FromIntegral (Wrapped a) b where 59 | fromIntegral a = Wrapped (fromIntegral a) 60 | 61 | instance (ToIntegral a b) => ToIntegral (Wrapped a) b where 62 | toIntegral (Wrapped a) = toIntegral a 63 | 64 | instance (FromRatio a b) => FromRatio (Wrapped a) b where 65 | fromRatio a = Wrapped (fromRatio a) 66 | 67 | instance (ToRatio a b) => ToRatio (Wrapped a) b where 68 | toRatio (Wrapped a) = toRatio a 69 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/configure/yaml/ 6 | 7 | # A 'specific' Stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # snapshot: lts-23.24 12 | # snapshot: nightly-2025-06-15 13 | # snapshot: ghc-9.8.4 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # snapshot: ./custom-snapshot.yaml 19 | # snapshot: https://example.com/snapshots/2024-01-01.yaml 20 | snapshot: nightly-2025-07-26 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the snapshot. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for project packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of Stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=3.7" 56 | # 57 | # Override the architecture used by Stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by Stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Action.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | 3 | -- | Algebra for Actions 4 | -- 5 | -- Convention: the |'s in the operators point towards the higher-kinded number, representing an operator or action __into__ a structure. 6 | module NumHask.Algebra.Action 7 | ( AdditiveAction (..), 8 | (+|), 9 | SubtractiveAction (..), 10 | (-|), 11 | MultiplicativeAction (..), 12 | (*|), 13 | DivisiveAction (..), 14 | (/|), 15 | Module, 16 | ) 17 | where 18 | 19 | import Data.Kind (Type) 20 | import NumHask.Algebra.Additive (Additive, Subtractive, negate) 21 | import NumHask.Algebra.Multiplicative (Divisive, Multiplicative, recip) 22 | import NumHask.Algebra.Ring (Distributive) 23 | import Prelude (flip) 24 | 25 | -- | Additive Action 26 | -- 27 | -- > m |+ zero == m 28 | class 29 | (Additive (AdditiveScalar m)) => 30 | AdditiveAction m 31 | where 32 | type AdditiveScalar m :: Type 33 | 34 | infixl 6 |+ 35 | (|+) :: m -> AdditiveScalar m -> m 36 | 37 | infixl 6 +| 38 | 39 | -- | flipped additive action 40 | -- 41 | -- > (+|) == flip (|+) 42 | -- > zero +| m = m 43 | (+|) :: (AdditiveAction m) => AdditiveScalar m -> m -> m 44 | (+|) = flip (|+) 45 | 46 | -- | Subtractive Action 47 | -- 48 | -- > m |- zero = m 49 | class 50 | (AdditiveAction m, Subtractive (AdditiveScalar m)) => 51 | SubtractiveAction m 52 | where 53 | infixl 6 |- 54 | (|-) :: m -> AdditiveScalar m -> m 55 | 56 | infixl 6 -| 57 | 58 | -- | Subtraction with the scalar on the left 59 | -- 60 | -- > (-|) == (+|) . negate 61 | -- > zero -| m = negate m 62 | (-|) :: (AdditiveAction m, Subtractive m) => AdditiveScalar m -> m -> m 63 | a -| b = a +| negate b 64 | 65 | -- | Multiplicative Action 66 | -- 67 | -- > m |* one = m 68 | -- > m |* zero = zero 69 | class 70 | (Multiplicative (Scalar m)) => 71 | MultiplicativeAction m 72 | where 73 | type Scalar m :: Type 74 | 75 | infixl 7 |* 76 | (|*) :: m -> Scalar m -> m 77 | 78 | infixl 7 *| 79 | 80 | -- | flipped multiplicative action 81 | -- 82 | -- > (*|) == flip (|*) 83 | -- > one *| m = one 84 | -- > zero *| m = zero 85 | (*|) :: (MultiplicativeAction m) => Scalar m -> m -> m 86 | (*|) = flip (|*) 87 | 88 | -- | Divisive Action 89 | -- 90 | -- > m |/ one = m 91 | class 92 | (Divisive (Scalar m), MultiplicativeAction m) => 93 | DivisiveAction m 94 | where 95 | infixl 7 |/ 96 | (|/) :: m -> Scalar m -> m 97 | 98 | -- | left scalar division 99 | -- 100 | -- > (/|) == (*|) . recip 101 | -- > one |/ m = recip m 102 | (/|) :: (MultiplicativeAction m, Divisive m) => Scalar m -> m -> m 103 | a /| b = a *| recip b 104 | 105 | -- | A 106 | -- 107 | -- > a *| one == a 108 | -- > (a + b) *| c == (a *| c) + (b *| c) 109 | -- > c |* (a + b) == (c |* a) + (c |* b) 110 | -- > a *| zero == zero 111 | -- > a *| b == b |* a 112 | type Module m = (Distributive (Scalar m), MultiplicativeAction m) 113 | -------------------------------------------------------------------------------- /src/NumHask/Prelude.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK prune #-} 2 | 3 | -- | A prelude composed by overlaying numhask on Prelude, together with a few minor tweaks needed for RebindableSyntax. 4 | module NumHask.Prelude 5 | ( -- * numhask exports 6 | module NumHask.Algebra.Additive, 7 | module NumHask.Algebra.Field, 8 | module NumHask.Algebra.Group, 9 | module NumHask.Algebra.Lattice, 10 | module NumHask.Algebra.Action, 11 | module NumHask.Algebra.Multiplicative, 12 | module NumHask.Algebra.Ring, 13 | module NumHask.Algebra.Metric, 14 | module NumHask.Data.Complex, 15 | module NumHask.Data.Integral, 16 | module NumHask.Data.Rational, 17 | module NumHask.Exception, 18 | 19 | -- * rebindables 20 | -- $rebindables 21 | fromString, 22 | ifThenElse, 23 | fromList, 24 | fromListN, 25 | Natural (..), 26 | module GHC.OverloadedLabels, 27 | 28 | -- * Modules you can't live without 29 | module Data.Bool, 30 | module Data.Kind, 31 | module GHC.Generics, 32 | module Control.Applicative, 33 | module Data.Traversable, 34 | module Data.Semigroup, 35 | module Data.Maybe, 36 | 37 | -- * Data.Function 38 | module Data.Function, 39 | 40 | -- * Control.Category 41 | 42 | -- Putting id back. 43 | module Control.Category, 44 | 45 | -- * Data.Foldable 46 | module Data.Foldable, 47 | 48 | -- * The Prelude 49 | module Prelude, 50 | ) 51 | where 52 | 53 | import Control.Applicative 54 | import Control.Category 55 | import Data.Bool 56 | import Data.Foldable hiding (product, sum) 57 | import Data.Function hiding (id, (.)) 58 | import Data.Kind 59 | import Data.Maybe 60 | import Data.Semigroup hiding (Product (..), Sum (..)) 61 | import Data.Traversable 62 | import GHC.Exts 63 | import GHC.Generics 64 | import GHC.Natural (Natural (..)) 65 | import GHC.OverloadedLabels 66 | import NumHask.Algebra.Action 67 | import NumHask.Algebra.Additive 68 | import NumHask.Algebra.Field 69 | import NumHask.Algebra.Group 70 | import NumHask.Algebra.Lattice 71 | import NumHask.Algebra.Metric 72 | import NumHask.Algebra.Multiplicative 73 | import NumHask.Algebra.Ring 74 | import NumHask.Data.Complex 75 | import NumHask.Data.Integral 76 | import NumHask.Data.Rational 77 | import NumHask.Exception 78 | import Prelude hiding (Integral (..), Rational, abs, acos, acosh, asin, asinh, atan, atan2, atanh, ceiling, cos, cosh, even, exp, floor, fromInteger, fromIntegral, fromRational, gcd, id, log, logBase, negate, odd, pi, product, properFraction, recip, round, signum, sin, sinh, sqrt, subtract, sum, tan, tanh, toInteger, toRational, truncate, (*), (**), (+), (-), (.), (/), (^), (^^)) 79 | 80 | -- $usage 81 | -- 82 | -- >>> :m -Prelude 83 | -- >>> :set -XRebindableSyntax 84 | -- >>> import NumHask.Prelude 85 | -- >>> 1+1 86 | -- 2 87 | 88 | -- $rebindables 89 | -- 90 | -- Using different types for numbers requires RebindableSyntax. This then removes base-level stuff that has to be put back in. 91 | 92 | -- | RebindableSyntax splats this, and I'm not sure where it exists in GHC land 93 | ifThenElse :: Bool -> a -> a -> a 94 | ifThenElse True x _ = x 95 | ifThenElse False _ y = y 96 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | on: [push] 3 | 4 | # INFO: The following configuration block ensures that only one build runs per branch, 5 | # which may be desirable for projects with a costly build process. 6 | # Remove this block from the CI workflow to let each CI job run to completion. 7 | concurrency: 8 | group: build-${{ github.ref }} 9 | cancel-in-progress: true 10 | 11 | jobs: 12 | hlint: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - uses: actions/checkout@v4 16 | - uses: haskell-actions/hlint-setup@v2 17 | - uses: haskell-actions/hlint-run@v2 18 | with: 19 | path: . 20 | fail-on: warning 21 | ormolu: 22 | runs-on: ubuntu-latest 23 | steps: 24 | - uses: actions/checkout@v4 25 | - uses: haskell-actions/run-ormolu@v17 26 | build: 27 | name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }} 28 | runs-on: ${{ matrix.os }} 29 | strategy: 30 | fail-fast: false 31 | matrix: 32 | os: [ubuntu-latest] 33 | ghc-version: ['9.12', '9.10', '9.8', '9.6','8.10'] 34 | 35 | include: 36 | - os: windows-latest 37 | ghc-version: '9.12' 38 | - os: macos-latest 39 | ghc-version: '9.12' 40 | 41 | steps: 42 | - uses: actions/checkout@v4 43 | 44 | - name: Set up GHC ${{ matrix.ghc-version }} 45 | uses: haskell-actions/setup@v2 46 | id: setup 47 | with: 48 | ghc-version: ${{ matrix.ghc-version }} 49 | 50 | - name: Configure the build 51 | run: | 52 | cabal configure --enable-tests --enable-benchmarks --disable-documentation 53 | cabal build --dry-run 54 | # The last step generates dist-newstyle/cache/plan.json for the cache key. 55 | 56 | - name: Restore cached dependencies 57 | uses: actions/cache/restore@v4 58 | id: cache 59 | env: 60 | key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} 61 | with: 62 | path: ${{ steps.setup.outputs.cabal-store }} 63 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 64 | restore-keys: ${{ env.key }}- 65 | 66 | - name: Install dependencies 67 | # If we had an exact cache hit, the dependencies will be up to date. 68 | if: steps.cache.outputs.cache-hit != 'true' 69 | run: cabal build all --only-dependencies 70 | 71 | # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. 72 | - name: Save cached dependencies 73 | uses: actions/cache/save@v4 74 | # If we had an exact cache hit, trying to save the cache would error because of key clash. 75 | if: steps.cache.outputs.cache-hit != 'true' 76 | with: 77 | path: ${{ steps.setup.outputs.cabal-store }} 78 | key: ${{ steps.cache.outputs.cache-primary-key }} 79 | 80 | - name: Build 81 | run: cabal build all 82 | 83 | - if: ${{ matrix.os == 'ubuntu-latest' && matrix.ghc-version == '9.12'}} 84 | name: doctests 85 | run: cabal run doctests 86 | 87 | - name: Check cabal file 88 | run: cabal check 89 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | 0.13.1 2 | === 3 | 4 | - added Data instances 5 | 6 | 7 | 0.13 8 | === 9 | 10 | - added modF, divF and divModF as field versions of modulo and diviso Integral functions. 11 | - fixed bug in EuclideanPair log function. 12 | - BoundedJoinSemiLattice becomes LowerBounded 13 | - BoundedMeetSemiLattice becomes UpperBounded 14 | - switch to GHC2024 15 | 16 | 0.12.1 17 | === 18 | 19 | - added doctests 20 | 21 | 0.12 22 | === 23 | 24 | - added SemiField, and bumped QuotientField to default for Subtraction. 25 | 26 | - moved infinity & nqn to SemiField, from Field. 27 | 28 | - introduced NumHask.Data.Positive 29 | 30 | - introduced NumHask.Data.Wrapped 31 | 32 | - Monus & Addus 33 | 34 | - hiding Prelude.Rational 35 | 36 | 0.11.1.0 37 | === 38 | * Added Sum (..) 39 | * Added Product (..) 40 | 41 | 0.11.0.0 42 | === 43 | 44 | * TypeFamilies introduced replacing FunDep usage for QuotientField, AdditiveAction, MultiplicativeAction, Basis. Classes go from Multi-parameter to single. 45 | * EuclideanPair introduced as an intended DerivingVia support for 2 dimensional Basis & Direction instances. 46 | * Complex modified to use EuclideanPair. Underlying representation changed to tuple and (+:) constructor as a top-level function. 47 | * Action class operators changed from (.\*) to (|\*), and (\*.) to (\*|) etc. 48 | * Ring, Field, Distributive & Module become type synonyms (were classes). 49 | * Added Basis class replacing Norm & Signed 50 | * extra type synonyms added for Basis specialisations: Absolute, Sign, EndoBased. 51 | * abs becomes top-level function (previously method of Norm). 52 | * sign removed and replaced with signum, mirroring Num. 53 | * aboutEqual & nearZero moved outside Epsilon class definition. 54 | * rationalised Language pragmas around GHC2021 55 | * introduced QuotientField instance for Complex & EuclideanPair without Ord constraint. 56 | 57 | 0.10.0 58 | === 59 | * Moved operators back in. 60 | * added doctests and properties 61 | * added accsum & accproduct 62 | * fixed Ratio Eq instance 63 | 64 | 0.9.0 65 | === 66 | * Removed bounded classes. 67 | * Moved operators outside of class definitions where possible. 68 | 69 | 0.8.0 70 | ===== 71 | 72 | * GHC 9.0.1 support 73 | * Removed protolude and replaced it with prelude 74 | * Removed NumHask.Data.Positive, NumHask.Data.LogFloat, NumHask.Data.Wrapper 75 | * modified project build to cabal 76 | * removed NegativeLiterals recommendation. 77 | 78 | 0.7.0 79 | ===== 80 | 81 | * GHC 8.10.2 support 82 | * Modules `NumHask.Algebra.Abstract.*` renamed to `NumHask.Algebra.*` 83 | * Renamed `Normed` to `Norm` and added `basis` 84 | * Removed `Metric` and added `distance` 85 | * Added `Direction`, `Polar`, `polar`, `coord`; streamlined `Complex` 86 | * Removed `NumHask.Data.Pair` 87 | * Fixed `FromIntegral` and `FromRational` to work in well with rebindable syntax. 88 | * Added fundeps to `Norm`, `Direction` 89 | * Integrated `NumHask.Algebra.Action` into `NumHask.Algebra.Module` 90 | * Added `atan2` 91 | * Added doctests and laws 92 | * Improved haddocks 93 | * Made (^) a monomorphic `a -> Int -> a` and accept negative Ints 94 | 95 | 96 | 0.6.0 97 | ===== 98 | 99 | * GHC 8.10.1 support 100 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Group.hs: -------------------------------------------------------------------------------- 1 | -- | The Group hierarchy 2 | module NumHask.Algebra.Group 3 | ( Magma (..), 4 | Unital (..), 5 | Associative, 6 | Commutative, 7 | Absorbing (..), 8 | Invertible (..), 9 | Idempotent, 10 | Group, 11 | AbelianGroup, 12 | ) 13 | where 14 | 15 | import Prelude 16 | 17 | -- * Magma structure 18 | 19 | -- | A is a tuple (T,magma) consisting of 20 | -- 21 | -- - a type a, and 22 | -- 23 | -- - a function (magma) :: T -> T -> T 24 | -- 25 | -- The mathematical laws for a magma are: 26 | -- 27 | -- - magma is defined for all possible pairs of type T, and 28 | -- 29 | -- - magma is closed in the set of all possible values of type T 30 | -- 31 | -- or, more tersly, 32 | -- 33 | -- > ∀ a, b ∈ T: a ⊕ b ∈ T 34 | -- 35 | -- These laws are true by construction in haskell: the type signature of '⊕' and the above mathematical laws are synonyms. 36 | class Magma a where 37 | infix 3 ⊕ 38 | (⊕) :: a -> a -> a 39 | 40 | instance (Magma b) => Magma (a -> b) where 41 | f ⊕ g = \a -> f a ⊕ g a 42 | 43 | -- | A Unital Magma is a magma with an 44 | -- (the 45 | -- unit). 46 | -- 47 | -- > unit ⊕ a = a 48 | -- > a ⊕ unit = a 49 | class 50 | (Magma a) => 51 | Unital a 52 | where 53 | unit :: a 54 | 55 | instance (Unital b) => Unital (a -> b) where 56 | {-# INLINE unit #-} 57 | unit _ = unit 58 | 59 | -- | An Associative Magma 60 | -- 61 | -- > (a ⊕ b) ⊕ c = a ⊕ (b ⊕ c) 62 | class 63 | (Magma a) => 64 | Associative a 65 | 66 | instance (Associative b) => Associative (a -> b) 67 | 68 | -- | A Commutative Magma is a Magma where the binary operation is 69 | -- . 70 | -- 71 | -- > a ⊕ b = b ⊕ a 72 | class 73 | (Magma a) => 74 | Commutative a 75 | 76 | instance (Commutative b) => Commutative (a -> b) 77 | 78 | -- | An Invertible Magma 79 | -- 80 | -- > ∀ a,b ∈ T: inv a ⊕ (a ⊕ b) = b = (b ⊕ a) ⊕ inv a 81 | class 82 | (Magma a) => 83 | Invertible a 84 | where 85 | inv :: a -> a 86 | 87 | instance (Invertible b) => Invertible (a -> b) where 88 | {-# INLINE inv #-} 89 | inv f = inv . f 90 | 91 | -- | A is a 92 | -- Associative, Unital and Invertible Magma. 93 | type Group a = (Associative a, Unital a, Invertible a) 94 | 95 | -- | An Absorbing is a Magma with an 96 | -- 97 | -- 98 | -- > a ⊕ absorb = absorb 99 | class 100 | (Magma a) => 101 | Absorbing a 102 | where 103 | absorb :: a 104 | 105 | instance (Absorbing b) => Absorbing (a -> b) where 106 | {-# INLINE absorb #-} 107 | absorb _ = absorb 108 | 109 | -- | An Idempotent Magma is a magma where every element is 110 | -- . 111 | -- 112 | -- > a ⊕ a = a 113 | class 114 | (Magma a) => 115 | Idempotent a 116 | 117 | instance (Idempotent b) => Idempotent (a -> b) 118 | 119 | -- | An is an 120 | -- Associative, Unital, Invertible and Commutative Magma . In other words, it 121 | -- is a Commutative Group 122 | type AbelianGroup a = (Associative a, Unital a, Invertible a, Commutative a) 123 | -------------------------------------------------------------------------------- /src/NumHask/Data/Complex.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | 5 | -- | Complex numbers. 6 | module NumHask.Data.Complex 7 | ( Complex (..), 8 | (+:), 9 | realPart, 10 | imagPart, 11 | ) 12 | where 13 | 14 | import Data.Data (Data) 15 | import GHC.Generics 16 | import NumHask.Algebra.Additive 17 | import NumHask.Algebra.Field 18 | import NumHask.Algebra.Lattice 19 | import NumHask.Algebra.Metric 20 | import NumHask.Algebra.Multiplicative 21 | import NumHask.Algebra.Ring 22 | import NumHask.Data.Integral 23 | import Prelude hiding 24 | ( Num (..), 25 | atan, 26 | atan2, 27 | ceiling, 28 | cos, 29 | exp, 30 | floor, 31 | fromIntegral, 32 | log, 33 | negate, 34 | pi, 35 | properFraction, 36 | recip, 37 | round, 38 | sin, 39 | sqrt, 40 | truncate, 41 | (/), 42 | ) 43 | 44 | -- $setup 45 | -- 46 | -- >>> import NumHask.Prelude 47 | -- >>> :m -Prelude 48 | 49 | -- | The underlying representation is a newtype-wrapped tuple, compared with the base datatype. This was chosen to facilitate the use of DerivingVia. 50 | newtype Complex a = Complex {complexPair :: (a, a)} 51 | deriving stock 52 | ( Eq, 53 | Show, 54 | Read, 55 | Generic, 56 | Data, 57 | Functor 58 | ) 59 | deriving 60 | ( Additive, 61 | Subtractive, 62 | Basis, 63 | Direction, 64 | Epsilon, 65 | JoinSemiLattice, 66 | MeetSemiLattice, 67 | LowerBounded, 68 | UpperBounded, 69 | ExpField 70 | ) 71 | via (EuclideanPair a) 72 | 73 | infixl 6 +: 74 | 75 | -- | Complex number constructor. 76 | -- 77 | -- Internally, Complex derives most instances via EuclideanPair. For instance, 78 | -- 79 | -- >>> sqrt (1.0 +: (-1.0)) :: Complex Double 80 | -- Complex {complexPair = (1.0986841134678098,-0.45508986056222733)} 81 | -- 82 | -- >>> sqrt ((-1.0) +: 0.0) :: Complex Double 83 | -- Complex {complexPair = (6.123233995736766e-17,1.0)} 84 | (+:) :: a -> a -> Complex a 85 | (+:) r i = Complex (r, i) 86 | 87 | -- | Extracts the real part of a complex number. 88 | realPart :: Complex a -> a 89 | realPart (Complex (x, _)) = x 90 | 91 | -- | Extracts the imaginary part of a complex number. 92 | imagPart :: Complex a -> a 93 | imagPart (Complex (_, y)) = y 94 | 95 | instance 96 | (Subtractive a, Multiplicative a) => 97 | Multiplicative (Complex a) 98 | where 99 | (Complex (r, i)) * (Complex (r', i')) = 100 | Complex (r * r' - i * i', i * r' + i' * r) 101 | one = one +: zero 102 | 103 | instance 104 | (Subtractive a, Divisive a) => 105 | Divisive (Complex a) 106 | where 107 | recip (Complex (r, i)) = (r * d) +: (negate i * d) 108 | where 109 | d = recip ((r * r) + (i * i)) 110 | 111 | instance 112 | (Additive a, FromIntegral a b) => 113 | FromIntegral (Complex a) b 114 | where 115 | fromIntegral x = fromIntegral x +: zero 116 | 117 | instance (Distributive a, Subtractive a) => InvolutiveRing (Complex a) where 118 | adj (Complex (r, i)) = r +: negate i 119 | 120 | -- Can't use DerivingVia due to extra Whole constraints 121 | instance (Subtractive a, QuotientField a) => QuotientField (Complex a) where 122 | type Whole (Complex a) = Complex (Whole a) 123 | 124 | properFraction (Complex (x, y)) = 125 | (Complex (xwhole, ywhole), Complex (xfrac, yfrac)) 126 | where 127 | (xwhole, xfrac) = properFraction x 128 | (ywhole, yfrac) = properFraction y 129 | 130 | round (Complex (x, y)) = Complex (round x, round y) 131 | ceiling (Complex (x, y)) = Complex (ceiling x, ceiling y) 132 | floor (Complex (x, y)) = Complex (floor x, floor y) 133 | truncate (Complex (x, y)) = Complex (truncate x, truncate y) 134 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Ring.hs: -------------------------------------------------------------------------------- 1 | -- | Ring classes 2 | module NumHask.Algebra.Ring 3 | ( Distributive, 4 | Ring, 5 | StarSemiring (..), 6 | KleeneAlgebra, 7 | InvolutiveRing (..), 8 | two, 9 | ) 10 | where 11 | 12 | import Data.Int (Int16, Int32, Int64, Int8) 13 | import Data.Word (Word, Word16, Word32, Word64, Word8) 14 | import GHC.Natural (Natural (..)) 15 | import NumHask.Algebra.Additive (Additive ((+)), Subtractive) 16 | import NumHask.Algebra.Group (Idempotent) 17 | import NumHask.Algebra.Multiplicative (Multiplicative (..)) 18 | import Prelude qualified as P 19 | 20 | -- $setup 21 | -- 22 | -- >>> :m -Prelude 23 | -- >>> :set -XRebindableSyntax 24 | -- >>> import NumHask.Prelude 25 | 26 | -- | 27 | -- 28 | -- prop> \a b c -> a * (b + c) == a * b + a * c 29 | -- prop> \a b c -> (a + b) * c == a * c + b * c 30 | -- prop> \a -> zero * a == zero 31 | -- prop> \a -> a * zero == zero 32 | -- 33 | -- The sneaking in of the laws here glosses over the possibility that the multiplicative zero element does not have to correspond with the additive unital zero. 34 | type Distributive a = (Additive a, Multiplicative a) 35 | 36 | -- | A is an abelian group under addition ('NumHask.Algebra.Unital', 'NumHask.Algebra.Associative', 'NumHask.Algebra.Commutative', 'NumHask.Algebra.Invertible') and monoidal under multiplication ('NumHask.Algebra.Unital', 'NumHask.Algebra.Associative'), and where multiplication distributes over addition. 37 | -- 38 | -- > \a -> zero + a == a 39 | -- > \a -> a + zero == a 40 | -- > \a b c -> (a + b) + c == a + (b + c) 41 | -- > \a b -> a + b == b + a 42 | -- > \a -> a - a == zero 43 | -- > \a -> negate a == zero - a 44 | -- > \a -> negate a + a == zero 45 | -- > \a -> a + negate a == zero 46 | -- > \a -> one * a == a 47 | -- > \a -> a * one == a 48 | -- > \a b c -> (a * b) * c == a * (b * c) 49 | -- > \a b c -> a * (b + c) == a * b + a * c 50 | -- > \a b c -> (a + b) * c == a * c + b * c 51 | -- > \a -> zero * a == zero 52 | -- > \a -> a * zero == zero 53 | type Ring a = (Distributive a, Subtractive a) 54 | 55 | -- | A is a semiring with an additional unary operator (star) satisfying: 56 | -- 57 | -- > \a -> star a == one + a * star a 58 | class (Distributive a) => StarSemiring a where 59 | {-# MINIMAL star | plus #-} 60 | 61 | star :: a -> a 62 | star a = one + plus a 63 | 64 | plus :: a -> a 65 | plus a = a * star a 66 | 67 | -- | A is a Star Semiring with idempotent addition. 68 | -- 69 | -- > a * x + x = a ==> star a * x + x = x 70 | -- > x * a + x = a ==> x * star a + x = x 71 | class (StarSemiring a, Idempotent a) => KleeneAlgebra a 72 | 73 | -- | Involutive Ring 74 | -- 75 | -- > adj (a + b) ==> adj a + adj b 76 | -- > adj (a * b) ==> adj a * adj b 77 | -- > adj one ==> one 78 | -- > adj (adj a) ==> a 79 | -- 80 | -- Note: elements for which @adj a == a@ are called "self-adjoint". 81 | class (Distributive a) => InvolutiveRing a where 82 | adj :: a -> a 83 | adj x = x 84 | 85 | instance InvolutiveRing P.Double 86 | 87 | instance InvolutiveRing P.Float 88 | 89 | instance InvolutiveRing P.Integer 90 | 91 | instance InvolutiveRing P.Int 92 | 93 | instance InvolutiveRing Natural 94 | 95 | instance InvolutiveRing Int8 96 | 97 | instance InvolutiveRing Int16 98 | 99 | instance InvolutiveRing Int32 100 | 101 | instance InvolutiveRing Int64 102 | 103 | instance InvolutiveRing Word 104 | 105 | instance InvolutiveRing Word8 106 | 107 | instance InvolutiveRing Word16 108 | 109 | instance InvolutiveRing Word32 110 | 111 | instance InvolutiveRing Word64 112 | 113 | -- | Defining 'two' requires adding the multiplicative unital to itself. In other words, the concept of 'two' is a Ring one. 114 | -- 115 | -- >>> two 116 | -- 2 117 | two :: (Multiplicative a, Additive a) => a 118 | two = one + one 119 | -------------------------------------------------------------------------------- /numhask.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: numhask 3 | version: 0.13.1.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | copyright: Tony Day (c) 2016 7 | category: math 8 | author: Tony Day 9 | maintainer: tonyday567@gmail.com 10 | homepage: https://github.com/tonyday567/numhask#readme 11 | bug-reports: https://github.com/tonyday567/numhask/issues 12 | synopsis: A numeric class hierarchy. 13 | description: 14 | This package provides alternative numeric classes over Prelude. 15 | 16 | The numeric class constellation looks somewhat like: 17 | 18 | ![nh](docs/other/nh12.svg) 19 | 20 | == Usage 21 | 22 | >>> {-# LANGUAGE GHC2024 #-} 23 | >>> {-# LANGUAGE RebindableSyntax #-} 24 | >>> import NumHask.Prelude 25 | 26 | See "NumHask" for a detailed overview. 27 | 28 | build-type: Simple 29 | tested-with: 30 | ghc ==8.10.7 31 | ghc ==9.6.7 32 | ghc ==9.8.4 33 | ghc ==9.10.2 34 | ghc ==9.12.2 35 | 36 | extra-doc-files: 37 | ChangeLog.md 38 | other/*.svg 39 | readme.md 40 | 41 | source-repository head 42 | type: git 43 | location: https://github.com/tonyday567/numhask 44 | 45 | common ghc-options-stanza 46 | ghc-options: 47 | -Wall 48 | -Wcompat 49 | -Widentities 50 | -Wincomplete-record-updates 51 | -Wincomplete-uni-patterns 52 | -Wpartial-fields 53 | -Wredundant-constraints 54 | 55 | common ghc2021-additions 56 | default-extensions: 57 | BangPatterns 58 | BinaryLiterals 59 | ConstrainedClassMethods 60 | ConstraintKinds 61 | DeriveDataTypeable 62 | DeriveFoldable 63 | DeriveFunctor 64 | DeriveGeneric 65 | DeriveLift 66 | DeriveTraversable 67 | DoAndIfThenElse 68 | EmptyCase 69 | EmptyDataDecls 70 | EmptyDataDeriving 71 | ExistentialQuantification 72 | ExplicitForAll 73 | FlexibleContexts 74 | FlexibleInstances 75 | ForeignFunctionInterface 76 | GADTSyntax 77 | GeneralisedNewtypeDeriving 78 | HexFloatLiterals 79 | ImplicitPrelude 80 | InstanceSigs 81 | KindSignatures 82 | MonomorphismRestriction 83 | MultiParamTypeClasses 84 | NamedFieldPuns 85 | NamedWildCards 86 | NumericUnderscores 87 | PatternGuards 88 | PolyKinds 89 | PostfixOperators 90 | RankNTypes 91 | RelaxedPolyRec 92 | ScopedTypeVariables 93 | StandaloneDeriving 94 | StarIsType 95 | TraditionalRecordSyntax 96 | TupleSections 97 | TypeApplications 98 | TypeOperators 99 | TypeSynonymInstances 100 | 101 | if impl(ghc <9.2) && impl(ghc >=8.10) 102 | default-extensions: 103 | ImportQualifiedPost 104 | StandaloneKindSignatures 105 | 106 | common ghc2024-additions 107 | default-extensions: 108 | DataKinds 109 | DerivingStrategies 110 | DisambiguateRecordFields 111 | ExplicitNamespaces 112 | GADTs 113 | LambdaCase 114 | MonoLocalBinds 115 | RoleAnnotations 116 | 117 | common ghc2024-stanza 118 | if impl(ghc >=9.10) 119 | default-language: 120 | GHC2024 121 | elif impl(ghc >=9.2) 122 | import: ghc2024-additions 123 | default-language: 124 | GHC2021 125 | else 126 | import: ghc2021-additions 127 | import: ghc2024-additions 128 | default-language: 129 | Haskell2010 130 | 131 | library 132 | import: ghc-options-stanza 133 | import: ghc2024-stanza 134 | hs-source-dirs: src 135 | build-depends: base >=4.14 && <5 136 | exposed-modules: 137 | NumHask 138 | NumHask.Algebra.Action 139 | NumHask.Algebra.Additive 140 | NumHask.Algebra.Field 141 | NumHask.Algebra.Group 142 | NumHask.Algebra.Lattice 143 | NumHask.Algebra.Metric 144 | NumHask.Algebra.Multiplicative 145 | NumHask.Algebra.Ring 146 | NumHask.Data.Complex 147 | NumHask.Data.Integral 148 | NumHask.Data.Positive 149 | NumHask.Data.Rational 150 | NumHask.Data.Wrapped 151 | NumHask.Exception 152 | NumHask.Prelude 153 | 154 | default-extensions: RebindableSyntax 155 | 156 | test-suite doctests 157 | import: ghc2024-stanza 158 | main-is: doctests.hs 159 | hs-source-dirs: test 160 | build-depends: 161 | QuickCheck >=2.14 && <2.17, 162 | base >=4.14 && <5, 163 | doctest-parallel >=0.3 && <0.5, 164 | 165 | default-extensions: RebindableSyntax 166 | ghc-options: -threaded 167 | type: exitcode-stdio-1.0 168 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Multiplicative.hs: -------------------------------------------------------------------------------- 1 | -- | Multiplicative classes 2 | module NumHask.Algebra.Multiplicative 3 | ( Multiplicative (..), 4 | Product (..), 5 | product, 6 | accproduct, 7 | Divisive (..), 8 | ) 9 | where 10 | 11 | import Data.Int (Int16, Int32, Int64, Int8) 12 | import Data.Traversable (mapAccumL) 13 | import Data.Word (Word, Word16, Word32, Word64, Word8) 14 | import GHC.Natural (Natural (..)) 15 | import Prelude (Double, Eq, Float, Int, Integer, Ord, Show, fromInteger, fromRational) 16 | import Prelude qualified as P 17 | 18 | -- $setup 19 | -- 20 | -- >>> :m -Prelude 21 | -- >>> :set -XRebindableSyntax 22 | -- >>> import NumHask.Prelude 23 | 24 | -- | or [Multiplication](https://en.wikipedia.org/wiki/Multiplication) 25 | -- 26 | -- For practical reasons, we begin the class tree with 'NumHask.Algebra.Additive.Additive' and 'Multiplicative'. Starting with 'NumHask.Algebra.Group.Associative' and 'NumHask.Algebra.Group.Unital', or using 'Data.Semigroup.Semigroup' and 'Data.Monoid.Monoid' from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication. 27 | -- 28 | -- 29 | -- prop> \a -> one * a == a 30 | -- prop> \a -> a * one == a 31 | -- prop> \a b c -> (a * b) * c == a * (b * c) 32 | -- 33 | -- By convention, (*) is regarded as not necessarily commutative, but this is not universal, and the introduction of another symbol which means commutative multiplication seems a bit dogmatic. 34 | -- 35 | -- >>> one * 2 36 | -- 2 37 | -- 38 | -- >>> 2 * 3 39 | -- 6 40 | class Multiplicative a where 41 | infixl 7 * 42 | (*) :: a -> a -> a 43 | 44 | one :: a 45 | 46 | -- | A wrapper for an Multiplicative which distinguishes the multiplicative structure 47 | -- 48 | -- @since 0.11.1 49 | newtype Product a = Product 50 | { getProduct :: a 51 | } 52 | deriving (Eq, Ord, Show) 53 | 54 | instance (Multiplicative a) => P.Semigroup (Product a) where 55 | Product a <> Product b = Product (a * b) 56 | 57 | instance (Multiplicative a) => P.Monoid (Product a) where 58 | mempty = Product one 59 | 60 | -- | Compute the product of a 'Data.Foldable.Foldable'. 61 | -- 62 | -- >>> product [1..5] 63 | -- 120 64 | product :: (Multiplicative a, P.Foldable f) => f a -> a 65 | product = getProduct P.. P.foldMap Product 66 | 67 | -- | Compute the accumulating product of a 'Data.Traversable.Traversable'. 68 | -- 69 | -- >>> accproduct [1..5] 70 | -- [1,2,6,24,120] 71 | accproduct :: (Multiplicative a, P.Traversable f) => f a -> f a 72 | accproduct = P.snd P.. mapAccumL (\a b -> (a * b, a * b)) one 73 | 74 | -- | or [Division](https://en.wikipedia.org/wiki/Division_(mathematics\)) 75 | -- 76 | -- Though unusual, the term Divisive usefully fits in with the grammer of other classes and avoids name clashes that occur with some popular libraries. 77 | -- 78 | -- prop> \(a :: Double) -> a / a ~= one || a == zero 79 | -- prop> \(a :: Double) -> recip a ~= one / a || a == zero 80 | -- prop> \(a :: Double) -> recip a * a ~= one || a == zero 81 | -- prop> \(a :: Double) -> a * recip a ~= one || a == zero 82 | -- 83 | -- >>> recip 2.0 84 | -- 0.5 85 | -- 86 | -- >>> 1 / 2 87 | -- 0.5 88 | class (Multiplicative a) => Divisive a where 89 | {-# MINIMAL (/) | recip #-} 90 | 91 | recip :: a -> a 92 | recip a = one / a 93 | 94 | infixl 7 / 95 | 96 | (/) :: a -> a -> a 97 | (/) a b = a * recip b 98 | 99 | instance Multiplicative Double where 100 | (*) = (P.*) 101 | one = 1.0 102 | 103 | instance Divisive Double where 104 | recip = P.recip 105 | 106 | instance Multiplicative Float where 107 | (*) = (P.*) 108 | one = 1.0 109 | 110 | instance Divisive Float where 111 | recip = P.recip 112 | 113 | instance Multiplicative Int where 114 | (*) = (P.*) 115 | one = 1 116 | 117 | instance Multiplicative Integer where 118 | (*) = (P.*) 119 | one = 1 120 | 121 | instance Multiplicative P.Bool where 122 | (*) = (P.&&) 123 | one = P.True 124 | 125 | instance Multiplicative Natural where 126 | (*) = (P.*) 127 | one = 1 128 | 129 | instance Multiplicative Int8 where 130 | (*) = (P.*) 131 | one = 1 132 | 133 | instance Multiplicative Int16 where 134 | (*) = (P.*) 135 | one = 1 136 | 137 | instance Multiplicative Int32 where 138 | (*) = (P.*) 139 | one = 1 140 | 141 | instance Multiplicative Int64 where 142 | (*) = (P.*) 143 | one = 1 144 | 145 | instance Multiplicative Word where 146 | (*) = (P.*) 147 | one = 1 148 | 149 | instance Multiplicative Word8 where 150 | (*) = (P.*) 151 | one = 1 152 | 153 | instance Multiplicative Word16 where 154 | (*) = (P.*) 155 | one = 1 156 | 157 | instance Multiplicative Word32 where 158 | (*) = (P.*) 159 | one = 1 160 | 161 | instance Multiplicative Word64 where 162 | (*) = (P.*) 163 | one = 1 164 | 165 | instance (Multiplicative b) => Multiplicative (a -> b) where 166 | f * f' = \a -> f a * f' a 167 | one _ = one 168 | 169 | instance (Divisive b) => Divisive (a -> b) where 170 | recip f = recip P.. f 171 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | numhask 2 | === 3 | 4 | [![Hackage](https://img.shields.io/hackage/v/numhask.svg)](https://hackage.haskell.org/package/numhask) 5 | [![build](https://github.com/tonyday567/numhask/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/tonyday567/numhask/actions/workflows/haskell-ci.yml) 6 | 7 | ![](other/nh12.svg) 8 | 9 | Usage 10 | === 11 | 12 | ``` haskell 13 | {-# LANGUAGE RebindableSyntax #-} 14 | import NumHask.Prelude 15 | ``` 16 | See the documentation in the NumHask module for a detailed overview. 17 | 18 | v0.12 notes 19 | === 20 | 21 | SemiField 22 | --- 23 | 24 | Compared to previous library versions, Ring and Field have been removed as super classes of QuotientField, and SemiField introduced as the new constraint. 25 | 26 | Old version: 27 | 28 | ![](other/nh11.svg) 29 | 30 | ``` 31 | type SemiField a = (Distributive a, Divisive a) 32 | 33 | class (SemiField a) => QuotientField a where 34 | type Whole a :: Type 35 | properFraction :: a -> (Whole a, a) 36 | ``` 37 | 38 | The notion of a quotient is now that which distributes and divides. 39 | 40 | Subtractive originally slipped in as a super class due to the notion of rounding down (or, specifically, towards zero). By using DefaultSignatures, a default for Subtractive-type numbers can be provided and still allow non-Subtractive (SemiField) things to be quotient fields. 41 | 42 | Infinity and nan move from a Field to a SemiField constraint - subtraction is not needed to come up with an infinity or silly compute. 43 | 44 | Positive 45 | --- 46 | 47 | A motivation for SemiField was to introduce NumHask.Data.Positive into the library. Positive has no sane Subtractive instance (but should be able to be rounded). 48 | 49 | Out of the many approaches that can be taken in defining a positive number, the definition relies on a notion of truncated subtraction; that subtraction can be performed on positive numbers but, for answers outside the typed range, the lower bound should be returned. 50 | 51 | Specifically, the positive constructor needs to be supplied with a number that has a MeetSemiLattice instance, so that complex numbers and other geometries are correctly handled: 52 | 53 | ``` haskell 54 | ghci> 2 +: (-2) 55 | Complex {complexPair = (2,-2)} 56 | ghci> positive (2 +: (-2)) 57 | UnsafePositive {unPositive = Complex {complexPair = (2,0)}} 58 | ``` 59 | 60 | Truncated Arithmetic 61 | --- 62 | 63 | Truncated subtraction can be generalised to a notion of truncated arithmetic on a number with a typed range. This may be a direction explored further in the library including: 64 | 65 | - [epsilon, +infinity): A positive number type which is a safe divisor. 66 | - /= zero, non-zero arithmetic (x - x returns epsilon, say) 67 | - [0,1]: probability and weight arithmetic 68 | - [-1,1]: correlation math 69 | 70 | magnitudes are positive 71 | --- 72 | 73 | The current Basis instance of Double: 74 | 75 | ``` haskell 76 | instance Basis Double where 77 | type Mag Double = Double 78 | type Base Double = Double 79 | magnitude = P.abs 80 | basis = P.signum 81 | ``` 82 | 83 | is probably more correctly written as: 84 | 85 | ``` haskell 86 | instance Basis Double where 87 | type Mag Double = Positive Double 88 | type Base Double = Sign Double 89 | magnitude = Positive . P.abs 90 | basis = Sign . P.signum 91 | ``` 92 | 93 | where Sign is a future-imagined type representing {-1,0,1} or {-1,1} 94 | 95 | In Haskell, there is a basic choice between using multiple parameters for a type or embedding types using type families. Using multiple parameters would, in practice, force users to have to chose and write 'Basis Double Double Double' or 'Basis Positive Sign Double'. 96 | 97 | On balance, a computational chain involving magnitude is likely to be a single, underlying type, so that providing a Basis instance returning a Positive would result in a lot of unwrapping. 98 | 99 | ``` haskell 100 | -- endo-based 101 | x == basis x * magnitude x 102 | 103 | -- if hetero-typed ... 104 | x == (unSign $ basis x) * (unPositive $ magnitude x) 105 | ``` 106 | 107 | The library awaits real-world feedback on safety versus ergonomics. 108 | 109 | Monus 110 | --- 111 | 112 | Truncated subtraction is encapsulated within the Monus class and supplied operator: 113 | 114 | ``` haskell 115 | ghci> 4 ∸ 7 :: Positive Int 116 | UnsafePositive {unPositive = 0} 117 | ghci> unPositive (4 ∸ 7 :: Positive Int) 118 | 0 119 | ghci> unPositive (7 ∸ 4 :: Positive Int) 120 | 3 121 | ``` 122 | 123 | NumHask.Data.Wrapped 124 | --- 125 | 126 | The introduction of Positive provoked including a wrapper type for most numhask types. This type can be used with derivingvia: 127 | 128 | ``` haskell 129 | newtype Positive a = UnsafePositive {unPositive :: a} 130 | deriving stock 131 | (Eq, Ord, Show) 132 | deriving 133 | ( Additive, 134 | Multiplicative, 135 | Divisive, 136 | Integral, 137 | FromInteger, 138 | FromRational, 139 | Basis, 140 | Direction, 141 | Epsilon, 142 | AdditiveAction, 143 | SubtractiveAction, 144 | MultiplicativeAction, 145 | DivisiveAction, 146 | JoinSemiLattice, 147 | MeetSemiLattice, 148 | UpperBounded 149 | ) 150 | via (Wrapped a) 151 | ``` 152 | 153 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Additive.hs: -------------------------------------------------------------------------------- 1 | -- | Additive classes 2 | module NumHask.Algebra.Additive 3 | ( Additive (..), 4 | Sum (..), 5 | sum, 6 | accsum, 7 | Subtractive (..), 8 | ) 9 | where 10 | 11 | import Data.Int (Int16, Int32, Int64, Int8) 12 | import Data.Semigroup (Semigroup (..)) 13 | import Data.Traversable (mapAccumL) 14 | import Data.Word (Word, Word16, Word32, Word64, Word8) 15 | import GHC.Natural (Natural (..)) 16 | import Prelude (Bool, Double, Eq, Float, Int, Integer, Ord, Show, fromInteger) 17 | import Prelude qualified as P 18 | 19 | -- $setup 20 | -- 21 | -- >>> :m -Prelude 22 | -- >>> :set -XRebindableSyntax 23 | -- >>> import NumHask.Prelude 24 | 25 | -- | or [Addition](https://en.wikipedia.org/wiki/Addition) 26 | -- 27 | -- For practical reasons, we begin the class tree with 'NumHask.Algebra.Additive.Additive'. Starting with 'NumHask.Algebra.Group.Associative' and 'NumHask.Algebra.Group.Unital', or using 'Data.Semigroup.Semigroup' and 'Data.Monoid.Monoid' from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication. 28 | -- 29 | -- prop> \a -> zero + a == a 30 | -- prop> \a -> a + zero == a 31 | -- prop> \a b c -> (a + b) + c == a + (b + c) 32 | -- prop> \a b -> a + b == b + a 33 | -- 34 | -- By convention, (+) is regarded as commutative, but this is not universal, and the introduction of another symbol which means non-commutative addition seems a bit dogmatic. 35 | -- 36 | -- >>> zero + 1 37 | -- 1 38 | -- 39 | -- >>> 1 + 1 40 | -- 2 41 | class Additive a where 42 | infixl 6 + 43 | (+) :: a -> a -> a 44 | 45 | zero :: a 46 | 47 | -- | A wrapper for an Additive which distinguishes the additive structure 48 | -- 49 | -- @since 0.11.1 50 | newtype Sum a = Sum 51 | { getSum :: a 52 | } 53 | deriving (Eq, Ord, Show) 54 | 55 | instance (Additive a) => P.Semigroup (Sum a) where 56 | Sum a <> Sum b = Sum (a + b) 57 | 58 | instance (Additive a) => P.Monoid (Sum a) where 59 | mempty = Sum zero 60 | 61 | deriving instance (Additive a) => Additive (Sum a) 62 | 63 | -- | Compute the sum of a 'Data.Foldable.Foldable'. 64 | -- 65 | -- >>> sum [0..10] 66 | -- 55 67 | sum :: (Additive a, P.Foldable f) => f a -> a 68 | sum = getSum P.. P.foldMap Sum 69 | 70 | -- | Compute the accumulating sum of a 'Data.Traversable.Traversable'. 71 | -- 72 | -- >>> accsum [0..10] 73 | -- [0,1,3,6,10,15,21,28,36,45,55] 74 | accsum :: (Additive a, P.Traversable f) => f a -> f a 75 | accsum = P.snd P.. mapAccumL (\a b -> (a + b, a + b)) zero 76 | 77 | -- | or [Subtraction](https://en.wikipedia.org/wiki/Subtraction) 78 | -- 79 | -- prop> \a -> a - a == zero 80 | -- prop> \a -> negate a == zero - a 81 | -- prop> \a -> negate a + a == zero 82 | -- prop> \a -> a + negate a == zero 83 | -- 84 | -- 85 | -- >>> negate 1 86 | -- -1 87 | -- 88 | -- >>> 1 - 2 89 | -- -1 90 | class (Additive a) => Subtractive a where 91 | {-# MINIMAL (-) | negate #-} 92 | 93 | negate :: a -> a 94 | negate a = zero - a 95 | 96 | infixl 6 - 97 | (-) :: a -> a -> a 98 | a - b = a + negate b 99 | 100 | instance Additive Double where 101 | (+) = (P.+) 102 | zero = 0 103 | 104 | instance Subtractive Double where 105 | negate = P.negate 106 | 107 | instance Additive Float where 108 | (+) = (P.+) 109 | zero = 0 110 | 111 | instance Subtractive Float where 112 | negate = P.negate 113 | 114 | instance Additive Int where 115 | (+) = (P.+) 116 | zero = 0 117 | 118 | instance Subtractive Int where 119 | negate = P.negate 120 | 121 | instance Additive Integer where 122 | (+) = (P.+) 123 | zero = 0 124 | 125 | instance Subtractive Integer where 126 | negate = P.negate 127 | 128 | instance Additive Bool where 129 | (+) = (P.||) 130 | zero = P.False 131 | 132 | instance Additive Natural where 133 | (+) = (P.+) 134 | zero = 0 135 | 136 | instance Subtractive Natural where 137 | negate = P.negate 138 | 139 | instance Additive Int8 where 140 | (+) = (P.+) 141 | zero = 0 142 | 143 | instance Subtractive Int8 where 144 | negate = P.negate 145 | 146 | instance Additive Int16 where 147 | (+) = (P.+) 148 | zero = 0 149 | 150 | instance Subtractive Int16 where 151 | negate = P.negate 152 | 153 | instance Additive Int32 where 154 | (+) = (P.+) 155 | zero = 0 156 | 157 | instance Subtractive Int32 where 158 | negate = P.negate 159 | 160 | instance Additive Int64 where 161 | (+) = (P.+) 162 | zero = 0 163 | 164 | instance Subtractive Int64 where 165 | negate = P.negate 166 | 167 | instance Additive Word where 168 | (+) = (P.+) 169 | zero = 0 170 | 171 | instance Subtractive Word where 172 | negate = P.negate 173 | 174 | instance Additive Word8 where 175 | (+) = (P.+) 176 | zero = 0 177 | 178 | instance Subtractive Word8 where 179 | negate = P.negate 180 | 181 | instance Additive Word16 where 182 | (+) = (P.+) 183 | zero = 0 184 | 185 | instance Subtractive Word16 where 186 | negate = P.negate 187 | 188 | instance Additive Word32 where 189 | (+) = (P.+) 190 | zero = 0 191 | 192 | instance Subtractive Word32 where 193 | negate = P.negate 194 | 195 | instance Additive Word64 where 196 | (+) = (P.+) 197 | zero = 0 198 | 199 | instance Subtractive Word64 where 200 | negate = P.negate 201 | 202 | instance (Additive b) => Additive (a -> b) where 203 | f + f' = \a -> f a + f' a 204 | zero _ = zero 205 | 206 | instance (Subtractive b) => Subtractive (a -> b) where 207 | negate f = negate P.. f 208 | -------------------------------------------------------------------------------- /src/NumHask/Data/Positive.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DefaultSignatures #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE TypeFamilies #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | 6 | -- | A positive number type, defined as existing on [zero, +infinity) 7 | module NumHask.Data.Positive 8 | ( Positive (..), 9 | positive, 10 | maybePositive, 11 | positive_, 12 | Monus (..), 13 | Addus (..), 14 | MonusSemiField, 15 | ) 16 | where 17 | 18 | import Control.Category ((>>>)) 19 | import Data.Bool (bool) 20 | import Data.Maybe 21 | import NumHask.Algebra.Action 22 | import NumHask.Algebra.Additive 23 | import NumHask.Algebra.Field 24 | import NumHask.Algebra.Lattice 25 | import NumHask.Algebra.Metric 26 | import NumHask.Algebra.Multiplicative 27 | import NumHask.Algebra.Ring 28 | import NumHask.Data.Integral 29 | import NumHask.Data.Rational 30 | import NumHask.Data.Wrapped 31 | import Prelude (Eq, Ord, Show) 32 | import Prelude qualified as P 33 | 34 | -- $setup 35 | -- 36 | -- >>> :m -Prelude 37 | -- >>> :set -XRebindableSyntax 38 | -- >>> import NumHask.Prelude 39 | -- >>> import NumHask.Data.Positive 40 | 41 | -- | A positive number is a number that is contained in [zero,+infinity). 42 | -- 43 | -- >>> 1 :: Positive Int 44 | -- UnsafePositive {unPositive = 1} 45 | -- 46 | -- 47 | -- >>> -1 :: Positive Int 48 | -- ... 49 | -- • No instance for ‘Subtractive (Positive Int)’ 50 | -- arising from a use of syntactic negation 51 | -- ... 52 | -- 53 | -- zero is positive 54 | -- 55 | -- >>> positive 0 == zero 56 | -- True 57 | -- 58 | -- The main constructors: 59 | -- 60 | -- >>> positive (-1) 61 | -- UnsafePositive {unPositive = 0} 62 | -- 63 | -- >>> maybePositive (-1) 64 | -- Nothing 65 | -- 66 | -- >>> UnsafePositive (-1) 67 | -- UnsafePositive {unPositive = -1} 68 | newtype Positive a = UnsafePositive {unPositive :: a} 69 | deriving stock 70 | (Eq, Ord, Show) 71 | deriving 72 | ( Additive, 73 | Multiplicative, 74 | Divisive, 75 | Integral, 76 | FromInteger, 77 | FromRational, 78 | Basis, 79 | Direction, 80 | Epsilon, 81 | AdditiveAction, 82 | SubtractiveAction, 83 | MultiplicativeAction, 84 | DivisiveAction, 85 | JoinSemiLattice, 86 | MeetSemiLattice, 87 | UpperBounded 88 | ) 89 | via (Wrapped a) 90 | 91 | instance (MeetSemiLattice a, Integral a) => FromIntegral (Positive a) a where 92 | fromIntegral a = positive a 93 | 94 | instance (FromIntegral a b) => FromIntegral (Positive a) b where 95 | fromIntegral a = UnsafePositive (fromIntegral a) 96 | 97 | instance (ToIntegral a b) => ToIntegral (Positive a) b where 98 | toIntegral (UnsafePositive a) = toIntegral a 99 | 100 | instance (FromRatio a b) => FromRatio (Positive a) b where 101 | fromRatio a = UnsafePositive (fromRatio a) 102 | 103 | instance (ToRatio a b) => ToRatio (Positive a) b where 104 | toRatio (UnsafePositive a) = toRatio a 105 | 106 | instance (Additive a, JoinSemiLattice a) => LowerBounded (Positive a) where 107 | bottom = UnsafePositive zero 108 | 109 | instance QuotientField (Positive P.Double) where 110 | type Whole (Positive P.Double) = Positive P.Int 111 | properFraction (UnsafePositive a) = (\(n, r) -> (UnsafePositive n, UnsafePositive r)) (P.properFraction a) 112 | ceiling = properFraction >>> P.fst >>> (+ one) 113 | floor = properFraction >>> P.fst 114 | truncate = floor 115 | round x = case properFraction x of 116 | (n, r) -> 117 | let half_up = r + half 118 | in case P.compare half_up one of 119 | P.LT -> n 120 | P.EQ -> bool (n + one) n (even n) 121 | P.GT -> n + one 122 | 123 | -- | Constructor which returns zero for a negative number. 124 | -- 125 | -- >>> positive (-1) 126 | -- UnsafePositive {unPositive = 0} 127 | positive :: (Additive a, MeetSemiLattice a) => a -> Positive a 128 | positive a = UnsafePositive (a /\ zero) 129 | 130 | -- | Unsafe constructor. 131 | -- 132 | -- >>> positive_ (-one) 133 | -- UnsafePositive {unPositive = -1} 134 | positive_ :: a -> Positive a 135 | positive_ = UnsafePositive 136 | 137 | -- | Constructor which returns Nothing if a negative number is supplied. 138 | -- 139 | -- >>> maybePositive (-one) 140 | -- Nothing 141 | maybePositive :: (Additive a, MeetSemiLattice a) => a -> Maybe (Positive a) 142 | maybePositive a = bool Nothing (Just (UnsafePositive a)) (a `meetLeq` zero) 143 | 144 | instance (Subtractive a, MeetSemiLattice a) => Monus (Positive a) where 145 | (UnsafePositive a) ∸ (UnsafePositive b) = positive (a - b) 146 | 147 | -- | A field but with truncated subtraction. 148 | type MonusSemiField a = (Monus a, Distributive a, Divisive a) 149 | 150 | -- | or truncated subtraction. 151 | -- 152 | -- @since 0.12 153 | -- 154 | -- >>> positive 4 ∸ positive 7 155 | -- UnsafePositive {unPositive = 0} 156 | -- 157 | -- >>> 4 ∸ 7 :: Positive Int 158 | -- UnsafePositive {unPositive = 0} 159 | class Monus a where 160 | {-# MINIMAL (∸) #-} 161 | 162 | infixl 6 ∸ 163 | (∸) :: a -> a -> a 164 | default (∸) :: (LowerBounded a, MeetSemiLattice a, Subtractive a) => a -> a -> a 165 | a ∸ b = bottom /\ (a - b) 166 | 167 | -- | Truncated addition 168 | -- 169 | -- @since 0.12 170 | class Addus a where 171 | {-# MINIMAL (∔) #-} 172 | infixl 6 ∔ 173 | (∔) :: a -> a -> a 174 | default (∔) :: (UpperBounded a, JoinSemiLattice a, Additive a) => a -> a -> a 175 | a ∔ b = top \/ (a + b) 176 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Lattice.hs: -------------------------------------------------------------------------------- 1 | -- | [Lattices](https://en.wikipedia.org/wiki/Lattice_(order\)) 2 | module NumHask.Algebra.Lattice 3 | ( JoinSemiLattice (..), 4 | joinLeq, 5 | (<\), 6 | MeetSemiLattice (..), 7 | meetLeq, 8 | ( Associativity: x \/ (y \/ z) == (x \/ y) \/ z 36 | -- > Commutativity: x \/ y == y \/ x 37 | -- > Idempotency: x \/ x == x 38 | class (Eq a) => JoinSemiLattice a where 39 | infixr 5 \/ 40 | (\/) :: a -> a -> a 41 | 42 | -- | The partial ordering induced by the join-semilattice structure 43 | joinLeq :: (JoinSemiLattice a) => a -> a -> Bool 44 | joinLeq x y = (x \/ y) == y 45 | 46 | infixr 6 <\ 47 | 48 | -- | The partial ordering induced by the join-semilattice structure 49 | (<\) :: (JoinSemiLattice a) => a -> a -> Bool 50 | (<\) = joinLeq 51 | 52 | -- | A algebraic structure with element meets: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice) 53 | -- 54 | -- > Associativity: x /\ (y /\ z) == (x /\ y) /\ z 55 | -- > Commutativity: x /\ y == y /\ x 56 | -- > Idempotency: x /\ x == x 57 | class (Eq a) => MeetSemiLattice a where 58 | infixr 6 /\ 59 | (/\) :: a -> a -> a 60 | 61 | -- | The partial ordering induced by the meet-semilattice structure 62 | meetLeq :: (MeetSemiLattice a) => a -> a -> Bool 63 | meetLeq x y = (x /\ y) == x 64 | 65 | infixr 6 a -> a -> Bool 69 | ( Absorption: a \/ (a /\ b) == a /\ (a \/ b) == a 75 | type Lattice a = (JoinSemiLattice a, MeetSemiLattice a) 76 | 77 | -- | A join-semilattice with an identity element 'bottom' for '\/'. 78 | -- 79 | -- > x \/ bottom == bottom 80 | class (JoinSemiLattice a) => LowerBounded a where 81 | bottom :: a 82 | 83 | -- | A meet-semilattice with an identity element 'top' for '/\'. 84 | -- 85 | -- > x /\ top == top 86 | class (MeetSemiLattice a) => UpperBounded a where 87 | top :: a 88 | 89 | -- | Lattices with both bounds 90 | -- 91 | -- > x /\ bottom == x 92 | -- > x \/ top = x 93 | type BoundedLattice a = (JoinSemiLattice a, MeetSemiLattice a, LowerBounded a, UpperBounded a) 94 | 95 | instance JoinSemiLattice Float where 96 | (\/) = min 97 | 98 | instance MeetSemiLattice Float where 99 | (/\) = max 100 | 101 | instance JoinSemiLattice Double where 102 | (\/) = min 103 | 104 | instance MeetSemiLattice Double where 105 | (/\) = max 106 | 107 | instance JoinSemiLattice Int where 108 | (\/) = min 109 | 110 | instance MeetSemiLattice Int where 111 | (/\) = max 112 | 113 | instance JoinSemiLattice Integer where 114 | (\/) = min 115 | 116 | instance MeetSemiLattice Integer where 117 | (/\) = max 118 | 119 | instance JoinSemiLattice Bool where 120 | (\/) = (||) 121 | 122 | instance MeetSemiLattice Bool where 123 | (/\) = (&&) 124 | 125 | instance JoinSemiLattice Natural where 126 | (\/) = min 127 | 128 | instance MeetSemiLattice Natural where 129 | (/\) = max 130 | 131 | instance JoinSemiLattice Int8 where 132 | (\/) = min 133 | 134 | instance MeetSemiLattice Int8 where 135 | (/\) = max 136 | 137 | instance JoinSemiLattice Int16 where 138 | (\/) = min 139 | 140 | instance MeetSemiLattice Int16 where 141 | (/\) = max 142 | 143 | instance JoinSemiLattice Int32 where 144 | (\/) = min 145 | 146 | instance MeetSemiLattice Int32 where 147 | (/\) = max 148 | 149 | instance JoinSemiLattice Int64 where 150 | (\/) = min 151 | 152 | instance MeetSemiLattice Int64 where 153 | (/\) = max 154 | 155 | instance JoinSemiLattice Word where 156 | (\/) = min 157 | 158 | instance MeetSemiLattice Word where 159 | (/\) = max 160 | 161 | instance JoinSemiLattice Word8 where 162 | (\/) = min 163 | 164 | instance MeetSemiLattice Word8 where 165 | (/\) = max 166 | 167 | instance JoinSemiLattice Word16 where 168 | (\/) = min 169 | 170 | instance MeetSemiLattice Word16 where 171 | (/\) = max 172 | 173 | instance JoinSemiLattice Word32 where 174 | (\/) = min 175 | 176 | instance MeetSemiLattice Word32 where 177 | (/\) = max 178 | 179 | instance JoinSemiLattice Word64 where 180 | (\/) = min 181 | 182 | instance MeetSemiLattice Word64 where 183 | (/\) = max 184 | 185 | instance LowerBounded Float where 186 | bottom = negInfinity 187 | 188 | instance UpperBounded Float where 189 | top = infinity 190 | 191 | instance LowerBounded Double where 192 | bottom = negInfinity 193 | 194 | instance UpperBounded Double where 195 | top = infinity 196 | 197 | instance LowerBounded Int where 198 | bottom = minBound 199 | 200 | instance UpperBounded Int where 201 | top = maxBound 202 | 203 | instance LowerBounded Bool where 204 | bottom = False 205 | 206 | instance UpperBounded Bool where 207 | top = True 208 | 209 | instance LowerBounded Natural where 210 | bottom = zero 211 | 212 | instance LowerBounded Int8 where 213 | bottom = minBound 214 | 215 | instance UpperBounded Int8 where 216 | top = maxBound 217 | 218 | instance LowerBounded Int16 where 219 | bottom = minBound 220 | 221 | instance UpperBounded Int16 where 222 | top = maxBound 223 | 224 | instance LowerBounded Int32 where 225 | bottom = minBound 226 | 227 | instance UpperBounded Int32 where 228 | top = maxBound 229 | 230 | instance LowerBounded Int64 where 231 | bottom = minBound 232 | 233 | instance UpperBounded Int64 where 234 | top = maxBound 235 | 236 | instance LowerBounded Word where 237 | bottom = minBound 238 | 239 | instance UpperBounded Word where 240 | top = maxBound 241 | 242 | instance LowerBounded Word8 where 243 | bottom = minBound 244 | 245 | instance UpperBounded Word8 where 246 | top = maxBound 247 | 248 | instance LowerBounded Word16 where 249 | bottom = minBound 250 | 251 | instance UpperBounded Word16 where 252 | top = maxBound 253 | 254 | instance LowerBounded Word32 where 255 | bottom = minBound 256 | 257 | instance UpperBounded Word32 where 258 | top = maxBound 259 | 260 | instance LowerBounded Word64 where 261 | bottom = minBound 262 | 263 | instance UpperBounded Word64 where 264 | top = maxBound 265 | -------------------------------------------------------------------------------- /src/NumHask/Data/Rational.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE UndecidableInstances #-} 3 | 4 | -- | Rational classes 5 | module NumHask.Data.Rational 6 | ( Ratio (..), 7 | Rational, 8 | ToRatio (..), 9 | FromRatio (..), 10 | FromRational (..), 11 | reduce, 12 | gcd, 13 | ) 14 | where 15 | 16 | import Data.Bool (bool) 17 | import Data.Int (Int16, Int32, Int64, Int8) 18 | import Data.Word (Word, Word16, Word32, Word64, Word8) 19 | import GHC.Float 20 | import GHC.Natural (Natural (..)) 21 | import GHC.Real qualified 22 | import NumHask.Algebra.Additive 23 | import NumHask.Algebra.Field 24 | import NumHask.Algebra.Lattice 25 | import NumHask.Algebra.Metric 26 | import NumHask.Algebra.Multiplicative 27 | import NumHask.Algebra.Ring 28 | import NumHask.Data.Integral 29 | import Prelude (Eq (..), Int, Integer, Ord (..), Ordering (..), (.)) 30 | import Prelude qualified as P 31 | 32 | -- $setup 33 | -- 34 | -- >>> :m -Prelude 35 | -- >>> :set -XRebindableSyntax 36 | -- >>> import NumHask.Prelude 37 | 38 | -- | A rational number, represented as the ratio of two 'Integral' numbers. 39 | data Ratio a = !a :% !a deriving (P.Show) 40 | 41 | -- | Ratio of two integers 42 | type Rational = Ratio Integer 43 | 44 | instance (P.Eq a, Subtractive a, EndoBased a, Absolute a, Integral a) => P.Eq (Ratio a) where 45 | a@(xa :% ya) == b@(xb :% yb) 46 | | isRNaN a P.|| isRNaN b = P.False 47 | | xa == zero P.&& xb == zero = P.True 48 | | xa == zero P.|| xb == zero = P.False 49 | | P.otherwise = 50 | let (xa' :% ya', xb' :% yb') = (reduce xa ya, reduce xb yb) 51 | in (xa' P.== xb') P.&& (ya' P.== yb') 52 | 53 | -- | Has a zero denominator 54 | isRNaN :: (P.Eq a, Additive a) => Ratio a -> P.Bool 55 | isRNaN (x :% y) 56 | | x P.== zero P.&& y P.== zero = P.True 57 | | P.otherwise = P.False 58 | 59 | instance (P.Ord a, Integral a, EndoBased a, Subtractive a) => P.Ord (Ratio a) where 60 | (x :% y) <= (x' :% y') = x * y' P.<= x' * y 61 | (x :% y) < (x' :% y') = x * y' P.< x' * y 62 | 63 | instance (P.Ord a, EndoBased a, Integral a, Ring a) => Additive (Ratio a) where 64 | (x :% y) + (x' :% y') 65 | | y P.== zero P.&& y' P.== zero = bool one (negate one) (x + x' P.< zero) :% zero 66 | | y P.== zero = x :% y 67 | | y' P.== zero = x' :% y' 68 | | P.otherwise = reduce ((x * y') + (x' * y)) (y * y') 69 | 70 | zero = zero :% one 71 | 72 | instance (P.Ord a, EndoBased a, Integral a, Ring a) => Subtractive (Ratio a) where 73 | negate (x :% y) = negate x :% y 74 | 75 | instance (P.Ord a, EndoBased a, Integral a, Ring a) => Multiplicative (Ratio a) where 76 | (x :% y) * (x' :% y') = reduce (x * x') (y * y') 77 | 78 | one = one :% one 79 | 80 | instance 81 | (P.Ord a, EndoBased a, Integral a, Ring a) => 82 | Divisive (Ratio a) 83 | where 84 | recip (x :% y) 85 | | signum x P.== negate one = negate y :% negate x 86 | | P.otherwise = y :% x 87 | 88 | instance (P.Ord a, EndoBased a, Absolute a, ToInt a, Integral a, Ring a) => QuotientField (Ratio a) where 89 | type Whole (Ratio a) = Int 90 | properFraction (n :% d) = let (w, r) = quotRem n d in (toIntegral w, r :% d) 91 | 92 | instance (P.Ord a, EndoBased a, Integral a, Ring a) => Basis (Ratio a) where 93 | type Mag (Ratio a) = Ratio a 94 | type Base (Ratio a) = Ratio a 95 | basis (n :% _) = 96 | case compare n zero of 97 | EQ -> zero 98 | GT -> one 99 | LT -> negate one 100 | magnitude (n :% d) = abs n :% abs d 101 | 102 | instance (P.Ord a, Integral a, EndoBased a, Subtractive a) => JoinSemiLattice (Ratio a) where 103 | (\/) = P.min 104 | 105 | instance (P.Ord a, Integral a, EndoBased a, Subtractive a) => MeetSemiLattice (Ratio a) where 106 | (/\) = P.max 107 | 108 | instance (P.Ord a, EndoBased a, Integral a, Ring a, MeetSemiLattice a) => Epsilon (Ratio a) 109 | 110 | instance (FromIntegral a b, Multiplicative a) => FromIntegral (Ratio a) b where 111 | fromIntegral x = fromIntegral x :% one 112 | 113 | -- | toRatio is equivalent to `GHC.Real.Real` in base, but is polymorphic in the Integral type. 114 | -- 115 | -- >>> toRatio (3.1415927 :: Float) :: Ratio Integer 116 | -- 13176795 :% 4194304 117 | class ToRatio a b where 118 | toRatio :: a -> Ratio b 119 | 120 | instance ToRatio Double Integer where 121 | toRatio = fromBaseRational . P.toRational 122 | 123 | instance ToRatio Float Integer where 124 | toRatio = fromBaseRational . P.toRational 125 | 126 | instance ToRatio (Ratio Integer) Integer where 127 | toRatio = P.id 128 | 129 | instance ToRatio Int Integer where 130 | toRatio = fromBaseRational . P.toRational 131 | 132 | instance ToRatio Integer Integer where 133 | toRatio = fromBaseRational . P.toRational 134 | 135 | instance ToRatio Natural Integer where 136 | toRatio = fromBaseRational . P.toRational 137 | 138 | instance ToRatio Int8 Integer where 139 | toRatio = fromBaseRational . P.toRational 140 | 141 | instance ToRatio Int16 Integer where 142 | toRatio = fromBaseRational . P.toRational 143 | 144 | instance ToRatio Int32 Integer where 145 | toRatio = fromBaseRational . P.toRational 146 | 147 | instance ToRatio Int64 Integer where 148 | toRatio = fromBaseRational . P.toRational 149 | 150 | instance ToRatio Word Integer where 151 | toRatio = fromBaseRational . P.toRational 152 | 153 | instance ToRatio Word8 Integer where 154 | toRatio = fromBaseRational . P.toRational 155 | 156 | instance ToRatio Word16 Integer where 157 | toRatio = fromBaseRational . P.toRational 158 | 159 | instance ToRatio Word32 Integer where 160 | toRatio = fromBaseRational . P.toRational 161 | 162 | instance ToRatio Word64 Integer where 163 | toRatio = fromBaseRational . P.toRational 164 | 165 | -- | `GHC.Real.Fractional` in base splits into fromRatio and Field 166 | -- 167 | -- >>> fromRatio (5 :% 2 :: Ratio Integer) :: Double 168 | -- 2.5 169 | class FromRatio a b where 170 | fromRatio :: Ratio b -> a 171 | 172 | fromBaseRational :: P.Rational -> Ratio Integer 173 | fromBaseRational (n GHC.Real.:% d) = n :% d 174 | 175 | instance FromRatio Double Integer where 176 | fromRatio (n :% d) = rationalToDouble n d 177 | 178 | instance FromRatio Float Integer where 179 | fromRatio (n :% d) = rationalToFloat n d 180 | 181 | instance FromRatio Rational Integer where 182 | fromRatio = P.id 183 | 184 | -- | fromRational is special in two ways: 185 | -- 186 | -- - numeric decimal literals (like "53.66") are interpreted as exactly "fromRational (53.66 :: GHC.Real.Ratio Integer)". The prelude version, GHC.Real.fromRational is used as default (or whatever is in scope if RebindableSyntax is set). 187 | -- 188 | -- - The default rules in < https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-750004.3 haskell2010> specify that contraints on 'fromRational' need to be in a form @C v@, where v is a Num or a subclass of Num. 189 | -- 190 | -- So a type synonym of `type FromRational a = FromRatio a Integer` doesn't work well with type defaulting; hence the need for a separate class. 191 | class FromRational a where 192 | fromRational :: P.Rational -> a 193 | 194 | instance FromRational Double where 195 | fromRational (n GHC.Real.:% d) = rationalToDouble n d 196 | 197 | instance FromRational Float where 198 | fromRational (n GHC.Real.:% d) = rationalToFloat n d 199 | 200 | instance FromRational (Ratio Integer) where 201 | fromRational (n GHC.Real.:% d) = n :% d 202 | 203 | -- | 'reduce' normalises a ratio by dividing both numerator and denominator by 204 | -- their greatest common divisor. 205 | -- 206 | -- >>> reduce 72 60 207 | -- 6 :% 5 208 | -- 209 | -- prop> \a b -> reduce a b == a :% b || b == zero 210 | reduce :: 211 | (P.Eq a, Subtractive a, EndoBased a, Integral a) => a -> a -> Ratio a 212 | reduce x y 213 | | x P.== zero P.&& y P.== zero = zero :% zero 214 | | z P.== zero = one :% zero 215 | | P.otherwise = (x `quot` z) % (y `quot` z) 216 | where 217 | z = gcd x y 218 | n % d 219 | | signum d P.== negate one = negate n :% negate d 220 | | P.otherwise = n :% d 221 | 222 | -- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which 223 | -- every common factor of @x@ and @y@ is also a factor; for example 224 | -- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@. 225 | -- (That is, the common divisor that is \"greatest\" in the divisibility 226 | -- preordering.) 227 | -- 228 | -- Note: Since for signed fixed-width integer types, @'abs' 'GHC.Enum.minBound' < 0@, 229 | -- the result may be negative if one of the arguments is @'GHC.Enum.minBound'@ (and 230 | -- necessarily is if the other is @0@ or @'GHC.Enum.minBound'@) for such types. 231 | -- 232 | -- >>> gcd 72 60 233 | -- 12 234 | gcd :: (P.Eq a, EndoBased a, Integral a) => a -> a -> a 235 | gcd x y = gcd' (abs x) (abs y) 236 | where 237 | gcd' a b 238 | | b P.== zero = a 239 | | P.otherwise = gcd' b (a `rem` b) 240 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Field.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DefaultSignatures #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | -- | [field](https://en.wikipedia.org/wiki/Field_(mathematics\)) classes 5 | module NumHask.Algebra.Field 6 | ( SemiField, 7 | Field, 8 | ExpField (..), 9 | QuotientField (..), 10 | infinity, 11 | negInfinity, 12 | nan, 13 | TrigField (..), 14 | half, 15 | modF, 16 | divF, 17 | divModF, 18 | ) 19 | where 20 | 21 | import Data.Bool (bool) 22 | import Data.Kind 23 | import NumHask.Algebra.Additive (Additive (..), Subtractive (..), (-)) 24 | import NumHask.Algebra.Multiplicative 25 | ( Divisive (..), 26 | Multiplicative (..), 27 | (/), 28 | ) 29 | import NumHask.Algebra.Ring (Distributive, Ring, two) 30 | import NumHask.Data.Integral (FromIntegral (..), Integral, even) 31 | import Prelude (Eq (..), (.)) 32 | import Prelude qualified as P 33 | 34 | -- $setup 35 | -- 36 | -- >>> :m -Prelude 37 | -- >>> :set -XRebindableSyntax 38 | -- >>> :set -XScopedTypeVariables 39 | -- >>> import NumHask.Prelude 40 | 41 | -- | A is a field with no subtraction. 42 | -- 43 | -- @since 0.12 44 | type SemiField a = (Distributive a, Divisive a) 45 | 46 | -- | A is a set 47 | -- on which addition, subtraction, multiplication, and division are defined. It is also assumed that multiplication is distributive over addition. 48 | -- 49 | -- A summary of the rules inherited from super-classes of Field: 50 | -- 51 | -- > zero + a == a 52 | -- > a + zero == a 53 | -- > ((a + b) + c) (a + (b + c)) 54 | -- > a + b == b + a 55 | -- > a - a == zero 56 | -- > negate a == zero - a 57 | -- > negate a + a == zero 58 | -- > a + negate a == zero 59 | -- > one * a == a 60 | -- > a * one == a 61 | -- > ((a * b) * c) == (a * (b * c)) 62 | -- > (a * (b + c)) == (a * b + a * c) 63 | -- > ((a + b) * c) == (a * c + b * c) 64 | -- > a * zero == zero 65 | -- > zero * a == zero 66 | -- > a / a == one || a == zero 67 | -- > recip a == one / a || a == zero 68 | -- > recip a * a == one || a == zero 69 | -- > a * recip a == one || a == zero 70 | type Field a = (Ring a, Divisive a) 71 | 72 | -- | A hyperbolic field class 73 | -- 74 | -- prop> \(a::Double) -> a < zero || (sqrt . (**2)) a == a 75 | -- prop> \(a::Double) -> a < zero || (log . exp) a ~= a 76 | -- prop> \(a::Double) (b::Double) -> (b < zero) || a <= zero || a == 1 || abs (a ** logBase a b - b) < 10 * epsilon 77 | class 78 | (Field a) => 79 | ExpField a 80 | where 81 | exp :: a -> a 82 | log :: a -> a 83 | (**) :: a -> a -> a 84 | (**) a b = exp (log a * b) 85 | 86 | -- | log to the base of 87 | -- 88 | -- >>> logBase 2 8 89 | -- 2.9999999999999996 90 | logBase :: a -> a -> a 91 | logBase a b = log b / log a 92 | 93 | -- | square root 94 | -- 95 | -- >>> sqrt 4 96 | -- 2.0 97 | sqrt :: a -> a 98 | sqrt a = a ** (one / (one + one)) 99 | 100 | instance ExpField P.Double where 101 | exp = P.exp 102 | log = P.log 103 | (**) = (P.**) 104 | 105 | instance ExpField P.Float where 106 | exp = P.exp 107 | log = P.log 108 | (**) = (P.**) 109 | 110 | instance (ExpField b) => ExpField (a -> b) where 111 | exp f = exp . f 112 | log f = log . f 113 | 114 | -- | Quotienting of a 'Field' into a 'NumHask.Algebra.Ring' 115 | -- 116 | -- See [Field of fractions](https://en.wikipedia.org/wiki/Field_of_fractions) 117 | -- 118 | -- > \a -> a - one < floor a <= a <= ceiling a < a + one 119 | class (SemiField a) => QuotientField a where 120 | type Whole a :: Type 121 | properFraction :: a -> (Whole a, a) 122 | 123 | -- | round to the nearest Int 124 | -- 125 | -- Exact ties are managed by rounding down ties if the whole component is even. 126 | -- 127 | -- >>> round (1.5 :: Double) 128 | -- 2 129 | -- 130 | -- >>> round (2.5 :: Double) 131 | -- 2 132 | round :: a -> Whole a 133 | default round :: (Subtractive a, Integral (Whole a), P.Eq (Whole a), P.Ord a, Subtractive (Whole a)) => a -> Whole a 134 | round x = case properFraction x of 135 | (n, r) -> 136 | let m = bool (n + one) (n - one) (r P.< zero) 137 | half_up = abs' r + half 138 | abs' a 139 | | a P.< zero = negate a 140 | | P.otherwise = a 141 | in case P.compare half_up one of 142 | P.LT -> n 143 | P.EQ -> bool m n (even n) 144 | P.GT -> m 145 | 146 | -- | supply the next upper whole component 147 | -- 148 | -- >>> ceiling (1.001 :: Double) 149 | -- 2 150 | ceiling :: a -> Whole a 151 | default ceiling :: (P.Ord a, Distributive (Whole a)) => a -> Whole a 152 | ceiling x = bool n (n + one) (r P.> zero) 153 | where 154 | (n, r) = properFraction x 155 | 156 | -- | supply the previous lower whole component 157 | -- 158 | -- >>> floor (1.001 :: Double) 159 | -- 1 160 | floor :: a -> Whole a 161 | default floor :: (P.Ord a, Subtractive (Whole a), Distributive (Whole a)) => a -> Whole a 162 | floor x = bool n (n - one) (r P.< zero) 163 | where 164 | (n, r) = properFraction x 165 | 166 | -- | supply the whole component closest to zero 167 | -- 168 | -- >>> floor (-1.001 :: Double) 169 | -- -2 170 | -- 171 | -- >>> truncate (-1.001 :: Double) 172 | -- -1 173 | truncate :: a -> Whole a 174 | default truncate :: (P.Ord a) => a -> Whole a 175 | truncate x = bool (ceiling x) (floor x) (x P.> zero) 176 | 177 | instance QuotientField P.Float where 178 | type Whole P.Float = P.Int 179 | properFraction = P.properFraction 180 | 181 | instance QuotientField P.Double where 182 | type Whole P.Double = P.Int 183 | properFraction = P.properFraction 184 | 185 | -- | infinity is defined for any 'Field'. 186 | -- 187 | -- >>> one / zero + infinity 188 | -- Infinity 189 | -- 190 | -- >>> infinity + 1 191 | -- Infinity 192 | infinity :: (SemiField a) => a 193 | infinity = one / zero 194 | 195 | -- | nan is defined as zero/zero 196 | -- 197 | -- but note the (social) law: 198 | -- 199 | -- >>> nan == zero / zero 200 | -- False 201 | nan :: (SemiField a) => a 202 | nan = zero / zero 203 | 204 | -- | negative infinity 205 | -- 206 | -- >>> negInfinity + infinity 207 | -- NaN 208 | negInfinity :: (Field a) => a 209 | negInfinity = negate infinity 210 | 211 | -- | Trigonometric Field 212 | -- 213 | -- The list of laws is quite long: 214 | class 215 | (Field a) => 216 | TrigField a 217 | where 218 | pi :: a 219 | sin :: a -> a 220 | cos :: a -> a 221 | tan :: a -> a 222 | tan x = sin x / cos x 223 | asin :: a -> a 224 | acos :: a -> a 225 | atan :: a -> a 226 | atan2 :: a -> a -> a 227 | sinh :: a -> a 228 | cosh :: a -> a 229 | tanh :: a -> a 230 | tanh x = sinh x / cosh x 231 | asinh :: a -> a 232 | acosh :: a -> a 233 | atanh :: a -> a 234 | 235 | instance TrigField P.Double where 236 | pi = P.pi 237 | sin = P.sin 238 | cos = P.cos 239 | asin = P.asin 240 | acos = P.acos 241 | atan = P.atan 242 | atan2 = P.atan2 243 | sinh = P.sinh 244 | cosh = P.cosh 245 | asinh = P.asinh 246 | acosh = P.acosh 247 | atanh = P.atanh 248 | 249 | instance TrigField P.Float where 250 | pi = P.pi 251 | sin = P.sin 252 | cos = P.cos 253 | asin = P.asin 254 | acos = P.acos 255 | atan = P.atan 256 | atan2 = P.atan2 257 | sinh = P.sinh 258 | cosh = P.cosh 259 | asinh = P.asinh 260 | acosh = P.acosh 261 | atanh = P.atanh 262 | 263 | instance (TrigField b) => TrigField (a -> b) where 264 | pi _ = pi 265 | sin f = sin . f 266 | cos f = cos . f 267 | asin f = asin . f 268 | acos f = acos . f 269 | atan f = atan . f 270 | atan2 f g x = atan2 (f x) (g x) 271 | sinh f = sinh . f 272 | cosh f = cosh . f 273 | asinh f = asinh . f 274 | acosh f = acosh . f 275 | atanh f = atanh . f 276 | 277 | -- | A half of 'one' 278 | -- 279 | -- >>> half :: Double 280 | -- 0.5 281 | half :: (Additive a, Divisive a) => a 282 | half = one / two 283 | 284 | -- | Approximate modulo for fields 285 | -- 286 | -- @since 0.13 287 | -- 288 | -- >>> modF 1.5 1.2 289 | -- 0.30000000000000004 290 | modF :: (Eq a, Field a, FromIntegral a (Whole a), QuotientField a) => a -> a -> a 291 | modF n d 292 | | d == infinity = n 293 | | d == zero = nan 294 | | P.True = n - d * fromIntegral (floor (n / d)) 295 | 296 | -- | Approximate diviso for fields. 297 | -- 298 | -- Compared with 'NumHask.Algebra.Field.div', divF returns the original type rather than the 'Whole' type. 299 | -- 300 | -- @since 0.13 301 | -- 302 | -- >>> divF 1.5 1.2 303 | -- 1.0 304 | divF :: (Eq a, Field a, FromIntegral a (Whole a), QuotientField a) => a -> a -> a 305 | divF n d 306 | | d == infinity = zero 307 | | d == zero = infinity 308 | | P.True = fromIntegral (floor (n / d)) 309 | 310 | -- | Approximate `NumHask.Algebra.Field.divMod` for fields. 311 | -- 312 | -- @since 0.13 313 | -- 314 | -- >>> divModF 1.5 1.2 315 | -- (1.0,0.30000000000000004) 316 | divModF :: (Eq a, Field a, FromIntegral a (Whole a), QuotientField a) => a -> a -> (a, a) 317 | divModF n d 318 | | d == infinity = (zero, n) 319 | | d == zero = (infinity, nan) 320 | | P.True = (div', n - d * div') 321 | where 322 | div' = fromIntegral (floor (n / d)) 323 | -------------------------------------------------------------------------------- /other/nh11.svg: -------------------------------------------------------------------------------- 1 | ActionsAdditiveBasisDirectionDistributiveDivisiveExpFieldFieldIntegralMultiplicativeQuotientFieldRatioRingSubtractiveTrigField 26 | -------------------------------------------------------------------------------- /other/nh12.svg: -------------------------------------------------------------------------------- 1 | AdditiveBasisDirectionDistributiveDivisiveExpFieldFieldIntegralMultiplicativeQuotientFieldRatioRingSemiFieldSubtractiveTrigField -------------------------------------------------------------------------------- /src/NumHask.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RebindableSyntax #-} 2 | {-# OPTIONS_HADDOCK prune #-} 3 | 4 | -- | Numeric classes. 5 | module NumHask 6 | ( -- * Usage 7 | -- $setup 8 | 9 | -- * Overview 10 | -- $overview 11 | -- $pictures 12 | 13 | -- * Prelude Mappings 14 | -- $mapping 15 | 16 | -- * Extensions 17 | -- $extensions 18 | 19 | -- * Additive 20 | Additive (..), 21 | sum, 22 | accsum, 23 | Subtractive (..), 24 | 25 | -- * Multiplicative 26 | Multiplicative (..), 27 | product, 28 | accproduct, 29 | Divisive (..), 30 | 31 | -- * Ring 32 | Distributive, 33 | Ring, 34 | StarSemiring (..), 35 | KleeneAlgebra, 36 | InvolutiveRing (..), 37 | two, 38 | 39 | -- * Field 40 | Field, 41 | ExpField (..), 42 | QuotientField (..), 43 | TrigField (..), 44 | infinity, 45 | negInfinity, 46 | nan, 47 | half, 48 | modF, 49 | divF, 50 | divModF, 51 | 52 | -- * Lattice 53 | JoinSemiLattice (..), 54 | joinLeq, 55 | (<\), 56 | MeetSemiLattice (..), 57 | meetLeq, 58 | (>> :m -Prelude 221 | -- >>> :set -XRebindableSyntax 222 | -- >>> import NumHask.Prelude 223 | -- >>> 1+1 224 | -- 2 225 | 226 | -- $extensions 227 | -- 228 | -- [RebindableSyntax](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/rebindable_syntax.html) 229 | -- is recommended for use with numhask. 230 | -- 231 | -- As a replacement for the numerical classes, numhask clashes significantly with an 232 | -- unqualified import of the @Prelude@. Either numhask modules should be qualified, 233 | -- or prelude turned off with the NoImplicitPrelude extension, or with RebindableSyntax, 234 | -- which implies NoImplicitPrelude. 235 | -- 236 | -- == defaulting 237 | -- 238 | -- Without RebindableSyntax, numeric literals default as follows: 239 | -- 240 | -- >>> :set -XNoRebindableSyntax 241 | -- >>> :t 1 242 | -- 1 :: Num a => a 243 | -- 244 | -- >>> :t 1.0 245 | -- 1.0 :: Fractional a => a 246 | -- 247 | -- With RebindableSyntax (which also switches NoImplicitPrelude on) literal numbers change to the numhask types, 'FromInteger' and 'FromRational': 248 | -- 249 | -- >>> :set -XRebindableSyntax 250 | -- >>> :t 1 251 | -- 1 :: FromInteger a => a 252 | -- 253 | -- >>> :t 1.0 254 | -- 1.0 :: FromRational a => a 255 | -- 256 | -- >>> 1 257 | -- 1 258 | -- 259 | -- >>> 1.0 260 | -- 1.0 261 | -- 262 | -- RebindableSyntax is a tradeoff, however, and usage comes attached with other non-numeric changes 263 | -- that "NumHask.Prelude" attempts to counteract. 264 | -- 265 | -- See [haskell2010 Section 4.3.4](https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-750004.3) for the nuts and bolts to defaulting. 266 | -- 267 | -- The effect of [ExtendedDefaultRules](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/ghci.html#extension-ExtendedDefaultRules) 268 | -- in ghci or switched on as an extension also need to be understood. 269 | -- It can lead to unusual interactions with numerics and strange error messages at times because 270 | -- it adds @()@ and @[]@ to the start of the type defaulting list. 271 | 272 | -- $overview 273 | -- numhask is largely a set of classes that can replace the 'GHC.Num.Num' class and it's descendents. 274 | -- Principles that have guided design include: 275 | -- 276 | -- - __/balanced class density/__. The numeric hierarchy begins with addition and multiplication, 277 | -- choosing not to build from a Magma base. Whilst not being as principled as other approaches, this circumvents the instance explosion problems of Haskell whilst maintaining clarity of class purpose. 278 | -- 279 | -- - __/operator-first/__. In all cases, a class exists to define useful operators. 280 | -- Major class groupings, such as 'Distributive', 'Ring' and 'Field' are type synonyms. 281 | -- 282 | -- - __/lawful/__. All classes have laws associated with them that serve to relate class operators together in a meaningful way. 283 | -- 284 | -- - __/low-impact/__. The library attempts to fit in with the rest of the Haskell ecosystem. 285 | -- It provides instances for common numbers: 'GHC.Num.Int', 'GHC.Num.Integer', 'GHC.Float.Double', 286 | -- 'GHC.Float.Float', 'GHC.Natural.Natural', and the Word classes. It avoids name (or idea) clashes with other popular libraries 287 | -- and adopts conventions in the 288 | -- where they make sense. 289 | -- 290 | -- - __/proof-of-concept/__. The library may be below industrial-strength depending on a definition 291 | -- of this term. At the same time, correspondence around improving the library is most welcome. 292 | 293 | -- $pictures 294 | -- 295 | -- The class heirarchy looks somewhat like this: 296 | -- 297 | -- ![classes](other/nh.svg) 298 | 299 | -- $mapping 300 | -- 301 | -- 'GHC.Num' is a very old part of haskell, and is virtually unchanged since its specification in 302 | -- [haskell98](https://www.haskell.org/onlinereport/standard-prelude.html). 303 | -- 304 | -- A deconstruction of 'GHC.Num.Num' and mapping to numhask. 305 | -- 306 | -- > -- | Basic numeric class. 307 | -- > class Num a where 308 | -- > {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-} 309 | -- > 310 | -- > (+), (-), (*) :: a -> a -> a 311 | -- > -- | Unary negation. 312 | -- > negate :: a -> a 313 | -- 314 | -- '(+)' is an operator of the 'Additive' class 315 | -- 316 | -- '(-)' & 'negate' are functions in the 'Subtractive' class, and 317 | -- 318 | -- '(*)' is an operator of the 'Multiplicative' class. 319 | -- 320 | -- 'zero' and 'one' are also introduced to the numeric hierarchy. 321 | -- 322 | -- > -- | Absolute value. 323 | -- > abs :: a -> a 324 | -- > -- | Sign of a number. 325 | -- > -- The functions 'abs' and 'signum' should satisfy the law: 326 | -- > -- 327 | -- > -- > abs x * signum x == x 328 | -- > -- 329 | -- > -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero) 330 | -- > -- or @1@ (positive). 331 | -- > signum :: a -> a 332 | -- 333 | -- The concept of an absolute value and the sign of a number can include situations where the domain type is different to the absolute and sign codomain types. 334 | -- 335 | -- A new class, 'Basis' is supplied to handle these situations: 336 | -- 337 | -- - the 'magnitude' method is a generalisation of 'abs' 338 | -- 339 | -- - the 'basis' method is a generalisation of 'signum' 340 | -- 341 | -- 'NumHask.Algebra.Metric.abs' and 'NumHask.Algebra.Metric.signum' are specialisations of these methods. 342 | -- 343 | -- > -- | Conversion from an 'Integer'. 344 | -- > -- An integer literal represents the application of the function 345 | -- > -- 'fromInteger' to the appropriate value of type 'Integer', 346 | -- > -- so such literals have type @('Num' a) => a@. 347 | -- > fromInteger :: Integer -> a 348 | -- 349 | -- 'FromInteger' becomes its own class and 'FromIntegral' is introduced to polymorphise the covariant. 350 | -- 351 | -- Mappings from other areas of prelude include: 352 | -- 353 | -- - 'GHC.Real.Integral' becomes 'Integral' and a polymorphic 'ToIntegral' is introduced. 354 | -- 355 | -- - 'GHC.Real.Fractional' is roughly synonymous to 'Field' together with a polymorphic 'FromRatio'. 356 | -- 357 | -- - 'GHC.Real.RealFrac' becomes 'QuotientField' with a polymorphic 'Whole' type using Type Families. 358 | -- 359 | -- - 'GHC.Float.Floating' is split into 'ExpField' and 'TrigField' 360 | -- 361 | -- - 'GHC.Float.RealFloat' is not attempted. Life is too short. 362 | -- 363 | -- - Complex is resupplied in 'NumHask.Data.Complex' but with some functionality deriving via 'NumHask.Algebra.Metric.EuclideanPair'. The underlying representation has also been switched to a newtype-wrapped tuple. 364 | -- 365 | -- In addition to base changes, alternatives to 'sum' and 'product' from 'Data.Foldable' are also supplied. 366 | -------------------------------------------------------------------------------- /src/NumHask/Algebra/Metric.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | 5 | -- | Metric classes 6 | module NumHask.Algebra.Metric 7 | ( Basis (..), 8 | Absolute, 9 | Sign, 10 | EndoBased, 11 | abs, 12 | signum, 13 | distance, 14 | Direction (..), 15 | Polar (..), 16 | polar, 17 | coord, 18 | Epsilon (..), 19 | nearZero, 20 | aboutEqual, 21 | (~=), 22 | EuclideanPair (..), 23 | ) 24 | where 25 | 26 | import Control.Applicative 27 | import Data.Bool 28 | import Data.Data 29 | import Data.Int (Int16, Int32, Int64, Int8) 30 | import Data.Kind 31 | import Data.Type.Equality 32 | import Data.Word (Word16, Word32, Word64, Word8) 33 | import GHC.Generics 34 | import GHC.Natural (Natural (..)) 35 | import NumHask.Algebra.Action 36 | import NumHask.Algebra.Additive 37 | import NumHask.Algebra.Field 38 | import NumHask.Algebra.Lattice 39 | import NumHask.Algebra.Multiplicative 40 | import NumHask.Algebra.Ring 41 | import Prelude (Double, Eq (..), Float, Functor (..), Int, Integer, Ord (..), Show, Word, fromRational) 42 | import Prelude qualified as P 43 | 44 | -- $setup 45 | -- 46 | -- >>> :m -Prelude 47 | -- >>> :set -XRebindableSyntax 48 | -- >>> import NumHask.Prelude 49 | 50 | -- | 'Basis' encapsulates the notion of magnitude (intuitively the quotienting of a higher-kinded number to a scalar one) and the basis on which the magnitude quotienting was performed. An instance needs to satisfy these laws: 51 | -- 52 | -- @since 0.11 53 | -- 54 | -- > \a -> magnitude a >= zero 55 | -- > \a -> magnitude zero == zero 56 | -- > \a -> a == magnitude a *| basis a 57 | -- > \a -> magnitude (basis a) == one 58 | -- 59 | -- The names chosen are meant to represent the spiritual idea of a basis rather than a specific mathematics. See https://en.wikipedia.org/wiki/Basis_(linear_algebra) & https://en.wikipedia.org/wiki/Norm_(mathematics) for some mathematical motivations. 60 | -- 61 | -- >>> magnitude (-0.5 :: Double) 62 | -- 0.5 63 | -- 64 | -- >>> basis (-0.5 :: Double) 65 | -- -1.0 66 | class (Distributive (Mag a)) => Basis a where 67 | type Mag a :: Type 68 | type Base a :: Type 69 | 70 | -- | or length, or ||v|| 71 | magnitude :: a -> Mag a 72 | 73 | -- | or direction, or v-hat 74 | basis :: a -> Base a 75 | 76 | -- | Basis where the domain and magnitude codomain are the same. 77 | -- 78 | -- @since 0.11 79 | type Absolute a = (Basis a, Mag a ~ a) 80 | 81 | -- | Basis where the domain and basis codomain are the same. 82 | -- 83 | -- @since 0.11 84 | type Sign a = (Basis a, Base a ~ a) 85 | 86 | -- | Basis where the domain, magnitude codomain and basis codomain are the same. 87 | -- 88 | -- @since 0.11 89 | type EndoBased a = (Basis a, Mag a ~ a, Base a ~ a) 90 | 91 | -- | The absolute value of a number. 92 | -- 93 | -- prop> \a -> abs a * signum a ~= a 94 | -- 95 | -- 96 | -- >>> abs (-1) 97 | -- 1 98 | abs :: (Absolute a) => a -> a 99 | abs = magnitude 100 | 101 | -- | The sign of a number. 102 | -- 103 | -- @since 0.11 104 | -- 105 | -- >>> signum (-1) 106 | -- -1 107 | -- 108 | -- @abs zero == zero@, so any value for @signum zero@ is ok. We choose lawful neutral: 109 | -- 110 | -- >>> signum zero == zero 111 | -- True 112 | signum :: (Sign a) => a -> a 113 | signum = basis 114 | 115 | instance Basis Double where 116 | type Mag Double = Double 117 | type Base Double = Double 118 | magnitude = P.abs 119 | basis = P.signum 120 | 121 | instance Basis Float where 122 | type Mag Float = Float 123 | type Base Float = Float 124 | magnitude = P.abs 125 | basis = P.signum 126 | 127 | instance Basis Int where 128 | type Mag Int = Int 129 | type Base Int = Int 130 | magnitude = P.abs 131 | basis = P.signum 132 | 133 | instance Basis Integer where 134 | type Mag Integer = Integer 135 | type Base Integer = Integer 136 | magnitude = P.abs 137 | basis = P.signum 138 | 139 | instance Basis Natural where 140 | type Mag Natural = Natural 141 | type Base Natural = Natural 142 | magnitude = P.abs 143 | basis = P.signum 144 | 145 | instance Basis Int8 where 146 | type Mag Int8 = Int8 147 | type Base Int8 = Int8 148 | magnitude = P.abs 149 | basis = P.signum 150 | 151 | instance Basis Int16 where 152 | type Mag Int16 = Int16 153 | type Base Int16 = Int16 154 | magnitude = P.abs 155 | basis = P.signum 156 | 157 | instance Basis Int32 where 158 | type Mag Int32 = Int32 159 | type Base Int32 = Int32 160 | magnitude = P.abs 161 | basis = P.signum 162 | 163 | instance Basis Int64 where 164 | type Mag Int64 = Int64 165 | type Base Int64 = Int64 166 | magnitude = P.abs 167 | basis = P.signum 168 | 169 | instance Basis Word where 170 | type Mag Word = Word 171 | type Base Word = Word 172 | magnitude = P.abs 173 | basis = P.signum 174 | 175 | instance Basis Word8 where 176 | type Mag Word8 = Word8 177 | type Base Word8 = Word8 178 | magnitude = P.abs 179 | basis = P.signum 180 | 181 | instance Basis Word16 where 182 | type Mag Word16 = Word16 183 | type Base Word16 = Word16 184 | magnitude = P.abs 185 | basis = P.signum 186 | 187 | instance Basis Word32 where 188 | type Mag Word32 = Word32 189 | type Base Word32 = Word32 190 | magnitude = P.abs 191 | basis = P.signum 192 | 193 | instance Basis Word64 where 194 | type Mag Word64 = Word64 195 | type Base Word64 = Word64 196 | magnitude = P.abs 197 | basis = P.signum 198 | 199 | -- | Distance, which combines the Subtractive notion of difference, with Basis. 200 | -- 201 | -- > distance a b >= zero 202 | -- > distance a a == zero 203 | -- > distance a b *| basis (a - b) == a - b 204 | distance :: (Basis a, Subtractive a) => a -> a -> Mag a 205 | distance a b = magnitude (a - b) 206 | 207 | -- | Convert between a "co-ordinated" or "higher-kinded" number and a direction. 208 | -- 209 | -- @since 0.7 210 | -- 211 | -- > ray . angle == basis 212 | -- > magnitude (ray x) == one 213 | class (Distributive coord, Distributive (Dir coord)) => Direction coord where 214 | type Dir coord :: Type 215 | angle :: coord -> Dir coord 216 | ray :: Dir coord -> coord 217 | 218 | -- | Something that has a magnitude and a direction, with both expressed as the same type. 219 | -- 220 | -- @since 0.7 221 | -- 222 | -- See [Polar coordinate system](https://en.wikipedia.org/wiki/Polar_coordinate_system) 223 | data Polar a = Polar {radial :: a, azimuth :: a} 224 | deriving (Eq, Show, Generic, Data) 225 | 226 | instance (Additive a, Multiplicative a) => Basis (Polar a) where 227 | type Mag (Polar a) = a 228 | type Base (Polar a) = a 229 | magnitude = radial 230 | basis = azimuth 231 | 232 | -- | Convert a higher-kinded number that has direction, to a 'Polar' 233 | -- 234 | -- @since 0.7 235 | polar :: (Dir (Base a) ~ Mag a, Basis a, Direction (Base a)) => a -> Polar (Mag a) 236 | polar x = Polar (magnitude x) (angle (basis x)) 237 | 238 | -- | Convert a Polar to a (higher-kinded) number that has a direction. 239 | -- 240 | -- @since 0.07 241 | coord :: (Scalar m ~ Dir m, MultiplicativeAction m, Direction m) => Polar (Scalar m) -> m 242 | coord x = radial x *| ray (azimuth x) 243 | 244 | -- | A small number, especially useful for approximate equality. 245 | class 246 | (Eq a, Additive a) => 247 | Epsilon a 248 | where 249 | epsilon :: a 250 | epsilon = zero 251 | 252 | -- | Note that the constraint is Lattice rather than Ord allowing broader usage. 253 | -- 254 | -- >>> nearZero (epsilon :: Double) 255 | -- True 256 | -- 257 | -- >>> nearZero (epsilon :: EuclideanPair Double) 258 | -- True 259 | nearZero :: (Epsilon a, Lattice a, Subtractive a) => a -> Bool 260 | nearZero a = epsilon /\ a == epsilon && epsilon /\ negate a == epsilon 261 | 262 | -- | Approximate equality 263 | -- 264 | -- >>> aboutEqual zero (epsilon :: Double) 265 | -- True 266 | aboutEqual :: (Epsilon a, Lattice a, Subtractive a) => a -> a -> Bool 267 | aboutEqual a b = nearZero (a - b) 268 | 269 | infixl 4 ~= 270 | 271 | -- | About equal operator. 272 | -- 273 | -- >>> (1.0 + epsilon) ~= (1.0 :: Double) 274 | -- True 275 | (~=) :: (Epsilon a) => (Lattice a, Subtractive a) => a -> a -> Bool 276 | (~=) = aboutEqual 277 | 278 | -- | 1e-14 279 | instance Epsilon Double where 280 | epsilon = 1e-14 281 | 282 | -- | 1e-6 283 | instance Epsilon Float where 284 | epsilon = 1e-6 285 | 286 | -- | 0 287 | instance Epsilon Int 288 | 289 | instance Epsilon Integer 290 | 291 | instance Epsilon Int8 292 | 293 | instance Epsilon Int16 294 | 295 | instance Epsilon Int32 296 | 297 | instance Epsilon Int64 298 | 299 | instance Epsilon Word 300 | 301 | instance Epsilon Word8 302 | 303 | instance Epsilon Word16 304 | 305 | instance Epsilon Word32 306 | 307 | instance Epsilon Word64 308 | 309 | -- | Two dimensional cartesian coordinates. 310 | -- 311 | -- @since 0.11 312 | newtype EuclideanPair a = EuclideanPair {euclidPair :: (a, a)} 313 | deriving stock 314 | (Eq, Show, Generic, Data) 315 | 316 | instance Functor EuclideanPair where 317 | fmap f (EuclideanPair (x, y)) = EuclideanPair (f x, f y) 318 | 319 | instance Applicative EuclideanPair where 320 | pure x = EuclideanPair (x, x) 321 | EuclideanPair (fx, fy) <*> EuclideanPair (x, y) = EuclideanPair (fx x, fy y) 322 | liftA2 f (EuclideanPair (x, y)) (EuclideanPair (x', y')) = EuclideanPair (f x x', f y y') 323 | 324 | instance (Additive a) => Additive (EuclideanPair a) where 325 | (+) = liftA2 (+) 326 | zero = pure zero 327 | 328 | instance (Subtractive a) => Subtractive (EuclideanPair a) where 329 | negate = fmap negate 330 | 331 | instance 332 | (Multiplicative a) => 333 | Multiplicative (EuclideanPair a) 334 | where 335 | (*) = liftA2 (*) 336 | one = pure one 337 | 338 | instance 339 | (Subtractive a, Divisive a) => 340 | Divisive (EuclideanPair a) 341 | where 342 | recip = fmap recip 343 | 344 | instance (TrigField a) => Direction (EuclideanPair a) where 345 | type Dir (EuclideanPair a) = a 346 | angle (EuclideanPair (x, y)) = atan2 y x 347 | ray x = EuclideanPair (cos x, sin x) 348 | 349 | instance 350 | (ExpField a, Eq a) => 351 | Basis (EuclideanPair a) 352 | where 353 | type Mag (EuclideanPair a) = a 354 | type Base (EuclideanPair a) = EuclideanPair a 355 | 356 | magnitude (EuclideanPair (x, y)) = sqrt (x * x + y * y) 357 | basis p = let m = magnitude p in bool (p |/ m) zero (m == zero) 358 | 359 | instance 360 | (Epsilon a) => 361 | Epsilon (EuclideanPair a) 362 | where 363 | epsilon = pure epsilon 364 | 365 | instance (JoinSemiLattice a) => JoinSemiLattice (EuclideanPair a) where 366 | (\/) (EuclideanPair (x, y)) (EuclideanPair (x', y')) = EuclideanPair (x \/ x', y \/ y') 367 | 368 | instance (MeetSemiLattice a) => MeetSemiLattice (EuclideanPair a) where 369 | (/\) (EuclideanPair (x, y)) (EuclideanPair (x', y')) = EuclideanPair (x /\ x', y /\ y') 370 | 371 | instance (LowerBounded a) => LowerBounded (EuclideanPair a) where 372 | bottom = pure bottom 373 | 374 | instance (UpperBounded a) => UpperBounded (EuclideanPair a) where 375 | top = pure top 376 | 377 | instance (Multiplicative a) => MultiplicativeAction (EuclideanPair a) where 378 | type Scalar (EuclideanPair a) = a 379 | (|*) (EuclideanPair (x, y)) s = EuclideanPair (s * x, s * y) 380 | 381 | instance (Divisive a) => DivisiveAction (EuclideanPair a) where 382 | (|/) e s = fmap (/ s) e 383 | 384 | instance (Ord a, TrigField a, ExpField a) => ExpField (EuclideanPair a) where 385 | exp (EuclideanPair (x, y)) = EuclideanPair (exp x * cos y, exp x * sin y) 386 | log (EuclideanPair (x, y)) = EuclideanPair (log (sqrt (x * x + y * y)), atan2 y x) 387 | 388 | instance (QuotientField a, Subtractive a) => QuotientField (EuclideanPair a) where 389 | type Whole (EuclideanPair a) = EuclideanPair (Whole a) 390 | 391 | properFraction (EuclideanPair (x, y)) = 392 | (EuclideanPair (xwhole, ywhole), EuclideanPair (xfrac, yfrac)) 393 | where 394 | (xwhole, xfrac) = properFraction x 395 | (ywhole, yfrac) = properFraction y 396 | 397 | round (EuclideanPair (x, y)) = EuclideanPair (round x, round y) 398 | ceiling (EuclideanPair (x, y)) = EuclideanPair (ceiling x, ceiling y) 399 | floor (EuclideanPair (x, y)) = EuclideanPair (floor x, floor y) 400 | truncate (EuclideanPair (x, y)) = EuclideanPair (truncate x, truncate y) 401 | -------------------------------------------------------------------------------- /src/NumHask/Data/Integral.hs: -------------------------------------------------------------------------------- 1 | -- | Integral classes 2 | module NumHask.Data.Integral 3 | ( Integral (..), 4 | ToIntegral (..), 5 | ToInt, 6 | FromIntegral (..), 7 | FromInt, 8 | FromInteger (..), 9 | even, 10 | odd, 11 | (^^), 12 | (^), 13 | ) 14 | where 15 | 16 | import Data.Int (Int16, Int32, Int64, Int8) 17 | import Data.Ord 18 | import Data.Word (Word, Word16, Word32, Word64, Word8) 19 | import GHC.Natural (Natural (..), naturalFromInteger) 20 | import NumHask.Algebra.Additive 21 | import NumHask.Algebra.Multiplicative 22 | import NumHask.Algebra.Ring 23 | import Prelude (Double, Float, Int, Integer, fst, snd, (.)) 24 | import Prelude qualified as P 25 | 26 | -- $setup 27 | -- 28 | -- >>> :m -Prelude 29 | -- >>> :set -XRebindableSyntax 30 | -- >>> import NumHask.Prelude 31 | 32 | -- | An Integral is anything that satisfies the law: 33 | -- 34 | -- prop> \a b -> b == zero || b * (a `div` b) + (a `mod` b) == a 35 | -- 36 | -- >>> 3 `divMod` 2 37 | -- (1,1) 38 | -- 39 | -- >>> (-3) `divMod` 2 40 | -- (-2,1) 41 | -- 42 | -- >>> (-3) `quotRem` 2 43 | -- (-1,-1) 44 | class 45 | (Distributive a) => 46 | Integral a 47 | where 48 | infixl 7 `div`, `mod` 49 | div :: a -> a -> a 50 | div a1 a2 = fst (divMod a1 a2) 51 | mod :: a -> a -> a 52 | mod a1 a2 = snd (divMod a1 a2) 53 | 54 | divMod :: a -> a -> (a, a) 55 | 56 | quot :: a -> a -> a 57 | quot a1 a2 = fst (quotRem a1 a2) 58 | rem :: a -> a -> a 59 | rem a1 a2 = snd (quotRem a1 a2) 60 | 61 | quotRem :: a -> a -> (a, a) 62 | 63 | instance Integral Int where 64 | divMod = P.divMod 65 | quotRem = P.quotRem 66 | 67 | instance Integral Integer where 68 | divMod = P.divMod 69 | quotRem = P.quotRem 70 | 71 | instance Integral Natural where 72 | divMod = P.divMod 73 | quotRem = P.quotRem 74 | 75 | instance Integral Int8 where 76 | divMod = P.divMod 77 | quotRem = P.quotRem 78 | 79 | instance Integral Int16 where 80 | divMod = P.divMod 81 | quotRem = P.quotRem 82 | 83 | instance Integral Int32 where 84 | divMod = P.divMod 85 | quotRem = P.quotRem 86 | 87 | instance Integral Int64 where 88 | divMod = P.divMod 89 | quotRem = P.quotRem 90 | 91 | instance Integral Word where 92 | divMod = P.divMod 93 | quotRem = P.quotRem 94 | 95 | instance Integral Word8 where 96 | divMod = P.divMod 97 | quotRem = P.quotRem 98 | 99 | instance Integral Word16 where 100 | divMod = P.divMod 101 | quotRem = P.quotRem 102 | 103 | instance Integral Word32 where 104 | divMod = P.divMod 105 | quotRem = P.quotRem 106 | 107 | instance Integral Word64 where 108 | divMod = P.divMod 109 | quotRem = P.quotRem 110 | 111 | instance (Integral b) => Integral (a -> b) where 112 | div f f' a = f a `div` f' a 113 | mod f f' a = f a `mod` f' a 114 | divMod f f' = (\a -> fst (f a `divMod` f' a), \a -> snd (f a `divMod` f' a)) 115 | quot f f' a = f a `mod` f' a 116 | rem f f' a = f a `mod` f' a 117 | quotRem f f' = (\a -> fst (f a `quotRem` f' a), \a -> snd (f a `quotRem` f' a)) 118 | 119 | -- | 120 | -- >>> even 2 121 | -- True 122 | even :: (P.Eq a, Integral a) => a -> P.Bool 123 | even n = n `rem` (one + one) P.== zero 124 | 125 | -- | 126 | -- >>> odd 3 127 | -- True 128 | odd :: (P.Eq a, Integral a) => a -> P.Bool 129 | odd = P.not . even 130 | 131 | -- | toIntegral is kept separate from Integral to help with compatability issues. 132 | -- 133 | -- > toIntegral a == a 134 | class ToIntegral a b where 135 | {-# MINIMAL toIntegral #-} 136 | 137 | toIntegral :: a -> b 138 | 139 | -- | Convert to an 'Int' 140 | type ToInt a = ToIntegral a Int 141 | 142 | instance ToIntegral Integer Integer where 143 | toIntegral = P.id 144 | 145 | instance ToIntegral Int Integer where 146 | toIntegral = P.toInteger 147 | 148 | instance ToIntegral Natural Integer where 149 | toIntegral = P.toInteger 150 | 151 | instance ToIntegral Int8 Integer where 152 | toIntegral = P.toInteger 153 | 154 | instance ToIntegral Int16 Integer where 155 | toIntegral = P.toInteger 156 | 157 | instance ToIntegral Int32 Integer where 158 | toIntegral = P.toInteger 159 | 160 | instance ToIntegral Int64 Integer where 161 | toIntegral = P.toInteger 162 | 163 | instance ToIntegral Word Integer where 164 | toIntegral = P.toInteger 165 | 166 | instance ToIntegral Word8 Integer where 167 | toIntegral = P.toInteger 168 | 169 | instance ToIntegral Word16 Integer where 170 | toIntegral = P.toInteger 171 | 172 | instance ToIntegral Word32 Integer where 173 | toIntegral = P.toInteger 174 | 175 | instance ToIntegral Word64 Integer where 176 | toIntegral = P.toInteger 177 | 178 | instance ToIntegral Int Int where 179 | toIntegral = P.id 180 | 181 | instance ToIntegral Integer Int where 182 | toIntegral = P.fromIntegral 183 | 184 | instance ToIntegral Natural Int where 185 | toIntegral = P.fromIntegral 186 | 187 | instance ToIntegral Int8 Int where 188 | toIntegral = P.fromIntegral 189 | 190 | instance ToIntegral Int16 Int where 191 | toIntegral = P.fromIntegral 192 | 193 | instance ToIntegral Int32 Int where 194 | toIntegral = P.fromIntegral 195 | 196 | instance ToIntegral Int64 Int where 197 | toIntegral = P.fromIntegral 198 | 199 | instance ToIntegral Word Int where 200 | toIntegral = P.fromIntegral 201 | 202 | instance ToIntegral Word8 Int where 203 | toIntegral = P.fromIntegral 204 | 205 | instance ToIntegral Word16 Int where 206 | toIntegral = P.fromIntegral 207 | 208 | instance ToIntegral Word32 Int where 209 | toIntegral = P.fromIntegral 210 | 211 | instance ToIntegral Word64 Int where 212 | toIntegral = P.fromIntegral 213 | 214 | instance ToIntegral Natural Natural where 215 | toIntegral = P.id 216 | 217 | instance ToIntegral Int8 Int8 where 218 | toIntegral = P.id 219 | 220 | instance ToIntegral Int16 Int16 where 221 | toIntegral = P.id 222 | 223 | instance ToIntegral Int32 Int32 where 224 | toIntegral = P.id 225 | 226 | instance ToIntegral Int64 Int64 where 227 | toIntegral = P.id 228 | 229 | instance ToIntegral Word Word where 230 | toIntegral = P.id 231 | 232 | instance ToIntegral Word8 Word8 where 233 | toIntegral = P.id 234 | 235 | instance ToIntegral Word16 Word16 where 236 | toIntegral = P.id 237 | 238 | instance ToIntegral Word32 Word32 where 239 | toIntegral = P.id 240 | 241 | instance ToIntegral Word64 Word64 where 242 | toIntegral = P.id 243 | 244 | -- | Polymorphic version of fromInteger 245 | -- 246 | -- > fromIntegral a == a 247 | class FromIntegral a b where 248 | {-# MINIMAL fromIntegral #-} 249 | 250 | fromIntegral :: b -> a 251 | 252 | -- | Convert from an 'Int' 253 | type FromInt a = FromIntegral a Int 254 | 255 | instance (FromIntegral a b) => FromIntegral (c -> a) b where 256 | fromIntegral i _ = fromIntegral i 257 | 258 | instance FromIntegral Double Integer where 259 | fromIntegral = P.fromInteger 260 | 261 | instance FromIntegral Float Integer where 262 | fromIntegral = P.fromInteger 263 | 264 | instance FromIntegral Int Integer where 265 | fromIntegral = P.fromInteger 266 | 267 | instance FromIntegral Integer Integer where 268 | fromIntegral = P.id 269 | 270 | instance FromIntegral Natural Integer where 271 | fromIntegral = naturalFromInteger 272 | 273 | instance FromIntegral Int8 Integer where 274 | fromIntegral = P.fromInteger 275 | 276 | instance FromIntegral Int16 Integer where 277 | fromIntegral = P.fromInteger 278 | 279 | instance FromIntegral Int32 Integer where 280 | fromIntegral = P.fromInteger 281 | 282 | instance FromIntegral Int64 Integer where 283 | fromIntegral = P.fromInteger 284 | 285 | instance FromIntegral Word Integer where 286 | fromIntegral = P.fromInteger 287 | 288 | instance FromIntegral Word8 Integer where 289 | fromIntegral = P.fromInteger 290 | 291 | instance FromIntegral Word16 Integer where 292 | fromIntegral = P.fromInteger 293 | 294 | instance FromIntegral Word32 Integer where 295 | fromIntegral = P.fromInteger 296 | 297 | instance FromIntegral Word64 Integer where 298 | fromIntegral = P.fromInteger 299 | 300 | instance FromIntegral Double Int where 301 | fromIntegral = P.fromIntegral 302 | 303 | instance FromIntegral Float Int where 304 | fromIntegral = P.fromIntegral 305 | 306 | instance FromIntegral Int Int where 307 | fromIntegral = P.id 308 | 309 | instance FromIntegral Integer Int where 310 | fromIntegral = P.fromIntegral 311 | 312 | instance FromIntegral Natural Int where 313 | fromIntegral = P.fromIntegral 314 | 315 | instance FromIntegral Int8 Int where 316 | fromIntegral = P.fromIntegral 317 | 318 | instance FromIntegral Int16 Int where 319 | fromIntegral = P.fromIntegral 320 | 321 | instance FromIntegral Int32 Int where 322 | fromIntegral = P.fromIntegral 323 | 324 | instance FromIntegral Int64 Int where 325 | fromIntegral = P.fromIntegral 326 | 327 | instance FromIntegral Word Int where 328 | fromIntegral = P.fromIntegral 329 | 330 | instance FromIntegral Word8 Int where 331 | fromIntegral = P.fromIntegral 332 | 333 | instance FromIntegral Word16 Int where 334 | fromIntegral = P.fromIntegral 335 | 336 | instance FromIntegral Word32 Int where 337 | fromIntegral = P.fromIntegral 338 | 339 | instance FromIntegral Word64 Int where 340 | fromIntegral = P.fromIntegral 341 | 342 | instance FromIntegral Natural Natural where 343 | fromIntegral = P.id 344 | 345 | instance FromIntegral Int8 Int8 where 346 | fromIntegral = P.id 347 | 348 | instance FromIntegral Int16 Int16 where 349 | fromIntegral = P.id 350 | 351 | instance FromIntegral Int32 Int32 where 352 | fromIntegral = P.id 353 | 354 | instance FromIntegral Int64 Int64 where 355 | fromIntegral = P.id 356 | 357 | instance FromIntegral Word Word where 358 | fromIntegral = P.id 359 | 360 | instance FromIntegral Word8 Word8 where 361 | fromIntegral = P.id 362 | 363 | instance FromIntegral Word16 Word16 where 364 | fromIntegral = P.id 365 | 366 | instance FromIntegral Word32 Word32 where 367 | fromIntegral = P.id 368 | 369 | instance FromIntegral Word64 Word64 where 370 | fromIntegral = P.id 371 | 372 | -- | 'fromInteger' is special in two ways: 373 | -- 374 | -- - numeric integral literals (like "42") are interpreted specifically as "fromInteger (42 :: GHC.Num.Integer)". The prelude version is used as default (or whatever fromInteger is in scope if RebindableSyntax is set). 375 | -- 376 | -- - The default rules in < https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-750004.3 haskell2010> specify that constraints on 'fromInteger' need to be in a form @C v@, where v is a Num or a subclass of Num. 377 | -- 378 | -- So a type synonym such as @type FromInteger a = FromIntegral a Integer@ doesn't work well with type defaulting; hence the need for a separate class. 379 | class FromInteger a where 380 | fromInteger :: Integer -> a 381 | 382 | instance FromInteger Double where 383 | fromInteger = P.fromInteger 384 | 385 | instance FromInteger Float where 386 | fromInteger = P.fromInteger 387 | 388 | instance FromInteger Int where 389 | fromInteger = P.fromInteger 390 | 391 | instance FromInteger Integer where 392 | fromInteger = P.id 393 | 394 | instance FromInteger Natural where 395 | fromInteger = naturalFromInteger 396 | 397 | instance FromInteger Int8 where 398 | fromInteger = P.fromInteger 399 | 400 | instance FromInteger Int16 where 401 | fromInteger = P.fromInteger 402 | 403 | instance FromInteger Int32 where 404 | fromInteger = P.fromInteger 405 | 406 | instance FromInteger Int64 where 407 | fromInteger = P.fromInteger 408 | 409 | instance FromInteger Word where 410 | fromInteger = P.fromInteger 411 | 412 | instance FromInteger Word8 where 413 | fromInteger = P.fromInteger 414 | 415 | instance FromInteger Word16 where 416 | fromInteger = P.fromInteger 417 | 418 | instance FromInteger Word32 where 419 | fromInteger = P.fromInteger 420 | 421 | instance FromInteger Word64 where 422 | fromInteger = P.fromInteger 423 | 424 | infixr 8 ^^ 425 | 426 | -- | raise a number to an 'Integral' power 427 | -- 428 | -- >>> 2 ^^ 3 429 | -- 8.0 430 | -- 431 | -- >>> 2 ^^ (-2) 432 | -- 0.25 433 | (^^) :: 434 | (P.Ord b, Divisive a, Subtractive b, Integral b) => 435 | a -> 436 | b -> 437 | a 438 | x0 ^^ y0 = 439 | case compare y0 zero of 440 | EQ -> one 441 | GT -> f x0 y0 442 | LT -> recip (x0 ^^ negate y0) 443 | where 444 | f x y 445 | | even y = f (x * x) (y `quot` two) 446 | | y P.== one = x 447 | | P.otherwise = g (x * x) (y `quot` two) x 448 | g x y z 449 | | even y = g (x * x) (y `quot` two) z 450 | | y P.== one = x * z 451 | | P.otherwise = g (x * x) (y `quot` two) (x * z) 452 | 453 | infixr 8 ^ 454 | 455 | -- | raise a number to an 'Int' power 456 | -- 457 | -- Note: This differs from (^) found in prelude which is a partial function (it errors on negative integrals). This is a monomorphic version of '(^^)' provided to help reduce ambiguous type noise in common usages. 458 | -- 459 | -- >>> 2 ^ 3 460 | -- 8.0 461 | -- 462 | -- >>> 2 ^ (-2) 463 | -- 0.25 464 | (^) :: 465 | (Divisive a) => a -> Int -> a 466 | (^) x n = x ^^ n 467 | --------------------------------------------------------------------------------