pax_global_header00006660000000000000000000000064145121134340014510gustar00rootroot0000000000000052 comment=0817da6877aa045932221134913d8511caa78d97 agda-stdlib-1.7.3/000077500000000000000000000000001451211343400136735ustar00rootroot00000000000000agda-stdlib-1.7.3/.boring000066400000000000000000000001221451211343400151470ustar00rootroot00000000000000\.l?agda\.el$ \.agdai$ (^|/)MAlonzo($|/) ^dist($|/) ^html($|/) ^Everything\.agda$ agda-stdlib-1.7.3/.gitattributes000066400000000000000000000000271451211343400165650ustar00rootroot00000000000000.travis.yml merge=ours agda-stdlib-1.7.3/.github/000077500000000000000000000000001451211343400152335ustar00rootroot00000000000000agda-stdlib-1.7.3/.github/workflows/000077500000000000000000000000001451211343400172705ustar00rootroot00000000000000agda-stdlib-1.7.3/.github/workflows/ci-ubuntu.yml000066400000000000000000000161601451211343400217320ustar00rootroot00000000000000name: Ubuntu build on: push: branches: - master - experimental pull_request: branches: - master - experimental ######################################################################## ## CONFIGURATION ## ## See SETTINGS for the most important configuration variable: AGDA_COMMIT. ## It has to be defined as a build step because it is potentially branch ## dependent. ## ## As for the rest: ## ## Basically do not touch GHC_VERSION and CABAL_VERSION as long as ## they aren't a problem in the build. If you have time to waste, it ## could be worth investigating whether newer versions of ghc produce ## more efficient Agda executable and could cut down the build time. ## Just be aware that actions are flaky and small variations are to be ## expected. ## ## The CABAL_INSTALL variable only passes `-O1` optimisations to ghc ## because github actions cannot currently handle a build using `-O2`. ## To be experimented with again in the future to see if things have ## gotten better. ## ## We use `v1-install` rather than `install` as Agda as a community ## hasn't figured out how to manage dependencies with the new local ## style builds (see agda/agda#4627 for details). Once this is resolved ## we should upgrade to `install`. ## ## The AGDA variable specifies the command to use to build the library. ## It currently passes the flag `-Werror` to ensure maximal compliance ## with e.g. not relying on deprecated definitions. ## The rest are some arbitrary runtime arguments that shape the way Agda ## allocates and garbage collects memory. It should make things faster. ## Limits can be bumped if the builds start erroring with out of memory ## errors. ## ######################################################################## env: GHC_VERSION: 8.6.5 CABAL_VERSION: 3.2.0.0 CABAL_INSTALL: cabal v1-install --ghc-options='-O1 +RTS -M6G -RTS' # CABAL_INSTALL: cabal install --overwrite-policy=always --ghc-options='-O1 +RTS -M6G -RTS' AGDA: agda -Werror +RTS -M3.5G -H3.5G -A128M -RTS -i. -i src/ jobs: test-stdlib: runs-on: ubuntu-latest steps: ######################################################################## ## SETTINGS ## ## AGDA_COMMIT picks the version of Agda to use to build the library. ## It can either be a hash of a specific commit (to target a bugfix for ## instance) or a tag e.g. tags/v2.6.1.3 (to target a released version). ## ## AGDA_HTML_DIR picks the html/ subdir in which to publish the docs. ## The content of the html/ directory will be deployed so we put the ## master version at the root and the experimental in a subdirectory. ######################################################################## - name: Initialise variables run: | if [[ '${{ github.ref }}' == 'refs/heads/master' \ || '${{ github.base_ref }}' == 'master' ]]; then # Pick Agda version for master echo "AGDA_COMMIT=tags/v2.6.1.3.20210524" >> $GITHUB_ENV; echo "AGDA_HTML_DIR=html" >> $GITHUB_ENV elif [[ '${{ github.ref }}' == 'refs/heads/experimental' \ || '${{ github.base_ref }}' == 'experimental' ]]; then # Pick Agda version for experimental echo "AGDA_COMMIT=9047e32a1b0cba98a299ed439a08d35bc4846f99" >> $GITHUB_ENV; echo "AGDA_HTML_DIR=html/experimental" >> $GITHUB_ENV fi if [[ '${{ github.ref }}' == 'refs/heads/master' \ || '${{ github.ref }}' == 'refs/heads/experimental' ]]; then echo "AGDA_DEPLOY=true" >> $GITHUB_ENV fi ######################################################################## ## CACHING ######################################################################## # This caching step allows us to save a lot of building time by only # downloading ghc and cabal and rebuilding Agda if absolutely necessary # i.e. if we change either the version of Agda, ghc, or cabal that we want # to use for the build. - name: Cache cabal packages uses: actions/cache@v2 id: cache-cabal with: path: | ~/.cabal/packages ~/.cabal/store ~/.cabal/bin key: ${{ runner.os }}-${{ env.GHC_VERSION }}-${{ env.CABAL_VERSION }}-${{ env.AGDA_COMMIT }} ######################################################################## ## INSTALLATION STEPS ######################################################################## - name: Install cabal if: steps.cache-cabal.outputs.cache-hit != 'true' uses: actions/setup-haskell@v1.1.3 with: ghc-version: ${{ env.GHC_VERSION }} cabal-version: ${{ env.CABAL_VERSION }} - name: Put cabal programs in PATH run: echo "~/.cabal/bin" >> $GITHUB_PATH - name: Cabal update run: cabal update - name: Download and install Agda from github if: steps.cache-cabal.outputs.cache-hit != 'true' run: | git clone https://github.com/agda/agda cd agda git checkout ${{ env.AGDA_COMMIT }} mkdir -p doc touch doc/user-manual.pdf ${{ env.CABAL_INSTALL }} cd .. ######################################################################## ## TESTING AND DEPLOYMENT ######################################################################## # By default github actions do not pull the repo - name: Checkout stdlib uses: actions/checkout@v2 - name: Test stdlib run: | ${{ env.CABAL_INSTALL }} agda-stdlib-utils.cabal cabal run GenerateEverything cp travis/* . ./index.sh ${{ env.AGDA }} --safe EverythingSafe.agda ${{ env.AGDA }} index.agda ######################################################################## ## DOC DEPLOYMENT ######################################################################## # We start by retrieving the currently deployed docs # We remove the content that is in the directory we are going to populate # so that stale files corresponding to deleted modules do not accumulate. # We then generate the docs in the AGDA_HTML_DIR subdirectory - name: Generate HTML run: | git clone --depth 1 --single-branch --branch gh-pages https://github.com/agda/agda-stdlib html rm -f '${{ env.AGDA_HTML_DIR }}'/*.html rm -f '${{ env.AGDA_HTML_DIR }}'/*.css ${{ env.AGDA }} --html --html-dir ${{ env.AGDA_HTML_DIR }} index.agda # This is a massive hack at the moment # - name: Compile stdlib # run: | # ${{ env.AGDA }} -c --no-main --ghc-dont-call-ghc --compile-dir=tmp Everything.agda # cd tmp # yes | cabal init --interactive # head -n -17 tmp.cabal > tmp # mv tmp tmp.cabal # cat ../travis/ghc-options >> tmp.cabal # cabal build ## ${{ env.AGDA }} -c README/Foreign/Haskell.agda && ./Haskell - name: Deploy HTML uses: JamesIves/github-pages-deploy-action@4.1.3 if: ${{ success() && env.AGDA_DEPLOY }} with: branch: gh-pages folder: html git-config-name: Github Actionsagda-stdlib-1.7.3/.github/workflows/haskell-ci.yml000066400000000000000000000154021451211343400220310ustar00rootroot00000000000000# This GitHub workflow config has been generated by a script via # # haskell-ci 'github' '--no-cabal-check' 'agda-stdlib-utils.cabal' # # To regenerate the script (for example after adjusting tested-with) run # # haskell-ci regenerate # # For more information, see https://github.com/haskell-CI/haskell-ci # # version: 0.12.1 # # REGENDATA ("0.12.1",["github","--no-cabal-check","agda-stdlib-utils.cabal"]) # name: Haskell-CI on: push: branches: - master - experimental pull_request: branches: - master - experimental jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} runs-on: ubuntu-18.04 container: image: buildpack-deps:xenial continue-on-error: ${{ matrix.allow-failure }} strategy: matrix: include: - compiler: ghc-9.0.1 allow-failure: false - compiler: ghc-8.10.4 allow-failure: false - compiler: ghc-8.8.4 allow-failure: false - compiler: ghc-8.6.5 allow-failure: false - compiler: ghc-8.4.4 allow-failure: false - compiler: ghc-8.2.2 allow-failure: false - compiler: ghc-8.0.2 allow-failure: false fail-fast: false steps: - name: apt run: | apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common apt-add-repository -y 'ppa:hvr/ghc' apt-get update apt-get install -y $CC cabal-install-3.4 env: CC: ${{ matrix.compiler }} - name: Set PATH and environment variables run: | echo "$HOME/.cabal/bin" >> $GITHUB_PATH echo "LANG=C.UTF-8" >> $GITHUB_ENV echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV HCDIR=$(echo "/opt/$CC" | sed 's/-/\//') HCNAME=ghc HC=$HCDIR/bin/$HCNAME echo "HC=$HC" >> $GITHUB_ENV echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV echo "HEADHACKAGE=false" >> $GITHUB_ENV echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV echo "GHCJSARITH=0" >> $GITHUB_ENV env: CC: ${{ matrix.compiler }} - name: env run: | env - name: write cabal config run: | mkdir -p $CABAL_DIR cat >> $CABAL_CONFIG < cabal-plan.xz echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan rm -f cabal-plan.xz chmod a+x $HOME/.cabal/bin/cabal-plan cabal-plan --version - name: checkout uses: actions/checkout@v2 with: path: source - name: initial cabal.project for sdist run: | touch cabal.project echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project cat cabal.project - name: sdist run: | mkdir -p sdist $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist - name: unpack run: | mkdir -p unpacked find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; - name: generate cabal.project run: | PKGDIR_agda_stdlib_utils="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/agda-stdlib-utils-[0-9.]*')" echo "PKGDIR_agda_stdlib_utils=${PKGDIR_agda_stdlib_utils}" >> $GITHUB_ENV touch cabal.project touch cabal.project.local echo "packages: ${PKGDIR_agda_stdlib_utils}" >> cabal.project if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package agda-stdlib-utils" >> cabal.project ; fi if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi cat >> cabal.project <> cabal.project.local cat cabal.project cat cabal.project.local - name: dump install plan run: | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - name: cache uses: actions/cache@v2 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- - name: install dependencies run: | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all - name: build w/o tests run: | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all - name: build run: | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always - name: unconstrained build run: | rm -f cabal.project.local $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all agda-stdlib-1.7.3/.gitignore000066400000000000000000000005171451211343400156660ustar00rootroot00000000000000# Keep this file in alphabetic order please! # Sort with the command `sort -uf` *.agda.el *.agdai *.hi *.lagda.el *.o .stack-work *.svg *.tix *.vim *~ .*.swp ./_build/* .DS_Store dist dist-newstyle Everything.agda EverythingSafe.agda EverythingSafeGuardedness.agda EverythingSafeSizedTypes.agda GenerateEverything Haskell html MAlonzo agda-stdlib-1.7.3/.mailmap000066400000000000000000000020611451211343400153130ustar00rootroot00000000000000# The information from some Git commands, e.g. git shortlog -nse, is # better by using this file. # Please keep this file in alphabetic order! ############################################################################## Alan Jeffrey ajeffrey Andreas Abel andreas.abel Darin Morrison dwm Dominique Devriese Evgeny Kotelnikov aztek Gergő Érdi gergo Jean-Philippe Bernardy jeanphilippe.bernardy Noam Zeilberger noam.zeilberger Patrik Jansson patrikj Shin-Cheng Mu scm Ulf Norell ulf.norell Ulf Norell ulfn Ulf Norell ulfn agda-stdlib-1.7.3/AllNonAsciiChars.hs000066400000000000000000000025751451211343400173550ustar00rootroot00000000000000{-# LANGUAGE OverloadedStrings #-} -- | This module extracts all the non-ASCII characters used by the -- library code (along with how many times they are used). module Main where import qualified Data.List as L (sortBy, group, sort) import Data.Char (isAscii, ord) import Data.Function (on) import Numeric (showHex) import System.FilePath.Find (find, always, extension, (||?), (==?)) import System.IO (openFile, hSetEncoding, utf8, IOMode(ReadMode)) import qualified Data.Text as T (Text, pack, unpack, concat) import qualified Data.Text.IO as T (putStrLn, hGetContents) readUTF8File :: FilePath -> IO T.Text readUTF8File f = do h <- openFile f ReadMode hSetEncoding h utf8 T.hGetContents h main :: IO () main = do agdaFiles <- find always (extension ==? ".agda" ||? extension ==? ".lagda") "src" nonAsciiChars <- filter (not . isAscii) . T.unpack . T.concat <$> mapM readUTF8File agdaFiles let table :: [(Char, Int)] table = L.sortBy (flip compare `on` snd) $ map (\cs -> (head cs, length cs)) $ L.group $ L.sort $ nonAsciiChars let codePoint :: Char -> T.Text codePoint c = T.pack $ showHex (ord c) "" uPlus :: Char -> T.Text uPlus c = T.concat ["(U+", codePoint c, ")"] mapM_ (\(c, count) -> T.putStrLn $ T.concat [T.pack [c], " ", uPlus c, ": ", T.pack $ show count]) table agda-stdlib-1.7.3/CHANGELOG.md000066400000000000000000000012611451211343400155040ustar00rootroot00000000000000Version 1.7.3 ============= The library has been tested using Agda 2.6.3 & 2.6.4. * To avoid _large indices_ that are by default no longer allowed in Agda 2.6.4, universe levels have been increased in the following definitions: - `Data.Star.Decoration.DecoratedWith` - `Data.Star.Pointer.Pointer` - `Reflection.AnnotatedAST.Typeₐ` - `Reflection.AnnotatedAST.AnnotationFun` * The following aliases have been added: - `IO.Primitive.pure` as alias for `IO.Primitive.return` - modules `Effect.*` as aliases for modules `Category.*` These allow to address said objects with the new name they will have in v2.0 of the library, to ease the transition from v1.7.3 to v2.0. agda-stdlib-1.7.3/CHANGELOG/000077500000000000000000000000001451211343400151625ustar00rootroot00000000000000agda-stdlib-1.7.3/CHANGELOG/v0.01.md000066400000000000000000000003331451211343400162470ustar00rootroot00000000000000Version 0.1 =========== Version 0.1 of the ["standard" library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.2. agda-stdlib-1.7.3/CHANGELOG/v0.02.md000066400000000000000000000005201451211343400162460ustar00rootroot00000000000000Version 0.2 =========== Version 0.2 of the ["standard" library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.4. Note that the library sources are now located in the sub-directory `lib-/src` of the installation tarball. agda-stdlib-1.7.3/CHANGELOG/v0.03.md000066400000000000000000000003311451211343400162470ustar00rootroot00000000000000Version 0.3 =========== Version 0.3 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.6. agda-stdlib-1.7.3/CHANGELOG/v0.04.md000066400000000000000000000003311451211343400162500ustar00rootroot00000000000000Version 0.4 =========== Version 0.4 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.8. agda-stdlib-1.7.3/CHANGELOG/v0.05.md000066400000000000000000000003321451211343400162520ustar00rootroot00000000000000Version 0.5 =========== Version 0.5 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.2.10. agda-stdlib-1.7.3/CHANGELOG/v0.06.md000066400000000000000000000003311451211343400162520ustar00rootroot00000000000000Version 0.6 =========== Version 0.6 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.3.0. agda-stdlib-1.7.3/CHANGELOG/v0.07.md000066400000000000000000000003311451211343400162530ustar00rootroot00000000000000Version 0.7 =========== Version 0.7 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.3.2. agda-stdlib-1.7.3/CHANGELOG/v0.08.1.md000066400000000000000000000007701451211343400164220ustar00rootroot00000000000000Version 0.8.1 ============= The library has been tested using Agda version 2.4.2. Important changes since 0.8: * Reflection API Agda 2.4.2 added support for literals, function definitions, pattern matching lambdas and absurd clause/patterns (see Agda release notes). The new supported entities were added to the `Reflection.agda` module. * Modules renamed `Foo.Props.Bar` -> `Foo.Properties.Bar` The current compatibility modules `Foo.Props.Bar` will be removed in the next release. agda-stdlib-1.7.3/CHANGELOG/v0.08.md000066400000000000000000000003311451211343400162540ustar00rootroot00000000000000Version 0.8 =========== Version 0.8 of the [standard library](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary) has now been released. The library has been tested using Agda version 2.4.0. agda-stdlib-1.7.3/CHANGELOG/v0.09.md000066400000000000000000000016301451211343400162600ustar00rootroot00000000000000Version 0.9 =========== The library has been tested using Agda version 2.4.2.1. Important changes since 0.8.1: * `Data.List.NonEmpty` Non-empty lists are no longer defined in terms of `Data.Product._×_`, instead, now they are defined as record with fields head and tail. * Reflection API + Quoting levels was fixed. This fix could break some code (see Agda Issue [#1207](https://github.com/agda/agda/issues/1269)). + The `Reflection.type` function returns a normalised `Reflection.Type` and `quoteTerm` returns an η-contracted `Reflection.Term` now. These changes could break some code (see Agda Issue [#1269](https://github.com/agda/agda/issues/1269)). + The primitive function for showing names, `primShowQName`, is now exposed as `Reflection.showName`. * Removed compatibility modules for `Props -> Properties` rename Use `Foo.Properties.Bar` instead of `Foo.Props.Bar`. agda-stdlib-1.7.3/CHANGELOG/v0.10.md000066400000000000000000000107421451211343400162540ustar00rootroot00000000000000Version 0.10 ============ The library has been tested using Agda version 2.4.2.3. Important changes since 0.9: * Renamed `Data.Unit.Core` to `Data.Unit.NonEta`. * Removed `Data.String.Core`. The module `Data.String.Base` now contains these definitions. * Removed `Relation.Nullary.Core`. The module `Relation.Nullary` now contains these definitions directly. * Inspect on steroids has been simplified (see `Relation.Binary.PropositionalEquality` and `Relation.Binary.HeterogeneousEquality`). The old version has been deprecated (see the above modules) and it will be removed in the next release. * Using `Data.X.Base` modules. The `Data.X.Base` modules are used for cheaply importing a data type and the most common definitions. The use of these modules reduce type-checking and compilation times. At the moment, the modules added are: ```agda Data.Bool.Base Data.Char.Base Data.Integer.Base Data.List.Base Data.Maybe.Base Data.Nat.Base Data.String.Base Data.Unit.Base ``` These modules are also cheap to import and can be considered basic: ```agda Data.BoundedVec.Inefficient Data.Empty Data.Product Data.Sign Data.Sum Function Level Relation.Binary Relation.Binary.PropositionalEquality.TrustMe Relation.Nullary ``` * Added singleton sets to `Relation.Unary`. There used to be an isomorphic definition of singleton sets in `Monad.Predicate`, this has been removed and the module has been cleaned up accordingly. The singleton set is also used to define generic operations (Plotkin and Power's terminology) in `Data.Container.Indexed.FreeMonad`. * Proved properties of `Data.List.gfilter`. The following definitions have been added to Data.List.Properties: ```agda gfilter-just : ... → gfilter just xs ≡ xs gfilter-nothing : ... → gfilter (λ _ → nothing) xs ≡ [] gfilter-concatMap : ... → gfilter f ≗ concatMap (fromMaybe ∘ f) ``` * New in `Data.Nat.Properties`: ```agda <⇒≤pred : ∀ {m n} → m < n → m ≤ pred n ``` * New in `Data.Fin`: ```agda strengthen : ∀ {n} (i : Fin n) → Fin′ (suc i) ``` * New in `Data.Fin.Properties`: ```agda from-to : ∀ {n} (i : Fin n) → fromℕ (toℕ i) ≡ strengthen i toℕ-strengthen : ∀ {n} (i : Fin n) → toℕ (strengthen i) ≡ toℕ i fromℕ-def : ∀ n → fromℕ n ≡ fromℕ≤ ℕ≤-refl reverse-suc : ∀{n}{i : Fin n} → toℕ (reverse (suc i)) ≡ toℕ (reverse i) inject≤-refl : ∀ {n} (i : Fin n) (n≤n : n ℕ≤ n) → inject≤ i n≤n ≡ i ``` * New in `Data.List.NonEmpty`: ```agda foldr₁ : ∀ {a} {A : Set a} → (A → A → A) → List⁺ A → A foldl₁ : ∀ {a} {A : Set a} → (A → A → A) → List⁺ A → A ``` * `Data.AVL.Height-invariants._∼_` was replaced by `_∼_⊔_`, following Conor McBride's principle of pushing information into indices rather than pulling information out. Some lemmas in `Data.AVL.Height-invariants` (`1+`, `max∼max` and `max-lemma`) were removed. The implementations of some functions in `Data.AVL` were simplified. This could mean that they, and other functions depending on them (in `Data.AVL`, `Data.AVL.IndexedMap` and `Data.AVL.Sets`), reduce in a different way than they used to. * The fixity of all `_∎` and `finally` operators, as well as `Category.Monad.Partiality.All._⟨_⟩P`, was changed from `infix 2` to `infix 3`. * The fixity of `Category.Monad.Partiality._≟-Kind_`, `Data.AVL._∈?_`, `Data.AVL.IndexedMap._∈?_`, `Data.AVL.Sets._∈?_`, `Data.Bool._≟_`, `Data.Char._≟_`, `Data.Float._≟_`, `Data.Nat._≤?_`, `Data.Nat.Divisibility._∣?_`, `Data.Sign._≟_`, `Data.String._≟_`, `Data.Unit._≟_`, `Data.Unit._≤?_` and `Data.Vec.Equality.DecidableEquality._≟_` was changed from the default to `infix 4`. * The fixity of all `_≟_` operators in `Reflection` is now `infix 4` (some of them already had this fixity). * The fixity of `Algebra.Operations._×′_` was changed from the default to `infixr 7`. * The fixity of `Data.Fin.#_` was changed from the default to `infix 10`. * The fixity of `Data.Nat.Divisibility.1∣_` and `_∣0` was changed from the default to `infix 10`. * The fixity of `Data.Nat.DivMod._divMod_`, `_div_` and `_mod_` was changed from the default to `infixl 7`. * The fixity of `Data.Product.Σ-syntax` was changed from the default to `infix 2`. * The fixity of `Relation.Unary._~` was changed from the default to `infix 10`. agda-stdlib-1.7.3/CHANGELOG/v0.11.md000066400000000000000000000011271451211343400162520ustar00rootroot00000000000000Version 0.11 ============ The library has been tested using Agda version 2.4.2.4. Important changes since 0.10: * `Relation.Binary.PropositionalEquality.TrustMe.erase` was added. * Added `Data.Nat.Base.{_≤″_,_≥″_,_<″_,_>″_,erase}`, `Data.Nat.Properties.{≤⇒≤″,≤″⇒≤}`, `Data.Fin.fromℕ≤″`, and `Data.Fin.Properties.fromℕ≤≡fromℕ≤″`. * The functions in `Data.Nat.DivMod` have been optimised. * Turned on η-equality for `Record.Record`, removed `Record.Signature′` and `Record.Record′`. * Renamed `Data.AVL.agda._⊕_sub1` to `pred[_⊕_]`. agda-stdlib-1.7.3/CHANGELOG/v0.12.md000066400000000000000000000002201451211343400162440ustar00rootroot00000000000000Version 0.12 ============ The library has been tested using Agda version 2.5.1. Important changes since 0.11: * Added support for GHC 8.0.1. agda-stdlib-1.7.3/CHANGELOG/v0.13.md000066400000000000000000000034241451211343400162560ustar00rootroot00000000000000Version 0.13 ============ The library has been tested using Agda version 2.5.2. Important changes since 0.12: * Added the `Selective` property in `Algebra.FunctionProperties` as well as proofs of the selectivity of `min` and `max` in `Data.Nat.Properties`. * Added `Relation.Binary.Product.StrictLex.×-total₂`, an alternative (non-degenerative) proof for totality, and renamed `×-total` to `x-total₁` in that module. * Added the `length-filter` property to `Data.List.Properties` (the `filter` equivalent to the pre-existing `length-gfilter`). * Added `_≤?_` decision procedure for `Data.Fin`. * Added `allPairs` function to `Data.Vec`. * Added additional properties of `_∈_` to `Data.Vec.Properties`: `∈-map`, `∈-++ₗ`, `∈-++ᵣ`, `∈-allPairs`. * Added some `zip`/`unzip`-related properties to `Data.Vec.Properties`. * Added an `All` predicate and related properties for `Data.Vec` (see `Data.Vec.All` and `Data.Vec.All.Properties`). * Added order-theoretic lattices and some related properties in `Relation.Binary.Lattice` and `Relation.Binary.Properties`. * Added symmetric and equivalence closures of binary relations in `Relation.Binary.SymmetricClosure` and `Relation.Binary.EquivalenceClosure`. * Added `Congruent₁` and `Congruent₂` to `Algebra.FunctionProperties`. These are aliases for `_Preserves _≈_ ⟶ _≈_` and `_Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_` from `Relation.Binary.Core`. * Useful lemmas and properties that were previously in private scope, either explicitly or within records, have been made public in several `Properties.agda` files. These include: ```agda Data.Bool.Properties Data.Fin.Properties Data.Integer.Properties Data.Integer.Addition.Properties Data.Integer.Multiplication.Properties ``` agda-stdlib-1.7.3/CHANGELOG/v0.14.md000066400000000000000000000774461451211343400162760ustar00rootroot00000000000000Version 0.14 ============ The library has been tested using Agda version 2.5.3. Non-backwards compatible changes -------------------------------- #### 1st stage of overhaul of list membership * The current setup for list membership is difficult to work with as both setoid membership and propositional membership exist as internal modules of `Data.Any`. Furthermore the top-level module `Data.List.Any.Membership` actually contains properties of propositional membership rather than the membership relation itself as its name would suggest. Consequently this leaves no place to reason about the properties of setoid membership. Therefore the two internal modules `Membership` and `Membership-≡` have been moved out of `Data.List.Any` into top-level `Data.List.Any.Membership` and `Data.List.Any.Membership.Propositional` respectively. The previous module `Data.List.Any.Membership` has been renamed `Data.List.Any.Membership.Propositional.Properties`. Accordingly some lemmas have been moved to more logical locations: - `lift-resp` has been moved from `Data.List.Any.Membership` to `Data.List.Any.Properties` - `∈-resp-≈`, `⊆-preorder` and `⊆-Reasoning` have been moved from `Data.List.Any.Membership` to `Data.List.Any.Membership.Properties`. - `∈-resp-list-≈` has been moved from `Data.List.Any.Membership` to `Data.List.Any.Membership.Properties` and renamed `∈-resp-≋`. - `swap` in `Data.List.Any.Properties` has been renamed `swap↔` and made more generic with respect to levels. #### Moving `decTotalOrder` and `decSetoid` from `Data.X` to `Data.X.Properties` * Currently the library does not directly expose proofs of basic properties such as reflexivity, transitivity etc. for `_≤_` in numeric datatypes such as `Nat`, `Integer` etc. In order to use these properties it was necessary to first import the `decTotalOrder` proof from `Data.X` and then separately open it, often having to rename the proofs as well. This adds unneccessary lines of code to the import statements for what are very commonly used properties. These basic proofs have now been added in `Data.X.Properties` along with proofs that they form pre-orders, partial orders and total orders. This should make them considerably easier to work with and simplify files' import preambles. However consequently the records `decTotalOrder` and `decSetoid` have been moved from `Data.X` to `≤-decTotalOrder` and `≡-decSetoid` in `Data.X.Properties`. The numeric datatypes for which this has been done are `Nat`, `Integer`, `Rational` and `Bin`. As a consequence the module `≤-Reasoning` has also had to have been moved from `Data.Nat` to `Data.Nat.Properties`. #### New well-founded induction proofs for `Data.Nat` * Currently `Induction.Nat` only proves that the non-standard `_<′_`relation over `ℕ` is well-founded. Unfortunately these existing proofs are named `<-Rec` and `<-well-founded` which clash with the sensible names for new proofs over the standard `_<_` relation. Therefore `<-Rec` and `<-well-founded` have been renamed to `<′-Rec` and `<′-well-founded` respectively. The original names `<-Rec` and `<-well-founded` now refer to new corresponding proofs for `_<_`. #### Other * Changed the implementation of `map` and `zipWith` in `Data.Vec` to use native (pattern-matching) definitions. Previously they were defined using the `applicative` operations of `Vec`. The new definitions can be converted back to the old using the new proofs `⊛-is-zipWith`, `map-is-⊛` and `zipWith-is-⊛` in `Data.Vec.Properties`. It has been argued that `zipWith` is fundamental than `_⊛_` and this change allows better printing of goals involving `map` or `zipWith`. * Changed the implementation of `All₂` in `Data.Vec.All` to a native datatype. This improved improves pattern matching on terms and allows the new datatype to be more generic with respect to types and levels. * Changed the implementation of `downFrom` in `Data.List` to a native (pattern-matching) definition. Previously it was defined using a private internal module which made pattern matching difficult. * The arguments of `≤pred⇒≤` and `≤⇒pred≤` in `Data.Nat.Properties` are now implicit rather than explicit (was `∀ m n → m ≤ pred n → m ≤ n` and is now `∀ {m n} → m ≤ pred n → m ≤ n`). This makes it consistent with `<⇒≤pred` which already used implicit arguments, and shouldn't introduce any significant problems as both parameters can be inferred by Agda. * Moved `¬∀⟶∃¬` from `Relation.Nullary.Negation` to `Data.Fin.Dec`. Its old location was causing dependency cyles to form between `Data.Fin.Dec`, `Relation.Nullary.Negation` and `Data.Fin`. * Moved `fold`, `add` and `mul` from `Data.Nat` to new module `Data.Nat.GeneralisedArithmetic`. * Changed type of second parameter of `Relation.Binary.StrictPartialOrderReasoning._<⟨_⟩_` from `x < y ⊎ x ≈ y` to `x < y`. `_≈⟨_⟩_` is left unchanged to take a value with type `x ≈ y`. Old code may be fixed by prefixing the contents of `_<⟨_⟩_` with `inj₁`. Deprecated features ------------------- Deprecated features still exist and therefore existing code should still work but they may be removed in some future release of the library. * The module `Data.Nat.Properties.Simple` is now deprecated. All proofs have been moved to `Data.Nat.Properties` where they should be used directly. The `Simple` file still exists for backwards compatability reasons and re-exports the proofs from `Data.Nat.Properties` but will be removed in some future release. * The modules `Data.Integer.Addition.Properties` and `Data.Integer.Multiplication.Properties` are now deprecated. All proofs have been moved to `Data.Integer.Properties` where they should be used directly. The `Addition.Properties` and `Multiplication.Properties` files still exist for backwards compatability reasons and re-exports the proofs from `Data.Integer.Properties` but will be removed in some future release. * The following renaming has occured in `Data.Nat.Properties` ```agda _+-mono_ ↦ +-mono-≤ _*-mono_ ↦ *-mono-≤ +-right-identity ↦ +-identityʳ *-right-zero ↦ *-zeroʳ distribʳ-*-+ ↦ *-distribʳ-+ *-distrib-∸ʳ ↦ *-distribʳ-∸ cancel-+-left ↦ +-cancelˡ-≡ cancel-+-left-≤ ↦ +-cancelˡ-≤ cancel-*-right ↦ *-cancelʳ-≡ cancel-*-right-≤ ↦ *-cancelʳ-≤ strictTotalOrder ↦ <-strictTotalOrder isCommutativeSemiring ↦ *-+-isCommutativeSemiring commutativeSemiring ↦ *-+-commutativeSemiring isDistributiveLattice ↦ ⊓-⊔-isDistributiveLattice distributiveLattice ↦ ⊓-⊔-distributiveLattice ⊔-⊓-0-isSemiringWithoutOne ↦ ⊔-⊓-isSemiringWithoutOne ⊔-⊓-0-isCommutativeSemiringWithoutOne ↦ ⊔-⊓-isCommutativeSemiringWithoutOne ⊔-⊓-0-commutativeSemiringWithoutOne ↦ ⊔-⊓-commutativeSemiringWithoutOne ``` * The following renaming has occurred in `Data.Nat.Divisibility`: ```agda ∣-* ↦ n|m*n ∣-+ ↦ ∣m∣n⇒∣m+n ∣-∸ ↦ ∣m+n|m⇒|n ``` Backwards compatible changes ---------------------------- * Added support for GHC 8.0.2 and 8.2.1. * Removed the empty `Irrelevance` module * Added `Category.Functor.Morphism` and module `Category.Functor.Identity`. * `Data.Container` and `Data.Container.Indexed` now allow for different levels in the container and in the data it contains. * Made `Data.BoundedVec` polymorphic with respect to levels. * Access to `primForce` and `primForceLemma` has been provided via the new top-level module `Strict`. * New call-by-value application combinator `_$!_` in `Function`. * Added properties to `Algebra.FunctionProperties`: ```agda LeftCancellative _•_ = ∀ x {y z} → (x • y) ≈ (x • z) → y ≈ z RightCancellative _•_ = ∀ {x} y z → (y • x) ≈ (z • x) → y ≈ z Cancellative _•_ = LeftCancellative _•_ × RightCancellative _•_ ``` * Added new module `Algebra.FunctionProperties.Consequences` for basic causal relationships between properties, containing: ```agda comm+idˡ⇒idʳ : Commutative _•_ → LeftIdentity e _•_ → RightIdentity e _•_ comm+idʳ⇒idˡ : Commutative _•_ → RightIdentity e _•_ → LeftIdentity e _•_ comm+zeˡ⇒zeʳ : Commutative _•_ → LeftZero e _•_ → RightZero e _•_ comm+zeʳ⇒zeˡ : Commutative _•_ → RightZero e _•_ → LeftZero e _•_ comm+invˡ⇒invʳ : Commutative _•_ → LeftInverse e _⁻¹ _•_ → RightInverse e _⁻¹ _•_ comm+invʳ⇒invˡ : Commutative _•_ → RightInverse e _⁻¹ _•_ → LeftInverse e _⁻¹ _•_ comm+distrˡ⇒distrʳ : Commutative _•_ → _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ comm+distrʳ⇒distrˡ : Commutative _•_ → _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ comm+cancelˡ⇒cancelʳ : Commutative _•_ → LeftCancellative _•_ → RightCancellative _•_ comm+cancelˡ⇒cancelʳ : Commutative _•_ → LeftCancellative _•_ → RightCancellative _•_ sel⇒idem : Selective _•_ → Idempotent _•_ ``` * Added proofs to `Algebra.Properties.BooleanAlgebra`: ```agda ∨-complementˡ : LeftInverse ⊤ ¬_ _∨_ ∧-complementˡ : LeftInverse ⊥ ¬_ _∧_ ∧-identityʳ : RightIdentity ⊤ _∧_ ∧-identityˡ : LeftIdentity ⊤ _∧_ ∧-identity : Identity ⊤ _∧_ ∨-identityʳ : RightIdentity ⊥ _∨_ ∨-identityˡ : LeftIdentity ⊥ _∨_ ∨-identity : Identity ⊥ _∨_ ∧-zeroʳ : RightZero ⊥ _∧_ ∧-zeroˡ : LeftZero ⊥ _∧_ ∧-zero : Zero ⊥ _∧_ ∨-zeroʳ : RightZero ⊤ _∨_ ∨-zeroˡ : LeftZero ⊤ _∨_ ∨-zero : Zero ⊤ _∨_ ⊕-identityˡ : LeftIdentity ⊥ _⊕_ ⊕-identityʳ : RightIdentity ⊥ _⊕_ ⊕-identity : Identity ⊥ _⊕_ ⊕-inverseˡ : LeftInverse ⊥ id _⊕_ ⊕-inverseʳ : RightInverse ⊥ id _⊕_ ⊕-inverse : Inverse ⊥ id _⊕_ ⊕-cong : Congruent₂ _⊕_ ⊕-comm : Commutative _⊕_ ⊕-assoc : Associative _⊕_ ∧-distribˡ-⊕ : _∧_ DistributesOverˡ _⊕_ ∧-distribʳ-⊕ : _∧_ DistributesOverʳ _⊕_ ∧-distrib-⊕ : _∧_ DistributesOver _⊕_ ∨-isSemigroup : IsSemigroup _≈_ _∨_ ∧-isSemigroup : IsSemigroup _≈_ _∧_ ∨-⊥-isMonoid : IsMonoid _≈_ _∨_ ⊥ ∧-⊤-isMonoid : IsMonoid _≈_ _∧_ ⊤ ∨-⊥-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∨_ ⊥ ∧-⊤-isCommutativeMonoid : IsCommutativeMonoid _≈_ _∧_ ⊤ ⊕-isSemigroup : IsSemigroup _≈_ _⊕_ ⊕-⊥-isMonoid : IsMonoid _≈_ _⊕_ ⊥ ⊕-⊥-isGroup : IsGroup _≈_ _⊕_ ⊥ id ⊕-⊥-isAbelianGroup : IsAbelianGroup _≈_ _⊕_ ⊥ id ⊕-∧-isRing : IsRing _≈_ _⊕_ _∧_ id ⊥ ⊤ ``` * Added proofs to `Algebra.Properties.DistributiveLattice`: ```agda ∨-∧-distribˡ : _∨_ DistributesOverˡ _∧_ ∧-∨-distribˡ : _∧_ DistributesOverˡ _∨_ ∧-∨-distribʳ : _∧_ DistributesOverʳ _∨_ ``` * Added pattern synonyms to `Data.Bin` to improve readability: ```agda pattern 0b = zero pattern 1b = 1+ zero pattern ⊥b = 1+ 1+ () ``` * A new module `Data.Bin.Properties` has been added, containing proofs: ```agda 1#-injective : as 1# ≡ bs 1# → as ≡ bs _≟_ : Decidable {A = Bin} _≡_ ≡-isDecEquivalence : IsDecEquivalence _≡_ ≡-decSetoid : DecSetoid _ _ <-trans : Transitive _<_ <-asym : Asymmetric _<_ <-irrefl : Irreflexive _≡_ _<_ <-cmp : Trichotomous _≡_ _<_ <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ <⇒≢ : a < b → a ≢ b 1<[23] : [] 1# < (b ∷ []) 1# 1<2+ : [] 1# < (b ∷ bs) 1# 0<1+ : 0# < bs 1# ``` * Added functions to `Data.BoundedVec`: ```agda toInefficient : BoundedVec A n → Ineff.BoundedVec A n fromInefficient : Ineff.BoundedVec A n → BoundedVec A n ``` * Added the following to `Data.Digit`: ```agda Expansion : ℕ → Set Expansion base = List (Fin base) ``` * Added new module `Data.Empty.Irrelevant` containing an irrelevant version of `⊥-elim`. * Added functions to `Data.Fin`: ```agda punchIn i j ≈ if j≥i then j+1 else j punchOut i j ≈ if j>i then j-1 else j ``` * Added proofs to `Data.Fin.Properties`: ```agda isDecEquivalence : ∀ {n} → IsDecEquivalence (_≡_ {A = Fin n}) ≤-reflexive : ∀ {n} → _≡_ ⇒ (_≤_ {n}) ≤-refl : ∀ {n} → Reflexive (_≤_ {n}) ≤-trans : ∀ {n} → Transitive (_≤_ {n}) ≤-antisymmetric : ∀ {n} → Antisymmetric _≡_ (_≤_ {n}) ≤-total : ∀ {n} → Total (_≤_ {n}) ≤-isPreorder : ∀ {n} → IsPreorder _≡_ (_≤_ {n}) ≤-isPartialOrder : ∀ {n} → IsPartialOrder _≡_ (_≤_ {n}) ≤-isTotalOrder : ∀ {n} → IsTotalOrder _≡_ (_≤_ {n}) __ : Rel ℤ _ _≰_ : Rel ℤ _ _≱_ : Rel ℤ _ _≮_ : Rel ℤ _ _≯_ : Rel ℤ _ ``` * Added proofs to `Data.Integer.Properties` ```agda +-injective : + m ≡ + n → m ≡ n -[1+-injective : -[1+ m ] ≡ -[1+ n ] → m ≡ n doubleNeg : - - n ≡ n neg-injective : - m ≡ - n → m ≡ n ∣n∣≡0⇒n≡0 : ∣ n ∣ ≡ 0 → n ≡ + 0 ∣-n∣≡∣n∣ : ∣ - n ∣ ≡ ∣ n ∣ +◃n≡+n : Sign.+ ◃ n ≡ + n -◃n≡-n : Sign.- ◃ n ≡ - + n signₙ◃∣n∣≡n : sign n ◃ ∣ n ∣ ≡ n ∣s◃m∣*∣t◃n∣≡m*n : ∣ s ◃ m ∣ ℕ* ∣ t ◃ n ∣ ≡ m ℕ* n ⊖-≰ : n ≰ m → m ⊖ n ≡ - + (n ∸ m) ∣⊖∣-≰ : n ≰ m → ∣ m ⊖ n ∣ ≡ n ∸ m sign-⊖-≰ : n ≰ m → sign (m ⊖ n) ≡ Sign.- -[n⊖m]≡-m+n : - (m ⊖ n) ≡ (- (+ m)) + (+ n) +-identity : Identity (+ 0) _+_ +-inverse : Inverse (+ 0) -_ _+_ +-0-isMonoid : IsMonoid _≡_ _+_ (+ 0) +-0-isGroup : IsGroup _≡_ _+_ (+ 0) (-_) +-0-abelianGroup : AbelianGroup _ _ n≢1+n : n ≢ suc n 1-[1+n]≡-n : suc -[1+ n ] ≡ - (+ n) neg-distrib-+ : - (m + n) ≡ (- m) + (- n) ◃-distrib-+ : s ◃ (m + n) ≡ (s ◃ m) + (s ◃ n) *-identityʳ : RightIdentity (+ 1) _*_ *-identity : Identity (+ 1) _*_ *-zeroˡ : LeftZero (+ 0) _*_ *-zeroʳ : RightZero (+ 0) _*_ *-zero : Zero (+ 0) _*_ *-1-isMonoid : IsMonoid _≡_ _*_ (+ 1) -1*n≡-n : -[1+ 0 ] * n ≡ - n ◃-distrib-* : (s 𝕊* t) ◃ (m ℕ* n) ≡ (s ◃ m) * (t ◃ n) +-*-isRing : IsRing _≡_ _+_ _*_ -_ (+ 0) (+ 1) +-*-isCommutativeRing : IsCommutativeRing _≡_ _+_ _*_ -_ (+ 0) (+ 1) ≤-reflexive : _≡_ ⇒ _≤_ ≤-refl : Reflexive _≤_ ≤-trans : Transitive _≤_ ≤-antisym : Antisymmetric _≡_ _≤_ ≤-total : Total _≤_ ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isTotalOrder : IsTotalOrder _≡_ _≤_ ≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ ≤-step : n ≤ m → n ≤ suc m n≤1+n : n ≤ + 1 + n <-irrefl : Irreflexive _≡_ _<_ <-asym : Asymmetric _<_ <-trans : Transitive _<_ <-cmp : Trichotomous _≡_ _<_ <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ n≮n : n ≮ n -<+ : -[1+ m ] < + n <⇒≤ : m < n → m ≤ n ≰→> : x ≰ y → x > y ``` * Added functions to `Data.List` ```agda applyUpTo f n ≈ f[0] ∷ f[1] ∷ ... ∷ f[n-1] ∷ [] upTo n ≈ 0 ∷ 1 ∷ ... ∷ n-1 ∷ [] applyDownFrom f n ≈ f[n-1] ∷ f[n-2] ∷ ... ∷ f[0] ∷ [] tabulate f ≈ f[0] ∷ f[1] ∷ ... ∷ f[n-1] ∷ [] allFin n ≈ 0f ∷ 1f ∷ ... ∷ n-1f ∷ [] ``` * Added proofs to `Data.List.Properties` ```agda map-id₂ : All (λ x → f x ≡ x) xs → map f xs ≡ xs map-cong₂ : All (λ x → f x ≡ g x) xs → map f xs ≡ map g xs foldr-++ : foldr f x (ys ++ zs) ≡ foldr f (foldr f x zs) ys foldl-++ : foldl f x (ys ++ zs) ≡ foldl f (foldl f x ys) zs foldr-∷ʳ : foldr f x (ys ∷ʳ y) ≡ foldr f (f y x) ys foldl-∷ʳ : foldl f x (ys ∷ʳ y) ≡ f (foldl f x ys) y reverse-foldr : foldr f x (reverse ys) ≡ foldl (flip f) x ys reverse-foldr : foldl f x (reverse ys) ≡ foldr (flip f) x ys length-reverse : length (reverse xs) ≡ length xs ``` * Added proofs to `Data.List.All.Properties` ```agda All-universal : Universal P → All P xs ¬Any⇒All¬ : ¬ Any P xs → All (¬_ ∘ P) xs All¬⇒¬Any : All (¬_ ∘ P) xs → ¬ Any P xs ¬All⇒Any¬ : Decidable P → ¬ All P xs → Any (¬_ ∘ P) xs ++⁺ : All P xs → All P ys → All P (xs ++ ys) ++⁻ˡ : All P (xs ++ ys) → All P xs ++⁻ʳ : All P (xs ++ ys) → All P ys ++⁻ : All P (xs ++ ys) → All P xs × All P ys concat⁺ : All (All P) xss → All P (concat xss) concat⁻ : All P (concat xss) → All (All P) xss drop⁺ : All P xs → All P (drop n xs) take⁺ : All P xs → All P (take n xs) tabulate⁺ : (∀ i → P (f i)) → All P (tabulate f) tabulate⁻ : All P (tabulate f) → (∀ i → P (f i)) applyUpTo⁺₁ : (∀ {i} → i < n → P (f i)) → All P (applyUpTo f n) applyUpTo⁺₂ : (∀ i → P (f i)) → All P (applyUpTo f n) applyUpTo⁻ : All P (applyUpTo f n) → ∀ {i} → i < n → P (f i) ``` * Added proofs to `Data.List.Any.Properties` ```agda lose∘find : uncurry′ lose (proj₂ (find p)) ≡ p find∘lose : find (lose x∈xs pp) ≡ (x , x∈xs , pp) swap : Any (λ x → Any (P x) ys) xs → Any (λ y → Any (flip P y) xs) ys swap-invol : swap (swap any) ≡ any ∃∈-Any : (∃ λ x → x ∈ xs × P x) → Any P xs Any-⊎⁺ : Any P xs ⊎ Any Q xs → Any (λ x → P x ⊎ Q x) xs Any-⊎⁻ : Any (λ x → P x ⊎ Q x) xs → Any P xs ⊎ Any Q xs Any-×⁺ : Any P xs × Any Q ys → Any (λ x → Any (λ y → P x × Q y) ys) xs Any-×⁻ : Any (λ x → Any (λ y → P x × Q y) ys) xs → Any P xs × Any Q ys map⁺ : Any (P ∘ f) xs → Any P (map f xs) map⁻ : Any P (map f xs) → Any (P ∘ f) xs ++⁺ˡ : Any P xs → Any P (xs ++ ys) ++⁺ʳ : Any P ys → Any P (xs ++ ys) ++⁻ : Any P (xs ++ ys) → Any P xs ⊎ Any P ys concat⁺ : Any (Any P) xss → Any P (concat xss) concat⁻ : Any P (concat xss) → Any (Any P) xss applyUpTo⁺ : P (f i) → i < n → Any P (applyUpTo f n) applyUpTo⁻ : Any P (applyUpTo f n) → ∃ λ i → i < n × P (f i) tabulate⁺ : P (f i) → Any P (tabulate f) tabulate⁻ : Any P (tabulate f) → ∃ λ i → P (f i) map-with-∈⁺ : (∃₂ λ x (x∈xs : x ∈ xs) → P (f x∈xs)) → Any P (map-with-∈ xs f) map-with-∈⁻ : Any P (map-with-∈ xs f) → ∃₂ λ x (x∈xs : x ∈ xs) → P (f x∈xs) return⁺ : P x → Any P (return x) return⁻ : Any P (return x) → P x ``` * Added proofs to `Data.List.Any.Membership.Properties` ```agda ∈-map⁺ : x ∈ xs → f x ∈ map f xs ∈-map⁻ : y ∈ map f xs → ∃ λ x → x ∈ xs × y ≈ f x ``` * Added proofs to `Data.List.Any.Membership.Propositional.Properties` ```agda ∈-map⁺ : x ∈ xs → f x ∈ map f xs ∈-map⁻ : y ∈ map f xs → ∃ λ x → x ∈ xs × y ≈ f x ``` * Added proofs to `Data.Maybe`: ```agda Eq-refl : Reflexive _≈_ → Reflexive (Eq _≈_) Eq-sym : Symmetric _≈_ → Symmetric (Eq _≈_) Eq-trans : Transitive _≈_ → Transitive (Eq _≈_) Eq-dec : Decidable _≈_ → Decidable (Eq _≈_) Eq-isEquivalence : IsEquivalence _≈_ → IsEquivalence (Eq _≈_) Eq-isDecEquivalence : IsDecEquivalence _≈_ → IsDecEquivalence (Eq _≈_) ``` * Added exponentiation operator `_^_` to `Data.Nat.Base` * Added proofs to `Data.Nat.Properties`: ```agda suc-injective : suc m ≡ suc n → m ≡ n ≡-isDecEquivalence : IsDecEquivalence (_≡_ {A = ℕ}) ≡-decSetoid : DecSetoid _ _ ≤-reflexive : _≡_ ⇒ _≤_ ≤-refl : Reflexive _≤_ ≤-trans : Antisymmetric _≡_ _≤_ ≤-antisymmetric : Transitive _≤_ ≤-total : Total _≤_ ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isTotalOrder : IsTotalOrder _≡_ _≤_ ≤-isDecTotalOrder : IsDecTotalOrder _≡_ _≤_ __ = map} ``` * Added proofs to `Data.Vec.Equality` ```agda to-≅ : xs ≈ ys → xs ≅ ys xs++[]≈xs : xs ++ [] ≈ xs xs++[]≅xs : xs ++ [] ≅ xs ``` * Added proofs to `Data.Vec.Properties` ```agda lookup-map : lookup i (map f xs) ≡ f (lookup i xs) lookup-functor-morphism : Morphism functor IdentityFunctor map-replicate : map f (replicate x) ≡ replicate (f x) ⊛-is-zipWith : fs ⊛ xs ≡ zipWith _$_ fs xs map-is-⊛ : map f xs ≡ replicate f ⊛ xs zipWith-is-⊛ : zipWith f xs ys ≡ replicate f ⊛ xs ⊛ ys zipWith-replicate₁ : zipWith _⊕_ (replicate x) ys ≡ map (x ⊕_) ys zipWith-replicate₂ : zipWith _⊕_ xs (replicate y) ≡ map (_⊕ y) xs zipWith-map₁ : zipWith _⊕_ (map f xs) ys ≡ zipWith (λ x y → f x ⊕ y) xs ys zipWith-map₂ : zipWith _⊕_ xs (map f ys) ≡ zipWith (λ x y → x ⊕ f y) xs ys ``` * Added proofs to `Data.Vec.All.Properties` ```agda All-++⁺ : All P xs → All P ys → All P (xs ++ ys) All-++ˡ⁻ : All P (xs ++ ys) → All P xs All-++ʳ⁻ : All P (xs ++ ys) → All P ys All-++⁻ : All P (xs ++ ys) → All P xs × All P ys All₂-++⁺ : All₂ _~_ ws xs → All₂ _~_ ys zs → All₂ _~_ (ws ++ ys) (xs ++ zs) All₂-++ˡ⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ws xs All₂-++ʳ⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ys zs All₂-++⁻ : All₂ _~_ (ws ++ ys) (xs ++ zs) → All₂ _~_ ws xs × All₂ _~_ ys zs All-concat⁺ : All (All P) xss → All P (concat xss) All-concat⁻ : All P (concat xss) → All (All P) xss All₂-concat⁺ : All₂ (All₂ _~_) xss yss → All₂ _~_ (concat xss) (concat yss) All₂-concat⁻ : All₂ _~_ (concat xss) (concat yss) → All₂ (All₂ _~_) xss yss ``` * Added non-dependant versions of the application combinators in `Function` for use cases where the most general one leads to unsolved meta variables: ```agda _$′_ : (A → B) → (A → B) _$!′_ : (A → B) → (A → B) ``` * Added proofs to `Relation.Binary.Consequences` ```agda P-resp⟶¬P-resp : Symmetric _≈_ → P Respects _≈_ → (¬_ ∘ P) Respects _≈_ ``` * Added conversion lemmas to `Relation.Binary.HeterogeneousEquality` ```agda ≅-to-type-≡ : {x : A} {y : B} → x ≅ y → A ≡ B ≅-to-subst-≡ : (p : x ≅ y) → subst (λ x → x) (≅-to-type-≡ p) x ≡ y ``` agda-stdlib-1.7.3/CHANGELOG/v0.15.md000066400000000000000000000734561451211343400162740ustar00rootroot00000000000000Version 0.15 ============ The library has been tested using Agda version 2.5.3. Non-backwards compatible changes -------------------------------- #### Upgrade and overhaul of organisation of relations over data * Relations over data have been moved from the `Relation` subtree to the `Data` subtree. This increases the usability of the library by: 1. keeping all the definitions concerning a given datatype in the same directory 2. providing a location to reason about how operations on the data affect the relations (e.g. how `Pointwise` is affected by `map`) 3. increasing the discoverability of the relations. There is anecdotal evidence that many users were not aware of the existence of the relations in the old location. In general the files have been moved from `Relation.Binary.X` to `Data.X.Relation`. The full list of moves is as follows: ``` `Relation.Binary.List.Pointwise` ↦ `Data.List.Relation.Pointwise` `Relation.Binary.List.StrictLex` ↦ `Data.List.Relation.Lex.Strict` `Relation.Binary.List.NonStrictLex` ↦ `Data.List.Relation.Lex.NonStrict` `Relation.Binary.Sum` ↦ `Data.Sum.Relation.Pointwise` ↘ `Data.Sum.Relation.LeftOrder` `Relation.Binary.Sigma.Pointwise` ↦ `Data.Product.Relation.Pointwise.Dependent' `Relation.Binary.Product.Pointwise` ↦ `Data.Product.Relation.Pointwise.NonDependent` `Relation.Binary.Product.StrictLex` ↦ `Data.Product.Relation.Lex.Strict` `Relation.Binary.Product.NonStrictLex` ↦ `Data.Product.Relation.Lex.NonStrict` `Relation.Binary.Vec.Pointwise` ↦ `Data.Vec.Relation.Pointwise.Inductive` ↘ `Data.Vec.Relation.Pointwise.Extensional` ``` The old files in `Relation.Binary.X` still exist for backwards compatability reasons and re-export the contents of files' new location in `Data.X.Relation` but may be removed in some future release. * The contents of `Relation.Binary.Sum` has been split into two modules `Data.Sum.Relation.Pointwise` and `Data.Sum.Relation.LeftOrder` * The contents of `Relation.Binary.Vec.Pointwise` has been split into two modules `Data.Vec.Relation.Pointwise.Inductive` and `Data.Vec.Relation.Pointwise.Extensional`. The inductive form of `Pointwise` has been generalised so that technically it can apply to two vectors with different lengths (although in practice the lengths must turn out to be equal). This allows a much wider range of proofs such as the fact that `[]` is a right identity for `_++_` which previously did not type check using the old definition. In order to ensure compatability with the `--without-K` option, the universe level of `Inductive.Pointwise` has been increased from `ℓ` to `a ⊔ b ⊔ ℓ`. * `Data.Vec.Equality` has been almost entirely reworked into four separate modules inside `Data.Vec.Relation.Equality` (namely `Setoid`, `DecSetoid`, `Propositional` and `DecPropositional`). All four of them now use `Data.Vec.Relation.Pointwise.Inductive` as a base. The proofs from the submodule `UsingVecEquality` in `Data.Vec.Properties` have been moved to these four new modules. * The datatype `All₂` has been removed from `Data.Vec.All`, along with associated proofs as it duplicates existing functionality in `Data.Vec.Relation.Pointwise.Inductive`. Unfortunately it is not possible to maintain backwards compatability due to dependency cycles. * Added new modules `Data.List.Relation.Equality.(Setoid/DecSetoid/Propositional/DecPropositional)`. #### Upgrade of `Data.AVL` * `Data.AVL.Key` and `Data.AVL.Height` have been split out of `Data.AVL` therefore ensuring they are independent on the type of `Value` the tree contains. * `Indexed` has been put into its own core module `Data.AVL.Indexed`, following the example of `Category.Monad.Indexed` and `Data.Container.Indexed`. * These changes allow `map` to have a polymorphic type and so it is now possible to change the type of values contained in a tree when mapping over it. #### Upgrade of `Algebra.Morphism` * Previously `Algebra.Morphism` only provides an example of a `Ring` homomorphism which packs the homomorphism and the proofs that it behaves the right way. Instead we have adopted and `Algebra.Structures`-like approach with proof-only records parametrised by the homomorphism and the structures it acts on. This make it possible to define the proof requirement for e.g. a ring in terms of the proof requirements for its additive abelian group and multiplicative monoid. #### Upgrade of `filter` and `partition` in `Data.List` * The functions `filter` and `partition` in `Data.List.Base` now use decidable predicates instead of boolean-valued functions. The boolean versions discarded type information, and hence were difficult to use and prove properties about. The proofs have been updated and renamed accordingly. The old boolean versions still exist as `boolFilter` and `boolPartition` for backwards compatibility reasons, but are deprecated and may be removed in some future release. The old versions can be implemented via the new versions by passing the decidability proof `λ v → f v ≟ true` with `_≟_` from `Data.Bool`. #### Overhaul of categorical interpretations of List and Vec * New modules `Data.List.Categorical` and `Data.Vec.Categorical` have been added for the categorical interpretations of `List` and `Vec`. The following have been moved to `Data.List.Categorical`: - The module `Monad` from `Data.List.Properties` (renamed to `MonadProperties`) - The module `Applicative` from `Data.List.Properties` - `monad`, `monadZero`, `monadPlus` and monadic operators from `Data.List` The following has been moved to `Data.Vec.Categorical`: - `applicative` and `functor` from `Data.Vec` - `lookup-morphism` and `lookup-functor-morphism` from `Data.Vec.Properties` #### Other * Removed support for GHC 7.8.4. * Renamed `Data.Container.FreeMonad.do` and `Data.Container.Indexed.FreeMonad.do` to `inn` as Agda 2.5.4 now supports proper 'do' notation. * Changed the fixity of `⋃` and `⋂` in `Relation.Unary` to make space for `_⊢_`. * Changed `_|_` from `Data.Nat.Divisibility` from data to a record. Consequently, the two parameters are no longer implicit arguments of the constructor (but such values can be destructed using a let-binding rather than a with-clause). * Names in `Data.Nat.Divisibility` now use the `divides` symbol (typed \\|) consistently. Previously a mixture of \\| and | was used. * Moved the proof `eq?` from `Data.Nat` to `Data.Nat.Properties` * The proofs that were called `+-monoˡ-<` and `+-monoʳ-<` in `Data.Nat.Properties` have been renamed `+-mono-<-≤` and `+-mono-≤-<` respectively. The original names are now used for proofs of left and right monotonicity of `_+_`. * Moved the proof `monoid` from `Data.List` to `++-monoid` in `Data.List.Properties`. * Names in Data.Nat.Divisibility now use the `divides` symbol (typed \\|) consistently. Previously a mixture of \\| and | was used. * Starting from Agda 2.5.4 the GHC backend compiles `Coinduction.∞` in a different way, and for this reason the GHC backend pragmas for `Data.Colist.Colist` and `Data.Stream.Stream` have been modified. Deprecated features ------------------- The following renaming has occurred as part of a drive to improve consistency across the library. The old names still exist and therefore all existing code should still work, however they have been deprecated and use of the new names is encouraged. Although not anticipated any time soon, they may eventually be removed in some future release of the library. * In `Data.Bool.Properties`: ```agda ∧-∨-distˡ ↦ ∧-distribˡ-∨ ∧-∨-distʳ ↦ ∧-distribʳ-∨ distrib-∧-∨ ↦ ∧-distrib-∨ ∨-∧-distˡ ↦ ∨-distribˡ-∧ ∨-∧-distʳ ↦ ∨-distribʳ-∧ ∨-∧-distrib ↦ ∨-distrib-∧ ∨-∧-abs ↦ ∨-abs-∧ ∧-∨-abs ↦ ∧-abs-∨ not-∧-inverseˡ ↦ ∧-inverseˡ not-∧-inverseʳ ↦ ∧-inverseʳ not-∧-inverse ↦ ∧-inverse not-∨-inverseˡ ↦ ∨-inverseˡ not-∨-inverseʳ ↦ ∨-inverseʳ not-∨-inverse ↦ ∨-inverse isCommutativeSemiring-∨-∧ ↦ ∨-∧-isCommutativeSemiring commutativeSemiring-∨-∧ ↦ ∨-∧-commutativeSemiring isCommutativeSemiring-∧-∨ ↦ ∧-∨-isCommutativeSemiring commutativeSemiring-∧-∨ ↦ ∧-∨-commutativeSemiring isBooleanAlgebra ↦ ∨-∧-isBooleanAlgebra booleanAlgebra ↦ ∨-∧-booleanAlgebra commutativeRing-xor-∧ ↦ xor-∧-commutativeRing proof-irrelevance ↦ T-irrelevance ``` * In `Data.Fin.Properties`: ```agda cmp ↦ <-cmp strictTotalOrder ↦ <-strictTotalOrder ``` * In `Data.Integer.Properties`: ```agda inverseˡ ↦ +-inverseˡ inverseʳ ↦ +-inverseʳ distribʳ ↦ *-distribʳ-+ isCommutativeSemiring ↦ +-*-isCommutativeSemiring commutativeRing ↦ +-*-commutativeRing *-+-right-mono ↦ *-monoʳ-≤-pos cancel-*-+-right-≤ ↦ *-cancelʳ-≤-pos cancel-*-right ↦ *-cancelʳ-≡ doubleNeg ↦ neg-involutive -‿involutive ↦ neg-involutive +-⊖-left-cancel ↦ +-cancelˡ-⊖ ``` * In `Data.List.Base`: ```agda gfilter ↦ mapMaybe ``` * In `Data.List.Properties`: ```agda right-identity-unique ↦ ++-identityʳ-unique left-identity-unique ↦ ++-identityˡ-unique ``` * In `Data.List.Relation.Pointwise`: ```agda Rel ↦ Pointwise Rel≡⇒≡ ↦ Pointwise-≡⇒≡ ≡⇒Rel≡ ↦ ≡⇒Pointwise-≡ Rel↔≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Nat.Properties`: ```agda ¬i+1+j≤i ↦ i+1+j≰i ≤-steps ↦ ≤-stepsˡ ``` * In all modules in the `Data.(Product/Sum).Relation` folders, all proofs with names using infix notation have been deprecated in favour of identical non-infix names, e.g. ``` _×-isPreorder_ ↦ ×-isPreorder ``` * In `Data.Product.Relation.Lex.(Non)Strict`: ```agda ×-≈-respects₂ ↦ ×-respects₂ ``` * In `Data.Product.Relation.Pointwise.Dependent`: ```agda Rel ↦ Pointwise Rel↔≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Product.Relation.Pointwise.NonDependent`: ```agda _×-Rel_ ↦ Pointwise Rel↔≡ ↦ Pointwise-≡↔≡ _×-≈-respects₂_ ↦ ×-respects₂ ``` * In `Data.Sign.Properties`: ```agda opposite-not-equal ↦ s≢opposite[s] opposite-cong ↦ opposite-injective cancel-*-left ↦ *-cancelˡ-≡ cancel-*-right ↦ *-cancelʳ-≡ *-cancellative ↦ *-cancel-≡ ``` * In `Data.Vec.Properties`: ```agda proof-irrelevance-[]= ↦ []=-irrelevance ``` * In `Data.Vec.Relation.Pointwise.Inductive`: ```agda Pointwise-≡ ↦ Pointwise-≡↔≡ ``` * In `Data.Vec.Relation.Pointwise.Extensional`: ```agda Pointwise-≡ ↦ Pointwise-≡↔≡ ``` * In `Induction.Nat`: ```agda rec-builder ↦ recBuilder cRec-builder ↦ cRecBuilder <′-rec-builder ↦ <′-recBuilder <-rec-builder ↦ <-recBuilder ≺-rec-builder ↦ ≺-recBuilder <′-well-founded ↦ <′-wellFounded <′-well-founded′ ↦ <′-wellFounded′ <-well-founded ↦ <-wellFounded ≺-well-founded ↦ ≺-wellFounded ``` * In `Induction.WellFounded`: ```agda Well-founded ↦ WellFounded Some.wfRec-builder ↦ Some.wfRecBuilder All.wfRec-builder ↦ All.wfRecBuilder Subrelation.well-founded ↦ Subrelation.wellFounded InverseImage.well-founded ↦ InverseImage.wellFounded TransitiveClosure.downwards-closed ↦ TransitiveClosure.downwardsClosed TransitiveClosure.well-founded ↦ TransitiveClosure.wellFounded Lexicographic.well-founded ↦ Lexicographic.wellFounded ``` * In `Relation.Binary.PropositionalEquality`: ```agda proof-irrelevance ↦ ≡-irrelevance ``` Removed features ---------------- #### Deprecated in version 0.10 * Modules `Deprecated-inspect` and `Deprecated-inspect-on-steroids` in `Relation.Binary.PropositionalEquality`. * Module `Deprecated-inspect-on-steroids` in `Relation.Binary.HeterogeneousEquality`. Backwards compatible changes ---------------------------- * Added support for GHC 8.2.2. * New module `Data.Word` for new builtin type `Agda.Builtin.Word.Word64`. * New modules `Data.Table`, `Data.Table.Base`, `Data.Table.Relation.Equality` and `Data.Table.Properties`. A `Table` is a fixed-length collection of objects similar to a `Vec` from `Data.Vec`, but implemented as a function `Fin n → A`. This prioritises ease of lookup as opposed to `Vec` which prioritises the ease of adding and removing elements. * The contents of the following modules are now more polymorphic with respect to levels: ```agda Data.Covec Data.List.Relation.Lex.Strict Data.List.Relation.Lex.NonStrict Data.Vec.Properties Data.Vec.Relation.Pointwise.Inductive Data.Vec.Relation.Pointwise.Extensional ``` * Added new proof to `asymmetric : Asymmetric _<_` to the `IsStrictPartialOrder` record. * Added new proofs to `Data.AVL`: ```agda leaf-injective : leaf p ≡ leaf q → p ≡ q node-injective-key : node k₁ lk₁ ku₁ bal₁ ≡ node k₂ lk₂ ku₂ bal₂ → k₁ ≡ k₂ node-injectiveˡ : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → lk₁ ≡ lk₂ node-injectiveʳ : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → ku₁ ≡ ku₂ node-injective-bal : node k lk₁ ku₁ bal₁ ≡ node k lk₂ ku₂ bal₂ → bal₁ ≡ bal₂ ``` * Added new proofs to `Data.Bin`: ```agda less-injective : (b₁ < b₂ ∋ less lt₁) ≡ less lt₂ → lt₁ ≡ lt₂ ``` * Added new proofs to `Data.Bool.Properties`: ```agda ∨-identityˡ : LeftIdentity false _∨_ ∨-identityʳ : RightIdentity false _∨_ ∨-identity : Identity false _∨_ ∨-zeroˡ : LeftZero true _∨_ ∨-zeroʳ : RightZero true _∨_ ∨-zero : Zero true _∨_ ∨-idem : Idempotent _∨_ ∨-sel : Selective _∨_ ∨-isSemigroup : IsSemigroup _≡_ _∨_ ∨-isCommutativeMonoid : IsCommutativeMonoid _≡_ _∨_ false ∧-identityˡ : LeftIdentity true _∧_ ∧-identityʳ : RightIdentity true _∧_ ∧-identity : Identity true _∧_ ∧-zeroˡ : LeftZero false _∧_ ∧-zeroʳ : RightZero false _∧_ ∧-zero : Zero false _∧_ ∧-idem : Idempotent _∧_ ∧-sel : Selective _∧_ ∧-isSemigroup : IsSemigroup _≡_ _∧_ ∧-isCommutativeMonoid : IsCommutativeMonoid _≡_ _∧_ true ∨-∧-isLattice : IsLattice _≡_ _∨_ _∧_ ∨-∧-isDistributiveLattice : IsDistributiveLattice _≡_ _∨_ _∧_ ``` * Added missing bindings to functions on `Data.Char.Base`: ```agda isLower : Char → Bool isDigit : Char → Bool isAlpha : Char → Bool isSpace : Char → Bool isAscii : Char → Bool isLatin1 : Char → Bool isPrint : Char → Bool isHexDigit : Char → Bool toNat : Char → ℕ fromNat : ℕ → Char ``` * Added new proofs to `Data.Cofin`: ```agda suc-injective : (Cofin (suc m) ∋ suc p) ≡ suc q → p ≡ q ``` * Added new proofs to `Data.Colist`: ```agda ∷-injectiveˡ : (Colist A ∋ x ∷ xs) ≡ y ∷ ys → x ≡ y ∷-injectiveʳ : (Colist A ∋ x ∷ xs) ≡ y ∷ ys → xs ≡ ys here-injective : (Any P (x ∷ xs) ∋ here p) ≡ here q → p ≡ q there-injective : (Any P (x ∷ xs) ∋ there p) ≡ there q → p ≡ q ∷-injectiveˡ : (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → px ≡ qx ∷-injectiveʳ : (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → pxs ≡ qxs ∷-injective : (Finite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective : (Infinite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ``` * Added new operations and proofs to `Data.Conat`: ```agda pred : Coℕ → Coℕ suc-injective : (Coℕ ∋ suc m) ≡ suc n → m ≡ n fromℕ-injective : fromℕ m ≡ fromℕ n → m ≡ n suc-injective : (suc m ≈ suc n ∋ suc p) ≡ suc q → p ≡ q ``` * Added new proofs to `Data.Covec`: ```agda ∷-injectiveˡ : (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → a ≡ b ∷-injectiveʳ : (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → as ≡ bs ``` * Added new proofs to `Data.Fin.Properties`: ```agda ≤-isDecTotalOrder : ∀ {n} → IsDecTotalOrder _≡_ (_≤_ {n}) ≤-irrelevance : ∀ {n} → IrrelevantRel (_≤_ {n}) <-asym : ∀ {n} → Asymmetric (_<_ {n}) <-irrefl : ∀ {n} → Irreflexive _≡_ (_<_ {n}) <-irrelevance : ∀ {n} → IrrelevantRel (_<_ {n}) ``` * Added new proofs to `Data.Integer.Properties`: ```agda +-cancelˡ-⊖ : (a + b) ⊖ (a + c) ≡ b ⊖ c neg-minus-pos : -[1+ m ] - (+ n) ≡ -[1+ (m + n) ] [+m]-[+n]≡m⊖n : (+ m) - (+ n) ≡ m ⊖ n ∣m-n∣≡∣n-m∣ : ∣ m - n ∣ ≡ ∣ n - m ∣ +-minus-telescope : (m - n) + (n - o) ≡ m - o pos-distrib-* : ∀ x y → (+ x) * (+ y) ≡ + (x * y) ≤-irrelevance : IrrelevantRel _≤_ <-irrelevance : IrrelevantRel _<_ ``` * Added new combinators to `Data.List.Base`: ```agda lookup : (xs : List A) → Fin (length xs) → A unzipWith : (A → B × C) → List A → List B × List C unzip : List (A × B) → List A × List B ``` * Added new proofs to `Data.List.Properties`: ```agda ∷-injectiveˡ : x ∷ xs ≡ y List.∷ ys → x ≡ y ∷-injectiveʳ : x ∷ xs ≡ y List.∷ ys → xs ≡ ys ∷ʳ-injectiveˡ : xs ∷ʳ x ≡ ys ∷ʳ y → xs ≡ ys ∷ʳ-injectiveʳ : xs ∷ʳ x ≡ ys ∷ʳ y → x ≡ y ++-assoc : Associative {A = List A} _≡_ _++_ ++-identityˡ : LeftIdentity _≡_ [] _++_ ++-identityʳ : RightIdentity _≡_ [] _++_ ++-identity : Identity _≡_ [] _++_ ++-isSemigroup : IsSemigroup {A = List A} _≡_ _++_ ++-isMonoid : IsMonoid {A = List A} _≡_ _++_ [] ++-semigroup : ∀ {a} (A : Set a) → Semigroup _ _ ++-monoid : ∀ {a} (A : Set a) → Monoid _ _ filter-none : All P xs → dfilter P? xs ≡ xs filter-some : Any (∁ P) xs → length (filter P? xs) < length xs filter-notAll : Any P xs → 0 < length (filter P? xs) filter-all : All (∁ P) xs → dfilter P? xs ≡ [] filter-complete : length (filter P? xs) ≡ length xs → filter P? xs ≡ xs tabulate-cong : f ≗ g → tabulate f ≡ tabulate g tabulate-lookup : tabulate (lookup xs) ≡ xs zipWith-identityˡ : ∀ xs → zipWith f [] xs ≡ [] zipWith-identityʳ : ∀ xs → zipWith f xs [] ≡ [] zipWith-comm : (∀ x y → f x y ≡ f y x) → zipWith f xs ys ≡ zipWith f ys xs zipWith-unzipWith : uncurry′ g ∘ f ≗ id → uncurry′ (zipWith g) ∘ (unzipWith f) ≗ id zipWith-map : zipWith f (map g xs) (map h ys) ≡ zipWith (λ x y → f (g x) (h y)) xs ys map-zipWith : map g (zipWith f xs ys) ≡ zipWith (λ x y → g (f x y)) xs ys length-zipWith : length (zipWith f xs ys) ≡ length xs ⊓ length ys length-unzipWith₁ : length (proj₁ (unzipWith f xys)) ≡ length xys length-unzipWith₂ : length (proj₂ (unzipWith f xys)) ≡ length xys ``` * Added new proofs to `Data.List.All.Properties`: ```agda All-irrelevance : IrrelevantPred P → IrrelevantPred (All P) filter⁺₁ : All P (filter P? xs) filter⁺₂ : All Q xs → All Q (filter P? xs) mapMaybe⁺ : All (Maybe.All P) (map f xs) → All P (mapMaybe f xs) zipWith⁺ : Pointwise (λ x y → P (f x y)) xs ys → All P (zipWith f xs ys) ``` * Added new proofs to `Data.List.Any.Properties`: ```agda mapMaybe⁺ : Any (Maybe.Any P) (map f xs) → Any P (mapMaybe f xs) ``` * Added new proofs to `Data.List.Relation.Lex.NonStrict`: ```agda <-antisymmetric : Symmetric _≈_ → Antisymmetric _≈_ _≼_ → Antisymmetric _≋_ _<_ <-transitive : IsPartialOrder _≈_ _≼_ → Transitive _<_ <-resp₂ : IsEquivalence _≈_ → _≼_ Respects₂ _≈_ → _<_ Respects₂ _≋_ ≤-antisymmetric : Symmetric _≈_ → Antisymmetric _≈_ _≼_ → Antisymmetric _≋_ _≤_ ≤-transitive : IsPartialOrder _≈_ _≼_ → Transitive _≤_ ≤-resp₂ : IsEquivalence _≈_ → _≼_ Respects₂ _≈_ → _≤_ Respects₂ _≋_ ``` * Added new proofs to `Data.List.Relation.Pointwise`: ```agda tabulate⁺ : (∀ i → f i ∼ g i) → Pointwise _∼_ (tabulate f) (tabulate g) tabulate⁻ : Pointwise _∼_ (tabulate f) (tabulate g) → (∀ i → f i ∼ g i) ++⁺ : Pointwise _∼_ ws xs → Pointwise _∼_ ys zs → Pointwise _∼_ (ws ++ ys) (xs ++ zs) concat⁺ : Pointwise (Pointwise _∼_) xss yss → Pointwise _∼_ (concat xss) (concat yss) ``` * Added new proofs to `Data.List.Relation.Lex.Strict`: ```agda <-antisymmetric : Symmetric _≈_ → Irreflexive _≈_ _≺_ → Asymmetric _≺_ → Antisymmetric _≋_ _<_ <-transitive : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → Transitive _≺_ → Transitive _<_ <-respects₂ : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → _<_ Respects₂ _≋_ ≤-antisymmetric : Symmetric _≈_ → Irreflexive _≈_ _≺_ → Asymmetric _≺_ → Antisymmetric _≋_ _≤_ ≤-transitive : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → Transitive _≺_ → Transitive _≤_ ≤-respects₂ : IsEquivalence _≈_ → _≺_ Respects₂ _≈_ → _≤_ Respects₂ _≋_ ``` * Added new proofs to `Data.Maybe.Base`: ```agda just-injective : (Maybe A ∋ just a) ≡ just b → a ≡ b ``` * Added new proofs to `Data.Nat.Divisibility`: ```agda m|m*n : m ∣ m * n ∣m⇒∣m*n : i ∣ m → i ∣ m * n ∣n⇒∣m*n : i ∣ n → i ∣ m * n ``` * Added new proofs to `Data.Nat.Properties`: ```agda ≤⇒≯ : _≤_ ⇒ _≯_ n≮n : ∀ n → n ≮ n ≤-stepsʳ : ∀ m ≤ n → m ≤ n + o ≤-irrelevance : IrrelevantRel _≤_ <-irrelevance : IrrelevantRel _<_ +-monoˡ-≤ : ∀ n → (_+ n) Preserves _≤_ ⟶ _≤_ +-monoʳ-≤ : ∀ n → (n +_) Preserves _≤_ ⟶ _≤_ +-monoˡ-< : ∀ n → (_+ n) Preserves _<_ ⟶ _<_ +-monoʳ-< : ∀ n → (n +_) Preserves _<_ ⟶ _<_ +-semigroup : Semigroup _ _ +-0-monoid : Monoid _ _ +-0-commutativeMonoid : CommutativeMonoid _ _ *-monoˡ-≤ : ∀ n → (_* n) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤ : ∀ n → (n *_) Preserves _≤_ ⟶ _≤_ *-semigroup : Semigroup _ _ *-1-monoid : Monoid _ _ *-1-commutativeMonoid : CommutativeMonoid _ _ *-+-semiring : Semiring _ _ ^-identityʳ : RightIdentity 1 _^_ ^-zeroˡ : LeftZero 1 _^_ ^-semigroup-morphism : (x ^_) Is +-semigroup -Semigroup⟶ *-semigroup ^-monoid-morphism : (x ^_) Is +-0-monoid -Monoid⟶ *-1-monoid m≤n⇒m⊓n≡m : m ≤ n → m ⊓ n ≡ m m≤n⇒n⊓m≡m : m ≤ n → n ⊓ m ≡ m m≤n⇒n⊔m≡n : m ≤ n → n ⊔ m ≡ n m≤n⇒m⊔n≡n : m ≤ n → m ⊔ n ≡ n ⊔-monoˡ-≤ : ∀ n → (_⊔ n) Preserves _≤_ ⟶ _≤_ ⊔-monoʳ-≤ : ∀ n → (n ⊔_) Preserves _≤_ ⟶ _≤_ ⊓-monoˡ-≤ : ∀ n → (_⊓ n) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ : ∀ n → (n ⊓_) Preserves _≤_ ⟶ _≤_ m∸n+n≡m : n ≤ m → (m ∸ n) + n ≡ m m∸[m∸n]≡n : n ≤ m → m ∸ (m ∸ n) ≡ n s≤s-injective : s≤s p ≡ s≤s q → p ≡ q ≤′-step-injective : ≤′-step p ≡ ≤′-step q → p ≡ q ``` * Added new proofs to `Data.Plus`: ```agda []-injective : (x [ _∼_ ]⁺ y ∋ [ p ]) ≡ [ q ] → p ≡ q ∼⁺⟨⟩-injectiveˡ : (x [ _∼_ ]⁺ z ∋ x ∼⁺⟨ p ⟩ q) ≡ (x ∼⁺⟨ r ⟩ s) → p ≡ r ∼⁺⟨⟩-injectiveʳ : (x [ _∼_ ]⁺ z ∋ x ∼⁺⟨ p ⟩ q) ≡ (x ∼⁺⟨ r ⟩ s) → q ≡ s ``` * Added new combinator to `Data.Product`: ```agda curry′ : (A × B → C) → (A → B → C) ``` * Added new proofs to `Data.Product.Properties`: ```agda ,-injectiveˡ : (a , b) ≡ (c , d) → a ≡ c ,-injectiveʳ : (Σ A B ∋ (a , b)) ≡ (a , c) → b ≡ c ``` * Added new operator in `Data.Product.Relation.Pointwise.NonDependent`: ```agda _×ₛ_ : Setoid ℓ₁ ℓ₂ → Setoid ℓ₃ ℓ₄ → Setoid _ _ ``` * Added new proofs to `Data.Rational.Properties`: ```agda ≤-irrelevance : IrrelevantRel _≤_ ``` * Added new proofs to `Data.ReflexiveClosure`: ```agda []-injective : (Refl _∼_ x y ∋ [ p ]) ≡ [ q ] → p ≡ q ``` * Added new proofs to `Data.Sign`: ```agda *-isSemigroup : IsSemigroup _≡_ _*_ *-semigroup : Semigroup _ _ *-isMonoid : IsMonoid _≡_ _*_ + *-monoid : Monoid _ _ ``` * Added new proofs to `Data.Star.Properties`: ```agda ◅-injectiveˡ : (Star T i k ∋ x ◅ xs) ≡ y ◅ ys → x ≡ y ◅-injectiveʳ : (Star T i k ∋ x ◅ xs) ≡ y ◅ ys → xs ≡ ys ``` * Added new proofs to `Data.Sum.Properties`: ```agda inj₁-injective : (A ⊎ B ∋ inj₁ x) ≡ inj₁ y → x ≡ y inj₂-injective : (A ⊎ B ∋ inj₂ x) ≡ inj₂ y → x ≡ y ``` * Added new operator in `Data.Sum.Relation.Pointwise`: ```agda _⊎ₛ_ : Setoid ℓ₁ ℓ₂ → Setoid ℓ₃ ℓ₄ → Setoid _ _ ``` * Added new proofs to `Data.Vec.Properties`: ```agda ∷-injectiveˡ : x ∷ xs ≡ y ∷ ys → x ≡ y ∷-injectiveʳ : x ∷ xs ≡ y ∷ ys → xs ≡ ys []=⇒lookup : xs [ i ]= x → lookup i xs ≡ x lookup⇒[]= : lookup i xs ≡ x → xs [ i ]= x lookup-replicate : lookup i (replicate x) ≡ x lookup-⊛ : lookup i (fs ⊛ xs) ≡ (lookup i fs $ lookup i xs) tabulate-cong : f ≗ g → tabulate f ≡ tabulate g ``` * Added new proofs to `Data.Vec.All.Properties` ```agda All-irrelevance : IrrelevantPred P → ∀ {n} → IrrelevantPred (All P {n}) ``` * Added new proofs to `Data.Vec.Relation.Pointwise.Extensional`: ```agda isDecEquivalence : IsDecEquivalence _~_ → IsDecEquivalence (Pointwise _~_) extensional⇒inductive : Pointwise _~_ xs ys → IPointwise _~_ xs ys inductive⇒extensional : IPointwise _~_ xs ys → Pointwise _~_ xs ys ≡⇒Pointwise-≡ : Pointwise _≡_ xs ys → xs ≡ ys Pointwise-≡⇒≡ : xs ≡ ys → Pointwise _≡_ xs ys ``` * Added new proofs to `Data.Vec.Relation.Pointwise.Inductive`: ```agda ++⁺ : Pointwise P xs → Pointwise P ys → Pointwise P (xs ++ ys) ++⁻ˡ : Pointwise P (xs ++ ys) → Pointwise P xs ++⁻ʳ : Pointwise P (xs ++ ys) → Pointwise P ys ++⁻ : Pointwise P (xs ++ ys) → Pointwise P xs × Pointwise P ys concat⁺ : Pointwise (Pointwise P) xss → Pointwise P (concat xss) concat⁻ : Pointwise P (concat xss) → Pointwise (Pointwise P) xss lookup : Pointwise _~_ xs ys → ∀ i → lookup i xs ~ lookup i ys isDecEquivalence : IsDecEquivalence _~_ → IsDecEquivalence (Pointwise _~_) ≡⇒Pointwise-≡ : Pointwise _≡_ xs ys → xs ≡ ys Pointwise-≡⇒≡ : xs ≡ ys → Pointwise _≡_ xs ys Pointwiseˡ⇒All : Pointwise (λ x y → P x) xs ys → All P xs Pointwiseʳ⇒All : Pointwise (λ x y → P y) xs ys → All P ys All⇒Pointwiseˡ : All P xs → Pointwise (λ x y → P x) xs ys All⇒Pointwiseʳ : All P ys → Pointwise (λ x y → P y) xs ys ``` * Added new functions and proofs to `Data.W`: ```agda map : (f : A → C) → ∀[ D ∘ f ⇒ B ] → W A B → W C D induction : (∀ a {f} (hf : ∀ (b : B a) → P (f b)) → (w : W A B) → P w foldr : (∀ a → (B a → P) → P) → W A B → P sup-injective₁ : sup x f ≡ sup y g → x ≡ y sup-injective₂ : sup x f ≡ sup x g → f ≡ g ``` * Added new properties to `Relation.Binary.PropositionalEquality` ```agda isPropositional A = (a b : A) → a ≡ b IrrelevantPred P = ∀ {x} → isPropositional (P x) IrrelevantRel _~_ = ∀ {x y} → isPropositional (x ~ y) ``` * Added new combinator to ` Relation.Binary.PropositionalEquality.TrustMe`: ```agda postulate[_↦_] : (t : A) → B t → (x : A) → B x ``` * Added new proofs to `Relation.Binary.StrictToNonStrict`: ```agda isPreorder₁ : IsPreorder _≈_ _<_ → IsPreorder _≈_ _≤_ isPreorder₂ : IsStrictPartialOrder _≈_ _<_ → IsPreorder _≈_ _≤_ isPartialOrder : IsStrictPartialOrder _≈_ _<_ → IsPartialOrder _≈_ _≤_ isTotalOrder : IsStrictTotalOrder _≈_ _<_ → IsTotalOrder _≈_ _≤_ isDecTotalOrder : IsStrictTotalOrder _≈_ _<_ → IsDecTotalOrder _≈_ _≤_ ``` * Added new syntax, relations and proofs to `Relation.Unary`: ```agda syntax Universal P = ∀[ P ] P ⊈ Q = ¬ (P ⊆ Q) P ⊉ Q = ¬ (P ⊇ Q) P ⊂ Q = P ⊆ Q × Q ⊈ P P ⊃ Q = Q ⊂ P P ⊄ Q = ¬ (P ⊂ Q) P ⊅ Q = ¬ (P ⊃ Q) P ⊈′ Q = ¬ (P ⊆′ Q) P ⊉′ Q = ¬ (P ⊇′ Q) P ⊂′ Q = P ⊆′ Q × Q ⊈′ P P ⊃′ Q = Q ⊂′ P P ⊄′ Q = ¬ (P ⊂′ Q) P ⊅′ Q = ¬ (P ⊃′ Q) f ⊢ P = λ x → P (f x) ∁? : Decidable P → Decidable (∁ P) ``` * Added `recompute` to `Relation.Nullary`: ```agda recompute : ∀ {a} {A : Set a} → Dec A → .A → A ``` agda-stdlib-1.7.3/CHANGELOG/v0.16.md000066400000000000000000000643351451211343400162710ustar00rootroot00000000000000Version 0.16 ============ The library has been tested using Agda version 2.5.4. Important changes since 0.15: Non-backwards compatible changes -------------------------------- #### Final overhaul of list membership * The aim of this final rearrangement of list membership is to create a better interface for the different varieties of membership, and make it easier to predict where certain proofs are found. Each of the new membership modules are parameterised by the relevant types so as to allow easy access to the infix `_∈_` and `_∈?_` operators. It also increases the discoverability of the modules by new users of the library. * The following re-organisation of list membership modules has occurred: ```agda Data.List.Any.BagAndSetEquality ↦ Data.List.Relation.BagAndSetEquality Data.List.Any.Membership ↦ Data.List.Membership.Setoid ↘ Data.List.Membership.DecSetoid ↘ Data.List.Relation.Sublist.Setoid Data.List.Any.Membership.Propositional ↦ Data.List.Membership.Propositional ↘ Data.List.Membership.DecPropositional ↘ Data.List.Relation.Sublist.Propositional ``` * The `_⊆_` relation has been moved out of the `Membership` modules to new modules `Data.List.Relation.Sublist.(Setoid/Propositional)`. Consequently the `mono` proofs that were in `Data.List.Membership.Propositional.Properties` have been moved to `Data.List.Relation.Sublist.Propositional.Properties`. * The following proofs have been moved from `Data.List.Any.Properties` to `Data.List.Membership.Propositional.Properties.Core`: ```agda map∘find, find∘map, find-∈, lose∘find, find∘lose, ∃∈-Any, Any↔ ``` * The following types and terms have been moved from `Data.List.Membership.Propositional` into `Relation.BagAndSetEquality`: ```agda Kind, Symmetric-kind set, subset, superset, bag, subbag, superbag [_]-Order, [_]-Equality, _∼[_]_ ``` * The type of the proof of `∈-resp-≈` in `Data.List.Membership.Setoid.Properties` has changed from `∀ {x} → (x ≈_) Respects _≈_` to `∀ {xs} → (_∈ xs) Respects _≈_`. #### Upgrade of `Algebra.Operations` * Previously `Algebra.Operations` was parameterised by a semiring, however several of the operators it defined depended only on the additive component. Therefore the modules have been rearranged to allow more fine-grained use depending on the current position in the algebra heirarchy. Currently there exist two modules: ``` Algebra.Operations.CommutativeMonoid Algebra.Operations.Semiring ``` where `Algebra.Operations.Semiring` exports all the definitions previously exported by `Algebra.Operations`. More modules may be added in future as required. Also the fixity of `_×_`, `_×′_` and `_^_` have all been increased by 1. #### Upgrade of `takeWhile`, `dropWhile`, `span` and `break` in `Data.List` * These functions in `Data.List.Base` now use decidable predicates instead of boolean-valued functions. The boolean versions discarded type information, and hence were difficult to use and prove properties about. The proofs have been updated and renamed accordingly. The old boolean versions still exist as `boolTakeWhile`, `boolSpan` etc. for backwards compatibility reasons, but are deprecated and may be removed in some future release. The old versions can be implemented via the new versions by passing the decidability proof `λ v → f v ≟ true` with `_≟_` from `Data.Bool`. #### Other * `Relation.Binary.Consequences` no longer exports `Total`. The standard way of accessing it through `Relation.Binary` remains unchanged. * `_⇒_` in `Relation.Unary` is now right associative instead of left associative. * Added new module `Relation.Unary.Properties`. The following proofs have been moved to the new module from `Relation.Unary`: `∅-Empty`, `∁∅-Universal`, `U-Universal`, `∁U-Empty`, `∅-⊆`, `⊆-U` and `∁?`. * The set operations `_∩/∪_` in `Data.Fin.Subset` are now implemented more efficiently using `zipWith _∧/∨_ p q` rather than `replicate _∧/∨_ ⊛ p ⊛ q`. The proof `booleanAlgebra` has been moved to `∩-∪-booleanAlgebra` in `Data.Fin.Subset.Properties`. * The decidability proofs `_≟_` and `__ : F A → (A → B) → F B ``` * Added new function to `Category.Monad.Indexed`: ```agda RawIMonadT : (T : IFun I f → IFun I f) → Set (i ⊔ suc f) ``` * Added new function to `Category.Monad`: ```agda RawMonadT : (T : (Set f → Set f) → (Set f → Set f)) → Set _ ``` * Added new functions to `Codata.Delay`: ```agda alignWith : (These A B → C) → Delay A i → Delay B i → Delay C i zip : Delay A i → Delay B i → Delay (A × B) i align : Delay A i → Delay B i → Delay (These A B) i ``` * Added new functions to `Codata.Musical.M`: ```agda map : (C₁ ⇒ C₂) → M C₁ → M C₂ unfold : (S → ⟦ C ⟧ S) → S → M C ``` * Added new proof to `Data.Fin.Permutation`: ```agda refute : m ≢ n → ¬ Permutation m n ``` Additionally the definitions `punchIn-permute` and `punchIn-permute′` have been generalised to work with heterogeneous permutations. * Added new proof to `Data.Fin.Properties`: ```agda toℕ-fromℕ≤″ : toℕ (fromℕ≤″ m m?_ : Decidable _>_ _≤′?_ : Decidable _≤′_ _<′?_ : Decidable _<′_ _≤″?_ : Decidable _≤″_ _<″?_ : Decidable _<″_ _≥″?_ : Decidable _≥″_ _>″?_ : Decidable _>″_ n≤0⇒n≡0 : n ≤ 0 → n ≡ 0 m Val` rather than a value together with a merging function `Val -> Val -> Val` to handle the case where a value is already present at that key. * Various functions have been made polymorphic which makes their biases & limitations clearer. e.g. we have: `unionWith : (V -> Maybe W -> W) -> Tree V -> Tree W -> Tree W` but ideally we would like to have: `unionWith : (These V W -> X) -> Tree V -> Tree W -> Tree X` * Keys are now implemented via the new `Relation.(Binary/Nullary).Construct.AddExtrema` modules. #### Overhaul of `Data.Container` * `Data.Container` has been split up into the standard hierarchy. * Moved `Data.Container`'s `All` and `Any` into their own `Data.Container.Relation.Unary.X` module. Made them record types to improve type inference. * Moved morphisms to `Data.Container.Morphism` and their properties to `Data.Container.Morphism.Properties`. * Made the index set explicit in `Data.Container.Combinator`'s `Π` and `Σ`. * Moved `Eq` to `Data.Container.Relation.Binary.Pointwise` (and renamed it to `Pointwise`) and its properties to `Data.Container.Relation.Binary.Pointwise.Properties`. * The type family `Data.Container.ν` is now defined using `Codata.M.M` rather than Codata.Musical.M.M`. #### Overhaul of `Data.Maybe` * `Data.Maybe` has been split up into the standard hierarchy for container datatypes. * Moved `Data.Maybe.Base`'s `Is-just`, `Is-nothing`, `to-witness`, and `to-witness-T` to `Data.Maybe` (they rely on `All` and `Any` which are now outside of `Data.Maybe.Base`). * Moved `Data.Maybe.Base`'s `All` and `Data.Maybe`'s `allDec` to `Data.Maybe.Relation.Unary.All` and renamed the proof `allDec` to `dec`. * Moved `Data.Maybe.Base`'s `Any` and `Data.Maybe`'s `anyDec` to `Data.Maybe.Relation.Unary.Any` and renamed the proof `anyDec` to `dec`. * Created `Data.Maybe.Properties` and moved `Data.Maybe.Base`'s `just-injective` into it and added new results. * Moved `Data.Maybe`'s `Eq` to `Data.Maybe.Relation.Binary.Pointwise`, made the relation heterogeneously typed and renamed the following proofs: ```agda Eq ↦ Pointwise Eq-refl ↦ refl Eq-sym ↦ sym Eq-trans ↦ trans Eq-dec ↦ dec Eq-isEquivalence ↦ isEquivalence Eq-isDecEquivalence ↦ isDecEquivalence ``` #### Overhaul of `Data.Sum.Relation.Binary` * The implementations of `Data.Sum.Relation.Binary.(Pointwise/LeftOrder)` have been altered to bring them in line with implementations of similar orders for other datatypes. Namely they are no longer specialised instances of some `Core` module. * The constructor `₁∼₂` for `LeftOrder` no longer takes an argument of type `⊤`. * The constructor `₁∼₁` and `₂∼₂` in `Pointwise` have been renamed `inj₁` and `inj₂` respectively. The old names still exist but have been deprecated. #### Overhaul of `MonadZero` and `MonadPlus` * Introduce `RawIApplicativeZero` for an indexed applicative with a zero and `RawAlternative` for an indexed applicative with a zero and a sum. * `RawIMonadZero` is now packing a `RawIApplicativeZero` rather than a `∅` directly * Similarly `RawIMonadPlus` is defined in terms of `RawIAlternative` rather than directly packing a _∣_. * Instances will be broken but usages should still work thanks to re-exports striving to maintain backwards compatibility. #### Overhaul of `Data.Char` and `Data.String` * Moved `setoid` and `strictTotalOrder` from `Data.(Char/String)` into the new module `Data.(Char/String).Properties`. * Used the new builtins from `Agda.Builtin.(Char/String).Properties` to implement decidable equality (`_≟_`) in a safe manner. This has allowed `_≟_`, `decSetoid` and `_==_` to be moved from `Data.(Char/String).Unsafe` to `Data.(Char/String).Properties`. #### Overhaul of `Data.Rational` * Many new operators have been added to `Data.Rational` including addition, substraction, multiplication, inverse etc. * The existing operator `_÷_` has been renamed `_/_` and is now more liberal as it now accepts non-coprime arguments (e.g. `+ 2 / 4`) which are then normalised. * The old name `_÷_` has been repurposed to represent division between two rationals. * The proofs `drop-*≤*`, `≃⇒≡` and `≡⇒≃` have been moved from `Data.Rational` to `Data.Rational.Properties`. #### Changes in `Data.List` * In `Data.List.Membership.Propositional.Properties`: - the `Set` argument has been made implicit in `∈-++⁺ˡ`, `∈-++⁺ʳ`, `∈-++⁻`, `∈-insert`, `∈-∃++`. - the `A → B` argument has been made explicit in `∈-map⁺`, `∈-map⁻`, `map-∈↔`. * The module `Data.List.Relation.Binary.Sublist.Propositional.Solver` has been removed and replaced by `Data.List.Relation.Binary.Sublist.DecPropositional.Solver`. * The functions `_∷=_` and `_─_` have been removed from `Data.List.Membership.Setoid` as they are subsumed by the more general versions now part of `Data.List.Any`. #### Changes in `Data.Nat` * Changed the implementation of `_≟_` and `_≤″?_` for natural numbers to use a (fast) boolean test. Compiled code that uses these should now run faster. * Made the contents of the modules `Data.Nat.Unsafe` and `Data.Nat.DivMod.Unsafe` safe by using the new safe equality erasure primitive instead of the unsafe one defined in `Relation.Binary.PropositionalEquality.TrustMe`. As the safe erasure primitive requires the K axiom the two files are now named `Data.Nat.WithK` and `Data.Nat.DivMod.WithK`. * Fixed a bug in `Data.Nat.Properties` where the type of `m⊓n≤m⊔n` was `∀ m n → m ⊔ n ≤ m ⊔ n`. The type has been corrected to `∀ m n → m ⊓ n ≤ m ⊔ n`. #### Changes in `Data.Vec` * The argument order for `lookup`, `insert` and `remove` in `Data.Vec` has been altered so that the `Vec` argument always come first, e.g. what was written as `lookup i v xs` is now `lookup xs i v`. The argument order for the corresponding proofs has also changed. This makes the operations more consistent with those in `Data.List`. * The proofs `toList⁺` and `toList⁻` in `Data.Vec.Relation.Unary.All.Properties` have been swapped as they were the opposite way round to similar properties in the rest of the library. #### Other changes * The proof `sel⇒idem` in `Algebra.FunctionProperties.Consequences` now only takes the equality relation as an argument instead of a full `Setoid`. * The proof `_≟_` that equality is decidable for `Bool` has been moved from `Data.Bool.Base` to `Data.Bool.Properties`. Backwards compatibility has been (nearly completely) preserved by having `Data.Bool` publicly re-export `_≟_`. * The type `Coprime` and proof `coprime-divisor` have been moved from `Data.Integer.Divisibility` to `Data.Integer.Coprimality`. * The functions `fromMusical` and `toMusical` were moved from the `Codata` modules to the corresponding `Codata.Musical` modules. Removed features ---------------- * The following modules that were deprecated in v0.14 and v0.15 have been removed. ```agda Data.Nat.Properties.Simple Data.Integer.Multiplication.Properties Data.Integer.Addition.Properties Relation.Binary.Sigma.Pointwise Relation.Binary.Sum Relation.Binary.List.NonStrictLex Relation.Binary.List.Pointwise Relation.Binary.List.StrictLex Relation.Binary.Product.NonStrictLex Relation.Binary.Product.Pointwise Relation.Binary.Product.StrictLex Relation.Binary.Vec.Pointwise ``` Deprecated features ------------------- The following renaming has occurred as part of a drive to improve consistency across the library. The old names still exist and therefore all existing code should still work, however they have been deprecated and use of the new names is encouraged. Although not anticipated any time soon, they may eventually be removed in some future release of the library. * In `Data.Bool.Properties`: ```agda T-irrelevance ↦ T-irrelevant ``` * In `Data.Fin.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.Integer.Properties`: ```agda ≰→> ↦ ≰⇒> ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.List.Relation.Binary.Permutation.Inductive.Properties`: ```agda ↭⇒~bag ↦ ↭⇒∼bag ~bag⇒↭ ↦ ∼bag⇒↭ ``` (now typed with "\sim" rather than "~") * In `Data.List.Relation.Binary.Pointwise`: ```agda decidable-≡ ↦ Data.List.Properties.≡-dec ``` * In `Data.List.Relation.Unary.All.Properties`: ```agda filter⁺₁ ↦ all-filter filter⁺₂ ↦ filter⁺ ``` * In `Data.Nat.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant <-irrelevance ↦ <-irrelevant ``` * In `Data.Rational`: ```agda drop-*≤* ≃⇒≡ ≡⇒≃ ``` (moved to `Data.Rational.Properties`) * In `Data.Rational.Properties`: ```agda ≤-irrelevance ↦ ≤-irrelevant ``` * In `Data.Vec.Properties.WithK`: ```agda []=-irrelevance ↦ []=-irrelevant ``` * In `Relation.Binary.HeterogeneousEquality`: ```agda ≅-irrelevance ↦ ≅-irrelevant ≅-heterogeneous-irrelevance ↦ ≅-heterogeneous-irrelevant ≅-heterogeneous-irrelevanceˡ ↦ ≅-heterogeneous-irrelevantˡ ≅-heterogeneous-irrelevanceʳ ↦ ≅-heterogeneous-irrelevantʳ ``` * In `Induction.WellFounded`: ```agda module Inverse-image ↦ InverseImage module Transitive-closure ↦ TransitiveClosure ``` * In `Relation.Binary.PropositionalEquality.WithK`: ```agda ≡-irrelevance ↦ ≡-irrelevant ``` Other minor additions --------------------- * Added new records to `Algebra`: ```agda record RawMagma c ℓ : Set (suc (c ⊔ ℓ)) record Magma c ℓ : Set (suc (c ⊔ ℓ)) ``` * Added new types to `Algebra.FunctionProperties`: ```agda LeftConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → x ≈ e RightConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → y ≈ e Conical e ∙ = LeftConical e ∙ × RightConical e ∙ LeftCongruent _∙_ = ∀ {x} → (x ∙_) Preserves _≈_ ⟶ _≈_ RightCongruent _∙_ = ∀ {x} → (_∙ x) Preserves _≈_ ⟶ _≈_ ``` * Added new proof to `Algebra.FunctionProperties.Consequences`: ```agda wlog : Commutative f → Total _R_ → (∀ a b → a R b → P (f a b)) → ∀ a b → P (f a b) ``` * Added new proofs to `Algebra.Properties.Lattice`: ```agda ∧-isSemilattice : IsSemilattice _≈_ _∧_ ∧-semilattice : Semilattice l₁ l₂ ∨-isSemilattice : IsSemilattice _≈_ _∨_ ∨-semilattice : Semilattice l₁ l₂ ``` * Added new operator to `Algebra.Solver.Ring`. ```agda _:×_ ``` * Added new records to `Algebra.Structures`: ```agda record IsMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) ``` * Added new proofs to `Category.Monad.State`: ```agda StateTIApplicative : RawMonad M → RawIApplicative (IStateT S M) StateTIApplicativeZero : RawMonadZero M → RawIApplicativeZero (IStateT S M) StateTIAlternative : RawMonadPlus M → RawIAlternative (IStateT S M) ``` * Added new functions to `Codata.Colist`: ```agda fromCowriter : Cowriter W A i → Colist W i toCowriter : Colist A i → Cowriter A ⊤ i [_] : A → Colist A ∞ chunksOf : (n : ℕ) → Colist A ∞ → Cowriter (Vec A n) (BoundedVec A n) ∞ ``` * Added new proofs to `Codata.Delay.Categorical`: ```agda Sequential.applicativeZero : RawApplicativeZero (λ A → Delay A i) Zippy.applicativeZero : RawApplicativeZero (λ A → Delay A i) Zippy.alternative : RawAlternative (λ A → Delay A i) ``` * Added new functions to `Codata.Stream`: ```agda splitAt : (n : ℕ) → Stream A ∞ → Vec A n × Stream A ∞ drop : ℕ → Stream A ∞ → Stream A ∞ interleave : Stream A i → Thunk (Stream A) i → Stream A i chunksOf : (n : ℕ) → Stream A ∞ → Stream (Vec A n) ∞ ``` * Added new proofs to `Codata.Stream.Properties`: ```agda splitAt-map : splitAt n (map f xs) ≡ map (map f) (map f) (splitAt n xs) lookup-iterate-identity : lookup n (iterate f a) ≡ fold a f n ``` * Added new proofs to `Data.Bool.Properties`: ```agda ∧-isMagma : IsMagma _∧_ ∨-isMagma : IsMagma _∨_ ∨-isBand : IsBand _∨_ ∨-isSemilattice : IsSemilattice _∨_ ∧-isBand : IsBand _∧_ ∧-isSemilattice : IsSemilattice _∧_ ∧-magma : Magma 0ℓ 0ℓ ∨-magma : Magma 0ℓ 0ℓ ∨-band : Band 0ℓ 0ℓ ∧-band : Band 0ℓ 0ℓ ∨-semilattice : Semilattice 0ℓ 0ℓ ∧-semilattice : Semilattice 0ℓ 0ℓ T? : Decidable T T?-diag : T b → True (T? b) ``` * Added new functions to `Data.Char`: ```agda toUpper : Char → Char toLower : Char → Char ``` * Added new functions to `Data.Fin.Base`: ```agda cast : m ≡ n → Fin m → Fin n lower₁ : (i : Fin (suc n)) → (n ≢ toℕ i) → Fin n ``` * Added new proof to `Data.Fin.Properties`: ```agda toℕ-cast : toℕ (cast eq k) ≡ toℕ k toℕ-inject₁-≢ : n ≢ toℕ (inject₁ i) inject₁-lower₁ : inject₁ (lower₁ i n≢i) ≡ i lower₁-inject₁′ : lower₁ (inject₁ i) n≢i ≡ i lower₁-inject₁ : lower₁ (inject₁ i) (toℕ-inject₁-≢ i) ≡ i lower₁-irrelevant : lower₁ i n≢i₁ ≡ lower₁ i n≢i₂ ``` * Added new proofs to `Data.Fin.Subset.Properties`: ```agda ∩-isMagma : IsMagma _∩_ ∪-isMagma : IsMagma _∪_ ∩-isBand : IsBand _∩_ ∪-isBand : IsBand _∪_ ∩-isSemilattice : IsSemilattice _∩_ ∪-isSemilattice : IsSemilattice _∪_ ∩-magma : Magma _ _ ∪-magma : Magma _ _ ∩-band : Band _ _ ∪-band : Band _ _ ∩-semilattice : Semilattice _ _ ∪-semilattice : Semilattice _ _ ``` * Added new proofs to `Data.Integer.Properties`: ```agda suc-pred : sucℤ (pred m) ≡ m pred-suc : pred (sucℤ m) ≡ m neg-suc : - + suc m ≡ pred (- + m) suc-+ : + suc m + n ≡ sucℤ (+ m + n) +-pred : m + pred n ≡ pred (m + n) pred-+ : pred m + n ≡ pred (m + n) minus-suc : m - + suc n ≡ pred (m - + n) [1+m]*n≡n+m*n : sucℤ m * n ≡ n + m * n ⊓-comm : Commutative _⊓_ ⊓-assoc : Associative _⊓_ ⊓-idem : Idempotent _⊓_ ⊓-sel : Selective _⊓_ m≤n⇒m⊓n≡m : m ≤ n → m ⊓ n ≡ m m⊓n≡m⇒m≤n : m ⊓ n ≡ m → m ≤ n m≥n⇒m⊓n≡n : m ≥ n → m ⊓ n ≡ n m⊓n≡n⇒m≥n : m ⊓ n ≡ n → m ≥ n m⊓n≤n : m ⊓ n ≤ n m⊓n≤m : m ⊓ n ≤ m ⊔-comm : Commutative _⊔_ ⊔-assoc : Associative _⊔_ ⊔-idem : Idempotent _⊔_ ⊔-sel : Selective _⊔_ m≤n⇒m⊔n≡n : m ≤ n → m ⊔ n ≡ n m⊔n≡n⇒m≤n : m ⊔ n ≡ n → m ≤ n m≥n⇒m⊔n≡m : m ≥ n → m ⊔ n ≡ m m⊔n≡m⇒m≥n : m ⊔ n ≡ m → m ≥ n m≤m⊔n : m ≤ m ⊔ n n≤m⊔n : n ≤ m ⊔ n neg-distrib-⊔-⊓ : - (m ⊔ n) ≡ - m ⊓ - n neg-distrib-⊓-⊔ : - (m ⊓ n) ≡ - m ⊔ - n pred-mono : pred Preserves _≤_ ⟶ _≤_ suc-mono : sucℤ Preserves _≤_ ⟶ _≤_ ⊖-monoʳ-≥-≤ : (p ⊖_) Preserves ℕ._≥_ ⟶ _≤_ ⊖-monoˡ-≤ : (_⊖ p) Preserves ℕ._≤_ ⟶ _≤_ +-monoʳ-≤ : (_+_ n) Preserves _≤_ ⟶ _≤_ +-monoˡ-≤ : (_+ n) Preserves _≤_ ⟶ _≤_ +-monoˡ-< : (_+ n) Preserves _<_ ⟶ _<_ +-monoʳ-< : (_+_ n) Preserves _<_ ⟶ _<_ *-monoˡ-≤-pos : (+ suc n *_) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-non-neg : (_* + n) Preserves _≤_ ⟶ _≤ *-monoˡ-≤-non-neg : (+ n *_) Preserves _≤_ ⟶ _≤_ +-mono-≤ : _+_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +-mono-< : _+_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +-mono-≤-< : _+_ Preserves₂ _≤_ ⟶ _<_ ⟶ _<_ +-mono-<-≤ : _+_ Preserves₂ _<_ ⟶ _≤_ ⟶ _<_ neg-mono-≤-≥ : -_ Preserves _≤_ ⟶ _≥_ neg-mono-<-> : -_ Preserves _<_ ⟶ _>_ *-cancelˡ-≡ : i ≢ + 0 → i * j ≡ i * k → j ≡ k *-cancelˡ-≤-pos : + suc m * n ≤ + suc m * o → n ≤ o neg-≤-pos : - (+ m) ≤ + n 0⊖m≤+ : 0 ⊖ m ≤ + n m≤n⇒m-n≤0 : m ≤ n → m - n ≤ + 0 m-n≤0⇒m≤n : m - n ≤ + 0 → m ≤ n m≤n⇒0≤n-m : m ≤ n → + 0 ≤ n - m 0≤n-m⇒m≤n : + 0 ≤ n - m → m ≤ n m≤pred[n]⇒m→≰ : x > y → x ≰ y >-irrefl : Irreflexive _≡_ _>_ pos-+-commute : Homomorphic₂ +_ ℕ._+_ _+_ neg-distribˡ-* : - (x * y) ≡ (- x) * y neg-distribʳ-* : - (x * y) ≡ x * (- y) *-distribˡ-+ : _*_ DistributesOverˡ _+_ ≤-steps : m ≤ n → m ≤ + p + n ≤-step-neg : m ≤ n → pred m ≤ n ≤-steps-neg : m ≤ n → m - + p ≤ n m≡n⇒m-n≡0 : m ≡ n → m - n ≡ + 0 m-n≡0⇒m≡n : m - n ≡ + 0 → m ≡ n 0≤n⇒+∣n∣≡n : + 0 ≤ n → + ∣ n ∣ ≡ n +∣n∣≡n⇒0≤n : + ∣ n ∣ ≡ n → + 0 ≤ n ◃-≡ : sign m ≡ sign n → ∣ m ∣ ≡ ∣ n ∣ → m ≡ n +-isMagma : IsMagma _+_ *-isMagma : IsMagma _*_ +-magma : Magma 0ℓ 0ℓ *-magma : Magma 0ℓ 0ℓ +-semigroup : Semigroup 0ℓ 0ℓ *-semigroup : Semigroup 0ℓ 0ℓ +-0-monoid : Monoid 0ℓ 0ℓ *-1-monoid : Monoid 0ℓ 0ℓ +-*-ring : Ring 0ℓ 0ℓ <-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<_ <-strictPartialOrder : StrictPartialOrder _ _ _ ``` * Added new proofs to `Data.List.Categorical`: ```agda applicativeZero : RawApplicativeZero List alternative : RawAlternative List ``` * Added new operations to `Data.List.Relation.Unary.All`: ```agda zipWith : P ∩ Q ⊆ R → All P ∩ All Q ⊆ All R unzipWith : R ⊆ P ∩ Q → All R ⊆ All P ∩ All Q sequenceA : All (F ∘′ P) ⊆ F ∘′ All P sequenceM : All (M ∘′ P) ⊆ M ∘′ All P mapA : (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) mapM : (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) forA : All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) forM : All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) updateAt : x ∈ xs → (P x → P x) → All P xs → All P xs _[_]%=_ : All P xs → x ∈ xs → (P x → P x) → All P xs _[_]≔_ : All P xs → x ∈ xs → P x → All P xs ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda respects : P Respects _≈_ → (All P) Respects _≋_ ─⁺ : All Q xs → All Q (xs Any.─ p) ─⁻ : Q (Any.lookup p) → All Q (xs Any.─ p) → All Q xs map-cong : f ≗ g → map f ps ≡ map g ps map-id : map id ps ≡ ps map-compose : map g (map f ps) ≡ map (g ∘ f) ps lookup-map : lookup (map f ps) i ≡ f (lookup ps i) ∷ʳ⁺ : All P xs → P x → All P (xs ∷ʳ x) ∷ʳ⁻ : All P (xs ∷ʳ x) → All P xs × P x ``` * Added new proofs to `Data.List.Relation.Binary.Equality.DecPropositional`: ```agda _≡?_ : Decidable (_≡_ {A = List A}) ``` * Added new functions to `Data.List.Relation.Unary.Any`: ```agda lookup : Any P xs → A _∷=_ : Any P xs → A → List A _─_ : ∀ xs → Any P xs → List A ``` * Added new functions to `Data.List.Base`: ```agda intercalate : List A → List (List A) → List A partitionSumsWith : (A → B ⊎ C) → List A → List B × List C partitionSums : List (A ⊎ B) → List A × List B _[_]%=_ : (xs : List A) → Fin (length xs) → (A → A) → List A _[_]∷=_ : (xs : List A) → Fin (length xs) → A → List A _─_ : (xs : List A) → Fin (length xs) → List A reverseAcc : List A → List A → List A ``` * Added new proofs to `Data.List.Membership.Propositional.Properties`: ```agda ∈-allFin : (k : Fin n) → k ∈ allFin n []∈inits : [] ∈ inits as ``` * Added new function to `Data.List.Membership.(Setoid/Propositional)`: ```agda _∷=_ : x ∈ xs → A → List A _─_ : (xs : List A) → x ∈ xs → List A ``` Added laws for `updateAt`. The laws that previously existed for `_[_]≔_` are now special instances of these. * Added new proofs to `Data.List.Membership.Setoid.Properties`: ```agda length-mapWith∈ : length (mapWith∈ xs f) ≡ length xs ∈-∷=⁺-updated : v ∈ (x∈xs ∷= v) ∈-∷=⁺-untouched : x ≉ y → y ∈ xs → y ∈ (x∈xs ∷= v) ∈-∷=⁻ : y ≉ v → y ∈ (x∈xs ∷= v) → y ∈ xs map-∷= : map f (x∈xs ∷= v) ≡ ∈-map⁺ f≈ pr ∷= f v ``` * Added new proofs to `Data.List.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable {A = List A} _≡_ ++-cancelˡ : xs ++ ys ≡ xs ++ zs → ys ≡ zs ++-cancelʳ : ys ++ xs ≡ zs ++ xs → ys ≡ zs ++-cancel : Cancellative _++_ ++-conicalˡ : xs ++ ys ≡ [] → xs ≡ [] ++-conicalʳ : xs ++ ys ≡ [] → ys ≡ [] ++-conical : Conical [] _++_ ++-isMagma : IsMagma _++_ length-%= : length (xs [ k ]%= f) ≡ length xs length-∷= : length (xs [ k ]∷= v) ≡ length xs length-─ : length (xs ─ k) ≡ pred (length xs) map-∷= : map f (xs [ k ]∷= v) ≡ map f xs [ cast eq k ]∷= f v map-─ : map f (xs ─ k) ≡ map f xs ─ cast eq k length-applyUpTo : length (applyUpTo f n) ≡ n length-applyDownFrom : length (applyDownFrom f n) ≡ n length-upTo : length (upTo n) ≡ n length-downFrom : length (downFrom n) ≡ n length-tabulate : length (tabulate f ) ≡ n lookup-applyUpTo : lookup (applyUpTo f n) i ≡ f (toℕ i) lookup-applyDownFrom : lookup (applyDownFrom f n) i ≡ f (n ∸ (suc (toℕ i))) lookup-upTo : lookup (upTo n) i ≡ toℕ i lookup-downFrom : lookup (downFrom n) i ≡ n ∸ (suc (toℕ i)) lookup-tabulate : lookup (tabulate f) i′ ≡ f i map-tabulate : map f (tabulate g) ≡ tabulate (f ∘ g) ``` * Added new proofs to `Data.List.Relation.Binary.Permutation.Inductive.Properties`: ```agda ++-isMagma : IsMagma _↭_ _++_ ++-magma : Magma _ _ ``` * Added new proofs to `Data.List.Relation.Binary.Pointwise`: ```agda reverseAcc⁺ : Pointwise R a x → Pointwise R b y → Pointwise R (reverseAcc a b) (reverseAcc x y) reverse⁺ : Pointwise R as bs → Pointwise R (reverse as) (reverse bs) map⁺ : Pointwise (λ a b → R (f a) (g b)) as bs → Pointwise R (map f as) (map g bs) map⁻ : Pointwise R (map f as) (map g bs) → Pointwise (λ a b → R (f a) (g b)) as bs filter⁺ : Pointwise R as bs → Pointwise R (filter P? as) (filter Q? bs) replicate⁺ : R a b → Pointwise R (replicate n a) (replicate n b) irrelevant : Irrelevant R → Irrelevant (Pointwise R) ``` * Added new function to `Data.Maybe.Base`: ```agda _<∣>_ : Maybe A → Maybe A → Maybe A ``` * Added new proofs to `Data.Maybe.Categorical`: ```agda applicativeZero : RawApplicativeZero Maybe alternative : RawAlternative Maybe ``` * Added new proof to `Data.Maybe.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable {A = Maybe A} _≡_ ``` * Added new proof to `Data.Maybe.Relation.Binary.Pointwise`: ```agda reflexive : _≡_ ⇒ R → _≡_ ⇒ Pointwise R ``` * Added new proofs to `Data.Maybe.Relation.Unary.All`: ```agda drop-just : All P (just x) → P x just-equivalence : P x ⇔ All P (just x) map : P ⊆ Q → All P ⊆ All Q fromAny : Any P ⊆ All P zipWith : P ∩ Q ⊆ R → All P ∩ All Q ⊆ All R unzipWith : P ⊆ Q ∩ R → All P ⊆ All Q ∩ All R zip : All P ∩ All Q ⊆ All (P ∩ Q) unzip : All (P ∩ Q) ⊆ All P ∩ All Q sequenceA : RawApplicative F → All (F ∘′ P) ⊆ F ∘′ All P mapA : RawApplicative F → (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) forA : RawApplicative F → All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) sequenceM : RawMonad M → All (M ∘′ P) ⊆ M ∘′ All P mapM : RawMonad M → (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) forM : RawMonad M → All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) universal : Universal P → Universal (All P) irrelevant : Irrelevant P → Irrelevant (All P) satisfiable : Satisfiable (All P) ``` * Added new proofs to `Data.Maybe.Relation.Unary.Any`: ```agda drop-just : Any P (just x) → P x just-equivalence : P x ⇔ Any P (just x) map : P ⊆ Q → Any P ⊆ Any Q satisfied : Any P x → ∃ P zipWith : P ∩ Q ⊆ R → Any P ∩ Any Q ⊆ Any R unzipWith : P ⊆ Q ∩ R → Any P ⊆ Any Q ∩ Any R zip : Any P ∩ Any Q ⊆ Any (P ∩ Q) unzip : Any (P ∩ Q) ⊆ Any P ∩ Any Q irrelevant : Irrelevant P → Irrelevant (Any P) satisfiable : Satisfiable P → Satisfiable (Any P) ``` * Added a third alternative definition of "less than" to `Data.Nat.Base`: ```agda _≤‴_ : Rel ℕ 0ℓ _<‴_ : Rel ℕ 0ℓ _≥‴_ : Rel ℕ 0ℓ _>‴_ : Rel ℕ 0ℓ ``` * Added new proofs to `Data.Nat.Properties`: ```agda +-isMagma : IsMagma _+_ *-isMagma : IsMagma _*_ ⊔-isMagma : IsMagma _⊔_ ⊓-isMagma : IsMagma _⊓_ ⊔-isBand : IsBand _⊔_ ⊓-isBand : IsBand _⊓_ ⊔-isSemilattice : IsSemilattice _⊔_ ⊓-isSemilattice : IsSemilattice _⊓_ +-magma : Magma 0ℓ 0ℓ *-magma : Magma 0ℓ 0ℓ ⊔-magma : Magma 0ℓ 0ℓ ⊓-magma : Magma 0ℓ 0ℓ ⊔-band : Band 0ℓ 0ℓ ⊓-band : Band 0ℓ 0ℓ ⊔-semilattice : Semilattice 0ℓ 0ℓ ⊓-semilattice : Semilattice 0ℓ 0ℓ +-cancelˡ-< : LeftCancellative _<_ _+_ +-cancelʳ-< : RightCancellative _<_ _+_ +-cancel-< : Cancellative _<_ _+_ m≤n⇒m⊓o≤n : m ≤ n → m ⊓ o ≤ n m≤n⇒o⊓m≤n : m ≤ n → o ⊓ m ≤ n m″-irrelevant : Irrelevant _>″_ m≤‴m+k : m + k ≡ n → m ≤‴ n ``` * Added new proof to `Data.Product.Properties.WithK`: ```agda ,-injective : (a , b) ≡ (c , d) → a ≡ c × b ≡ d ≡-dec : Decidable _≡_ → (∀ {a} → Decidable {A = B a} _≡_) → Decidable {A = Σ A B} _≡_ ``` * Added new functions to `Data.Product.Relation.Binary.Pointwise.NonDependent`: ```agda <_,_>ₛ : A ⟶ B → A ⟶ C → A ⟶ (B ×ₛ C) proj₁ₛ : (A ×ₛ B) ⟶ A proj₂ₛ : (A ×ₛ B) ⟶ B swapₛ : (A ×ₛ B) ⟶ (B ×ₛ A) ``` * Added new functions to `Data.Rational`: ```agda -_ : ℚ → ℚ 1/_ : (p : ℚ) → .{n≢0 : ∣ ℚ.numerator p ∣ ≢0} → ℚ _*_ : ℚ → ℚ → ℚ _+_ : ℚ → ℚ → ℚ _-_ : ℚ → ℚ → ℚ _/_ : (p₁ p₂ : ℚ) → {n≢0 : ∣ ℚ.numerator p₂ ∣ ≢0} → ℚ show : ℚ → String ``` * Added new proofs to `Data.Sign.Properties`: ```agda *-isMagma : IsMagma _*_ *-magma : Magma 0ℓ 0ℓ ``` * Added new functions to `Data.Sum.Base`: ```agda fromDec : Dec P → P ⊎ ¬ P toDec : P ⊎ ¬ P → Dec P ``` * Added new proof to `Data.Sum.Properties`: ```agda ≡-dec : Decidable _≡_ → Decidable _≡_ → Decidable {A = A ⊎ B} _≡_ ``` * Added new functions to `Data.Sum.Relation.Binary.Pointwise`: ```agda inj₁ₛ : A ⟶ (A ⊎ₛ B) inj₂ₛ : B ⟶ (A ⊎ₛ B) [_,_]ₛ : (A ⟶ C) → (B ⟶ C) → (A ⊎ₛ B) ⟶ C swapₛ : (A ⊎ₛ B) ⟶ (B ⊎ₛ A) ``` * Added new function to `Data.These`: ```agda fromSum : A ⊎ B → These A B ``` * Added to `Data.Vec` a generalization of single point overwrite `_[_]≔_` to single-point modification `_[_]%=_` (with an alias `updateAt` with different argument order): ```agda _[_]%=_ : Vec A n → Fin n → (A → A) → Vec A n updateAt : Fin n → (A → A) → Vec A n → Vec A n ``` * Added proofs for `updateAt` to `Data.Vec.Properties`. Previously existing proofs for `_[_]≔_` are now special instances of these. * Added new proofs to `Data.Vec.Relation.Unary.Any.Properties`: ```agda lookup-index : (p : Any P xs) → P (lookup (index p) xs) lift-resp : P Respects _≈_ → (Any P) Respects (Pointwise _≈_) here-injective : here p ≡ here q → p ≡ q there-injective : there p ≡ there q → p ≡ q ¬Any[] : ¬ Any P [] ⊥↔Any⊥ : ⊥ ↔ Any (const ⊥) xs ⊥↔Any[] : ⊥ ↔ Any P [] map-id : ∀ f → (∀ p → f p ≡ p) → ∀ p → Any.map f p ≡ p map-∘ : Any.map (f ∘ g) p ≡ Any.map f (Any.map g p) swap : Any (λ x → Any (x ∼_) ys) xs → Any (λ y → Any (_∼ y) xs) ys swap-there : swap (Any.map there p) ≡ there (swap p) swap-invol : swap (swap p) ≡ p swap↔ : Any (λ x → Any (x ∼_) ys) xs ↔ Any (λ y → Any (_∼ y) xs) ys Any-⊎⁺ : Any P xs ⊎ Any Q xs → Any (λ x → P x ⊎ Q x) xs Any-⊎⁻ : Any (λ x → P x ⊎ Q x) xs → Any P xs ⊎ Any Q xs ⊎↔ : (Any P xs ⊎ Any Q xs) ↔ Any (λ x → P x ⊎ Q x) xs Any-×⁺ : Any P xs × Any Q ys → Any (λ x → Any (λ y → P x × Q y) ys) xs Any-×⁻ : Any (λ x → Any (λ y → P x × Q y) ys) xs → Any P xs × Any Q ys singleton⁺ : P x → Any P [ x ] singleton⁻ : Any P [ x ] → P x singleton⁺∘singleton⁻ : singleton⁺ (singleton⁻ p) ≡ p singleton⁻∘singleton⁺ : singleton⁻ (singleton⁺ p) ≡ p singleton↔ : P x ↔ Any P [ x ] map⁺ : Any (P ∘ f) xs → Any P (map f xs) map⁻ : Any P (map f xs) → Any (P ∘ f) xs map⁺∘map⁻ : map⁺ (map⁻ p) ≡ p map⁻∘map⁺ : map⁻ (map⁺ p) ≡ p map↔ : Any (P ∘ f) xs ↔ Any P (map f xs) ++⁺ˡ : Any P xs → Any P (xs ++ ys) ++⁺ʳ : Any P ys → Any P (xs ++ ys) ++⁻ : Any P (xs ++ ys) → Any P xs ⊎ Any P ys ++⁺∘++⁻ : ∀ p → [ ++⁺ˡ , ++⁺ʳ xs ]′ (++⁻ xs p) ≡ p ++⁻∘++⁺ : ∀ p → ++⁻ xs ([ ++⁺ˡ , ++⁺ʳ xs ]′ p) ≡ p ++-comm : ∀ xs ys → Any P (xs ++ ys) → Any P (ys ++ xs) ++-comm∘++-comm : ∀ p → ++-comm ys xs (++-comm xs ys p) ≡ p ++-insert : ∀ xs → P x → Any P (xs ++ [ x ] ++ ys) ++↔ : (Any P xs ⊎ Any P ys) ↔ Any P (xs ++ ys) ++↔++ : ∀ xs ys → Any P (xs ++ ys) ↔ Any P (ys ++ xs) concat⁺ : Any (Any P) xss → Any P (concat xss) concat⁻ : Any P (concat xss) → Any (Any P) xss concat⁻∘++⁺ˡ : ∀ xss p → concat⁻ (xs ∷ xss) (++⁺ˡ p) ≡ here p concat⁻∘++⁺ʳ : ∀ xs xss p → concat⁻ (xs ∷ xss) (++⁺ʳ xs p) ≡ there (concat⁻ xss p) concat⁺∘concat⁻ : ∀ xss p → concat⁺ (concat⁻ xss p) ≡ p concat⁻∘concat⁺ : ∀ p → concat⁻ xss (concat⁺ p) ≡ p concat↔ : Any (Any P) xss ↔ Any P (concat xss) tabulate⁺ : ∀ i → P (f i) → Any P (tabulate f) tabulate⁻ : Any P (tabulate f) → ∃ λ i → P (f i) mapWith∈⁺ : ∀ f → (∃₂ λ x p → P (f p)) → Any P (mapWith∈ xs f) mapWith∈⁻ : ∀ xs f → Any P (mapWith∈ xs f) → ∃₂ λ x p → P (f p) mapWith∈↔ : (∃₂ λ x p → P (f p)) ↔ Any P (mapWith∈ xs f) toList⁺ : Any P xs → List.Any P (toList xs) toList⁻ : List.Any P (toList xs) → Any P xs fromList⁺ : List.Any P xs → Any P (fromList xs) fromList⁻ : Any P (fromList xs) → List.Any P xs ∷↔ : ∀ P → (P x ⊎ Any P xs) ↔ Any P (x ∷ xs) >>=↔ : Any (Any P ∘ f) xs ↔ Any P (xs >>= f) ``` * Added new functions to `Data.Vec.Membership.Propositional.Properties`: ```agda fromAny : Any P xs → ∃ λ x → x ∈ xs × P x toAny : x ∈ xs → P x → Any P xs ``` * Added new proof to `Data.Vec.Properties`: ```agda ≡-dec : Decidable _≡_ → ∀ {n} → Decidable {A = Vec A n} _≡_ ``` * Added new proofs to `Function.Related.TypeIsomorphisms`: ```agda ×-isMagma : ∀ k ℓ → IsMagma (Related ⌊ k ⌋) _×_ ⊎-isMagma : ∀ k ℓ → IsMagma (Related ⌊ k ⌋) _⊎_ ×-magma : Symmetric-kind → (ℓ : Level) → Magma _ _ ⊎-magma : Symmetric-kind → (ℓ : Level) → Semigroup _ _ ``` * Added new proofs to `Relation.Binary.Consequences`: ```agda wlog : Total _R_ → Symmetric Q → (∀ a b → a R b → Q a b) → ∀ a b → Q a b ``` * Added new definitions to `Relation.Binary.Core`: ```agda Antisym R S E = ∀ {i j} → R i j → S j i → E i j Max : REL A B ℓ → B → Set _ Min : REL A B ℓ → A → Set _ Conn P Q = ∀ x y → P x y ⊎ Q y x P ⟶ Q Respects _∼_ = ∀ {x y} → x ∼ y → P x → Q y ``` Additionally the definition of the types `_Respectsʳ_`/`_Respectsˡ_` has been generalised as follows in order to support heterogenous relations: ```agda _Respectsʳ_ : REL A B ℓ₁ → Rel B ℓ₂ → Set _ _Respectsˡ_ : REL A B ℓ₁ → Rel A ℓ₂ → Set _ ``` * Added new proofs to `Relation.Binary.Lattice`: ```agda Lattice.setoid : Setoid c ℓ BoundedLattice.setoid : Setoid c ℓ ``` * Added new operations and proofs to `Relation.Binary.Properties.HeytingAlgebra`: ```agda y≤x⇨y : y ≤ x ⇨ y ⇨-unit : x ⇨ x ≈ ⊤ ⇨-drop : (x ⇨ y) ∧ y ≈ y ⇨-app : (x ⇨ y) ∧ x ≈ y ∧ x ⇨-relax : _⇨_ Preserves₂ (flip _≤_) ⟶ _≤_ ⟶ _≤_ ⇨-cong : _⇨_ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_ ⇨-applyˡ : w ≤ x → (x ⇨ y) ∧ w ≤ y ⇨-applyʳ : w ≤ x → w ∧ (x ⇨ y) ≤ y ⇨-curry : x ∧ y ⇨ z ≈ x ⇨ y ⇨ z ⇨ʳ-covariant : (x ⇨_) Preserves _≤_ ⟶ _≤_ ⇨ˡ-contravariant : (_⇨ x) Preserves (flip _≤_) ⟶ _≤_ ¬_ : Op₁ Carrier x≤¬¬x : x ≤ ¬ ¬ x de-morgan₁ : ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y de-morgan₂-≤ : ¬ (x ∧ y) ≤ ¬ ¬ (¬ x ∨ ¬ y) de-morgan₂-≥ : ¬ ¬ (¬ x ∨ ¬ y) ≤ ¬ (x ∧ y) de-morgan₂ : ¬ (x ∧ y) ≈ ¬ ¬ (¬ x ∨ ¬ y) weak-lem : ¬ ¬ (¬ x ∨ x) ≈ ⊤ ``` * Added new proofs to `Relation.Binary.Properties.JoinSemilattice`: ```agda x≤y⇒x∨y≈y : x ≤ y → x ∨ y ≈ y ``` * Added new proofs to `Relation.Binary.Properties.Lattice`: ```agda ∧≤∨ : x ∧ y ≤ x ∨ y quadrilateral₁ : x ∨ y ≈ x → x ∧ y ≈ y quadrilateral₂ : x ∧ y ≈ y → x ∨ y ≈ x collapse₁ : x ≈ y → x ∧ y ≈ x ∨ y collapse₂ : x ∨ y ≤ x ∧ y → x ≈ y ``` * Added new proofs to `Relation.Binary.Properties.MeetSemilattice`: ```agda y≤x⇒x∧y≈y : y ≤ x → x ∧ y ≈ y ``` * Added new definitions to `Relation.Binary.PropositionalEquality`: ```agda trans-injectiveˡ : trans p₁ q ≡ trans p₂ q → p₁ ≡ p₂ trans-injectiveʳ : trans p q₁ ≡ trans p q₂ → q₁ ≡ q₂ subst-injective : subst P x≡y p ≡ subst P x≡y q → p ≡ q cong-id : cong id p ≡ p cong-∘ : cong (f ∘ g) p ≡ cong f (cong g p) cong-≡id : (f≡id : ∀ x → f x ≡ x) → cong f (f≡id x) ≡ f≡id (f x) naturality : trans (cong f x≡y) (f≡g y) ≡ trans (f≡g x) (cong g x≡y) subst-application : (eq : x₁ ≡ x₂) → subst B₂ eq (g x₁ y) ≡ g x₂ (subst B₁ (cong f eq) y) subst-subst : subst P y≡z (subst P x≡y p) ≡ subst P (trans x≡y y≡z) p subst-subst-sym : subst P x≡y (subst P (sym x≡y) p) ≡ p subst-sym-subst : subst P (sym x≡y) (subst P x≡y p) ≡ p subst-∘ : subst (P ∘ f) x≡y p ≡ subst P (cong f x≡y) p trans-assoc : trans (trans p q) r ≡ trans p (trans q r) trans-reflʳ : trans p refl ≡ p trans-symʳ : trans p (sym p) ≡ refl trans-symˡ : trans (sym p) p ≡ refl ``` agda-stdlib-1.7.3/CHANGELOG/v1.1.md000066400000000000000000001073161451211343400162010ustar00rootroot00000000000000Version 1.1 =========== The library has been tested using Agda version 2.6.0.1. Changes since 1.0.1: Highlights ---------- * Large increases in performance for `Nat`, `Integer` and `Rational` datatypes, particularly in compiled code. * Generic n-ary programming (`projₙ`, `congₙ`, `substₙ` etc.) * General argmin/argmax/min/max over `List`. * New `Trie` datatype Bug-fixes --------- #### `_<_` in `Data.Integer` * The definition of `_<_` in `Data.Integer` often resulted in unsolved metas when Agda had to infer the first argument. This was because it was previously implemented in terms of `suc` -> `_+_` -> `_⊖_`. * To fix this problem the implementation has therefore changed to: ```agda data _<_ : ℤ → ℤ → Set where -<+ : ∀ {m n} → -[1+ m ] < + n -<- : ∀ {m n} → (n-< : (p ⊖_) Preserves ℕ._>_ ⟶ _<_ ⊖-monoˡ-< : (_⊖ p) Preserves ℕ._<_ ⟶ _<_ *-distrib-+ : _*_ DistributesOver _+_ *-monoˡ-<-pos : (+[1+ n ] *_) Preserves _<_ ⟶ _<_ *-monoʳ-<-pos : (_* +[1+ n ]) Preserves _<_ ⟶ _<_ *-cancelˡ-<-non-neg : + m * n < + m * o → n < o *-cancelʳ-<-non-neg : m * + o < n * + o → m < n ``` * Added new proofs to `Data.List.Properties`: ```agda foldr-forcesᵇ : (P (f x y) → P x × P y) → P (foldr f e xs) → All P xs foldr-preservesᵇ : (P x → P y → P (f x y)) → P e → All P xs → P (foldr f e xs) foldr-preservesʳ : (P y → P (f x y)) → P e → P (foldr f e xs) foldr-preservesᵒ : (P x ⊎ P y → P (f x y)) → P e ⊎ Any P xs → P (foldr f e xs) ``` * Added a new proof in `Data.List.Relation.Binary.Permutation.Propositional.Properties`: ```agda shifts : xs ++ ys ++ zs ↭ ys ++ xs ++ zs ``` * Added new proofs to `Data.List.Relation.Binary.Pointwise`: ```agda ++-cancelˡ : Pointwise _∼_ (xs ++ ys) (xs ++ zs) → Pointwise _∼_ ys zs ++-cancelʳ : Pointwise _∼_ (ys ++ xs) (zs ++ xs) → Pointwise _∼_ ys zs ``` * Added new proof to `Data.List.Relation.Binary.Sublist.Heterogeneous.Properties`: ```agda concat⁺ : Sublist (Sublist R) ass bss → Sublist R (concat ass) (concat bss) ``` * Added new proof to `Data.List.Membership.Setoid.Properties`: ```agda unique⇒irrelevant : Irrelevant _≈_ → Unique xs → Irrelevant (_∈ xs) ``` * Added new proofs to `Data.List.Relation.Binary.Sublist.Propositional.Properties`: ```agda All-resp-⊆ : (All P) Respects (flip _⊆_) Any-resp-⊆ : (Any P) Respects _⊆_ ``` * Added new operations to `Data.List.Relation.Unary.All`: ```agda lookupAny : All P xs → (i : Any Q xs) → (P ∩ Q) (lookup i) lookupWith : ∀[ P ⇒ Q ⇒ R ] → All P xs → (i : Any Q xs) → R (lookup i) uncons : All P (x ∷ xs) → P x × All P xs reduce : (f : ∀ {x} → P x → B) → ∀ {xs} → All P xs → List B construct : (f : B → ∃ P) (xs : List B) → ∃ (All P) fromList : (xs : List (∃ P)) → All P (List.map proj₁ xs) toList : All P xs → List (∃ P) self : All (const A) xs ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda All-swap : All (λ xs → All (xs ~_) ys) xss → All (λ y → All (_~ y) xss) ys applyDownFrom⁺₁ : (∀ {i} → i < n → P (f i)) → All P (applyDownFrom f n) applyDownFrom⁺₂ : (∀ i → P (f i)) → All P (applyDownFrom f n) ``` * Added new proofs to `Data.List.Relation.Unary.Any.Properties`: ```agda Any-Σ⁺ʳ : (∃ λ x → Any (_~ x) xs) → Any (∃ ∘ _~_) xs Any-Σ⁻ʳ : Any (∃ ∘ _~_) xs → ∃ λ x → Any (_~ x) xs gmap : P ⋐ Q ∘ f → Any P ⋐ Any Q ∘ map f ``` * Added new functions to `Data.Maybe.Base`: ```agda ap : Maybe (A → B) → Maybe A → Maybe B _>>=_ : Maybe A → (A → Maybe B) → Maybe B ``` * Added new proofs to `Data.Nat.Divisibility`: ```agda ∣m∸n∣n⇒∣m : n ≤ m → i ∣ m ∸ n → i ∣ n → i ∣ m ∣n∣m%n⇒∣m : d ∣ n → d ∣ (m % n) → d ∣ m *-monoˡ-∣ : i ∣ j → i * k ∣ j * k %-presˡ-∣ : d ∣ m → d ∣ n → d ∣ (m % n) m/n∣m : n ∣ m → m / n ∣ m m*n∣o⇒m∣o/n : m * n ∣ o → m ∣ o / n m*n∣o⇒n∣o/m : m * n ∣ o → n ∣ o / m m∣n/o⇒m*o∣n : o ∣ n → m ∣ n / o → m * o ∣ n m∣n/o⇒o*m∣n : o ∣ n → m ∣ n / o → o * m ∣ n m/n∣o⇒m∣o*n : n ∣ m → m / n ∣ o → m ∣ o * n m∣n*o⇒m/n∣o : n ∣ m → m ∣ o * n → m / n ∣ o ``` * Added new operator and proofs to `Data.Nat.DivMod`: ```agda _/_ = _div_ m%n≤m : m % n ≤ m m≤n⇒m%n≡m : m ≤ n → m % n ≡ m %-remove-+ˡ : d ∣ m → (m + n) % d ≡ n % d %-remove-+ʳ : d ∣ n → (m + n) % d ≡ m % d %-pred-≡0 : suc m % n ≡ 0 → m % n ≡ n ∸ 1 m<[1+n%d]⇒m≤[n%d] : m < suc n % d → m ≤ n % d [1+m%d]≤1+n⇒[m%d]≤n : 0 < suc m % d → suc m % d ≤ suc n → m % d ≤ n 0/n≡0 : 0 / n ≡ 0 n/1≡n : n / 1 ≡ n n/n≡1 : n / n ≡ 1 m*n/n≡m : m * n / n ≡ m m/n*n≡m : n ∣ m → m / n * n ≡ m m*[n/m]≡n : m ∣ n → m * (n / m) ≡ n m/n*n≤m : m / n * n ≤ m m/n-connex : Connex _≥_ _>_ <-≤-connex : Connex _<_ _≤_ >-≥-connex : Connex _>_ _≥_ 1+n≢0 : suc n ≢ 0 <ᵇ⇒< : T (m <ᵇ n) → m < n <⇒<ᵇ : m < n → T (m <ᵇ n) n≢0⇒n>0 : n ≢ 0 → n > 0 m≤m*n : 0 < n → m ≤ m * n m_ : Rel ℚ 0ℓ _≰_ : Rel ℚ 0ℓ _≱_ : Rel ℚ 0ℓ _≮_ : Rel ℚ 0ℓ _≯_ : Rel ℚ 0ℓ ``` * Added new proofs and modules to `Data.Rational.Properties`: ```agda ≡-setoid : Setoid 0ℓ 0ℓ ≡-decSetoid : DecSetoid 0ℓ 0ℓ drop-*<* : p < q → (↥ p ℤ.* ↧ q) ℤ.< (↥ q ℤ.* ↧ p) <⇒≤ : _<_ ⇒ _≤_ <-irrefl : Irreflexive _≡_ _<_ <-asym : Asymmetric _<_ <-≤-trans : Trans _<_ _≤_ _<_ ≤-<-trans : Trans _≤_ _<_ _<_ <-trans : Transitive _<_ _>=_ : TC A → (A → TC B) → TC B _>>_ : TC A → TC B → TC B assocˡ : Associativity assocʳ : Associativity non-assoc : Associativity unrelated : Precedence related : Int → Precedence fixity : Associativity → Precedence → Fixity getFixity : Name → Fixity vArg ty = arg (arg-info visible relevant) ty hArg ty = arg (arg-info hidden relevant) ty iArg ty = arg (arg-info instance′ relevant) ty vLam s t = lam visible (abs s t) hLam s t = lam hidden (abs s t) iLam s t = lam instance′ (abs s t) Π[_∶_]_ s a ty = pi a (abs s ty) vΠ[_∶_]_ s a ty = Π[ s ∶ (vArg a) ] ty hΠ[_∶_]_ s a ty = Π[ s ∶ (hArg a) ] ty iΠ[_∶_]_ s a ty = Π[ s ∶ (iArg a) ] ty ``` * Added new definition to `Setoid` in `Relation.Binary`: ```agda x ≉ y = ¬ (x ≈ y) ``` * Added new definitions in `Relation.Binary.Core`: ```agda Universal _∼_ = ∀ x y → x ∼ y Recomputable _~_ = ∀ {x y} → .(x ~ y) → x ~ y ``` * Added new proof to `Relation.Binary.Consequences`: ```agda dec⟶recomputable : Decidable R → Recomputable R flip-Connex : Connex P Q → Connex Q P ``` * Added new proofs to `Relation.Binary.Construct.Add.(Infimum/Supremum/Extrema).NonStrict`: ```agda ≤±-reflexive-≡ : (_≡_ ⇒ _≤_) → (_≡_ ⇒ _≤±_) ≤±-antisym-≡ : Antisymmetric _≡_ _≤_ → Antisymmetric _≡_ _≤±_ ≤±-isPreorder-≡ : IsPreorder _≡_ _≤_ → IsPreorder _≡_ _≤±_ ≤±-isPartialOrder-≡ : IsPartialOrder _≡_ _≤_ → IsPartialOrder _≡_ _≤±_ ≤±-isDecPartialOrder-≡ : IsDecPartialOrder _≡_ _≤_ → IsDecPartialOrder _≡_ _≤±_ ≤±-isTotalOrder-≡ : IsTotalOrder _≡_ _≤_ → IsTotalOrder _≡_ _≤±_ ≤±-isDecTotalOrder-≡ : IsDecTotalOrder _≡_ _≤_ → IsDecTotalOrder _≡_ _≤±_ ``` * Added new proofs to `Relation.Binary.Construct.Add.(Infimum/Supremum/Extrema).Strict`: ```agda <±-respˡ-≡ : _<±_ Respectsˡ _≡_ <±-respʳ-≡ : _<±_ Respectsʳ _≡_ <±-resp-≡ : _<±_ Respects₂ _≡_ <±-cmp-≡ : Trichotomous _≡_ _<_ → Trichotomous _≡_ _<±_ <±-irrefl-≡ : Irreflexive _≡_ _<_ → Irreflexive _≡_ _<±_ <±-isStrictPartialOrder-≡ : IsStrictPartialOrder _≡_ _<_ → IsStrictPartialOrder _≡_ _<±_ <±-isDecStrictPartialOrder-≡ : IsDecStrictPartialOrder _≡_ _<_ → IsDecStrictPartialOrder _≡_ _<±_ <±-isStrictTotalOrder-≡ : IsStrictTotalOrder _≡_ _<_ → IsStrictTotalOrder _≡_ _<±_ ``` * In `Relation.Binary.HeterogeneousEquality` the relation `_≅_` has been generalised so that the types of the two equal elements need not be at the same universe level. * Added new proof to `Relation.Binary.PropositionalEquality.Core`: ```agda ≢-sym : Symmetric _≢_ ``` * Added new proofs to `Relation.Nullary.Construct.Add.Point`: ```agda ≡-dec : Decidable {A = A} _≡_ → Decidable {A = Pointed A} _≡_ []-injective : [ x ] ≡ [ y ] → x ≡ y ``` * Added new type and syntax to `Relation.Unary`: ```agda Recomputable P = ∀ {x} → .(P x) → P x syntax Satisfiable P = ∃⟨ P ⟩ ``` * Added new proof to `Relation.Unary.Consequences`: ```agda dec⟶recomputable : Decidable R → Recomputable R ``` * Added new aliases for `IdempotentCommutativeMonoid` in `Algebra`: ```agda BoundedLattice = IdempotentCommutativeMonoid IsBoundedLattice = IsIdempotentCommutativeMonoid ``` * Added new functions to `Function`: ```agda _$- : ((x : A) → B x) → ({x : A} → B x) λ- : ({x : A} → B x) → ((x : A) → B x) ``` * Added new definition and proof to `Axiom.Extensionality.Propositional`: ```agda ExtensionalityImplicit = (∀ {x} → f {x} ≡ g {x}) → (λ {x} → f {x}) ≡ (λ {x} → g {x}) implicit-extensionality : Extensionality a b → ExtensionalityImplicit a b ``` * Added new definition in `Relation.Nullary`: ```agda Irrelevant P = ∀ (p₁ p₂ : P) → p₁ ≡ p₂ ``` * Added new proofs to `Relation.Nullary.Decidable.Core`: ```agda dec-yes : (p? : Dec P) → P → ∃ λ p′ → p? ≡ yes p′ dec-no : (p? : Dec P) → ¬ P → ∃ λ ¬p′ → p? ≡ no ¬p′ dec-yes-irr : (p? : Dec P) → Irrelevant P → (p : P) → p? ≡ yes p ``` agda-stdlib-1.7.3/CHANGELOG/v1.2.md000066400000000000000000001037521451211343400162020ustar00rootroot00000000000000Version 1.2 =========== The library has been tested using Agda version 2.6.0.1. Highlights ---------- * New function hierarchy. * New (homo/mono/iso)morphism infrastructure for algebraic and relational structures. * Fresh lists. * First proofs of algebraic properties for operations over ℚ. * Improved reduction behaviour for all decidability proofs. Bug-fixes --------- * The record `RawRing` from `Algebra` now includes an equality relation to make it consistent with the othor `Raw` bundles. * In `Relation.Binary`: - `IsStrictTotalOrder` now exports `isDecStrictPartialOrder` - `IsDecStrictPartialOrder` now re-exports the contents of `IsStrictPartialOrder`. * Due to bug #3879 in Agda, the pattern synonyms `0F`, `1F`, ... added to `Data.Fin.Base` in version 1.1 resulted in unavoidable and undesirable behaviour when case splitting on `ℕ` when `Data.Fin` has been imported. These pattern synonyms have therefore been moved to the new module `Data.Fin.Patterns`. Non-backwards compatible changes -------------------------------- ### Standardisation of record hierarchies * The modules containing the record hierarchies for algebra, binary relations, and functions are currently inconsistently structured. For example: - in the binary relation record hierarchy the module `Relation.Binary` exports all parts of the hierarchy, e.g. `Reflexive`, `IsPreorder` and `Preorder`. - in contrast the algebra record hierarchy `Associative` is exported from `Algebra.FunctionProperties`, `IsSemigroup` from `Algebra.Structures` and `Semigroup` from `Algebra`. - the function hiearchy doesn't have a notion of `Injective` and `IsInjective` at all, and `Injection` is exported from `Function.Injection`. * Consequently all hierarchies have been re-organised to follow the same standard pattern: ```agda X.Core -- Contains: Rel, Op₂, Fun etc. X.Definitions -- Contains: Reflexive, Associative, Injective etc. X.Structures -- Contains: IsEquivalence, IsSemigroup, IsInjection etc. X.Bundles -- Contains: Setoid, Semigroup, Injection etc. X -- Publicly re-exports all of the above ``` * In `Relation.Binary` this means: * New module `Relation.Binary.Bundles` * New module `Relation.Binary.Definitions` * Fully backwards compatible. * In `Algebra` this means: * `Algebra.FunctionProperties.Core` has been deprecated in favour of `Algebra.Core`. * `Algebra.FunctionProperties` has been deprecated in favour of `Algebra.Definitions`. * The contents of `Algebra` has been moved to `Algebra.Bundles`. * `Algebra` now re-exports the contents of `Algebra.Definitions` and `Algebra.Structures`, not just that of `Algebra.Bundles`. * **Compatibility:** Modules which previously imported both `Algebra` and `Algebra.FunctionProperties` and/or `Algebra.Structures` will need small changes. - If either of `FunctionProperties` or `Structures` are explicitly parameterised by an equality relation then import `Algebra.Bundles` instead of `Algebra`. - Otherwise just remove the `FunctionProperties` and `Structures` imports entirely. ### New function hierarchy * The problems with the current function hierarchy run deeper problems than the other two: 1. The raw functions are wrapped in the equality-preserving type `_⟶_` from `Function.Equality`. As the rest of the library rarely uses such wrapped functions, it is very difficult to write code that interfaces neatly between the `Function` hierarchy and, for example, the `Algebra` hierarchy. 2. The hierarchy doesn't follow the same pattern as the other record hierarchies in the standard library, e.g. `Injective`, `IsInjection` and `Injection`. Coupled with point 1., anecdotally this means that people find it difficult to understand and use. 3. There is no way of specifying a function has a specific property (e.g. injectivity) without specifying all the properties required of the equality relation as well. This is in contrast to the `Relation.Binary` and `Algebra` hierarchies where it is perfectly possible to specify that for example an operation is commutative without providing all the proofs associated with the equality relation. 4. In many fonts the symbol `_⟶_` used for equality preserving functions is almost indistinguishable from the symbol for ordinary functions `_→_`, leading to confusion when reading code. * To address these problems a new standardised function hierarchy has been created that follows the same structure found in `Relation.Binary` and `Algebra`. In particular: - The `Fun1` and `Fun2` from `Function` have been moved to `Function.Core`. - The rest of the old contents of `Function` have been moved to `Function.Base`. - Added a new module `Function.Definitions` containing definitions like `Injective`, `Surjective` which are parameterised by the equality relations over the domain and codomain. - Added a new module `Function.Structures` containing definitions like `IsInjection`, `IsSurjection`, once again parameterised the equality relations. - New module `Function.Bundles` containing definitions like `Injection`, `Surjection` which provide essentially the same top-level interface as currently exists, i.e. parameterised by setoids but hiding the function. - The module `Function` now re-exports all of the above. * For the moment the existing modules containing the old hierarchy still exist, as not all existing functionality has been reimplemented using the new hierarchy. However it is expected that they will be deprecated at some point in the future when contents this transfer is complete. ```agda Function.Equivalence Function.Equality Function.Bijection Function.Injection Function.Surjection Function.LeftInverse ``` * **Compatibility:** As most of changes involve adding new modules, the only problem that occurs is when importing both `Function` and e.g. `Function.Injection`. In this case the old and new definitions of `Injection` will clash. In the short term this can be fixed immediately by importing `Function.Base` instead of `Function`. However in the longer term it is encouraged to migrate away from `Function.Injection` and to use the new hierarchy instead. * Finally the propositional bundle for left inverses in `Function.Bundles` has been renamed in the new hierarchy from `_↞_` to `_↩_`. This is in order to make room for the new bundle for right inverse `_↪_`. #### Harmonizing `List.All` and `Vec` in their role as finite maps. * The function `updateAt` in `Data.List.Relation.Unary.All` is analogous to `updateAt` in `Data.Vec.Base` and hence the API for the former has been refactored to match the latter. * Added a new "points-to" relation `_[_]=_` in `Data.List.Relation.Unary.All`: ```agda _[_]=_ : All P xs → x ∈ xs → P x → Set _ ``` * In `Data.List.Relation.Unary.All.Properties` the proofs `updateAt-cong` and `updateAt-updates` are now formulated in terms of the new `_[_]=_` relation rather than the function `lookup`. The old proofs are available with minor variations under the names `lookup∘updateAt` and `updateAt-cong-relative`. #### Other * Version 1.1 in the library added irrelevance to various places in the library. Unfortunately this exposed the library to several irrelevance-related bugs. The decision has therefore been taken to roll-back these additions until irrelevance is more stable. In particular it has been removed from `_%_`, `_/_`, `_div_`, `_mod_` in `Data.Nat.DivMod` and from `fromℕ≤`, `inject≤` in `Data.Fin.Base`. * The proofs `isPreorder` and `preorder` have been moved from the `Setoid` record to the module `Relation.Binary.Properties.Setoid`. * The function `normalize` in `Data.Rational.Base` has been reimplemented in terms of a direct division of the numerator and denominator by their GCD. Although less elegant than the previous implementation, it's reduction behaviour is much easier to reason about. Re-implementations and deprecations ------------------------------- ### `Data.Bin` → `Data.Nat.Binary` * The current implementation of binary naturals in Agda has proven hard to work with. Therefore a new, simpler implementation which avoids using `List` has been added as `Data.Nat.Binary`. ```agda Data.Nat.Binary Data.Nat.Binary.Base Data.Nat.Binary.Induction Data.Nat.Binary.Properties ``` * The old modules still exist but have been deprecated and may be removed in some future release of the library. ```agda Data.Bin Data.Bin.Properties ``` ### `Data.Table` → `Data.Vec.Functional` * As well as having a non-standard name, the definition of `Table` in `Data.Table` has proved very difficult to work with due to the wrapping of the type in a record. It has therefore been renamed and reimplemented without the record wrapper as the `Vector` type in the new module `Data.Vec.Functional`, ```agda Data.Vec.Functional Data.Vec.Functional.Relation.Binary.Pointwise Data.Vec.Functional.Relation.Unary.All Data.Vec.Functional.Relation.Unary.Any ``` * The old modules still exist but have been deprecated and may be removed in some future release of the library. ```agda Data.Table Data.Table.Base Data.Table.Properties Data.Table.Relation.Equality ``` ### `Data.BoundedVec(.Inefficient)` → `Data.Vec.Bounded` * `Data.BoundedVec` and `Data.BoundedVec.Inefficient` have been deprecated in favour of `Data.Vec.Bounded` introduced in version 1.1. ```agda Data.Vec.Bounded Data.Vec.Bounded.Base ``` * The old modules still exist but have been deprecated and may be removed in some future release of the library. ```agda Data.BoundedVec Data.BoundedVec.Inefficient ``` Other major additions --------------------- ### `Reflects` idiom for decidability proofs * A version of the `Reflects` idiom, as seen in SSReflect, has been introduced in `Relation.Nullary`. Some properties of it have been added in the new module `Relation.Nullary.Reflects`. The definition is as follows ```agda data Reflects {p} (P : Set p) : Bool → Set p where ofʸ : ( p : P) → Reflects P true ofⁿ : (¬p : ¬ P) → Reflects P false ``` * `Dec` has been redefined in terms of `Reflects`. ```agda record Dec {p} (P : Set p) : Set p where constructor _because_ field does : Bool proof : Reflects P does open Dec public ``` which is entirely backwards compatible thanks to the introduction of the pattern synonyms in `Relation.Nullary`: ```agda pattern yes p = true because ofʸ p pattern no ¬p = false because ofⁿ ¬p ``` * These changes mean that decision procedures can be defined so as to provide a boolean result that is independent of the proof that it is the correct decision. For example, a proof of decidability of `_≤_` on natural numbers: ```agda _≤?_ : (m n : ℕ) → Dec (m ≤ n) zero ≤? n = yes z≤n suc m ≤? zero = no λ () suc m ≤? suc n with m ≤? n ... | yes p = yes (s≤s p) ... | no ¬p = no (¬p ∘ ≤-pred) ``` can now be rewritten as: ```agda _≤?_ : (m n : ℕ) → Dec (m ≤ n) zero ≤? n = yes z≤n suc m ≤? zero = no λ () does (suc m ≤? suc n) = does (m ≤? n) proof (suc m ≤? suc n) with m ≤? n ... | yes p = ofʸ (s≤s p) ... | no ¬p = ofⁿ (¬p ∘ ≤-pred) ``` Notice that projecting the `does` field, returns a function whose reduction behaviour is identically to what we would expect of a boolean test. This has significant advantages for both performance and reasoning in situations where only a decision is required and the proof itself is not needed. * Functions and lemmas about `Dec` have been rewritten to reflect these changes. - The lemmas `map′` and `map` in `Relation.Nullary.Decidable` produce their `does` result without any pattern matching, and `isYes` matches only on the `does` field, and not the `proof` field. For example this means that `does (map f X?)` is definitionally equal to `does X?`. - All of the connective lemmas like `_×-dec_` have a `does` field written in terms of boolean functions like `_∧_`. As well as being less strict than the previous definitions, this should improve readability when only the `does` field is involved. * The function `⌊_⌋` still exists to be used in conjunction with `toWitness` and similar (e.g. in proof automation), but doesn't require the immediate evaluation of the `proof` part. * The rest of the `Relation.Nullary` subtree has been updated to reflect the changes to `Dec`. ### Other new modules * Properties for `Semigroup` and `CommutativeSemigroup`. Contains all the non-trivial 3 element permutations. Useful for equational reasoning. ```agda Algebra.Properties.Semigroup Algebra.Properties.CommutativeSemigroup ``` * A map interface for AVL trees. ```agda Data.AVL.Map ``` * Level polymorphic versions for the bottom and top types. Useful in getting rid of the need to use `Lift`. ```agda Data.Unit.Polymorphic Data.Unit.Polymorphic.Properties Data.Empty.Polymorphic ``` * Greatest common divisor and least common multiples for integers: ```agda Data.Integer.GCD Data.Integer.LCM ``` * Fresh lists. ```agda Data.List.Fresh Data.List.Fresh.Properties Data.List.Fresh.Relation.Unary.All Data.List.Fresh.Relation.Unary.All.Properties Data.List.Fresh.Relation.Unary.Any Data.List.Fresh.Relation.Unary.Any.Properties Data.List.Fresh.Membership Data.List.Fresh.Membership.Properties ``` * Kleene lists. Useful when needing to distinguish between empty and non-empty lists. ```agda Data.List.Kleene Data.List.Kleene.AsList Data.List.Kleene.Base ``` * Predicate over lists in which every neighbouring pair of elements is related. Useful for implementing paths in graphs. ```agda Data.List.Relation.Unary.Linked Data.List.Relation.Unary.Linked.Properties ``` * Disjoint sublists. ```agda Data.List.Relation.Binary.Sublist.Propositional.Disjoint ``` * Rationals whose numerator and denominator are not necessarily normalised (i.e. coprime). ``` Data.Rational.Unnormalised Data.Rational.Unnormalised.Properties ``` In this formalisation every number has an infinite number of multiple representations and that evaluation is inefficient as the top and the bottom will inevitably blow up. However they are significantly easier to reason about then the existing normalised implementation in `Data.Rational`. The new monomorphism infrastructure (see below) is used to transfer proofs from these new unnormalised rationals to the existing normalised implementation. * Basic constructions for the new funciton hierarchy. ```agda Function.Construct.Identity Function.Construct.Composition ``` * New interfaces for using Haskell datatypes: ``` Foreign.Haskell.Coerce Foreign.Haskell.Either ``` * Properties of setoids. ```agda Relation.Binary.Properties.Setoid ``` * Reasoning over partial setoids. ``` Relation.Binary.Reasoning.Base.Partial Relation.Binary.Reasoning.PartialSetoid ``` * Morphisms between algebraic and relational structures. See `Data.Rational.Properties` for how these can be used to easily transfer algebraic properties from unnormalised to normalised rationals. ```agda Algebra.Morphism.Definitions Algebra.Morphism.Structures Algebra.Morphism.MagmaMonomorphism Algebra.Morphism.MonoidMonomorphism Relation.Binary.Morphism Relation.Binary.Morphism.Definitions Relation.Binary.Morphism.Structures Relation.Binary.Morphism.RelMonomorphism Relation.Binary.Morphism.OrderMonomorphism ``` Deprecated names ---------------- The following deprecations have occurred as part of a drive to improve consistency across the library. The deprecated names still exist and therefore all existing code should still work, however use of the new names is encouraged. Although not anticipated any time soon, they may eventually be removed in some future release of the library. Automated warnings are attached to all deprecated names to discourage their use. * In `Data.Fin`: ```agda fromℕ≤ ↦ fromℕ< fromℕ≤″ ↦ fromℕ<″ ``` * In `Data.Fin.Properties` ```agda fromℕ≤-toℕ ↦ fromℕ<-toℕ toℕ-fromℕ≤ ↦ toℕ-fromℕ< fromℕ≤≡fromℕ≤″ ↦ fromℕ<≡fromℕ<″ toℕ-fromℕ≤″ ↦ toℕ-fromℕ<″ isDecEquivalence ↦ ≡-isDecEquivalence preorder ↦ ≡-preorder setoid ↦ ≡-setoid decSetoid ↦ ≡-decSetoid ``` * In `Data.Integer.Properties`: ```agda [1+m]*n≡n+m*n ↦ suc-* ``` * In `Data.Nat.Coprimality`: ```agda coprime-gcd ↦ coprime⇒GCD≡1 gcd-coprime ↦ GCD≡1⇒coprime ``` * In `Data.Nat.Properties`: ```agda +-*-suc ↦ *-suc n∸m≤n ↦ m∸n≤m ``` (Note that the latter will require the arguments to be reversed) * In `Data.Unit` the definition `_≤_` is unnecessary as it is isomorphic to `_≡_` and has therefore been deprecated. * In `Data.Unit.Properties` the associated proofs have therefore been renamed as follows: ```agda ≤-total ↦ ≡-total _≤?_ ↦ _≟_ ≤-isPreorder ↦ ≡-isPreorder ≤-isPartialOrder ↦ ≡-isPartialOrder ≤-isTotalOrder ↦ ≡-isTotalOrder ≤-isDecTotalOrder ↦ ≡-isDecTotalOrder ≤-poset ↦ ≡-poset ≤-decTotalOrder ↦ ≡-decTotalOrder ``` * In `Relation.Binary.Properties.Poset`: ```agda invIsPartialOrder ↦ ≥-isPartialOrder invPoset ↦ ≥-poset strictPartialOrder ↦ <-strictPartialOrder ``` * In `Relation.Binary.Properties.DecTotalOrder`: ```agda strictTotalOrder ↦ <-strictTotalOrder ``` Other minor additions --------------------- * Added new definition to `Algebra.Bundles`: ```agda record CommutativeSemigroup c ℓ : Set (suc (c ⊔ ℓ)) ``` * Added new definition to `Algebra.Structures`: ```agda record IsCommutativeSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) ``` * The function `tail` in `Codata.Stream` has a new, more general type: ```agda tail : ∀ {i} {j : Size< i} → Stream A i → Stream A j ``` * Added new proofs to `Data.Char.Properties`: ```agda <-isStrictPartialOrder-≈ : IsStrictPartialOrder _≈_ _<_ <-isStrictTotalOrder-≈ : IsStrictTotalOrder _≈_ _<_ <-strictPartialOrder-≈ : StrictPartialOrder 0ℓ 0ℓ 0ℓ ``` * Added new proofs to `Data.Fin.Properties`: ```agda ∀-cons-⇔ : (P zero × Π[ P ∘ suc ]) ⇔ Π[ P ] ∃-here : P zero → ∃⟨ P ⟩ ∃-there : ∃⟨ P ∘ suc ⟩ → ∃⟨ P ⟩ ∃-toSum : ∃⟨ P ⟩ → P zero ⊎ ∃⟨ P ∘ suc ⟩ ⊎⇔∃ : (P zero ⊎ ∃⟨ P ∘ suc ⟩) ⇔ ∃⟨ P ⟩ ``` * Added new proofs to `Data.Fin.Subset.Properties`: ```agda out⊆ : p ⊆ q → outside ∷ p ⊆ y ∷ q out⊆-⇔ : p ⊆ q ⇔ outside ∷ p ⊆ y ∷ q in⊆in : p ⊆ q → inside ∷ p ⊆ inside ∷ q in⊆in-⇔ : p ⊆ q ⇔ inside ∷ p ⊆ inside ∷ q ∃-Subset-zero : ∃⟨ P ⟩ → P [] ∃-Subset-[]-⇔ : P [] ⇔ ∃⟨ P ⟩ ∃-Subset-suc : ∃⟨ P ⟩ → ∃⟨ P ∘ (inside ∷_) ⟩ ⊎ ∃⟨ P ∘ (outside ∷_) ⟩ ∃-Subset-∷-⇔ : (∃⟨ P ∘ (inside ∷_) ⟩ ⊎ ∃⟨ P ∘ (outside ∷_) ⟩) ⇔ ∃⟨ P ⟩ ``` * Added new constants to `Data.Integer.Base`: ```agda -1ℤ = -[1+ 0 ] 0ℤ = +0 1ℤ = +[1+ 0 ] ``` * Added new proofs to `Data.Integer.Properties`: ```agda *-suc : m * sucℤ n ≡ m + m * n +-isCommutativeSemigroup : IsCommutativeSemigroup _+_ *-isCommutativeSemigroup : IsCommutativeSemigroup _*_ +-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ *-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ ``` * Added new function to `Data.List.Base`: ```agda _ʳ++_ = flip reverseAcc ``` * Added new proofs to `Data.List.Properties`: ```agda filter-accept : P x → filter P? (x ∷ xs) ≡ x ∷ (filter P? xs) filter-reject : ¬ P x → filter P? (x ∷ xs) ≡ filter P? xs filter-idem : filter P? ∘ filter P? ≗ filter P? filter-++ : filter P? (xs ++ ys) ≡ filter P? xs ++ filter P? ys ʳ++-defn : xs ʳ++ ys ≡ reverse xs ++ ys ʳ++-++ : (xs ++ ys) ʳ++ zs ≡ ys ʳ++ xs ʳ++ zs ʳ++-ʳ++ : (xs ʳ++ ys) ʳ++ zs ≡ ys ʳ++ xs ++ zs length-ʳ++ : length (xs ʳ++ ys) ≡ length xs + length ys map-ʳ++ : map f (xs ʳ++ ys) ≡ map f xs ʳ++ map f ys foldr-ʳ++ : foldr f b (xs ʳ++ ys) ≡ foldl (flip f) (foldr f b ys) xs foldl-ʳ++ : foldl f b (xs ʳ++ ys) ≡ foldl f (foldr (flip f) b xs) ys ``` * Added new definitions to `Data.List.Relation.Binary.Lex.Core`: ```agda []<[]-⇔ : P ⇔ [] < [] toSum : (x ∷ xs) < (y ∷ ys) → (x ≺ y ⊎ (x ≈ y × xs < ys)) ∷<∷-⇔ : (x ≺ y ⊎ (x ≈ y × xs < ys)) ⇔ (x ∷ xs) < (y ∷ ys) ``` * The proof `toAny` in `Data.List.Relation.Binary.Sublist.Heterogeneous` has a new more general type: ```agda toAny : Sublist R (a ∷ as) bs → Any (R a) bs ``` * Added new relations to `Data.List.Relation.Binary.Sublist.Heterogeneous`: ```agda Disjoint (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) DisjointUnion (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) (τ : xys ⊆ zs) ``` * Added new relations and definitions to `Data.List.Relation.Binary.Sublist.Setoid`: ```agda xs ⊇ ys = ys ⊆ xs xs ⊈ ys = ¬ (xs ⊆ ys) xs ⊉ ys = ¬ (xs ⊇ ys) UpperBound (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) ⊆-disjoint-union : Disjoint τ σ → UpperBound τ σ ``` * Added new proofs to `Data.List.Relation.Binary.Sublist.Setoid.Properties`: ```agda shrinkDisjointˡ : Disjoint τ₁ τ₂ → Disjoint (⊆-trans σ τ₁) τ₂ shrinkDisjointʳ : Disjoint τ₁ τ₂ → Disjoint τ₁ (⊆-trans σ τ₂) ``` * Added new definitions to `Data.List.Relation.Binary.Sublist.Propositional`: ```agda separateˡ : (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → Separation τ₁ τ₂ ``` * Added new proofs to `Data.List.Relation.Binary.Sublist.Propositional.Properties`: ```agda ⊆-trans-idˡ : ⊆-trans ⊆-refl τ ≡ τ ⊆-trans-idʳ : ⊆-trans τ ⊆-refl ≡ τ ⊆-trans-assoc : ⊆-trans τ₁ (⊆-trans τ₂ τ₃) ≡ ⊆-trans (⊆-trans τ₁ τ₂) τ₃ All-resp-⊆ : (All P) Respects _⊇_ Any-resp-⊆ : (Any P) Respects _⊆_ All-resp-⊆-refl : All-resp-⊆ ⊆-refl ≗ id All-resp-⊆-trans : All-resp-⊆ (⊆-trans τ τ′) ≗ All-resp-⊆ τ ∘ All-resp-⊆ τ′ Any-resp-⊆-refl : Any-resp-⊆ ⊆-refl ≗ id Any-resp-⊆-trans : Any-resp-⊆ (⊆-trans τ τ′) ≗ Any-resp-⊆ τ′ ∘ Any-resp-⊆ τ lookup-injective : lookup τ i ≡ lookup τ j → i ≡ j ``` * Added new definition to `Data.List.Relation.Binary.Pointwise`: ```agda uncons : Pointwise _∼_ (x ∷ xs) (y ∷ ys) → x ∼ y × Pointwise _∼_ xs ys ``` * Added new definitions to `Data.List.Relation.Unary.All`: ```agda Null = All (λ _ → ⊥) ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda Null⇒null : Null xs → T (null xs) null⇒Null : T (null xs) → Null xs []=-injective : pxs [ i ]= px → pxs [ i ]= qx → px ≡ qx []=lookup : (i : x ∈ xs) → pxs [ i ]= lookup pxs i []=⇒lookup : pxs [ i ]= px → lookup pxs i ≡ px lookup⇒[]= : lookup pxs i ≡ px → pxs [ i ]= px updateAt-minimal : i ≢∈ j → pxs [ i ]= px → updateAt j f pxs [ i ]= px updateAt-id-relative : f (lookup pxs i) ≡ lookup pxs i → updateAt i f pxs ≡ pxs updateAt-compose-relative : f (g (lookup pxs i)) ≡ h (lookup pxs i) → updateAt i f (updateAt i g pxs) ≡ updateAt i h pxs updateAt-commutes : i ≢∈ j → updateAt i f ∘ updateAt j g ≗ updateAt j g ∘ updateAt i f ``` * The proof `All-swap` in `Data.List.Relation.Unary.All.Properties` has been generalised to work over `_~_ : REL A B ℓ` instead of just `_~_ : REL (List A) B ℓ`. * Added new definition to `Data.List.Relation.Unary.AllPairs`: ```agda uncons : AllPairs R (x ∷ xs) → All (R x) xs × AllPairs R xs ``` * Added new proofs to `Data.Nat.Coprimality`: ```agda coprime⇒gcd≡1 : Coprime m n → gcd m n ≡ 1 gcd≡1⇒coprime : gcd m n ≡ 1 → Coprime m n coprime-/gcd : Coprime (m / gcd m n) (n / gcd m n) ``` * Added new proof to `Data.Nat.Divisibility`: ```agda >⇒∤ : m > suc n → m ∤ suc n ``` * Added new proofs to `Data.Nat.DivMod`: ```agda /-congˡ : m ≡ n → m / o ≡ n / o /-congʳ : n ≡ o → m / n ≡ m / o /-mono-≤ : m ≤ n → o ≥ p → m / o ≤ n / p /-monoˡ-≤ : m ≤ n → m / o ≤ n / o /-monoʳ-≤ : n ≥ o → m / n ≤ m / o m≥n⇒m/n>0 : m ≥ n → m / n > 0 ``` * Added new proofs to `Data.Nat.GCD`: ```agda gcd[m,n]≡0⇒m≡0 : gcd m n ≡ 0 → m ≡ 0 gcd[m,n]≡0⇒n≡0 : gcd m n ≡ 0 → n ≡ 0 gcd[m,n]≤n : gcd m (suc n) ≤ suc n n/gcd[m,n]≢0 : {n≢0 gcd≢0} → n / gcd m n ≢ 0 GCD-* : GCD (m * suc c) (n * suc c) (d * suc c) → GCD m n d GCD-/ : c ∣ m → c ∣ n → c ∣ d → GCD m n d → GCD (m / c) (n / c) (d / c) GCD-/gcd : GCD (m / gcd m n) (n / gcd m n) 1 ``` * Added new proofs to `Data.Nat.Properties`: ```agda 0≢1+n : 0 ≢ suc n 1+n≢n : suc n ≢ n even≢odd : 2 * m ≢ suc (2 * n) 0<1+n : 0 < suc n n<1+n : n < suc n m 0 → m < m + n mn⇒m∸n≢0 : m > n → m ∸ n ≢ 0 ∣-∣-identityˡ : LeftIdentity 0 ∣_-_∣ ∣-∣-identityʳ : RightIdentity 0 ∣_-_∣ ∣-∣-identity : Identity 0 ∣_-_∣ m≤n+∣n-m∣ : m ≤ n + ∣ n - m ∣ m≤n+∣m-n∣ : m ≤ n + ∣ m - n ∣ m≤∣m-n∣+n : m ≤ ∣ m - n ∣ + n +-isCommutativeSemigroup : IsCommutativeSemigroup _+_ +-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ ``` * Added new bundles to `Data.String.Properties`: ```agda <-isStrictPartialOrder-≈ : IsStrictPartialOrder _≈_ _<_ <-isStrictTotalOrder-≈ : IsStrictTotalOrder _≈_ _<_ <-strictPartialOrder-≈ : StrictPartialOrder 0ℓ 0ℓ 0ℓ ``` * Added new functions to `Data.Rational.Base`: ```agda mkℚ+ : ∀ n d → .{d≢0 : d ≢0} → .(Coprime n d) → ℚ toℚᵘ : ℚ → ℚᵘ fromℚᵘ : ℚᵘ → ℚ ``` * Added new proofs to `Data.Rational.Properties`: ```agda mkℚ-cong : n₁ ≡ n₂ → d₁ ≡ d₂ → mkℚ n₁ d₁ c₁ ≡ mkℚ n₂ d₂ c₂ mkℚ+-cong : n₁ ≡ n₂ → d₁ ≡ d₂ → mkℚ+ n₁ d₁ c₁ ≡ mkℚ+ n₂ d₂ c₂ normalize-coprime : .(c : Coprime n (suc d-1)) → normalize n (suc d-1) ≡ mkℚ (+ n) d-1 c ↥-mkℚ+ : ↥ (mkℚ+ n d c) ≡ + n ↧-mkℚ+ : ↧ (mkℚ+ n d c) ≡ + d ↥-neg : ↥ (- p) ≡ - (↥ p) ↧-neg : ↧ (- p) ≡ ↧ p ↥-normalise : ↥ (normalize i n) * gcd (+ i) (+ n) ≡ + i ↧-normalise : ↧ (normalize i n) * gcd (+ i) (+ n) ≡ + n ↥-/ : ↥ (i / n) * gcd i (+ n) ≡ i ↧-/ : ↧ (i / n) * gcd i (+ n) ≡ + n ↥-+ : ↥ (p + q) * gcd (...) (...) ≡ ↥ p * ↧ q ℤ.+ ↥ q * ↧ p ↧-+ : ↧ (p + q) * gcd (...) (...) ≡ ↧ p * ↧ q ↥p/↧p≡p : ↥ p / ↧ₙ p ≡ p 0/n≡0 : 0ℤ / n ≡ 0ℚ toℚᵘ-cong : toℚᵘ Preserves _≡_ ⟶ _≃ᵘ_ toℚᵘ-injective : Injective _≡_ _≃ᵘ_ toℚᵘ fromℚᵘ-toℚᵘ : fromℚᵘ (toℚᵘ p) ≡ p toℚᵘ-homo-+ : Homomorphic₂ toℚᵘ _+_ ℚᵘ._+_ toℚᵘ-+-isRawMagmaMorphism : IsRawMagmaMorphism +-rawMagma ℚᵘ.+-rawMagma toℚᵘ toℚᵘ-+-isRawMonoidMorphism : IsRawMonoidMorphism +-rawMonoid ℚᵘ.+-rawMonoid toℚᵘ +-assoc : Associative _+_ +-comm : Commutative _+_ +-identityˡ : LeftIdentity 0ℚ _+_ +-identityʳ : RightIdentity 0ℚ _+_ +-identity : Identity 0ℚ _+_ +-isMagma : IsMagma _+_ +-isSemigroup : IsSemigroup _+_ +-0-isMonoid : IsMonoid _+_ 0ℚ +-0-isCommutativeMonoid : IsCommutativeMonoid _+_ 0ℚ +-rawMagma : RawMagma 0ℓ 0ℓ +-rawMonoid : RawMonoid 0ℓ 0ℓ +-magma : Magma 0ℓ 0ℓ +-semigroup : Semigroup 0ℓ 0ℓ +-0-monoid : Monoid 0ℓ 0ℓ +-0-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ ``` * Added new functions to `Data.Sum.Base`: ```agda fromInj₁ : (B → A) → A ⊎ B → A fromInj₂ : (A → B) → A ⊎ B → B ``` * Added new definition to `Data.These.Properties`: ```agda these-injective : these x a ≡ these y b → x ≡ y × a ≡ b ``` * Added new definition to `Data.Vec.Relation.Binary.Pointwise.Inductive`: ```agda uncons : Pointwise _∼_ (x ∷ xs) (y ∷ ys) → x ∼ y × Pointwise _∼_ xs ys ``` * Added new definition to `Data.Vec.Relation.Unary.All`: ```agda uncons : All P (x ∷ xs) → P x × All P xs ``` * Added new functions to `Level`. ```agda levelOfType : ∀ {a} → Set a → Level levelOfTerm : ∀ {a} {A : Set a} → A → Level ``` * Added new proofs to `Relation.Binary.PropositionalEquality`: ```agda isMagma : (_∙_ : Op₂ A) → IsMagma _≡_ _∙_ magma : (_∙_ : Op₂ A) → Magma a a ``` * Added new definition to `Relation.Binary.Structures`: ```agda record IsPartialEquivalence (_≈_ : Rel A ℓ) : Set (a ⊔ ℓ) ``` * Added new definition to `Relation.Binary.Bundles`: ```agda record PartialSetoid a ℓ : Set (suc (a ⊔ ℓ)) ``` * Added new proofs to `Relation.Binary.Construct.NonStrictToStrict`: ```agda <⇒≉ : x < y → x ≉ y ≤∧≉⇒< : x ≤ y → x ≉ y → x < y <⇒≱ : Antisymmetric _≈_ _≤_ → ∀ {x y} → x < y → ¬ (y ≤ x) ≤⇒≯ : Antisymmetric _≈_ _≤_ → ∀ {x y} → x ≤ y → ¬ (y < x) ≰⇒> : Symmetric _≈_ → (_≈_ ⇒ _≤_) → Total _≤_ → ∀ {x y} → ¬ (x ≤ y) → y < x ≮⇒≥ : Symmetric _≈_ → Decidable _≈_ → _≈_ ⇒ _≤_ → Total _≤_ → ∀ {x y} → ¬ (x < y) → y ≤ x ``` * Each of the following modules now re-export relevant proofs and relations from the previous modules in the list. ``` Relation.Binary.Properties.Preorder Relation.Binary.Properties.Poset Relation.Binary.Properties.TotalOrder Relation.Binary.Properties.DecTotalOrder ``` * Added new relations and proofs to `Relation.Binary.Properties.Poset`: ```agda x ≥ y = y ≤ x x < y = ¬ (y ≈ x) <⇒≉ : x < y → x ≉ y ≤∧≉⇒< : x ≤ y → x ≉ y → x < y <⇒≱ : x < y → ¬ (y ≤ x) ≤⇒≯ : x ≤ y → ¬ (y < x) ``` * Added new proof to `Relation.Binary.Properties.TotalOrder`: ```agda ≰⇒> : ¬ (x ≤ y) → y < x ``` * Added new proof to `Relation.Binary.Properties.DecTotalOrder`: ```agda ≮⇒≥ : ¬ (x < y) → y ≤ x ``` * Added new proof to `Relation.Binary.PropositionalEquality`: ```agda isDecEquivalence : Decidable _≡_ → IsDecEquivalence _≡_ ``` * Added new definitions to `Relation.Nary`: ```agda apply⊤ₙ : Π[ R ] → (vs : Product⊤ n as) → uncurry⊤ₙ n R vs applyₙ : Π[ R ] → (vs : Product n as) → uncurry⊤ₙ n R (toProduct⊤ n vs) iapply⊤ₙ : ∀[ R ] → {vs : Product⊤ n as} → uncurry⊤ₙ n R vs iapplyₙ : ∀[ R ] → {vs : Product n as} → uncurry⊤ₙ n R (toProduct⊤ n vs) Decidable : as ⇉ Set r → Set (r ⊔ ⨆ n ls) ⌊_⌋ : Decidable R → as ⇉ Set r fromWitness : (R : as ⇉ Set r) (R? : Decidable R) → ∀[ ⌊ R? ⌋ ⇒ R ] toWitness : (R : as ⇉ Set r) (R? : Decidable R) → ∀[ R ⇒ ⌊ R? ⌋ ] ``` * Added new definitions to `Relation.Unary`: ```agda ⌊_⌋ : {P : Pred A ℓ} → Decidable P → Pred A ℓ ``` * Added new definitions to `Relation.Binary.Construct.Closure.Reflexive.Properties`: ```agda fromSum : a ≡ b ⊎ a ~ b → Refl _~_ a b toSum : Refl _~_ a b → a ≡ b ⊎ a ~ b ⊎⇔Refl : (a ≡ b ⊎ a ~ b) ⇔ Refl _~_ a b ``` * Added new definitions to `Relation.Nullary.Decidable`: ```agda dec-true : (p? : Dec P) → P → does p? ≡ true dec-false : (p? : Dec P) → ¬ P → does p? ≡ false ``` * Added new definition to `Relation.Nullary.Implication`: ```agda _→-reflects_ : Reflects P bp → Reflects Q bq → Reflects (P → Q) (not bp ∨ bq) ``` * Added new definition to `Relation.Nullary.Negation`: ```agda ¬-reflects : Reflects P b → Reflects (¬ P) (not b) ``` * Added new definition to `Relation.Nullary.Product`: ```agda _×-reflects_ : Reflects P bp → Reflects Q bq → Reflects (P × Q) (bp ∧ bq) ``` * Added new definition to `Relation.Nullary.Sum`: ```agda _⊎-reflects_ : Reflects P bp → Reflects Q bq → Reflects (P ⊎ Q) (bp ∨ bq) ``` * The module `Size` now re-exports the built-in function: ```agda _⊔ˢ_ : Size → Size → Size ``` agda-stdlib-1.7.3/CHANGELOG/v1.3.md000066400000000000000000001074401451211343400162010ustar00rootroot00000000000000Version 1.3 =========== The library has been tested using Agda version 2.6.1. Highlights ---------- * Monoid and ring tactics that are capable of solving equalities without having to restate the equation. * Binary and rose trees. * Warnings when importing deprecated modules. Bug-fixes --------- * In `Data.Fin.Subset.Properties` the incorrectly named proof `p⊆q⇒∣p∣<∣q∣ : p ⊆ q → ∣ p ∣ ≤ ∣ q ∣` has been renamed to `p⊆q⇒∣p∣≤∣q∣`. * In `Data.Nat.Properties` the incorrectly named proofs `∀[m≤n⇒m≢o]⇒o 0 → m < n + m ∸-cancelʳ-≡ : o ≤ m → o ≤ n → m ∸ o ≡ n ∸ o → m ≡ n ⌊n/2⌋+⌈n/2⌉≡n : ⌊ n /2⌋ + ⌈ n /2⌉ ≡ n ⌊n/2⌋≤n : ⌊ n /2⌋ ≤ n ⌊n/2⌋_ : String → String → String padLeft : Char → ℕ → String → String padRight : Char → ℕ → String → String padBoth : Char → Char → ℕ → String → String rectangle : Vec (ℕ → String → String) n → Vec String n → Vec String n rectangleˡ : Char → Vec String n → Vec String n rectangleʳ : Char → Vec String n → Vec String n rectangleᶜ : Char → Char → Vec String n → Vec String n ``` * Added new proofs to `Data.String.Unsafe`: ```agda toList-++ : toList (s ++ t) ≡ toList s ++ toList t length-++ : length (s ++ t) ≡ length s + length t length-replicate : length (replicate n c) ≡ n ``` * Added new proof to `Data.Sum.Properties`: ```agda [,]-∘-distr : f ∘ [ g , h ] ≗ [ f ∘ g , f ∘ h ] [,]-map-commute : [ f′ , g′ ] ∘ (map f g) ≗ [ f′ ∘ f , g′ ∘ g ] map-commute : ((map f′ g′) ∘ (map f g)) ≗ map (f′ ∘ f) (g′ ∘ g) ``` * Improved the universe polymorphism of `Data.Product.Relation.Binary.Lex.Strict/NonStrict` so that the equality and order relations need not live at the same universe level. * Added new proofs to `Data.Product.Relation.Binary.Lex.Strict`: ``` ×-wellFounded : WellFounded _<₁_ → WellFounded _<₂_ → WellFounded _<ₗₑₓ_ ``` * Added new proofs to `Data.Rational.Properties`: ```agda ↥-* : ↥ (p * q) ℤ.* *-nf p q ≡ ↥ p ℤ.* ↥ q ↧-* : ↧ (p * q) ℤ.* *-nf p q ≡ ↧ p ℤ.* ↧ q toℚᵘ-homo-* : Homomorphic₂ toℚᵘ _*_ ℚᵘ._*_ toℚᵘ-isMagmaHomomorphism-* : IsMagmaHomomorphism *-rawMagma ℚᵘ.*-rawMagma toℚᵘ toℚᵘ-isMonoidHomomorphism-* : IsMonoidHomomorphism *-rawMonoid ℚᵘ.*-rawMonoid toℚᵘ toℚᵘ-isMonoidMonomorphism-* : IsMonoidMonomorphism *-rawMonoid ℚᵘ.*-rawMonoid toℚᵘ toℚᵘ-homo‿- : Homomorphic₁ toℚᵘ (-_) (ℚᵘ.-_) toℚᵘ-isGroupHomomorphism-+ : IsGroupHomomorphism +-0-rawGroup ℚᵘ.+-0-rawGroup toℚᵘ toℚᵘ-isGroupMonomorphism-+ : IsGroupMonomorphism +-0-rawGroup ℚᵘ.+-0-rawGroup toℚᵘ toℚᵘ-isRingHomomorphism-|-* : IsRingHomomorphism +-*-rawRing ℚᵘ.+-*-rawRing toℚᵘ toℚᵘ-isRingMonomorphism-|-* : IsRingMonomorphism +-*-rawRing ℚᵘ.+-*-rawRing toℚᵘ *-assoc : Associative _*_ *-comm : Commutative _*_ *-identityˡ : LeftIdentity 1ℚ _*_ *-identityʳ : RightIdentity 1ℚ _*_ *-identity : Identity 1ℚ _*_ +-inverseˡ : LeftInverse 0ℚ -_ _+_ +-inverseʳ : RightInverse 0ℚ -_ _+_ +-inverse : Inverse 0ℚ -_ _+_ -‿cong : Congruent₁ (-_) *-isMagma : IsMagma _*_ *-isSemigroup : IsSemigroup _* *-1-isMonoid : IsMonoid _*_ 1ℚ *-1-isCommutativeMonoid : IsCommutativeMonoid _*_ 1ℚ *-rawMagma : RawMagma 0ℓ 0ℓ *-rawMonoid : RawMonoid 0ℓ 0ℓ +-0-rawGroup : RawGroup 0ℓ 0ℓ +-*-rawRing : RawRing 0ℓ 0ℓ +-0-isGroup : IsGroup _+_ 0ℚ (-_) +-0-isAbelianGroup : IsAbelianGroup _+_ 0ℚ (-_) +-0-isRing : IsRing _+_ _*_ -_ 0ℚ 1ℚ +-0-group : Group 0ℓ 0ℓ +-0-abelianGroup : AbelianGroup 0ℓ 0ℓ *-distribˡ-+ : _*_ DistributesOverˡ _+_ *-distribʳ-+ : _*_ DistributesOverʳ _+_ *-distrib-+ : _*_ DistributesOver _+_ *-magma : Magma 0ℓ 0ℓ *-semigroup : Semigroup 0ℓ 0ℓ *-1-monoid : Monoid 0ℓ 0ℓ *-1-commutativeMonoid : CommutativeMonoid 0ℓ 0ℓ +-*-isRing : IsRing _+_ _*_ -_ 0ℚ 1ℚ +-*-ring : Ring 0ℓ 0ℓ ``` * Added new proofs to `Data.Rational.Unnormalised.Properties`: ```agda +-inverseˡ : LeftInverse _≃_ 0ℚᵘ -_ _+_ +-inverseʳ : RightInverse _≃_ 0ℚᵘ -_ _+_ +-inverse : Inverse _≃_ 0ℚᵘ -_ _+_ -‿cong : Congruent₁ _≃_ (-_) +-0-isGroup : IsGroup _≃_ _+_ 0ℚᵘ (-_) +-0-group : Group 0ℓ 0ℓ +-0-isAbelianGroup : IsAbelianGroup _≃_ _+_ 0ℚᵘ (-_) +-0-abelianGroup : AbelianGroup 0ℓ 0ℓ *-zeroˡ : LeftZero _≃_ 0ℚᵘ _*_ *-zeroʳ : RightZero _≃_ 0ℚᵘ _*_ *-zero : Zero _≃_ 0ℚᵘ _*_ *-distribˡ-+ : _DistributesOverˡ_ _≃_ _*_ _+_ *-distribʳ-+ : _DistributesOverʳ_ _≃_ _*_ _+_ *-distrib-+ : _DistributesOver_ _≃_ _*_ _+_ +-*-isRing : IsRing _≃_ _+_ _*_ -_ 0ℚᵘ 1ℚ +-*-ring : Ring 0ℓ 0ℓ +-0-rawGroup : RawGroup 0ℓ 0ℓ +-*-rawRing : RawRing 0ℓ 0ℓ +-*-isCommutativeRing : IsCommutativeRing _≃_ _+_ _*_ -_ 0ℚᵘ 1ℚᵘ +-*-commutativeRing : CommutativeRing 0ℓ 0ℓ ``` * Added new functions to `Data.Vec.Base`: ```agda uncons : Vec A (suc n) → A × Vec A n length : Vec A n → ℕ transpose : Vec (Vec A n) m → Vec (Vec A m) n ``` * Added new functions to `Data.Vec.Bounded.Base`: ```agda take : n → Vec≤ A m → Vec≤ A (n ⊓ m) drop : n → Vec≤ A m → Vec≤ A (m ∸ n) padLeft : A → Vec≤ A n → Vec A n padRight : A → Vec≤ A n → Vec A n padBoth : ∀ {n} → A → A → Vec≤ A n → Vec A n rectangle : List (∃ (Vec≤ A)) → ∃ (List ∘ Vec≤ A) ``` * Added new definitions to `Data.Word.Base`: ```agda _≈_ : Rel Word64 zero _<_ : Rel Word64 zero ``` * Added utility function to `Function.Base`: ```agda it : {A : Set a} → {{A}} → A ``` * Added new definitions to `Function.Bundles`: ```agda record BiInverse record BiEquivalence _↩↪_ : Set a → Set b → Set _ mk↩↪ : Inverseˡ f g₁ → Inverseʳ f g₂ → A ↩↪ B ``` * Added new definitions to `Function.Structures`: ```agda record IsBiEquivalence (f : A → B) (g₁ : B → A) (g₂ : B → A) record IsBiInverse (f : A → B) (g₁ : B → A) (g₂ : B → A) ``` * Added new proofs to `Induction.WellFounded`: ```agda Acc-resp-≈ : Symmetric _≈_ → _<_ Respectsʳ _≈_ → (Acc _<_) Respects _≈_ some-wfRec-irrelevant : Some.wfRec P f x q ≡ Some.wfRec P f x q' wfRecBuilder-wfRec : All.wfRecBuilder P f x y y-nonZero : p > 0ℤ → NonZero p <-nonZero : p < 0ℤ → NonZero p positive : p > 0ℤ → Positive p negative : p < 0ℤ → Negative p nonPositive : p ≤ 0ℤ → NonPositive p nonNegative : p ≥ 0ℤ → NonNegative p ``` * Added new functions to `Data.List.Base`: ```agda wordsBy : Decidable P → List A → List (List A) cartesianProductWith : (A → B → C) → List A → List B → List C cartesianProduct : List A → List B → List (A × B) ``` * Added new proofs to `Data.List.Properties`: ```agda reverse-injective : reverse xs ≡ reverse ys → xs ≡ ys map-injective : Injective _≡_ _≡_ f → Injective _≡_ _≡_ (map f) ``` * Added new proofs to `Data.List.Membership.Propositional.Properties`: ```agda ∈-cartesianProductWith⁺ : a ∈ xs → b ∈ ys → f a b ∈ cartesianProductWith f xs ys ∈-cartesianProductWith⁻ : v ∈ cartesianProductWith f xs ys → ∃₂ λ a b → a ∈ xs × b ∈ ys × v ≡ f a b ∈-cartesianProduct⁺ : x ∈ xs → y ∈ ys → (x , y) ∈ cartesianProduct xs ys ∈-cartesianProduct⁻ : xy ∈ cartesianProduct xs ys → x ∈ xs × y ∈ ys ``` * Added new proofs to `Data.List.Membership.Setoid.Properties`: ```agda ∈-cartesianProductWith⁺ : a ∈₁ xs → b ∈₂ ys → f a b ∈₃ cartesianProductWith f xs ys ∈-cartesianProductWith⁻ : v ∈₃ cartesianProductWith f xs ys → ∃₂ λ a b → a ∈₁ xs × b ∈₂ ys × v ≈₃ f a b ∈-cartesianProduct⁺ : x ∈₁ xs → y ∈₂ ys → (x , y) ∈₁₂ cartesianProduct xs ys ∈-cartesianProduct⁻ : (x , y) ∈₁₂ cartesianProduct xs ys → x ∈₁ xs ``` * Added new operations to `Data.List.Relation.Unary.All`: ```agda tabulateₛ : (∀ {x} → x ∈ xs → P x) → All P xs ``` * Added new proofs to `Data.List.Relation.Unary.All.Properties`: ```agda cartesianProductWith⁺ : (∀ {x y} → x ∈₁ xs → y ∈₂ ys → P (f x y)) → All P (cartesianProductWith f xs ys) cartesianProduct⁺ : (∀ {x y} → x ∈₁ xs → y ∈₂ ys → P (x , y)) → All P (cartesianProduct xs ys) ``` * Added new proofs to `Data.List.Relation.Unary.Any.Properties`: ```agda cartesianProductWith⁺ : (∀ {x y} → P x → Q y → R (f x y)) → Any P xs → Any Q ys → Any R (cartesianProductWith f xs ys) cartesianProductWith⁻ : (∀ {x y} → R (f x y) → P x × Q y) → Any R (cartesianProductWith f xs ys) → Any P xs × Any Q ys cartesianProduct⁺ : Any P xs → Any Q ys → Any (P ⟨×⟩ Q) (cartesianProduct xs ys) cartesianProduct⁻ : Any (P ⟨×⟩ Q) (cartesianProduct xs ys) → Any P xs × Any Q ys reverseAcc⁺ : Any P acc ⊎ Any P xs → Any P (reverseAcc acc xs) reverseAcc⁻ : Any P (reverseAcc acc xs) -> Any P acc ⊎ Any P xs reverse⁺ : Any P xs → Any P (reverse xs) reverse⁻ : Any P (reverse xs) → Any P xs ``` * Added new proofs to `Data.List.Relation.Unary.Unique.Propositional.Properties`: ```agda cartesianProductWith⁺ : (∀ {w x y z} → f w y ≡ f x z → w ≡ x × y ≡ z) → Unique xs → Unique ys → Unique (cartesianProductWith f xs ys) cartesianProduct⁺ : Unique xs → Unique ys → Unique (cartesianProduct xs ys) ``` * Added new proofs to `Data.List.Relation.Unary.Unique.Setoid.Properties`: ```agda cartesianProductWith⁺ : (∀ {w x y z} → f w y ≈₃ f x z → w ≈₁ x × y ≈₂ z) → Unique S xs → Unique T ys → Unique U (cartesianProductWith f xs ys) cartesianProduct⁺ : Unique S xs → Unique T ys → Unique (S ×ₛ T) (cartesianProduct xs ys) ``` * Added new properties to ` Data.List.Relation.Binary.Permutation.Propositional.Properties`: ```agda ↭-empty-inv : xs ↭ [] → xs ≡ [] ¬x∷xs↭[] : ¬ (x ∷ xs ↭ []) ↭-singleton-inv : xs ↭ [ x ] → xs ≡ [ x ] ↭-map-inv : map f xs ↭ ys → ∃ λ ys′ → ys ≡ map f ys′ × xs ↭ ys′ ↭-length : xs ↭ ys → length xs ≡ length ys ``` * Added new proofs to `Data.List.Relation.Unary.Linked.Properties`: ```agda map⁻ : Linked R (map f xs) → Linked (λ x y → R (f x) (f y)) xs filter⁺ : Transitive R → Linked R xs → Linked R (filter P? xs) ``` * Add new properties to `Data.Maybe.Properties`: ```agda map-injective : Injective _≡_ _≡_ f → Injective _≡_ _≡_ (map f) ``` * Added new proofs to `Data.Maybe.Relation.Binary.Pointwise`: ```agda nothing-inv : Pointwise R nothing x → x ≡ nothing just-inv : Pointwise R (just x) y → ∃ λ z → y ≡ just z × R x z ``` * `Data.Nat.Binary.Induction` now re-exports `Acc` and `acc` from `Induction.WellFounded`. * Added new properties to `Data.Nat.Binary.Properties`: ```agda +-isSemigroup : IsSemigroup _+_ +-semigroup : Semigroup 0ℓ 0ℓ +-isCommutativeSemigroup : IsCommutativeSemigroup _+_ +-commutativeSemigroup : CommutativeSemigroup 0ℓ 0ℓ x≡0⇒double[x]≡0 : x ≡ 0ᵇ → double x ≡ 0ᵇ double-suc : double (suc x) ≡ 2ᵇ + double x pred[x]+y≡x+pred[y] : x ≢ 0ᵇ → y ≢ 0ᵇ → (pred x) + y ≡ x + pred y x+suc[y]≡suc[x]+y : x + suc y ≡ suc x + y ``` * Added new types and constructors to `Data.Nat.Base`: ```agda NonZero : ℕ → Set ≢-nonZero : n ≢ 0 → NonZero n >-nonZero : n > 0 → NonZero n ``` * The function `pred` in `Data.Nat.Base` has been redefined as `pred n = n ∸ 1`. Consequently proofs about `pred` are now just special cases of proofs for `_∸_`. The change is fully backwards compatible. * Added new proofs to `Data.Nat.Properties`: ```agda pred[m∸n]≡m∸[1+n] : pred (m ∸ n) ≡ m ∸ suc n ∣-∣-isProtoMetric : IsProtoMetric _≡_ ∣_-_∣ ∣-∣-isPreMetric : IsPreMetric _≡_ ∣_-_∣ ∣-∣-isQuasiSemiMetric : IsQuasiSemiMetric _≡_ ∣_-_∣ ∣-∣-isSemiMetric : IsSemiMetric _≡_ ∣_-_∣ ∣-∣-isMetric : IsMetric _≡_ ∣_-_∣ ∸-magma : Magma 0ℓ 0ℓ ∣-∣-quasiSemiMetric : QuasiSemiMetric 0ℓ 0ℓ ∣-∣-semiMetric : SemiMetric 0ℓ 0ℓ ∣-∣-preMetric : PreMetric 0ℓ 0ℓ ∣-∣-metric : Metric 0ℓ 0ℓ ``` * Added new proof to `Data.Nat.Coprimality`: ```agda ¬0-coprimeTo-2+ : ¬ Coprime 0 (2 + n) recompute : .(Coprime n d) → Coprime n d ``` * Add new functions to `Data.Product`: ```agda assocʳ-curried : Σ (Σ A B) C → Σ A (λ a → Σ (B a) (curry C a)) assocˡ-curried : Σ A (λ a → Σ (B a) (curry C a)) → Σ (Σ A B) C assocʳ : Σ (Σ A B) (uncurry C) → Σ A (λ a → Σ (B a) (C a)) assocˡ : Σ A (λ a → Σ (B a) (C a)) → Σ (Σ A B) (uncurry C) assocʳ′ : (A × B) × C → A × (B × C) assocˡ′ : A × (B × C) → (A × B) × C dmap : (f : (a : A) → B a) → (∀ {a} (b : P a) → Q b (f a)) → ((a , b) : Σ A P) → Σ (B a) (Q b) dmap′ : ((a : A) → X a) → ((b : B) → Y b) → ((a , b) : A × B) → X a × Y b _<*>_ : ((a : A) → X a) × ((b : B) → Y b) → ((a , b) : A × B) → X a × Y b ``` * Added new proofs to `Data.Product.Properties`: ```agda Σ-≡,≡↔≡ : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : Σ A B} → (∃ λ (p : a₁ ≡ a₂) → subst B p b₁ ≡ b₂) ↔ (p₁ ≡ p₂) ×-≡,≡↔≡ : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : A × B} → (a₁ ≡ a₂ × b₁ ≡ b₂) ↔ p₁ ≡ p₂ ∃∃↔∃∃ : (R : A → B → Set ℓ) → (∃₂ λ x y → R x y) ↔ (∃₂ λ y x → R x y) ``` * Add new functions to `Data.Sum.Base`: ```agda assocʳ : (A ⊎ B) ⊎ C → A ⊎ B ⊎ C assocˡ : A ⊎ B ⊎ C → (A ⊎ B) ⊎ C ``` * Added new proofs to `Data.Sum.Properties`: ```agda map-id : map id id ≗ id map₁₂-commute : map₁ f ∘ map₂ g ≗ map₂ g ∘ map₁ f [,]-cong : f ≗ f′ → g ≗ g′ → [ f , g ] ≗ [ f′ , g′ ] [-,]-cong : f ≗ f′ → [ f , g ] ≗ [ f′ , g ] [,-]-cong : g ≗ g′ → [ f , g ] ≗ [ f , g′ ] map-cong : f ≗ f′ → g ≗ g′ → map f g ≗ map f′ g′ map₁-cong : f ≗ f′ → map₁ f ≗ map₁ f′ map₂-cong : g ≗ g′ → map₂ g ≗ map₂ g′ ``` * Added new types and constructors to `Data.Rational`: ```agda NonZero : Pred ℚ 0ℓ Positive : Pred ℚ 0ℓ Negative : Pred ℚ 0ℓ NonPositive : Pred ℚ 0ℓ NonNegative : Pred ℚ 0ℓ ≢-nonZero : p ≢ 0ℚ → NonZero p >-nonZero : p > 0ℚ → NonZero p <-nonZero : p < 0ℚ → NonZero p positive : p > 0ℚ → Positive p negative : p < 0ℚ → Negative p nonPositive : p ≤ 0ℚ → NonPositive p nonNegative : p ≥ 0ℚ → NonNegative p ``` * Added new proofs to `Data.Rational.Properties`: ```agda +-*-isCommutativeRing : IsCommutativeRing _+_ _*_ -_ 0ℚ 1ℚ +-*-commutativeRing : CommutativeRing 0ℓ 0ℓ *-zeroˡ : LeftZero 0ℚ _*_ *-zeroʳ : RightZero 0ℚ _*_ *-zero : Zero 0ℚ _*_ ``` * Added new types and constructors to `Data.Rational.Unnormalised`: ```agda _≠_ : Rel ℚᵘ 0ℓ NonZero : Pred ℚᵘ 0ℓ Positive : Pred ℚᵘ 0ℓ Negative : Pred ℚᵘ 0ℓ NonPositive : Pred ℚᵘ 0ℓ NonNegative : Pred ℚᵘ 0ℓ ≢-nonZero : p ≠ 0ℚᵘ → NonZero p >-nonZero : p > 0ℚᵘ → NonZero p <-nonZero : p < 0ℚᵘ → NonZero p positive : p > 0ℚᵘ → Positive p negative : p < 0ℚᵘ → Negative p nonPositive : p ≤ 0ℚᵘ → NonPositive p nonNegative : p ≥ 0ℚᵘ → NonNegative p ``` * Added new functions to `Data.String.Base`: ```agda wordsBy : Decidable P → String → List String words : String → List String ``` * Added new proofs to `Data.Tree.Binary.Properties`: ```agda map-compose : map (f₁ ∘ f₂) (g₁ ∘ g₂) ≗ map f₁ g₁ ∘ map f₂ g₂ map-cong : f₁ ≗ f₂ → g₁ ≗ g₂ → map f₁ g₁ ≗ map f₂ g₂ ``` * Added new proofs to `Data.Unit.Properties`: ```agda ⊤-irrelevant : Irrelevant ⊤ ``` * Added new proofs to `Data.Vec.Properties`: ```agda unfold-take : take (suc n) (x ∷ xs) ≡ x ∷ take n xs unfold-drop : drop (suc n) (x ∷ xs) ≡ drop n xs lookup-inject≤-take : lookup xs (inject≤ i m≤m+n) ≡ lookup (take m xs) i ``` * Added new functions to `Data.Vec.Functional`: ```agda length : Vector A n → ℕ insert : Vector A n → Fin (suc n) → A → Vector A (suc n) updateAt : Fin n → (A → A) → Vector A n → Vector A n _++_ : Vector A m → Vector A n → Vector A (m + n) concat : Vector (Vector A m) n → Vector A (n * m) _>>=_ : Vector A m → (A → Vector B n) → Vector B (m * n) unzipWith : (A → B × C) → Vector A n → Vector B n × Vector C n unzip : Vector (A × B) n → Vector A n × Vector B n take : Vector A (m + n) → Vector A m drop : Vector A (m + n) → Vector A n reverse : Vector A n → Vector A n init : Vector A (suc n) → Vector A n last : Vector A (suc n) → A transpose : Vector (Vector A n) m → Vector (Vector A m) n ``` * Added new functions to `Data.Vec.Relation.Unary.All`: ```agda reduce : (f : ∀ {x} → P x → B) → All P xs → Vec B n ``` * Added new proofs to `Data.Vec.Relation.Unary.All.Properties`: ```agda All-swap : All (λ x → All (x ~_) ys) xs → All (λ y → All (_~ y) xs) ys tabulate⁺ : (∀ i → P (f i)) → All P (tabulate f) tabulate⁻ : All P (tabulate f) → (∀ i → P (f i)) drop⁺ : All P xs → All P (drop m xs) take⁺ : All P xs → All P (take m xs) ``` * Added new proofs to `Data.Vec.Membership.Propositional.Properties`: ```agda index-∈-lookup : index (∈-lookup i xs) ≡ i ``` * Added new functions to `Function.Base`: ```agda _∘₂_ : (f : {x : A₁} → {y : A₂ x} → (z : B x y) → C z) → (g : (x : A₁) → (y : A₂ x) → B x y) → ((x : A₁) → (y : A₂ x) → C (g x y)) _∘₂′_ : (C → D) → (A → B → C) → (A → B → D) constᵣ : A → B → B _-⟪_∣ : (A → B → C) → (C → B → D) → (A → B → D) ∣_⟫-_ : (A → C → D) → (A → B → C) → (A → B → D) _-⟨_∣ : (A → C) → (C → B → D) → (A → B → D) ∣_⟩-_ : (A → C → D) → (B → C) → (A → B → D) _-⟪_⟩-_ : (A → B → C) → (C → D → E) → (B → D) → (A → B → E) _-⟨_⟫-_ : (A → C) → (C → D → E) → (A → B → D) → (A → B → E) _-⟨_⟩-_ : (A → C) → (C → D → E) → (B → D) → (A → B → E) _on₂_ : (C → C → D) → (A → B → C) → (A → B → D) ``` * Added new proofs to `Function.Bundles`: ```agda mk↔′ : ∀ (f : A → B) (f⁻¹ : B → A) → Inverseˡ f f⁻¹ → Inverseʳ f f⁻¹ → A ↔ B ``` * Added new operators to `Relation.Binary`: ```agda _⇔_ : REL A B ℓ₁ → REL A B ℓ₂ → Set _ ``` * Added new proofs to `Relation.Binary.PropositionalEquality`: ```agda trans-cong : trans (cong f p) (cong f q) ≡ cong f (trans p q) cong₂-reflˡ : cong₂ _∙_ refl p ≡ cong (x ∙_) p cong₂-reflʳ : cong₂ _∙_ p refl ≡ cong (_∙ u) p ``` * Added new combinators to `Relation.Binary.PropositionalEquality.Core`: ```agda pattern erefl x = refl {x = x} cong′ : {f : A → B} x → f x ≡ f x icong : {f : A → B} {x y} → x ≡ y → f x ≡ f y icong′ : {f : A → B} x → f x ≡ f x ``` * Added new proofs to `Relation.Nullary.Decidable`: ```agda True-↔ : (dec : Dec P) → Irrelevant P → True dec ↔ P ``` * Added new proofs to `Relation.Binary.Construct.NonStrictToStrict`: ```agda <-isDecStrictPartialOrder : IsDecPartialOrder _≈_ _≤_ → IsDecStrictPartialOrder _≈_ _<_ ``` * The following operators have had fixities assigned: ``` infix 4 _[_] (Data.Graph.Acyclic) infix 4 _∣?_ (Data.Integer.Divisibility.Signed) infix 4 _∈_ _∉_ (Data.List.Fresh.Membership.Setoid) infixr 5 _∷_ (Data.List.Fresh.Relation.Unary.All) infixr 5 _∷_ _++_ (Data.List.Relation.Binary.Prefix.Heterogeneous) infix 4 _⊆?_ (Data.List.Relation.Binary.Sublist.DecSetoid) infix 4 _⊆I_ _⊆R_ _⊆T_ (Data.List.Relation.Binary.Sublist.Heterogeneous.Solver) infixr 8 _⇒_ (Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables) infix 1 _⊢_~_▷_ (Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables) infix 4 _++-mono_ (Data.List.Relation.Binary.Subset.Propositional.Properties) infix 4 _⊛-mono_ (Data.List.Relation.Binary.Subset.Propositional.Properties) infix 4 _⊗-mono_ (Data.List.Relation.Binary.Subset.Propositional.Properties) infixr 5 _++_ (Data.List.Relation.Binary.Suffix.Heterogeneous) infixr 5 _∷ˡ_ _∷ʳ_ (Data.List.Relation.Ternary.Interleaving) infix 1 _++_∷_ (Data.List.Relation.Unary.First) infixr 5 _∷_ (Data.List.Relation.Unary.First) infix 4 _≥_ (Data.Nat.Binary.Base) infix 4 __ (Function.Nary.NonDependent.Base) infix 1 _%=_⊢_ (Function.Nary.NonDependent.Base) infix 1 _∷=_⊢_ (Function.Nary.NonDependent.Base) infixr 2 _⊗_ (Induction.Lexicographic) infix 10 _⋆ (Relation.Binary.Construct.Closure.ReflexiveTransitive) infix 4 _≤_ (Relation.Binary.Construct.StrictToNonStrict) infixr 6 _$ʳ_ (Tactic.RingSolver) infix -1 _$ᵉ_ (Tactic.RingSolver) infix 4 _⇓≟_ (Tactic.RingSolver) infixl 6 _⊜_ (Tactic.RingSolver.NonReflective) ``` agda-stdlib-1.7.3/CHANGELOG/v1.5.md000066400000000000000000000742651451211343400162130ustar00rootroot00000000000000Version 1.5 =========== The library has been tested using Agda 2.6.1 and 2.6.1.1. Highlights ---------- * Regular expressions which work over both arbitrary types and `String`s. * Instance declarations for `IsDecEquivalence` and `IsDecTotalOrder` over various data types. * Bindings for Haskell's `System.Environment` and `System.Exit`. Bug-fixes --------- * Added the version number to the official library name, i.e. name is now `standard-library-1.5` rather than `standard-library`, allowing other libraries to require a specific version as a dependency. See the [library management docs](https://agda.readthedocs.io/en/v2.6.1.1/tools/package-system.html#version-numbers) for more details. * In `Data.List.Relation.Unary.All.Properties`: fixed the type of the proof `map-id` which was incorrectly abstracted over unused module parameters. * In `Data.List.Relation.Binary.Subset.(Propositional/Setoid).Properties`: fixed the fixity of the reasoning combinators in so that they compose properly. * In `Relation.Binary.Construct.Closure.Reflexive`: the example module `Maybe` was accidentally exposed publicly. It has been made private. * In `Relation.Binary.Morphism.Structures`: fixed bug where `IsRelIsomorphism` did not publicly re-export the contents of `IsRelMonomorphism`. * In `Relation.Binary.Bundles`: the binary relation `_≉_` exposed by records now has the correct infix precedence. Non-backwards compatible changes -------------------------------- * The internal build utilities package `lib.cabal` has been renamed `agda-stdlib-utils.cabal` to avoid potential conflict or confusion. Please note that the package is not intended for external use. * The modules `Algebra.Construct.Zero` and `Algebra.Module.Construct.Zero` are now level-polymorphic, each taking two implicit level parameters. * The definition of `_⊖_` in `Data.Integer.Base` has changed. Previously it was defined inductively as: ```agda _⊖_ : ℕ → ℕ → ℤ m ⊖ ℕ.zero = + m ℕ.zero ⊖ ℕ.suc n = -[1+ n ] ℕ.suc m ⊖ ℕ.suc n = m ⊖ n ``` which meant that it had to recursively evaluate its unary arguments. The definition has been changed as follows to use operations on `ℕ` that are backed by builtin operations, greatly improving its performance: ```agda _⊖_ : ℕ → ℕ → ℤ m ⊖ n with m ℕ.<ᵇ n ... | true = - + (n ℕ.∸ m) ... | false = + (m ℕ.∸ n) ``` * The proofs `↭⇒∼bag` and `∼bag⇒↭` have been moved from `Data.List.Relation.Binary.Permutation.Setoid.Properties` to `Data.List.Relation.Binary.BagAndSetEquality` as their current location were causing cyclic import dependencies. * In `Data.String`, orders on `String` now use propositional equality as the notion of equivalence on characters rather than the equivalent, but less inference-friendly, variant defined by conversion of characters to natural numbers. This is in line with our effort to deprecate this badly-behaved equivalence relation on characters. * In `Data.Vec.Relation.Unary.AllPairs`: generalised the types of `head`, `tail`, `uncons` so that the vector talked about does not need to be cons-headed. * Cleaned up `IO` to make it more friendly: + Renamed `_>>=_` and `_>>_` to `bind` and `seq` respectively to free up the names for `do`-notation friendly combinators. + Introduced `Colist` and `List` modules for the various `sequence` and `mapM` functions. This breaks code that relied on the `Colist`-specific function being exported as part of `IO`. + `⊤`-returning functions (such as `putStrLn`) have been made level polymorphic. This may force you to add more type or level annotations to your programs. Deprecated modules ------------------ * The inner module `TransitiveClosure` in `Induction.WellFounded` has been deprecated. You should instead use the standard definition of transitive closure and the accompanying proof of well-foundness defined in `Relation.Binary.Construct.Closure.Transitive`. * The module `Relation.Binary.OrderMorphism` has been deprecated, as the new `(Homo/Mono/Iso)morphism` infrastructure in `Algebra.Morphism.Structures` is now complete. The new definitions are parameterised by raw bundles instead of bundles meaning they are much more flexible to work with. * All modules in the folder `Algebra.Operations` have been deprecated, as their design a) was inconsistent, with some of the modules parameterised over the raw bundle and some over the stanard bundle b) prevented definitions from being neatly inherited by super-bundles. These problems have been fixed with a redesign: definitions of the operations can be found in `Algebra.Definitions.(RawMagma/RawMonoid/RawSemiring)` and their properties can be found in `Algebra.Properties.(Magma/Semigroup/Monoid/CommutativeMonoid/Semiring).(Sum/Mult/Exp)`. The latter also export the definition, and so most users will only need to import the latter. Deprecated names ---------------- * The immediate contents of `Algebra.Morphism` have been deprecated, as the new `(Homo/Mono/Iso)morphism` infrastructure in `Algebra.Morphism.Structures` is now complete. The new definitions are parameterised by raw bundles instead of bundles meaning they are much more flexible to work with. The replacements are as following: ```agda IsSemigroupMorphism ↦ IsSemigroupHomomorphism IsMonoidMorphism ↦ IsMonoidHomomorphism IsCommutativeMonoidMorphism ↦ IsMonoidHomomorphism IsIdempotentCommutativeMonoidMorphism ↦ IsMonoidHomomorphism IsGroupMorphism ↦ IsGroupHomomorphism IsAbelianGroupMorphism ↦ IsGroupHomomorphism ``` * In `Data.Char.Properties`, deprecated all of the `_≈_`-related content: this relation is equivalent to propositional equality but has worse inference. * In `Data.Fin.Properties`: ```agda inject+-raise-splitAt ↦ join-splitAt ``` * In `Data.Integer`, the `show` function has been deprecated. Please use `show` from `Data.Integer.Show` instead. * In `Data.Integer.Properties`: ```agda neg-mono-<-> ↦ neg-mono-< neg-mono-≤-≥ ↦ neg-mono-≤ *-monoʳ-≤-non-neg ↦ *-monoʳ-≤-nonNeg *-monoˡ-≤-non-neg ↦ *-monoˡ-≤-nonNeg *-cancelˡ-<-non-neg ↦ *-cancelˡ-<-nonNeg *-cancelʳ-<-non-neg ↦ *-cancelʳ-<-nonNeg ``` * In `Data.List.Relation.Binary.Subset.Propositional.Properties`: ```agda mono ↦ Any-resp-⊆ map-mono ↦ map⁺ concat-mono ↦ concat⁺ >>=-mono ↦ >>=⁺ _⊛-mono_ ↦ ⊛⁺ _⊗-mono_ ↦ ⊗⁺ any-mono ↦ any⁺ map-with-∈-mono ↦ map-with-∈⁺ filter⁺ ↦ filter-⊆ ``` * In `Data.List.Relation.Binary.Subset.Setoid.Properties`: ```agda filter⁺ ↦ filter-⊆ ``` * In `Data.Rational`, the `show` function has been deprecated. Please use `show` from `Data.Rational.Show` instead. * In `Relation.Binary.Construct.Closure.Reflexive`: ```agda Refl ↦ ReflClosure ``` * In `Relation.Binary.Construct.Closure.Transitive`: ```agda Plus′ ↦ TransClosure ``` New modules ----------- * Generic definitions over algebraic structures (divisibility, multiplication etc.): ``` Algebra.Definitions.RawMagma Algebra.Definitions.RawMonoid Algebra.Definitions.RawSemiring ``` * Properties of generic definitions over algebraic structures (divisibility, multiplication etc.): ``` Algebra.Properties.Magma.Divisibility Algebra.Properties.Semigroup.Divisibility Algebra.Properties.CommutativeSemigroup.Divisibility Algebra.Properties.Monoid.Sum Algebra.Properties.Monoid.Mult Algebra.Properties.Monoid.Divisibility Algebra.Properties.CommutativeMonoid.Sum Algebra.Properties.CommutativeMonoid.Mult Algebra.Properties.Semiring.Divisibility Algebra.Properties.Semiring.Exp Algebra.Properties.Semiring.Exp.TCOptimised Algebra.Properties.Semiring.Mult Algebra.Properties.Semiring.Mult.TCOptimised Algebra.Properties.CommutativeSemiring.Exp Algebra.Properties.CommutativeSemiring.Exp.TCOptimised ``` * Properties of monomorphisms over lattice structures: ``` Algebra.Morphism.LatticeMonomorphism ``` * Various modules containing `instance` declarations for `IsDecEquivalence` and `IsDecTotalOrder` records: ``` Data.Bool.Instances Data.Char.Instances Data.Fin.Instances Data.Float.Instances Data.Integer.Instances Data.List.Instances Data.Nat.Instances Data.Nat.Binary.Instances Data.Product.Instances Data.Rational.Instances Data.Sign.Instances Data.String.Instances Data.Sum.Instances Data.These.Instances Data.Unit.Instances Data.Unit.Polymorphic.Instances Data.Vec.Instances Data.Word.Instances Reflection.Instances ``` * Various modules for converting numeric data to `String`s: ```agda Data.Fin.Show Data.Integer.Show Data.Rational.Show ``` * Permutations over finite sets represented as a list of transpositions: ``` Data.Fin.Permutation.Transposition.List ``` * Heterogeneous relation characterising a list as an infix segment of another: ``` Data.List.Relation.Binary.Infix.Heterogeneous Data.List.Relation.Binary.Infix.Heterogeneous.Properties ``` and added `Properties` file for the homogeneous variants of (pre/in/suf)fix: ``` Data.List.Relation.Binary.Prefix.Homogeneous.Properties Data.List.Relation.Binary.Infix.Homogeneous.Properties Data.List.Relation.Binary.Suffix.Homogeneous.Properties ``` * Properties of lists with decidably unique elements: ``` Data.List.Relation.Unary.Unique.DecSetoid Data.List.Relation.Unary.Unique.DecSetoid.Properties Data.List.Relation.Unary.Unique.DecPropositional Data.List.Relation.Unary.Unique.DecPropositional.Properties ``` * New ternary relation for two lists that are appended to form a third list: ``` Data.List.Relation.Ternary.Appending Data.List.Relation.Ternary.Appending.Properties Data.List.Relation.Ternary.Appending.Propositional Data.List.Relation.Ternary.Appending.Propositional.Properties Data.List.Relation.Ternary.Appending.Setoid Data.List.Relation.Ternary.Appending.Setoid.Properties ``` * Solvers for rationals: ``` Data.Rational.Solver Data.Rational.Unnormalised.Solver ``` * Setoid equality over vectors: ``` Data.Vec.Functional.Relation.Binary.Equality.Setoid ``` * Bindings for Haskell's `System.Environment`: ``` System.Environment System.Environment.Primitive ``` * Bindings for Haskell's `System.Exit`: ``` System.Exit System.Exit.Primitive ``` * Added `Reflection.Traversal` for generic de Bruijn-aware traversals of reflected terms. * Added `Reflection.DeBruijn` with weakening, strengthening and free variable operations on reflected terms. * Added `Relation.Binary.TypeClasses` for type classes to be used with instance search. This module re-exports `_≟_` from `IsDecEquivalence` and `_≤?_` from `IsDecTotalOrder` where the principal argument has been made into an instance argument. This enables automatic resolution if the corresponding module `Data.*.Instances` (or `Reflection.Instances`) is imported as well. For example, if `Relation.Binary.TypeClasses`, `Data.Nat.Instances`, and `Data.Bool.Instances` have been imported, then `true ≟ true` has type `Dec (true ≡ true)`, while `0 ≟ 1` has type `Dec (0 ≡ 1)`. More examples can be found in `README.Relation.Binary.TypeClasses`. * Added various constructions for morphisms over binary relations: ```agda Relation.Binary.Morphism.Construct.Composition Relation.Binary.Morphism.Construct.Constant Relation.Binary.Morphism.Construct.Identity ``` * New modules formalising regular expressions: ``` Text.Regex Text.Regex.Base Text.Regex.Derivative.Brzozowski Text.Regex.Properties.Core Text.Regex.Properties Text.Regex.Search Text.Regex.SmartConstructors Text.Regex.String Text.Regex.String.Unsafe ``` Other minor additions --------------------- * All bundles in `Algebra.Bundles` now re-export the binary relation `_≉_` from the underlying `Setoid`. * Added new records to `Algebra.Bundles`: ```agda CommutativeMagma c ℓ : Set (suc (c ⊔ ℓ)) RawNearSemiring c ℓ : Set (suc (c ⊔ ℓ)) RawLattice c ℓ : Set (suc (c ⊔ ℓ)) CancellativeCommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) ``` * Added new definitions to `Algebra.Definitions`: ```agda AlmostLeftCancellative e _•_ = ¬ x ≈ e → (x • y) ≈ (x • z) → y ≈ z AlmostRightCancellative e _•_ = ¬ x ≈ e → (y • x) ≈ (z • x) → y ≈ z AlmostCancellative e _•_ = AlmostLeftCancellative e _•_ × AlmostRightCancellative e _•_ ``` * Added new records to `Algebra.Morphism.Structures`: ```agda IsNearSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsNearSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsNearSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) IsSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) IsLatticeHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsLatticeMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) IsLatticeIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) ``` * Added new definitions to `Algebra.Structures`: ```agda IsCommutativeMagma (• : Op₂ A) : Set (a ⊔ ℓ) IsCancellativeCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) ``` * Added new proofs to `Codata.Delay.Properties`: ```agda ⇓-unique : (d⇓₁ : d ⇓) (d⇓₂ : d ⇓) → d⇓₁ ≡ d⇓₂ bind̅₁ : bind d f ⇓ → d ⇓ bind̅₂ : (bind⇓ : bind d f ⇓) → f (extract (bind̅₁ bind⇓)) ⇓ extract-bind-⇓ : (d⇓ : d ⇓) (f⇓ : f (extract d⇓) ⇓) → extract (bind-⇓ d⇓ f⇓) ≡ extract f⇓ extract-bind̅₂-bind⇓ : (bind⇓ : bind d f ⇓) → extract (bind̅₂ d bind⇓) ≡ extract bind⇓ bind⇓-length : (bind⇓ : bind d f ⇓) (d⇓ : d ⇓) (f⇓ : f (extract d⇓) ⇓) → toℕ (length-⇓ bind⇓) ≡ toℕ (length-⇓ d⇓) ℕ.+ toℕ (length-⇓ f⇓) ``` * Added new definition to `Data.Char.Base`: ```agda _≉_ : Rel Char zero _≤_ : Rel Char zero ``` * Added proofs to `Data.Char.Properties`: ```agda ≉⇒≢ : x ≉ y → x ≢ y <-trans : Transitive _<_ <-asym : Asymmetric _<_ <-cmp : Trichotomous _≡_ _<_ _≤?_ : Decidable _≤_ ≤-reflexive : _≡_ ⇒ _≤_ ≤-trans : Transitive _≤_ ≤-antisym : Antisymmetric _≡_ _≤_ ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isDecPartialOrder : IsDecPartialOrder _≡_ _≤_ ≤-preorder : Preorder _ _ _ ≤-poset : Poset _ _ _ ≤-decPoset : DecPoset _ _ _ ``` * Added new function to `Data.Fin`: ```agda join : Fin m ⊎ Fin n → Fin (m ℕ.+ n) ``` * Added new properties to `Data.Fin.Properties`: ```agda splitAt-join : splitAt m (join m n i) ≡ i +↔⊎ : Fin (m ℕ.+ n) ↔ (Fin m ⊎ Fin n) Fin0↔⊥ : Fin 0 ↔ ⊥ ``` * Added new relations, functions and proofs to `Data.Fin.Permutation`: ``` _≈_ : Rel (Permutation m n) 0ℓ lift₀ : Permutation m n → Permutation (suc m) (suc n) lift₀-remove : π ⟨$⟩ʳ 0F ≡ 0F → ∀ i → lift₀ (remove 0F π) ≈ π lift₀-id : lift₀ id ⟨$⟩ʳ i ≡ i lift₀-comp : lift₀ π ∘ₚ lift₀ ρ ≈ lift₀ (π ∘ₚ ρ) lift₀-cong : π ≈ ρ → lift₀ π ≈ lift₀ ρ lift₀-transpose : transpose (suc i) (suc j)≈ lift₀ (transpose i j) ``` * Added new proofs in `Data.Integer.Properties`: ```agda [1+m]⊖[1+n]≡m⊖n : suc m ⊖ suc n ≡ m ⊖ n ⊖-≤ : m ≤ n → m ⊖ n ≡ - + (n ∸ m) -m+n≡n⊖m : - (+ m) + + n ≡ n ⊖ m m-n≡m⊖n : + m + (- + n) ≡ m ⊖ n ≤∧≢⇒< : x ≤ y → x ≢ y → x < y ≤∧≮⇒≡ : x ≤ y → x ≮ y → x ≡ y positive⁻¹ : Positive n → n > 0ℤ nonNegative⁻¹ : NonNegative n → n ≥ 0ℤ negative⁻¹ : Negative n → n < 0ℤ nonPositive⁻¹ : NonPositive q → q ≤ 0ℤ negative_ neg-mono-≤ : -_ Preserves _≤_ ⟶ _≥_ neg-cancel-< : - m < - n → m > n neg-cancel-≤ : - m ≤ - n → m ≥ n +∣n∣≡n⊎+∣n∣≡-n : + ∣ n ∣ ≡ n ⊎ + ∣ n ∣ ≡ - n ∣m⊝n∣≤m⊔n : ∣ m ⊖ n ∣ ℕ.≤ m ℕ.⊔ n ∣m+n∣≤∣m∣+∣n∣ : ∣ m + n ∣ ℕ.≤ ∣ m ∣ ℕ.+ ∣ n ∣ ∣m-n∣≤∣m∣+∣n∣ : ∣ m - n ∣ ℕ.≤ ∣ m ∣ ℕ.+ ∣ n ∣ *-cancelˡ-≤-neg : -[1+ m ] * n ≤ -[1+ m ] * o → n ≥ o *-cancelʳ-≤-neg : n * -[1+ m ] ≤ o * -[1+ m ] → n ≥ o *-monoˡ-≤-nonPos : NonPositive m → (m *_) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-nonPos : ∀ m → NonPositive m → (_* m) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-neg : (-[1+ m ] *_) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-neg : (_* -[1+ m ]) Preserves _≤_ ⟶ _≥_ *-monoˡ-<-neg : (-[1+ n ] *_) Preserves _<_ ⟶ _>_ *-monoʳ-<-neg : (_* -[1+ n ]) Preserves _<_ ⟶ _>_ *-cancelˡ-<-neg : -[1+ n ] * i < -[1+ n ] * j → i > j *-cancelˡ-<-nonPos : NonPositive n → n * i < n * j → i > j *-cancelʳ-<-neg : i * -[1+ n ] < j * -[1+ n ] → i > j *-cancelʳ-<-nonPos : NonPositive n → i * n < j * n → i > j ∣m*n∣≡∣m∣*∣n∣ : ∣ m * n ∣ ≡ ∣ m ∣ ℕ.* ∣ n ∣ +-*-commutativeSemiring : CommutativeSemiring 0ℓ 0ℓ mono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≤_ → f (m ⊓ n) ≡ f m ⊓ f n mono-<-distrib-⊓ : f Preserves _<_ ⟶ _<_ → f (m ⊓ n) ≡ f m ⊓ f n mono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≤_ → f (m ⊔ n) ≡ f m ⊔ f n mono-<-distrib-⊔ : f Preserves _<_ ⟶ _<_ → f (m ⊔ n) ≡ f m ⊔ f n antimono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≥_ → f (m ⊔ n) ≡ f m ⊓ f n antimono-<-distrib-⊔ : f Preserves _<_ ⟶ _>_ → f (m ⊔ n) ≡ f m ⊓ f n antimono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≥_ → f (m ⊓ n) ≡ f m ⊔ f n antimono-<-distrib-⊓ : f Preserves _<_ ⟶ _>_ → f (m ⊓ n) ≡ f m ⊔ f n *-distribˡ-⊓-nonNeg : + m * (n ⊓ o) ≡ (+ m * n) ⊓ (+ m * o) *-distribʳ-⊓-nonNeg : (n ⊓ o) * + m ≡ (n * + m) ⊓ (o * + m) *-distribˡ-⊔-nonNeg : + m * (n ⊔ o) ≡ (+ m * n) ⊔ (+ m * o) *-distribʳ-⊔-nonNeg : (n ⊔ o) * + m ≡ (n * + m) ⊔ (o * + m) *-distribˡ-⊓-nonPos : NonPositive m → m * (n ⊓ o) ≡ (m * n) ⊔ (m * o) *-distribʳ-⊓-nonPos : NonPositive m → (n ⊓ o) * m ≡ (n * m) ⊔ (o * m) *-distribˡ-⊔-nonPos : NonPositive m → m * (n ⊔ o) ≡ (m * n) ⊓ (m * o) *-distribʳ-⊔-nonPos : NonPositive m → (n ⊔ o) * m ≡ (n * m) ⊓ (o * m) ⊓-absorbs-⊔ : _⊓_ Absorbs _⊔_ ⊔-absorbs-⊓ : _⊔_ Absorbs _⊓_ ⊔-⊓-absorptive : Absorptive _⊔_ _⊓_ ⊓-⊔-absorptive : Absorptive _⊓_ _⊔_ ⊓-isMagma : IsMagma _⊓_ ⊓-isSemigroup : IsSemigroup _⊓_ ⊓-isBand : IsBand _⊓_ ⊓-isCommutativeSemigroup : IsCommutativeSemigroup _⊓_ ⊓-isSemilattice : IsSemilattice _⊓_ ⊓-isSelectiveMagma : IsSelectiveMagma _⊓_ ⊔-isMagma : IsMagma _⊔_ ⊔-isSemigroup : IsSemigroup _⊔_ ⊔-isBand : IsBand _⊔_ ⊔-isCommutativeSemigroup : IsCommutativeSemigroup _⊔_ ⊔-isSemilattice : IsSemilattice _⊔_ ⊔-isSelectiveMagma : IsSelectiveMagma _⊔_ ⊔-⊓-isLattice : IsLattice _⊔_ _⊓_ ⊓-⊔-isLattice : IsLattice _⊓_ _⊔_ ⊓-magma : Magma _ _ ⊓-semigroup : Semigroup _ _ ⊓-band : Band _ _ ⊓-commutativeSemigroup : CommutativeSemigroup _ _ ⊓-semilattice : Semilattice _ _ ⊓-selectiveMagma : SelectiveMagma _ _ ⊔-magma : Magma _ _ ⊔-semigroup : Semigroup _ _ ⊔-band : Band _ _ ⊔-commutativeSemigroup : CommutativeSemigroup _ _ ⊔-semilattice : Semilattice _ _ ⊔-selectiveMagma : SelectiveMagma _ _ ⊔-⊓-lattice : Lattice _ _ ⊓-⊔-lattice : Lattice _ _ ``` * Added new functions to `Data.List.Base`: ```agda linesBy : Decidable P → List A → List (List A) unsnoc : List A → Maybe (List A × A) ``` * Added new relations in `Data.List.Relation.Binary.Subset.(Propositional/Setoid)`: ```agda xs ⊇ ys = ys ⊆ xs xs ⊉ ys = ¬ xs ⊇ ys ``` * Added new proofs in `Data.List.Relation.Binary.Subset.Setoid.Properties`: ```agda ⊆-respʳ-≋ : _⊆_ Respectsʳ _≋_ ⊆-respˡ-≋ : _⊆_ Respectsˡ _≋_ ⊆-reflexive-↭ : _↭_ ⇒ _⊆_ ⊆-respʳ-↭ : _⊆_ Respectsʳ _↭_ ⊆-respˡ-↭ : _⊆_ Respectsˡ _↭_ ⊆-↭-isPreorder : IsPreorder _↭_ _⊆_ ⊆-↭-preorder : Preorder _ _ _ Any-resp-⊆ : P Respects _≈_ → (Any P) Respects _⊆_ All-resp-⊇ : P Respects _≈_ → (All P) Respects _⊇_ xs⊆xs++ys : xs ⊆ xs ++ ys xs⊆ys++xs : xs ⊆ ys ++ xs ++⁺ʳ : xs ⊆ ys → zs ++ xs ⊆ zs ++ ys ++⁺ˡ : xs ⊆ ys → xs ++ zs ⊆ ys ++ zs ++⁺ : ws ⊆ xs → ys ⊆ zs → ws ++ ys ⊆ xs ++ zs filter⁺′ : P ⋐ Q → xs ⊆ ys → filter P? xs ⊆ filter Q? ys ``` * Added new proofs in `Data.List.Relation.Binary.Subset.Propositional.Properties`: ```agda ⊆-reflexive-↭ : _↭_ ⇒ _⊆_ ⊆-respʳ-↭ : _⊆_ Respectsʳ _↭_ ⊆-respˡ-↭ : _⊆_ Respectsˡ _↭_ ⊆-↭-isPreorder : IsPreorder _↭_ _⊆_ ⊆-↭-preorder : Preorder _ _ _ Any-resp-⊆ : (Any P) Respects _⊆_ All-resp-⊇ : (All P) Respects _⊇_ Sublist⇒Subset : xs ⊑ ys → xs ⊆ ys xs⊆xs++ys : xs ⊆ xs ++ ys xs⊆ys++xs : xs ⊆ ys ++ xs ++⁺ʳ : xs ⊆ ys → zs ++ xs ⊆ zs ++ ys ++⁺ˡ : xs ⊆ ys → xs ++ zs ⊆ ys ++ zs filter⁺′ : P ⋐ Q → xs ⊆ ys → filter P? xs ⊆ filter Q? ys ``` * Added new properties to `Data.List.Properties`: ```agda concat-++ : concat xss ++ concat yss ≡ concat (xss ++ yss) concat-concat : concat ∘ map concat ≗ concat ∘ concat concat-[-] : concat ∘ map [_] ≗ id ``` * Added new relations to `Data.List.Relation.Binary.Sublist.(Setoid/Propositional)`: ```agda xs ⊂ ys = xs ⊆ ys × ¬ (xs ≋ ys) xs ⊃ ys = ys ⊂ xs xs ⊄ ys = ¬ (xs ⊂ ys) xs ⊅ ys = ¬ (xs ⊃ ys) ``` * Added new proof to `Data.List.Relation.Binary.Permutation.Propositional.Properties`: ```agda ++↭ʳ++ : xs ++ ys ↭ xs ʳ++ ys ``` * Added new proof to `Data.List.Relation.Binary.Permutation.Setoi.Properties`: ```agda ++↭ʳ++ : xs ++ ys ↭ xs ʳ++ ys ``` * Added new proofs to `Data.List.Extrema`: ```agda min-mono-⊆ : ⊥₁ ≤ ⊥₂ → xs ⊇ ys → min ⊥₁ xs ≤ min ⊥₂ ys max-mono-⊆ : ⊥₁ ≤ ⊥₂ → xs ⊆ ys → max ⊥₁ xs ≤ max ⊥₂ ys ``` * Added new operator to `Data.List.Membership.DecSetoid`: ```agda _∉?_ : Decidable _∉_ ``` * Added new proofs to `Data.List.Relation.Unary.Any.Properties`: ```agda lookup-index : (p : Any P xs) → P (lookup xs (index p)) applyDownFrom⁺ : P (f i) → i < n → Any P (applyDownFrom f n) applyDownFrom⁻ : Any P (applyDownFrom f n) → ∃ λ i → i < n × P (f i) ``` * Added new proofs to `Data.List.Membership.Setoid.Properties`: ```agda ∈-applyDownFrom⁺ : i < n → f i ∈ applyDownFrom f n ∈-applyDownFrom⁻ : v ∈ applyDownFrom f n → ∃ λ i → i < n × v ≈ f i ``` * Added new proofs to `Data.List.Membership.Propositional.Properties`: ```agda ∈-applyDownFrom⁺ : i < n → f i ∈ applyDownFrom f n ∈-applyDownFrom⁻ : v ∈ applyDownFrom f n → ∃ λ i → i < n × v ≡ f i ∈-upTo⁺ : i < n → i ∈ upTo n ∈-upTo⁻ : i ∈ upTo n → i < n ∈-downFrom⁺ : i < n → i ∈ downFrom n ∈-downFrom⁻ : i ∈ downFrom n → i < n ``` * Added new proofs to `Data.List.Relation.Binary.Lex.Strict`: ```agda ≤-isDecPartialOrder : IsStrictTotalOrder _≈_ _≺_ → IsDecPartialOrder _≋_ _≤_ ≤-decPoset : StrictTotalOrder a ℓ₁ ℓ₂ → DecPoset _ _ _ ``` * Added new function to `Data.List.Relation.Binary.Prefix.Heterogeneous`: ```agda _++ᵖ_ : Prefix R as bs → ∀ suf → Prefix R as (bs ++ suf) ``` * Added new function to `Data.List.Relation.Binary.Suffix.Heterogeneous`: ```agda _++ˢ_ : ∀ pre → Suffix R as bs → Suffix R as (pre ++ bs) ``` * Added new function to `Data.Maybe.Base`: ```agda when : Bool → A → Maybe A ``` * Added new definition to `Data.Nat.Base`: ```agda _≤ᵇ_ : (m n : ℕ) → Bool ``` * Added new proofs to `Data.Nat.Properties`: ```agda ≤∧≮⇒≡ : m ≤ n → m ≮ n → m ≡ n ≤ᵇ⇒≤ : T (m ≤ᵇ n) → m ≤ n ≤⇒≤ᵇ : m ≤ n → T (m ≤ᵇ n) <ᵇ-reflects-< : Reflects (m < n) (m <ᵇ n) ≤ᵇ-reflects-≤ : Reflects (m ≤ n) (m ≤ᵇ n) *-distribˡ-⊔ : _*_ DistributesOverˡ _⊔_ *-distribʳ-⊔ : _*_ DistributesOverʳ _⊔_ *-distrib-⊔ : _*_ DistributesOver _⊔_ *-distribˡ-⊓ : _*_ DistributesOverˡ _⊓_ *-distribʳ-⊓ : _*_ DistributesOverʳ _⊓_ *-distrib-⊓ : _*_ DistributesOver _⊓_ ``` * Added new function to `Data.Nat.Show`: ```agda readMaybe : (base : ℕ) → {base≤16 : True (base ≤? 16)} → String → Maybe ℕ ``` * Added new functions and relation to `Data.String.Base`: ```agda linesBy : Decidable P → String → List String lines : String → List String _≤_ : Rel String zero ``` * Added new proofs to `Data.Sign.Properties`: ```agda s*opposite[s]≡- : s * opposite s ≡ - opposite[s]*s≡- : opposite s * s ≡ - ``` * Added new operation to `Data.Sum.Base`: ```agda reduce : A ⊎ A → A ``` * Added new proofs to `Data.String.Properties`: ```agda ≤-isDecPartialOrder-≈ : IsDecPartialOrder _≈_ _≤_ ≤-decPoset-≈ : DecPoset _ _ _ ``` * Added new functions to `Data.Tree.AVL`: ```agda foldr : (∀ {k} → Val k → A → A) → A → Tree V → A size : Tree V → ℕ intersectionWith : (∀ {k} → Val k → Wal k → Xal k) → Tree V → Tree W → Tree X intersection : Tree V → Tree V → Tree V intersectionsWith : (∀ {k} → Val k → Val k → Val k) → List (Tree V) → Tree V intersections : List (Tree V) → Tree V ``` * Added new functions to `Data.Tree.AVL.Indexed`: ```agda foldr : (∀ {k} → Val k → A → A) → A → Tree V l u h → A size : Tree V → ℕ ``` * Added new functions to `Data.Tree.AVL.IndexedMap` module: ```agda foldr : (∀ {k} → Value k → A → A) → A → Map → A size : Map → ℕ ``` * Added new functions to `Data.Tree.AVL.Map`: ```agda foldr : (Key → V → A → A) → A → Map V → A size : Map V → ℕ intersectionWith : (V → W → X) → Map V → Map W → Map X intersection : Map V → Map V → Map V intersectionsWith : (V → V → V) → List (Map V) → Map V intersections : List (Map V) → Map V ``` * Added new functions to `Data.Tree.AVL.Sets`: ```agda foldr : (A → B → B) → B → ⟨Set⟩ → B size : ⟨Set⟩ → ℕ union : ⟨Set⟩ → ⟨Set⟩ → ⟨Set⟩ unions : List ⟨Set⟩ → ⟨Set⟩ intersection : ⟨Set⟩ → ⟨Set⟩ → ⟨Set⟩ intersections : List ⟨Set⟩ → ⟨Set⟩ ``` * Add new properties to `Data.Vec.Properties`: ```agda take-distr-zipWith : take m (zipWith f u v) ≡ zipWith f (take m u) (take m v) take-distr-map : take m (map f v) ≡ map f (take m v) drop-distr-zipWith : drop m (zipWith f u v) ≡ zipWith f (drop m u) (drop m v) drop-distr-map : drop m (map f v) ≡ map f (drop m v) take-drop-id : take m v ++ drop m v ≡ v zipWith-replicate : zipWith _⊕_ (replicate x) (replicate y) ≡ replicate (x ⊕ y) ``` * Added infix declarations to `∃-syntax` and `∄-syntax` to `Data.Product`. * Added new definitions to `Function.Bundles`: ```agda record Func : Set _ _⟶_ : Set a → Set b → Set _ mk⟶ : (A → B) → A ⟶ B ``` * Added new proofs to `Function.Construct.Composition`: ```agda function : Func R S → Func S T → Func R T _∘-⟶_ : (A ⟶ B) → (B ⟶ C) → (A ⟶ C) ``` * Added new proofs to `Function.Construct.Identity`: ```agda function : Func S S id-⟶ : A ⟶ A ``` * Added new function `Reflection.TypeChecking.Format`: ```agda errorPartFmt : (fmt : String) → Printf (lexer fmt) (List ErrorPart) ``` * Added new proofs to `Relation.Binary.Construct.Closure.Transitive`: ```agda reflexive : Reflexive _∼_ → Reflexive _∼⁺_ symmetric : Symmetric _∼_ → Symmetric _∼⁺_ transitive : Transitive _∼⁺_ wellFounded : WellFounded _∼_ → WellFounded _∼⁺_ ``` * Added new proof to `Relation.Binary.PropositionalEquality`: ```agda resp : (P : Pred A ℓ) → P Respects _≡_ ``` * Added new proof to `Relation.Nullary.Reflects`: ```agda fromEquivalence : (T b → P) → (P → T b) → Reflects P b ``` agda-stdlib-1.7.3/CHANGELOG/v1.6.md000066400000000000000000001364171451211343400162120ustar00rootroot00000000000000Version 1.6 =========== The library has been tested using Agda 2.6.1 and 2.6.1.3. Highlights ---------- * Reorganised module hierarchy in the dependency graph of the `IO` module so that a program as simple as "Hello world" may be compiled without pulling upwards of 130 modules. * First verified implementation of a sorting algorithm (available from `Data.List.Sort`). * Pseudo random generators for ℕ (available from `Data.Nat.Pseudorandom.LCG`) * Drastic increase in performance of normalised rational numbers. * Large number of additional proofs about both normalised and unnormalised rational numbers. Bug-fixes --------- * The sum operator `_⊎_` in `Data.Container.Indexed.Combinator` was not as universe polymorphic as it should have been. This has been fixed. The old, less universe polymorphic variant is still available under the new name `_⊎′_`. * The performance of the `gcd` operator over naturals and hence all operations in `Data.Rational.Base` has been drastically increased by using the new `<-wellFounded-fast` operation in `Data.Nat.Induction`. * The proof `isEquivalence` in `Function.Properties.(Equivalence/Inverse)` used to be defined in an anonymous module that took two unneccessary `Setoid` arguments: ```agda module _ (R : Setoid a ℓ₁) (S : Setoid b ℓ₂) where isEquivalence : IsEquivalence (Equivalence {a} {b}) ``` Their definitions have now been moved out of the anonymous modules so that they no longer require these unnecessary arguments. * Despite being designed for use with non-reflexive relations, the combinators in `Relation.Binary.Reasoning.Base.Partial` required users to provide a proof of reflexivity of the relation over the last element in the chain: ```agda begin x ⟨ x∼y ⟩ y ∎⟨ y∼y ⟩ ``` The combinators have been redefined so that this proof is no longer needed: ```agda begin x ⟨ x∼y ⟩ y ∎ ``` This is a backwards compatible change when using the `Relation.Binary.Reasoning.PartialSetoid` API directly as the old `_∎⟨_⟩` combinator has simply been deprecated. For users who were building their own reasoning combinators on top of `Relation.Binary.Reasoning.Base.Partial`, they will need to adjust their additional combinators to use the new `singleStep`/`multiStep` constructors of `_IsRelatedTo_`. * In `Relation.Binary.Reasoning.StrictPartialOrder` filled a missing argument to the re-exported `Relation.Binary.Reasoning.Base.Triple`. Non-backwards compatible changes -------------------------------- * `Data.String.Base` has been thinned to minimise its dependencies. The more complex functions (`parensIfSpace`, `wordsBy`, `words`, `linesBy`, `lines`, `rectangle`, `rectangleˡ`, `rectangleʳ`, `rectangleᶜ`) have been moved to `Data.String`. * In `Data.Tree.AVL.Indexed` the type alias `K&_` defined in terms of `Σ` has been changed into a standalone record to help with parameter inference. The record constructor remains the same so you will only observe the change if you are using functions explicitly expecting a pair (e.g. `(un)curry`). In this case you can use `Data.Tree.AVL.Value`'s `(to/from)Pair` to convert back and forth. * The new modules `Relation.Binary.Morphism.(Constant/Identity/Composition)` that were added in the last release no longer have module-level arguments. This is in order to allow proofs about newly added morphism bundles to be added to these files. This is only a breaking change if you were supplying the module arguments upon import, in which case you will have to change to supplying them upon application of the proofs. Deprecated modules ------------------ * The module `Text.Tree.Linear` has been deprecated, and its contents has been moved to `Data.Tree.Rose.Show`. Deprecated names ---------------- * In `Data.Nat.Properties`: ```agda m≤n⇒n⊔m≡n ↦ m≥n⇒m⊔n≡m m≤n⇒n⊓m≡m ↦ m≥n⇒m⊓n≡n n⊔m≡m⇒n≤m ↦ m⊔n≡n⇒m≤n n⊔m≡n⇒m≤n ↦ m⊔n≡m⇒n≤m n≤m⊔n ↦ m≤n⊔m ⊔-least ↦ ⊔-lub ⊓-greatest ↦ ⊓-glb ⊔-pres-≤m ↦ ⊔-lub ⊓-pres-m≤ ↦ ⊓-glb ⊔-abs-⊓ ↦ ⊔-absorbs-⊓ ⊓-abs-⊔ ↦ ⊓-absorbs-⊔ ∣m+n-m+o∣≡∣n-o| ↦ ∣m+n-m+o∣≡∣n-o∣ -- note final character is a \| rather than a | ``` * In `Data.Integer.Properties`: ```agda m≤n⇒m⊓n≡m ↦ i≤j⇒i⊓j≡i m⊓n≡m⇒m≤n ↦ i⊓j≡i⇒i≤j m≥n⇒m⊓n≡n ↦ i≥j⇒i⊓j≡j m⊓n≡n⇒m≥n ↦ i⊓j≡j⇒j≤i m⊓n≤n ↦ i⊓j≤j m⊓n≤m ↦ i⊓j≤i m≤n⇒m⊔n≡n ↦ i≤j⇒i⊔j≡j m⊔n≡n⇒m≤n ↦ i⊔j≡j⇒i≤j m≥n⇒m⊔n≡m ↦ i≥j⇒i⊔j≡i m⊔n≡m⇒m≥n ↦ i⊔j≡i⇒j≤i m≤m⊔n ↦ i≤i⊔j n≤m⊔n ↦ i≤j⊔i ``` * In `Relation.Binary.Consequences`: ```agda subst⟶respˡ ↦ subst⇒respˡ subst⟶respʳ ↦ subst⇒respʳ subst⟶resp₂ ↦ subst⇒resp₂ P-resp⟶¬P-resp ↦ resp⇒¬-resp total⟶refl ↦ total⇒refl total+dec⟶dec ↦ total∧dec⇒dec trans∧irr⟶asym ↦ trans∧irr⇒asym irr∧antisym⟶asym ↦ irr∧antisym⇒asym asym⟶antisym ↦ asym⇒antisym asym⟶irr ↦ asym⇒irr tri⟶asym ↦ tri⇒asym tri⟶irr ↦ tri⇒irr tri⟶dec≈ ↦ tri⇒dec≈ tri⟶dec< ↦ tri⇒dec< trans∧tri⟶respʳ≈ ↦ trans∧tri⇒respʳ trans∧tri⟶respˡ≈ ↦ trans∧tri⇒respˡ trans∧tri⟶resp≈ ↦ trans∧tri⇒resp dec⟶weaklyDec ↦ dec⇒weaklyDec dec⟶recomputable ↦ dec⇒recomputable ``` * In `Data.Rational.Properties`: ```agda neg-mono-<-> ↦ neg-mono-< neg-mono-≤-≥ ↦ neg-mono-≤ ``` New modules ----------- * Properties of cancellative commutative semirings: ``` Algebra.Properties.CancellativeCommutativeSemiring ``` * Specifications for min and max operators: ``` Algebra.Construct.NaturalChoice.MinOp Algebra.Construct.NaturalChoice.MaxOp Algebra.Construct.NaturalChoice.MinMaxOp ``` * Lexicographic product over algebraic structures: ``` Algebra.Construct.LexProduct Algebra.Construct.LexProduct.Base Algebra.Construct.LexProduct.Inner ``` * Properties of sums over semirings: ``` Algebra.Properties.Semiring.Sum ``` * Broke up `Codata.Musical.Colist` into a multitude of modules in order to simply module dependency graph: ``` Codata.Musical.Colist.Base Codata.Musical.Colist.Properties Codata.Musical.Colist.Bisimilarity Codata.Musical.Colist.Relation.Unary.All Codata.Musical.Colist.Relation.Unary.All.Properties Codata.Musical.Colist.Relation.Unary.Any Codata.Musical.Colist.Relation.Unary.Any.Properties ``` * Broke up `Data.List.Relation.Binary.Pointwise` into several modules in order to simply module dependency graph: ``` Data.List.Relation.Binary.Pointwise.Base Data.List.Relation.Binary.Pointwise.Properties ``` * Sorting algorithms over lists: ``` Data.List.Sort Data.List.Sort.Base Data.List.Sort.MergeSort ``` * A variant of the `Pointwise` relation over `Maybe` where `nothing` is also related to `just`: ``` Data.Maybe.Relation.Binary.Connected ``` * Linear congruential pseudo random generators for ℕ: ``` Data.Nat.PseudoRandom.LCG ``` /!\ NB: LCGs must not be used for cryptographic applications /!\ NB: the example parameters provided are not claimed to be good * Heterogeneous `All` predicate for disjoint sums: ``` Data.Sum.Relation.Unary.All ``` * Functions for printing trees: ``` Data.Tree.Rose.Show Data.Tree.Binary.Show ``` * Basic unary predicates for AVL trees: ``` Data.Tree.AVL.Indexed.Relation.Unary.All Data.Tree.AVL.Indexed.Relation.Unary.Any Data.Tree.AVL.Indexed.Relation.Unary.Any.Properties Data.Tree.AVL.Relation.Unary.Any Data.Tree.AVL.Map.Relation.Unary.Any ``` * Wrapping n-ary relations into a record definition so type-inference remembers the things being related: ``` Data.Wrap ``` (see `README.Data.Wrap` for an explanation) * Broke up `IO` into a many smaller modules: ``` IO.Base IO.Finite IO.Infinite ``` * Instantiate a homogeneously indexed bundle at a particular index: ``` Relation.Binary.Indexed.Homogeneous.Construct.At ``` * Bundles for binary relation morphisms: ``` Relation.Binary.Morphism.Bundles ``` Other minor additions --------------------- * Added new proofs to `Algebra.Consequences.Setoid`: ```agda comm+almostCancelˡ⇒almostCancelʳ : AlmostLeftCancellative e _•_ → AlmostRightCancellative e _•_ comm+almostCancelʳ⇒almostCancelˡ : AlmostRightCancellative e _•_ → AlmostLeftCancellative e _•_ ``` * Added new proofs in `Algebra.Morphism.GroupMonomorphism`: ```agda ⁻¹-distrib-∙ : ((x ◦ y) ⁻¹₂ ≈₂ (x ⁻¹₂) ◦ (y ⁻¹₂)) → ((x ∙ y) ⁻¹₁ ≈₁ (x ⁻¹₁) ∙ (y ⁻¹₁)) ``` * Added new proofs in `Algebra.Morphism.RingMonomorphism`: ```agda neg-distribˡ-* : ((⊝ (x ⊛ y)) ≈₂ ((⊝ x) ⊛ y)) → ((- (x * y)) ≈₁ ((- x) * y)) neg-distribʳ-* : ((⊝ (x ⊛ y)) ≈₂ (x ⊛ (⊝ y))) → ((- (x * y)) ≈₁ (x * (- y))) ``` * Added new proofs in `Algebra.Properties.Magma.Divisibility`: ```agda ∣∣-sym : Symmetric _∣∣_ ∣∣-respʳ-≈ : _∣∣_ Respectsʳ _≈_ ∣∣-respˡ-≈ : _∣∣_ Respectsˡ _≈_ ∣∣-resp-≈ : _∣∣_ Respects₂ _≈_ ``` * Added new proofs in `Algebra.Properties.Semigroup.Divisibility`: ```agda ∣∣-trans : Transitive _∣∣_ ``` * Added new proofs in `Algebra.Properties.CommutativeSemigroup.Divisibility`: ```agda x∣y∧z∣x/y⇒xz∣y : ((x/y , _) : x ∣ y) → z ∣ x/y → x ∙ z ∣ y x∣y⇒zx∣zy : x ∣ y → z ∙ x ∣ z ∙ y ``` * Added new proofs in `Algebra.Properties.Monoid.Divisibility`: ```agda ∣∣-refl : Reflexive _∣∣_ ∣∣-reflexive : _≈_ ⇒ _∣∣_ ∣∣-isEquivalence : IsEquivalence _∣∣_ ``` * Added new proofs in `Algebra.Properties.CancellativeCommutativeSemiring`: ```agda xy≈0⇒x≈0∨y≈0 : Decidable _≈_ → x * y ≈ 0# → x ≈ 0# ⊎ y ≈ 0# x≉0∧y≉0⇒xy≉0 : Decidable _≈_ → x ≉ 0# → y ≉ 0# → x * y ≉ 0# xy∣x⇒y∣1 : x ≉ 0# → x * y ∣ x → y ∣ 1# ``` * Added new functions to `Codata.Stream`: ```agda nats : Stream ℕ ∞ interleave⁺ : List⁺ (Stream A i) → Stream A i cantor : Stream (Stream A ∞) ∞ → Stream A ∞ plane : Stream A ∞ → ((a : A) → Stream (B a) ∞) → Stream (Σ A B) ∞ ``` * Added new function in `Data.Char.Base`: ```agda _≈ᵇ_ : (c d : Char) → Bool ``` * Added new operations to `Data.Fin.Base`: ```agda remQuot : remQuot : ∀ k → Fin (n * k) → Fin n × Fin k combine : Fin n → Fin k → Fin (n * k) ``` * Added new proofs to `Data.Fin.Properties`: ```agda remQuot-combine : ∀ x y → remQuot k (combine x y) ≡ (x , y) combine-remQuot : ∀ k i → uncurry combine (remQuot k i) ≡ i *↔× : Fin (m * n) ↔ (Fin m × Fin n) ``` * Added new operations to `Data.Fin.Subset`: ```agda _─_ : Op₂ (Subset n) _-_ : Subset n → Fin n → Subset n ``` * Added new proofs to `Data.Fin.Subset.Properties`: ```agda s⊂s : p ⊂ q → s ∷ p ⊂ s ∷ q ∣p∣≤∣x∷p∣ : ∣ p ∣ ≤ ∣ x ∷ p ∣ p─⊥≡p : p ─ ⊥ ≡ p p─⊤≡⊥ : p ─ ⊤ ≡ ⊥ p─q─r≡p─q∪r : p ─ q ─ r ≡ p ─ (q ∪ r) p─q─r≡p─r─q : p ─ q ─ r ≡ p ─ r ─ q p─q─q≡p─q : p ─ q ─ q ≡ p ─ q p─q⊆p : p ─ q ⊆ p ∣p─q∣≤∣p∣ : ∣ p ─ q ∣ ≤ ∣ p ∣ p∩q≢∅⇒p─q⊂p : Nonempty (p ∩ q) → p ─ q ⊂ p p∩q≢∅⇒∣p─q∣<∣p∣ : Nonempty (p ∩ q) → ∣ p ─ q ∣ < ∣ p ∣ x∈p∧x∉q⇒x∈p─q : x ∈ p → x ∉ q → x ∈ p ─ q p─x─y≡p─y─x : p - x - y ≡ p - y - x x∈p⇒p-x⊂p : x ∈ p → p - x ⊂ p x∈p⇒∣p-x∣<∣p∣ : x ∈ p → ∣ p - x ∣ < ∣ p ∣ x∈p∧x≢y⇒x∈p-y : x ∈ p → x ≢ y → x ∈ p - y ``` * Added new relation to `Data.Integer.Base`: ```agda _≤ᵇ_ : ℤ → ℤ → Bool ``` * Added new proofs to `Data.Integer.Properties`: ```agda ≤-isTotalPreorder : IsTotalPreorder _≡_ _≤_ ≤-totalPreorder : TotalPreorder 0ℓ 0ℓ 0ℓ ≤ᵇ⇒≤ : T (i ≤ᵇ j) → i ≤ j ≤⇒≤ᵇ : i ≤ j → T (i ≤ᵇ j) m*n≡0⇒m≡0∨n≡0 : m * n ≡ 0ℤ → m ≡ 0ℤ ⊎ n ≡ 0ℤ ⊓-distribˡ-⊔ : _⊓_ DistributesOverˡ _⊔_ ⊓-distribʳ-⊔ : _⊓_ DistributesOverʳ _⊔_ ⊓-distrib-⊔ : _⊓_ DistributesOver _⊔_ ⊔-distribˡ-⊓ : _⊔_ DistributesOverˡ _⊓_ ⊔-distribʳ-⊓ : _⊔_ DistributesOverʳ _⊓_ ⊔-distrib-⊓ : _⊔_ DistributesOver _⊓_ ⊔-⊓-isDistributiveLattice : IsDistributiveLattice _⊔_ _⊓_ ⊓-⊔-isDistributiveLattice : IsDistributiveLattice _⊓_ _⊔_ ⊔-⊓-distributiveLattice : DistributiveLattice _ _ ⊓-⊔-distributiveLattice : DistributiveLattice _ _ ⊓-glb : m ≥ o → n ≥ o → m ⊓ n ≥ o ⊓-triangulate : m ⊓ n ⊓ o ≡ (m ⊓ n) ⊓ (n ⊓ o) ⊓-mono-≤ : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊓-monoˡ-≤ : (_⊓ n) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ : (n ⊓_) Preserves _≤_ ⟶ _≤_ ⊔-lub : m ≤ o → n ≤ o → m ⊔ n ≤ o ⊔-triangulate : m ⊔ n ⊔ o ≡ (m ⊔ n) ⊔ (n ⊔ o) ⊔-mono-≤ : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊔-monoˡ-≤ : (_⊔ n) Preserves _≤_ ⟶ _≤_ ⊔-monoʳ-≤ : (n ⊔_) Preserves _≤_ ⟶ _≤_ i≤j⇒i⊓k≤j : i ≤ j → i ⊓ k ≤ j i≤j⇒k⊓i≤j : i ≤ j → k ⊓ i ≤ j i≤j⊓k⇒i≤j : i ≤ j ⊓ k → i ≤ j i≤j⊓k⇒i≤k : i ≤ j ⊓ k → i ≤ k i≤j⇒i≤j⊔k : i ≤ j → i ≤ j ⊔ k i≤j⇒i≤k⊔j : i ≤ j → i ≤ k ⊔ j i⊔j≤k⇒i≤k : i ⊔ j ≤ k → i ≤ k i⊔j≤k⇒j≤k : i ⊔ j ≤ k → j ≤ k i⊓j≤i⊔j : i ⊓ j ≤ i ⊔ j +-*-commutativeSemiring : CommutativeSemiring 0ℓ 0ℓ ``` * Added new functions in `Data.List.Base`: ```agda last : List A → Maybe A merge : Decidable R → List A → List A → List A ``` * Added new proof in `Data.List.Properties`: ```agda length-partition : (let (ys , zs) = partition P? xs) → length ys ≤ length xs × length zs ≤ length xs ``` * Added new proofs in `Data.List.Relation.Unary.All.Properties`: ```agda head⁺ : All P xs → Maybe.All P (head xs) tail⁺ : All P xs → Maybe.All (All P) (tail xs) last⁺ : All P xs → Maybe.All P (last xs) uncons⁺ : All P xs → Maybe.All (P ⟨×⟩ All P) (uncons xs) uncons⁻ : Maybe.All (P ⟨×⟩ All P) (uncons xs) → All P xs unsnoc⁺ : All P xs → Maybe.All (All P ⟨×⟩ P) (unsnoc xs) unsnoc⁻ : Maybe.All (All P ⟨×⟩ P) (unsnoc xs) → All P xs dropWhile⁺ : (Q? : Decidable Q) → All P xs → All P (dropWhile Q? xs) dropWhile⁻ : (P? : Decidable P) → dropWhile P? xs ≡ [] → All P xs takeWhile⁺ : (Q? : Decidable Q) → All P xs → All P (takeWhile Q? xs) takeWhile⁻ : (P? : Decidable P) → takeWhile P? xs ≡ xs → All P xs all-head-dropWhile : (P? : Decidable P) → ∀ xs → Maybe.All (∁ P) (head (dropWhile P? xs)) all-takeWhile : (P? : Decidable P) → ∀ xs → All P (takeWhile P? xs) all-upTo : All (_< n) (upTo n) ``` * Added new proof in `Data.List.Relation.Unary.First.Properties`: ```agda cofirst? : Decidable P → Decidable (First (∁ P) P) ``` * Added new operations in `Data.List.Relation.Unary.Linked`: ```agda head′ : Linked R (x ∷ xs) → Connected R (just x) (head xs) _∷′_ : Connected R (just x) (head xs) → Linked R xs → Linked R (x ∷ xs) ``` * Generalised the type of operation `tail` in `Data.List.Relation.Unary.Linked` from `Linked R (x ∷ y ∷ xs) → Linked R (y ∷ xs)` to `Linked R (x ∷ xs) → Linked R xs`. * Added new proof in `Data.List.Relation.Unary.Linked.Properties`: ```agda ++⁺ : Linked R xs → Connected R (last xs) (head ys) → Linked R ys → Linked R (xs ++ ys) ``` * Added new proof in `Data.List.Relation.Unary.Sorted.TotalOrder.Properties`: ```agda ++⁺ : Sorted O xs → Connected _≤_ (last xs) (head ys) → Sorted O ys → Sorted O (xs ++ ys) merge⁺ : Sorted O xs → Sorted O ys → Sorted O (merge _≤?_ xs ys) ``` * Added new proof to `Data.List.Relation.Binary.Equality.Setoid`: ```agda foldr⁺ : (w ≈ x → y ≈ z → (w • y) ≈ (x ◦ z)) → e ≈ f → xs ≋ ys → foldr _•_ e xs ≈ foldr _◦_ f ys ``` * Added new proof in `Data.List.Relation.Binary.Permutation.Setoid.Properties`: ```agda ↭-shift : xs ++ [ v ] ++ ys ↭ v ∷ xs ++ ys ↭-merge : merge R? xs ys ↭ xs ++ ys ↭-partition : (let ys , zs = partition P? xs) → xs ↭ ys ++ zs ``` * Added new proofs to `Data.List.Relation.Binary.Pointwise.Properties`: ```agda foldr⁺ : (R w x → R y z → R (w • y) (x ◦ z)) → R e f → Pointwise R xs ys → R (foldr _•_ e xs) (foldr _◦_ f ys) lookup⁻ : length xs ≡ length ys → (toℕ i ≡ toℕ j → R (lookup xs i) (lookup ys j)) → Pointwise R xs ys lookup⁺ : (Rxys : Pointwise R xs ys) → ∀ i → (let j = cast (Pointwise-length Rxys) i) → R (lookup xs i) (lookup ys j) ``` * Added new proof to `Data.List.Relation.Binary.Subset.(Setoid/Propositional).Properties`: ```agda xs⊆x∷xs : xs ⊆ x ∷ xs ∷⁺ʳ : xs ⊆ ys → x ∷ xs ⊆ x ∷ ys ∈-∷⁺ʳ : x ∈ ys → xs ⊆ ys → x ∷ xs ⊆ ys applyUpTo⁺ : m ≤ n → applyUpTo f m ⊆ applyUpTo f n ``` * Added new proofs in `Data.Maybe.Relation.Unary.All.Properties`: ```agda All⇒Connectedˡ : All (R x) y → Connected R (just x) y All⇒Connectedʳ : All (λ v → R v y) x → Connected R x (just y ``` * Added new definition in `Data.Nat.Base`: ```agda _≤ᵇ_ : (m n : ℕ) → Bool ``` * Added new proofs to `Data.Nat.DivMod`: ```agda m⇒≢ : _>_ ⇒ _≢_ pred[n]≤n : pred n ≤ n n<1⇒n≡0 : n < 1 → n ≡ 0 m_ neg-antimono-≤ : -_ Preserves _≤_ ⟶ _≥_ neg-pos : Positive p → Negative (- p) normalize-cong : m₁ ≡ m₂ → n₁ ≡ n₂ → normalize m₁ n₁ ≡ normalize m₂ n₂ normalize-nonNeg : NonNegative (normalize m n) normalize-pos : NonZero m → Positive (normalize m n) normalize-injective-≃ : normalize m c ≡ normalize n d → m ℕ.* d ≡ n ℕ.* c /-injective-≃ : ↥ᵘ p / ↧ₙᵘ p ≡ ↥ᵘ q / ↧ₙᵘ q → p ≃ᵘ q fromℚᵘ-injective : Injective _≃ᵘ_ _≡_ fromℚᵘ toℚᵘ-fromℚᵘ : toℚᵘ (fromℚᵘ p) ≃ᵘ p fromℚᵘ-cong : fromℚᵘ Preserves _≃ᵘ_ ⟶ _≡_ ≤-isTotalPreorder : IsTotalPreorder _≡_ _≤_ ≤-totalPreorder : TotalPreorder 0ℓ 0ℓ 0ℓ toℚᵘ-mono-< : p < q → toℚᵘ p <ᵘ toℚᵘ q toℚᵘ-cancel-< : toℚᵘ p <ᵘ toℚᵘ q → p < q toℚᵘ-isOrderHomomorphism-< : IsOrderHomomorphism _≡_ _≃ᵘ_ _<_ _<ᵘ_ toℚᵘ toℚᵘ-isOrderMonomorphism-< : IsOrderMonomorphism _≡_ _≃ᵘ_ _<_ _<ᵘ_ toℚᵘ ≤ᵇ⇒≤ : T (p ≤ᵇ q) → p ≤ q ≤⇒≤ᵇ : p ≤ q → T (p ≤ᵇ q) +-mono-≤ : _+_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +-monoˡ-≤ : (_+ r) Preserves _≤_ ⟶ _≤_ +-monoʳ-≤ : (_+_ r) Preserves _≤_ ⟶ _≤_ +-mono-<-≤ : _+_ Preserves₂ _<_ ⟶ _≤_ ⟶ _<_ +-mono-< : _+_ Preserves₂ _<_ ⟶ _<_ ⟶ _<_ +-monoˡ-< : (_+ r) Preserves _<_ ⟶ _<_ +-monoʳ-< : (_+_ r) Preserves _<_ ⟶ _<_ neg-distrib-+ : - (p + q) ≡ (- p) + (- q) *-inverseʳ : p * (1/ p) ≡ 1ℚ *-inverseˡ : (1/ p) * p ≡ 1ℚ *-monoʳ-≤-pos : Positive r → (_* r) Preserves _≤_ ⟶ _≤_ *-monoˡ-≤-pos : Positive r → (r *_) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-neg : Negative r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-neg : Negative r → (r *_) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-nonNeg : NonNegative r → (_* r) Preserves _≤_ ⟶ _≤_ *-monoˡ-≤-nonNeg : NonNegative r → (r *_) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-nonPos : NonPositive r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-nonPos : NonPositive r → (r *_) Preserves _≤_ ⟶ _≥_ *-monoˡ-<-pos : Positive r → (_* r) Preserves _<_ ⟶ _<_ *-monoʳ-<-pos : Positive r → (r *_) Preserves _<_ ⟶ _<_ *-monoˡ-<-neg : Negative r → (_* r) Preserves _<_ ⟶ _>_ *-monoʳ-<-neg : Negative r → (r *_) Preserves _<_ ⟶ _>_ *-cancelʳ-≤-pos : Positive r → p * r ≤ q * r → p ≤ q *-cancelˡ-≤-pos : Positive r → r * p ≤ r * q → p ≤ q *-cancelʳ-≤-neg : Negative r → p * r ≤ q * r → p ≥ q *-cancelˡ-≤-neg : Negative r → r * p ≤ r * q → p ≥ q *-cancelˡ-<-pos : Positive r → r * p < r * q → p < q *-cancelʳ-<-pos : Positive r → p * r < q * r → p < q *-cancelˡ-<-neg : Negative r → r * p < r * q → p > q *-cancelʳ-<-neg : Negative r → p * r < q * r → p > q *-cancelˡ-<-nonPos : NonPositive r → r * p < r * q → p > q *-cancelʳ-<-nonPos : NonPositive r → p * r < q * r → p > q *-cancelˡ-<-nonNeg : NonNegative r → r * p < r * q → p < q *-cancelʳ-<-nonNeg : NonNegative r → p * r < q * r → p < q neg-distribˡ-* : - (p * q) ≡ - p * q neg-distribʳ-* : - (p * q) ≡ p * - q p≤q⇒p⊔q≡q : p ≤ q → p ⊔ q ≡ q p≥q⇒p⊔q≡p : p ≥ q → p ⊔ q ≡ p p≤q⇒p⊓q≡p : p ≤ q → p ⊓ q ≡ p p≥q⇒p⊓q≡q : p ≥ q → p ⊓ q ≡ q ⊓-idem : Idempotent _⊓_ ⊓-sel : Selective _⊓_ ⊓-assoc : Associative _⊓_ ⊓-comm : Commutative _⊓_ ⊔-idem : Idempotent _⊔_ ⊔-sel : Selective _⊔_ ⊔-assoc : Associative _⊔_ ⊔-comm : Commutative _⊔_ ⊓-distribˡ-⊔ : _⊓_ DistributesOverˡ _⊔_ ⊓-distribʳ-⊔ : _⊓_ DistributesOverʳ _⊔_ ⊓-distrib-⊔ : _⊓_ DistributesOver _⊔_ ⊔-distribˡ-⊓ : _⊔_ DistributesOverˡ _⊓_ ⊔-distribʳ-⊓ : _⊔_ DistributesOverʳ _⊓_ ⊔-distrib-⊓ : _⊔_ DistributesOver _⊓_ ⊓-absorbs-⊔ : _⊓_ Absorbs _⊔_ ⊔-absorbs-⊓ : _⊔_ Absorbs _⊓_ ⊔-⊓-absorptive : Absorptive _⊔_ _⊓_ ⊓-⊔-absorptive : Absorptive _⊓_ _⊔_ ⊓-isMagma : IsMagma _⊓_ ⊓-isSemigroup : IsSemigroup _⊓_ ⊓-isCommutativeSemigroup : IsCommutativeSemigroup _⊓_ ⊓-isBand : IsBand _⊓_ ⊓-isSemilattice : IsSemilattice _⊓_ ⊓-isSelectiveMagma : IsSelectiveMagma _⊓_ ⊔-isMagma : IsMagma _⊔_ ⊔-isSemigroup : IsSemigroup _⊔_ ⊔-isCommutativeSemigroup : IsCommutativeSemigroup _⊔_ ⊔-isBand : IsBand _⊔_ ⊔-isSemilattice : IsSemilattice _⊔_ ⊔-isSelectiveMagma : IsSelectiveMagma _⊔_ ⊔-⊓-isLattice : IsLattice _⊔_ _⊓_ ⊓-⊔-isLattice : IsLattice _⊓_ _⊔_ ⊔-⊓-isDistributiveLattice : IsDistributiveLattice _⊔_ _⊓_ ⊓-⊔-isDistributiveLattice : IsDistributiveLattice _⊓_ _⊔_ ⊓-magma : Magma _ _ ⊓-semigroup : Semigroup _ _ ⊓-band : Band _ _ ⊓-commutativeSemigroup : CommutativeSemigroup _ _ ⊓-semilattice : Semilattice _ _ ⊓-selectiveMagma : SelectiveMagma _ _ ⊔-magma : Magma _ _ ⊔-semigroup : Semigroup _ _ ⊔-band : Band _ _ ⊔-commutativeSemigroup : CommutativeSemigroup _ _ ⊔-semilattice : Semilattice _ _ ⊔-selectiveMagma : SelectiveMagma _ _ ⊔-⊓-lattice : Lattice _ _ ⊓-⊔-lattice : Lattice _ _ ⊔-⊓-distributiveLattice : DistributiveLattice _ _ ⊓-⊔-distributiveLattice : DistributiveLattice _ _ ⊓-glb : p ≥ r → q ≥ r → p ⊓ q ≥ r ⊓-triangulate : p ⊓ q ⊓ r ≡ (p ⊓ q) ⊓ (q ⊓ r) ⊓-mono-≤ : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊓-monoˡ-≤ : (_⊓ p) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ : (p ⊓_) Preserves _≤_ ⟶ _≤_ ⊔-lub : p ≤ r → q ≤ r → p ⊔ q ≤ r ⊔-triangulate : p ⊔ q ⊔ r ≡ (p ⊔ q) ⊔ (q ⊔ r) ⊔-mono-≤ : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊔-monoˡ-≤ : (_⊔ p) Preserves _≤_ ⟶ _≤_ ⊔-monoʳ-≤ : (p ⊔_) Preserves _≤_ ⟶ _≤_ p⊓q≡q⇒q≤p : p ⊓ q ≡ q → q ≤ p p⊓q≡p⇒p≤q : p ⊓ q ≡ p → p ≤ q p⊓q≤p : p ⊓ q ≤ p p⊓q≤q : p ⊓ q ≤ q p≤q⇒p⊓r≤q : p ≤ q → p ⊓ r ≤ q p≤q⇒r⊓p≤q : p ≤ q → r ⊓ p ≤ q p≤q⊓r⇒p≤q : p ≤ q ⊓ r → p ≤ q p≤q⊓r⇒p≤r : p ≤ q ⊓ r → p ≤ r p⊔q≡q⇒p≤q : p ⊔ q ≡ q → p ≤ q p⊔q≡p⇒q≤p : p ⊔ q ≡ p → q ≤ p p≤p⊔q : p ≤ p ⊔ q p≤q⊔p : p ≤ q ⊔ p p≤q⇒p≤q⊔r : p ≤ q → p ≤ q ⊔ r p≤q⇒p≤r⊔q : p ≤ q → p ≤ r ⊔ q p⊔q≤r⇒p≤r : p ⊔ q ≤ r → p ≤ r p⊔q≤r⇒q≤r : p ⊔ q ≤ r → q ≤ r p⊓q≤p⊔q : p ⊓ q ≤ p ⊔ q mono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≤_ → f (p ⊔ q) ≡ f p ⊔ f q mono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≤_ → f (p ⊓ q) ≡ f p ⊓ f q mono-<-distrib-⊓ : f Preserves _<_ ⟶ _<_ → f (p ⊓ q) ≡ f p ⊓ f q mono-<-distrib-⊔ : f Preserves _<_ ⟶ _<_ → f (p ⊔ q) ≡ f p ⊔ f q antimono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≥_ → f (p ⊓ q) ≡ f p ⊔ f q antimono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≥_ → f (p ⊔ q) ≡ f p ⊓ f q *-distribˡ-⊓-nonNeg : NonNegative p → p * (q ⊓ r) ≡ (p * q) ⊓ (p * r) *-distribʳ-⊓-nonNeg : NonNegative p → (q ⊓ r) * p ≡ (q * p) ⊓ (r * p) *-distribˡ-⊔-nonNeg : NonNegative p → p * (q ⊔ r) ≡ (p * q) ⊔ (p * r) *-distribʳ-⊔-nonNeg : NonNegative p → (q ⊔ r) * p ≡ (q * p) ⊔ (r * p) *-distribˡ-⊔-nonPos : NonPositive p → p * (q ⊔ r) ≡ (p * q) ⊓ (p * r) *-distribʳ-⊔-nonPos : NonPositive p → (q ⊔ r) * p ≡ (q * p) ⊓ (r * p) *-distribˡ-⊓-nonPos : NonPositive p → p * (q ⊓ r) ≡ (p * q) ⊔ (p * r) *-distribʳ-⊓-nonPos : NonPositive p → (q ⊓ r) * p ≡ (q * p) ⊔ (r * p) 1/-involutive : 1/ (1/ p) ≡ p pos⇒1/pos : Positive p → Positive (1/ p) neg⇒1/neg : Negative p → Negative (1/ p) 1/pos⇒pos : Positive (1/ p) → Positive p 1/neg⇒neg : Negative (1/ p) → Negative p toℚᵘ-homo-∣_∣ : Homomorphic₁ toℚᵘ ∣_∣ ℚᵘ.∣_∣ ∣-∣-nonNeg : NonNegative ∣ p ∣ 0≤∣p∣ : 0ℚ ≤ ∣ p ∣ 0≤p⇒∣p∣≡p : 0ℚ ≤ p → ∣ p ∣ ≡ p ∣p∣≡p⇒0≤p : ∣ p ∣ ≡ p → 0ℚ ≤ p ∣-p∣≡∣p∣ : ∣ - p ∣ ≡ ∣ p ∣ ∣p∣≡0⇒p≡0 : ∣ p ∣ ≡ 0ℚ → p ≡ 0ℚ ∣p∣≡p∨∣p∣≡-p : ∣ p ∣ ≡ p ⊎ ∣ p ∣ ≡ - p ∣p+q∣≤∣p∣+∣q∣ : ∣ p + q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p-q∣≤∣p∣+∣q∣ : ∣ p - q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p*q∣≡∣p∣*∣q∣ : ∣ p * q ∣ ≡ ∣ p ∣ * ∣ q ∣ ∣∣p∣∣≡∣p∣ : ∣ ∣ p ∣ ∣ ≡ ∣ p ∣ ``` * Add new relations and functions to `Data.Rational.Unnormalised.Base`: ```agda _≤ᵇ_ : ℤ → ℤ → Bool _⊔_ : (p q : ℚᵘ) → ℚᵘ _⊓_ : (p q : ℚᵘ) → ℚᵘ ∣_∣ : ℚᵘ → ℚᵘ ``` * Add new proofs to `Data.Rational.Unnormalised.Properties`: ```agda /-cong : p₁ ≡ p₂ → q₁ ≡ q₂ → p₁ / q₁ ≡ p₂ / q₂ ↥[p/q]≡p : ↥ (p / q) ≡ p ↧[p/q]≡q : ↧ (p / q) ≡ ℤ.+ q ≤-respˡ-≃ : _≤_ Respectsˡ _≃_ ≤-respʳ-≃ : _≤_ Respectsʳ _≃_ ≤-resp₂-≃ : _≤_ Respects₂ _≃_ ≤-isPreorder : IsPreorder _≃_ _≤_ ≤-isPreorder-≡ : IsPreorder _≡_ _≤_ ≤-isTotalPreorder : IsTotalPreorder _≃_ _≤_ ≤-isTotalPreorder-≡ : IsTotalPreorder _≡_ _≤_ ≤-preorder : Preorder 0ℓ 0ℓ 0ℓ ≤-preorder-≡ : Preorder 0ℓ 0ℓ 0ℓ ≤-totalPreorder : TotalPreorder 0ℓ 0ℓ 0ℓ ≤-totalPreorder-≡ : TotalPreorder 0ℓ 0ℓ 0ℓ ≤ᵇ⇒≤ : T (p ≤ᵇ q) → p ≤ q ≤⇒≤ᵇ : p ≤ q → T (p ≤ᵇ q) p+p≃0⇒p≃0 : p + p ≃ 0ℚᵘ → p ≃ 0ℚᵘ p≃-p⇒p≃0 : p ≃ - p → p ≃ 0ℚᵘ neg-cancel-< : - p < - q → q < p neg-cancel-≤-≥ : - p ≤ - q → q ≤ p mono⇒cong : f Preserves _≤_ ⟶ _≤_ → f Preserves _≃_ ⟶ _≃_ antimono⇒cong : f Preserves _≤_ ⟶ _≥_ → f Preserves _≃_ ⟶ _≃_ *-congˡ : LeftCongruent _≃_ _*_ *-congʳ : RightCongruent _≃_ _*_ *-cancelˡ-/ : (ℤ.+ p ℤ.* q) / (p ℕ.* r) ≃ q / r *-cancelʳ-/ : (q ℤ.* ℤ.+ p) / (r ℕ.* p) ≃ q / r *-cancelʳ-≤-neg : Negative r → p * r ≤ q * r → q ≤ p *-cancelˡ-≤-neg : Negative r → r * p ≤ r * q → q ≤ p *-monoˡ-≤-nonPos : NonPositive r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-nonPos : NonPositive r → (r *_) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-neg : Negative r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-neg : Negative r → (r *_) Preserves _≤_ ⟶ _≥_ *-cancelˡ-<-pos : Positive r → r * p < r * q → p < q *-cancelʳ-<-pos : Positive r → p * r < q * r → p < q *-monoˡ-<-neg : Negative r → (_* r) Preserves _<_ ⟶ _>_ *-monoʳ-<-neg : Negative r → (r *_) Preserves _<_ ⟶ _>_ *-cancelˡ-<-nonPos : NonPositive r → r * p < r * q → q < p *-cancelʳ-<-nonPos : NonPositive r → p * r < q * r → q < p *-cancelˡ-<-neg : Negative r → r * p < r * q → q < p *-cancelʳ-<-neg : Negative r → p * r < q * r → q < p pos⇒1/pos : Positive q → Positive (1/ q) neg⇒1/neg : Negative q → Negative (1/ q) 1/-involutive-≡ : 1/ (1/ q) ≡ q 1/-involutive : 1/ (1/ q) ≃ q p>1⇒1/p<1 : p > 1ℚᵘ → (1/ p) < 1ℚᵘ ⊓-congˡ : LeftCongruent _≃_ _⊓_ ⊓-congʳ : RightCongruent _≃_ _⊓_ ⊓-cong : Congruent₂ _≃_ _⊓_ ⊓-idem : Idempotent _≃_ _⊓_ ⊓-sel : Selective _≃_ _⊓_ ⊓-assoc : Associative _≃_ _⊓_ ⊓-comm : Commutative _≃_ _⊓_ ⊔-congˡ : LeftCongruent _≃_ _⊔_ ⊔-congʳ : RightCongruent _≃_ _⊔_ ⊔-cong : Congruent₂ _≃_ _⊔_ ⊔-idem : Idempotent _≃_ _⊔_ ⊔-sel : Selective _≃_ _⊔_ ⊔-assoc : Associative _≃_ _⊔_ ⊔-comm : Commutative _≃_ _⊔_ ⊓-distribˡ-⊔ : _DistributesOverˡ_ _≃_ _⊓_ _⊔_ ⊓-distribʳ-⊔ : _DistributesOverʳ_ _≃_ _⊓_ _⊔_ ⊓-distrib-⊔ : _DistributesOver_ _≃_ _⊓_ _⊔_ ⊔-distribˡ-⊓ : _DistributesOverˡ_ _≃_ _⊔_ _⊓_ ⊔-distribʳ-⊓ : _DistributesOverʳ_ _≃_ _⊔_ _⊓_ ⊔-distrib-⊓ : _DistributesOver_ _≃_ _⊔_ _⊓_ ⊓-absorbs-⊔ : _Absorbs_ _≃_ _⊓_ _⊔_ ⊔-absorbs-⊓ : _Absorbs_ _≃_ _⊔_ _⊓_ ⊔-⊓-absorptive : Absorptive _≃_ _⊔_ _⊓_ ⊓-⊔-absorptive : Absorptive _≃_ _⊓_ _⊔_ ⊓-isMagma : IsMagma _≃_ _⊓_ ⊓-isSemigroup : IsSemigroup _≃_ _⊓_ ⊓-isCommutativeSemigroup : IsCommutativeSemigroup _≃_ _⊓_ ⊓-isBand : IsBand _≃_ _⊓_ ⊓-isSemilattice : IsSemilattice _≃_ _⊓_ ⊓-isSelectiveMagma : IsSelectiveMagma _≃_ _⊓_ ⊔-isMagma : IsMagma _≃_ _⊔_ ⊔-isSemigroup : IsSemigroup _≃_ _⊔_ ⊔-isCommutativeSemigroup : IsCommutativeSemigroup _≃_ _⊔_ ⊔-isBand : IsBand _≃_ _⊔_ ⊔-isSemilattice : IsSemilattice _≃_ _⊔_ ⊔-isSelectiveMagma : IsSelectiveMagma _≃_ _⊔_ ⊔-⊓-isLattice : IsLattice _≃_ _⊔_ _⊓_ ⊓-⊔-isLattice : IsLattice _≃_ _⊓_ _⊔_ ⊔-⊓-isDistributiveLattice : IsDistributiveLattice _≃_ _⊔_ _⊓_ ⊓-⊔-isDistributiveLattice : IsDistributiveLattice _≃_ _⊓_ _⊔_ ⊓-rawMagma : RawMagma _ _ ⊔-rawMagma : RawMagma _ _ ⊔-⊓-rawLattice : RawLattice _ _ ⊓-magma : Magma _ _ ⊓-semigroup : Semigroup _ _ ⊓-band : Band _ _ ⊓-commutativeSemigroup : CommutativeSemigroup _ _ ⊓-semilattice : Semilattice _ _ ⊓-selectiveMagma : SelectiveMagma _ _ ⊔-magma : Magma _ _ ⊔-semigroup : Semigroup _ _ ⊔-band : Band _ _ ⊔-commutativeSemigroup : CommutativeSemigroup _ _ ⊔-semilattice : Semilattice _ _ ⊔-selectiveMagma : SelectiveMagma _ _ ⊔-⊓-lattice : Lattice _ _ ⊓-⊔-lattice : Lattice _ _ ⊔-⊓-distributiveLattice : DistributiveLattice _ _ ⊓-⊔-distributiveLattice : DistributiveLattice _ _ ⊓-triangulate : p ⊓ q ⊓ r ≃ (p ⊓ q) ⊓ (q ⊓ r) ⊔-triangulate : p ⊔ q ⊔ r ≃ (p ⊔ q) ⊔ (q ⊔ r) ⊓-glb : p ≥ r → q ≥ r → p ⊓ q ≥ r ⊓-mono-≤ : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊓-monoˡ-≤ : (_⊓ p) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ : (p ⊓_) Preserves _≤_ ⟶ _≤_ ⊔-lub : p ≤ r → q ≤ r → p ⊔ q ≤ r ⊔-mono-≤ : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊔-monoˡ-≤ : (_⊔ p) Preserves _≤_ ⟶ _≤_ ⊔-monoʳ-≤ : (p ⊔_) Preserves _≤_ ⟶ _≤_ p⊓q≃q⇒q≤p : p ⊓ q ≃ q → q ≤ p p⊓q≃p⇒p≤q : p ⊓ q ≃ p → p ≤ q p⊔q≃q⇒p≤q : p ⊔ q ≃ q → p ≤ q p⊔q≃p⇒q≤p : p ⊔ q ≃ p → q ≤ p p⊓q≤p : p ⊓ q ≤ p p⊓q≤q : p ⊓ q ≤ q p≤q⇒p⊓r≤q : p ≤ q → p ⊓ r ≤ q p≤q⇒r⊓p≤q : p ≤ q → r ⊓ p ≤ q p≤q⊓r⇒p≤q : p ≤ q ⊓ r → p ≤ q p≤q⊓r⇒p≤r : p ≤ q ⊓ r → p ≤ r p≤p⊔q : p ≤ p ⊔ q p≤q⊔p : p ≤ q ⊔ p p≤q⇒p≤q⊔r : p ≤ q → p ≤ q ⊔ r p≤q⇒p≤r⊔q : p ≤ q → p ≤ r ⊔ q p⊔q≤r⇒p≤r : p ⊔ q ≤ r → p ≤ r p⊔q≤r⇒q≤r : p ⊔ q ≤ r → q ≤ r p≤q⇒p⊔q≃q : p ≤ q → p ⊔ q ≃ q p≥q⇒p⊔q≃p : p ≥ q → p ⊔ q ≃ p p≤q⇒p⊓q≃p : p ≤ q → p ⊓ q ≃ p p≥q⇒p⊓q≃q : p ≥ q → p ⊓ q ≃ q p⊓q≤p⊔q : p ⊓ q ≤ p ⊔ q mono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≤_ → f (m ⊔ n) ≃ f m ⊔ f n mono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≤_ → f (m ⊓ n) ≃ f m ⊓ f n antimono-≤-distrib-⊓ : f Preserves _≤_ ⟶ _≥_ → f (m ⊓ n) ≃ f m ⊔ f n antimono-≤-distrib-⊔ : f Preserves _≤_ ⟶ _≥_ → f (m ⊔ n) ≃ f m ⊓ f n neg-distrib-⊔-⊓ : - (p ⊔ q) ≃ - p ⊓ - q neg-distrib-⊓-⊔ : - (p ⊓ q) ≃ - p ⊔ - q *-distribˡ-⊓-nonNeg : NonNegative p → p * (q ⊓ r) ≃ (p * q) ⊓ (p * r) *-distribʳ-⊓-nonNeg : NonNegative p → (q ⊓ r) * p ≃ (q * p) ⊓ (r * p) *-distribˡ-⊔-nonNeg : NonNegative p → p * (q ⊔ r) ≃ (p * q) ⊔ (p * r) *-distribʳ-⊔-nonNeg : NonNegative p → (q ⊔ r) * p ≃ (q * p) ⊔ (r * p) *-distribˡ-⊔-nonPos : NonPositive p → p * (q ⊔ r) ≃ (p * q) ⊓ (p * r) *-distribʳ-⊔-nonPos : NonPositive p → (q ⊔ r) * p ≃ (q * p) ⊓ (r * p) *-distribˡ-⊓-nonPos : NonPositive p → p * (q ⊓ r) ≃ (p * q) ⊔ (p * r) *-distribʳ-⊓-nonPos : NonPositive p → (q ⊓ r) * p ≃ (q * p) ⊔ (r * p) ∣-∣-cong : p ≃ q → ∣ p ∣ ≃ ∣ q ∣ ∣-∣-nonNeg : NonNegative ∣ p ∣ 0≤∣p∣ : 0 ≤ ∣ p ∣ ∣p∣≃0⇒p≃0 : ∣ p ∣ ≃ 0ℚᵘ → p ≃ 0ℚᵘ ∣-p∣≡∣p∣ : ∣ - p ∣ ≡ ∣ p ∣ ∣-p∣≃∣p∣ : ∣ - p ∣ ≃ ∣ p ∣ 0≤p⇒∣p∣≡p : 0ℚᵘ ≤ p → ∣ p ∣ ≡ p 0≤p⇒∣p∣≃p : 0ℚᵘ ≤ p → ∣ p ∣ ≃ p ∣p∣≡p⇒0≤p : ∣ p ∣ ≡ p → 0ℚᵘ ≤ p ∣p∣≃p⇒0≤p : ∣ p ∣ ≃ p → 0ℚᵘ ≤ p ∣p∣≡p∨∣p∣≡-p : (∣ p ∣ ≡ p) ⊎ (∣ p ∣ ≡ - p) ∣p+q∣≤∣p∣+∣q∣ : ∣ p + q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p-q∣≤∣p∣+∣q∣ : ∣ p - q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p*q∣≡∣p∣*∣q∣ : ∣ p * q ∣ ≡ ∣ p ∣ * ∣ q ∣ ∣p*q∣≃∣p∣*∣q∣ : ∣ p * q ∣ ≃ ∣ p ∣ * ∣ q ∣ ∣∣p∣∣≡∣p∣ : ∣ ∣ p ∣ ∣ ≡ ∣ p ∣ ∣∣p∣∣≃∣p∣ : ∣ ∣ p ∣ ∣ ≃ ∣ p ∣ ``` * Added new functions and pattern synonyms to `Data.Tree.AVL.Indexed`: ```agda foldr : (∀ {k} → Val k → A → A) → A → Tree V l u h → A size : Tree V → ℕ pattern node⁺ k₁ t₁ k₂ t₂ t₃ bal = node k₁ t₁ (node k₂ t₂ t₃ bal) ∼+ pattern node⁻ k₁ k₂ t₁ t₂ bal t₃ = node k₁ (node k₂ t₁ t₂ bal) t₃ ∼- ordered : Tree V l u n → l <⁺ u ``` * Re-exported and defined new functions in `Data.Tree.AVL.Key`: ```agda _≈⁺_ : Rel Key _ [_]ᴱ : x ≈ y → [ x ] ≈⁺ [ y ] refl⁺ : Reflexive _≈⁺_ sym⁺ : l ≈⁺ u → u ≈⁺ l irrefl⁺ : ∀ k → ¬ (k <⁺ k) strictPartialOrder : StrictPartialOrder _ _ _ strictTotalOrder : StrictTotalOrder _ _ _ ``` * Added new function to `Data.Tree.Rose`: ```agda fromBinary : (A → C) → (B → C) → Tree.Binary A B → Rose C ∞ ``` * Added new definitions to `IO`: ```agda getLine : IO String Main : Set ``` * Added new definitions to `Relation.Binary.Bundles`: ```agda record TotalPreorder c ℓ₁ ℓ₂ : Set (suc (c ⊔ ℓ₁ ⊔ ℓ₂)) ``` * Added new definitions to `Relation.Binary.Structures`: ```agda record IsTotalPreorder (_≲_ : Rel A ℓ₂) : Set (a ⊔ ℓ ⊔ ℓ₂) ``` * Added new proofs to `Relation.Binary.Properties.Poset`: ```agda mono⇒cong : f Preserves _≤_ ⟶ _≤_ → f Preserves _≈_ ⟶ _≈_ antimono⇒cong : f Preserves _≤_ ⟶ _≥_ → f Preserves _≈_ ⟶ _≈_ ``` * Added new definitions and proofs to `Relation.Binary.Properties.(Poset/TotalOrder/DecTotalOrder)`: ```agda _≰_ : Rel A p₃ ≰-respˡ-≈ : _≰_ Respectsˡ _≈_ ≰-respʳ-≈ : _≰_ Respectsʳ _≈_ ``` * Added new proofs to `Relation.Binary.Consequences`: ```agda mono⇒cong : Symmetric ≈₁ → ≈₁ ⇒ ≤₁ → Antisymmetric ≈₂ ≤₂ → ∀ {f} → f Preserves ≤₁ ⟶ ≤₂ → f Preserves ≈₁ ⟶ ≈₂ antimono⇒cong : Symmetric ≈₁ → ≈₁ ⇒ ≤₁ → Antisymmetric ≈₂ ≤₂ → ∀ {f} → f Preserves ≤₁ ⟶ (flip ≤₂) → f Preserves ≈₁ ⟶ ≈₂ ``` * Added new proofs to `Relation.Binary.Construct.Converse`: ```agda totalPreorder : TotalPreorder a ℓ₁ ℓ₂ → TotalPreorder a ℓ₁ ℓ₂ isTotalPreorder : IsTotalPreorder ≈ ∼ → IsTotalPreorder ≈ (flip ∼) ``` * Added new proofs to `Relation.Binary.Morphism.Construct.Constant`: ```agda setoidHomomorphism : (S : Setoid a ℓ₁) (T : Setoid b ℓ₂) → ∀ x → SetoidHomomorphism S T preorderHomomorphism : (P : Preorder a ℓ₁ ℓ₂) (Q : Preorder b ℓ₃ ℓ₄) → ∀ x → PreorderHomomorphism P Q ``` * Added new proofs to `Relation.Binary.Morphism.Construct.Composition`: ```agda setoidHomomorphism : SetoidHomomorphism S T → SetoidHomomorphism T U → SetoidHomomorphism S U setoidMonomorphism : SetoidMonomorphism S T → SetoidMonomorphism T U → SetoidMonomorphism S U setoidIsomorphism : SetoidIsomorphism S T → SetoidIsomorphism T U → SetoidIsomorphism S U preorderHomomorphism : PreorderHomomorphism P Q → PreorderHomomorphism Q R → PreorderHomomorphism P R posetHomomorphism : PosetHomomorphism P Q → PosetHomomorphism Q R → PosetHomomorphism P R ``` * Added new proofs to `Relation.Binary.Morphism.Construct.Identity`: ```agda setoidHomomorphism : (S : Setoid a ℓ₁) → SetoidHomomorphism S S setoidMonomorphism : (S : Setoid a ℓ₁) → SetoidMonomorphism S S setoidIsomorphism : (S : Setoid a ℓ₁) → SetoidIsomorphism S S preorderHomomorphism : (P : Preorder a ℓ₁ ℓ₂) → PreorderHomomorphism P P posetHomomorphism : (P : Poset a ℓ₁ ℓ₂) → PosetHomomorphism P P ``` * Added new proofs to `Relation.Nullary.Negation`: ```agda contradiction₂ : P ⊎ Q → ¬ P → ¬ Q → Whatever ``` agda-stdlib-1.7.3/CHANGELOG/v1.7.2.md000066400000000000000000000005101451211343400163330ustar00rootroot00000000000000Version 1.7.2 ============= The library has been tested using Agda 2.6.3. * In accordance with changes to the flags in Agda 2.6.3, all modules that previously used the `--without-K` flag now use the `--cubical-compatible` flag instead. * Updated the code using `primFloatToWord64` - the library API has remained unchanged. agda-stdlib-1.7.3/CITATION.cff000066400000000000000000000003511451211343400155640ustar00rootroot00000000000000cff-version: 1.2.0 message: "If you use this software, please cite it as below." authors: - name: "The Agda Community" title: "Agda Standard Library" version: 1.7.3 date-released: 2023-10-13 url: "https://github.com/agda/agda-stdlib"agda-stdlib-1.7.3/GNUmakefile000066400000000000000000000014611451211343400157470ustar00rootroot00000000000000AGDA_EXEC ?= agda RTS_OPTIONS=+RTS -M4.0G -H3.5G -A128M -RTS AGDA=$(AGDA_EXEC) $(RTS_OPTIONS) # Before running `make test` the `fix-whitespace` program should # be installed: # # cabal install fix-whitespace test: Everything.agda check-whitespace $(AGDA) -i. -isrc README.agda check-whitespace: cabal exec -- fix-whitespace --check setup: Everything.agda .PHONY: Everything.agda Everything.agda: # The command `cabal build` is needed by cabal-install 3.0.0.0 and the # command `cabal install` is needed by cabal-install <= 2.4.*. I did # not found any problem running both commands with different versions # of cabal-install. See Issue #1001. cabal run GenerateEverything .PHONY: listings listings: Everything.agda $(AGDA) -i. -isrc --html README.agda -v0 clean : find . -type f -name '*.agdai' -delete agda-stdlib-1.7.3/GenerateEverything.hs000066400000000000000000000271331451211343400200340ustar00rootroot00000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternSynonyms #-} import Control.Applicative import Control.Monad import Control.Monad.Except import qualified Data.List as List import qualified Data.List.NonEmpty as List1 import Data.List.NonEmpty ( pattern (:|) ) import Data.Maybe import System.Directory import System.Environment import System.Exit import System.FilePath import System.FilePath.Find import System.IO headerFile = "Header" allOutputFile = "Everything" safeOutputFile = "EverythingSafe" srcDir = "src" --------------------------------------------------------------------------- -- Files with a special status -- | Checks whether a module is declared (un)safe unsafeModules :: [FilePath] unsafeModules = map modToFile [ "Codata.Musical.Colist" , "Codata.Musical.Colist.Base" , "Codata.Musical.Colist.Properties" , "Codata.Musical.Colist.Bisimilarity" , "Codata.Musical.Colist.Relation.Unary.All" , "Codata.Musical.Colist.Relation.Unary.All.Properties" , "Codata.Musical.Colist.Relation.Unary.Any" , "Codata.Musical.Colist.Relation.Unary.Any.Properties" , "Codata.Musical.Colist.Infinite-merge" , "Codata.Musical.Costring" , "Codata.Musical.Covec" , "Codata.Musical.Conversion" , "Codata.Musical.Stream" , "Debug.Trace" , "Foreign.Haskell" , "Foreign.Haskell.Coerce" , "Foreign.Haskell.Either" , "Foreign.Haskell.Maybe" , "Foreign.Haskell.Pair" , "IO" , "IO.Base" , "IO.Infinite" , "IO.Finite" , "IO.Primitive" , "IO.Primitive.Infinite" , "IO.Primitive.Finite" , "Relation.Binary.PropositionalEquality.TrustMe" , "System.Environment" , "System.Environment.Primitive" , "System.Exit" , "System.Exit.Primitive" , "Text.Pretty.Core" , "Text.Pretty" ] ++ sizedTypesModules isUnsafeModule :: FilePath -> Bool isUnsafeModule fp = unqualifiedModuleName fp == "Unsafe" || fp `elem` unsafeModules -- | Checks whether a module is declared as using K withKModules :: [FilePath] withKModules = map modToFile [ "Axiom.Extensionality.Heterogeneous" , "Data.Star.BoundedVec" , "Data.Star.Decoration" , "Data.Star.Environment" , "Data.Star.Fin" , "Data.Star.Pointer" , "Data.Star.Vec" , "Data.String.Unsafe" , "Reflection.Annotated" , "Reflection.Annotated.Free" , "Relation.Binary.HeterogeneousEquality" , "Relation.Binary.HeterogeneousEquality.Core" , "Relation.Binary.HeterogeneousEquality.Quotients.Examples" , "Relation.Binary.HeterogeneousEquality.Quotients" , "Relation.Binary.PropositionalEquality.TrustMe" , "Text.Pretty.Core" , "Text.Pretty" , "Text.Regex.String.Unsafe" ] isWithKModule :: FilePath -> Bool isWithKModule = -- GA 2019-02-24: it is crucial to use an anonymous lambda -- here so that `withKModules` is shared between all calls -- to `isWithKModule`. \ fp -> unqualifiedModuleName fp == "WithK" || fp `elem` withKModules sizedTypesModules :: [FilePath] sizedTypesModules = map modToFile [ "Codata.Cofin" , "Codata.Cofin.Literals" , "Codata.Colist" , "Codata.Colist.Bisimilarity" , "Codata.Colist.Categorical" , "Codata.Colist.Properties" , "Codata.Conat" , "Codata.Conat.Bisimilarity" , "Codata.Conat.Literals" , "Codata.Conat.Properties" , "Codata.Covec" , "Codata.Covec.Bisimilarity" , "Codata.Covec.Categorical" , "Codata.Covec.Instances" , "Codata.Covec.Properties" , "Codata.Cowriter" , "Codata.Cowriter.Bisimilarity" , "Codata.Delay" , "Codata.Delay.Bisimilarity" , "Codata.Delay.Categorical" , "Codata.Delay.Properties" , "Codata.M" , "Codata.M.Bisimilarity" , "Codata.M.Properties" , "Codata.Stream" , "Codata.Stream.Bisimilarity" , "Codata.Stream.Categorical" , "Codata.Stream.Instances" , "Codata.Stream.Properties" , "Codata.Thunk" , "Data.Container.Fixpoints.Sized" , "Data.W.Sized" , "Data.Nat.PseudoRandom.LCG.Unsafe" , "Data.Tree.Binary.Show" , "Data.Tree.Rose" , "Data.Tree.Rose.Properties" , "Data.Tree.Rose.Show" , "Data.Trie" , "Data.Trie.NonEmpty" , "Relation.Unary.Sized" , "Size" , "Text.Tree.Linear" ] isSizedTypesModule :: FilePath -> Bool isSizedTypesModule = \ fp -> fp `elem` sizedTypesModules unqualifiedModuleName :: FilePath -> String unqualifiedModuleName = dropExtension . takeFileName -- | Returns 'True' for all Agda files except for core modules. isLibraryModule :: FilePath -> Bool isLibraryModule f = takeExtension f `elem` [".agda", ".lagda"] && unqualifiedModuleName f /= "Core" --------------------------------------------------------------------------- -- Analysing library files type Exc = Except String -- | Extracting the header. -- It needs to have the form: -- ------------------------------------------------------------------------ -- -- The Agda standard library -- -- -- -- Description of the module -- ------------------------------------------------------------------------ extractHeader :: FilePath -> [String] -> Exc [String] extractHeader mod = extract where delimiter = all (== '-') extract :: [String] -> Exc [String] extract (d1 : "-- The Agda standard library" : "--" : ss) | delimiter d1 , (info, d2 : rest) <- span ("-- " `List.isPrefixOf`) ss , delimiter d2 = pure $ info extract (d1@(c:cs) : _) | not (delimiter d1) -- Andreas, issue #1510: there is a haunting of Prelude.last, so use List1.last instead. -- See https://gitlab.haskell.org/ghc/ghc/-/issues/19917. -- Update: The haunting is also resolved by 'throwError' instead of 'error', -- but still I dislike Prelude.last. , List1.last (c :| cs) == '\r' = throwError $ unwords [ mod , "contains \\r, probably due to git misconfiguration;" , "maybe set autocrf to input?" ] extract _ = throwError $ unwords [ mod , "is malformed." , "It needs to have a module header." , "Please see other existing files or consult HACKING.md." ] -- | A crude classifier looking for lines containing options data Status = Deprecated | Unsafe | Safe deriving (Eq) classify :: FilePath -> [String] -> [String] -> Exc Status classify fp hd ls -- We start with sanity checks | isUnsafe && safe = throwError $ fp ++ contradiction "unsafe" "safe" | not (isUnsafe || safe) = throwError $ fp ++ uncategorized "unsafe" "safe" | isWithK && cubicalC = throwError $ fp ++ contradiction "as relying on K" "cubical-compatible" | isWithK && not withK = throwError $ fp ++ missingWithK | not (isWithK || cubicalC) = throwError $ fp ++ uncategorized "as relying on K" "cubical-compatible" -- And then perform the actual classification | deprecated = pure $ Deprecated | isUnsafe = pure $ Unsafe | safe = pure $ Safe -- We know that @not (isUnsafe || safe)@, all cases are covered | otherwise = error "IMPOSSIBLE" where -- based on declarations isWithK = isWithKModule fp isUnsafe = isUnsafeModule fp -- based on detected OPTIONS safe = option "--safe" withK = option "--with-K" cubicalC = option "--cubical-compatible" -- based on detected comment in header deprecated = let detect = List.isSubsequenceOf "This module is DEPRECATED." in any detect hd -- GA 2019-02-24: note that we do not reprocess the whole module for every -- option check: the shared @options@ definition ensures we only inspect a -- handful of lines (at most one, ideally) option str = let detect = List.isSubsequenceOf ["{-#", "OPTIONS", str, "#-}"] in any detect options options = words <$> filter (List.isInfixOf "OPTIONS") ls -- formatting error messages contradiction d o = unwords [ " is declared", d, "but uses the", "--" ++ o, "option." ] uncategorized d o = unwords [ " is not declared", d, "but not using the", "--" ++ o, "option either." ] missingWithK = " is declared as relying on K but not using the --with-K option." -- | Analyse a file: extracting header and classifying it. data LibraryFile = LibraryFile { filepath :: FilePath -- ^ FilePath of the source file , header :: [String] -- ^ All lines in the headers are already prefixed with \"-- \". , status :: Status -- ^ Safety options used by the module } analyse :: FilePath -> IO LibraryFile analyse fp = do ls <- lines <$> readFileUTF8 fp hd <- runExc $ extractHeader fp ls cl <- runExc $ classify fp hd ls return $ LibraryFile { filepath = fp , header = hd , status = cl } checkFilePaths :: String -> [FilePath] -> IO () checkFilePaths cat fps = forM_ fps $ \ fp -> do b <- doesFileExist fp unless b $ die $ fp ++ " is listed as " ++ cat ++ " but does not exist." --------------------------------------------------------------------------- -- Collecting all non-Core library files, analysing them and generating -- 4 files: -- Everything.agda all the modules -- EverythingSafe.agda all the safe modules main = do args <- getArgs case args of [] -> return () _ -> hPutStr stderr usage >> exitFailure checkFilePaths "unsafe" unsafeModules checkFilePaths "using K" withKModules header <- readFileUTF8 headerFile modules <- filter isLibraryModule . List.sort <$> find always (extension ==? ".agda" ||? extension ==? ".lagda") srcDir libraryfiles <- filter ((Deprecated /=) . status) <$> mapM analyse modules let mkModule str = "module " ++ str ++ " where" writeFileUTF8 (allOutputFile ++ ".agda") $ unlines [ header , "{-# OPTIONS --rewriting --guardedness --sized-types #-}\n" , mkModule allOutputFile , format libraryfiles ] writeFileUTF8 (safeOutputFile ++ ".agda") $ unlines [ header , "{-# OPTIONS --safe --guardedness #-}\n" , mkModule safeOutputFile , format $ filter ((Unsafe /=) . status) libraryfiles ] -- | Usage info. usage :: String usage = unlines [ "GenerateEverything: A utility program for Agda's standard library." , "" , "Usage: GenerateEverything" , "" , "This program should be run in the base directory of a clean checkout of" , "the library." , "" , "The program generates documentation for the library by extracting" , "headers from library modules. The output is written to " ++ allOutputFile , "with the file " ++ headerFile ++ " inserted verbatim at the beginning." ] -- | Formats the extracted module information. format :: [LibraryFile] -> String format = unlines . concatMap fmt where fmt lf = "" : header lf ++ ["import " ++ fileToMod (filepath lf)] -- | Translates back and forth between a file name and the corresponding module -- name. We assume that the file name corresponds to an Agda module under -- 'srcDir'. fileToMod :: FilePath -> String fileToMod = map slashToDot . dropExtension . makeRelative srcDir where slashToDot c | isPathSeparator c = '.' | otherwise = c modToFile :: String -> FilePath modToFile name = concat [ srcDir, [pathSeparator], map dotToSlash name, ".agda" ] where dotToSlash c | c == '.' = pathSeparator | otherwise = c -- | A variant of 'readFile' which uses the 'utf8' encoding. readFileUTF8 :: FilePath -> IO String readFileUTF8 f = do h <- openFile f ReadMode hSetEncoding h utf8 s <- hGetContents h length s `seq` return s -- | A variant of 'writeFile' which uses the 'utf8' encoding. writeFileUTF8 :: FilePath -> String -> IO () writeFileUTF8 f s = withFile f WriteMode $ \h -> do hSetEncoding h utf8 hPutStr h s -- | Turning exceptions into fatal errors. runExc :: Exc a -> IO a runExc = either die return . runExcept agda-stdlib-1.7.3/HACKING.md000066400000000000000000000120071451211343400152610ustar00rootroot00000000000000Contributing to the library =========================== Thank you for your interest in contributing to the Agda standard library. Hopefully this guide should make it easy to do so! Feel free to ask any questions on the Agda mailing list. Before you start please read the [style-guide](https://github.com/agda/agda-stdlib/blob/master/notes/style-guide.md). How to make changes ------------------- ### Fork and download the repository 1. Create a fork by clicking `Fork` button at the top right of the [repository](https://github.com/agda/agda-stdlib). 2. If you are on a Mac, make sure that your git options has `autocrlf` set to `input`. This can be done by executing ``` git config --global core.autocrlf input ``` If you are on Windows, make sure that your editor can deal with Unix format files. 3. On the command line, and in a suitable folder, download your fork by running the command ``` git clone https://github.com/USER_NAME/agda-stdlib agda-stdlib-fork ``` where `USER_NAME` is your Git username. The folder `agda-stdlib-fork` should now contain a copy of the standard library. 4. Enter the folder `agda-stdlib-fork` and choose the correct branch of the library to make your changes on by running the command ``` git checkout X ``` where `X` should be `master` if your changes are compatible with the current released version of Agda, and `experimental` if your changes require the development version of Agda. ### Make your changes 5. Make your proposed changes. Please try to obey existing conventions in the library. See `agda-stdlib-fork/notes/style-guide.md` for a selection of the most important ones. 6. Document your changes in `agda-stdlib-fork/CHANGELOG.md`. 7. Ensure your changes are compatible with the rest of the library by running the commands ``` make clean make test ``` inside the `agda-stdlib-fork` folder. Continue to correct any bugs thrown up until the tests are passed. Your proposed changes MUST pass these tests. Note that the tests require the use of a tool called `fix-whitespace`. See the instructions at the end of this file for how to install this. If you are creating new modules, please make sure you are having a proper header, and a brief description of what the module is for, e.g. ``` ------------------------------------------------------------------------ -- The Agda standard library -- -- {PLACE YOUR BRIEF DESCRIPTION HERE} ------------------------------------------------------------------------ ``` If possible, each module should use the options `--safe` and `--cubical-compatible`. You can achieve this by placing the following pragma under the header and before any other line of code (including the module name): ``` {-# OPTIONS --cubical-compatible --safe #-} ``` If a module cannot be made safe or needs the `--with-K` option then it should be split into a module which is compatible with these options and an auxiliary one which will: * Either be called `SOME/PATH/Unsafe.agda` or `SOME/PATH/WithK.agda` * Or explicitly declared as either unsafe or needing K in `GenerateEverything.hs` ### Upload your changes 8. Use the `git add X` command to add changes to file `X` to the commit, or `git add .` to add all the changed files. 9. Run the command: ``` git commit ``` and enter a meaningful description for your changes. 10. Upload your changes to your fork by running the command: ``` git push ``` 11. Go to your fork on Github at `https://github.com/USER_NAME/agda-stdlib` and follow the [official Git instructions](https://help.github.com/en/articles/creating-a-pull-request-from-a-fork) to open a pull request to the main standard library repository. 12. The library maintainers will then be made aware of your requested changes and should be in touch soon. How to enforce whitespace policies ---------------------------------- ### Installing fix-whitespace This tool is kept in the main agda organization. It can be installed by following these instructions: ``` git clone https://github.com/agda/fix-whitespace --depth 1 cd fix-whitespace/ cabal install ``` ### Adding fix-whitespace as a pre-commit hook You can add the following code to the file `.git/hooks/pre-commit` to get git to run fix-whitespace before each `git commit` and ensure you are never committing anything with a whitespace violation: ``` #!/bin/sh fix-whitespace --check ``` Type-checking the README directory ---------------------------------- * By default the README directory is not exported in the `standard-library.agda-lib` file in order to avoid clashing with other people's README files. This means that by default type-checking a file in the README directory fails. * If you wish to type-check a README file, then you will need to change the line: ``` include: src ``` to ``` include: src . ``` in the `standard-library.agda-lib` file. * Please do not include this change in your pull request. agda-stdlib-1.7.3/Header000066400000000000000000000004251451211343400150070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- All library modules, along with short descriptions ------------------------------------------------------------------------ -- Note that core modules are not included. agda-stdlib-1.7.3/LICENCE000066400000000000000000000032101451211343400146540ustar00rootroot00000000000000Copyright (c) 2007-2023 Nils Anders Danielsson, Ulf Norell, Shin-Cheng Mu, Bradley Hardy, Samuel Bronson, Dan Doel, Patrik Jansson, Liang-Ting Chen, Jean-Philippe Bernardy, Andrés Sicard-Ramírez, Nicolas Pouillard, Darin Morrison, Peter Berry, Daniel Brown, Simon Foster, Dominique Devriese, Andreas Abel, Alcatel-Lucent, Eric Mertens, Joachim Breitner, Liyang Hu, Noam Zeilberger, Érdi Gergő, Stevan Andjelkovic, Helmut Grohne, Guilhem Moulin, Noriyuki Ohkawa, Evgeny Kotelnikov, James Chapman, Wen Kokke, Matthew Daggitt, Jason Hu, Sandro Stucki, Milo Turner, Zack Grannan, Lex van der Stoep, Jacques Carette and some anonymous contributors. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. agda-stdlib-1.7.3/README.agda000066400000000000000000000211651451211343400154530ustar00rootroot00000000000000{-# OPTIONS --rewriting --guardedness --sized-types #-} module README where ------------------------------------------------------------------------ -- The Agda standard library, version 1.7.3 -- -- Authors: Nils Anders Danielsson, Matthew Daggitt, Guillaume Allais -- with contributions from Andreas Abel, Stevan Andjelkovic, -- Jean-Philippe Bernardy, Peter Berry, Bradley Hardy Joachim Breitner, -- Samuel Bronson, Daniel Brown, Jacques Carette, James Chapman, -- Liang-Ting Chen, Dominique Devriese, Dan Doel, Érdi Gergő, -- Zack Grannan, Helmut Grohne, Simon Foster, Liyang Hu, Jason Hu, -- Patrik Jansson, Alan Jeffrey, Wen Kokke, Evgeny Kotelnikov, -- Sergei Meshveliani, Eric Mertens, Darin Morrison, Guilhem Moulin, -- Shin-Cheng Mu, Ulf Norell, Noriyuki Ohkawa, Nicolas Pouillard, -- Andrés Sicard-Ramírez, Lex van der Stoep, Sandro Stucki, Milo Turner, -- Noam Zeilberger and other anonymous contributors. ------------------------------------------------------------------------ -- This version of the library has been tested using Agda 2.6.4. -- The library comes with a .agda-lib file, for use with the library -- management system. -- Currently the library does not support the JavaScript compiler -- backend. ------------------------------------------------------------------------ -- Stability guarantees ------------------------------------------------------------------------ -- We do our best to adhere to the spirit of semantic versioning in that -- minor versions should not break people's code. This applies to the -- the entire library with one exception: modules with names that end in -- either ".Core" or ".Primitive". -- The former have (mostly) been created to avoid mutual recursion -- between modules and the latter to bind primitive operations to the -- more efficient operations supplied by the relevant backend. -- These modules may undergo backwards incompatible changes between -- minor versions and therefore are imported directly at your own risk. -- Instead their contents should be accessed by their parent module, -- whose interface will remain stable. ------------------------------------------------------------------------ -- High-level overview of contents ------------------------------------------------------------------------ -- The top-level module names of the library are currently allocated -- as follows: -- -- • Algebra -- Abstract algebra (monoids, groups, rings etc.), along with -- properties needed to specify these structures (associativity, -- commutativity, etc.), and operations on and proofs about the -- structures. -- • Axiom -- Types and consequences of various additional axioms not -- necessarily included in Agda, e.g. uniqueness of identity -- proofs, function extensionality and excluded middle. import README.Axiom -- • Category -- Category theory-inspired idioms used to structure functional -- programs (functors and monads, for instance). -- • Codata -- Coinductive data types and properties. There are two different -- approaches taken. The `Codata` folder contains the new more -- standard approach using sized types. The `Codata.Musical` -- folder contains modules using the old musical notation. -- • Data -- Data types and properties. import README.Data -- • Function -- Combinators and properties related to functions. -- • Foreign -- Related to the foreign function interface. -- • Induction -- A general framework for induction (includes lexicographic and -- well-founded induction). -- • IO -- Input/output-related functions. import README.IO -- • Level -- Universe levels. -- • Reflection -- Support for reflection. -- • Relation -- Properties of and proofs about relations. -- • Size -- Sizes used by the sized types mechanism. -- • Strict -- Provides access to the builtins relating to strictness. -- • Tactic -- Tactics for automatic proof generation -- ∙ Text -- Format-based printing, Pretty-printing, and regular expressions ------------------------------------------------------------------------ -- Library design ------------------------------------------------------------------------ -- The following modules contain a discussion of some of the choices -- that have been made whilst designing the library. -- • How mathematical hierarchies (e.g. preorder, partial order, total -- order) are handled in the library. import README.Design.Hierarchies -- • How decidability is handled in the library. import README.Design.Decidability ------------------------------------------------------------------------ -- A selection of useful library modules ------------------------------------------------------------------------ -- Note that module names in source code are often hyperlinked to the -- corresponding module. In the Emacs mode you can follow these -- hyperlinks by typing M-. or clicking with the middle mouse button. -- • Some data types import Data.Bool -- Booleans. import Data.Char -- Characters. import Data.Empty -- The empty type. import Data.Fin -- Finite sets. import Data.List -- Lists. import Data.Maybe -- The maybe type. import Data.Nat -- Natural numbers. import Data.Product -- Products. import Data.String -- Strings. import Data.Sum -- Disjoint sums. import Data.Unit -- The unit type. import Data.Vec -- Fixed-length vectors. -- • Some co-inductive data types import Codata.Stream -- Streams. import Codata.Colist -- Colists. -- • Some types used to structure computations import Category.Functor -- Functors. import Category.Applicative -- Applicative functors. import Category.Monad -- Monads. -- • Equality -- Propositional equality: import Relation.Binary.PropositionalEquality -- Convenient syntax for "equational reasoning" using a preorder: import Relation.Binary.Reasoning.Preorder -- Solver for commutative ring or semiring equalities: import Algebra.Solver.Ring -- • Properties of functions, sets and relations -- Monoids, rings and similar algebraic structures: import Algebra -- Negation, decidability, and similar operations on sets: import Relation.Nullary -- Properties of homogeneous binary relations: import Relation.Binary -- • Induction -- An abstraction of various forms of recursion/induction: import Induction -- Well-founded induction: import Induction.WellFounded -- Various forms of induction for natural numbers: import Data.Nat.Induction -- • Support for coinduction import Codata.Musical.Notation import Codata.Thunk -- • IO import IO -- ∙ Text -- Dependently typed formatted printing import Text.Printf ------------------------------------------------------------------------ -- More documentation ------------------------------------------------------------------------ -- Some examples showing how the case expression can be used. import README.Case -- Some examples showing how combinators can be used to emulate -- "functional reasoning" import README.Function.Reasoning -- An example showing how to use the debug tracing mechanism to inspect -- the behaviour of compiled Agda programs. import README.Debug.Trace -- An exploration of the generic programs acting on n-ary functions and -- n-ary heterogeneous products import README.Nary -- Explaining the inspect idiom: use case, equivalent handwritten -- auxiliary definitions, and implementation details. import README.Inspect -- Explaining how to use the automatic solvers import README.Tactic.MonoidSolver import README.Tactic.RingSolver -- Explaining how the Haskell FFI works import README.Foreign.Haskell -- Explaining string formats and the behaviour of printf import README.Text.Printf -- Showcasing the pretty printing module import README.Text.Pretty -- Demonstrating the regular expression matching import README.Text.Regex -- Explaining how to display tables of strings: import README.Text.Tabular ------------------------------------------------------------------------ -- All library modules ------------------------------------------------------------------------ -- For short descriptions of every library module, see Everything; -- to exclude unsafe modules, see EverythingSafe: import Everything import EverythingSafe -- Note that the Everything* modules are generated automatically. If -- you have downloaded the library from its Git repository and want -- to type check README then you can (try to) construct Everything by -- running "cabal install && GenerateEverything". -- Note that all library sources are located under src or ffi. The -- modules README, README.* and Everything are not really part of the -- library, so these modules are located in the top-level directory -- instead. agda-stdlib-1.7.3/README.md000066400000000000000000000070331451211343400151550ustar00rootroot00000000000000![Travis (.org) branch](https://img.shields.io/travis/agda/agda-stdlib/master?label=master) ![Travis (.org) branch](https://img.shields.io/travis/agda/agda-stdlib/experimental?label=experimental) The Agda standard library ========================= The standard library aims to contain all the tools needed to write both programs and proofs easily. While we always try and write efficient code, we prioritize ease of proof over type-checking and normalization performance. If computational performance is important to you, then perhaps try [agda-prelude](https://github.com/UlfNorell/agda-prelude) instead. ## Getting started If you're looking to find your way around the library, there are several different ways to get started: - The library's structure and the associated design choices are described in the [README.agda](https://github.com/agda/agda-stdlib/tree/master/README.agda). - The [README folder](https://github.com/agda/agda-stdlib/tree/master/README), which mirrors the structure of the main library, contains examples of how to use some of the more common modules. Feel free to [open a new issue](https://github.com/agda/agda-stdlib/issues/new) if there's a particular module you feel could do with some more documentation. - You can [browse the library's source code](https://agda.github.io/agda-stdlib/README.html) in glorious clickable HTML. - Finally, you can get an overview of the entire library by looking at the [index](https://agda.github.io/agda-stdlib/), which lists all modules in the library except the deprecated ones. ## Installation instructions See the [installation instructions](https://github.com/agda/agda-stdlib/blob/master/notes/installation-guide.md) for the latest version of the standard library. #### Old versions of Agda If you're using an old version of Agda, you can download the corresponding version of the standard library on the [Agda wiki](http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Libraries.StandardLibrary). The module index for older versions of the library is also available. For example, version 0.17 can be found at https://agda.github.io/agda-stdlib/v0.17/, just replace in the URL 0.17 with the version that you need. #### Development version of Agda If you're using a development version of Agda rather than the latest official release, you should use the `experimental` branch of the standard library rather than `master`. The `experimental` branch contains non-backward compatible patches for upcoming changes to the language. ## Type-checking with flags #### The `--safe` flag Most of the library can be type-checked using the `--safe` flag. Please consult [GenerateEverything.hs](https://github.com/agda/agda-stdlib/blob/master/GenerateEverything.hs#L23) for a full list of modules that use unsafe features. #### The `--cubical-compatible` flag Most of the library can be type-checked using the `--cubical-compatible` flag. Please consult [GenerateEverything.hs](https://github.com/agda/agda-stdlib/blob/master/GenerateEverything.hs#L74) for a full list of modules that use axiom K and are therefore incompatible. ## Contributing to the library If you would like to suggest improvements, feel free to use the `Issues` tab. Even better, if you would like to make the improvements yourself, we have instructions in [HACKING](https://github.com/agda/agda-stdlib/blob/master/HACKING.md) to help you get started. For those who would simply like to help out, issues marked with the [low-hanging-fruit](https://github.com/agda/agda-stdlib/issues?q=is%3Aopen+is%3Aissue+label%3Alow-hanging-fruit) tag are a good starting point. agda-stdlib-1.7.3/README/000077500000000000000000000000001451211343400146305ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Axiom.agda000066400000000000000000000064341451211343400165320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about the `Axiom` modules. ------------------------------------------------------------------------ module README.Axiom where open import Level using (Level) private variable ℓ : Level ------------------------------------------------------------------------ -- Introduction -- Several rules that are used without thought in written mathematics -- cannot be proved in Agda. The modules in the `Axiom` folder -- provide types expressing some of these rules that users may want to -- use even when they're not provable in Agda. ------------------------------------------------------------------------ -- Example: law of excluded middle -- In classical logic the law of excluded middle states that for any -- proposition `P` either `P` or `¬P` must hold. This is impossible -- to prove in Agda because Agda is a constructive system and so any -- proof of the excluded middle would have to build a term of either -- type `P` or `¬P`. This is clearly impossible without any knowledge -- of what proposition `P` is. -- The types for which `P` or `¬P` holds is called `Dec P` in the -- standard library (short for `Decidable`). open import Relation.Nullary using (Dec) -- The type of the proof of saying that excluded middle holds for -- all types at universe level ℓ is therefore: -- -- ExcludedMiddle ℓ = ∀ {P : Set ℓ} → Dec P -- -- and this type is exactly the one found in `Axiom.ExcludedMiddle`: open import Axiom.ExcludedMiddle -- There are two different ways that the axiom can be introduced into -- your Agda development. The first option is to postulate it: postulate excludedMiddle : ExcludedMiddle ℓ -- This has the advantage that it only needs to be postulated once -- and it can then be imported into many different modules as with any -- other proof. The downside is that the resulting Agda code will no -- longer type check under the --safe flag. -- The second approach is to pass it as a module parameter: module Proof (excludedMiddle : ExcludedMiddle ℓ) where -- The advantage of this approach is that the resulting Agda -- development can still be type checked under the --safe flag. -- Intuitively the reason for this is that when postulating it -- you are telling Agda that excluded middle does hold (which is clearly -- untrue as discussed above). In contrast when passing it as a module -- parameter you are telling Agda that **if** excluded middle was true -- then the following proofs would hold, which is logically valid. -- The disadvantage of this approach is that it is now necessary to -- include the excluded middle assumption as a parameter in every module -- that you want to use it in. Additionally the modules can never -- be fully instantiated (without postulating excluded middle). ------------------------------------------------------------------------ -- Other axioms -- Double negation elimination -- (∀ P → ¬ ¬ P → P) import Axiom.DoubleNegationElimination -- Function extensionality -- (∀ f g → (∀ x → f x ≡ g x) → f ≡ g) import Axiom.Extensionality.Propositional import Axiom.Extensionality.Heterogeneous -- Uniqueness of identity proofs (UIP) -- (∀ x y (p q : x ≡ y) → p ≡ q) import Axiom.UniquenessOfIdentityProofs agda-stdlib-1.7.3/README/Case.agda000066400000000000000000000041051451211343400163210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the case expressions can be used with anonymous -- pattern-matching lambda abstractions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Case where open import Data.Fin hiding (pred) open import Data.Maybe hiding (from-just) open import Data.Nat hiding (pred) open import Data.List open import Data.Sum open import Data.Product open import Function.Base using (case_of_; case_return_of_) open import Relation.Nullary open import Relation.Binary open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Different types of pattern-matching lambdas -- absurd pattern empty : ∀ {a} {A : Set a} → Fin 0 → A empty i = case i of λ () -- {}-delimited and ;-separated list of clauses -- Note that they do not need to be on different lines pred : ℕ → ℕ pred n = case n of λ { zero → zero ; (suc n) → n } -- where-introduced and indentation-identified block of list of clauses from-just : ∀ {a} {A : Set a} (x : Maybe A) → From-just x from-just x = case x return From-just of λ where (just x) → x nothing → _ ------------------------------------------------------------------------ -- We can define some recursive functions with case plus : ℕ → ℕ → ℕ plus m n = case m of λ { zero → n ; (suc m) → suc (plus m n) } div2 : ℕ → ℕ div2 zero = zero div2 (suc m) = case m of λ where zero → zero (suc m′) → suc (div2 m′) -- Note that some natural uses of case are rejected by the termination -- checker: -- module _ {a} {A : Set a} (eq? : Decidable {A = A} _≡_) where -- pairBy : List A → List (A ⊎ (A × A)) -- pairBy [] = [] -- pairBy (x ∷ []) = inj₁ x ∷ [] -- pairBy (x ∷ y ∷ xs) = case eq? x y of λ where -- (yes _) → inj₂ (x , y) ∷ pairBy xs -- (no _) → inj₁ x ∷ pairBy (y ∷ xs) agda-stdlib-1.7.3/README/Data.agda000066400000000000000000000161741451211343400163300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about how data types are laid out in the standard -- library. ------------------------------------------------------------------------ {-# OPTIONS --sized-types --guardedness #-} module README.Data where -- The top-level folder `Data` contains all the definitions of datatypes -- and their associated properties. -- Datatypes can broadly split into two categories -- i) "Basic" datatypes which do not take other datatypes as generic -- arguments (Nat, String, Fin, Bool, Char etc.) -- ii) "Container" datatypes which take other generic datatypes as -- arguments, (List, Vec, Sum, Product, Maybe, AVL trees etc.) ------------------------------------------------------------------------ -- Basic datatypes ------------------------------------------------------------------------ -- Basic datatypes are usually organised as follows: -- 1. A `Base` module which either contains the definition of the -- datatype or reimports it from the builtin modules, along with common -- functions, operations and relations over elements of the datatype. import Data.Nat.Base import Data.Integer.Base import Data.Char.Base import Data.String.Base import Data.Bool.Base -- Commonly these modules don't need to be imported directly as their -- contents is re-exported by the top level module (see below). -- 2. A `Properties` module which contains the basic properties of the -- functions, operations and relations contained in the base module. import Data.Nat.Properties import Data.Integer.Properties import Data.Char.Properties import Data.String.Properties import Data.Bool.Properties -- 3. A top-level module which re-exports the contents of the base -- module as well as various queries (i.e. decidability proofs) from the -- properties file. import Data.Nat import Data.Integer import Data.Char import Data.String import Data.Bool -- 4. A `Solver` module (for those datatypes that have an algebraic solver) -- which can be used to automatically solve equalities over the basic datatype. import Data.Nat.Solver import Data.Integer.Solver import Data.Bool.Solver -- 5. More complex operations and relations are commonly found in their -- own module beneath the top-level directory. For example: import Data.Nat.DivMod import Data.Integer.Coprimality -- Note that eventually there is a plan to re-organise the library to -- have the top-level module export a far wider range of properties and -- additional operations in order to minimise the number of imports -- needed. Currently it is necessary to import each of these separately -- however. ------------------------------------------------------------------------ -- Container datatypes ------------------------------------------------------------------------ -- 1. As with basic datatypes, a `Base` module which contains the -- definition of the datatype, along with common functions and -- operations over that data. Unlike basic datatypes, the `Base` module -- for container datatypes does not export any relations or predicates -- over the datatype (see the `Relation` section below). import Data.List.Base import Data.Maybe.Base import Data.Sum.Base -- Commonly these modules don't need to be imported directly as their -- contents is re-exported by the top level module (see below). -- 2. As with basic datatypes, a `Properties` module which contains the -- basic properties of the functions, operations and contained in the -- base module. import Data.List.Properties import Data.Maybe.Properties import Data.Sum.Properties -- 3. As with basic datatypes, a top-level module which re-exports the -- contents of the base module. In some cases this may also contain -- additional functions which could not be placed into the corresponding -- Base module because of cyclic dependencies. import Data.List import Data.Maybe import Data.Sum -- 4. A `Relation.Binary` folder where binary relations over the datatypes -- are stored. Because relations over container datatypes often depend on -- relations over the parameter datatype, this differs from basic datatypes -- where the binary relations are usually defined in the `Base` module, e.g. -- equality over the type `List A` depends on equality over type `A`. -- For example the `Pointwise` relation that takes a relation over the -- underlying type A and lifts it to the container parameterised can be found -- as follows: import Data.List.Relation.Binary.Pointwise import Data.Maybe.Relation.Binary.Pointwise import Data.Sum.Relation.Binary.Pointwise -- Another useful subfolder in the `Data.X.Relation.Binary` folders is the -- `Data.X.Relation.Binary.Equality` folder which contains various forms of -- equality over the datatype. -- 5. A `Relation.Unary` folder where unary relations, or predicates, -- over the datatypes are stored. These can be viewed as properties -- over a single list. -- For example a common, useful example is `Data.X.Relation.Unary.Any` -- that contains the types of proofs that at least one element in the -- container satisfies some predicate/property. import Data.List.Relation.Unary.Any import Data.Vec.Relation.Unary.Any import Data.Maybe.Relation.Unary.Any -- Alternatively the `Data.X.Relation.Unary.All` module contains the -- type of proofs that all elements in the container satisfy some -- property. import Data.List.Relation.Unary.All import Data.Vec.Relation.Unary.All import Data.Maybe.Relation.Unary.All -- 6. A `Categorical` module/folder that contains categorical -- interpretations of the datatype. import Data.List.Categorical import Data.Maybe.Categorical import Data.Sum.Categorical.Left import Data.Sum.Categorical.Right -- 7. A `Function` folder that contains lifting of various types of -- functions (e.g. injections, surjections, bijections, inverses) to -- the datatype. import Data.Sum.Function.Propositional import Data.Sum.Function.Setoid import Data.Product.Function.Dependent.Propositional import Data.Product.Function.Dependent.Setoid ------------------------------------------------------------------------ -- Full list of documentation for the Data folder ------------------------------------------------------------------------ -- Some examples showing where the natural numbers/integers and some -- related operations and properties are defined, and how they can be -- used: import README.Data.Nat import README.Data.Nat.Induction import README.Data.Integer -- Some examples showing how the AVL tree module can be used. import README.Data.Tree.AVL -- Some examples showing how List module can be used. import README.Data.List -- Some examples showing how the Fresh list can be used. import README.Data.List.Fresh -- Example of an encoding of record types with manifest fields and "with". import README.Data.Record -- Example use case for a trie: a wee generic lexer import README.Data.Trie.NonDependent -- Examples how (indexed) containers and constructions over them (free -- monad, least fixed point, etc.) can be used import README.Data.Container.FreeMonad import README.Data.Container.Indexed -- Wrapping n-ary relations into a record definition so type-inference -- remembers the things being related. import README.Data.Wrap agda-stdlib-1.7.3/README/Data/000077500000000000000000000000001451211343400155015ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Data/Container/000077500000000000000000000000001451211343400174235ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Data/Container/FreeMonad.agda000066400000000000000000000037501451211343400221060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how the free monad construction on containers can be -- used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module README.Data.Container.FreeMonad where open import Category.Monad open import Data.Empty open import Data.Unit open import Data.Bool.Base using (Bool; true) open import Data.Nat open import Data.Sum using (inj₁; inj₂) open import Data.Product renaming (_×_ to _⟨×⟩_) open import Data.Container open import Data.Container.Combinator open import Data.Container.FreeMonad open import Data.W open import Relation.Binary.PropositionalEquality as P ------------------------------------------------------------------------ -- The signature of state and its (generic) operations. State : Set → Container _ _ State S = ⊤ ⟶ S ⊎ S ⟶ ⊤ where _⟶_ : Set → Set → Container _ _ I ⟶ O = I ▷ λ _ → O get : ∀ {S} → State S ⋆ S get = inn (inj₁ _ , return) where open RawMonad rawMonad put : ∀ {S} → S → State S ⋆ ⊤ put s = inn (inj₂ s , return) where open RawMonad rawMonad -- Using the above we can, for example, write a stateful program that -- delivers a boolean. prog : State ℕ ⋆ Bool prog = get >>= λ n → put (suc n) >> return true where open RawMonad rawMonad runState : {S X : Set} → State S ⋆ X → (S → X ⟨×⟩ S) runState (sup (inj₁ x , _)) = λ s → x , s runState (sup (inj₂ (inj₁ _) , k)) = λ s → runState (k s) s runState (sup (inj₂ (inj₂ s) , k)) = λ _ → runState (k _) s test : runState prog 0 ≡ (true , 1) test = P.refl -- It should be noted that @State S ⋆ X@ is not the state monad. If we -- could quotient @State S ⋆ X@ by the seven axioms of state (see -- Plotkin and Power's "Notions of Computation Determine Monads", 2002) -- then we would get the state monad. agda-stdlib-1.7.3/README/Data/Container/Indexed.agda000066400000000000000000000062141451211343400216240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example showing how to define an indexed container ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe --guardedness #-} module README.Data.Container.Indexed where open import Data.Unit open import Data.Empty open import Data.Nat.Base open import Data.Product open import Function open import Data.W.Indexed open import Data.Container.Indexed open import Data.Container.Indexed.WithK module _ {a} (A : Set a) where ------------------------------------------------------------------------ -- Vector as an indexed container -- An indexed container is defined by three things: -- 1. Commands the user can emit -- 2. Responses the indexed container returns to these commands -- 3. Update of the index based on the command and the response issued. -- For a vector, commands are constructors, responses are the number of subvectors -- (0 if the vector is empty, 1 otherwise) and the update corresponds to setting the -- size of the tail (if it exists). We can formalize these ideas like so: -- Depending on the size of the vector, we may have reached the end already (nil) -- or we may specify what the head should be (cons). This is the type of commands. data VecC : ℕ → Set a where nil : VecC zero cons : ∀ n → A → VecC (suc n) Vec : Container ℕ ℕ a _ Command Vec = VecC -- We then treat each command independently, specifying both the response and the -- next index based on that response. -- In the nil case, the response is the empty type: there won't be any tail. As -- a consequence, the next index won't be needed (and we can rely on the fact the -- user will never be able to call it). Response Vec nil = ⊥ next Vec nil = λ () -- In the cons case, the response is the unit type: there is exactly one tail. The -- next index is the predecessor of the current one. It is handily handed over to -- use by `cons`. -- cons Response Vec (cons n a) = ⊤ next Vec (cons n a) = λ _ → n -- Finally we can define the type of Vector as the least fixed point of Vec. Vector : ℕ → Set a Vector = μ Vec module _ {a} {A : Set a} where -- We can recover the usual constructors by using `sup` to enter the fixpoint -- and then using the appropriate pairing of a command & a handler for the -- response. -- For [], the response is ⊥ which makes it easy to conclude. [] : Vector A 0 [] = sup (nil , λ ()) -- For _∷_, the response is ⊤ so we need to pass a tail. We give the one we took -- as an argument. infixr 3 _∷_ _∷_ : ∀ {n} → A → Vector A n → Vector A (suc n) x ∷ xs = sup (cons _ x , λ _ → xs) -- We can now use these constructors to build up vectors: 1⋯3 : Vector ℕ 3 1⋯3 = 1 ∷ 2 ∷ 3 ∷ [] -- Horrible thing to check the definition of _∈_ is not buggy. -- Not sure whether we can say anything interesting about it in the case of Vector... open import Relation.Binary.HeterogeneousEquality _ : _∈_ {C = Vec ℕ} {X = Vector ℕ} 1⋯3 (⟦ Vec ℕ ⟧ (Vector ℕ) 4 ∋ cons _ 0 , λ _ → 1⋯3) _ = _ , refl agda-stdlib-1.7.3/README/Data/Integer.agda000066400000000000000000000037401451211343400177200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing where the integers and some related -- operations and properties are defined, and how they can be used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible #-} module README.Data.Integer where -- The integers and various arithmetic operations are defined in -- Data.Integer. open import Data.Integer -- The +_ function converts natural numbers into integers. ex₁ : ℤ ex₁ = + 2 -- The -_ function negates an integer. ex₂ : ℤ ex₂ = - + 4 -- Some binary operators are also defined, including addition, -- subtraction and multiplication. ex₃ : ℤ ex₃ = + 1 + + 3 * - + 2 - + 4 -- Propositional equality and some related properties can be found -- in Relation.Binary.PropositionalEquality. open import Relation.Binary.PropositionalEquality as P using (_≡_) ex₄ : ex₃ ≡ - + 9 ex₄ = P.refl -- Data.Integer.Properties contains a number of properties related to -- integers. Algebra defines what a commutative ring is, among other -- things. import Data.Integer.Properties as ℤₚ ex₅ : ∀ i j → i * j ≡ j * i ex₅ i j = ℤₚ.*-comm i j -- The module ≡-Reasoning in Relation.Binary.PropositionalEquality -- provides some combinators for equational reasoning. open P.≡-Reasoning open import Data.Product ex₆ : ∀ i j → i * (j + + 0) ≡ j * i ex₆ i j = begin i * (j + + 0) ≡⟨ P.cong (i *_) (ℤₚ.+-identityʳ j) ⟩ i * j ≡⟨ ℤₚ.*-comm i j ⟩ j * i ∎ -- The module RingSolver in Data.Integer.Solver contains a solver -- for integer equalities involving variables, constants, _+_, _*_, -_ -- and _-_. open import Data.Integer.Solver using (module +-*-Solver) open +-*-Solver ex₇ : ∀ i j → i * - j - j * i ≡ - + 2 * i * j ex₇ = solve 2 (λ i j → i :* :- j :- j :* i := :- con (+ 2) :* i :* j) P.refl agda-stdlib-1.7.3/README/Data/List.agda000066400000000000000000000141711451211343400172360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Documentation for the List type ------------------------------------------------------------------------ module README.Data.List where open import Data.Nat.Base using (ℕ; _+_) open import Relation.Binary.PropositionalEquality using (_≡_; refl) ------------------------------------------------------------------------ -- 1. Basics ------------------------------------------------------------------------ -- The `List` datatype is exported by the following file: open import Data.List using (List ; []; _∷_ ; sum; map; take; reverse; _++_; drop ) -- Lists are built using the "[]" and "_∷_" constructors. list₁ : List ℕ list₁ = 3 ∷ 1 ∷ 2 ∷ [] -- Basic operations over lists are also exported by the same file. lem₁ : sum list₁ ≡ 6 lem₁ = refl lem₂ : map (_+ 2) list₁ ≡ 5 ∷ 3 ∷ 4 ∷ [] lem₂ = refl lem₃ : take 2 list₁ ≡ 3 ∷ 1 ∷ [] lem₃ = refl lem₄ : reverse list₁ ≡ 2 ∷ 1 ∷ 3 ∷ [] lem₄ = refl lem₅ : list₁ ++ list₁ ≡ 3 ∷ 1 ∷ 2 ∷ 3 ∷ 1 ∷ 2 ∷ [] lem₅ = refl -- Various basic properties of these operations can be found in: open import Data.List.Properties lem₆ : ∀ n (xs : List ℕ) → take n xs ++ drop n xs ≡ xs lem₆ = take++drop lem₇ : ∀ (xs : List ℕ) → reverse (reverse xs) ≡ xs lem₇ = reverse-involutive lem₈ : ∀ (xs ys zs : List ℕ) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs) lem₈ = ++-assoc ------------------------------------------------------------------------ -- 2. Unary relations over lists ------------------------------------------------------------------------ -- Unary relations in `Data.List.Relation.Unary` are used to reason -- about the properties of an individual list. ------------------------------------------------------------------------ -- Any -- The predicate `Any` encodes the idea of at least one element of a -- given list satisfying a given property (or more formally a -- predicate, see the `Pred` type in `Relation.Unary`). import README.Data.List.Relation.Unary.Any ------------------------------------------------------------------------ -- All -- The dual to `Any` is the predicate `All` which encodes the idea that -- every element in a given list satisfies a given property. import README.Data.List.Relation.Unary.All ------------------------------------------------------------------------ -- Other unary relations -- There exist many other unary relations in the -- `Data.List.Relation.Unary` folder, including: -- 1. lists with every pair of elements related import Data.List.Relation.Unary.AllPairs -- 2. lists with only unique elements import Data.List.Relation.Unary.Unique.Setoid -- 3. lists with each pair of neighbouring elements related import Data.List.Relation.Unary.Linked ------------------------------------------------------------------------ -- 3. Binary relations over lists ------------------------------------------------------------------------ -- Binary relations relate two different lists, and are found in the -- folder `Data.List.Relation.Binary`. ------------------------------------------------------------------------ -- Pointwise -- One of the most basic ways to form a binary relation between two -- lists of type `List A`, given a binary relation over `A`, is to say -- that two lists are related if they are the same length and: -- i) the first elements in the lists are related -- ii) the second elements in the lists are related -- iii) the third elements in the lists are related etc. -- etc. -- This is known as the pointwise lifting of a relation import README.Data.List.Relation.Binary.Pointwise ------------------------------------------------------------------------ -- Equality -- There are many different options for what it means for two -- different lists of type `List A` to be "equal". We will initially -- consider notions of equality that require the list elements to be -- pointwise equal. import README.Data.List.Relation.Binary.Equality ------------------------------------------------------------------------ -- Permutations -- Alternatively you might consider two lists to be equal if they -- contain the same elements regardless of the order of the elements. -- This is known as either "set equality" or a "permutation". import README.Data.List.Relation.Binary.Permutation ------------------------------------------------------------------------ -- Subsets -- Instead one might want to order lists by the subset relation which -- forms a partial order over lists. One list is a subset of another if -- every element in the first list occurs at least once in the second. import README.Data.List.Relation.Binary.Subset ------------------------------------------------------------------------ -- Other binary relations -- There exist many other binary relations in the -- `Data.List.Relation.Binary` folder, including: -- 1. lexicographic orderings import Data.List.Relation.Binary.Lex.Strict -- 2. bag/multiset equality import Data.List.Relation.Binary.BagAndSetEquality -- 3. the sublist relations import Data.List.Relation.Binary.Sublist.Propositional ------------------------------------------------------------------------ -- 4. Ternary relations over lists ------------------------------------------------------------------------ -- Ternary relations relate three different lists, and are found in the -- folder `Data.List.Relation.Ternary`. ------------------------------------------------------------------------ -- Interleaving -- Given two lists, a third list is an `Interleaving` of them if there -- exists an order preserving partition of it that reconstructs the -- original two lists. import README.Data.List.Relation.Ternary.Interleaving ------------------------------------------------------------------------ -- 5. Membership ------------------------------------------------------------------------ -- Although simply a specialisation of the unary predicate `Any`, -- membership of a list is not strictly a unary or a binary relation -- over lists. Therefore it lives it it's own top-level folder. import README.Data.List.Membership agda-stdlib-1.7.3/README/Data/List/000077500000000000000000000000001451211343400164145ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Data/List/Fresh.agda000066400000000000000000000037261451211343400203110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Example use case for a fresh list: sorted list ------------------------------------------------------------------------ {-# OPTIONS --sized-types #-} module README.Data.List.Fresh where open import Data.Nat open import Data.List.Base open import Data.List.Fresh open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs) open import Data.Product open import Relation.Nary using (⌊_⌋; fromWitness) -- A sorted list of natural numbers can be seen as a fresh list -- where the notion of freshness is being smaller than all the -- existing entries SortedList : Set SortedList = List# ℕ _<_ _ : SortedList _ = cons 0 (cons 1 (cons 3 (cons 10 [] _) (s≤s (s≤s (s≤s (s≤s z≤n))) , _)) (s≤s (s≤s z≤n) , s≤s (s≤s z≤n) , _)) (s≤s z≤n , s≤s z≤n , s≤s z≤n , _) -- Clearly, writing these by hand can pretty quickly become quite cumbersome -- Luckily, if the notion of freshness we are using is decidable, we can -- make most of the proofs inferrable by using the erasure of the relation -- rather than the relation itself! -- We call this new type *I*SortedList because all the proofs will be implicit. ISortedList : Set ISortedList = List# ℕ ⌊ _ ] is an m-labeled edge and is followed when reading 'm' -- [ (X) ] is a value leaf storing constructor X -- --> -- m --> -- m --> -- a --> (LEMMA) -- / -- -- l --> -- e --> -- t --> (LET) -- / -- / -- u --> -- t --> -- u --> -- a --> -- l --> (MUTUAL) -- / / -- .< -- m --> -- o --> -- d --> -- u --> -- l --> -- e --> (MODULE) -- \ -- -- w --> -- h --> -- e --> -- r --> -- e --> (WHERE) -- \ -- --> -- n --> (WHEN) -- after reading 'w', we get the derivative: -- . -- h --> -- e --> -- r --> -- e --> (WHERE) -- \ -- --> -- n --> (WHEN) open import Level open import Data.Unit open import Data.Bool open import Data.Char as Char import Data.Char.Properties as Char open import Data.List as List using (List; []; _∷_) open import Data.List.Fresh as List# using (List#; []; _∷#_) open import Data.Maybe as Maybe open import Data.Product as Prod open import Data.String as String using (String) open import Data.These as These open import Function.Base using (case_of_; _$_; _∘′_; id; _on_) open import Relation.Nary open import Relation.Binary using (Rel) open import Relation.Nullary.Negation using (¬?) open import Data.Trie Char.<-strictTotalOrder open import Data.Tree.AVL.Value ------------------------------------------------------------------------ -- Generic lexer record Lexer t : Set (suc t) where field -- Our lexer is parametrised over the type of tokens Tok : Set t -- Keywords are distinguished strings associated to tokens Keyword : Set t Keyword = String × Tok -- Two keywords are considered distinct if the strings are not equal Distinct : Rel Keyword 0ℓ Distinct a b = ⌊ ¬? ((proj₁ a) String.≟ (proj₁ b)) ⌋ field -- We ask users to provide us with a fresh list of keywords to guarantee -- that no two keywords share the same string representation keywords : List# Keyword Distinct -- Some characters are special: they are separators, breaking a string -- into a list of tokens. Some are associated to a token value -- (e.g. parentheses) others are not (e.g. space) breaking : Char → ∃ λ b → if b then Maybe Tok else Lift _ ⊤ -- Finally, strings which are not decoded as keywords are coerced -- using a function to token values. default : String → Tok module _ {t} (L : Lexer t) where open Lexer L tokenize : String → List Tok tokenize = start ∘′ String.toList where mutual -- A Trie is defined for an alphabet of strictly ordered letters (here -- we have picked Char for letters and decided to use the strict total -- order induced by their injection into ℕ as witnessed by the statement -- open import Data.Trie Char.strictTotalOrder earlier in this file). -- It is parametrised by a set of Values indexed over list of letters. -- Because we focus on the non-dependent case, we pick the constant -- family of Value uniformly equal to Tok. It is trivially compatible -- with the notion of equality underlying the strict total order on Chars. Keywords : Set _ Keywords = Trie (const _ Tok) _ -- We build a trie from the association list so that we may easily -- compute the successive derivatives obtained by eating the -- characters one by one init : Keywords init = fromList $ List.map (Prod.map₁ String.toList) $ proj₁ $ List#.toList keywords -- Kickstart the tokeniser with an empty accumulator and the initial -- trie. start : List Char → List Tok start = loop [] init -- The main loop loop : (acc : List Char) → -- chars read so far in this token (toks : Keywords) → -- keyword candidates left at this point (input : List Char) → -- list of chars to tokenize List Tok -- Empty input: finish up, check whether we have a non-empty accumulator loop acc toks [] = push acc [] -- At least one character loop acc toks (c ∷ cs) = case breaking c of λ where -- if we are supposed to break on this character, we do (true , m) → push acc $ maybe′ _∷_ id m $ start cs -- otherwise we see whether it leads to a recognized keyword (false , _) → case lookupValue (c ∷ []) toks of λ where -- if so we can forget about the current accumulator and -- restart the tokenizer on the rest of the input (just tok) → tok ∷ start cs -- otherwise we record the character we read in the accumulator, -- compute the derivative of the map of keyword candidates and -- keep going with the rest of the input nothing → loop (c ∷ acc) (lookupTrie c toks) cs -- Grab the accumulator and, unless it is empty, push it on top of -- the decoded list of tokens push : List Char → List Tok → List Tok push [] ts = ts push cs ts = default (String.fromList (List.reverse cs)) ∷ ts ------------------------------------------------------------------------ -- Concrete instance -- A small set of keywords for a language with expressions of the form -- `let x = e in b`. module LetIn where data TOK : Set where LET EQ IN : TOK LPAR RPAR : TOK ID : String → TOK keywords : List# (String × TOK) (λ a b → ⌊ ¬? ((proj₁ a) String.≟ (proj₁ b)) ⌋) keywords = ("let" , LET) ∷# ("=" , EQ) ∷# ("in" , IN) ∷# [] -- Breaking characters: spaces (thrown away) and parentheses (kept) breaking : Char → ∃ (λ b → if b then Maybe TOK else Lift 0ℓ ⊤) breaking c = if isSpace c then true , nothing else parens c where parens : Char → _ parens '(' = true , just LPAR parens ')' = true , just RPAR parens _ = false , _ default : String → TOK default = ID letIn : Lexer 0ℓ letIn = record { LetIn } open import Agda.Builtin.Equality -- A test case: open LetIn _ : tokenize letIn "fix f x = let b = fix f in (f b) x" ≡ ID "fix" ∷ ID "f" ∷ ID "x" ∷ EQ ∷ LET ∷ ID "b" ∷ EQ ∷ ID "fix" ∷ ID "f" ∷ IN ∷ LPAR ∷ ID "f" ∷ ID "b" ∷ RPAR ∷ ID "x" ∷ [] _ = refl agda-stdlib-1.7.3/README/Data/Wrap.agda000066400000000000000000000165431451211343400172410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how to use `Wrap` to help term inference. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Data.Wrap where open import Data.Wrap open import Algebra open import Data.Nat open import Data.Nat.Properties open import Data.Product open import Level using (Level) open import Relation.Binary private variable c ℓ : Level A : Set c m n : ℕ ------------------------------------------------------------------------ -- `Wrap` for remembering instances ------------------------------------------------------------------------ module Instances where -- `Monoid.Carrier` gets the carrier set from a monoid, and thus has -- type `Monoid c ℓ → Set c`. -- Using `Wrap`, we can convert `Monoid.Carrier` into an equivalent -- “wrapped” version: `MonoidEl`. MonoidEl : Monoid c ℓ → Set c MonoidEl = Wrap Monoid.Carrier -- We can turn any monoid into the equivalent monoid where the elements -- and equations have been wrapped. -- The translation mainly consists of wrapping and unwrapping everything -- via the `Wrap` constructor, `[_]`. -- Notice that the equality field is wrapping the binary relation -- `_≈_ : (x y : Carrier) → Set ℓ`, giving an example of how `Wrap` works -- for arbitrary n-ary relations. Wrap-monoid : Monoid c ℓ → Monoid c ℓ Wrap-monoid M = record { Carrier = MonoidEl M ; _≈_ = λ ([ x ]) ([ y ]) → Wrap _≈_ x y ; _∙_ = λ ([ x ]) ([ y ]) → [ x ∙ y ] ; ε = [ ε ] ; isMonoid = record { isSemigroup = record { isMagma = record { isEquivalence = record { refl = [ refl ] ; sym = λ ([ xy ]) → [ sym xy ] ; trans = λ ([ xy ]) ([ yz ]) → [ trans xy yz ] } ; ∙-cong = λ ([ xx ]) ([ yy ]) → [ ∙-cong xx yy ] } ; assoc = λ ([ x ]) ([ y ]) ([ z ]) → [ assoc x y z ] } ; identity = (λ ([ x ]) → [ identityˡ x ]) , (λ ([ x ]) → [ identityʳ x ]) } } where open Monoid M -- Usually, we would only open one monoid at a time. -- If we were to open two monoids `M` and `N` simultaneously, Agda would -- get confused whenever it came across, for example, `_∙_`, not knowing -- whether it came from `M` or `N`. -- This is true whether or not `M` and `N` can be disambiguated by some -- other means (such as by their `Carrier`s). -- However, with wrapped monoids, we are going to remember the monoid -- while checking any monoid expressions, so we can afford to have just -- one, polymorphic, version of `_∙_` visible globally. open module Wrap-monoid {c ℓ} {M : Monoid c ℓ} = Monoid (Wrap-monoid M) -- Now we can test out this construct on some existing monoids. open import Data.Nat.Properties -- Notice that, while the following two definitions appear to be defined -- by the same expression, their types are genuinely different. -- Whereas `Carrier +-0-monoid = ℕ = Carrier *-1-monoid`, `MonoidEl M` -- does not compute, and thus -- `MonoidEl +-0-monoid ≠ MonoidEl *-1-monoid` definitionally. -- This lets us use the respective monoids when checking the respective -- definitions. test-+ : MonoidEl +-0-monoid test-+ = ([ 3 ] ∙ ε) ∙ [ 2 ] test-* : MonoidEl *-1-monoid test-* = ([ 3 ] ∙ ε) ∙ [ 2 ] -- The reader is invited to normalise these two definitions -- (`C-c C-n`, then type in the name). -- `test-+` is interpreted using (ℕ, +, 0), and thus computes to `[ 5 ]`. -- Meanwhile, `test-*` is interpreted using (ℕ, *, 1), and thus computes -- to `[ 6 ]`. ------------------------------------------------------------------------ -- `Wrap` for dealing with functions spoiling unification ------------------------------------------------------------------------ module Unification where open import Relation.Binary.PropositionalEquality module Naïve where -- We want to work with factorisations of natural numbers in a -- “proof-relevant” style. We could draw out `Factor m n o` as -- m -- /*\ -- n o. Factor : (m n o : ℕ) → Set Factor m n o = m ≡ n * o -- We can prove a basic lemma about `Factor`: the following tree rotation -- can be done, due to associativity of `_*_`. -- m m -- /*\ /*\ -- no p ----> n op -- /*\ /*\ -- n o o p assoc-→ : ∀ {m n o p} → (∃ λ no → Factor m no p × Factor no n o) → (∃ λ op → Factor m n op × Factor op o p) assoc-→ {m} {n} {o} {p} (._ , refl , refl) = _ , *-assoc n o p , refl -- We must give at least some arguments to `*-assoc`, as Agda is unable to -- unify `? * ? * ?` with `n * o * p`, as `_*_` is a function and not -- necessarily injective (and indeed not injective when one of its -- arguments is 0). -- We now want to use this lemma in a more complex proof: -- m m -- /*\ /*\ -- nop q n opq -- /*\ ----> /*\ -- no p o pq -- /*\ /*\ -- n o p q test : ∀ {m n o p q} → (∃₂ λ no nop → Factor m nop q × Factor nop no p × Factor no n o) → (∃₂ λ pq opq → Factor m n opq × Factor opq o pq × Factor pq p q) test {n = n} (no , nop , fm , fnop , fno) = let _ , fm , fpq = assoc-→ {n = no} (_ , fm , fnop) in let _ , fm , fopq = assoc-→ {n = n} (_ , fm , fno) in _ , _ , fm , fopq , fpq -- This works okay, but where we have written `{n = no}` and similar, we -- are being forced to deal with details we don't really care about. Agda -- should be able to fill in the vertices given part of a tree, but can't -- due to similar reasons as before: `Factor ? ? ?` doesn't unify against -- `Factor m no p`, because both instances of `Factor` compute and we're -- left trying to unify `? * ?` against `no * p`. module Wrapped where -- We can use `Wrap` to stop the computation of `Factor`. Factor : (m n o : ℕ) → Set Factor = Wrap λ m n o → m ≡ n * o -- Because `assoc-→` needs access to the implementation of `Factor`, the -- proof is exactly as before except for using `[_]` to wrap and unwrap. assoc-→ : ∀ {m n o p} → (∃ λ no → Factor m no p × Factor no n o) → (∃ λ op → Factor m n op × Factor op o p) assoc-→ {m} {n} {o} {p} (._ , [ refl ] , [ refl ]) = _ , [ *-assoc n o p ] , [ refl ] -- The difference is that now we have our basic lemma, the complex proof -- can work purely in terms of `Factor` trees. In particular, -- `Factor ? ? ?` now does unify with `Factor m no p`, so we don't have to -- give `no` explicitly again. test : ∀ {m n o p q} → (∃₂ λ no nop → Factor m nop q × Factor nop no p × Factor no n o) → (∃₂ λ pq opq → Factor m n opq × Factor opq o pq × Factor pq p q) test (_ , _ , fm , fnop , fno) = let _ , fm , fpq = assoc-→ (_ , fm , fnop) in let _ , fm , fopq = assoc-→ (_ , fm , fno) in _ , _ , fm , fopq , fpq agda-stdlib-1.7.3/README/Debug/000077500000000000000000000000001451211343400156565ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Debug/Trace.agda000066400000000000000000000073441451211343400175420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example showing how the Debug.Trace module can be used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --rewriting --guardedness #-} module README.Debug.Trace where ------------------------------------------------------------------------ -- Sometimes compiled code can contain bugs. -- Whether caused by the compiler or present in the source code already, they -- can be hard to track. A primitive debugging technique is to strategically -- insert calls to tracing functions which will display their String argument -- upon evaluation. open import Data.String.Base using (_++_) open import Debug.Trace -- We can for instance add tracing messages to make sure an invariant is -- respected or check in which order evaluation takes place in the backend -- (which can inform our decision to use, or not, strictness primitives). -- In the following example, we define a division operation on natural numbers -- using the original dividend as the termination measure. We: -- 1. check in the base case that when the fuel runs out then the updated dividend -- is already zero. -- 2. wrap the calls to _∸_ and go in respective calls to trace to see when all -- of these thunks are forced: are we building a big thunk in go's second -- argument or evaluating it as we go? open import Data.Maybe.Base open import Data.Nat.Base open import Data.Nat.Show using (show) div : ℕ → ℕ → Maybe ℕ div m zero = nothing div m n = just (go m m) where -- invariants: m ≤ fuel -- result : m / n go : (fuel : ℕ) (m : ℕ) → ℕ go zero m = trace ("Invariant: " ++ show m ++ " should be zero.") zero go (suc fuel) m = let m′ = trace ("Thunk for step " ++ show fuel ++ " forced") (m ∸ n) in trace ("Recursive call for step " ++ show fuel) (suc (go fuel m′)) -- To observe the behaviour of this code, we need to compile it and run it. -- To run it, we need a main function. We define a very basic one: run div, -- and display its result if the run was successful. -- We add two calls to trace to see when div is evaluated and when the returned -- number is forced (by a call to show). open import Level using (0ℓ) open import IO main : Main main = let r = trace "Call to div" (div 4 2) j = λ n → trace "Forcing the result wrapped in just." (putStrLn (show n)) in run (maybe′ j (return _) r) -- We get the following trace where we can see that checking that the -- maybe-solution is just-headed does not force the natural number. Once forced, -- we observe that we indeed build a big thunk on go's second argument (all the -- recursive calls happen first and then we force the thunks one by one). -- Call to div -- Forcing the result wrapped in just. -- Recursive call for step 3 -- Recursive call for step 2 -- Recursive call for step 1 -- Recursive call for step 0 -- Thunk for step 0 forced -- Thunk for step 1 forced -- Thunk for step 2 forced -- Thunk for step 3 forced -- Invariant: 0 should be zero. -- 4 -- We also notice that the result is incorrect: 4/2 is 2 and not 4. We quickly -- notice that (div m (suc n)) will perform m recursive calls no matter what. -- And at each call it will put add 1. We can fix this bug by adding a new first -- equation to go: -- go fuel zero = zero -- Running the example again we observe that because we now need to check -- whether go's second argument is zero, the function is more strict: we see -- that recursive calls and thunk forcings are interleaved. -- Call to div -- Forcing the result wrapped in just. -- Recursive call for step 3 -- Thunk for step 3 forced -- Recursive call for step 2 -- Thunk for step 2 forced -- 2 agda-stdlib-1.7.3/README/Design/000077500000000000000000000000001451211343400160415ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Design/Decidability.agda000066400000000000000000000115361451211343400212530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of decision procedures and how to use them ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Design.Decidability where -- Reflects and Dec are defined in Relation.Nullary, and operations on them can -- be found in Relation.Nullary.Reflects and Relation.Nullary.Decidable. open import Relation.Nullary as Nullary open import Relation.Nullary.Reflects open import Relation.Nullary.Decidable open import Data.Bool open import Data.List open import Data.List.Properties using (∷-injective) open import Data.Nat open import Data.Nat.Properties using (suc-injective) open import Data.Product open import Data.Unit open import Function open import Relation.Binary.PropositionalEquality open import Relation.Nary open import Relation.Nullary.Product infix 4 _≟₀_ _≟₁_ _≟₂_ -- A proof of `Reflects P b` shows that a proposition `P` has the truth value of -- the boolean `b`. A proof of `Reflects P true` amounts to a proof of `P`, and -- a proof of `Reflects P false` amounts to a refutation of `P`. ex₀ : (n : ℕ) → Reflects (n ≡ n) true ex₀ n = ofʸ refl ex₁ : (n : ℕ) → Reflects (zero ≡ suc n) false ex₁ n = ofⁿ λ () ex₂ : (b : Bool) → Reflects (T b) b ex₂ false = ofⁿ id ex₂ true = ofʸ tt -- A proof of `Dec P` is a proof of `Reflects P b` for some `b`. -- `Dec P` is declared as a record, with fields: -- does : Bool -- proof : Reflects P does ex₃ : (b : Bool) → Dec (T b) does (ex₃ b) = b proof (ex₃ b) = ex₂ b -- We also have pattern synonyms `yes` and `no`, allowing both fields to be -- given at once. ex₄ : (n : ℕ) → Dec (zero ≡ suc n) ex₄ n = no λ () -- It is possible, but not ideal, to define recursive decision procedures using -- only the `yes` and `no` patterns. The following procedure decides whether two -- given natural numbers are equal. _≟₀_ : (m n : ℕ) → Dec (m ≡ n) zero ≟₀ zero = yes refl zero ≟₀ suc n = no λ () suc m ≟₀ zero = no λ () suc m ≟₀ suc n with m ≟₀ n ... | yes p = yes (cong suc p) ... | no ¬p = no (¬p ∘ suc-injective) -- In this case, we can see that `does (suc m ≟ suc n)` should be equal to -- `does (m ≟ n)`, because a `yes` from `m ≟ n` gives rise to a `yes` from the -- result, and similarly for `no`. However, in the above definition, this -- equality does not hold definitionally, because we always do a case split -- before returning a result. To avoid this, we can return the `does` part -- separately, before any pattern matching. _≟₁_ : (m n : ℕ) → Dec (m ≡ n) zero ≟₁ zero = yes refl zero ≟₁ suc n = no λ () suc m ≟₁ zero = no λ () does (suc m ≟₁ suc n) = does (m ≟₁ n) proof (suc m ≟₁ suc n) with m ≟₁ n ... | yes p = ofʸ (cong suc p) ... | no ¬p = ofⁿ (¬p ∘ suc-injective) -- We now get definitional equalities such as the following. _ : (m n : ℕ) → does (5 + m ≟₁ 3 + n) ≡ does (2 + m ≟₁ n) _ = λ m n → refl -- Even better, from a maintainability point of view, is to use `map` or `map′`, -- both of which capture the pattern of the `does` field remaining the same, but -- the `proof` field being updated. _≟₂_ : (m n : ℕ) → Dec (m ≡ n) zero ≟₂ zero = yes refl zero ≟₂ suc n = no λ () suc m ≟₂ zero = no λ () suc m ≟₂ suc n = map′ (cong suc) suc-injective (m ≟₂ n) _ : (m n : ℕ) → does (5 + m ≟₂ 3 + n) ≡ does (2 + m ≟₂ n) _ = λ m n → refl -- `map′` can be used in conjunction with combinators such as `_⊎-dec_` and -- `_×-dec_` to build complex (simply typed) decision procedures. module ListDecEq₀ {a} {A : Set a} (_≟ᴬ_ : (x y : A) → Dec (x ≡ y)) where _≟ᴸᴬ_ : (xs ys : List A) → Dec (xs ≡ ys) [] ≟ᴸᴬ [] = yes refl [] ≟ᴸᴬ (y ∷ ys) = no λ () (x ∷ xs) ≟ᴸᴬ [] = no λ () (x ∷ xs) ≟ᴸᴬ (y ∷ ys) = map′ (uncurry (cong₂ _∷_)) ∷-injective (x ≟ᴬ y ×-dec xs ≟ᴸᴬ ys) -- The final case says that `x ∷ xs ≡ y ∷ ys` exactly when `x ≡ y` *and* -- `xs ≡ ys`. The proofs are updated by the first two arguments to `map′`. -- In the case of ≡-equality tests, the pattern -- `map′ (congₙ c) c-injective (x₀ ≟ y₀ ×-dec ... ×-dec xₙ₋₁ ≟ yₙ₋₁)` -- is captured by `≟-mapₙ n c c-injective (x₀ ≟ y₀) ... (xₙ₋₁ ≟ yₙ₋₁)`. module ListDecEq₁ {a} {A : Set a} (_≟ᴬ_ : (x y : A) → Dec (x ≡ y)) where _≟ᴸᴬ_ : (xs ys : List A) → Dec (xs ≡ ys) [] ≟ᴸᴬ [] = yes refl [] ≟ᴸᴬ (y ∷ ys) = no λ () (x ∷ xs) ≟ᴸᴬ [] = no λ () (x ∷ xs) ≟ᴸᴬ (y ∷ ys) = ≟-mapₙ 2 _∷_ ∷-injective (x ≟ᴬ y) (xs ≟ᴸᴬ ys) agda-stdlib-1.7.3/README/Design/Fixity.agda000066400000000000000000000017141451211343400201360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Documentation describing some of the fixity choices ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- There is no actual code in here, just design note. module README.Design.Fixity where -- binary relations of all kinds are infix 4 -- multiplication-like: infixl 7 _*_ -- addition-like infixl 6 _+_ -- negation-like infix 8 ¬_ -- and-like infixr 7 _∧_ -- or-like infixr 6 _∨_ -- post-fix inverse infix 8 _⁻¹ -- bind infixl 1 _>>=_ -- list concat-like infixr 5 _∷_ -- ternary reasoning infix 1 _⊢_≈_ -- composition infixr 9 _∘_ -- application infixr -1 _$_ _$!_ -- Reasoning: -- QED infix 3 _∎ -- stepping infixr 2 _≡⟨⟩_ step-≡ step-≡˘ -- begin infix 1 begin_ -- type formers: -- product-like infixr 2 _×_ _-×-_ _-,-_ -- sum-like infixr 1 _⊎_ agda-stdlib-1.7.3/README/Design/Hierarchies.agda000066400000000000000000000245501451211343400211130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about how mathematical hierarchies are laid out. ------------------------------------------------------------------------ {-# OPTIONS --allow-unsolved-metas #-} module README.Design.Hierarchies where open import Data.Sum using (_⊎_) open import Level using (Level; _⊔_; suc) open import Relation.Binary using (_Preserves₂_⟶_⟶_) private variable a b ℓ : Level A : Set a ------------------------------------------------------------------------ -- Introduction ------------------------------------------------------------------------ -- One of the key design decisions facing the library is how to handle -- mathematical hierarchies, e.g. -- ∙ Binary relations: preorder → partial order → total order -- ↘ equivalence -- ∙ Algebraic structures: magma → semigroup → monoid → group -- ↘ band → semilattice -- -- Some of the hierarchies in the library are: -- ∙ Algebra -- ∙ Function -- ∙ Relation.Binary -- ∙ Relation.Binary.Indexed -- -- A given hierarchy `X` is always split into 4 seperate folders: -- ∙ X.Core -- ∙ X.Definitions -- ∙ X.Structures -- ∙ X.Bundles -- all four of which are publicly re-exported by `X` itself. -- -- Additionally a hierarchy `X` may contain additional files -- ∙ X.Consequences -- ∙ X.Constructs -- ∙ X.Properties -- ∙ X.Morphisms -- -- Descriptions of these modules are now described below using the -- running example of the `Relation.Binary` and `Algebra` hierarchies. -- Note that we redefine everything here for illustrative purposes, -- and that the definitions given below may be slightly simpler -- than the real definitions in order to focus on the points being -- discussed. ------------------------------------------------------------------------ -- Main hierarchy modules ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- X.Core -- The Core module contains the basic units of the hierarchy. -- For example for binary relations these are homoegeneous and -- heterogeneous binary relations: REL : Set a → Set b → (ℓ : Level) → Set (a ⊔ b ⊔ suc ℓ) REL A B ℓ = A → B → Set ℓ Rel : Set a → (ℓ : Level) → Set (a ⊔ suc ℓ) Rel A ℓ = A → A → Set ℓ -- and in Algebra these are unary and binary operators, e.g. Op₁ : Set a → Set a Op₁ A = A → A Op₂ : Set a → Set a Op₂ A = A → A → A ------------------------------------------------------------------------ -- X.Definitions -- The Definitions module defines the various properties that the -- basic units of the hierarchy may have. -- For example in Relation.Binary this includes reflexivity, -- transitivity etc. Reflexive : Rel A ℓ → Set _ Reflexive _∼_ = ∀ {x} → x ∼ x Symmetric : Rel A ℓ → Set _ Symmetric _∼_ = ∀ {x y} → x ∼ y → y ∼ x Transitive : Rel A ℓ → Set _ Transitive _∼_ = ∀ {x y z} → x ∼ y → y ∼ z → x ∼ z Total : Rel A ℓ → Set _ Total _∼_ = ∀ x y → x ∼ y ⊎ y ∼ x -- For example in Algebra these are associativity, commutativity. -- Note that all definitions for Algebra are based on some notion of -- underlying equality. Associative : Rel A ℓ → Op₂ A → Set _ Associative _≈_ _∙_ = ∀ x y z → ((x ∙ y) ∙ z) ≈ (x ∙ (y ∙ z)) Commutative : Rel A ℓ → Op₂ A → Set _ Commutative _≈_ _∙_ = ∀ x y → (x ∙ y) ≈ (y ∙ x) LeftIdentity : Rel A ℓ → A → Op₂ A → Set _ LeftIdentity _≈_ e _∙_ = ∀ x → (e ∙ x) ≈ x RightIdentity : Rel A ℓ → A → Op₂ A → Set _ RightIdentity _≈_ e _∙_ = ∀ x → (x ∙ e) ≈ x -- Note that the types in `Definitions` modules are not meant to express -- the full concept on their own. For example the `Associative` type does -- not require the underlying relation to be an equivalence relation. -- Instead they are designed to aid the modular reuse of the core -- concepts. The complete concepts are captured in various -- structures/bundles where the definitions are correctly used in -- context. ------------------------------------------------------------------------ -- X.Structures -- When an abstract hierarchy of some sort (for instance semigroup → -- monoid → group) is included in the library the basic approach is to -- specify the properties of every concept in terms of a record -- containing just properties, parameterised on the underlying -- sets, relations and operations. For example: record IsEquivalence {A : Set a} (_≈_ : Rel A ℓ) : Set (a ⊔ ℓ) where field refl : Reflexive _≈_ sym : Symmetric _≈_ trans : Transitive _≈_ -- More specific concepts are then specified in terms of the simpler -- ones: record IsMagma {A : Set a} (≈ : Rel A ℓ) (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence ≈ ∙-cong : ∙ Preserves₂ ≈ ⟶ ≈ ⟶ ≈ record IsSemigroup {A : Set a} (≈ : Rel A ℓ) (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ≈ ∙ associative : Associative ≈ ∙ open IsMagma isMagma public -- Note here that `open IsMagma isMagma public` ensures that the -- fields of the `isMagma` record can be accessed directly; this -- technique enables the user of an `IsSemigroup` record to use underlying -- records without having to manually open an entire record hierarchy. -- This is not always possible, though. Consider the following definition -- of preorders: record IsPreorder {A : Set a} (_≈_ : Rel A ℓ) -- The underlying equality. (_∼_ : Rel A ℓ) -- The relation. : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence _≈_ refl : Reflexive _∼_ trans : Transitive _∼_ module Eq = IsEquivalence isEquivalence -- The IsEquivalence field in IsPreorder is not opened publicly because -- the `refl` and `trans` fields would clash with those in the -- `IsPreorder` record. Instead we provide an internal module and the -- equality fields can be accessed via `Eq.refl` and `Eq.trans`. ------------------------------------------------------------------------ -- X.Bundles -- Although structures are useful for describing the properties of a -- given set of operations/relations, sometimes you don't require the -- properties to hold for a given set of objects but only that such a -- set of objects exists. In this case bundles are what you're after. -- Each structure has a corresponding bundle that include the structure -- along with the corresponding sets, relations and operations as -- fields. record Setoid c ℓ : Set (suc (c ⊔ ℓ)) where field Carrier : Set c _≈_ : Rel Carrier ℓ isEquivalence : IsEquivalence _≈_ open IsEquivalence isEquivalence public -- The contents of the structure is always re-exported publicly, -- providing access to its fields. record Magma c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isMagma : IsMagma _≈_ _∙_ open IsMagma isMagma public record Semigroup : Set (suc (a ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set a _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isSemigroup : IsSemigroup _≈_ _∙_ open IsSemigroup isSemigroup public magma : Magma a ℓ magma = record { isMagma = isMagma } -- Note that the Semigroup record does not include a Magma field. -- Instead the Semigroup record includes a "repackaging function" -- semigroup which converts a Magma to a Semigroup. -- The above setup may seem a bit complicated, but it has been arrived -- at after a lot of thought and is designed to both make the hierarchies -- easy to work with whilst also providing enough flexibility for the -- different applications of their concepts. -- NOTE: bundles for the function hierarchy are designed a little -- differently, as a function with an unknown domain an codomain is -- of little use. ------------------------------------------------------------------------ -- Other hierarchy modules ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- X.Consequences -- The "consequences" modules contains proofs for how the different -- types in the `Definitions` module relate to each other. For example: -- that any total relation is reflexive or that commutativity allows -- one to translate between left and right identities. total⇒refl : ∀ {_∼_ : Rel A ℓ} → Total _∼_ → Reflexive _∼_ total⇒refl = {!!} idˡ+comm⇒idʳ : ∀ {_≈_ : Rel A ℓ} {e _∙_} → Commutative _≈_ _∙_ → LeftIdentity _≈_ e _∙_ → RightIdentity _≈_ e _∙_ idˡ+comm⇒idʳ = {!!} ------------------------------------------------------------------------ -- X.Construct -- The "construct" folder contains various generic ways of constructing -- new instances of the hierarchy. For example import Relation.Binary.Construct.Intersection -- takes in two relations and forms the new relation that says two -- elements are only related if they are related via both of the -- original relations. -- These files are layed out in four parts, mimicking the main modules -- of the hierarchy itself. First they define the new relation, then -- subsequently how the definitions, then structures and finally -- bundles can be translated across to it. ------------------------------------------------------------------------ -- X.Morphisms -- The `Morphisms` folder is a sub-hierarchy containing relationships -- such homomorphisms, monomorphisms and isomorphisms between the -- structures and bundles in the hierarchy. ------------------------------------------------------------------------ -- X.Properties -- The `Properties` folder contains additional proofs about the theory -- of each bundle. They are usually designed so as a bundle's -- `Properties` file re-exports the contents of the `Properties` files -- above it in the hierarchy. For example -- `Algebra.Properties.AbelianGroup` re-exports the contents of -- `Algebra.Properties.Group`. agda-stdlib-1.7.3/README/Foreign/000077500000000000000000000000001451211343400162215ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Foreign/Haskell.agda000066400000000000000000000072771451211343400204370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A simple example of a program using the foreign function interface ------------------------------------------------------------------------ {-# OPTIONS --guardedness #-} module README.Foreign.Haskell where -- In order to be considered safe by Agda, the standard library cannot -- add COMPILE pragmas binding the inductive types it defines to concrete -- Haskell types. -- To work around this limitation, we have defined FFI-friendly versions -- of these types together with a zero-cost coercion `coerce`. open import Level using (Level) open import Agda.Builtin.Int open import Agda.Builtin.Nat open import Data.Bool.Base using (Bool; if_then_else_) open import Data.Char as Char open import Data.List.Base as List using (List; _∷_; []; takeWhile; dropWhile) open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Product open import Function open import Relation.Nullary.Decidable import Foreign.Haskell as FFI open import Foreign.Haskell.Coerce private variable a : Level A : Set a -- Here we use the FFI version of Pair. postulate primUncons : List A → Maybe (FFI.Pair A (List A)) primCatMaybes : List (Maybe A) → List A primTestChar : Char → Bool primIntEq : Int → Int → Bool {-# COMPILE GHC primUncons = \ _ _ xs -> case xs of { [] -> Nothing ; (x : xs) -> Just (x, xs) } #-} {-# FOREIGN GHC import Data.Maybe #-} {-# COMPILE GHC primCatMaybes = \ _ _ -> catMaybes #-} {-# COMPILE GHC primTestChar = ('-' /=) #-} {-# COMPILE GHC primIntEq = (==) #-} -- We however want to use the notion of Pair internal to the standard library. -- For this we use `coerce` to take use back to the types we are used to. -- The typeclass mechanism uses the coercion rules for Pair, as well as the -- knowledge that natural numbers are represented as integers. -- We additionally benefit from the congruence rules for List, Maybe, Char, -- Bool, and a reflexivity principle for variable A. uncons : List A → Maybe (A × List A) uncons = coerce primUncons catMaybes : List (Maybe A) → List A catMaybes = primCatMaybes testChar : Char → Bool testChar = coerce primTestChar -- note that coerce is useless here but the proof could come from -- either `coerce-fun coerce-refl coerce-refl` or `coerce-refl` alone -- We (and Agda) do not care which proof we got. eqNat : Nat → Nat → Bool eqNat = coerce primIntEq -- We can coerce `Nat` to `Int` but not `Int` to `Nat`. This fundamentally -- relies on the fact that `Coercible` understands that functions are -- contravariant. open import IO open import Codata.Musical.Notation open import Data.String.Base using (toList; fromList; unlines; _++_) open import Relation.Nullary.Negation -- example program using uncons, catMaybes, and testChar main = run $ do content ← readFiniteFile "README/Foreign/Haskell.agda" let chars = toList content let cleanup = catMaybes ∘ List.map (λ c → if testChar c then just c else nothing) let cleaned = dropWhile ('\n' ≟_) $ cleanup chars case uncons cleaned of λ where nothing → putStrLn "I cannot believe this file is filed with dashes only!" (just (c , cs)) → putStrLn $ unlines $ ("First (non dash) character: " ++ Char.show c) ∷ ("Rest (dash free) of the line: " ++ fromList (takeWhile (¬? ∘ ('\n' ≟_)) cs)) ∷ [] -- You can compile and run this test by writing: -- agda -c Haskell.agda -- ../../Haskell -- You should see the following text (without the indentation on the left): -- First (non dash) character: ' ' -- Rest (dash free) of the line: The Agda standard library agda-stdlib-1.7.3/README/Function/000077500000000000000000000000001451211343400164155ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Function/Reasoning.agda000066400000000000000000000046301451211343400211630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some examples showing how the Function.Reasoning module -- can be used to perform "functional reasoning" similar to what is being -- described in: https://stackoverflow.com/q/22676703/3168666 ------------------------------------------------------------------------ {-# OPTIONS --with-K #-} module README.Function.Reasoning where -- Function.Reasoning exports a flipped application (_|>_) combinator -- as well as a type annotation (_∶_) combinator. open import Function.Reasoning ------------------------------------------------------------------------ -- A simple example module _ {A B C : Set} {A→B : A → B} {B→C : B → C} where -- Using the combinators we can, starting from a value, chain various -- functions whilst tracking the types of the intermediate results. A→C : A → C A→C a = a ∶ A |> A→B ∶ B |> B→C ∶ C ------------------------------------------------------------------------ -- A more concrete example open import Data.Nat open import Data.List.Base open import Data.Char.Base open import Data.String using (String; toList; fromList; _==_) open import Function open import Data.Bool hiding (_≤?_) open import Data.Product as P using (_×_; <_,_>; uncurry; proj₁) open import Agda.Builtin.Equality -- This can give us for instance this decomposition of a function -- collecting all of the substrings of the input which happen to be -- palindromes: subpalindromes : String → List String subpalindromes str = let Chars = List Char in str ∶ String -- first generate the substrings |> toList ∶ Chars |> inits ∶ List Chars |> concatMap tails ∶ List Chars -- then only keeps the ones which are not singletons |> filter (λ cs → 2 ≤? length cs) ∶ List Chars -- only keep the ones that are palindromes |> map < fromList , fromList ∘ reverse > ∶ List (String × String) |> boolFilter (uncurry _==_) ∶ List (String × String) |> map proj₁ ∶ List String -- Test cases _ : subpalindromes "doctoresreverse" ≡ "eve" ∷ "rever" ∷ "srevers" ∷ "esreverse" ∷ [] _ = refl _ : subpalindromes "elle-meme" ≡ "ll" ∷ "elle" ∷ "mem" ∷ "eme" ∷ [] _ = refl agda-stdlib-1.7.3/README/IO.agda000066400000000000000000000075531451211343400157670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Simple examples of programs using IO ------------------------------------------------------------------------ {-# OPTIONS --guardedness #-} module README.IO where open import Level open import Data.Nat.Base open import Data.Nat.Show using (show) open import Data.String using (String; _++_; lines) open import Data.Unit.Polymorphic open import IO ------------------------------------------------------------------------ -- Basic programs ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- Hello World! -- Minimal example of an IO program. -- * The entrypoint of the executable is given type `Main` -- * It is implemented using `run`, a function that converts a description -- of an IO-computation into a computation that actually invokes the magic -- primitives that will perform the side effects. helloWorld : Main helloWorld = run (putStrLn "Hello World!") ------------------------------------------------------------------------ -- Hello {{name}}! -- We can of course write little auxiliary functions that may be used in -- larger IO programs. Here we are going to first write a function displaying -- "Hello {{name}}!" when {{name}} is passed as an argument. -- `IO` primitives whose sole purpose is generating side effects (e.g. -- printing a string on the screen) are typically given a level polymorphic -- type which means we may need to add explicit level annotations. -- Here we state that the `IO` computation will be at level zero (`0ℓ`). sayHello : String → IO {0ℓ} ⊤ sayHello name = putStrLn ("Hello " ++ name ++ "!") -- Functions can be sequenced using monadic combinators or `do` notations. -- The two following definitions are equivalent. They start by asking the -- user what their name is, listen for an answer and respond by saying hello -- using the `sayHello` auxiliary function we just defined. helloName : Main helloName = run (putStrLn "What is your name?" >> getLine >>= sayHello) doHelloName : Main doHelloName = run do putStrLn "What is your name?" name ← getLine sayHello name ------------------------------------------------------------------------ -- (Co)Recursive programs ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- NO GUARDEDNESS -- If you do not need to rely on guardedness for the function to be seen as -- terminating (for instance because it is structural in an inductive argument) -- then you can use `do` notations to write fairly readable programs. -- Countdown to explosion countdown : ℕ → IO {0ℓ} _ countdown zero = putStrLn "BOOM!" countdown m@(suc n) = do let str = show m putStrLn str countdown n -- cat the content of a finite file cat : String → IO _ cat fp = do content ← readFiniteFile fp let ls = lines content List.mapM′ putStrLn ls open import Codata.Musical.Notation open import Codata.Musical.Colist open import Data.Bool open import Data.Unit.Polymorphic.Base ------------------------------------------------------------------------ -- GUARDEDNESS -- If you are performing coinduction on a potentially infinite piece of codata -- then you need to rely on guardedness. That is to say that the coinductive -- call needs to be obviously under a coinductive constructor and guarded by a -- sharp (♯_). -- In this case you cannot use the convenient combinators that make `do`-notations -- and have to revert back to the underlying coinductive constructors. -- Whether a colist is finite is semi decidable: just let the user wait until -- you reach the end! isFinite : ∀ {a} {A : Set a} → Colist A → IO Bool isFinite [] = return true isFinite (x ∷ xs) = seq (♯ return tt) (♯ isFinite (♭ xs)) agda-stdlib-1.7.3/README/Inspect.agda000066400000000000000000000124001451211343400170500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Explaining how to use the inspect idiom and elaborating on the way -- it is implemented in the standard library. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Inspect where open import Data.Nat.Base open import Data.Nat.Properties open import Data.Product open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Using inspect -- We start with the definition of a (silly) predicate: `Plus m n p` states -- that `m + n` is equal to `p` in a rather convoluted way. Crucially, it -- distinguishes two cases: whether `p` is 0 or not. Plus-eq : (m n p : ℕ) → Set Plus-eq m n zero = m ≡ 0 × n ≡ 0 Plus-eq m n p@(suc _) = m + n ≡ p -- A sensible lemma to prove of this predicate is that whenever `p` is literally -- `m + n` then `Plus m n p` holds. That is to say `∀ m n → Plus m n (m + n)`. -- To be able to prove `Plus-eq m n (m + n)`, we need `m + n` to have either -- the shape `zero` or `suc _` so that `Plus-eq` may reduce. -- We could follow the way `_+_` computes by mimicking the same splitting -- strategy, thus forcing `m + n` to reduce: plus-eq-+ : ∀ m n → Plus-eq m n (m + n) plus-eq-+ zero zero = refl , refl plus-eq-+ zero (suc n) = refl plus-eq-+ (suc m) n = refl -- Or we could attempt to compute `m + n` first and check whether the result -- is `zero` or `suc p`. By using `with m + n` and naming the result `p`, -- the goal will become `Plus-eq m n p`. We can further refine this definition -- by distinguishing two cases like so: -- plus-eq-with : ∀ m n → Plus-eq m n (m + n) -- plus-eq-with m n with m + n -- ... | zero = {!!} -- ... | suc p = {!!} -- The problem however is that we have abolutely lost the connection between the -- computation `m + n` and its result `p`. Which makes the two goals unprovable: -- 1. `m ≡ 0 × n ≡ 0`, with no assumption whatsoever -- 2. `m + n ≡ suc p`, with no assumption either -- By using the `with` construct, we have generated an auxiliary function that -- looks like this: -- `plus-eq-with-aux : ∀ m n p → Plus-eq m n p` -- when we would have wanted a more precise type of the form: -- `plus-eq-aux : ∀ m n p → m + n ≡ p → Plus-eq m n p`. -- This is where we can use `inspect`. By using `with f x | inspect f x`, -- we get both a `y` which is the result of `f x` and a proof that `f x ≡ y`. -- Splitting on the result of `m + n`, we get two cases: -- 1. `m ≡ 0 × n ≡ 0` under the assumption that `m + n ≡ zero` -- 2. `m + n ≡ suc p` under the assumption that `m + n ≡ suc p` -- The first one can be discharged using lemmas from Data.Nat.Properties and -- the second one is trivial. plus-eq-with : ∀ m n → Plus-eq m n (m + n) plus-eq-with m n with m + n | inspect (m +_) n ... | zero | [ m+n≡0 ] = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 ... | suc p | [ m+n≡1+p ] = m+n≡1+p ------------------------------------------------------------------------ -- Understanding the implementation of inspect -- So why is it that we have to go through the record type `Reveal_·_is_` -- and the ̀inspect` function? The fact is: we don't have to if we write -- our own auxiliary lemma: plus-eq-aux : ∀ m n → Plus-eq m n (m + n) plus-eq-aux m n = aux m n (m + n) refl where aux : ∀ m n p → m + n ≡ p → Plus-eq m n p aux m n zero m+n≡0 = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 aux m n (suc p) m+n≡1+p = m+n≡1+p -- The problem is that when we write ̀with f x | pr`, `with` decides to call `y` -- the result `f x` and to replace *all* of the occurences of `f x` in the type -- of `pr` with `y`. That is to say that if we were to write: -- plus-eq-naïve : ∀ m n → Plus-eq m n (m + n) -- plus-eq-naïve m n with m + n | refl {x = m + n} -- ... | p | eq = {!!} -- then `with` would abstract `m + n` as `p` on *both* sides of the equality -- proven by `refl` thus giving us the following goal with an extra, useless, -- assumption: -- 1. `Plus-eq m n p` under the assumption that `p ≡ p` -- So how does `inspect` work? The standard library uses a more general version -- of the following type and function: record MyReveal_·_is_ (f : ℕ → ℕ) (x y : ℕ) : Set where constructor [_] field eq : f x ≡ y my-inspect : ∀ f n → MyReveal f · n is (f n) my-inspect f n = [ refl ] -- Given that `inspect` has the type `∀ f n → Reveal f · n is (f n)`, when we -- write `with f n | inspect f n`, the only `f n` that can be abstracted in the -- type of `inspect f n` is the third argument to `Reveal_·_is_`. -- That is to say that the auxiliary definition generated looks like this: plus-eq-reveal : ∀ m n → Plus-eq m n (m + n) plus-eq-reveal m n = aux m n (m + n) (my-inspect (m +_) n) where aux : ∀ m n p → MyReveal (m +_) · n is p → Plus-eq m n p aux m n zero [ m+n≡0 ] = m+n≡0⇒m≡0 m m+n≡0 , m+n≡0⇒n≡0 m m+n≡0 aux m n (suc p) [ m+n≡1+p ] = m+n≡1+p -- At the cost of having to unwrap the constructor `[_]` around the equality -- we care about, we can keep relying on `with` and avoid having to roll out -- handwritten auxiliary definitions. agda-stdlib-1.7.3/README/Nary.agda000066400000000000000000000376561451211343400164000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the generic n-ary operations the stdlib provides -- can be used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Nary where open import Level using (Level) open import Data.Nat.Base open import Data.Nat.Properties open import Data.Fin using (Fin; fromℕ; #_; inject₁) open import Data.List open import Data.List.Properties open import Data.Product using (_×_; _,_) open import Data.Sum using (inj₁; inj₂) open import Function open import Relation.Nullary open import Relation.Binary using (module Tri); open Tri open import Relation.Binary.PropositionalEquality private variable a b c d e : Level A : Set a B : Set b C : Set c D : Set d E : Set e ------------------------------------------------------------------------ -- Introduction ------------------------------------------------------------------------ -- Function.Nary.NonDependent and Data.Product.N-ary.Heterogeneous provide -- a generic representation of n-ary heterogeneous (non dependent) products -- and the corresponding types of (non-dependent) n-ary functions. The -- representation works well with inference thus allowing us to use generic -- combinators to manipulate such functions. open import Data.Product.Nary.NonDependent open import Function.Nary.NonDependent open import Relation.Nary ------------------------------------------------------------------------ -- Generalised equality-manipulating combinators ------------------------------------------------------------------------ -- By default the standard library provides users with (we are leaving out -- the implicit arguments here): -- -- cong : (f : A₁ → B) → a₁ ≡ b₁ → f a₁ ≡ f b₁ -- cong₂ : (f : A₁ → A₂ → B) → a₁ ≡ b₁ → a₂ ≡ b₂ → f a₁ a₂ ≡ f b₁ b₂ -- -- and -- -- subst : (P : A₁ → Set p) → a₁ ≡ b₁ → P a₁ → P b₁ -- subst₂ : (P : A₁ → A₂ → Set p) → a₁ ≡ b₁ → a₂ ≡ b₂ → P a₁ a₂ → P b₁ b₂ -- -- This pattern can be generalised to any natural number `n`. Thanks to our -- library for n-ary functions, we can write the types and implementations -- of `congₙ` and `substₙ`. ------------------------------------------------------------------------ -- congₙ : ∀ n (f : A₁ → ⋯ → Aₙ → B) → -- a₁ ≡ b₁ → ⋯ aₙ ≡ bₙ → f a₁ ⋯ aₙ ≡ f b₁ ⋯ bₙ -- It may be used directly to prove something: _ : ∀ (as bs cs : List ℕ) → zip (zip (as ++ []) (map id cs)) (reverse (reverse bs)) ≡ zip (zip as cs) bs _ = λ as bs cs → congₙ 3 (λ as bs → zip (zip as bs)) (++-identityʳ as) (map-id cs) (reverse-involutive bs) -- Or as part of a longer derivation: _ : ∀ m n p q → suc (m + (p * n) + (q ^ (m + n))) ≡ (m + 0) + (n * p) + (q ^ m * q ^ n) + 1 _ = λ m n p q → begin suc (m + (p * n) + (q ^ (m + n))) ≡⟨ +-comm 1 _ ⟩ m + (p * n) + (q ^ (m + n)) + 1 ≡⟨ congₙ 3 (λ m n p → m + n + p + 1) (+-comm 0 m) (*-comm p n) (^-distribˡ-+-* q m n) ⟩ m + 0 + n * p + (q ^ m) * (q ^ n) + 1 ∎ where open ≡-Reasoning -- Partial application of the functional argument is fine: the number of arguments -- `congₙ` is going to take is determined by its first argument (a natural number) -- and not by the type of the function it works on. _ : ∀ m → (m +_) ≡ ((m + 0) +_) _ = λ m → congₙ 1 _+_ (+-comm 0 m) -- We don't have to work on the function's first argument either: we can just as -- easily use `congₙ` to act on the second one by `flip`ping it. See `holeₙ` for -- a generalisation of this idea allowing to target *any* of the function's -- arguments and not just the first or second one. _ : ∀ m → (_+ m) ≡ (_+ (m + 0)) _ = λ m → congₙ 1 (flip _+_) (+-comm 0 m) ------------------------------------------------------------------------ -- substₙ : (P : A₁ → ⋯ → Aₙ → Set p) → -- a₁ ≡ b₁ → ⋯ aₙ ≡ bₙ → P a₁ ⋯ aₙ → P b₁ ⋯ bₙ -- We can play the same type of game with subst open import Agda.Builtin.Nat using (mod-helper) -- Because we know from the definition `mod-helper` that this equation holds: -- mod-helper k m (suc n) (suc j) = mod-helper (suc k) m n j -- we should be able to prove the slightly modified statement by transforming -- all the `x + 1` into `suc x`. We can do so using `substₙ`. _ : ∀ k m n j → mod-helper k m (n + 1) (j + 1) ≡ mod-helper (k + 1) m n j _ = λ k m n j → let P sk sn sj = mod-helper k m sn sj ≡ mod-helper sk m n j in substₙ P (+-comm 1 k) (+-comm 1 n) (+-comm 1 j) refl ----------------------------------------------------------------------- -- Generic programs working on n-ary products & functions ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- curryₙ : ∀ n → (A₁ × ⋯ × Aₙ → B) → A₁ → ⋯ → Aₙ → B -- uncurryₙ : ∀ n → (A₁ → ⋯ → Aₙ → B) → A₁ × ⋯ × Aₙ → B -- The first thing we may want to do generically is convert between -- curried function types and uncurried ones. We can do this by using: -- They both work the same way so we will focus on curryₙ only here. -- If we pass to `curryₙ` the arity of its argument then we obtain a -- fully curried function. curry₁ : (A × B × C × D → E) → A → B → C → D → E curry₁ = curryₙ 4 -- Note that here we are not flattening arbitrary nestings: products have -- to be right nested. Which means that if you have a deeply-nested product -- then it won't be affected by the procedure. curry₁′ : (A × (B × C) × D → E) → A → (B × C) → D → E curry₁′ = curryₙ 3 -- When we are currying a function, we have no obligation to pass its exact -- arity as the parameter: we can decide to only curry part of it like so: -- Indeed (A₁ × ⋯ × Aₙ → B) can also be seen as (A₁ × ⋯ × (Aₖ × ⋯ × Aₙ) → B) curry₂ : (A × B × C × D → E) → A → B → (C × D) → E curry₂ = curryₙ 3 ----------------------------------------------------------------------- -- projₙ : ∀ n (k : Fin n) → (A₁ × ⋯ × Aₙ) → Aₖ₊₁ -- Another useful class of functions to manipulate n-ary product is a -- generic projection function. Note the (k + 1) in the return index: -- Fin counts from 0 up. -- It behaves as one expects (Data.Fin's #_ comes in handy to write down -- Fin literals): proj₃ : (A × B × C × D × E) → C proj₃ = projₙ 5 (# 2) -- Of course we can once more project the "tail" of the n-ary product by -- passing `projₙ` a natural number which is smaller than the size of the -- n-ary product, seeing (A₁ × ⋯ × Aₙ) as (A₁ × ⋯ × (Aₖ × ⋯ × Aₙ)). proj₃′ : (A × B × C × D × E) → C × D × E proj₃′ = projₙ 3 (# 2) ----------------------------------------------------------------------- -- insertₙ : ∀ n (k : Fin (suc n)) → -- B → (A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × B × Aₖ₊₁ × ⋯ Aₙ) insert₁ : C → (A × B × D × E) → (A × B × C × D × E) insert₁ = insertₙ 4 (# 2) insert₁′ : C → (A × B × D × E) → (A × B × C × D × E) insert₁′ = insertₙ 3 (# 2) -- Note that `insertₙ` takes a `Fin (suc n)`. Indeed in an n-ary product -- there are (suc n) positions at which one may insert a value. We may -- insert at the front or the back of the product: insert-front : A → (B × C × D × E) → (A × B × C × D × E) insert-front = insertₙ 4 (# 0) insert-back : E → (A × B × C × D) → (A × B × C × D × E) insert-back = insertₙ 4 (# 4) ----------------------------------------------------------------------- -- removeₙ : ∀ n (k : Fin n) → (A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × Aₖ₊₂ × ⋯ Aₙ) -- Dual to `insertₙ`, we may remove a value. remove₁ : (A × B × C × D × E) → (A × B × D × E) remove₁ = removeₙ 5 (# 2) -- Inserting at `k` and then removing at `inject₁ k` should yield the identity remove-insert : C → (A × B × D × E) → (A × B × D × E) remove-insert c = removeₙ 5 (inject₁ k) ∘′ insertₙ 4 k c where k = # 2 ----------------------------------------------------------------------- -- updateₙ : ∀ n (k : Fin n) (f : (a : Aₖ₊₁) → B a) → -- (p : A₁ × ⋯ Aₙ) → (A₁ × ⋯ × Aₖ × B (projₙ n k p) × Aₖ₊₂ × ⋯ Aₙ) -- We can not only project out, insert or remove values: we can update them -- in place. The type (and value) of the replacement at position k may depend -- upon the current value at position k. update₁ : (p : A × B × ℕ × C × D) → (A × B × Fin _ × C × D) update₁ = updateₙ 5 (# 2) fromℕ -- We can explicitly use the primed version of `updateₙ` to make it known to -- Agda that the update function is non dependent. This type of information -- is useful for inference: the tighter the constraints, the easier it is to -- find a solution (if possible). update₂ : (p : A × B × ℕ × C × D) → (A × B × List D × C × D) update₂ = λ p → updateₙ′ 5 (# 2) (λ n → replicate n (projₙ 5 (# 4) p)) p ----------------------------------------------------------------------- -- _%=_⊢_ : ∀ n → (C → D) → (A₁ → ⋯ Aₙ → D → B) → A₁ → ⋯ → Aₙ → C → B -- Traditional composition (also known as the index update operator `_⊢_` -- in `Relation.Unary`) focuses solely on the first argument of an n-ary -- function. `_%=_⊢_` on the other hand allows us to touch any one of the -- arguments. -- In the following example we have a function `f : A → B` and `replicate` -- of type `ℕ → B → List B`. We want ̀f` to act on the second argument of -- replicate. Which we can do like so. compose₁ : (A → B) → ℕ → A → List B compose₁ f = 1 %= f ⊢ replicate -- Here we spell out the equivalent explicit variable-manipulation and -- prove the two functions equal. compose₁′ : (A → B) → ℕ → A → List B compose₁′ f n a = replicate n (f a) compose₁-eq : compose₁ {a} {A} {b} {B} ≡ compose₁′ compose₁-eq = refl ----------------------------------------------------------------------- -- _∷=_⊢_ : ∀ n → A → (A₁ → ⋯ Aₙ → A → B) → A₁ → ⋯ → Aₙ → B -- Partial application usually focuses on the first argument of a function. -- We can now partially apply a function in any of its arguments using -- `_∷=_⊢_`. Reusing our example involving replicate: we can specialise it -- to only output finite lists of `0`: apply₁ : ℕ → List ℕ apply₁ = 1 ∷= 0 ⊢ replicate apply₁-eq : apply₁ 3 ≡ 0 ∷ 0 ∷ 0 ∷ [] apply₁-eq = refl ------------------------------------------------------------------------ -- holeₙ : ∀ n → (A → (A₁ → ⋯ Aₙ → B)) → A₁ → ⋯ → Aₙ → (A → B) -- As we have seen earlier, `cong` acts on a function's first variable. -- If we want to access the second one, we can use `flip`. But what about -- the fourth one? We typically use an explicit λ-abstraction shuffling -- variables. Not anymore. -- Reusing mod-helper just because it takes a lot of arguments: hole₁ : ∀ k m n j → mod-helper k (m + 1) n j ≡ mod-helper k (suc m) n j hole₁ = λ k m n j → cong (holeₙ 2 (mod-helper k) n j) (+-comm m 1) ----------------------------------------------------------------------- -- mapₙ : ∀ n → (B → C) → (A₁ → ⋯ Aₙ → B) → (A₁ → ⋯ → Aₙ → C) -- (R →_) gives us the reader monad (and, a fortiori, functor). That is to -- say that given a function (A → B) and an (R → A) we can get an (R → B) -- This generalises to n-ary functions. -- Reusing our `composeₙ` example: instead of applying `f` to the replicated -- element, we can map it on the resulting list. Giving us: map₁ : (A → B) → ℕ → A → List B map₁ f = mapₙ 2 (map f) replicate ------------------------------------------------------------------------ -- constₙ : ∀ n → B → A₁ → ⋯ → Aₙ → B -- `const` is basically `pure` for the reader monad discussed above. Just -- like we can generalise the functorial action corresponding to the reader -- functor to n-ary functions, we can do the same for `pure`. const₁ : A → B → C → D → E → A const₁ = constₙ 4 -- Together with `holeₙ`, this means we can make a constant function out -- of any of the arguments. The fourth for instance: const₂ : A → B → C → D → E → D const₂ = holeₙ 3 (constₙ 4) ------------------------------------------------------------------------ -- Generalised quantifiers ------------------------------------------------------------------------ -- As we have seen multiple times already, one of the advantages of working -- with non-dependent products is that they can be easily inferred. This is -- a prime opportunity to define generic quantifiers. -- And because n-ary relations are Set-terminated, there is no ambiguity -- where to split between arguments & codomain. As a consequence Agda can -- infer even `n`, the number of arguments. We can use notations which are -- just like the ones defined in `Relation.Unary`. ------------------------------------------------------------------------ -- ∃⟨_⟩ : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- ∃⟨ P ⟩ = ∃ λ a₁ → ⋯ → ∃ λ aₙ → P a₁ ⋯ aₙ -- Returning to our favourite function taking a lot of arguments: we can -- find a set of input for which it evaluates to 666 exist₁ : ∃⟨ (λ k m n j → mod-helper k m n j ≡ 666) ⟩ exist₁ = 19 , 793 , 3059 , 10 , refl ------------------------------------------------------------------------ -- ∀[_] : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- ∀[_] P = ∀ {a₁} → ⋯ → ∀ {aₙ} → P a₁ ⋯ aₙ all₁ : ∀[ (λ (a₁ a₂ : ℕ) → Dec (a₁ ≡ a₂)) ] all₁ {a₁} {a₂} = a₁ ≟ a₂ ------------------------------------------------------------------------ -- Π : (A₁ → ⋯ → Aₙ → Set r) → Set _ -- Π P = ∀ a₁ → ⋯ → ∀ aₙ → P a₁ ⋯ aₙ all₂ : Π[ (λ (a₁ a₂ : ℕ) → Dec (a₁ ≡ a₂)) ] all₂ = _≟_ ------------------------------------------------------------------------ -- _⇒_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ⇒ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ → Q a₁ ⋯ aₙ antisym : ∀[ _≤_ ⇒ _≥_ ⇒ _≡_ ] antisym = ≤-antisym ------------------------------------------------------------------------ -- _∪_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ∪ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ ⊎ Q a₁ ⋯ aₙ ≤->-connex : Π[ _≤_ ∪ _>_ ] ≤->-connex m n with <-cmp m n ... | tri< a ¬b ¬c = inj₁ (<⇒≤ a) ... | tri≈ ¬a b ¬c = inj₁ (≤-reflexive b) ... | tri> ¬a ¬b c = inj₂ c ------------------------------------------------------------------------ -- _∩_ : (A₁ → ⋯ → Aₙ → Set r) → (A₁ → ⋯ → Aₙ → Set s) → (A₁ → ⋯ → Aₙ → Set _) -- P ∩ Q = λ a₁ → ⋯ → λ aₙ → P a₁ ⋯ aₙ × Q a₁ ⋯ aₙ <-inversion : ∀[ _<_ ⇒ _≤_ ∩ _≢_ ] <-inversion m_ ⇒ ∁ _≤_ ] mn m≤n = <⇒≱ m>n m≤n agda-stdlib-1.7.3/README/Reflection/000077500000000000000000000000001451211343400167225ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Reflection/External.agda000066400000000000000000000040621451211343400213240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- How to use reflection to call external functions. -- -- IMPORTANT: In order for this file to type-check you will need to add -- a line `/usr/bin/expr` to your `~/.agda/executables` file. See the -- section on Reflection in the Agda user manual for more details. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --allow-exec #-} module README.Reflection.External where open import Data.List.Base using ([]; _∷_) open import Data.String.Base using (String; _++_) open import Relation.Binary.PropositionalEquality -- All the commands needed to make an external system call are included -- in `Reflection.External`. open import Reflection.External using (CmdSpec; runCmd) -- The most important one is `CmdSpec` ("command specification") -- which allows ones to specify the external command being called, its -- arguments and the contents of stdin. -- Here we define a simple command spec that takes two numbers and -- uses the Unix `expr` command to add the two together. add : String → String → CmdSpec add x y = record { name = "expr" ; args = x ∷ "+" ∷ y ∷ [] ; input = "" } -- The command can then be run using the `runCmd` macro. If no error -- occured then by default the macro returns the result of `stdout`. -- Otherwise the macro will terminate with a type error. test : runCmd (add "1" "2") ≡ "3\n" test = refl -- If you are running a command that you know might be ill-formed -- and result in an error then can use `unsafeRunCmd` instead that -- returns a `Result` object containing the exit code and the contents -- of both `stdout` and `stderr`. open import Reflection.External using (unsafeRunCmd; result; exitFailure) error = "/usr/bin/expr: non-integer argument\n" test2 : unsafeRunCmd (add "a" "b") ≡ result (exitFailure 2) "" error test2 = refl -- For a more advanced use-case where SMT solvers are invoked from -- Agda, see Schmitty (https://github.com/wenkokke/schmitty) agda-stdlib-1.7.3/README/Relation/000077500000000000000000000000001451211343400164055ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Relation/Binary/000077500000000000000000000000001451211343400176315ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Relation/Binary/TypeClasses.agda000066400000000000000000000033741451211343400227150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Usage examples of typeclasses for binary relations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module README.Relation.Binary.TypeClasses where open import Relation.Nullary open import Relation.Binary.PropositionalEquality open import Relation.Binary.TypeClasses open import Data.Bool.Base renaming (_≤_ to _≤Bool) open import Data.Bool.Instances open import Data.List.Base open import Data.List.Instances open import Data.List.Relation.Binary.Lex.NonStrict using (Lex-≤) open import Data.Nat.Base renaming (_≤_ to _≤ℕ_) open import Data.Nat.Instances open import Data.Product open import Data.Product.Instances open import Data.Unit.Base renaming (_≤_ to _≤⊤_) open import Data.Unit.Instances open import Data.Vec.Base open import Data.Vec.Instances test-Dec≡-Bool : Dec (true ≡ true) test-Dec≡-Bool = true ≟ true test-Dec≡-Nat : Dec (0 ≡ 1) test-Dec≡-Nat = 0 ≟ 1 test-Dec≡-List : Dec (_≡_ {A = List ℕ} (1 ∷ 2 ∷ []) (1 ∷ 2 ∷ [])) test-Dec≡-List = (1 ∷ 2 ∷ []) ≟ (1 ∷ 2 ∷ []) test-Dec≡-⊤ : Dec (tt ≡ tt) test-Dec≡-⊤ = _ ≟ _ test-Dec≡-Pair : Dec (_≡_ {A = Bool × Bool} (true , false) (false , true)) test-Dec≡-Pair = _ ≟ _ test-Dec≡-Vec : Dec (_≡_ {A = Vec Bool 2} (true ∷ false ∷ []) (true ∷ false ∷ [])) test-Dec≡-Vec = _ ≟ _ test-Dec≡-Σ : Dec (_≡_ {A = Σ ℕ (Vec Bool)} (0 , []) (1 , true ∷ [])) test-Dec≡-Σ = _ ≟ _ test-Dec≤-Nat : Dec (0 ≤ℕ 1) test-Dec≤-Nat = 0 ≤? 1 test-Dec≤-List : Dec (Lex-≤ _≡_ _≤ℕ_ (0 ∷ 1 ∷ []) (1 ∷ [])) test-Dec≤-List = _ ≤? _ agda-stdlib-1.7.3/README/Tactic/000077500000000000000000000000001451211343400160375ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Tactic/MonoidSolver.agda000066400000000000000000000021431451211343400212750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An explanation about how to use the solver in Tactic.MonoidSolver. ------------------------------------------------------------------------ open import Algebra module README.Tactic.MonoidSolver {a ℓ} (M : Monoid a ℓ) where open Monoid M open import Data.Nat as Nat using (ℕ; suc; zero; _+_) open import Data.Nat.Properties as Properties using (+-0-monoid; +-comm) open import Relation.Binary.Reasoning.Setoid setoid open import Tactic.MonoidSolver using (solve; solve-macro) -- The monoid solver is capable to of solving equations without having -- to specify the equation itself in the proof. example₁ : ∀ x y z → (x ∙ y) ∙ z ≈ x ∙ (y ∙ z) ∙ ε example₁ x y z = solve M -- The solver can also be used in equational reasoning. example₂ : ∀ w x y z → w ≈ x → (w ∙ y) ∙ z ≈ x ∙ (y ∙ z) ∙ ε example₂ w x y z w≈x = begin (w ∙ y) ∙ z ≈⟨ ∙-congʳ (∙-congʳ w≈x) ⟩ (x ∙ y) ∙ z ≈⟨ solve M ⟩ x ∙ (y ∙ z) ∙ ε ∎ agda-stdlib-1.7.3/README/Tactic/RingSolver.agda000066400000000000000000000077441451211343400207630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples showing how the reflective ring solver may be used. ------------------------------------------------------------------------ module README.Tactic.RingSolver where -- You can ignore this bit! We're just overloading the literals Agda uses for -- numbers. This bit isn't necessary if you're just using Nats, or if you -- construct your type directly. We only really do it here so that we can use -- different numeric types in the same file. open import Agda.Builtin.FromNat open import Data.Nat using (ℕ) open import Data.Integer using (ℤ) import Data.Nat.Literals as ℕ import Data.Integer.Literals as ℤ instance numberNat : Number ℕ numberNat = ℕ.number instance numberInt : Number ℤ numberInt = ℤ.number ------------------------------------------------------------------------------ -- Imports! open import Data.List as List using (List; _∷_; []) open import Function open import Relation.Binary.PropositionalEquality as ≡ using (subst; _≡_; module ≡-Reasoning) open import Data.Bool as Bool using (Bool; true; false; if_then_else_) open import Data.Unit using (⊤; tt) open import Tactic.RingSolver.Core.AlmostCommutativeRing using (AlmostCommutativeRing) ------------------------------------------------------------------------------ -- Integer examples ------------------------------------------------------------------------------ module IntegerExamples where open import Data.Integer.Tactic.RingSolver open AlmostCommutativeRing ring -- Everything is automatic: you just ask Agda to solve it and it does! lemma₁ : ∀ x y → x + y * 1 + 3 ≈ 3 + 1 + y + x + - 1 lemma₁ = solve-∀ lemma₂ : ∀ x y → (x + y) ^ 2 ≈ x ^ 2 + 2 * x * y + y ^ 2 lemma₂ = solve-∀ -- It can interact with manual proofs as well. lemma₃ : ∀ x y → x + y * 1 + 3 ≈ 2 + 1 + y + x lemma₃ x y = begin x + y * 1 + 3 ≡⟨ +-comm x (y * 1) ⟨ +-cong ⟩ refl ⟩ y * 1 + x + 3 ≡⟨ solve (x ∷ y ∷ []) ⟩ 3 + y + x ≡⟨⟩ 2 + 1 + y + x ∎ where open ≡-Reasoning ------------------------------------------------------------------------------ -- Natural examples ------------------------------------------------------------------------------ module NaturalExamples where open import Data.Nat.Tactic.RingSolver open AlmostCommutativeRing ring -- The solver is flexible enough to work with ℕ (even though it asks -- for rings!) lemma₁ : ∀ x y → x + y * 1 + 3 ≈ 2 + 1 + y + x lemma₁ = solve-∀ ------------------------------------------------------------------------------ -- Checking invariants ------------------------------------------------------------------------------ -- The solver makes it easy to prove invariants, without having to rewrite -- proof code every time something changes in the data structure. module _ {a} {A : Set a} (_≤_ : A → A → Bool) where open import Data.Nat.Tactic.RingSolver open AlmostCommutativeRing ring -- A Skew Heap, indexed by its size. data Tree : ℕ → Set a where leaf : Tree 0 node : ∀ {n m} → A → Tree n → Tree m → Tree (1 + n + m) -- A substitution operator, to clean things up. infixr 1 _⇒_ _⇒_ : ∀ {n} → Tree n → ∀ {m} → n ≈ m → Tree m x ⇒ n≈m = subst Tree n≈m x open ≡-Reasoning _∪_ : ∀ {n m} → Tree n → Tree m → Tree (n + m) leaf ∪ ys = ys node {a} {b} x xl xr ∪ leaf = node x xl xr ⇒ solve (a ∷ b ∷ []) node {a} {b} x xl xr ∪ node {c} {d} y yl yr = if x ≤ y then node x (node y yl yr ∪ xr) xl ⇒ begin 1 + (1 + c + d + b) + a ≡⟨ solve (a ∷ b ∷ c ∷ d ∷ []) ⟩ 1 + a + b + (1 + c + d) ∎ else node y (node x xl xr ∪ yr) yl ⇒ begin 1 + (1 + a + b + d) + c ≡⟨ solve (a ∷ b ∷ c ∷ d ∷ []) ⟩ 1 + a + b + (1 + c + d) ∎ agda-stdlib-1.7.3/README/Text/000077500000000000000000000000001451211343400155545ustar00rootroot00000000000000agda-stdlib-1.7.3/README/Text/Pretty.agda000066400000000000000000000150631451211343400176660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of pretty printing ------------------------------------------------------------------------ {-# OPTIONS --sized-types #-} module README.Text.Pretty where open import Size open import Data.Bool.Base open import Data.List.Base as List open import Data.List.NonEmpty as List⁺ open import Data.Nat.Base open import Data.Product open import Data.String.Base hiding (parens; _<+>_) open import Data.Vec.Base as Vec open import Function.Base -- We import the pretty printer and pass 80 to say that we do not want to -- have lines longer than 80 characters open import Text.Pretty 80 open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- A small declarative programming language ------------------------------------------------------------------------ -- We define a small programming language where definitions are -- introduced by providing a non-empty list of equations with: -- * the same number of patterns on the LHS -- * a term on the RHS of each equation -- A pattern is either a variable or a constructor applied to a -- list of subpatterns data Pattern (i : Size) : Set where var : String → Pattern i con : ∀ {j : Size< i} → String → List (Pattern j) → Pattern i -- A term is either a (bound) variable, the application of a -- named definition / constructor to a list of arguments or a -- lambda abstraction data Term (i : Size) : Set where var : String → Term i app : ∀ {j : Size< i} → String → List (Term j) → Term i lam : ∀ {j : Size< i} → String → Term j → Term i -- As explained before, a definitions is given by a list of equations infix 1 _by_ record Def : Set where constructor _by_ field name : String {arity} : ℕ equations : List⁺ (Vec (Pattern _) arity × (Term _)) ------------------------------------------------------------------------ -- A pretty printer for this language ------------------------------------------------------------------------ -- First we print patterns. We only wrap a pattern in parentheses if it -- is compound: i.e. if it is a constructor applied to a non-empty list -- of subpatterns -- Lists of patterns are printed separated by a single space. prettyPattern : ∀ {i} → Pattern i → Doc prettyPatterns : ∀ {i} → List (Pattern i) → Doc prettyPattern (var v) = text v prettyPattern (con c []) = text c prettyPattern (con c ps) = parens $ text c <+> prettyPatterns ps prettyPatterns = hsep ∘ List.map prettyPattern -- Next we print terms. The Bool argument tells us whether we are on -- the RHS of an application (in which case it is sensible to wrap -- complex subterms in parentheses). prettyTerm : ∀ {i} → Bool → Term i → Doc prettyTerm l (var v) = text v prettyTerm l (app f []) = text f prettyTerm l (app f es) = if l then parens else id $ text f <+> sep (List.map (prettyTerm true) es) prettyTerm l (lam x b) = if l then parens else id $ text "λ" <+> text x <> text "." <+> prettyTerm false b -- We now have all the pieces to print definitions. -- We print the equations below each other by using vcat. -- -- The LHS is printed as follows: the name of the function followed by -- the space-separated list of patterns (if any) and then an equal sign. -- -- The RHS is printed as a term which is *not* on the RHS of an application. -- -- Finally we can layout the definition in two different manners: -- * either LHS followed by RHS -- * or LHS followed and the RHS as a relative block (indented by 2 spaces) -- on the next line prettyDef : Def → Doc prettyDef (fun by eqs) = vcat $ List⁺.toList $ flip List⁺.map eqs $ uncurry $ λ ps e → let lhs = text fun <+> (case ps of λ where [] → text "=" _ → prettyPatterns (Vec.toList ps) <+> text "=") rhs = prettyTerm false e in lhs <+> rhs <|> lhs $$ (spaces 2 <> rhs) -- The pretty printer is obtained by using the renderer. pretty : Def → String pretty = render ∘ prettyDef ------------------------------------------------------------------------ -- Some examples ------------------------------------------------------------------------ -- Our first example is the identity function defined as a λ-abstraction `id : Def `id = "id" by ([] , lam "x" (var "x")) ∷ [] _ : pretty `id ≡ "id = λ x. x" _ = refl -- If we were to assume that this definition also takes a level (a) and -- a Set at that level (A) as arguments, we can have a slightly more complex -- definition like so. `explicitid : Def `explicitid = "id" by (var "a" ∷ var "A" ∷ [] , lam "x" (var "x")) ∷ [] _ : pretty `explicitid ≡ "id a A = λ x. x" _ = refl -- A more complex example: boolFilter, a function that takes a boolean -- predicate and a list as arguments and returns a list containing only -- the values that satisfy the predicate. -- We use nil and con for [] and _∷_ as our little toy language does not -- support infix notations. `filter : Def `filter = "boolFilter" by ( var "P?" ∷ con "nil" [] ∷ [] , app "nil" [] ) ∷ ( var "P?" ∷ con "con" (var "x" ∷ var "xs" ∷ []) ∷ [] , let rec = app "filter" (var "P?" ∷ var "xs" ∷ []) in app "if" (app "P?" (var "x" ∷ []) ∷ app "con" (var "x" ∷ rec ∷ []) ∷ rec ∷ []) ) ∷ [] _ : pretty `filter ≡ "boolFilter P? nil = nil \ \boolFilter P? (con x xs) = if (P? x) (con x (filter P? xs)) (filter P? xs)" _ = refl -- We can once more revisit this example with its more complex counterpart: -- boolFilter taking its level and set arguments explicitly (idem for the -- list constructors nil and con). -- This time laying out the second equation on a single line would produce a -- string larger than 80 characters long. So the pretty printer decides to -- make the RHS a relative block indented by 2 spaces. `explicitfilter : Def `explicitfilter = "boolFilter" by ( var "a" ∷ var "A" ∷ var "P?" ∷ con "nil" [] ∷ [] , app "nil" (var "a" ∷ var "A" ∷ []) ) ∷ ( var "a" ∷ var "A" ∷ var "P?" ∷ con "con" (var "x" ∷ var "xs" ∷ []) ∷ [] , let rec = app "filter" (var "a" ∷ var "A" ∷ var "P?" ∷ var "xs" ∷ []) in app "if" (app "P?" (var "x" ∷ []) ∷ app "con" (var "a" ∷ var "A" ∷ var "x" ∷ rec ∷ []) ∷ rec ∷ []) ) ∷ [] _ : pretty `explicitfilter ≡ "boolFilter a A P? nil = nil a A \ \boolFilter a A P? (con x xs) = \ \ if (P? x) (con a A x (filter a A P? xs)) (filter a A P? xs)" _ = refl agda-stdlib-1.7.3/README/Text/Printf.agda000066400000000000000000000061341451211343400176400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of format strings and printf ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible #-} module README.Text.Printf where open import Data.Nat.Base open import Data.Char.Base open import Data.List.Base open import Data.String.Base open import Data.Sum.Base open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Format strings open import Text.Format -- We can specify a format by writing a string which will get interpreted -- by a lexer into a list of formatting directives. -- The specification types are always started with a '%' character: -- Integers (%d or %i) -- Naturals (%u) -- Floats (%f) -- Chars (%c) -- Strings (%s) -- Anything which is not a type specification is a raw string to be spliced -- in the output of printf. -- For instance the following format alternates types and raw strings _ : lexer "%s: %u + %u ≡ %u" ≡ inj₂ (`String ∷ Raw ": " ∷ `ℕ ∷ Raw " + " ∷ `ℕ ∷ Raw " ≡ " ∷ `ℕ ∷ []) _ = refl -- Lexing can fail. There are two possible errors: -- If we start a specification type with a '%' but the string ends then -- we get an UnexpectedEndOfString error _ : lexer "%s: %u + %u ≡ %" ≡ inj₁ (UnexpectedEndOfString "%s: %u + %u ≡ %") _ = refl -- If we start a specification type with a '%' and the following character -- does not correspond to an existing type, we get an InvalidType error -- together with a focus highlighting the position of the problematic type. _ : lexer "%s: %u + %a ≡ %u" ≡ inj₁ (InvalidType "%s: %u + %" 'a' " ≡ %u") _ = refl ------------------------------------------------------------------------ -- Printf open import Text.Printf -- printf is a function which takes a format string as an argument and -- returns a function expecting a value for each type specification present -- in the format and returns a string splicing in these values into the -- format string. -- For instance `printf "%s: %u + %u ≡ %u"` is a -- `String → ℕ → ℕ → ℕ → String` function. _ : String → ℕ → ℕ → ℕ → String _ = printf "%s: %u + %u ≡ %u" _ : printf "%s: %u + %u ≡ %u" "example" 3 2 5 ≡ "example: 3 + 2 ≡ 5" _ = refl -- If the format string str is invalid then `printf str` will have type -- `Error e` where `e` is the lexing error. _ : Text.Printf.Error (UnexpectedEndOfString "%s: %u + %u ≡ %") _ = printf "%s: %u + %u ≡ %" _ : Text.Printf.Error (InvalidType "%s: %u + %" 'a' " ≡ %u") _ = printf "%s: %u + %a ≡ %u" -- Trying to pass arguments to such an ̀Error` type will lead to a -- unification error which hopefully makes the problem clear e.g. -- `printf "%s: %u + %a ≡ %u" "example" 3 2 5` fails with the error: -- Text.Printf.Error (InvalidType "%s: %u + %" 'a' " ≡ %u") should be -- a function type, but it isn't -- when checking that "example" 3 2 5 are valid arguments to a -- function of type Text.Printf.Printf (lexer "%s: %u + %a ≡ %u") agda-stdlib-1.7.3/README/Text/Regex.agda000066400000000000000000000124711451211343400174510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of regular expressions and matching ------------------------------------------------------------------------ {-# OPTIONS --with-K #-} module README.Text.Regex where open import Data.Bool using (true; false) open import Data.List using (_∷_; []) open import Data.String open import Function.Base using () renaming (_$′_ to _$_) open import Relation.Nullary using (yes) open import Relation.Nullary.Decidable using (True; False; from-yes) -- Our library available via the Text.Regex module is safe but it works on -- lists of characters. -- To use it on strings we have to rely on unsafe theorems about the -- conversions between strings and lists of characters being inverses. -- For convenience we use the following unsafe module for this README. open import Text.Regex.String.Unsafe ------------------------------------------------------------------------ -- Defining regular expressions -- The type of regular expressions is Exp. -- Some examples of regular expressions using: -- [_] for the union of ranges it contains -- _─_ for a range -- singleton for an exact character -- _∙_ for the concatenation of two regular expressions -- _∣_ for the sum of two regular expressions -- _⋆ for the Kleene star (zero or more matches of the regular expression) -- _⁇ for an optional regular expression ℕ* : Exp ℕ* = [ '1' ─ '9' ∷ [] ] -- a non-zero digit ∙ [ '0' ─ '9' ∷ [] ] ⋆ -- followed by zero or more digits ℕ : Exp ℕ = ℕ* ∣ singleton '0' -- ℕ* or exactly 0 ℤ : Exp ℤ = ((singleton '-') ⁇ ∙ ℕ*) -- an optional minus sign followed by a ℕ* ∣ singleton '0' -- or exactly 0 ------------------------------------------------------------------------ -- An expression's semantics -- The semantics of these regular expression is defined in terms of the -- lists of characters they match. The type (str ∈ e) states that the -- string str matches the expression e. -- It is decidable, and the proof is called _∈?_. -- We can run it on a few examples to check that it matches our intuition: -- Valid: starts with a non-zero digit, followed by 3 digits _ : True ("1848" ∈? ℕ*) _ = _ -- Valid: exactly 0 _ : True ("0" ∈? ℕ) _ = _ -- Invalid: starts with a leading 0 _ : False ("007" ∈? ℕ) _ = _ -- Invalid: no negative ℕ number _ : False ("-666" ∈? ℕ) _ = _ -- Valid: a negative integer _ : True ("-666" ∈? ℤ) _ = _ -- Invalid: no negative 0 _ : False ("-0" ∈? ℤ) _ = _ ------------------------------------------------------------------------ -- Matching algorithms -- The proof that _∈_ is decidable gives us the ability to check whether -- a whole string matches a regular expression. But we may want to use -- other matching algorithms detecting a prefix, infix, or suffix of the -- input string that matches the regular expression. -- This is what the Regex type gives us. -- For instance, the following value corresponds to finding an infix -- substring matching the string "agda" or "agdai" agda : Exp agda = singleton 'a' ∙ singleton 'g' ∙ singleton 'd' ∙ singleton 'a' ∙ (singleton 'i' ⁇) infixAgda : Regex infixAgda = record { fromStart = false ; tillEnd = false ; expression = agda } -- The search function gives us the ability to look for matches -- Valid: agda in the middle _ : True (search "Maria Magdalena" infixAgda) _ = _ -- By changing the value of fromStart and tillEnd we can control where the -- substring should be. We can insist on the match being at the end of the -- input for instance: suffixAgda : Regex suffixAgda = record { fromStart = false ; tillEnd = true ; expression = agda } -- Invalid: agda is in the middle _ : False (search "Maria Magdalena" suffixAgda) _ = _ -- Valid: agda as a suffix _ : True (search "README.agda" suffixAgda) _ = _ -- Valid: agdai as a suffix _ : True (search "README.agdai" suffixAgda) _ = _ ------------------------------------------------------------------------ -- Advanced uses -- Search does not just return a boolean, it returns an informative answer. -- Infix matches are for instance represented using the `Infix` relation on -- list. Such a proof pinpoints the exact position of the match: open import Data.List.Relation.Binary.Infix.Heterogeneous open import Data.List.Relation.Binary.Infix.Heterogeneous.Properties open import Data.List.Relation.Binary.Pointwise using (≡⇒Pointwise-≡) open import Relation.Binary.PropositionalEquality -- Here is an example of a match: it gives back the substring, the inductive -- proof that it is accepted by the regular expression and its precise location -- inside the input string mariamAGDAlena : Match "Maria Magdalena" infixAgda mariamAGDAlena = record { string = "agda" -- we have found "agda" ; match = from-yes ("agda" ∈? agda) -- a proof of the match ; related = proof -- and its location } where proof : Infix _≡_ (toList "agda") (toList "Maria Magdalena") proof = toList "Maria M" ++ⁱ fromPointwise (≡⇒Pointwise-≡ refl) ⁱ++ toList "lena" -- And here is the proof that search returns such an object _ : search "Maria Magdalena" infixAgda ≡ yes mariamAGDAlena _ = refl agda-stdlib-1.7.3/README/Text/Tabular.agda000066400000000000000000000150741451211343400177730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Examples of printing list and vec-based tables ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible #-} module README.Text.Tabular where open import Function.Base open import Relation.Binary.PropositionalEquality open import Data.List.Base open import Data.String.Base open import Data.Vec.Base open import Text.Tabular.Base import Text.Tabular.List as Tabularˡ import Text.Tabular.Vec as Tabularᵛ ------------------------------------------------------------------------ -- VEC -- -- If you have a matrix of strings, you simply need to: -- * pick a configuration (see below) -- * pick an alignment for each column -- * pass the matrix -- -- The display function will then pad each string on the left, right, -- or both to respect the alignment constraints. -- It will return a list of strings corresponding to each line in the -- table. You may then: --- * use Data.String.Base's unlines to produce a String -- * use Text.Pretty's text and vcat to produce a Doc (i.e. indentable!) ------------------------------------------------------------------------ _ : unlines (Tabularᵛ.display unicode (Right ∷ Left ∷ Center ∷ []) ( ("foo" ∷ "bar" ∷ "baz" ∷ []) ∷ ("1" ∷ "2" ∷ "3" ∷ []) ∷ ("6" ∷ "5" ∷ "4" ∷ []) ∷ [])) ≡ "┌───┬───┬───┐ \ \│foo│bar│baz│ \ \├───┼───┼───┤ \ \│ 1│2 │ 3 │ \ \├───┼───┼───┤ \ \│ 6│5 │ 4 │ \ \└───┴───┴───┘" _ = refl ------------------------------------------------------------------------ -- CONFIG -- -- Configurations allow you to change the way the table is displayed. ------------------------------------------------------------------------ -- We will use the same example throughout foobar : Vec (Vec String 2) 3 foobar = ("foo" ∷ "bar" ∷ []) ∷ ("1" ∷ "2" ∷ []) ∷ ("4" ∷ "3" ∷ []) ∷ [] ------------------------------------------------------------------------ -- Basic configurations: unicode, ascii, whitespace -- unicode _ : unlines (Tabularᵛ.display unicode (Right ∷ Left ∷ []) foobar) ≡ "┌───┬───┐ \ \│foo│bar│ \ \├───┼───┤ \ \│ 1│2 │ \ \├───┼───┤ \ \│ 4│3 │ \ \└───┴───┘" _ = refl -- ascii _ : unlines (Tabularᵛ.display ascii (Right ∷ Left ∷ []) foobar) ≡ "+-------+ \ \|foo|bar| \ \|---+---| \ \| 1|2 | \ \|---+---| \ \| 4|3 | \ \+-------+" _ = refl -- whitespace _ : unlines (Tabularᵛ.display whitespace (Right ∷ Left ∷ []) foobar) ≡ "foo bar \ \ 1 2 \ \ 4 3 " _ = refl ------------------------------------------------------------------------ -- Modifiers: altering existing configurations -- In these examples we will be using unicode as the base configuration. -- However these modifiers apply to all configurations (and can even be -- combined) -- compact: drop the horizontal line between each row _ : unlines (Tabularᵛ.display (compact unicode) (Right ∷ Left ∷ []) foobar) ≡ "┌───┬───┐ \ \│foo│bar│ \ \│ 1│2 │ \ \│ 4│3 │ \ \└───┴───┘" _ = refl -- noBorder: drop the outside borders _ : unlines (Tabularᵛ.display (noBorder unicode) (Right ∷ Left ∷ []) foobar) ≡ "foo│bar \ \───┼─── \ \ 1│2 \ \───┼─── \ \ 4│3 " _ = refl -- addSpace : add whitespace space inside cells _ : unlines (Tabularᵛ.display (addSpace unicode) (Right ∷ Left ∷ []) foobar) ≡ "┌─────┬─────┐ \ \│ foo │ bar │ \ \├─────┼─────┤ \ \│ 1 │ 2 │ \ \├─────┼─────┤ \ \│ 4 │ 3 │ \ \└─────┴─────┘" _ = refl -- compact together with addSpace _ : unlines (Tabularᵛ.display (compact (addSpace unicode)) (Right ∷ Left ∷ []) foobar) ≡ "┌─────┬─────┐ \ \│ foo │ bar │ \ \│ 1 │ 2 │ \ \│ 4 │ 3 │ \ \└─────┴─────┘" _ = refl ------------------------------------------------------------------------ -- LIST -- -- Same thing as for vectors except that if the list of lists is not -- rectangular, it is padded with empty strings to make it so. If there -- are not enough alignment directives, we arbitrarily pick Left. ------------------------------------------------------------------------ _ : unlines (Tabularˡ.display unicode (Center ∷ Right ∷ []) ( ("foo" ∷ "bar" ∷ []) ∷ ("partial" ∷ "rows" ∷ "are" ∷ "ok" ∷ []) ∷ ("3" ∷ "2" ∷ "1" ∷ "..." ∷ "surprise!" ∷ []) ∷ [])) ≡ "┌───────┬────┬───┬───┬─────────┐ \ \│ foo │ bar│ │ │ │ \ \├───────┼────┼───┼───┼─────────┤ \ \│partial│rows│are│ok │ │ \ \├───────┼────┼───┼───┼─────────┤ \ \│ 3 │ 2│1 │...│surprise!│ \ \└───────┴────┴───┴───┴─────────┘" _ = refl ------------------------------------------------------------------------ -- LIST (UNSAFE) -- -- If you know *for sure* that your data is already perfectly rectangular -- i.e. all the rows of the list of lists have the same length -- in each column, all the strings have the same width -- then you can use the unsafeDisplay function defined Text.Tabular.Base. -- -- This is what gets used internally by `Text.Tabular.Vec` and -- `Text.Tabular.List` once the potentially unsafe data has been -- processed. ------------------------------------------------------------------------ _ : unlines (unsafeDisplay (compact unicode) ( ("foo" ∷ "bar" ∷ []) ∷ (" 1" ∷ " 2" ∷ []) ∷ (" 4" ∷ " 3" ∷ []) ∷ [])) ≡ "┌───┬───┐ \ \│foo│bar│ \ \│ 1│ 2│ \ \│ 4│ 3│ \ \└───┴───┘" _ = refl agda-stdlib-1.7.3/Setup.hs000066400000000000000000000000571451211343400153310ustar00rootroot00000000000000import Distribution.Simple main = defaultMain agda-stdlib-1.7.3/agda-stdlib-utils.cabal000066400000000000000000000022761451211343400201770ustar00rootroot00000000000000name: agda-stdlib-utils version: 1.7.3 cabal-version: >= 1.10 build-type: Simple description: Helper programs. license: MIT tested-with: GHC == 8.0.2 GHC == 8.2.2 GHC == 8.4.4 GHC == 8.6.5 GHC == 8.8.4 GHC == 8.10.7 GHC == 9.0.2 GHC == 9.2.8 GHC == 9.4.7 GHC == 9.6.3 GHC == 9.8.1 executable GenerateEverything hs-source-dirs: . main-is: GenerateEverything.hs default-language: Haskell2010 default-extensions: PatternGuards, PatternSynonyms build-depends: base >= 4.9.0.0 && < 4.20 , directory >= 1.0.0.0 && < 1.4 , filemanip >= 0.3.6.2 && < 0.4 , filepath >= 1.4.1.0 && < 1.5 , mtl >= 2.2.2 && < 2.4 executable AllNonAsciiChars hs-source-dirs: . main-is: AllNonAsciiChars.hs default-language: Haskell2010 build-depends: base >= 4.9.0.0 && < 4.20 , filemanip >= 0.3.6.2 && < 0.4 , text >= 1.2.3.0 && < 2.2 agda-stdlib-1.7.3/fix-whitespace.yaml000066400000000000000000000002361451211343400175000ustar00rootroot00000000000000included-dirs: - src - README included-files: - "*.agda" - "*.md" - ".travis.yml" excluded-files: - "README/Text/Tabular.agda" - CHANGELOG.md agda-stdlib-1.7.3/graph.sh000077500000000000000000000017441451211343400153410ustar00rootroot00000000000000#!/bin/sh ### You can call this script like so to generate a dependency graph ### of the `Data.List.Base` module: ### ./graph.sh src/Data/List/Base.agda ### Allow users to pick the agda executable they want by prefixing ### the call with `AGDA=agda-X.Y.Z` and default to agda in case ### nothing was picked AGDA=${AGDA:-"agda"} ### Grab the directory and name of the target agda file DIR=$(dirname $1) BASE=$(basename $1 ".agda") FILE=_build/${DIR}/${BASE} ### Prepare the directory for the dot & tmp files mkdir -p _build/$DIR ### Generate the dot file for the target agda file ${AGDA} -i. -isrc/ --dependency-graph=${FILE}.dot $1 ### Trim the graph to remove transitive dependencies. Without that the ### graphs get too big too quickly and are impossible to render tred ${FILE}.dot > ${FILE}2.dot mv ${FILE}2.dot ${FILE}.dot ### Generate an svg representation of the graph dot -Tsvg ${FILE}.dot > ${FILE}.svg ### Add a symlink to it in the base directory ln -is ${FILE}.svg ${BASE}.svg agda-stdlib-1.7.3/notes/000077500000000000000000000000001451211343400150235ustar00rootroot00000000000000agda-stdlib-1.7.3/notes/installation-guide.md000066400000000000000000000034071451211343400211450ustar00rootroot00000000000000Installation instructions ========================= Use version v1.7.3 of the standard library with Agda 2.6.3 or 2.6.4. 1. Navigate to a suitable directory `$HERE` (replace appropriately) where you would like to install the library. 2. Download the tarball of v1.7.3 of the standard library. This can either be done manually by visiting the Github repository for the library, or via the command line as follows: ``` wget -O agda-stdlib.tar https://github.com/agda/agda-stdlib/archive/v1.7.3.tar.gz ``` Note that you can replace `wget` with other popular tools such as `curl` and that you can replace `1.7.3` with any other version of the library you desire. 3. Extract the standard library from the tarball. Again this can either be done manually or via the command line as follows: ``` tar -zxvf agda-stdlib.tar ``` 4. [ OPTIONAL ] If using [cabal](https://www.haskell.org/cabal/) then run the commands to install via cabal: ``` cd agda-stdlib-1.7.3 cabal install ``` 5. Register the standard library with Agda's package system by adding the following line to `$HOME/.agda/libraries`: ``` $HERE/agda-stdlib-1.7.3/standard-library.agda-lib ``` Now, the standard library is ready to be used either: - in your project `$PROJECT`, by creating a file `$PROJECT.agda-lib` in the project's root containing: ``` depend: standard-library include: $DIRS ``` where `$DIRS` is a list of directories where Agda searches for modules, for instance `.` (just the project's root). - in all your projects, by adding the following line to `$HOME/.agda/defaults` ``` standard-library ``` Find the [full story at readthedocs](http://agda.readthedocs.io/en/latest/tools/package-system.html) about installing Agda libraries. agda-stdlib-1.7.3/notes/release-guide.txt000066400000000000000000000046411451211343400203040ustar00rootroot00000000000000When releasing a new version of Agda standard library, the following procedure should be followed: #### Pre-release changes * Update `README.agda` by replacing 'development version' by 'version X.Y' in the title. * Update `README.md` * Update `agda-stdlib-utils.cabal` version to `X.Y`. * Update the version in standard-library.agda-lib to `X.Y` * Update `notes/installation-guide.txt` * Update `CHANGELOG.md`. * Update the copyright year range in the LICENSE file, if necessary. #### Pre-release tests * Ensure that the library type-checks using Agda A.B.C: make test * Update submodule commit in the Agda repository: cd agda make fast-forward-std-lib * Build the latest version of Agda make quicker-install-bin * Run the tests involving the library: make test-using-std-lib * Commit the changes and push #### Release * Tag version X.Y (do not forget to record the changes above first): VERSION=X.Y git tag -a v$VERSION -m "Agda standard library version $VERSION" * Push all the changes and the new tag (requires Git >= 1.8.3): git push --follow-tags * Make a new release on Github at https://github.com/agda/agda-stdlib/releases * Submit a pull request to update the version of standard library on Homebrew (https://github.com/Homebrew/homebrew-core/blob/master/Formula/agda.rb) * Update the Agda wiki: ** The standard library page. ** News section on the main page. * Announce the release of the new version on the Agda mailing lists (users and developers). * Add v$VERSION to the list of protected directories in the .travis.yml file of BOTH master and experimental. They should look something like: > git checkout HEAD -- v0.16/ v0.17/ v1.0/ v1.1/ (...) Commit & push these changes. This will prevent the next step from being overwritten by travis. * Generate and upload documentation for the released version: cp travis/* . runhaskell GenerateEverything.hs ./index.sh agda -i. -isrc --html index.agda mv html v$VERSION git checkout gh-pages git add v$VERSION/*.html v$VERSION/*.css git commit -m "[ release ] doc for version $VERSION" git push After that you can cleanup the generated files and copies of things taken from travis/ from your agda-stdlib directory. #### Post-release * Move the CHANGELOG.md into the old CHANGELOG folders * Create new CHANGELOG.md file * Revert changes in README.md to reference development version agda-stdlib-1.7.3/notes/style-guide.md000066400000000000000000000351561451211343400176120ustar00rootroot00000000000000Style guide for the standard library ==================================== This is very much a work-in-progress and is not exhaustive. Furthermore many of these are aspirations, and may be violated in certain parts of the library. It is hoped that at some point a linter will be developed for Agda which will automate most of this. ## File structure * The standard library uses a standard line length of 72 characters. Please try to stay within this limit. Having said that this is the most violated rule in the style-guide and it is recognised that it is not always possible to achieve whilst using meaningful names. #### Indentation * The contents of a top-level module should have zero indentation. * Every subsequent nested scope should then be indented by an additional two spaces. * `where` blocks should be indented by two spaces and their contents should be aligned with the `where`. * If the type of a term does not fit on one line then the subsequent lines of the type should all be aligned with the first character of the first line of type, e.g. ```agda map-cong₂ : ∀ {a b} {A : Set a} {B : Set b} → ∀ {f g : A → B} {xs} → All (λ x → f x ≡ g x) xs → map f xs ≡ map g xs ``` * As can be seen in the example above, function arrows at line breaks should always go at the end of the line rather than the beginning of the next line. #### Empty lines * All module headers and standard term definitions should have a single empty line after them. * There should be _two_ empty lines between adjacent record or module definitions in order to better distinguish the end of the record or module, as they will already be using single empty lines between internal definitions. * For example: ```agda module Test1 where def1 : ... def1 = ... def2 : ... def2 = ... module Test2 where record Record1 : Set where field field1 : ... aux1 : ... aux1 = ... aux2 : ... aux2 = ... record Record2 : Set where field field2 : ... record1 : Record1 record1 = { field1 = ... } record2 : Record2 record2 = { field2 = ... } ``` #### Modules * As a rule of thumb there should only be one named module per file. Anonymous modules are fine, but named internal modules should either be opened publicly immediately or split out into a separate file. * Module parameters should be put on a single line if they fit. * Otherwise they should be spread out over multiple lines, each indented by two spaces. If they can be grouped logically by line then it is fine to do so, otherwise, a line each is probably clearest. The `where` keyword should be placed on an additional line of code at the end. For example: ```agda module Relation.Binary.Reasoning.Base.Single {a ℓ} {A : Set a} (_∼_ : Rel A ℓ) (refl : Reflexive _∼_) (trans : Transitive _∼_) where ``` * There should always be a single blank line after a module declaration. #### Imports * All imports should be placed in a list at the top of the file immediately after the module declaration. * The list of imports should be declared in alphabetical order. * If the module takes parameters that require imports from other files, then those imports only may be placed above the module declaration, e.g. ```agda open import Algebra using (Ring) module Algebra.Properties.Ring {a l} (ring : Ring a l) where ... other imports ``` * If it is important that certain names only come into scope later in the file then the module should still be imported at the top of the file but it can be given a shorter name using the keyword `as` and then opened later on in the file when needed, e.g. ```agda import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality ... ... open SetoidEquality S ``` * When using only a few items (i.e. < 5) from a module, it is a good practice to enumerate the items that will be used by declaring the import statement with the directive `using`. This makes the dependencies clearer, e.g. ```agda open import Data.Nat.Properties using (+-assoc) ``` * Re-exporting terms from a module using the `public` modifier should *not* be done in the list of imports as it is very hard to spot. Instead the best approach is often to rename the import and then open it publicly later in the file in a more obvious fashion, e.g. ```agda -- Import list ... import Data.Nat.Properties as NatProperties ... -- Re-export ring open NatProperties public using (+-*-ring) ``` * If multiple import modifiers are used, then they should occur in the following order: `public`, `using` `renaming`, and if `public` is used then the `using` and `renaming` modifiers should occur on a separate line. For example: ```agda open Monoid monoid public using (ε) renaming (_∙_ to _+_) ``` #### Layout of data declarations * The `:` for each constructor should be aligned. #### Layout of record declarations * The `:` for each field should be aligned. * If defining multiple records back to back then there should be a double empty line between each record. #### Layout of record instances * The `record` keyword should go on the same line as the rest of the proof. * The next line with the first record item should start with a single `{`. * Every subsequent item of the record should go on its own line starting with a `;`. * The final line should end with `}` on its own. * The `=` signs for each field should be aligned. * For example: ```agda ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPreorder = record { isEquivalence = isEquivalence ; reflexive = ≤-reflexive ; trans = ≤-trans } ``` #### Layout of `where` blocks * `where` blocks are preferred rather than the `let` construction. * The `where` keyword should be placed on the line below the main proof, indented by two spaces. * If the content of the block is non-trivial then types should be provided alongside the terms, and all terms should be on lines after the `where`, e.g. ```agda statement : Statement statement = proof where proof : Proof proof = some-very-long-proof ``` * If the content of the block is trivial or is an `open` statement then it can be provided on the same line as the `where` and a type can be omitted, e.g. ```agda statement : Statement statement = proof where proof = x ``` #### Layout of equational reasoning * The `begin` clause should go on the same line as the rest of the proof. * Every subsequent combinator `_≡⟨_⟩_` should be placed on an additional line of code, indented by two spaces. * The relation sign (e.g. `≡`) for each line should be aligned if possible. * For example: ```agda +-comm : Commutative _+_ +-comm zero n = sym (+-identityʳ n) +-comm (suc m) n = begin suc m + n ≡⟨⟩ suc (m + n) ≡⟨ cong suc (+-comm m n) ⟩ suc (n + m) ≡⟨ sym (+-suc n m) ⟩ n + suc m ∎ ``` * When multiple reasoning frameworks need to be used in the same file, the `open` statement should always come in a where clause local to the definition. This way users can easily see which reasoning toolkit is being used. For instance: ```agda foo m n p = begin (...) ∎ where open ≤-Reasoning ``` #### Mutual and private blocks * Non-trivial proofs in `private` blocks are generally discouraged. If it is non-trivial, then chances are that someone will want to reuse it at some point! * Instead private blocks should only be used to prevent temporary terms and records that are defined for convenience from being exported by the module. * The mutual block is considered obselete. Please use the standard approach of placing the type signatures of the mutually recursive functions before their definitions. #### Function arguments * Function arguments should be aligned between cases where possible, e.g. ```agda +-comm : Commutative _+_ +-comm zero n = ... +-comm (suc m) n = ... ``` * If an argument is unused in a case, it may at the author's discretion be replaced by an underscore, e.g. ```agda +-assoc : Associative _+_ +-assoc zero _ _ = refl +-assoc (suc m) n o = cong suc (+-assoc m n o) ``` * If it is necessary to refer to an implicit argument in one case then the implicit argument brackets must be included in every other case as well, e.g. ```agda m≤n⇒m∸n≡0 : ∀ {m n} → m ≤ n → m ∸ n ≡ 0 m≤n⇒m∸n≡0 {n = n} z≤n = 0∸n≡0 n m≤n⇒m∸n≡0 {n = _} (s≤s m≤n) = m≤n⇒m∸n≡0 m≤n ``` * As of Agda 2.6.0 dot patterns are no longer necessary when unifying function arguments and therefore should not be prepended to function arguments. #### Comments * Comments should be placed above a term rather than on the same line, e.g. ```agda -- Multiplication of two elements _*_ : A → A → A _*_ = ... ``` rather than: ```agda _*_ : A → A → A -- Multiplication of two elements _*_ = ... ``` * Files can be seperated into different logical parts using comments of the following style where the header is 72 characters wide: ```agda ------------------------------------------------------------------------ -- TITLE ``` #### Other * The `with` syntax is preferred over the use of `case` from the `Function` module. ## Types #### Implicit and explicit arguments * Function arguments should be implicit if they can "almost always" be inferred. If there are common cases where they cannot be inferred then they should be left explicit. * If there are lots of implicit arguments that are common to a collection of proofs they should be extracted by using an anonymous module. #### Variables * `Level` and `Set`s can always be generalized using the keyword `variable`. * A file may only declare variables of other types if those types are used in the definition of the main type that the file concerns itself with. At the moment the policy is *not* to generalize over any other types to minimize the amount of information that users have to keep in their head concurrently. * Example 1: the main type in `Data.List.Properties` is `List A` where `A : Set a`. Therefore it may declare variables over `Level`, `Set a`, `A`, `List A`. It may not declare variables, for example, over predicates (e.g. `P : Pred A p`) as predicates are not used in the definition of `List`, even though they are used in may list functions such as `filter`. * Example 2: the main type in `Data.List.Relation.Unary.All` is `All P xs` where `A : Set a`, `P : Pred A p`, `xs : List A`. It therefore may declare variables over `Level`, `Set a`, `A`, `List A`, `Pred A p`. It may not declare, for example, variables of type `Rel` or `Vec`. ## Naming conventions * Names should be descriptive - i.e. given the name of a proof and the module it lives in, then users should be able to make a reasonable guess at its meaning. * Terms from other modules should only be renamed to avoid name clashes, otherwise, all names should be used as defined. * Datatype names should be capitalized, being its first letter in uppercase and the remaining letters in lowercase. * Function names should follow the camelCase naming convention, in which each word within a compound word is capitalized except for the first word. #### Variables * Sets are named `A`, `B`, `C` etc. * Predicates are named `P`, `Q`, `R` etc. * Relations are named either `R`, `S`, `T` in the general case or `_≈_`/`_∼_`/`_≤_`/`_<_` if they are known to be an equivalence/preorder/partial order/strict partial order. * Level variables are typically chosen to match the name of the relation, e.g. `a` for the level of a set `A`, `p` for a predicate `P`. By convention the name `0ℓ` is preferred over `zero` for the zeroth level. * Natural variables are named `m`, `n`, `o`, ... (default `n`) * Integer variables are named `i`, `j`, `k`, ... (default `i`) * Rational variables are named `p`, `q`, `r`, ... (default `p`) * All other variables tend to be named `x`, `y`, `z`. * Collections of elements are usually indicated by appending an `s` (e.g. if you are naming your variables `x` and `y` then lists should be named `xs` and `ys`). #### Preconditions and postconditions * Preconditions should only be included in names of results if "important" (mostly a judgment call). * Preconditions of results should be prepended to a description of the result by using the symbol `⇒` in names (e.g. `asym⇒antisym`) * Preconditions and postconditions should be combined using the symbols `∨` and `∧` (e.g. `m*n≡0⇒m≡0∨n≡0`) * Try to avoid the need for bracketing, but if necessary use square brackets (e.g. `[m∸n]⊓[n∸m]≡0`) * When naming proofs, the variables should occur in alphabetical order, e.g. `m≤n+m` rather than `n≤m+n`. #### Operators and relations * Concrete operators and relations should be defined using [mixfix](https://agda.readthedocs.io/en/latest/language/mixfix-operators.html) notation where applicable (e.g. `_+_`, `_<_`) * Common properties such as those in rings/orders/equivalences etc. have defined abbreviations (e.g. commutativity is shortened to `comm`). `Data.Nat.Properties` is a good place to look for examples. * Properties should be prefixed by the relevant operator/relation and separated from its name by a hyphen `-` (e.g. commutativity of sum results in a compositional name `+-comm` where `-` acts as a separator). * If the relevant Unicode characters are available, negated forms of relations should be used over the `¬` symbol (e.g. `m+n≮n` should be used instead of `¬m+n P(f)` - `f⁻` is a lemma of the form `P(f) -> Postcondition` The logic behind the name is that `⁺` makes f appear in the conclusion while `⁻` makes it disappear from the hypothesis. For example in `Data.List.Relation.Binary.Pointwise` we have `map⁺` to show how the `map` function may be introduced and `map⁻` to show how it may be eliminated: ```agda map⁺ : Pointwise (λ a b → R (f a) (g b)) as bs → Pointwise R (map f as) (map g bs) map⁻ : Pointwise R (map f as) (map g bs) → Pointwise (λ a b → R (f a) (g b)) as bs ``` #### Keywords * If the name of something clashes with a keyword in Agda, then convention is to place angular brackets around the name, e.g. `⟨set⟩` and `⟨module⟩`. agda-stdlib-1.7.3/notes/updating-experimental.txt000066400000000000000000000006211451211343400220710ustar00rootroot00000000000000The `experimental` branch contains changes that are required for yet unreleased versions of Agda. These are kept separate from `master` so that the standard library releases can occur independently from Agda releases. To update `experimental` to the current version of `master` run the following: ``` git checkout master git pull git checkout experimental git merge master git push ``` agda-stdlib-1.7.3/publish-listings.sh000077500000000000000000000007031451211343400175320ustar00rootroot00000000000000#!/bin/bash cd /tmp git clone git@github.com:agda/agda-stdlib.git cd agda-stdlib git checkout gh-pages git merge master -m "[auto] merge master into gh-pages" make listings if [ "`git status --porcelain`" != "" ]; then echo "Updates:" git status --porcelain changed=`git status --porcelain | cut -c4-` git add --all -- $changed git commit -m "[auto] updated html listings" git push else echo "No changes!" fi cd .. rm -rf agda-stdlib agda-stdlib-1.7.3/src/000077500000000000000000000000001451211343400144625ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra.agda000066400000000000000000000010001451211343400166240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of algebraic structures like monoids and rings -- (packed in records together with sets, operations, etc.) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra where open import Algebra.Core public open import Algebra.Definitions public open import Algebra.Structures public open import Algebra.Bundles public agda-stdlib-1.7.3/src/Algebra/000077500000000000000000000000001451211343400160175ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Bundles.agda000066400000000000000000000611501451211343400202340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of algebraic structures like monoids and rings -- (packed in records together with sets, operations, etc.) ------------------------------------------------------------------------ -- The contents of this module should be accessed via `Algebra`. {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Bundles where open import Algebra.Core open import Algebra.Structures open import Relation.Binary open import Function.Base import Relation.Nullary as N open import Level ------------------------------------------------------------------------ -- Bundles with 1 binary operation ------------------------------------------------------------------------ record RawMagma c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier infix 4 _≉_ _≉_ : Rel Carrier _ x ≉ y = N.¬ (x ≈ y) record Magma c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isMagma : IsMagma _≈_ _∙_ open IsMagma isMagma public rawMagma : RawMagma _ _ rawMagma = record { _≈_ = _≈_; _∙_ = _∙_ } open RawMagma rawMagma public using (_≉_) record SelectiveMagma c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isSelectiveMagma : IsSelectiveMagma _≈_ _∙_ open IsSelectiveMagma isSelectiveMagma public magma : Magma c ℓ magma = record { isMagma = isMagma } open Magma magma public using (rawMagma) record CommutativeMagma c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isCommutativeMagma : IsCommutativeMagma _≈_ _∙_ open IsCommutativeMagma isCommutativeMagma public magma : Magma c ℓ magma = record { isMagma = isMagma } open Magma magma public using (rawMagma) record Semigroup c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isSemigroup : IsSemigroup _≈_ _∙_ open IsSemigroup isSemigroup public magma : Magma c ℓ magma = record { isMagma = isMagma } open Magma magma public using (_≉_; rawMagma) record Band c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isBand : IsBand _≈_ _∙_ open IsBand isBand public semigroup : Semigroup c ℓ semigroup = record { isSemigroup = isSemigroup } open Semigroup semigroup public using (_≉_; magma; rawMagma) record CommutativeSemigroup c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier isCommutativeSemigroup : IsCommutativeSemigroup _≈_ _∙_ open IsCommutativeSemigroup isCommutativeSemigroup public semigroup : Semigroup c ℓ semigroup = record { isSemigroup = isSemigroup } open Semigroup semigroup public using (_≉_; magma; rawMagma) commutativeMagma : CommutativeMagma c ℓ commutativeMagma = record { isCommutativeMagma = isCommutativeMagma } record Semilattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∧_ : Op₂ Carrier isSemilattice : IsSemilattice _≈_ _∧_ open IsSemilattice isSemilattice public band : Band c ℓ band = record { isBand = isBand } open Band band public using (_≉_; rawMagma; magma; semigroup) ------------------------------------------------------------------------ -- Bundles with 1 binary operation & 1 element ------------------------------------------------------------------------ -- A raw monoid is a monoid without any laws. record RawMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier rawMagma : RawMagma c ℓ rawMagma = record { _≈_ = _≈_ ; _∙_ = _∙_ } open RawMagma rawMagma public using (_≉_) record Monoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isMonoid : IsMonoid _≈_ _∙_ ε open IsMonoid isMonoid public semigroup : Semigroup _ _ semigroup = record { isSemigroup = isSemigroup } open Semigroup semigroup public using (_≉_; rawMagma; magma) rawMonoid : RawMonoid _ _ rawMonoid = record { _≈_ = _≈_; _∙_ = _∙_; ε = ε} record CommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isCommutativeMonoid : IsCommutativeMonoid _≈_ _∙_ ε open IsCommutativeMonoid isCommutativeMonoid public monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (_≉_; rawMagma; magma; semigroup; rawMonoid) commutativeSemigroup : CommutativeSemigroup _ _ commutativeSemigroup = record { isCommutativeSemigroup = isCommutativeSemigroup } open CommutativeSemigroup commutativeSemigroup public using (commutativeMagma) record IdempotentCommutativeMonoid c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier isIdempotentCommutativeMonoid : IsIdempotentCommutativeMonoid _≈_ _∙_ ε open IsIdempotentCommutativeMonoid isIdempotentCommutativeMonoid public commutativeMonoid : CommutativeMonoid _ _ commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } open CommutativeMonoid commutativeMonoid public using ( _≉_; rawMagma; magma; commutativeMagma; semigroup; commutativeSemigroup ; rawMonoid; monoid ) -- Idempotent commutative monoids are also known as bounded lattices. -- Note that the BoundedLattice necessarily uses the notation inherited -- from monoids rather than lattices. BoundedLattice = IdempotentCommutativeMonoid module BoundedLattice {c ℓ} (idemCommMonoid : IdempotentCommutativeMonoid c ℓ) = IdempotentCommutativeMonoid idemCommMonoid ------------------------------------------------------------------------ -- Bundles with 1 binary operation, 1 unary operation & 1 element ------------------------------------------------------------------------ record RawGroup c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 _⁻¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier _⁻¹ : Op₁ Carrier rawMonoid : RawMonoid c ℓ rawMonoid = record { _≈_ = _≈_ ; _∙_ = _∙_ ; ε = ε } open RawMonoid rawMonoid public using (_≉_; rawMagma) record Group c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 _⁻¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier _⁻¹ : Op₁ Carrier isGroup : IsGroup _≈_ _∙_ ε _⁻¹ open IsGroup isGroup public rawGroup : RawGroup _ _ rawGroup = record { _≈_ = _≈_; _∙_ = _∙_; ε = ε; _⁻¹ = _⁻¹} monoid : Monoid _ _ monoid = record { isMonoid = isMonoid } open Monoid monoid public using (_≉_; rawMagma; magma; semigroup; rawMonoid) record AbelianGroup c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 _⁻¹ infixl 7 _∙_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∙_ : Op₂ Carrier ε : Carrier _⁻¹ : Op₁ Carrier isAbelianGroup : IsAbelianGroup _≈_ _∙_ ε _⁻¹ open IsAbelianGroup isAbelianGroup public group : Group _ _ group = record { isGroup = isGroup } open Group group public using (_≉_; rawMagma; magma; semigroup; monoid; rawMonoid; rawGroup) commutativeMonoid : CommutativeMonoid _ _ commutativeMonoid = record { isCommutativeMonoid = isCommutativeMonoid } open CommutativeMonoid commutativeMonoid public using (commutativeMagma; commutativeSemigroup) ------------------------------------------------------------------------ -- Bundles with 2 binary operations ------------------------------------------------------------------------ record RawLattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∧_ : Op₂ Carrier _∨_ : Op₂ Carrier ∨-rawMagma : RawMagma c ℓ ∨-rawMagma = record { _≈_ = _≈_; _∙_ = _∨_ } ∧-rawMagma : RawMagma c ℓ ∧-rawMagma = record { _≈_ = _≈_; _∙_ = _∧_ } open RawMagma ∨-rawMagma public using (_≉_) record Lattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier isLattice : IsLattice _≈_ _∨_ _∧_ open IsLattice isLattice public rawLattice : RawLattice c ℓ rawLattice = record { _≈_ = _≈_ ; _∧_ = _∧_ ; _∨_ = _∨_ } open RawLattice rawLattice using (∨-rawMagma; ∧-rawMagma) setoid : Setoid _ _ setoid = record { isEquivalence = isEquivalence } open Setoid setoid public using (_≉_) record DistributiveLattice c ℓ : Set (suc (c ⊔ ℓ)) where infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier isDistributiveLattice : IsDistributiveLattice _≈_ _∨_ _∧_ open IsDistributiveLattice isDistributiveLattice public lattice : Lattice _ _ lattice = record { isLattice = isLattice } open Lattice lattice public using (_≉_; rawLattice; setoid) ------------------------------------------------------------------------ -- Bundles with 2 binary operations & 1 element ------------------------------------------------------------------------ record RawNearSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier +-rawMonoid : RawMonoid c ℓ +-rawMonoid = record { _≈_ = _≈_ ; _∙_ = _+_ ; ε = 0# } open RawMonoid +-rawMonoid public using (_≉_) renaming (rawMagma to +-rawMagma) *-rawMagma : RawMagma c ℓ *-rawMagma = record { _≈_ = _≈_ ; _∙_ = _*_ } record NearSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isNearSemiring : IsNearSemiring _≈_ _+_ _*_ 0# open IsNearSemiring isNearSemiring public rawNearSemiring : RawNearSemiring _ _ rawNearSemiring = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; 0# = 0# } +-monoid : Monoid _ _ +-monoid = record { isMonoid = +-isMonoid } open Monoid +-monoid public using (_≉_) renaming ( rawMagma to +-rawMagma ; magma to +-magma ; semigroup to +-semigroup ; rawMonoid to +-rawMonoid ) *-semigroup : Semigroup _ _ *-semigroup = record { isSemigroup = *-isSemigroup } open Semigroup *-semigroup public using () renaming ( rawMagma to *-rawMagma ; magma to *-magma ) record SemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isSemiringWithoutOne : IsSemiringWithoutOne _≈_ _+_ _*_ 0# open IsSemiringWithoutOne isSemiringWithoutOne public nearSemiring : NearSemiring _ _ nearSemiring = record { isNearSemiring = isNearSemiring } open NearSemiring nearSemiring public using ( _≉_; +-rawMagma; +-magma; +-semigroup ; +-rawMonoid; +-monoid ; *-rawMagma; *-magma; *-semigroup ; rawNearSemiring ) +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } open CommutativeMonoid +-commutativeMonoid public using () renaming ( commutativeMagma to +-commutativeMagma ; commutativeSemigroup to +-commutativeSemigroup ) record CommutativeSemiringWithoutOne c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne _≈_ _+_ _*_ 0# open IsCommutativeSemiringWithoutOne isCommutativeSemiringWithoutOne public semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using ( _≉_; +-rawMagma; +-magma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-semigroup ; +-rawMonoid; +-monoid; +-commutativeMonoid ; nearSemiring; rawNearSemiring ) ------------------------------------------------------------------------ -- Bundles with 2 binary operations & 2 elements ------------------------------------------------------------------------ record RawSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier rawNearSemiring : RawNearSemiring c ℓ rawNearSemiring = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; 0# = 0# } open RawNearSemiring rawNearSemiring public using (_≉_; +-rawMonoid; +-rawMagma; *-rawMagma) *-rawMonoid : RawMonoid c ℓ *-rawMonoid = record { _≈_ = _≈_ ; _∙_ = _*_ ; ε = 1# } record SemiringWithoutAnnihilatingZero c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero _≈_ _+_ _*_ 0# 1# open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public rawSemiring : RawSemiring c ℓ rawSemiring = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; 0# = 0# ; 1# = 1# } open RawSemiring rawSemiring public using (rawNearSemiring) +-commutativeMonoid : CommutativeMonoid _ _ +-commutativeMonoid = record { isCommutativeMonoid = +-isCommutativeMonoid } open CommutativeMonoid +-commutativeMonoid public using (_≉_) renaming ( rawMagma to +-rawMagma ; magma to +-magma ; commutativeMagma to +-commutativeMagma ; semigroup to +-semigroup ; commutativeSemigroup to +-commutativeSemigroup ; rawMonoid to +-rawMonoid ; monoid to +-monoid ) *-monoid : Monoid _ _ *-monoid = record { isMonoid = *-isMonoid } open Monoid *-monoid public using () renaming ( rawMagma to *-rawMagma ; magma to *-magma ; semigroup to *-semigroup ; rawMonoid to *-rawMonoid ) record Semiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isSemiring : IsSemiring _≈_ _+_ _*_ 0# 1# open IsSemiring isSemiring public semiringWithoutAnnihilatingZero : SemiringWithoutAnnihilatingZero _ _ semiringWithoutAnnihilatingZero = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero } open SemiringWithoutAnnihilatingZero semiringWithoutAnnihilatingZero public using ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-semigroup ; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-rawMonoid; *-monoid ; rawNearSemiring ; rawSemiring ) semiringWithoutOne : SemiringWithoutOne _ _ semiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne } open SemiringWithoutOne semiringWithoutOne public using (nearSemiring) record CommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# open IsCommutativeSemiring isCommutativeSemiring public semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-semigroup ; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ; rawSemiring ) *-commutativeMonoid : CommutativeMonoid _ _ *-commutativeMonoid = record { isCommutativeMonoid = *-isCommutativeMonoid } open CommutativeMonoid *-commutativeMonoid public using () renaming ( commutativeMagma to *-commutativeMagma ; commutativeSemigroup to *-commutativeSemigroup ) commutativeSemiringWithoutOne : CommutativeSemiringWithoutOne _ _ commutativeSemiringWithoutOne = record { isCommutativeSemiringWithoutOne = isCommutativeSemiringWithoutOne } record CancellativeCommutativeSemiring c ℓ : Set (suc (c ⊔ ℓ)) where infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier 0# : Carrier 1# : Carrier isCancellativeCommutativeSemiring : IsCancellativeCommutativeSemiring _≈_ _+_ _*_ 0# 1# open IsCancellativeCommutativeSemiring isCancellativeCommutativeSemiring public commutativeSemiring : CommutativeSemiring c ℓ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open CommutativeSemiring commutativeSemiring public using ( +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-commutativeMagma; *-semigroup; *-commutativeSemigroup ; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-rawMonoid; *-monoid; *-commutativeMonoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ; rawSemiring ; semiring ; _≉_ ) ------------------------------------------------------------------------ -- Bundles with 2 binary operations, 1 unary operation & 2 elements ------------------------------------------------------------------------ -- A raw ring is a ring without any laws. record RawRing c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier rawSemiring : RawSemiring c ℓ rawSemiring = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; 0# = 0# ; 1# = 1# } open RawSemiring rawSemiring public using ( _≉_ ; +-rawMagma; +-rawMonoid ; *-rawMagma; *-rawMonoid ) +-rawGroup : RawGroup c ℓ +-rawGroup = record { _≈_ = _≈_ ; _∙_ = _+_ ; ε = 0# ; _⁻¹ = -_ } record Ring c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isRing : IsRing _≈_ _+_ _*_ -_ 0# 1# open IsRing isRing public +-abelianGroup : AbelianGroup _ _ +-abelianGroup = record { isAbelianGroup = +-isAbelianGroup } semiring : Semiring _ _ semiring = record { isSemiring = isSemiring } open Semiring semiring public using ( _≉_; +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-semigroup ; +-rawMonoid; +-monoid ; +-commutativeMonoid ; *-rawMonoid; *-monoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero ) open AbelianGroup +-abelianGroup public using () renaming (group to +-group) rawRing : RawRing _ _ rawRing = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } record CommutativeRing c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isCommutativeRing : IsCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsCommutativeRing isCommutativeRing public ring : Ring _ _ ring = record { isRing = isRing } open Ring ring public using (_≉_; rawRing; +-group; +-abelianGroup) commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open CommutativeSemiring commutativeSemiring public using ( +-rawMagma; +-magma; +-commutativeMagma; +-semigroup; +-commutativeSemigroup ; *-rawMagma; *-magma; *-commutativeMagma; *-semigroup; *-commutativeSemigroup ; +-rawMonoid; +-monoid; +-commutativeMonoid ; *-rawMonoid; *-monoid; *-commutativeMonoid ; nearSemiring; semiringWithoutOne ; semiringWithoutAnnihilatingZero; semiring ; commutativeSemiringWithoutOne ) record BooleanAlgebra c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 ¬_ infixr 7 _∧_ infixr 6 _∨_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _∨_ : Op₂ Carrier _∧_ : Op₂ Carrier ¬_ : Op₁ Carrier ⊤ : Carrier ⊥ : Carrier isBooleanAlgebra : IsBooleanAlgebra _≈_ _∨_ _∧_ ¬_ ⊤ ⊥ open IsBooleanAlgebra isBooleanAlgebra public distributiveLattice : DistributiveLattice _ _ distributiveLattice = record { isDistributiveLattice = isDistributiveLattice } open DistributiveLattice distributiveLattice public using (_≉_; setoid; lattice) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.0 RawSemigroup = RawMagma {-# WARNING_ON_USAGE RawSemigroup "Warning: RawSemigroup was deprecated in v1.0. Please use RawMagma instead." #-} agda-stdlib-1.7.3/src/Algebra/Consequences/000077500000000000000000000000001451211343400204525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Consequences/Base.agda000066400000000000000000000013711451211343400221440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lemmas relating algebraic definitions (such as associativity and -- commutativity) that don't the equality relation to be a setoid. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Consequences.Base {a} {A : Set a} where open import Algebra.Core open import Algebra.Definitions open import Data.Sum.Base open import Relation.Binary.Core sel⇒idem : ∀ {ℓ} {_•_ : Op₂ A} (_≈_ : Rel A ℓ) → Selective _≈_ _•_ → Idempotent _≈_ _•_ sel⇒idem _ sel x with sel x x ... | inj₁ x•x≈x = x•x≈x ... | inj₂ x•x≈x = x•x≈x agda-stdlib-1.7.3/src/Algebra/Consequences/Propositional.agda000066400000000000000000000100671451211343400241360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Relations between properties of functions, such as associativity and -- commutativity (specialised to propositional equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Consequences.Propositional {a} {A : Set a} where open import Data.Sum.Base using (inj₁; inj₂) open import Relation.Binary using (Rel; Setoid; Symmetric; Total) open import Relation.Binary.PropositionalEquality open import Relation.Unary using (Pred) open import Algebra.Core open import Algebra.Definitions {A = A} _≡_ import Algebra.Consequences.Setoid (setoid A) as Base ------------------------------------------------------------------------ -- Re-export all proofs that don't require congruence or substitutivity open Base public hiding ( assoc+distribʳ+idʳ+invʳ⇒zeˡ ; assoc+distribˡ+idʳ+invʳ⇒zeʳ ; assoc+id+invʳ⇒invˡ-unique ; assoc+id+invˡ⇒invʳ-unique ; comm+distrˡ⇒distrʳ ; comm+distrʳ⇒distrˡ ; comm⇒sym[distribˡ] ; subst+comm⇒sym ; wlog ; sel⇒idem ) ------------------------------------------------------------------------ -- Group-like structures module _ {_•_ _⁻¹ ε} where assoc+id+invʳ⇒invˡ-unique : Associative _•_ → Identity ε _•_ → RightInverse ε _⁻¹ _•_ → ∀ x y → (x • y) ≡ ε → x ≡ (y ⁻¹) assoc+id+invʳ⇒invˡ-unique = Base.assoc+id+invʳ⇒invˡ-unique (cong₂ _) assoc+id+invˡ⇒invʳ-unique : Associative _•_ → Identity ε _•_ → LeftInverse ε _⁻¹ _•_ → ∀ x y → (x • y) ≡ ε → y ≡ (x ⁻¹) assoc+id+invˡ⇒invʳ-unique = Base.assoc+id+invˡ⇒invʳ-unique (cong₂ _) ------------------------------------------------------------------------ -- Ring-like structures module _ {_+_ _*_ -_ 0#} where assoc+distribʳ+idʳ+invʳ⇒zeˡ : Associative _+_ → _*_ DistributesOverʳ _+_ → RightIdentity 0# _+_ → RightInverse 0# -_ _+_ → LeftZero 0# _*_ assoc+distribʳ+idʳ+invʳ⇒zeˡ = Base.assoc+distribʳ+idʳ+invʳ⇒zeˡ (cong₂ _+_) (cong₂ _*_) assoc+distribˡ+idʳ+invʳ⇒zeʳ : Associative _+_ → _*_ DistributesOverˡ _+_ → RightIdentity 0# _+_ → RightInverse 0# -_ _+_ → RightZero 0# _*_ assoc+distribˡ+idʳ+invʳ⇒zeʳ = Base.assoc+distribˡ+idʳ+invʳ⇒zeʳ (cong₂ _+_) (cong₂ _*_) ------------------------------------------------------------------------ -- Bisemigroup-like structures module _ {_•_ _◦_ : Op₂ A} (•-comm : Commutative _•_) where comm+distrˡ⇒distrʳ : _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ comm+distrˡ⇒distrʳ = Base.comm+distrˡ⇒distrʳ (cong₂ _) •-comm comm+distrʳ⇒distrˡ : _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ comm+distrʳ⇒distrˡ = Base.comm+distrʳ⇒distrˡ (cong₂ _) •-comm comm⇒sym[distribˡ] : ∀ x → Symmetric (λ y z → (x ◦ (y • z)) ≡ ((x ◦ y) • (x ◦ z))) comm⇒sym[distribˡ] = Base.comm⇒sym[distribˡ] (cong₂ _◦_) •-comm ------------------------------------------------------------------------ -- Selectivity module _ {_•_ : Op₂ A} where sel⇒idem : Selective _•_ → Idempotent _•_ sel⇒idem = Base.sel⇒idem _≡_ ------------------------------------------------------------------------ -- Without Loss of Generality module _ {p} {P : Pred A p} where subst+comm⇒sym : ∀ {f} (f-comm : Commutative f) → Symmetric (λ a b → P (f a b)) subst+comm⇒sym = Base.subst+comm⇒sym {P = P} subst wlog : ∀ {f} (f-comm : Commutative f) → ∀ {r} {_R_ : Rel _ r} → Total _R_ → (∀ a b → a R b → P (f a b)) → ∀ a b → P (f a b) wlog = Base.wlog {P = P} subst agda-stdlib-1.7.3/src/Algebra/Consequences/Setoid.agda000066400000000000000000000214331451211343400225220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Relations between properties of functions, such as associativity and -- commutativity, when the underlying relation is a setoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; Substitutive; Symmetric; Total) module Algebra.Consequences.Setoid {a ℓ} (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open import Algebra.Core open import Algebra.Definitions _≈_ open import Data.Sum.Base using (inj₁; inj₂) open import Data.Product using (_,_) open import Function.Base using (_$_) import Relation.Binary.Consequences as Bin open import Relation.Binary.Reasoning.Setoid S open import Relation.Unary using (Pred) ------------------------------------------------------------------------ -- Re-exports -- Export base lemmas that don't require the setoid open import Algebra.Consequences.Base public ------------------------------------------------------------------------ -- Magma-like structures module _ {_•_ : Op₂ A} (comm : Commutative _•_) where comm+cancelˡ⇒cancelʳ : LeftCancellative _•_ → RightCancellative _•_ comm+cancelˡ⇒cancelʳ cancelˡ {x} y z eq = cancelˡ x $ begin x • y ≈⟨ comm x y ⟩ y • x ≈⟨ eq ⟩ z • x ≈⟨ comm z x ⟩ x • z ∎ comm+cancelʳ⇒cancelˡ : RightCancellative _•_ → LeftCancellative _•_ comm+cancelʳ⇒cancelˡ cancelʳ x {y} {z} eq = cancelʳ y z $ begin y • x ≈⟨ comm y x ⟩ x • y ≈⟨ eq ⟩ x • z ≈⟨ comm x z ⟩ z • x ∎ ------------------------------------------------------------------------ -- Monoid-like structures module _ {_•_ : Op₂ A} (comm : Commutative _•_) {e : A} where comm+idˡ⇒idʳ : LeftIdentity e _•_ → RightIdentity e _•_ comm+idˡ⇒idʳ idˡ x = begin x • e ≈⟨ comm x e ⟩ e • x ≈⟨ idˡ x ⟩ x ∎ comm+idʳ⇒idˡ : RightIdentity e _•_ → LeftIdentity e _•_ comm+idʳ⇒idˡ idʳ x = begin e • x ≈⟨ comm e x ⟩ x • e ≈⟨ idʳ x ⟩ x ∎ comm+zeˡ⇒zeʳ : LeftZero e _•_ → RightZero e _•_ comm+zeˡ⇒zeʳ zeˡ x = begin x • e ≈⟨ comm x e ⟩ e • x ≈⟨ zeˡ x ⟩ e ∎ comm+zeʳ⇒zeˡ : RightZero e _•_ → LeftZero e _•_ comm+zeʳ⇒zeˡ zeʳ x = begin e • x ≈⟨ comm e x ⟩ x • e ≈⟨ zeʳ x ⟩ e ∎ comm+almostCancelˡ⇒almostCancelʳ : AlmostLeftCancellative e _•_ → AlmostRightCancellative e _•_ comm+almostCancelˡ⇒almostCancelʳ cancelˡ-nonZero {x} y z x≉e yx≈zx = cancelˡ-nonZero y z x≉e $ begin x • y ≈⟨ comm x y ⟩ y • x ≈⟨ yx≈zx ⟩ z • x ≈⟨ comm z x ⟩ x • z ∎ comm+almostCancelʳ⇒almostCancelˡ : AlmostRightCancellative e _•_ → AlmostLeftCancellative e _•_ comm+almostCancelʳ⇒almostCancelˡ cancelʳ-nonZero {x} y z x≉e xy≈xz = cancelʳ-nonZero y z x≉e $ begin y • x ≈⟨ comm y x ⟩ x • y ≈⟨ xy≈xz ⟩ x • z ≈⟨ comm x z ⟩ z • x ∎ ------------------------------------------------------------------------ -- Group-like structures module _ {_•_ : Op₂ A} {_⁻¹ : Op₁ A} {e} (comm : Commutative _•_) where comm+invˡ⇒invʳ : LeftInverse e _⁻¹ _•_ → RightInverse e _⁻¹ _•_ comm+invˡ⇒invʳ invˡ x = begin x • (x ⁻¹) ≈⟨ comm x (x ⁻¹) ⟩ (x ⁻¹) • x ≈⟨ invˡ x ⟩ e ∎ comm+invʳ⇒invˡ : RightInverse e _⁻¹ _•_ → LeftInverse e _⁻¹ _•_ comm+invʳ⇒invˡ invʳ x = begin (x ⁻¹) • x ≈⟨ comm (x ⁻¹) x ⟩ x • (x ⁻¹) ≈⟨ invʳ x ⟩ e ∎ module _ {_•_ : Op₂ A} {_⁻¹ : Op₁ A} {e} (cong : Congruent₂ _•_) where assoc+id+invʳ⇒invˡ-unique : Associative _•_ → Identity e _•_ → RightInverse e _⁻¹ _•_ → ∀ x y → (x • y) ≈ e → x ≈ (y ⁻¹) assoc+id+invʳ⇒invˡ-unique assoc (idˡ , idʳ) invʳ x y eq = begin x ≈⟨ sym (idʳ x) ⟩ x • e ≈⟨ cong refl (sym (invʳ y)) ⟩ x • (y • (y ⁻¹)) ≈⟨ sym (assoc x y (y ⁻¹)) ⟩ (x • y) • (y ⁻¹) ≈⟨ cong eq refl ⟩ e • (y ⁻¹) ≈⟨ idˡ (y ⁻¹) ⟩ y ⁻¹ ∎ assoc+id+invˡ⇒invʳ-unique : Associative _•_ → Identity e _•_ → LeftInverse e _⁻¹ _•_ → ∀ x y → (x • y) ≈ e → y ≈ (x ⁻¹) assoc+id+invˡ⇒invʳ-unique assoc (idˡ , idʳ) invˡ x y eq = begin y ≈⟨ sym (idˡ y) ⟩ e • y ≈⟨ cong (sym (invˡ x)) refl ⟩ ((x ⁻¹) • x) • y ≈⟨ assoc (x ⁻¹) x y ⟩ (x ⁻¹) • (x • y) ≈⟨ cong refl eq ⟩ (x ⁻¹) • e ≈⟨ idʳ (x ⁻¹) ⟩ x ⁻¹ ∎ ---------------------------------------------------------------------- -- Bisemigroup-like structures module _ {_•_ _◦_ : Op₂ A} (◦-cong : Congruent₂ _◦_) (•-comm : Commutative _•_) where comm+distrˡ⇒distrʳ : _•_ DistributesOverˡ _◦_ → _•_ DistributesOverʳ _◦_ comm+distrˡ⇒distrʳ distrˡ x y z = begin (y ◦ z) • x ≈⟨ •-comm (y ◦ z) x ⟩ x • (y ◦ z) ≈⟨ distrˡ x y z ⟩ (x • y) ◦ (x • z) ≈⟨ ◦-cong (•-comm x y) (•-comm x z) ⟩ (y • x) ◦ (z • x) ∎ comm+distrʳ⇒distrˡ : _•_ DistributesOverʳ _◦_ → _•_ DistributesOverˡ _◦_ comm+distrʳ⇒distrˡ distrˡ x y z = begin x • (y ◦ z) ≈⟨ •-comm x (y ◦ z) ⟩ (y ◦ z) • x ≈⟨ distrˡ x y z ⟩ (y • x) ◦ (z • x) ≈⟨ ◦-cong (•-comm y x) (•-comm z x) ⟩ (x • y) ◦ (x • z) ∎ comm⇒sym[distribˡ] : ∀ x → Symmetric (λ y z → (x ◦ (y • z)) ≈ ((x ◦ y) • (x ◦ z))) comm⇒sym[distribˡ] x {y} {z} prf = begin x ◦ (z • y) ≈⟨ ◦-cong refl (•-comm z y) ⟩ x ◦ (y • z) ≈⟨ prf ⟩ (x ◦ y) • (x ◦ z) ≈⟨ •-comm (x ◦ y) (x ◦ z) ⟩ (x ◦ z) • (x ◦ y) ∎ ---------------------------------------------------------------------- -- Ring-like structures module _ {_+_ _*_ : Op₂ A} {_⁻¹ : Op₁ A} {0# : A} (+-cong : Congruent₂ _+_) (*-cong : Congruent₂ _*_) where assoc+distribʳ+idʳ+invʳ⇒zeˡ : Associative _+_ → _*_ DistributesOverʳ _+_ → RightIdentity 0# _+_ → RightInverse 0# _⁻¹ _+_ → LeftZero 0# _*_ assoc+distribʳ+idʳ+invʳ⇒zeˡ +-assoc distribʳ idʳ invʳ x = begin 0# * x ≈⟨ sym (idʳ _) ⟩ (0# * x) + 0# ≈⟨ +-cong refl (sym (invʳ _)) ⟩ (0# * x) + ((0# * x) + ((0# * x)⁻¹)) ≈⟨ sym (+-assoc _ _ _) ⟩ ((0# * x) + (0# * x)) + ((0# * x)⁻¹) ≈⟨ +-cong (sym (distribʳ _ _ _)) refl ⟩ ((0# + 0#) * x) + ((0# * x)⁻¹) ≈⟨ +-cong (*-cong (idʳ _) refl) refl ⟩ (0# * x) + ((0# * x)⁻¹) ≈⟨ invʳ _ ⟩ 0# ∎ assoc+distribˡ+idʳ+invʳ⇒zeʳ : Associative _+_ → _*_ DistributesOverˡ _+_ → RightIdentity 0# _+_ → RightInverse 0# _⁻¹ _+_ → RightZero 0# _*_ assoc+distribˡ+idʳ+invʳ⇒zeʳ +-assoc distribˡ idʳ invʳ x = begin x * 0# ≈⟨ sym (idʳ _) ⟩ (x * 0#) + 0# ≈⟨ +-cong refl (sym (invʳ _)) ⟩ (x * 0#) + ((x * 0#) + ((x * 0#)⁻¹)) ≈⟨ sym (+-assoc _ _ _) ⟩ ((x * 0#) + (x * 0#)) + ((x * 0#)⁻¹) ≈⟨ +-cong (sym (distribˡ _ _ _)) refl ⟩ (x * (0# + 0#)) + ((x * 0#)⁻¹) ≈⟨ +-cong (*-cong refl (idʳ _)) refl ⟩ ((x * 0#) + ((x * 0#)⁻¹)) ≈⟨ invʳ _ ⟩ 0# ∎ ------------------------------------------------------------------------ -- Without Loss of Generality module _ {p} {f : Op₂ A} {P : Pred A p} (≈-subst : Substitutive _≈_ p) (comm : Commutative f) where subst+comm⇒sym : Symmetric (λ a b → P (f a b)) subst+comm⇒sym = ≈-subst P (comm _ _) wlog : ∀ {r} {_R_ : Rel _ r} → Total _R_ → (∀ a b → a R b → P (f a b)) → ∀ a b → P (f a b) wlog r-total = Bin.wlog r-total subst+comm⇒sym agda-stdlib-1.7.3/src/Algebra/Construct/000077500000000000000000000000001451211343400200035ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Construct/DirectProduct.agda000066400000000000000000000136251451211343400234030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances of algebraic structures made by taking two other instances -- A and B, and having elements of the new instance be pairs |A| × |B|. -- In mathematics, this would usually be written A × B or A ⊕ B. -- -- From semigroups up, these new instances are products of the relevant -- category. For structures with commutative addition (commutative -- monoids, Abelian groups, semirings, rings), the direct product is -- also the coproduct, making it a biproduct. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Construct.DirectProduct where open import Algebra open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Level using (Level; _⊔_) private variable a b ℓ₁ ℓ₂ : Level ------------------------------------------------------------------------ -- Raw bundles rawMagma : RawMagma a ℓ₁ → RawMagma b ℓ₂ → RawMagma (a ⊔ b) (ℓ₁ ⊔ ℓ₂) rawMagma M N = record { Carrier = M.Carrier × N.Carrier ; _≈_ = Pointwise M._≈_ N._≈_ ; _∙_ = zip M._∙_ N._∙_ } where module M = RawMagma M; module N = RawMagma N rawMonoid : RawMonoid a ℓ₁ → RawMonoid b ℓ₂ → RawMonoid (a ⊔ b) (ℓ₁ ⊔ ℓ₂) rawMonoid M N = record { Carrier = M.Carrier × N.Carrier ; _≈_ = Pointwise M._≈_ N._≈_ ; _∙_ = zip M._∙_ N._∙_ ; ε = M.ε , N.ε } where module M = RawMonoid M; module N = RawMonoid N rawGroup : RawGroup a ℓ₁ → RawGroup b ℓ₂ → RawGroup (a ⊔ b) (ℓ₁ ⊔ ℓ₂) rawGroup G H = record { Carrier = G.Carrier × H.Carrier ; _≈_ = Pointwise G._≈_ H._≈_ ; _∙_ = zip G._∙_ H._∙_ ; ε = G.ε , H.ε ; _⁻¹ = map G._⁻¹ H._⁻¹ } where module G = RawGroup G; module H = RawGroup H ------------------------------------------------------------------------ -- Bundles magma : Magma a ℓ₁ → Magma b ℓ₂ → Magma (a ⊔ b) (ℓ₁ ⊔ ℓ₂) magma M N = record { Carrier = M.Carrier × N.Carrier ; _≈_ = Pointwise M._≈_ N._≈_ ; _∙_ = zip M._∙_ N._∙_ ; isMagma = record { isEquivalence = ×-isEquivalence M.isEquivalence N.isEquivalence ; ∙-cong = zip M.∙-cong N.∙-cong } } where module M = Magma M; module N = Magma N semigroup : Semigroup a ℓ₁ → Semigroup b ℓ₂ → Semigroup (a ⊔ b) (ℓ₁ ⊔ ℓ₂) semigroup G H = record { isSemigroup = record { isMagma = Magma.isMagma (magma G.magma H.magma) ; assoc = λ x y z → (G.assoc , H.assoc) <*> x <*> y <*> z } } where module G = Semigroup G; module H = Semigroup H band : Band a ℓ₁ → Band b ℓ₂ → Band (a ⊔ b) (ℓ₁ ⊔ ℓ₂) band B C = record { isBand = record { isSemigroup = Semigroup.isSemigroup (semigroup B.semigroup C.semigroup) ; idem = λ x → (B.idem , C.idem) <*> x } } where module B = Band B; module C = Band C commutativeSemigroup : CommutativeSemigroup a ℓ₁ → CommutativeSemigroup b ℓ₂ → CommutativeSemigroup (a ⊔ b) (ℓ₁ ⊔ ℓ₂) commutativeSemigroup G H = record { isCommutativeSemigroup = record { isSemigroup = Semigroup.isSemigroup (semigroup G.semigroup H.semigroup) ; comm = λ x y → (G.comm , H.comm) <*> x <*> y } } where module G = CommutativeSemigroup G; module H = CommutativeSemigroup H semilattice : Semilattice a ℓ₁ → Semilattice b ℓ₂ → Semilattice (a ⊔ b) (ℓ₁ ⊔ ℓ₂) semilattice L M = record { isSemilattice = record { isBand = Band.isBand (band L.band M.band) ; comm = λ x y → (L.comm , M.comm) <*> x <*> y } } where module L = Semilattice L; module M = Semilattice M monoid : Monoid a ℓ₁ → Monoid b ℓ₂ → Monoid (a ⊔ b) (ℓ₁ ⊔ ℓ₂) monoid M N = record { ε = M.ε , N.ε ; isMonoid = record { isSemigroup = Semigroup.isSemigroup (semigroup M.semigroup N.semigroup) ; identity = (M.identityˡ , N.identityˡ <*>_) , (M.identityʳ , N.identityʳ <*>_) } } where module M = Monoid M; module N = Monoid N commutativeMonoid : CommutativeMonoid a ℓ₁ → CommutativeMonoid b ℓ₂ → CommutativeMonoid (a ⊔ b) (ℓ₁ ⊔ ℓ₂) commutativeMonoid M N = record { isCommutativeMonoid = record { isMonoid = Monoid.isMonoid (monoid M.monoid N.monoid) ; comm = λ x y → (M.comm , N.comm) <*> x <*> y } } where module M = CommutativeMonoid M; module N = CommutativeMonoid N idempotentCommutativeMonoid : IdempotentCommutativeMonoid a ℓ₁ → IdempotentCommutativeMonoid b ℓ₂ → IdempotentCommutativeMonoid (a ⊔ b) (ℓ₁ ⊔ ℓ₂) idempotentCommutativeMonoid M N = record { isIdempotentCommutativeMonoid = record { isCommutativeMonoid = CommutativeMonoid.isCommutativeMonoid (commutativeMonoid M.commutativeMonoid N.commutativeMonoid) ; idem = λ x → (M.idem , N.idem) <*> x } } where module M = IdempotentCommutativeMonoid M module N = IdempotentCommutativeMonoid N group : Group a ℓ₁ → Group b ℓ₂ → Group (a ⊔ b) (ℓ₁ ⊔ ℓ₂) group G H = record { _⁻¹ = map G._⁻¹ H._⁻¹ ; isGroup = record { isMonoid = Monoid.isMonoid (monoid G.monoid H.monoid) ; inverse = (λ x → (G.inverseˡ , H.inverseˡ) <*> x) , (λ x → (G.inverseʳ , H.inverseʳ) <*> x) ; ⁻¹-cong = map G.⁻¹-cong H.⁻¹-cong } } where module G = Group G; module H = Group H abelianGroup : AbelianGroup a ℓ₁ → AbelianGroup b ℓ₂ → AbelianGroup (a ⊔ b) (ℓ₁ ⊔ ℓ₂) abelianGroup G H = record { isAbelianGroup = record { isGroup = Group.isGroup (group G.group H.group) ; comm = λ x y → (G.comm , H.comm) <*> x <*> y } } where module G = AbelianGroup G; module H = AbelianGroup H agda-stdlib-1.7.3/src/Algebra/Construct/LexProduct.agda000066400000000000000000000077531451211343400227260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of the lexicographic product of two operators. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Bool using (true; false) open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent using (Pointwise) open import Data.Sum.Base using (inj₁; inj₂) open import Function.Base using (_∘_) open import Relation.Binary open import Relation.Nullary using (¬_; does; yes; no) open import Relation.Nullary.Negation using (contradiction; contradiction₂) import Relation.Binary.Reasoning.Setoid as SetoidReasoning module Algebra.Construct.LexProduct {ℓ₁ ℓ₂ ℓ₃ ℓ₄} (M : Magma ℓ₁ ℓ₂) (N : Magma ℓ₃ ℓ₄) (_≟₁_ : Decidable (Magma._≈_ M)) where open Magma M using (_∙_ ; ∙-cong) renaming ( Carrier to A ; _≈_ to _≈₁_ ; _≉_ to _≉₁_ ) open Magma N using () renaming ( Carrier to B ; _∙_ to _◦_ ; _≈_ to _≈₂_ ; refl to ≈₂-refl ) import Algebra.Construct.LexProduct.Inner M N _≟₁_ as InnerLex private infix 4 _≋_ _≋_ : Rel (A × B) _ _≋_ = Pointwise _≈₁_ _≈₂_ variable a b : A ------------------------------------------------------------------------ -- Definition ------------------------------------------------------------------------ open import Algebra.Construct.LexProduct.Base _∙_ _◦_ _≟₁_ public renaming (lex to _⊕_) ------------------------------------------------------------------------ -- Properties ------------------------------------------------------------------------ -- Basic cases case₁ : ∀ {a b} → (a ∙ b) ≈₁ a → (a ∙ b) ≉₁ b → ∀ x y → (a , x) ⊕ (b , y) ≋ (a , x) case₁ ab≈a ab≉b _ _ = ab≈a , InnerLex.case₁ ab≈a ab≉b case₂ : ∀ {a b} → (a ∙ b) ≉₁ a → (a ∙ b) ≈₁ b → ∀ x y → (a , x) ⊕ (b , y) ≋ (b , y) case₂ ab≉a ab≈b _ _ = ab≈b , InnerLex.case₂ ab≉a ab≈b case₃ : ∀ {a b} → (a ∙ b) ≈₁ a → (a ∙ b) ≈₁ b → ∀ x y → (a , x) ⊕ (b , y) ≋ (a , x ◦ y) case₃ ab≈a ab≈b _ _ = ab≈a , InnerLex.case₃ ab≈a ab≈b ------------------------------------------------------------------------ -- Algebraic properties cong : Congruent₂ _≋_ _⊕_ cong (a≈b , w≈x) (c≈d , y≈z) = ∙-cong a≈b c≈d , InnerLex.cong a≈b c≈d w≈x y≈z assoc : Associative _≈₁_ _∙_ → Commutative _≈₁_ _∙_ → Selective _≈₁_ _∙_ → Associative _≈₂_ _◦_ → Associative _≋_ _⊕_ assoc ∙-assoc ∙-comm ∙-sel ◦-assoc (a , x) (b , y) (c , z) = ∙-assoc a b c , InnerLex.assoc ∙-assoc ∙-comm ∙-sel ◦-assoc a b c x y z comm : Commutative _≈₁_ _∙_ → Commutative _≈₂_ _◦_ → Commutative _≋_ _⊕_ comm ∙-comm ◦-comm (a , x) (b , y) = ∙-comm a b , InnerLex.comm ∙-comm ◦-comm a b x y zeroʳ : ∀ {e f} → RightZero _≈₁_ e _∙_ → RightZero _≈₂_ f _◦_ → RightZero _≋_ (e , f) _⊕_ zeroʳ ze₁ ze₂ (x , a) = ze₁ x , InnerLex.zeroʳ ze₁ ze₂ identityʳ : ∀ {e f} → RightIdentity _≈₁_ e _∙_ → RightIdentity _≈₂_ f _◦_ → RightIdentity _≋_ (e , f) _⊕_ identityʳ id₁ id₂ (x , a) = id₁ x , InnerLex.identityʳ id₁ id₂ sel : Selective _≈₁_ _∙_ → Selective _≈₂_ _◦_ → Selective _≋_ _⊕_ sel ∙-sel ◦-sel (a , x) (b , y) with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b ... | no ab≉a | no ab≉b = contradiction₂ (∙-sel a b) ab≉a ab≉b ... | yes ab≈a | no _ = inj₁ (ab≈a , ≈₂-refl) ... | no _ | yes ab≈b = inj₂ (ab≈b , ≈₂-refl) ... | yes ab≈a | yes ab≈b with ◦-sel x y ... | inj₁ xy≈x = inj₁ (ab≈a , xy≈x) ... | inj₂ xy≈y = inj₂ (ab≈b , xy≈y) agda-stdlib-1.7.3/src/Algebra/Construct/LexProduct/000077500000000000000000000000001451211343400220745ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Construct/LexProduct/Base.agda000066400000000000000000000026041451211343400235660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of the lexicographic product of two operators. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core using (Op₂) open import Data.Bool.Base using (true; false) open import Data.Product using (_×_; _,_) open import Relation.Binary.Core using (Rel) open import Relation.Binary.Definitions using (Decidable) open import Relation.Nullary using (does; yes; no) module Algebra.Construct.LexProduct.Base {a b ℓ} {A : Set a} {B : Set b} (_∙_ : Op₂ A) (_◦_ : Op₂ B) {_≈₁_ : Rel A ℓ} (_≟₁_ : Decidable _≈₁_) where ------------------------------------------------------------------------ -- Definition -- In order to get the first component to be definitionally equal to -- `a ∙ b` and to simplify some of the proofs we first define an inner -- operator that only calculates the second component of product. innerLex : A → A → B → B → B innerLex a b x y with does ((a ∙ b) ≟₁ a) | does ((a ∙ b) ≟₁ b) ... | true | false = x ... | false | true = y ... | _ | _ = x ◦ y -- The full lexicographic choice operator can then be simply defined -- in terms of the inner one. lex : Op₂ (A × B) lex (a , x) (b , y) = (a ∙ b , innerLex a b x y) agda-stdlib-1.7.3/src/Algebra/Construct/LexProduct/Inner.agda000066400000000000000000000300161451211343400237650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the inner lexicographic product of two operators. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Bool.Base using (false; true) open import Data.Product using (_×_; _,_; swap; map; uncurry′) open import Function.Base using (_∘_) open import Level using (Level; _⊔_) open import Relation.Binary.Definitions using (Decidable) open import Relation.Nullary using (does; yes; no) open import Relation.Nullary.Negation using (contradiction; contradiction₂) import Relation.Binary.Reasoning.Setoid as SetoidReasoning import Algebra.Construct.LexProduct.Base as Base module Algebra.Construct.LexProduct.Inner {ℓ₁ ℓ₂ ℓ₃ ℓ₄} (M : Magma ℓ₁ ℓ₂) (N : Magma ℓ₃ ℓ₄) (_≟₁_ : Decidable (Magma._≈_ M)) where open module M = Magma M renaming ( Carrier to A ; _≈_ to _≈₁_ ; _≉_ to _≉₁_ ) open module N = Magma N using () renaming ( Carrier to B ; _∙_ to _◦_ ; _≈_ to _≈₂_ ; ∙-cong to ◦-cong ) private variable a b c d : A w x y z : B ------------------------------------------------------------------------ -- Base definition open Base _∙_ _◦_ _≟₁_ public using (innerLex) -- Save ourselves some typing in this file private lex = innerLex ------------------------------------------------------------------------ -- Properties module NaturalOrder where -- It would be really nice if we could use -- `Relation.Binary.Construct.NaturalOrder.Left/Right` to prove these -- properties but the equalities are defined the wrong way around open SetoidReasoning M.setoid ≤∙ˡ-resp-≈ : a ∙ b ≈₁ b → a ≈₁ c → b ≈₁ d → c ∙ d ≈₁ d ≤∙ˡ-resp-≈ {a} {b} {c} {d} ab≈b a≈c b≈d = begin c ∙ d ≈⟨ ∙-cong (M.sym a≈c) (M.sym b≈d) ⟩ a ∙ b ≈⟨ ab≈b ⟩ b ≈⟨ b≈d ⟩ d ∎ ≤∙ʳ-resp-≈ : a ∙ b ≈₁ a → a ≈₁ c → b ≈₁ d → c ∙ d ≈₁ c ≤∙ʳ-resp-≈ {a} {b} {c} {d} ab≈b a≈c b≈d = begin c ∙ d ≈⟨ ∙-cong (M.sym a≈c) (M.sym b≈d) ⟩ a ∙ b ≈⟨ ab≈b ⟩ a ≈⟨ a≈c ⟩ c ∎ ≤∙ˡ-trans : Associative _≈₁_ _∙_ → (a ∙ b) ≈₁ b → (b ∙ c) ≈₁ c → (a ∙ c) ≈₁ c ≤∙ˡ-trans {a} {b} {c} ∙-assoc ab≈b bc≈c = begin a ∙ c ≈˘⟨ ∙-congˡ bc≈c ⟩ a ∙ (b ∙ c) ≈˘⟨ ∙-assoc a b c ⟩ (a ∙ b) ∙ c ≈⟨ ∙-congʳ ab≈b ⟩ b ∙ c ≈⟨ bc≈c ⟩ c ∎ ≰∙ˡ-trans : Commutative _≈₁_ _∙_ → (a ∙ b) ≉₁ a → (a ∙ c) ≈₁ c → (b ∙ c) ≈₁ c → (a ∙ c) ≉₁ a ≰∙ˡ-trans {a} {b} {c} ∙-comm ab≉a ac≈c bc≈c ac≈a = ab≉a (begin a ∙ b ≈⟨ ∙-congʳ (M.trans (M.sym ac≈a) ac≈c) ⟩ c ∙ b ≈⟨ ∙-comm c b ⟩ b ∙ c ≈⟨ bc≈c ⟩ c ≈⟨ M.trans (M.sym ac≈c) ac≈a ⟩ a ∎) <∙ˡ-trans : Associative _≈₁_ _∙_ → Commutative _≈₁_ _∙_ → (a ∙ b) ≈₁ b → (a ∙ b) ≉₁ a → (b ∙ c) ≈₁ c → (a ∙ c) ≉₁ a × (a ∙ c) ≈₁ c <∙ˡ-trans {a} {b} {c} ∙-assoc ∙-comm ab≈b ab≉a bc≈c = ac≉a , ac≈c where ac≈c = ≤∙ˡ-trans ∙-assoc ab≈b bc≈c ac≉a = ≰∙ˡ-trans ∙-comm ab≉a ac≈c bc≈c <∙ʳ-trans : Associative _≈₁_ _∙_ → Commutative _≈₁_ _∙_ → (a ∙ b) ≈₁ a → (b ∙ c) ≈₁ b → (b ∙ c) ≉₁ c → (a ∙ c) ≈₁ a × (a ∙ c) ≉₁ c <∙ʳ-trans {a} {b} {c} assoc comm ab≈a bc≈b bc≉c = map (M.trans (comm a c)) (_∘ M.trans (comm c a)) (swap (<∙ˡ-trans assoc comm (M.trans (comm c b) bc≈b) (bc≉c ∘ M.trans (comm b c)) (M.trans (comm b a) ab≈a))) ------------------------------------------------------------------------ -- Basic properties open SetoidReasoning N.setoid open NaturalOrder case₁ : a ∙ b ≈₁ a → a ∙ b ≉₁ b → lex a b x y ≈₂ x case₁ {a} {b} ab≈a ab≉b with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b ... | no ab≉a | _ = contradiction ab≈a ab≉a ... | yes _ | yes ab≈b = contradiction ab≈b ab≉b ... | yes _ | no _ = N.refl case₂ : a ∙ b ≉₁ a → a ∙ b ≈₁ b → lex a b x y ≈₂ y case₂ {a} {b} ab≉a ab≈b with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b ... | yes ab≈a | _ = contradiction ab≈a ab≉a ... | no _ | no ab≉b = contradiction ab≈b ab≉b ... | no _ | yes _ = N.refl case₃ : a ∙ b ≈₁ a → a ∙ b ≈₁ b → lex a b x y ≈₂ (x ◦ y) case₃ {a} {b} ab≈a ab≈b with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b ... | no ab≉a | _ = contradiction ab≈a ab≉a ... | yes _ | no ab≉b = contradiction ab≈b ab≉b ... | yes _ | yes _ = N.refl ------------------------------------------------------------------------ -- Algebraic properties cong : a ≈₁ b → c ≈₁ d → w ≈₂ x → y ≈₂ z → lex a c w y ≈₂ lex b d x z cong {a} {b} {c} {d} a≈b c≈d w≈x y≈z with (a ∙ c) ≟₁ a | (a ∙ c) ≟₁ c | (b ∙ d) ≟₁ b | (b ∙ d) ≟₁ d ... | yes _ | yes _ | yes _ | yes _ = ◦-cong w≈x y≈z ... | yes _ | yes _ | no _ | no _ = ◦-cong w≈x y≈z ... | no _ | no _ | yes _ | yes _ = ◦-cong w≈x y≈z ... | no _ | no _ | no _ | no _ = ◦-cong w≈x y≈z ... | yes _ | no _ | yes _ | no _ = w≈x ... | no _ | yes _ | no _ | yes _ = y≈z ... | _ | yes ac≈c | _ | no bd≉d = contradiction (≤∙ˡ-resp-≈ ac≈c a≈b c≈d) bd≉d ... | yes ac≈a | _ | no bd≉b | _ = contradiction (≤∙ʳ-resp-≈ ac≈a a≈b c≈d) bd≉b ... | _ | no ac≉c | _ | yes bd≈d = contradiction (≤∙ˡ-resp-≈ bd≈d (M.sym a≈b) (M.sym c≈d)) ac≉c ... | no ac≉a | _ | yes bd≈b | _ = contradiction (≤∙ʳ-resp-≈ bd≈b (M.sym a≈b) (M.sym c≈d)) ac≉a cong₁₂ : a ≈₁ b → c ≈₁ d → lex a c x y ≈₂ lex b d x y cong₁₂ a≈b c≈d = cong a≈b c≈d N.refl N.refl cong₁ : a ≈₁ b → lex a c x y ≈₂ lex b c x y cong₁ a≈b = cong₁₂ a≈b M.refl cong₂ : b ≈₁ c → lex a b x y ≈₂ lex a c x y cong₂ = cong₁₂ M.refl -- It is possible to relax this. Instead of ∙ being selective and ◦ being associative it's also -- possible for _◦_ to return a single idempotent element. assoc : Associative _≈₁_ _∙_ → Commutative _≈₁_ _∙_ → Selective _≈₁_ _∙_ → Associative _≈₂_ _◦_ → ∀ a b c x y z → lex (a ∙ b) c (lex a b x y) z ≈₂ lex a (b ∙ c) x (lex b c y z) assoc ∙-assoc ∙-comm ∙-sel ◦-assoc a b c x y z with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b | (b ∙ c) ≟₁ b | (b ∙ c) ≟₁ c ... | _ | _ | no bc≉b | no bc≉c = contradiction₂ (∙-sel b c) bc≉b bc≉c ... | no ab≉a | no ab≉b | _ | _ = contradiction₂ (∙-sel a b) ab≉a ab≉b ... | yes ab≈a | no ab≉b | no bc≉b | yes bc≈c = cong₁₂ ab≈a (M.sym bc≈c) ... | no ab≉a | yes ab≈b | yes bc≈b | yes bc≈c = begin lex (a ∙ b) c y z ≈⟨ cong₁ ab≈b ⟩ lex b c y z ≈⟨ case₃ bc≈b bc≈c ⟩ y ◦ z ≈˘⟨ case₂ ab≉a ab≈b ⟩ lex a b x (y ◦ z) ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x (y ◦ z) ∎ ... | no ab≉a | yes ab≈b | yes bc≈b | no bc≉c = begin lex (a ∙ b) c y z ≈⟨ cong₁ ab≈b ⟩ lex b c y z ≈⟨ case₁ bc≈b bc≉c ⟩ y ≈˘⟨ case₂ ab≉a ab≈b ⟩ lex a b x y ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x y ∎ ... | yes ab≈a | yes ab≈b | yes bc≈b | no bc≉c = begin lex (a ∙ b) c (x ◦ y) z ≈⟨ cong₁ ab≈b ⟩ lex b c (x ◦ y) z ≈⟨ case₁ bc≈b bc≉c ⟩ x ◦ y ≈˘⟨ case₃ ab≈a ab≈b ⟩ lex a b x y ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x y ∎ ... | yes ab≈a | yes ab≈b | yes bc≈b | yes bc≈c = begin lex (a ∙ b) c (x ◦ y) z ≈⟨ cong₁ ab≈b ⟩ lex b c (x ◦ y) z ≈⟨ case₃ bc≈b bc≈c ⟩ (x ◦ y) ◦ z ≈⟨ ◦-assoc x y z ⟩ x ◦ (y ◦ z) ≈˘⟨ case₃ ab≈a ab≈b ⟩ lex a b x (y ◦ z) ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x (y ◦ z) ∎ ... | yes ab≈a | yes ab≈b | no bc≉b | yes bc≈c = begin lex (a ∙ b) c (x ◦ y) z ≈⟨ cong₁ ab≈b ⟩ lex b c (x ◦ y) z ≈⟨ case₂ bc≉b bc≈c ⟩ z ≈˘⟨ case₂ bc≉b bc≈c ⟩ lex b c x z ≈˘⟨ cong₁₂ (M.trans (M.sym ab≈a) ab≈b) bc≈c ⟩ lex a (b ∙ c) x z ∎ ... | yes ab≈a | no ab≉b | yes bc≈b | yes bc≈c = begin lex (a ∙ b) c x z ≈⟨ cong₁₂ ab≈a (M.trans (M.sym bc≈c) bc≈b) ⟩ lex a b x z ≈⟨ case₁ ab≈a ab≉b ⟩ x ≈˘⟨ case₁ ab≈a ab≉b ⟩ lex a b x (y ◦ z) ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x (y ◦ z) ∎ ... | no ab≉a | yes ab≈b | no bc≉b | yes bc≈c = begin lex (a ∙ b) c y z ≈⟨ cong₁ ab≈b ⟩ lex b c y z ≈⟨ case₂ bc≉b bc≈c ⟩ z ≈˘⟨ uncurry′ case₂ (<∙ˡ-trans ∙-assoc ∙-comm ab≈b ab≉a bc≈c) ⟩ lex a c x z ≈˘⟨ cong₂ bc≈c ⟩ lex a (b ∙ c) x z ∎ ... | yes ab≈a | no ab≉b | yes bc≈b | no bc≉c = begin lex (a ∙ b) c x z ≈⟨ cong₁ ab≈a ⟩ lex a c x z ≈⟨ uncurry′ case₁ (<∙ʳ-trans ∙-assoc ∙-comm ab≈a bc≈b bc≉c) ⟩ x ≈˘⟨ case₁ ab≈a ab≉b ⟩ lex a b x y ≈˘⟨ cong₂ bc≈b ⟩ lex a (b ∙ c) x y ∎ comm : Commutative _≈₁_ _∙_ → Commutative _≈₂_ _◦_ → ∀ a b x y → lex a b x y ≈₂ lex b a y x comm ∙-comm ◦-comm a b x y with (a ∙ b) ≟₁ a | (a ∙ b) ≟₁ b | (b ∙ a) ≟₁ b | (b ∙ a) ≟₁ a ... | yes ab≈a | _ | _ | no ba≉a = contradiction (M.trans (∙-comm b a) ab≈a) ba≉a ... | no ab≉a | _ | _ | yes ba≈a = contradiction (M.trans (∙-comm a b) ba≈a) ab≉a ... | _ | yes ab≈b | no ba≉b | _ = contradiction (M.trans (∙-comm b a) ab≈b) ba≉b ... | _ | no ab≉b | yes ba≈b | _ = contradiction (M.trans (∙-comm a b) ba≈b) ab≉b ... | yes _ | yes _ | yes _ | yes _ = ◦-comm x y ... | yes _ | no _ | no _ | yes _ = N.refl ... | no _ | yes _ | yes _ | no _ = N.refl ... | no _ | no _ | no _ | no _ = ◦-comm x y idem : Idempotent _≈₂_ _◦_ → ∀ a b x → lex a b x x ≈₂ x idem ◦-idem a b x with does ((a ∙ b) ≟₁ a) | does ((a ∙ b) ≟₁ b) ... | false | false = ◦-idem x ... | false | true = N.refl ... | true | false = N.refl ... | true | true = ◦-idem x zeroʳ : ∀ {e f} → RightZero _≈₁_ e _∙_ → RightZero _≈₂_ f _◦_ → lex a e x f ≈₂ f zeroʳ {a} {x} {e} {f} ze₁ ze₂ with (a ∙ e) ≟₁ a | (a ∙ e) ≟₁ e ... | _ | no a∙e≉e = contradiction (ze₁ a) a∙e≉e ... | no _ | yes _ = N.refl ... | yes _ | yes _ = ze₂ x identityʳ : ∀ {e f} → RightIdentity _≈₁_ e _∙_ → RightIdentity _≈₂_ f _◦_ → lex a e x f ≈₂ x identityʳ {a} {x} {e} {f} id₁ id₂ with (a ∙ e) ≟₁ a | (a ∙ e) ≟₁ e ... | no a∙e≉a | _ = contradiction (id₁ a) a∙e≉a ... | yes _ | no _ = N.refl ... | yes _ | yes _ = id₂ x agda-stdlib-1.7.3/src/Algebra/Construct/LiftedChoice.agda000066400000000000000000000160701451211343400231470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Choosing between elements based on the result of applying a function ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Construct.LiftedChoice where open import Algebra.Consequences.Base open import Relation.Binary open import Relation.Nullary using (¬_; yes; no) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]) open import Data.Product using (_×_; _,_) open import Level using (Level; _⊔_) open import Function.Base using (id; _on_) open import Function.Injection using (Injection) open import Function.Equality using (Π) open import Relation.Binary using (Setoid; _Preserves_⟶_) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Unary using (Pred) open import Relation.Nullary.Negation using (contradiction) import Relation.Binary.Reasoning.Setoid as EqReasoning private variable a b p ℓ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Definition module _ (_≈_ : Rel B ℓ) (_•_ : Op₂ B) where Lift : Selective _≈_ _•_ → (A → B) → Op₂ A Lift ∙-sel f x y with ∙-sel (f x) (f y) ... | inj₁ _ = x ... | inj₂ _ = y ------------------------------------------------------------------------ -- Algebraic properties module _ {_≈_ : Rel B ℓ} {_∙_ : Op₂ B} (∙-isSelectiveMagma : IsSelectiveMagma _≈_ _∙_) where private module M = IsSelectiveMagma ∙-isSelectiveMagma open M hiding (sel; isMagma) open EqReasoning setoid module _ (f : A → B) where private _◦_ = Lift _≈_ _∙_ M.sel f sel-≡ : Selective _≡_ _◦_ sel-≡ x y with M.sel (f x) (f y) ... | inj₁ _ = inj₁ P.refl ... | inj₂ _ = inj₂ P.refl distrib : ∀ x y → ((f x) ∙ (f y)) ≈ f (x ◦ y) distrib x y with M.sel (f x) (f y) ... | inj₁ fx∙fy≈fx = fx∙fy≈fx ... | inj₂ fx∙fy≈fy = fx∙fy≈fy module _ (f : A → B) {_≈′_ : Rel A ℓ} (≈-reflexive : _≡_ ⇒ _≈′_) where private _◦_ = Lift _≈_ _∙_ M.sel f sel : Selective _≈′_ _◦_ sel x y = Sum.map ≈-reflexive ≈-reflexive (sel-≡ f x y) idem : Idempotent _≈′_ _◦_ idem = sel⇒idem _≈′_ sel module _ {f : A → B} {_≈′_ : Rel A ℓ} (f-injective : ∀ {x y} → f x ≈ f y → x ≈′ y) where private _◦_ = Lift _≈_ _∙_ M.sel f cong : f Preserves _≈′_ ⟶ _≈_ → Congruent₂ _≈′_ _◦_ cong f-cong {x} {y} {u} {v} x≈y u≈v with M.sel (f x) (f u) | M.sel (f y) (f v) ... | inj₁ fx∙fu≈fx | inj₁ fy∙fv≈fy = x≈y ... | inj₂ fx∙fu≈fu | inj₂ fy∙fv≈fv = u≈v ... | inj₁ fx∙fu≈fx | inj₂ fy∙fv≈fv = f-injective (begin f x ≈⟨ sym fx∙fu≈fx ⟩ f x ∙ f u ≈⟨ ∙-cong (f-cong x≈y) (f-cong u≈v) ⟩ f y ∙ f v ≈⟨ fy∙fv≈fv ⟩ f v ∎) ... | inj₂ fx∙fu≈fu | inj₁ fy∙fv≈fy = f-injective (begin f u ≈⟨ sym fx∙fu≈fu ⟩ f x ∙ f u ≈⟨ ∙-cong (f-cong x≈y) (f-cong u≈v) ⟩ f y ∙ f v ≈⟨ fy∙fv≈fy ⟩ f y ∎) assoc : Associative _≈_ _∙_ → Associative _≈′_ _◦_ assoc ∙-assoc x y z = f-injective (begin f ((x ◦ y) ◦ z) ≈˘⟨ distrib f (x ◦ y) z ⟩ f (x ◦ y) ∙ f z ≈˘⟨ ∙-congʳ (distrib f x y) ⟩ (f x ∙ f y) ∙ f z ≈⟨ ∙-assoc (f x) (f y) (f z) ⟩ f x ∙ (f y ∙ f z) ≈⟨ ∙-congˡ (distrib f y z) ⟩ f x ∙ f (y ◦ z) ≈⟨ distrib f x (y ◦ z) ⟩ f (x ◦ (y ◦ z)) ∎) comm : Commutative _≈_ _∙_ → Commutative _≈′_ _◦_ comm ∙-comm x y = f-injective (begin f (x ◦ y) ≈˘⟨ distrib f x y ⟩ f x ∙ f y ≈⟨ ∙-comm (f x) (f y) ⟩ f y ∙ f x ≈⟨ distrib f y x ⟩ f (y ◦ x) ∎) ------------------------------------------------------------------------ -- Algebraic structures module _ {_≈′_ : Rel A ℓ} {f : A → B} (f-injective : ∀ {x y} → f x ≈ f y → x ≈′ y) (f-cong : f Preserves _≈′_ ⟶ _≈_) (≈′-isEquivalence : IsEquivalence _≈′_) where private module E = IsEquivalence ≈′-isEquivalence _◦_ = Lift _≈_ _∙_ M.sel f isMagma : IsMagma _≈′_ _◦_ isMagma = record { isEquivalence = ≈′-isEquivalence ; ∙-cong = cong (λ {x y} → f-injective {x} {y}) f-cong } isSemigroup : Associative _≈_ _∙_ → IsSemigroup _≈′_ _◦_ isSemigroup ∙-assoc = record { isMagma = isMagma ; assoc = assoc (λ {x y} → f-injective {x} {y}) ∙-assoc } isBand : Associative _≈_ _∙_ → IsBand _≈′_ _◦_ isBand ∙-assoc = record { isSemigroup = isSemigroup ∙-assoc ; idem = idem f E.reflexive } isSemilattice : Associative _≈_ _∙_ → Commutative _≈_ _∙_ → IsSemilattice _≈′_ _◦_ isSemilattice ∙-assoc ∙-comm = record { isBand = isBand ∙-assoc ; comm = comm (λ {x y} → f-injective {x} {y}) ∙-comm } isSelectiveMagma : IsSelectiveMagma _≈′_ _◦_ isSelectiveMagma = record { isMagma = isMagma ; sel = sel f E.reflexive } ------------------------------------------------------------------------ -- Other properties module _ {P : Pred A p} (f : A → B) where private _◦_ = Lift _≈_ _∙_ M.sel f preservesᵒ : (∀ {x y} → P x → (f x ∙ f y) ≈ f y → P y) → (∀ {x y} → P y → (f x ∙ f y) ≈ f x → P x) → ∀ x y → P x ⊎ P y → P (x ◦ y) preservesᵒ left right x y (inj₁ px) with M.sel (f x) (f y) ... | inj₁ _ = px ... | inj₂ fx∙fy≈fx = left px fx∙fy≈fx preservesᵒ left right x y (inj₂ py) with M.sel (f x) (f y) ... | inj₁ fx∙fy≈fy = right py fx∙fy≈fy ... | inj₂ _ = py preservesʳ : (∀ {x y} → P y → (f x ∙ f y) ≈ f x → P x) → ∀ x {y} → P y → P (x ◦ y) preservesʳ right x {y} Py with M.sel (f x) (f y) ... | inj₁ fx∙fy≈fx = right Py fx∙fy≈fx ... | inj₂ fx∙fy≈fy = Py preservesᵇ : ∀ {x y} → P x → P y → P (x ◦ y) preservesᵇ {x} {y} Px Py with M.sel (f x) (f y) ... | inj₁ _ = Px ... | inj₂ _ = Py forcesᵇ : (∀ {x y} → P x → (f x ∙ f y) ≈ f x → P y) → (∀ {x y} → P y → (f x ∙ f y) ≈ f y → P x) → ∀ x y → P (x ◦ y) → P x × P y forcesᵇ presˡ presʳ x y P[x∙y] with M.sel (f x) (f y) ... | inj₁ fx∙fy≈fx = P[x∙y] , presˡ P[x∙y] fx∙fy≈fx ... | inj₂ fx∙fy≈fy = presʳ P[x∙y] fx∙fy≈fy , P[x∙y] agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/000077500000000000000000000000001451211343400225245ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/Base.agda000066400000000000000000000037761451211343400242310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic definition of an operator that computes the min/max value -- with respect to a total ordering. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Level as L hiding (_⊔_) open import Function.Base using (flip) open import Relation.Binary open import Relation.Binary.Construct.Converse using () renaming (totalPreorder to flipOrder) import Relation.Binary.Properties.TotalOrder as TotalOrderProperties module Algebra.Construct.NaturalChoice.Base where private variable a ℓ₁ ℓ₂ : Level O : TotalPreorder a ℓ₁ ℓ₂ ------------------------------------------------------------------------ -- Definition module _ (O : TotalPreorder a ℓ₁ ℓ₂) where open TotalPreorder O renaming (_≲_ to _≤_) private _≥_ = flip _≤_ record MinOperator : Set (a L.⊔ ℓ₁ L.⊔ ℓ₂) where infixl 7 _⊓_ field _⊓_ : Op₂ Carrier x≤y⇒x⊓y≈x : ∀ {x y} → x ≤ y → x ⊓ y ≈ x x≥y⇒x⊓y≈y : ∀ {x y} → x ≥ y → x ⊓ y ≈ y record MaxOperator : Set (a L.⊔ ℓ₁ L.⊔ ℓ₂) where infixl 6 _⊔_ field _⊔_ : Op₂ Carrier x≤y⇒x⊔y≈y : ∀ {x y} → x ≤ y → x ⊔ y ≈ y x≥y⇒x⊔y≈x : ∀ {x y} → x ≥ y → x ⊔ y ≈ x ------------------------------------------------------------------------ -- Properties MinOp⇒MaxOp : MinOperator O → MaxOperator (flipOrder O) MinOp⇒MaxOp minOp = record { _⊔_ = _⊓_ ; x≤y⇒x⊔y≈y = x≥y⇒x⊓y≈y ; x≥y⇒x⊔y≈x = x≤y⇒x⊓y≈x } where open MinOperator minOp MaxOp⇒MinOp : MaxOperator O → MinOperator (flipOrder O) MaxOp⇒MinOp maxOp = record { _⊓_ = _⊔_ ; x≤y⇒x⊓y≈x = x≥y⇒x⊔y≈x ; x≥y⇒x⊓y≈y = x≤y⇒x⊔y≈y } where open MaxOperator maxOp agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/Max.agda000066400000000000000000000024721451211343400240740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The max operator derived from an arbitrary total order ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Algebra.Construct.NaturalChoice.Max {a ℓ₁ ℓ₂} (totalOrder : TotalOrder a ℓ₁ ℓ₂) where open import Algebra.Core open import Algebra.Definitions open import Algebra.Construct.NaturalChoice.Base open import Relation.Binary.Construct.Converse using () renaming (totalOrder to flip) open TotalOrder totalOrder renaming (Carrier to A) ------------------------------------------------------------------------ -- Max is just min with a flipped order import Algebra.Construct.NaturalChoice.Min (flip totalOrder) as Min infixl 6 _⊔_ _⊔_ : Op₂ A _⊔_ = Min._⊓_ ------------------------------------------------------------------------ -- Properties open Min public using () renaming ( x≤y⇒x⊓y≈x to x≤y⇒y⊔x≈y ; x≤y⇒y⊓x≈x to x≤y⇒x⊔y≈y ) maxOperator : MaxOperator totalPreorder maxOperator = record { x≤y⇒x⊔y≈y = x≤y⇒x⊔y≈y ; x≥y⇒x⊔y≈x = x≤y⇒y⊔x≈y } open import Algebra.Construct.NaturalChoice.MaxOp maxOperator public agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/MaxOp.agda000066400000000000000000000055161451211343400243750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of a max operator derived from a spec over a total order. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Algebra.Construct.NaturalChoice.Base import Algebra.Construct.NaturalChoice.MinOp as MinOp open import Function.Base using (flip) open import Relation.Binary open import Relation.Binary.Construct.Converse using () renaming (totalPreorder to flipOrder) module Algebra.Construct.NaturalChoice.MaxOp {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} (maxOp : MaxOperator O) where open TotalPreorder O renaming (Carrier to A; _≲_ to _≤_) open MaxOperator maxOp -- Max is just min with a flipped order private module Min = MinOp (MaxOp⇒MinOp maxOp) open Min public using () renaming ( ⊓-cong to ⊔-cong ; ⊓-congʳ to ⊔-congʳ ; ⊓-congˡ to ⊔-congˡ ; ⊓-idem to ⊔-idem ; ⊓-sel to ⊔-sel ; ⊓-assoc to ⊔-assoc ; ⊓-comm to ⊔-comm ; ⊓-identityˡ to ⊔-identityˡ ; ⊓-identityʳ to ⊔-identityʳ ; ⊓-identity to ⊔-identity ; ⊓-zeroˡ to ⊔-zeroˡ ; ⊓-zeroʳ to ⊔-zeroʳ ; ⊓-zero to ⊔-zero ; ⊓-isMagma to ⊔-isMagma ; ⊓-isSemigroup to ⊔-isSemigroup ; ⊓-isCommutativeSemigroup to ⊔-isCommutativeSemigroup ; ⊓-isBand to ⊔-isBand ; ⊓-isSemilattice to ⊔-isSemilattice ; ⊓-isMonoid to ⊔-isMonoid ; ⊓-isSelectiveMagma to ⊔-isSelectiveMagma ; ⊓-magma to ⊔-magma ; ⊓-semigroup to ⊔-semigroup ; ⊓-commutativeSemigroup to ⊔-commutativeSemigroup ; ⊓-band to ⊔-band ; ⊓-semilattice to ⊔-semilattice ; ⊓-monoid to ⊔-monoid ; ⊓-selectiveMagma to ⊔-selectiveMagma ; x⊓y≈y⇒y≤x to x⊔y≈y⇒x≤y ; x⊓y≈x⇒x≤y to x⊔y≈x⇒y≤x ; x⊓y≤x to x≤x⊔y ; x⊓y≤y to x≤y⊔x ; x≤y⇒x⊓z≤y to x≤y⇒x≤y⊔z ; x≤y⇒z⊓x≤y to x≤y⇒x≤z⊔y ; x≤y⊓z⇒x≤y to x⊔y≤z⇒x≤z ; x≤y⊓z⇒x≤z to x⊔y≤z⇒y≤z ; ⊓-glb to ⊔-lub ; ⊓-triangulate to ⊔-triangulate ; ⊓-mono-≤ to ⊔-mono-≤ ; ⊓-monoˡ-≤ to ⊔-monoˡ-≤ ; ⊓-monoʳ-≤ to ⊔-monoʳ-≤ ) mono-≤-distrib-⊔ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≤_ → ∀ x y → f (x ⊔ y) ≈ f x ⊔ f y mono-≤-distrib-⊔ cong pres = Min.mono-≤-distrib-⊓ cong pres agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/Min.agda000066400000000000000000000030111451211343400240600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The min operator derived from an arbitrary total order ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Algebra.Bundles open import Algebra.Construct.NaturalChoice.Base open import Data.Sum using (inj₁; inj₂; [_,_]) open import Data.Product using (_,_) open import Function using (id) open import Relation.Binary import Algebra.Construct.NaturalChoice.MinOp as MinOp module Algebra.Construct.NaturalChoice.Min {a ℓ₁ ℓ₂} (O : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder O renaming (Carrier to A) ------------------------------------------------------------------------ -- Definition infixl 7 _⊓_ _⊓_ : Op₂ A x ⊓ y with total x y ... | inj₁ x≤y = x ... | inj₂ y≤x = y ------------------------------------------------------------------------ -- Properties x≤y⇒x⊓y≈x : ∀ {x y} → x ≤ y → x ⊓ y ≈ x x≤y⇒x⊓y≈x {x} {y} x≤y with total x y ... | inj₁ _ = Eq.refl ... | inj₂ y≤x = antisym y≤x x≤y x≤y⇒y⊓x≈x : ∀ {x y} → x ≤ y → y ⊓ x ≈ x x≤y⇒y⊓x≈x {x} {y} x≤y with total y x ... | inj₁ y≤x = antisym y≤x x≤y ... | inj₂ _ = Eq.refl minOperator : MinOperator totalPreorder minOperator = record { x≤y⇒x⊓y≈x = x≤y⇒x⊓y≈x ; x≥y⇒x⊓y≈y = x≤y⇒y⊓x≈x } open MinOp minOperator public agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/MinMaxOp.agda000066400000000000000000000156411451211343400250410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of min and max operators specified over a total order ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Algebra.Bundles open import Algebra.Construct.NaturalChoice.Base open import Data.Sum.Base as Sum using (inj₁; inj₂; [_,_]) open import Data.Product using (_,_) open import Function.Base using (id; _∘_; flip) open import Relation.Binary open import Relation.Binary.Consequences module Algebra.Construct.NaturalChoice.MinMaxOp {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} (minOp : MinOperator O) (maxOp : MaxOperator O) where open TotalPreorder O renaming ( Carrier to A ; _≲_ to _≤_ ; ≲-resp-≈ to ≤-resp-≈ ; ≲-respʳ-≈ to ≤-respʳ-≈ ; ≲-respˡ-≈ to ≤-respˡ-≈ ) open MinOperator minOp open MaxOperator maxOp open import Algebra.Definitions _≈_ open import Algebra.Structures _≈_ open import Algebra.Consequences.Setoid Eq.setoid open import Relation.Binary.Reasoning.Preorder preorder ------------------------------------------------------------------------ -- Re-export properties of individual operators open import Algebra.Construct.NaturalChoice.MinOp minOp public open import Algebra.Construct.NaturalChoice.MaxOp maxOp public ------------------------------------------------------------------------ -- Joint algebraic structures ⊓-distribˡ-⊔ : _⊓_ DistributesOverˡ _⊔_ ⊓-distribˡ-⊔ x y z with total y z ... | inj₁ y≤z = begin-equality x ⊓ (y ⊔ z) ≈⟨ ⊓-congˡ x (x≤y⇒x⊔y≈y y≤z) ⟩ x ⊓ z ≈˘⟨ x≤y⇒x⊔y≈y (⊓-monoʳ-≤ x y≤z) ⟩ (x ⊓ y) ⊔ (x ⊓ z) ∎ ... | inj₂ y≥z = begin-equality x ⊓ (y ⊔ z) ≈⟨ ⊓-congˡ x (x≥y⇒x⊔y≈x y≥z) ⟩ x ⊓ y ≈˘⟨ x≥y⇒x⊔y≈x (⊓-monoʳ-≤ x y≥z) ⟩ (x ⊓ y) ⊔ (x ⊓ z) ∎ ⊓-distribʳ-⊔ : _⊓_ DistributesOverʳ _⊔_ ⊓-distribʳ-⊔ = comm+distrˡ⇒distrʳ ⊔-cong ⊓-comm ⊓-distribˡ-⊔ ⊓-distrib-⊔ : _⊓_ DistributesOver _⊔_ ⊓-distrib-⊔ = ⊓-distribˡ-⊔ , ⊓-distribʳ-⊔ ⊔-distribˡ-⊓ : _⊔_ DistributesOverˡ _⊓_ ⊔-distribˡ-⊓ x y z with total y z ... | inj₁ y≤z = begin-equality x ⊔ (y ⊓ z) ≈⟨ ⊔-congˡ x (x≤y⇒x⊓y≈x y≤z) ⟩ x ⊔ y ≈˘⟨ x≤y⇒x⊓y≈x (⊔-monoʳ-≤ x y≤z) ⟩ (x ⊔ y) ⊓ (x ⊔ z) ∎ ... | inj₂ y≥z = begin-equality x ⊔ (y ⊓ z) ≈⟨ ⊔-congˡ x (x≥y⇒x⊓y≈y y≥z) ⟩ x ⊔ z ≈˘⟨ x≥y⇒x⊓y≈y (⊔-monoʳ-≤ x y≥z) ⟩ (x ⊔ y) ⊓ (x ⊔ z) ∎ ⊔-distribʳ-⊓ : _⊔_ DistributesOverʳ _⊓_ ⊔-distribʳ-⊓ = comm+distrˡ⇒distrʳ ⊓-cong ⊔-comm ⊔-distribˡ-⊓ ⊔-distrib-⊓ : _⊔_ DistributesOver _⊓_ ⊔-distrib-⊓ = ⊔-distribˡ-⊓ , ⊔-distribʳ-⊓ ⊓-absorbs-⊔ : _⊓_ Absorbs _⊔_ ⊓-absorbs-⊔ x y with total x y ... | inj₁ x≤y = begin-equality x ⊓ (x ⊔ y) ≈⟨ ⊓-congˡ x (x≤y⇒x⊔y≈y x≤y) ⟩ x ⊓ y ≈⟨ x≤y⇒x⊓y≈x x≤y ⟩ x ∎ ... | inj₂ y≤x = begin-equality x ⊓ (x ⊔ y) ≈⟨ ⊓-congˡ x (x≥y⇒x⊔y≈x y≤x) ⟩ x ⊓ x ≈⟨ ⊓-idem x ⟩ x ∎ ⊔-absorbs-⊓ : _⊔_ Absorbs _⊓_ ⊔-absorbs-⊓ x y with total x y ... | inj₁ x≤y = begin-equality x ⊔ (x ⊓ y) ≈⟨ ⊔-congˡ x (x≤y⇒x⊓y≈x x≤y) ⟩ x ⊔ x ≈⟨ ⊔-idem x ⟩ x ∎ ... | inj₂ y≤x = begin-equality x ⊔ (x ⊓ y) ≈⟨ ⊔-congˡ x (x≥y⇒x⊓y≈y y≤x) ⟩ x ⊔ y ≈⟨ x≥y⇒x⊔y≈x y≤x ⟩ x ∎ ⊔-⊓-absorptive : Absorptive _⊔_ _⊓_ ⊔-⊓-absorptive = ⊔-absorbs-⊓ , ⊓-absorbs-⊔ ⊓-⊔-absorptive : Absorptive _⊓_ _⊔_ ⊓-⊔-absorptive = ⊓-absorbs-⊔ , ⊔-absorbs-⊓ ⊔-⊓-isLattice : IsLattice _⊔_ _⊓_ ⊔-⊓-isLattice = record { isEquivalence = isEquivalence ; ∨-comm = ⊔-comm ; ∨-assoc = ⊔-assoc ; ∨-cong = ⊔-cong ; ∧-comm = ⊓-comm ; ∧-assoc = ⊓-assoc ; ∧-cong = ⊓-cong ; absorptive = ⊔-⊓-absorptive } ⊓-⊔-isLattice : IsLattice _⊓_ _⊔_ ⊓-⊔-isLattice = record { isEquivalence = isEquivalence ; ∨-comm = ⊓-comm ; ∨-assoc = ⊓-assoc ; ∨-cong = ⊓-cong ; ∧-comm = ⊔-comm ; ∧-assoc = ⊔-assoc ; ∧-cong = ⊔-cong ; absorptive = ⊓-⊔-absorptive } ⊓-⊔-isDistributiveLattice : IsDistributiveLattice _⊓_ _⊔_ ⊓-⊔-isDistributiveLattice = record { isLattice = ⊓-⊔-isLattice ; ∨-distribʳ-∧ = ⊓-distribʳ-⊔ } ⊔-⊓-isDistributiveLattice : IsDistributiveLattice _⊔_ _⊓_ ⊔-⊓-isDistributiveLattice = record { isLattice = ⊔-⊓-isLattice ; ∨-distribʳ-∧ = ⊔-distribʳ-⊓ } ⊔-⊓-lattice : Lattice _ _ ⊔-⊓-lattice = record { isLattice = ⊔-⊓-isLattice } ⊓-⊔-lattice : Lattice _ _ ⊓-⊔-lattice = record { isLattice = ⊓-⊔-isLattice } ⊔-⊓-distributiveLattice : DistributiveLattice _ _ ⊔-⊓-distributiveLattice = record { isDistributiveLattice = ⊔-⊓-isDistributiveLattice } ⊓-⊔-distributiveLattice : DistributiveLattice _ _ ⊓-⊔-distributiveLattice = record { isDistributiveLattice = ⊓-⊔-isDistributiveLattice } ------------------------------------------------------------------------ -- Other joint properties private _≥_ = flip _≤_ antimono-≤-distrib-⊓ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≥_ → ∀ x y → f (x ⊓ y) ≈ f x ⊔ f y antimono-≤-distrib-⊓ {f} cong antimono x y with total x y ... | inj₁ x≤y = begin-equality f (x ⊓ y) ≈⟨ cong (x≤y⇒x⊓y≈x x≤y) ⟩ f x ≈˘⟨ x≥y⇒x⊔y≈x (antimono x≤y) ⟩ f x ⊔ f y ∎ ... | inj₂ y≤x = begin-equality f (x ⊓ y) ≈⟨ cong (x≥y⇒x⊓y≈y y≤x) ⟩ f y ≈˘⟨ x≤y⇒x⊔y≈y (antimono y≤x) ⟩ f x ⊔ f y ∎ antimono-≤-distrib-⊔ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≥_ → ∀ x y → f (x ⊔ y) ≈ f x ⊓ f y antimono-≤-distrib-⊔ {f} cong antimono x y with total x y ... | inj₁ x≤y = begin-equality f (x ⊔ y) ≈⟨ cong (x≤y⇒x⊔y≈y x≤y) ⟩ f y ≈˘⟨ x≥y⇒x⊓y≈y (antimono x≤y) ⟩ f x ⊓ f y ∎ ... | inj₂ y≤x = begin-equality f (x ⊔ y) ≈⟨ cong (x≥y⇒x⊔y≈x y≤x) ⟩ f x ≈˘⟨ x≤y⇒x⊓y≈x (antimono y≤x) ⟩ f x ⊓ f y ∎ x⊓y≤x⊔y : ∀ x y → x ⊓ y ≤ x ⊔ y x⊓y≤x⊔y x y = begin x ⊓ y ∼⟨ x⊓y≤x x y ⟩ x ∼⟨ x≤x⊔y x y ⟩ x ⊔ y ∎ agda-stdlib-1.7.3/src/Algebra/Construct/NaturalChoice/MinOp.agda000066400000000000000000000220351451211343400243660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of a min operator derived from a spec over a total order. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Algebra.Bundles open import Algebra.Construct.NaturalChoice.Base open import Data.Sum.Base as Sum using (inj₁; inj₂; [_,_]) open import Data.Product using (_,_) open import Function.Base using (id; _∘_) open import Relation.Binary open import Relation.Binary.Consequences module Algebra.Construct.NaturalChoice.MinOp {a ℓ₁ ℓ₂} {O : TotalPreorder a ℓ₁ ℓ₂} (minOp : MinOperator O) where open TotalPreorder O renaming ( Carrier to A ; _≲_ to _≤_ ; ≲-resp-≈ to ≤-resp-≈ ; ≲-respʳ-≈ to ≤-respʳ-≈ ; ≲-respˡ-≈ to ≤-respˡ-≈ ) open MinOperator minOp open import Algebra.Definitions _≈_ open import Algebra.Structures _≈_ open import Relation.Binary.Reasoning.Preorder preorder ------------------------------------------------------------------------ -- Helpful properties x⊓y≤x : ∀ x y → x ⊓ y ≤ x x⊓y≤x x y with total x y ... | inj₁ x≤y = ≤-respˡ-≈ (Eq.sym (x≤y⇒x⊓y≈x x≤y)) refl ... | inj₂ y≤x = ≤-respˡ-≈ (Eq.sym (x≥y⇒x⊓y≈y y≤x)) y≤x x⊓y≤y : ∀ x y → x ⊓ y ≤ y x⊓y≤y x y with total x y ... | inj₁ x≤y = ≤-respˡ-≈ (Eq.sym (x≤y⇒x⊓y≈x x≤y)) x≤y ... | inj₂ y≤x = ≤-respˡ-≈ (Eq.sym (x≥y⇒x⊓y≈y y≤x)) refl ------------------------------------------------------------------------ -- Algebraic properties ⊓-comm : Commutative _⊓_ ⊓-comm x y with total x y ... | inj₁ x≤y = Eq.trans (x≤y⇒x⊓y≈x x≤y) (Eq.sym (x≥y⇒x⊓y≈y x≤y)) ... | inj₂ y≤x = Eq.trans (x≥y⇒x⊓y≈y y≤x) (Eq.sym (x≤y⇒x⊓y≈x y≤x)) ⊓-congˡ : ∀ x → Congruent₁ (x ⊓_) ⊓-congˡ x {y} {r} y≈r with total x y ... | inj₁ x≤y = begin-equality x ⊓ y ≈⟨ x≤y⇒x⊓y≈x x≤y ⟩ x ≈˘⟨ x≤y⇒x⊓y≈x (≤-respʳ-≈ y≈r x≤y) ⟩ x ⊓ r ∎ ... | inj₂ y≤x = begin-equality x ⊓ y ≈⟨ x≥y⇒x⊓y≈y y≤x ⟩ y ≈⟨ y≈r ⟩ r ≈˘⟨ x≥y⇒x⊓y≈y (≤-respˡ-≈ y≈r y≤x) ⟩ x ⊓ r ∎ ⊓-congʳ : ∀ x → Congruent₁ (_⊓ x) ⊓-congʳ x {y₁} {y₂} y₁≈y₂ = begin-equality y₁ ⊓ x ≈˘⟨ ⊓-comm x y₁ ⟩ x ⊓ y₁ ≈⟨ ⊓-congˡ x y₁≈y₂ ⟩ x ⊓ y₂ ≈⟨ ⊓-comm x y₂ ⟩ y₂ ⊓ x ∎ ⊓-cong : Congruent₂ _⊓_ ⊓-cong {x₁} {x₂} {y₁} {y₂} x₁≈x₂ y₁≈y₂ = Eq.trans (⊓-congˡ x₁ y₁≈y₂) (⊓-congʳ y₂ x₁≈x₂) ⊓-assoc : Associative _⊓_ ⊓-assoc x y r with total x y | total y r ⊓-assoc x y r | inj₁ x≤y | inj₁ y≤r = begin-equality (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≤y⇒x⊓y≈x x≤y) ⟩ x ⊓ r ≈⟨ x≤y⇒x⊓y≈x (trans x≤y y≤r) ⟩ x ≈˘⟨ x≤y⇒x⊓y≈x x≤y ⟩ x ⊓ y ≈˘⟨ ⊓-congˡ x (x≤y⇒x⊓y≈x y≤r) ⟩ x ⊓ (y ⊓ r) ∎ ⊓-assoc x y r | inj₁ x≤y | inj₂ r≤y = begin-equality (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≤y⇒x⊓y≈x x≤y) ⟩ x ⊓ r ≈˘⟨ ⊓-congˡ x (x≥y⇒x⊓y≈y r≤y) ⟩ x ⊓ (y ⊓ r) ∎ ⊓-assoc x y r | inj₂ y≤x | _ = begin-equality (x ⊓ y) ⊓ r ≈⟨ ⊓-congʳ r (x≥y⇒x⊓y≈y y≤x) ⟩ y ⊓ r ≈˘⟨ x≥y⇒x⊓y≈y (trans (x⊓y≤x y r) y≤x) ⟩ x ⊓ (y ⊓ r) ∎ ⊓-idem : Idempotent _⊓_ ⊓-idem x = x≤y⇒x⊓y≈x (refl {x}) ⊓-sel : Selective _⊓_ ⊓-sel x y = Sum.map x≤y⇒x⊓y≈x x≥y⇒x⊓y≈y (total x y) ⊓-identityˡ : ∀ {⊤} → Maximum _≤_ ⊤ → LeftIdentity ⊤ _⊓_ ⊓-identityˡ max = x≥y⇒x⊓y≈y ∘ max ⊓-identityʳ : ∀ {⊤} → Maximum _≤_ ⊤ → RightIdentity ⊤ _⊓_ ⊓-identityʳ max = x≤y⇒x⊓y≈x ∘ max ⊓-identity : ∀ {⊤} → Maximum _≤_ ⊤ → Identity ⊤ _⊓_ ⊓-identity max = ⊓-identityˡ max , ⊓-identityʳ max ⊓-zeroˡ : ∀ {⊥} → Minimum _≤_ ⊥ → LeftZero ⊥ _⊓_ ⊓-zeroˡ min = x≤y⇒x⊓y≈x ∘ min ⊓-zeroʳ : ∀ {⊥} → Minimum _≤_ ⊥ → RightZero ⊥ _⊓_ ⊓-zeroʳ min = x≥y⇒x⊓y≈y ∘ min ⊓-zero : ∀ {⊥} → Minimum _≤_ ⊥ → Zero ⊥ _⊓_ ⊓-zero min = ⊓-zeroˡ min , ⊓-zeroʳ min ------------------------------------------------------------------------ -- Structures ⊓-isMagma : IsMagma _⊓_ ⊓-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ⊓-cong } ⊓-isSemigroup : IsSemigroup _⊓_ ⊓-isSemigroup = record { isMagma = ⊓-isMagma ; assoc = ⊓-assoc } ⊓-isBand : IsBand _⊓_ ⊓-isBand = record { isSemigroup = ⊓-isSemigroup ; idem = ⊓-idem } ⊓-isCommutativeSemigroup : IsCommutativeSemigroup _⊓_ ⊓-isCommutativeSemigroup = record { isSemigroup = ⊓-isSemigroup ; comm = ⊓-comm } ⊓-isSemilattice : IsSemilattice _⊓_ ⊓-isSemilattice = record { isBand = ⊓-isBand ; comm = ⊓-comm } ⊓-isSelectiveMagma : IsSelectiveMagma _⊓_ ⊓-isSelectiveMagma = record { isMagma = ⊓-isMagma ; sel = ⊓-sel } ⊓-isMonoid : ∀ {⊤} → Maximum _≤_ ⊤ → IsMonoid _⊓_ ⊤ ⊓-isMonoid max = record { isSemigroup = ⊓-isSemigroup ; identity = ⊓-identity max } ------------------------------------------------------------------------ -- Raw bandles ⊓-rawMagma : RawMagma _ _ ⊓-rawMagma = record { _≈_ = _≈_ ; _∙_ = _⊓_ } ------------------------------------------------------------------------ -- Bundles ⊓-magma : Magma _ _ ⊓-magma = record { isMagma = ⊓-isMagma } ⊓-semigroup : Semigroup _ _ ⊓-semigroup = record { isSemigroup = ⊓-isSemigroup } ⊓-band : Band _ _ ⊓-band = record { isBand = ⊓-isBand } ⊓-commutativeSemigroup : CommutativeSemigroup _ _ ⊓-commutativeSemigroup = record { isCommutativeSemigroup = ⊓-isCommutativeSemigroup } ⊓-semilattice : Semilattice _ _ ⊓-semilattice = record { isSemilattice = ⊓-isSemilattice } ⊓-selectiveMagma : SelectiveMagma _ _ ⊓-selectiveMagma = record { isSelectiveMagma = ⊓-isSelectiveMagma } ⊓-monoid : ∀ {⊤} → Maximum _≤_ ⊤ → Monoid a ℓ₁ ⊓-monoid max = record { isMonoid = ⊓-isMonoid max } ------------------------------------------------------------------------ -- Other properties x⊓y≈x⇒x≤y : ∀ {x y} → x ⊓ y ≈ x → x ≤ y x⊓y≈x⇒x≤y {x} {y} x⊓y≈x with total x y ... | inj₁ x≤y = x≤y ... | inj₂ y≤x = reflexive (Eq.trans (Eq.sym x⊓y≈x) (x≥y⇒x⊓y≈y y≤x)) x⊓y≈y⇒y≤x : ∀ {x y} → x ⊓ y ≈ y → y ≤ x x⊓y≈y⇒y≤x {x} {y} x⊓y≈y = x⊓y≈x⇒x≤y (begin-equality y ⊓ x ≈⟨ ⊓-comm y x ⟩ x ⊓ y ≈⟨ x⊓y≈y ⟩ y ∎) mono-≤-distrib-⊓ : ∀ {f} → f Preserves _≈_ ⟶ _≈_ → f Preserves _≤_ ⟶ _≤_ → ∀ x y → f (x ⊓ y) ≈ f x ⊓ f y mono-≤-distrib-⊓ {f} cong mono x y with total x y ... | inj₁ x≤y = begin-equality f (x ⊓ y) ≈⟨ cong (x≤y⇒x⊓y≈x x≤y) ⟩ f x ≈˘⟨ x≤y⇒x⊓y≈x (mono x≤y) ⟩ f x ⊓ f y ∎ ... | inj₂ y≤x = begin-equality f (x ⊓ y) ≈⟨ cong (x≥y⇒x⊓y≈y y≤x) ⟩ f y ≈˘⟨ x≥y⇒x⊓y≈y (mono y≤x) ⟩ f x ⊓ f y ∎ x≤y⇒x⊓z≤y : ∀ {x y} z → x ≤ y → x ⊓ z ≤ y x≤y⇒x⊓z≤y z x≤y = trans (x⊓y≤x _ z) x≤y x≤y⇒z⊓x≤y : ∀ {x y} z → x ≤ y → z ⊓ x ≤ y x≤y⇒z⊓x≤y y x≤y = trans (x⊓y≤y y _) x≤y x≤y⊓z⇒x≤y : ∀ {x} y z → x ≤ y ⊓ z → x ≤ y x≤y⊓z⇒x≤y y z x≤y⊓z = trans x≤y⊓z (x⊓y≤x y z) x≤y⊓z⇒x≤z : ∀ {x} y z → x ≤ y ⊓ z → x ≤ z x≤y⊓z⇒x≤z y z x≤y⊓z = trans x≤y⊓z (x⊓y≤y y z) ⊓-mono-≤ : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ⊓-mono-≤ {x} {y} {u} {v} x≤y u≤v with ⊓-sel y v ... | inj₁ y⊓v≈y = ≤-respʳ-≈ (Eq.sym y⊓v≈y) (trans (x⊓y≤x x u) x≤y) ... | inj₂ y⊓v≈v = ≤-respʳ-≈ (Eq.sym y⊓v≈v) (trans (x⊓y≤y x u) u≤v) ⊓-monoˡ-≤ : ∀ x → (_⊓ x) Preserves _≤_ ⟶ _≤_ ⊓-monoˡ-≤ x y≤z = ⊓-mono-≤ y≤z (refl {x}) ⊓-monoʳ-≤ : ∀ x → (x ⊓_) Preserves _≤_ ⟶ _≤_ ⊓-monoʳ-≤ x y≤z = ⊓-mono-≤ (refl {x}) y≤z ⊓-glb : ∀ {x y z} → x ≤ y → x ≤ z → x ≤ y ⊓ z ⊓-glb {x} x≤y x≤z = ≤-respˡ-≈ (⊓-idem x) (⊓-mono-≤ x≤y x≤z) ⊓-triangulate : ∀ x y z → x ⊓ y ⊓ z ≈ (x ⊓ y) ⊓ (y ⊓ z) ⊓-triangulate x y z = begin-equality x ⊓ y ⊓ z ≈˘⟨ ⊓-congʳ z (⊓-congˡ x (⊓-idem y)) ⟩ x ⊓ (y ⊓ y) ⊓ z ≈⟨ ⊓-assoc x _ _ ⟩ x ⊓ ((y ⊓ y) ⊓ z) ≈⟨ ⊓-congˡ x (⊓-assoc y y z) ⟩ x ⊓ (y ⊓ (y ⊓ z)) ≈˘⟨ ⊓-assoc x y (y ⊓ z) ⟩ (x ⊓ y) ⊓ (y ⊓ z) ∎ agda-stdlib-1.7.3/src/Algebra/Construct/Subst/000077500000000000000000000000001451211343400211035ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Construct/Subst/Equality.agda000066400000000000000000000162351451211343400235250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Substituting equalities for binary relations ------------------------------------------------------------------------ -- For more general transformations between algebraic structures see -- `Algebra.Morphisms`. {-# OPTIONS --cubical-compatible --safe #-} open import Data.Product as Prod open import Relation.Binary.Core module Algebra.Construct.Subst.Equality {a ℓ₁ ℓ₂} {A : Set a} {≈₁ : Rel A ℓ₁} {≈₂ : Rel A ℓ₂} (equiv@(to , from) : ≈₁ ⇔ ≈₂) where open import Algebra.Definitions open import Algebra.Structures import Data.Sum as Sum open import Function.Base open import Relation.Binary.Construct.Subst.Equality equiv ------------------------------------------------------------------------ -- Definitions cong₁ : ∀ {⁻¹} → Congruent₁ ≈₁ ⁻¹ → Congruent₁ ≈₂ ⁻¹ cong₁ cong x≈y = to (cong (from x≈y)) cong₂ : ∀ {∙} → Congruent₂ ≈₁ ∙ → Congruent₂ ≈₂ ∙ cong₂ cong u≈v x≈y = to (cong (from u≈v) (from x≈y)) assoc : ∀ {∙} → Associative ≈₁ ∙ → Associative ≈₂ ∙ assoc assoc x y z = to (assoc x y z) comm : ∀ {∙} → Commutative ≈₁ ∙ → Commutative ≈₂ ∙ comm comm x y = to (comm x y) idem : ∀ {∙} → Idempotent ≈₁ ∙ → Idempotent ≈₂ ∙ idem idem x = to (idem x) sel : ∀ {∙} → Selective ≈₁ ∙ → Selective ≈₂ ∙ sel sel x y = Sum.map to to (sel x y) identity : ∀ {∙ e} → Identity ≈₁ e ∙ → Identity ≈₂ e ∙ identity = Prod.map (to ∘_) (to ∘_) inverse : ∀ {∙ e ⁻¹} → Inverse ≈₁ ⁻¹ ∙ e → Inverse ≈₂ ⁻¹ ∙ e inverse = Prod.map (to ∘_) (to ∘_) absorptive : ∀ {∙ ◦} → Absorptive ≈₁ ∙ ◦ → Absorptive ≈₂ ∙ ◦ absorptive = Prod.map (λ f x y → to (f x y)) (λ f x y → to (f x y)) distribˡ : ∀ {∙ ◦} → _DistributesOverˡ_ ≈₁ ∙ ◦ → _DistributesOverˡ_ ≈₂ ∙ ◦ distribˡ distribˡ x y z = to (distribˡ x y z) distribʳ : ∀ {∙ ◦} → _DistributesOverʳ_ ≈₁ ∙ ◦ → _DistributesOverʳ_ ≈₂ ∙ ◦ distribʳ distribʳ x y z = to (distribʳ x y z) distrib : ∀ {∙ ◦} → _DistributesOver_ ≈₁ ∙ ◦ → _DistributesOver_ ≈₂ ∙ ◦ distrib {∙} {◦} = Prod.map (distribˡ {∙} {◦}) (distribʳ {∙} {◦}) ------------------------------------------------------------------------ -- Structures isMagma : ∀ {∙} → IsMagma ≈₁ ∙ → IsMagma ≈₂ ∙ isMagma S = record { isEquivalence = isEquivalence S.isEquivalence ; ∙-cong = cong₂ S.∙-cong } where module S = IsMagma S isSemigroup : ∀ {∙} → IsSemigroup ≈₁ ∙ → IsSemigroup ≈₂ ∙ isSemigroup {∙} S = record { isMagma = isMagma S.isMagma ; assoc = assoc {∙} S.assoc } where module S = IsSemigroup S isBand : ∀ {∙} → IsBand ≈₁ ∙ → IsBand ≈₂ ∙ isBand {∙} S = record { isSemigroup = isSemigroup S.isSemigroup ; idem = idem {∙} S.idem } where module S = IsBand S isSemilattice : ∀ {∧} → IsSemilattice ≈₁ ∧ → IsSemilattice ≈₂ ∧ isSemilattice S = record { isBand = isBand S.isBand ; comm = comm S.comm } where module S = IsSemilattice S isSelectiveMagma : ∀ {∙} → IsSelectiveMagma ≈₁ ∙ → IsSelectiveMagma ≈₂ ∙ isSelectiveMagma S = record { isMagma = isMagma S.isMagma ; sel = sel S.sel } where module S = IsSelectiveMagma S isMonoid : ∀ {∙ ε} → IsMonoid ≈₁ ∙ ε → IsMonoid ≈₂ ∙ ε isMonoid S = record { isSemigroup = isSemigroup S.isSemigroup ; identity = Prod.map (to ∘_) (to ∘_) S.identity } where module S = IsMonoid S isCommutativeMonoid : ∀ {∙ ε} → IsCommutativeMonoid ≈₁ ∙ ε → IsCommutativeMonoid ≈₂ ∙ ε isCommutativeMonoid S = record { isMonoid = isMonoid S.isMonoid ; comm = comm S.comm } where module S = IsCommutativeMonoid S isIdempotentCommutativeMonoid : ∀ {∙ ε} → IsIdempotentCommutativeMonoid ≈₁ ∙ ε → IsIdempotentCommutativeMonoid ≈₂ ∙ ε isIdempotentCommutativeMonoid {∙} S = record { isCommutativeMonoid = isCommutativeMonoid S.isCommutativeMonoid ; idem = to ∘ S.idem } where module S = IsIdempotentCommutativeMonoid S isGroup : ∀ {∙ ε ⁻¹} → IsGroup ≈₁ ∙ ε ⁻¹ → IsGroup ≈₂ ∙ ε ⁻¹ isGroup S = record { isMonoid = isMonoid S.isMonoid ; inverse = Prod.map (to ∘_) (to ∘_) S.inverse ; ⁻¹-cong = cong₁ S.⁻¹-cong } where module S = IsGroup S isAbelianGroup : ∀ {∙ ε ⁻¹} → IsAbelianGroup ≈₁ ∙ ε ⁻¹ → IsAbelianGroup ≈₂ ∙ ε ⁻¹ isAbelianGroup S = record { isGroup = isGroup S.isGroup ; comm = comm S.comm } where module S = IsAbelianGroup S isLattice : ∀ {∨ ∧} → IsLattice ≈₁ ∨ ∧ → IsLattice ≈₂ ∨ ∧ isLattice {∨} {∧} S = record { isEquivalence = isEquivalence S.isEquivalence ; ∨-comm = comm S.∨-comm ; ∨-assoc = assoc {∨} S.∨-assoc ; ∨-cong = cong₂ S.∨-cong ; ∧-comm = comm S.∧-comm ; ∧-assoc = assoc {∧} S.∧-assoc ; ∧-cong = cong₂ S.∧-cong ; absorptive = absorptive {∨} {∧} S.absorptive } where module S = IsLattice S isDistributiveLattice : ∀ {∨ ∧} → IsDistributiveLattice ≈₁ ∨ ∧ → IsDistributiveLattice ≈₂ ∨ ∧ isDistributiveLattice S = record { isLattice = isLattice S.isLattice ; ∨-distribʳ-∧ = λ x y z → to (S.∨-distribʳ-∧ x y z) } where module S = IsDistributiveLattice S isBooleanAlgebra : ∀ {∨ ∧ ¬ ⊤ ⊥} → IsBooleanAlgebra ≈₁ ∨ ∧ ¬ ⊤ ⊥ → IsBooleanAlgebra ≈₂ ∨ ∧ ¬ ⊤ ⊥ isBooleanAlgebra S = record { isDistributiveLattice = isDistributiveLattice S.isDistributiveLattice ; ∨-complementʳ = to ∘ S.∨-complementʳ ; ∧-complementʳ = to ∘ S.∧-complementʳ ; ¬-cong = cong₁ S.¬-cong } where module S = IsBooleanAlgebra S isNearSemiring : ∀ {+ * 0#} → IsNearSemiring ≈₁ + * 0# → IsNearSemiring ≈₂ + * 0# isNearSemiring S = record { +-isMonoid = isMonoid S.+-isMonoid ; *-isSemigroup = isSemigroup S.*-isSemigroup ; distribʳ = λ x y z → to (S.distribʳ x y z) ; zeroˡ = to ∘ S.zeroˡ } where module S = IsNearSemiring S isSemiringWithoutOne : ∀ {+ * 0#} → IsSemiringWithoutOne ≈₁ + * 0# → IsSemiringWithoutOne ≈₂ + * 0# isSemiringWithoutOne {+} {*} S = record { +-isCommutativeMonoid = isCommutativeMonoid S.+-isCommutativeMonoid ; *-isSemigroup = isSemigroup S.*-isSemigroup ; distrib = distrib {*} {+} S.distrib ; zero = Prod.map (to ∘_) (to ∘_) S.zero } where module S = IsSemiringWithoutOne S isCommutativeSemiringWithoutOne : ∀ {+ * 0#} → IsCommutativeSemiringWithoutOne ≈₁ + * 0# → IsCommutativeSemiringWithoutOne ≈₂ + * 0# isCommutativeSemiringWithoutOne S = record { isSemiringWithoutOne = isSemiringWithoutOne S.isSemiringWithoutOne ; *-comm = comm S.*-comm } where module S = IsCommutativeSemiringWithoutOne S agda-stdlib-1.7.3/src/Algebra/Construct/Zero.agda000066400000000000000000000042511451211343400215420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances of algebraic structures where the carrier is ⊤. -- In mathematics, this is usually called 0. -- -- From monoids up, these are are zero-objects – i.e, both the initial -- and the terminal object in the relevant category. -- For structures without an identity element, we can't necessarily -- produce a homomorphism out of 0, because there is an instance of such -- a structure with an empty Carrier. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level using (Level) module Algebra.Construct.Zero {c ℓ : Level} where open import Algebra.Bundles open import Data.Unit.Polymorphic ------------------------------------------------------------------------ -- Raw bundles rawMagma : RawMagma c ℓ rawMagma = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } rawMonoid : RawMonoid c ℓ rawMonoid = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } rawGroup : RawGroup c ℓ rawGroup = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } ------------------------------------------------------------------------ -- Bundles magma : Magma c ℓ magma = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } semigroup : Semigroup c ℓ semigroup = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } band : Band c ℓ band = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } commutativeSemigroup : CommutativeSemigroup c ℓ commutativeSemigroup = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } semilattice : Semilattice c ℓ semilattice = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } monoid : Monoid c ℓ monoid = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } commutativeMonoid : CommutativeMonoid c ℓ commutativeMonoid = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } idempotentCommutativeMonoid : IdempotentCommutativeMonoid c ℓ idempotentCommutativeMonoid = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } group : Group c ℓ group = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } abelianGroup : AbelianGroup c ℓ abelianGroup = record { Carrier = ⊤ ; _≈_ = λ _ _ → ⊤ } agda-stdlib-1.7.3/src/Algebra/Core.agda000066400000000000000000000015561451211343400175340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Core algebraic definitions ------------------------------------------------------------------------ -- The contents of this module should be accessed via `Algebra`. {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Core where open import Level using (_⊔_) ------------------------------------------------------------------------ -- Unary and binary operations Op₁ : ∀ {ℓ} → Set ℓ → Set ℓ Op₁ A = A → A Op₂ : ∀ {ℓ} → Set ℓ → Set ℓ Op₂ A = A → A → A ------------------------------------------------------------------------ -- Left and right actions Opₗ : ∀ {a b} → Set a → Set b → Set (a ⊔ b) Opₗ A B = A → B → B Opᵣ : ∀ {a b} → Set a → Set b → Set (a ⊔ b) Opᵣ A B = B → A → B agda-stdlib-1.7.3/src/Algebra/Definitions.agda000066400000000000000000000106361451211343400211160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of functions, such as associativity and commutativity ------------------------------------------------------------------------ -- The contents of this module should be accessed via `Algebra`, unless -- you want to parameterise it via the equality relation. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary.Core open import Relation.Nullary using (¬_) module Algebra.Definitions {a ℓ} {A : Set a} -- The underlying set (_≈_ : Rel A ℓ) -- The underlying equality where open import Algebra.Core open import Data.Product open import Data.Sum.Base ------------------------------------------------------------------------ -- Properties of operations Congruent₁ : Op₁ A → Set _ Congruent₁ f = f Preserves _≈_ ⟶ _≈_ Congruent₂ : Op₂ A → Set _ Congruent₂ ∙ = ∙ Preserves₂ _≈_ ⟶ _≈_ ⟶ _≈_ LeftCongruent : Op₂ A → Set _ LeftCongruent _∙_ = ∀ {x} → (x ∙_) Preserves _≈_ ⟶ _≈_ RightCongruent : Op₂ A → Set _ RightCongruent _∙_ = ∀ {x} → (_∙ x) Preserves _≈_ ⟶ _≈_ Associative : Op₂ A → Set _ Associative _∙_ = ∀ x y z → ((x ∙ y) ∙ z) ≈ (x ∙ (y ∙ z)) Commutative : Op₂ A → Set _ Commutative _∙_ = ∀ x y → (x ∙ y) ≈ (y ∙ x) LeftIdentity : A → Op₂ A → Set _ LeftIdentity e _∙_ = ∀ x → (e ∙ x) ≈ x RightIdentity : A → Op₂ A → Set _ RightIdentity e _∙_ = ∀ x → (x ∙ e) ≈ x Identity : A → Op₂ A → Set _ Identity e ∙ = (LeftIdentity e ∙) × (RightIdentity e ∙) LeftZero : A → Op₂ A → Set _ LeftZero z _∙_ = ∀ x → (z ∙ x) ≈ z RightZero : A → Op₂ A → Set _ RightZero z _∙_ = ∀ x → (x ∙ z) ≈ z Zero : A → Op₂ A → Set _ Zero z ∙ = (LeftZero z ∙) × (RightZero z ∙) LeftInverse : A → Op₁ A → Op₂ A → Set _ LeftInverse e _⁻¹ _∙_ = ∀ x → ((x ⁻¹) ∙ x) ≈ e RightInverse : A → Op₁ A → Op₂ A → Set _ RightInverse e _⁻¹ _∙_ = ∀ x → (x ∙ (x ⁻¹)) ≈ e Inverse : A → Op₁ A → Op₂ A → Set _ Inverse e ⁻¹ ∙ = (LeftInverse e ⁻¹) ∙ × (RightInverse e ⁻¹ ∙) LeftConical : A → Op₂ A → Set _ LeftConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → x ≈ e RightConical : A → Op₂ A → Set _ RightConical e _∙_ = ∀ x y → (x ∙ y) ≈ e → y ≈ e Conical : A → Op₂ A → Set _ Conical e ∙ = (LeftConical e ∙) × (RightConical e ∙) _DistributesOverˡ_ : Op₂ A → Op₂ A → Set _ _*_ DistributesOverˡ _+_ = ∀ x y z → (x * (y + z)) ≈ ((x * y) + (x * z)) _DistributesOverʳ_ : Op₂ A → Op₂ A → Set _ _*_ DistributesOverʳ _+_ = ∀ x y z → ((y + z) * x) ≈ ((y * x) + (z * x)) _DistributesOver_ : Op₂ A → Op₂ A → Set _ * DistributesOver + = (* DistributesOverˡ +) × (* DistributesOverʳ +) _IdempotentOn_ : Op₂ A → A → Set _ _∙_ IdempotentOn x = (x ∙ x) ≈ x Idempotent : Op₂ A → Set _ Idempotent ∙ = ∀ x → ∙ IdempotentOn x IdempotentFun : Op₁ A → Set _ IdempotentFun f = ∀ x → f (f x) ≈ f x Selective : Op₂ A → Set _ Selective _∙_ = ∀ x y → (x ∙ y) ≈ x ⊎ (x ∙ y) ≈ y _Absorbs_ : Op₂ A → Op₂ A → Set _ _∙_ Absorbs _∘_ = ∀ x y → (x ∙ (x ∘ y)) ≈ x Absorptive : Op₂ A → Op₂ A → Set _ Absorptive ∙ ∘ = (∙ Absorbs ∘) × (∘ Absorbs ∙) Involutive : Op₁ A → Set _ Involutive f = ∀ x → f (f x) ≈ x LeftCancellative : Op₂ A → Set _ LeftCancellative _•_ = ∀ x {y z} → (x • y) ≈ (x • z) → y ≈ z RightCancellative : Op₂ A → Set _ RightCancellative _•_ = ∀ {x} y z → (y • x) ≈ (z • x) → y ≈ z Cancellative : Op₂ A → Set _ Cancellative _•_ = (LeftCancellative _•_) × (RightCancellative _•_) AlmostLeftCancellative : A → Op₂ A → Set _ AlmostLeftCancellative e _•_ = ∀ {x} y z → ¬ x ≈ e → (x • y) ≈ (x • z) → y ≈ z AlmostRightCancellative : A → Op₂ A → Set _ AlmostRightCancellative e _•_ = ∀ {x} y z → ¬ x ≈ e → (y • x) ≈ (z • x) → y ≈ z AlmostCancellative : A → Op₂ A → Set _ AlmostCancellative e _•_ = AlmostLeftCancellative e _•_ × AlmostRightCancellative e _•_ Interchangable : Op₂ A → Op₂ A → Set _ Interchangable _∘_ _∙_ = ∀ w x y z → ((w ∙ x) ∘ (y ∙ z)) ≈ ((w ∘ y) ∙ (x ∘ z)) agda-stdlib-1.7.3/src/Algebra/Definitions/000077500000000000000000000000001451211343400202725ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Definitions/RawMagma.agda000066400000000000000000000040401451211343400226020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic auxiliary definitions for magma-like structures ------------------------------------------------------------------------ -- You're unlikely to want to use this module directly. Instead you -- probably want to be importing the appropriate module from -- `Algebra.Properties.(Magma/Semigroup/...).Divisibility` {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (RawMagma) open import Data.Product using (_×_; ∃) open import Level using (_⊔_) open import Relation.Binary.Core open import Relation.Nullary using (¬_) module Algebra.Definitions.RawMagma {a ℓ} (M : RawMagma a ℓ) where open RawMagma M renaming (Carrier to A) ------------------------------------------------------------------------ -- Divisibility infix 5 _∣ˡ_ _∤ˡ_ _∣ʳ_ _∤ʳ_ _∣_ _∤_ -- Divisibility from the left _∣ˡ_ : Rel A (a ⊔ ℓ) x ∣ˡ y = ∃ λ q → (x ∙ q) ≈ y _∤ˡ_ : Rel A (a ⊔ ℓ) x ∤ˡ y = ¬ x ∣ˡ y -- Divisibility from the right _∣ʳ_ : Rel A (a ⊔ ℓ) x ∣ʳ y = ∃ λ q → (q ∙ x) ≈ y _∤ʳ_ : Rel A (a ⊔ ℓ) x ∤ʳ y = ¬ x ∣ʳ y -- General divisibility -- The relations _∣ˡ_ and _∣ʳ_ are only equivalent when _∙_ is -- commutative. When that is not the case we take `_∣ʳ_` to be the -- primary one. _∣_ : Rel A (a ⊔ ℓ) _∣_ = _∣ʳ_ _∤_ : Rel A (a ⊔ ℓ) x ∤ y = ¬ x ∣ y ------------------------------------------------------------------------ -- Mutual divisibility. -- In a monoid, this is an equivalence relation extending _≈_. -- When in a cancellative monoid, elements related by _∣∣_ are called -- associated, and `x ∣∣ y` means that `x` and `y` differ by some -- invertible factor. -- Example: for ℕ this is equivalent to x ≡ y, -- for ℤ this is equivalent to (x ≡ y or x ≡ - y). _∣∣_ : Rel A (a ⊔ ℓ) x ∣∣ y = x ∣ y × y ∣ x _∤∤_ : Rel A (a ⊔ ℓ) x ∤∤ y = ¬ x ∣∣ y agda-stdlib-1.7.3/src/Algebra/Definitions/RawMonoid.agda000066400000000000000000000042701451211343400230120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic auxiliary definitions for monoid-like structures ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (RawMonoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc) open import Data.Vec.Functional as Vector using (Vector) module Algebra.Definitions.RawMonoid {a ℓ} (M : RawMonoid a ℓ) where open RawMonoid M renaming ( _∙_ to _+_ ; ε to 0# ) ------------------------------------------------------------------------ -- Re-export definitions over a magma ------------------------------------------------------------------------ open import Algebra.Definitions.RawMagma rawMagma public ------------------------------------------------------------------------ -- Multiplication by natural number ------------------------------------------------------------------------ -- Standard definition -- A simple definition, easy to use and prove properties about. infixr 8 _×_ _×_ : ℕ → Carrier → Carrier 0 × x = 0# suc n × x = x + (n × x) ------------------------------------------------------------------------ -- Type-checking optimised definition -- For use in code where high performance at type-checking time is -- important, e.g. solvers and tactics. Firstly it avoids unnecessarily -- multiplying by the unit if possible, speeding up type-checking and -- makes for much more readable proofs: -- -- Standard definition: x * 2 = x + x + 0# -- Optimised definition: x * 2 = x + x -- -- Secondly, associates to the left which, counterintuitive as it may -- seem, also speeds up typechecking. -- -- Standard definition: x * 3 = x + (x + (x + 0#)) -- Our definition: x * 3 = (x + x) + x infixl 8 _×′_ _×′_ : ℕ → Carrier → Carrier 0 ×′ x = 0# 1 ×′ x = x suc n ×′ x = n ×′ x + x {-# INLINE _×′_ #-} ------------------------------------------------------------------------ -- Summation ------------------------------------------------------------------------ sum : ∀ {n} → Vector Carrier n → Carrier sum = Vector.foldr _+_ 0# agda-stdlib-1.7.3/src/Algebra/Definitions/RawSemiring.agda000066400000000000000000000036651451211343400233510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic auxiliary definitions for semiring-like structures ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (RawSemiring) open import Data.Sum.Base using (_⊎_) open import Data.Nat using (ℕ) open import Level using (_⊔_) open import Relation.Binary.Core using (Rel) module Algebra.Definitions.RawSemiring {a ℓ} (M : RawSemiring a ℓ) where open RawSemiring M renaming (Carrier to A) ------------------------------------------------------------------------ -- Definitions over _+_ open import Algebra.Definitions.RawMonoid +-rawMonoid public using ( _×_ -- : ℕ → A → A ; _×′_ -- : ℕ → A → A ; sum -- : Vector A n → A ) ------------------------------------------------------------------------ -- Definitions over _*_ open import Algebra.Definitions.RawMonoid *-rawMonoid as Mult public using ( _∣_ ; _∤_ ) renaming ( sum to product ) -- Unlike `sum` to `product`, can't simply rename multiplication to -- exponentation as the argument order is reversed. -- Standard exponentiation infixr 8 _^_ _^_ : A → ℕ → A x ^ n = n Mult.× x -- Exponentiation optimsed for type-checking infixr 8 _^′_ _^′_ : A → ℕ → A x ^′ n = n Mult.×′ x {-# INLINE _^′_ #-} ------------------------------------------------------------------------ -- Primality Coprime : Rel A (a ⊔ ℓ) Coprime x y = ∀ {z} → z ∣ x → z ∣ y → z ∣ 1# record Irreducible (p : A) : Set (a ⊔ ℓ) where constructor mkIrred field p∤1 : p ∤ 1# split-∣1 : ∀ {x y} → p ≈ (x * y) → x ∣ 1# ⊎ y ∣ 1# record Prime (p : A) : Set (a ⊔ ℓ) where constructor mkPrime field p≉0 : p ≉ 0# split-∣ : ∀ {x y} → p ∣ x * y → p ∣ x ⊎ p ∣ y agda-stdlib-1.7.3/src/Algebra/FunctionProperties.agda000066400000000000000000000011651451211343400225020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Algebra` or -- `Algebra.Definitions` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary.Core using (Rel) module Algebra.FunctionProperties {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) where {-# WARNING_ON_IMPORT "Algebra.FunctionProperties was deprecated in v1.2. Use Algebra.Definitions instead." #-} open import Algebra.Core public open import Algebra.Definitions _≈_ public agda-stdlib-1.7.3/src/Algebra/FunctionProperties/000077500000000000000000000000001451211343400216615ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/FunctionProperties/Consequences.agda000066400000000000000000000011311451211343400251260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; Substitutive; Symmetric; Total) module Algebra.FunctionProperties.Consequences {a ℓ} (S : Setoid a ℓ) where {-# WARNING_ON_IMPORT "Algebra.FunctionProperties.Consequences was deprecated in v1.3. Use Algebra.Consequences.Setoid instead." #-} open import Algebra.Consequences.Setoid S public agda-stdlib-1.7.3/src/Algebra/FunctionProperties/Consequences/000077500000000000000000000000001451211343400243145ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/FunctionProperties/Consequences/Core.agda000066400000000000000000000010011451211343400260120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.FunctionProperties.Consequences.Core {a} {A : Set a} where {-# WARNING_ON_IMPORT "Algebra.FunctionProperties.Consequences.Core was deprecated in v1.3. Use Algebra.Consequences.Base instead." #-} open import Algebra.Consequences.Base public agda-stdlib-1.7.3/src/Algebra/FunctionProperties/Consequences/Propositional.agda000066400000000000000000000010551451211343400277750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.FunctionProperties.Consequences.Propositional {a} {A : Set a} where {-# WARNING_ON_IMPORT "Algebra.FunctionProperties.Consequences.Propositional was deprecated in v1.3. Use Algebra.Consequences.Propositional instead." #-} open import Algebra.Consequences.Propositional {A = A} public agda-stdlib-1.7.3/src/Algebra/FunctionProperties/Core.agda000066400000000000000000000007561451211343400233770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Algebra` or `Algebra.Core` -- instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.FunctionProperties.Core where {-# WARNING_ON_IMPORT "Algebra.FunctionProperties.Core was deprecated in v1.2. Use Algebra.Core instead." #-} open import Algebra.Core public agda-stdlib-1.7.3/src/Algebra/Module/000077500000000000000000000000001451211343400172445ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Module/Bundles.agda000066400000000000000000000247511451211343400214670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Definitions of algebraic structures defined over some other -- structure, like modules and vector spaces -- -- Terminology of bundles: -- * There are both *semimodules* and *modules*. -- - For M an R-semimodule, R is a semiring, and M forms a commutative -- monoid. -- - For M an R-module, R is a ring, and M forms an Abelian group. -- * There are all four of *left modules*, *right modules*, *bimodules*, -- and *modules*. -- - Left modules have a left-scaling operation. -- - Right modules have a right-scaling operation. -- - Bimodules have two sorts of scalars. Left-scaling handles one and -- right-scaling handles the other. Left-scaling and right-scaling -- are furthermore compatible. -- - Modules are bimodules with a single sort of scalars and scalar -- multiplication must also be commutative. Left-scaling and -- right-scaling coincide. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Module.Bundles where open import Algebra.Bundles open import Algebra.Core open import Algebra.Module.Structures open import Algebra.Module.Definitions open import Function.Base open import Level open import Relation.Binary import Relation.Binary.Reasoning.Setoid as SetR private variable r ℓr s ℓs : Level ------------------------------------------------------------------------ -- Left modules ------------------------------------------------------------------------ record LeftSemimodule (semiring : Semiring r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open Semiring semiring infixr 7 _*ₗ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ Carrier Carrierᴹ 0ᴹ : Carrierᴹ isLeftSemimodule : IsLeftSemimodule semiring _≈ᴹ_ _+ᴹ_ 0ᴹ _*ₗ_ open IsLeftSemimodule isLeftSemimodule public +ᴹ-commutativeMonoid : CommutativeMonoid m ℓm +ᴹ-commutativeMonoid = record { isCommutativeMonoid = +ᴹ-isCommutativeMonoid } open CommutativeMonoid +ᴹ-commutativeMonoid public using () renaming ( monoid to +ᴹ-monoid ; semigroup to +ᴹ-semigroup ; magma to +ᴹ-magma ; rawMagma to +ᴹ-rawMagma ; rawMonoid to +ᴹ-rawMonoid ) record LeftModule (ring : Ring r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open Ring ring infixr 8 -ᴹ_ infixr 7 _*ₗ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ Carrier Carrierᴹ 0ᴹ : Carrierᴹ -ᴹ_ : Op₁ Carrierᴹ isLeftModule : IsLeftModule ring _≈ᴹ_ _+ᴹ_ 0ᴹ -ᴹ_ _*ₗ_ open IsLeftModule isLeftModule public leftSemimodule : LeftSemimodule semiring m ℓm leftSemimodule = record { isLeftSemimodule = isLeftSemimodule } open LeftSemimodule leftSemimodule public using ( +ᴹ-commutativeMonoid; +ᴹ-monoid; +ᴹ-semigroup; +ᴹ-magma ; +ᴹ-rawMagma; +ᴹ-rawMonoid) +ᴹ-abelianGroup : AbelianGroup m ℓm +ᴹ-abelianGroup = record { isAbelianGroup = +ᴹ-isAbelianGroup } open AbelianGroup +ᴹ-abelianGroup public using () renaming (group to +ᴹ-group) ------------------------------------------------------------------------ -- Right modules ------------------------------------------------------------------------ record RightSemimodule (semiring : Semiring r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open Semiring semiring infixl 7 _*ᵣ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ᵣ_ : Opᵣ Carrier Carrierᴹ 0ᴹ : Carrierᴹ isRightSemimodule : IsRightSemimodule semiring _≈ᴹ_ _+ᴹ_ 0ᴹ _*ᵣ_ open IsRightSemimodule isRightSemimodule public +ᴹ-commutativeMonoid : CommutativeMonoid m ℓm +ᴹ-commutativeMonoid = record { isCommutativeMonoid = +ᴹ-isCommutativeMonoid } open CommutativeMonoid +ᴹ-commutativeMonoid public using () renaming ( monoid to +ᴹ-monoid ; semigroup to +ᴹ-semigroup ; magma to +ᴹ-magma ; rawMagma to +ᴹ-rawMagma ; rawMonoid to +ᴹ-rawMonoid ) record RightModule (ring : Ring r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open Ring ring infixr 8 -ᴹ_ infixl 7 _*ᵣ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ᵣ_ : Opᵣ Carrier Carrierᴹ 0ᴹ : Carrierᴹ -ᴹ_ : Op₁ Carrierᴹ isRightModule : IsRightModule ring _≈ᴹ_ _+ᴹ_ 0ᴹ -ᴹ_ _*ᵣ_ open IsRightModule isRightModule public rightSemimodule : RightSemimodule semiring m ℓm rightSemimodule = record { isRightSemimodule = isRightSemimodule } open RightSemimodule rightSemimodule public using ( +ᴹ-commutativeMonoid; +ᴹ-monoid; +ᴹ-semigroup; +ᴹ-magma ; +ᴹ-rawMagma; +ᴹ-rawMonoid) +ᴹ-abelianGroup : AbelianGroup m ℓm +ᴹ-abelianGroup = record { isAbelianGroup = +ᴹ-isAbelianGroup } open AbelianGroup +ᴹ-abelianGroup public using () renaming (group to +ᴹ-group) ------------------------------------------------------------------------ -- Bimodules ------------------------------------------------------------------------ record Bisemimodule (R-semiring : Semiring r ℓr) (S-semiring : Semiring s ℓs) m ℓm : Set (r ⊔ s ⊔ ℓr ⊔ ℓs ⊔ suc (m ⊔ ℓm)) where private module R = Semiring R-semiring module S = Semiring S-semiring infixr 7 _*ₗ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ R.Carrier Carrierᴹ _*ᵣ_ : Opᵣ S.Carrier Carrierᴹ 0ᴹ : Carrierᴹ isBisemimodule : IsBisemimodule R-semiring S-semiring _≈ᴹ_ _+ᴹ_ 0ᴹ _*ₗ_ _*ᵣ_ open IsBisemimodule isBisemimodule public leftSemimodule : LeftSemimodule R-semiring m ℓm leftSemimodule = record { isLeftSemimodule = isLeftSemimodule } rightSemimodule : RightSemimodule S-semiring m ℓm rightSemimodule = record { isRightSemimodule = isRightSemimodule } open LeftSemimodule leftSemimodule public using ( +ᴹ-commutativeMonoid; +ᴹ-monoid; +ᴹ-semigroup; +ᴹ-magma; +ᴹ-rawMagma ; +ᴹ-rawMonoid) record Bimodule (R-ring : Ring r ℓr) (S-ring : Ring s ℓs) m ℓm : Set (r ⊔ s ⊔ ℓr ⊔ ℓs ⊔ suc (m ⊔ ℓm)) where private module R = Ring R-ring module S = Ring S-ring infixr 7 _*ₗ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ R.Carrier Carrierᴹ _*ᵣ_ : Opᵣ S.Carrier Carrierᴹ 0ᴹ : Carrierᴹ -ᴹ_ : Op₁ Carrierᴹ isBimodule : IsBimodule R-ring S-ring _≈ᴹ_ _+ᴹ_ 0ᴹ -ᴹ_ _*ₗ_ _*ᵣ_ open IsBimodule isBimodule public leftModule : LeftModule R-ring m ℓm leftModule = record { isLeftModule = isLeftModule } rightModule : RightModule S-ring m ℓm rightModule = record { isRightModule = isRightModule } open LeftModule leftModule public using ( +ᴹ-abelianGroup; +ᴹ-commutativeMonoid; +ᴹ-group; +ᴹ-monoid ; +ᴹ-semigroup; +ᴹ-magma; +ᴹ-rawMagma; +ᴹ-rawMonoid) bisemimodule : Bisemimodule R.semiring S.semiring m ℓm bisemimodule = record { isBisemimodule = isBisemimodule } open Bisemimodule bisemimodule public using (leftSemimodule; rightSemimodule) ------------------------------------------------------------------------ -- Modules over commutative structures ------------------------------------------------------------------------ record Semimodule (commutativeSemiring : CommutativeSemiring r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open CommutativeSemiring commutativeSemiring infixr 7 _*ₗ_ infixl 7 _*ᵣ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ Carrier Carrierᴹ _*ᵣ_ : Opᵣ Carrier Carrierᴹ 0ᴹ : Carrierᴹ isSemimodule : IsSemimodule commutativeSemiring _≈ᴹ_ _+ᴹ_ 0ᴹ _*ₗ_ _*ᵣ_ open IsSemimodule isSemimodule public private module L = LeftDefs Carrier _≈ᴹ_ module R = RightDefs Carrier _≈ᴹ_ bisemimodule : Bisemimodule semiring semiring m ℓm bisemimodule = record { isBisemimodule = isBisemimodule } open Bisemimodule bisemimodule public using ( leftSemimodule; rightSemimodule ; +ᴹ-commutativeMonoid; +ᴹ-monoid; +ᴹ-semigroup; +ᴹ-magma ; +ᴹ-rawMagma; +ᴹ-rawMonoid) open SetR ≈ᴹ-setoid *ₗ-comm : L.Commutative _*ₗ_ *ₗ-comm x y m = begin x *ₗ y *ₗ m ≈⟨ ≈ᴹ-sym (*ₗ-assoc x y m) ⟩ (x * y) *ₗ m ≈⟨ *ₗ-cong (*-comm _ _) ≈ᴹ-refl ⟩ (y * x) *ₗ m ≈⟨ *ₗ-assoc y x m ⟩ y *ₗ x *ₗ m ∎ *ᵣ-comm : R.Commutative _*ᵣ_ *ᵣ-comm m x y = begin m *ᵣ x *ᵣ y ≈⟨ *ᵣ-assoc m x y ⟩ m *ᵣ (x * y) ≈⟨ *ᵣ-cong ≈ᴹ-refl (*-comm _ _) ⟩ m *ᵣ (y * x) ≈⟨ ≈ᴹ-sym (*ᵣ-assoc m y x) ⟩ m *ᵣ y *ᵣ x ∎ record Module (commutativeRing : CommutativeRing r ℓr) m ℓm : Set (r ⊔ ℓr ⊔ suc (m ⊔ ℓm)) where open CommutativeRing commutativeRing infixr 8 -ᴹ_ infixr 7 _*ₗ_ infixl 6 _+ᴹ_ infix 4 _≈ᴹ_ field Carrierᴹ : Set m _≈ᴹ_ : Rel Carrierᴹ ℓm _+ᴹ_ : Op₂ Carrierᴹ _*ₗ_ : Opₗ Carrier Carrierᴹ _*ᵣ_ : Opᵣ Carrier Carrierᴹ 0ᴹ : Carrierᴹ -ᴹ_ : Op₁ Carrierᴹ isModule : IsModule commutativeRing _≈ᴹ_ _+ᴹ_ 0ᴹ -ᴹ_ _*ₗ_ _*ᵣ_ open IsModule isModule public bimodule : Bimodule ring ring m ℓm bimodule = record { isBimodule = isBimodule } open Bimodule bimodule public using ( leftModule; rightModule; leftSemimodule; rightSemimodule ; +ᴹ-abelianGroup; +ᴹ-group; +ᴹ-commutativeMonoid; +ᴹ-monoid ; +ᴹ-semigroup; +ᴹ-magma ; +ᴹ-rawMonoid; +ᴹ-rawMagma) semimodule : Semimodule commutativeSemiring m ℓm semimodule = record { isSemimodule = isSemimodule } open Semimodule semimodule public using (*ₗ-comm; *ᵣ-comm) agda-stdlib-1.7.3/src/Algebra/Module/Consequences.agda000066400000000000000000000060561451211343400225240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Relations between properties of scaling and other operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Module.Consequences where open import Algebra.Core using (Op₂; Opₗ; Opᵣ) import Algebra.Definitions as Defs open import Algebra.Module.Definitions open import Function.Base using (flip) open import Level using (Level) open import Relation.Binary using (Rel; Setoid) import Relation.Binary.Reasoning.Setoid as Rea private variable a b c ℓ ℓa : Level A : Set a B : Set b module _ (_≈ᴬ_ : Rel {a} A ℓa) (S : Setoid c ℓ) where open Setoid S open Rea S open Defs _≈ᴬ_ private module L = LeftDefs A _≈_ module R = RightDefs A _≈_ module B = BiDefs A A _≈_ module _ {_*_ : Op₂ A} {_*ₗ_ : Opₗ A Carrier} where private _*ᵣ_ = flip _*ₗ_ *ₗ-assoc+comm⇒*ᵣ-assoc : L.RightCongruent _≈ᴬ_ _*ₗ_ → L.Associative _*_ _*ₗ_ → Commutative _*_ → R.Associative _*_ _*ᵣ_ *ₗ-assoc+comm⇒*ᵣ-assoc *ₗ-congʳ *ₗ-assoc *-comm m x y = begin (m *ᵣ x) *ᵣ y ≈⟨ refl ⟩ y *ₗ (x *ₗ m) ≈˘⟨ *ₗ-assoc _ _ _ ⟩ (y * x) *ₗ m ≈⟨ *ₗ-congʳ (*-comm y x) ⟩ (x * y) *ₗ m ≈⟨ refl ⟩ m *ᵣ (x * y) ∎ *ₗ-assoc+comm⇒*ₗ-*ᵣ-assoc : L.RightCongruent _≈ᴬ_ _*ₗ_ → L.Associative _*_ _*ₗ_ → Commutative _*_ → B.Associative _*ₗ_ _*ᵣ_ *ₗ-assoc+comm⇒*ₗ-*ᵣ-assoc *ₗ-congʳ *ₗ-assoc *-comm x m y = begin ((x *ₗ m) *ᵣ y) ≈⟨ refl ⟩ (y *ₗ (x *ₗ m)) ≈˘⟨ *ₗ-assoc _ _ _ ⟩ ((y * x) *ₗ m) ≈⟨ *ₗ-congʳ (*-comm y x) ⟩ ((x * y) *ₗ m) ≈⟨ *ₗ-assoc _ _ _ ⟩ (x *ₗ (y *ₗ m)) ≈⟨ refl ⟩ (x *ₗ (m *ᵣ y)) ∎ module _ {_*_ : Op₂ A} {_*ᵣ_ : Opᵣ A Carrier} where private _*ₗ_ = flip _*ᵣ_ *ᵣ-assoc+comm⇒*ₗ-assoc : R.LeftCongruent _≈ᴬ_ _*ᵣ_ → R.Associative _*_ _*ᵣ_ → Commutative _*_ → L.Associative _*_ _*ₗ_ *ᵣ-assoc+comm⇒*ₗ-assoc *ᵣ-congˡ *ᵣ-assoc *-comm x y m = begin ((x * y) *ₗ m) ≈⟨ refl ⟩ (m *ᵣ (x * y)) ≈⟨ *ᵣ-congˡ (*-comm x y) ⟩ (m *ᵣ (y * x)) ≈˘⟨ *ᵣ-assoc _ _ _ ⟩ ((m *ᵣ y) *ᵣ x) ≈⟨ refl ⟩ (x *ₗ (y *ₗ m)) ∎ *ᵣ-assoc+comm⇒*ₗ-*ᵣ-assoc : R.LeftCongruent _≈ᴬ_ _*ᵣ_ → R.Associative _*_ _*ᵣ_ → Commutative _*_ → B.Associative _*ₗ_ _*ᵣ_ *ᵣ-assoc+comm⇒*ₗ-*ᵣ-assoc *ᵣ-congˡ *ᵣ-assoc *-comm x m y = begin ((x *ₗ m) *ᵣ y) ≈⟨ refl ⟩ ((m *ᵣ x) *ᵣ y) ≈⟨ *ᵣ-assoc _ _ _ ⟩ (m *ᵣ (x * y)) ≈⟨ *ᵣ-congˡ (*-comm x y) ⟩ (m *ᵣ (y * x)) ≈˘⟨ *ᵣ-assoc _ _ _ ⟩ ((m *ᵣ y) *ᵣ x) ≈⟨ refl ⟩ (x *ₗ (m *ᵣ y)) ∎ agda-stdlib-1.7.3/src/Algebra/Module/Construct/000077500000000000000000000000001451211343400212305ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Module/Construct/DirectProduct.agda000066400000000000000000000155041451211343400246260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module constructs the biproduct of two R-modules, and similar -- for weaker module-like structures. -- The intended universal property is that the biproduct is both a -- product and a coproduct in the category of R-modules. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Module.Construct.DirectProduct where open import Algebra.Bundles open import Algebra.Construct.DirectProduct open import Algebra.Module.Bundles open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Level private variable r s ℓr ℓs m m′ ℓm ℓm′ : Level ------------------------------------------------------------------------ -- Bundles leftSemimodule : {R : Semiring r ℓr} → LeftSemimodule R m ℓm → LeftSemimodule R m′ ℓm′ → LeftSemimodule R (m ⊔ m′) (ℓm ⊔ ℓm′) leftSemimodule M N = record { _*ₗ_ = λ r → map (r M.*ₗ_) (r N.*ₗ_) ; isLeftSemimodule = record { +ᴹ-isCommutativeMonoid = CommutativeMonoid.isCommutativeMonoid (commutativeMonoid M.+ᴹ-commutativeMonoid N.+ᴹ-commutativeMonoid) ; isPreleftSemimodule = record { *ₗ-cong = λ where rr (mm , nn) → M.*ₗ-cong rr mm , N.*ₗ-cong rr nn ; *ₗ-zeroˡ = λ where (m , n) → M.*ₗ-zeroˡ m , N.*ₗ-zeroˡ n ; *ₗ-distribʳ = λ where (m , n) x y → M.*ₗ-distribʳ m x y , N.*ₗ-distribʳ n x y ; *ₗ-identityˡ = λ where (m , n) → M.*ₗ-identityˡ m , N.*ₗ-identityˡ n ; *ₗ-assoc = λ where x y (m , n) → M.*ₗ-assoc x y m , N.*ₗ-assoc x y n ; *ₗ-zeroʳ = λ x → M.*ₗ-zeroʳ x , N.*ₗ-zeroʳ x ; *ₗ-distribˡ = λ where x (m , n) (m′ , n′) → M.*ₗ-distribˡ x m m′ , N.*ₗ-distribˡ x n n′ } } } where module M = LeftSemimodule M; module N = LeftSemimodule N rightSemimodule : {R : Semiring r ℓr} → RightSemimodule R m ℓm → RightSemimodule R m′ ℓm′ → RightSemimodule R (m ⊔ m′) (ℓm ⊔ ℓm′) rightSemimodule M N = record { _*ᵣ_ = λ mn r → map (M._*ᵣ r) (N._*ᵣ r) mn ; isRightSemimodule = record { +ᴹ-isCommutativeMonoid = CommutativeMonoid.isCommutativeMonoid (commutativeMonoid M.+ᴹ-commutativeMonoid N.+ᴹ-commutativeMonoid) ; isPrerightSemimodule = record { *ᵣ-cong = λ where (mm , nn) rr → M.*ᵣ-cong mm rr , N.*ᵣ-cong nn rr ; *ᵣ-zeroʳ = λ where (m , n) → M.*ᵣ-zeroʳ m , N.*ᵣ-zeroʳ n ; *ᵣ-distribˡ = λ where (m , n) x y → M.*ᵣ-distribˡ m x y , N.*ᵣ-distribˡ n x y ; *ᵣ-identityʳ = λ where (m , n) → M.*ᵣ-identityʳ m , N.*ᵣ-identityʳ n ; *ᵣ-assoc = λ where (m , n) x y → M.*ᵣ-assoc m x y , N.*ᵣ-assoc n x y ; *ᵣ-zeroˡ = λ x → M.*ᵣ-zeroˡ x , N.*ᵣ-zeroˡ x ; *ᵣ-distribʳ = λ where x (m , n) (m′ , n′) → M.*ᵣ-distribʳ x m m′ , N.*ᵣ-distribʳ x n n′ } } } where module M = RightSemimodule M; module N = RightSemimodule N bisemimodule : {R : Semiring r ℓr} {S : Semiring s ℓs} → Bisemimodule R S m ℓm → Bisemimodule R S m′ ℓm′ → Bisemimodule R S (m ⊔ m′) (ℓm ⊔ ℓm′) bisemimodule M N = record { isBisemimodule = record { +ᴹ-isCommutativeMonoid = CommutativeMonoid.isCommutativeMonoid (commutativeMonoid M.+ᴹ-commutativeMonoid N.+ᴹ-commutativeMonoid) ; isPreleftSemimodule = LeftSemimodule.isPreleftSemimodule (leftSemimodule M.leftSemimodule N.leftSemimodule) ; isPrerightSemimodule = RightSemimodule.isPrerightSemimodule (rightSemimodule M.rightSemimodule N.rightSemimodule) ; *ₗ-*ᵣ-assoc = λ where x (m , n) y → M.*ₗ-*ᵣ-assoc x m y , N.*ₗ-*ᵣ-assoc x n y } } where module M = Bisemimodule M; module N = Bisemimodule N semimodule : {R : CommutativeSemiring r ℓr} → Semimodule R m ℓm → Semimodule R m′ ℓm′ → Semimodule R (m ⊔ m′) (ℓm ⊔ ℓm′) semimodule M N = record { isSemimodule = record { isBisemimodule = Bisemimodule.isBisemimodule (bisemimodule M.bisemimodule N.bisemimodule) } } where module M = Semimodule M; module N = Semimodule N leftModule : {R : Ring r ℓr} → LeftModule R m ℓm → LeftModule R m′ ℓm′ → LeftModule R (m ⊔ m′) (ℓm ⊔ ℓm′) leftModule M N = record { -ᴹ_ = map M.-ᴹ_ N.-ᴹ_ ; isLeftModule = record { isLeftSemimodule = LeftSemimodule.isLeftSemimodule (leftSemimodule M.leftSemimodule N.leftSemimodule) ; -ᴹ‿cong = λ where (mm , nn) → M.-ᴹ‿cong mm , N.-ᴹ‿cong nn ; -ᴹ‿inverse = λ where .proj₁ (m , n) → M.-ᴹ‿inverseˡ m , N.-ᴹ‿inverseˡ n .proj₂ (m , n) → M.-ᴹ‿inverseʳ m , N.-ᴹ‿inverseʳ n } } where module M = LeftModule M; module N = LeftModule N rightModule : {R : Ring r ℓr} → RightModule R m ℓm → RightModule R m′ ℓm′ → RightModule R (m ⊔ m′) (ℓm ⊔ ℓm′) rightModule M N = record { -ᴹ_ = map M.-ᴹ_ N.-ᴹ_ ; isRightModule = record { isRightSemimodule = RightSemimodule.isRightSemimodule (rightSemimodule M.rightSemimodule N.rightSemimodule) ; -ᴹ‿cong = λ where (mm , nn) → M.-ᴹ‿cong mm , N.-ᴹ‿cong nn ; -ᴹ‿inverse = λ where .proj₁ (m , n) → M.-ᴹ‿inverseˡ m , N.-ᴹ‿inverseˡ n .proj₂ (m , n) → M.-ᴹ‿inverseʳ m , N.-ᴹ‿inverseʳ n } } where module M = RightModule M; module N = RightModule N bimodule : {R : Ring r ℓr} {S : Ring s ℓs} → Bimodule R S m ℓm → Bimodule R S m′ ℓm′ → Bimodule R S (m ⊔ m′) (ℓm ⊔ ℓm′) bimodule M N = record { -ᴹ_ = map M.-ᴹ_ N.-ᴹ_ ; isBimodule = record { isBisemimodule = Bisemimodule.isBisemimodule (bisemimodule M.bisemimodule N.bisemimodule) ; -ᴹ‿cong = λ where (mm , nn) → M.-ᴹ‿cong mm , N.-ᴹ‿cong nn ; -ᴹ‿inverse = λ where .proj₁ (m , n) → M.-ᴹ‿inverseˡ m , N.-ᴹ‿inverseˡ n .proj₂ (m , n) → M.-ᴹ‿inverseʳ m , N.-ᴹ‿inverseʳ n } } where module M = Bimodule M; module N = Bimodule N ⟨module⟩ : {R : CommutativeRing r ℓr} → Module R m ℓm → Module R m′ ℓm′ → Module R (m ⊔ m′) (ℓm ⊔ ℓm′) ⟨module⟩ M N = record { isModule = record { isBimodule = Bimodule.isBimodule (bimodule M.bimodule N.bimodule) } } where module M = Module M; module N = Module N agda-stdlib-1.7.3/src/Algebra/Module/Construct/TensorUnit.agda000066400000000000000000000070241451211343400241630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module constructs the unit of the monoidal structure on -- R-modules, and similar for weaker module-like structures. -- The intended universal property is that the maps out of the tensor -- unit into M are isomorphic to the elements of M. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Module.Construct.TensorUnit where open import Algebra.Bundles open import Algebra.Module.Bundles open import Level private variable c ℓ : Level leftSemimodule : {R : Semiring c ℓ} → LeftSemimodule R c ℓ leftSemimodule {R = semiring} = record { Carrierᴹ = Carrier ; _≈ᴹ_ = _≈_ ; _+ᴹ_ = _+_ ; _*ₗ_ = _*_ ; 0ᴹ = 0# ; isLeftSemimodule = record { +ᴹ-isCommutativeMonoid = +-isCommutativeMonoid ; isPreleftSemimodule = record { *ₗ-cong = *-cong ; *ₗ-zeroˡ = zeroˡ ; *ₗ-distribʳ = distribʳ ; *ₗ-identityˡ = *-identityˡ ; *ₗ-assoc = *-assoc ; *ₗ-zeroʳ = zeroʳ ; *ₗ-distribˡ = distribˡ } } } where open Semiring semiring rightSemimodule : {R : Semiring c ℓ} → RightSemimodule R c ℓ rightSemimodule {R = semiring} = record { Carrierᴹ = Carrier ; _≈ᴹ_ = _≈_ ; _+ᴹ_ = _+_ ; _*ᵣ_ = _*_ ; 0ᴹ = 0# ; isRightSemimodule = record { +ᴹ-isCommutativeMonoid = +-isCommutativeMonoid ; isPrerightSemimodule = record { *ᵣ-cong = *-cong ; *ᵣ-zeroʳ = zeroʳ ; *ᵣ-distribˡ = distribˡ ; *ᵣ-identityʳ = *-identityʳ ; *ᵣ-assoc = *-assoc ; *ᵣ-zeroˡ = zeroˡ ; *ᵣ-distribʳ = distribʳ } } } where open Semiring semiring bisemimodule : {R : Semiring c ℓ} → Bisemimodule R R c ℓ bisemimodule {R = semiring} = record { isBisemimodule = record { +ᴹ-isCommutativeMonoid = +-isCommutativeMonoid ; isPreleftSemimodule = LeftSemimodule.isPreleftSemimodule leftSemimodule ; isPrerightSemimodule = RightSemimodule.isPrerightSemimodule rightSemimodule ; *ₗ-*ᵣ-assoc = *-assoc } } where open Semiring semiring semimodule : {R : CommutativeSemiring c ℓ} → Semimodule R c ℓ semimodule {R = commutativeSemiring} = record { isSemimodule = record { isBisemimodule = Bisemimodule.isBisemimodule bisemimodule } } where open CommutativeSemiring commutativeSemiring leftModule : {R : Ring c ℓ} → LeftModule R c ℓ leftModule {R = ring} = record { -ᴹ_ = -_ ; isLeftModule = record { isLeftSemimodule = LeftSemimodule.isLeftSemimodule leftSemimodule ; -ᴹ‿cong = -‿cong ; -ᴹ‿inverse = -‿inverse } } where open Ring ring rightModule : {R : Ring c ℓ} → RightModule R c ℓ rightModule {R = ring} = record { -ᴹ_ = -_ ; isRightModule = record { isRightSemimodule = RightSemimodule.isRightSemimodule rightSemimodule ; -ᴹ‿cong = -‿cong ; -ᴹ‿inverse = -‿inverse } } where open Ring ring bimodule : {R : Ring c ℓ} → Bimodule R R c ℓ bimodule {R = ring} = record { isBimodule = record { isBisemimodule = Bisemimodule.isBisemimodule bisemimodule ; -ᴹ‿cong = -‿cong ; -ᴹ‿inverse = -‿inverse } } where open Ring ring ⟨module⟩ : {R : CommutativeRing c ℓ} → Module R c ℓ ⟨module⟩ {R = commutativeRing} = record { isModule = record { isBimodule = Bimodule.isBimodule bimodule } } where open CommutativeRing commutativeRing agda-stdlib-1.7.3/src/Algebra/Module/Construct/Zero.agda000066400000000000000000000034671451211343400227770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module constructs the zero R-module, and similar for weaker -- module-like structures. -- The intended universal property is that, given any R-module M, there -- is a unique map into and a unique map out of the zero R-module -- from/to M. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Algebra.Module.Construct.Zero {c ℓ : Level} where open import Algebra.Bundles open import Algebra.Module.Bundles open import Data.Unit.Polymorphic private variable r s ℓr ℓs : Level leftSemimodule : {R : Semiring r ℓr} → LeftSemimodule R c ℓ leftSemimodule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } rightSemimodule : {S : Semiring s ℓs} → RightSemimodule S c ℓ rightSemimodule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } bisemimodule : {R : Semiring r ℓr} {S : Semiring s ℓs} → Bisemimodule R S c ℓ bisemimodule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } semimodule : {R : CommutativeSemiring r ℓr} → Semimodule R c ℓ semimodule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } leftModule : {R : Ring r ℓr} → LeftModule R c ℓ leftModule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } rightModule : {S : Ring s ℓs} → RightModule S c ℓ rightModule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } bimodule : {R : Ring r ℓr} {S : Ring s ℓs} → Bimodule R S c ℓ bimodule = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } ⟨module⟩ : {R : CommutativeRing r ℓr} → Module R c ℓ ⟨module⟩ = record { Carrierᴹ = ⊤ ; _≈ᴹ_ = λ _ _ → ⊤ } agda-stdlib-1.7.3/src/Algebra/Module/Definitions.agda000066400000000000000000000012141451211343400223330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module collects the property definitions for left-scaling -- (LeftDefs), right-scaling (RightDefs), and both (BiDefs). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Algebra.Module.Definitions where open import Algebra.Core import Algebra.Module.Definitions.Left as L import Algebra.Module.Definitions.Right as R import Algebra.Module.Definitions.Bi as B module LeftDefs = L module RightDefs = R module BiDefs = B agda-stdlib-1.7.3/src/Algebra/Module/Definitions/000077500000000000000000000000001451211343400215175ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Module/Definitions/Bi.agda000066400000000000000000000013001451211343400226610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties connecting left-scaling and right-scaling ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary -- The properties are parameterised by the three carriers and -- the result equality. module Algebra.Module.Definitions.Bi {a a′ b ℓb} (A : Set a) (A′ : Set a′) {B : Set b} (_≈_ : Rel B ℓb) where open import Algebra.Core Associative : Opₗ A B → Opᵣ A′ B → Set _ Associative _∙ₗ_ _∙ᵣ_ = ∀ x m y → ((x ∙ₗ m) ∙ᵣ y) ≈ (x ∙ₗ (m ∙ᵣ y)) agda-stdlib-1.7.3/src/Algebra/Module/Definitions/Left.agda000066400000000000000000000036661451211343400232420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of left-scaling ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary -- The properties are parameterised by the two carriers and -- the result equality. module Algebra.Module.Definitions.Left {a b ℓb} (A : Set a) {B : Set b} (_≈_ : Rel B ℓb) where open import Data.Sum open import Data.Product ------------------------------------------------------------------------ -- Binary operations open import Algebra.Core ------------------------------------------------------------------------ -- Properties of operations LeftIdentity : A → Opₗ A B → Set _ LeftIdentity a _∙ᴮ_ = ∀ m → (a ∙ᴮ m) ≈ m Associative : Op₂ A → Opₗ A B → Set _ Associative _∙ᴬ_ _∙ᴮ_ = ∀ x y m → ((x ∙ᴬ y) ∙ᴮ m) ≈ (x ∙ᴮ (y ∙ᴮ m)) _DistributesOverˡ_ : Opₗ A B → Op₂ B → Set _ _*_ DistributesOverˡ _+_ = ∀ x m n → (x * (m + n)) ≈ ((x * m) + (x * n)) _DistributesOverʳ_⟶_ : Opₗ A B → Op₂ A → Op₂ B → Set _ _*_ DistributesOverʳ _+ᴬ_ ⟶ _+ᴮ_ = ∀ x m n → ((m +ᴬ n) * x) ≈ ((m * x) +ᴮ (n * x)) LeftZero : A → B → Opₗ A B → Set _ LeftZero zᴬ zᴮ _∙_ = ∀ x → (zᴬ ∙ x) ≈ zᴮ RightZero : B → Opₗ A B → Set _ RightZero z _∙_ = ∀ x → (x ∙ z) ≈ z Commutative : Opₗ A B → Set _ Commutative _∙_ = ∀ x y m → (x ∙ (y ∙ m)) ≈ (y ∙ (x ∙ m)) LeftCongruent : Opₗ A B → Set _ LeftCongruent _∙_ = ∀ {x} → (x ∙_) Preserves _≈_ ⟶ _≈_ RightCongruent : ∀ {ℓa} → Rel A ℓa → Opₗ A B → Set _ RightCongruent ≈ᴬ _∙_ = ∀ {m} → (_∙ m) Preserves ≈ᴬ ⟶ _≈_ Congruent : ∀ {ℓa} → Rel A ℓa → Opₗ A B → Set _ Congruent ≈ᴬ ∙ = ∙ Preserves₂ ≈ᴬ ⟶ _≈_ ⟶ _≈_ agda-stdlib-1.7.3/src/Algebra/Module/Definitions/Right.agda000066400000000000000000000036721451211343400234220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of right-scaling ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary -- The properties are parameterised by the two carriers and -- the result equality. module Algebra.Module.Definitions.Right {a b ℓb} (A : Set a) {B : Set b} (_≈_ : Rel B ℓb) where open import Data.Product open import Data.Sum ------------------------------------------------------------------------ -- Binary operations open import Algebra.Core ------------------------------------------------------------------------ -- Properties of operations RightIdentity : A → Opᵣ A B → Set _ RightIdentity a _∙ᴮ_ = ∀ m → (m ∙ᴮ a) ≈ m Associative : Op₂ A → Opᵣ A B → Set _ Associative _∙ᴬ_ _∙ᴮ_ = ∀ m x y → ((m ∙ᴮ x) ∙ᴮ y) ≈ (m ∙ᴮ (x ∙ᴬ y)) _DistributesOverˡ_⟶_ : Opᵣ A B → Op₂ A → Op₂ B → Set _ _*_ DistributesOverˡ _+ᴬ_ ⟶ _+ᴮ_ = ∀ m x y → (m * (x +ᴬ y)) ≈ ((m * x) +ᴮ (m * y)) _DistributesOverʳ_ : Opᵣ A B → Op₂ B → Set _ _*_ DistributesOverʳ _+_ = ∀ x m n → ((m + n) * x) ≈ ((m * x) + (n * x)) LeftZero : B → Opᵣ A B → Set _ LeftZero z _∙_ = ∀ x → (z ∙ x) ≈ z RightZero : A → B → Opᵣ A B → Set _ RightZero zᴬ zᴮ _∙_ = ∀ x → (x ∙ zᴬ) ≈ zᴮ Commutative : Opᵣ A B → Set _ Commutative _∙_ = ∀ m x y → ((m ∙ x) ∙ y) ≈ ((m ∙ y) ∙ x) LeftCongruent : ∀ {ℓa} → Rel A ℓa → Opᵣ A B → Set _ LeftCongruent ≈ᴬ _∙_ = ∀ {m} → (m ∙_) Preserves ≈ᴬ ⟶ _≈_ RightCongruent : Opᵣ A B → Set _ RightCongruent _∙_ = ∀ {x} → (_∙ x) Preserves _≈_ ⟶ _≈_ Congruent : ∀ {ℓa} → Rel A ℓa → Opᵣ A B → Set _ Congruent ≈ᴬ ∙ = ∙ Preserves₂ _≈_ ⟶ ≈ᴬ ⟶ _≈_ agda-stdlib-1.7.3/src/Algebra/Module/Structures.agda000066400000000000000000000246541451211343400222600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some algebraic structures defined over some other structure ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; IsEquivalence) module Algebra.Module.Structures where open import Algebra.Bundles open import Algebra.Core import Algebra.Definitions as Defs open import Algebra.Module.Definitions open import Algebra.Structures open import Data.Product using (_,_; proj₁; proj₂) open import Level using (Level; _⊔_) private variable m ℓm r ℓr s ℓs : Level M : Set m module _ (semiring : Semiring r ℓr) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) where open Semiring semiring renaming (Carrier to R) record IsPreleftSemimodule (*ₗ : Opₗ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open LeftDefs R ≈ᴹ field *ₗ-cong : Congruent _≈_ *ₗ *ₗ-zeroˡ : LeftZero 0# 0ᴹ *ₗ *ₗ-distribʳ : *ₗ DistributesOverʳ _+_ ⟶ +ᴹ *ₗ-identityˡ : LeftIdentity 1# *ₗ *ₗ-assoc : Associative _*_ *ₗ *ₗ-zeroʳ : RightZero 0ᴹ *ₗ *ₗ-distribˡ : *ₗ DistributesOverˡ +ᴹ record IsLeftSemimodule (*ₗ : Opₗ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open LeftDefs R ≈ᴹ field +ᴹ-isCommutativeMonoid : IsCommutativeMonoid ≈ᴹ +ᴹ 0ᴹ isPreleftSemimodule : IsPreleftSemimodule *ₗ open IsPreleftSemimodule isPreleftSemimodule public open IsCommutativeMonoid +ᴹ-isCommutativeMonoid public using () renaming ( assoc to +ᴹ-assoc ; comm to +ᴹ-comm ; identity to +ᴹ-identity ; identityʳ to +ᴹ-identityʳ ; identityˡ to +ᴹ-identityˡ ; isEquivalence to ≈ᴹ-isEquivalence ; isMagma to +ᴹ-isMagma ; isMonoid to +ᴹ-isMonoid ; isPartialEquivalence to ≈ᴹ-isPartialEquivalence ; isSemigroup to +ᴹ-isSemigroup ; refl to ≈ᴹ-refl ; reflexive to ≈ᴹ-reflexive ; setoid to ≈ᴹ-setoid ; sym to ≈ᴹ-sym ; trans to ≈ᴹ-trans ; ∙-cong to +ᴹ-cong ; ∙-congʳ to +ᴹ-congʳ ; ∙-congˡ to +ᴹ-congˡ ) *ₗ-congˡ : LeftCongruent *ₗ *ₗ-congˡ mm = *ₗ-cong refl mm *ₗ-congʳ : RightCongruent _≈_ *ₗ *ₗ-congʳ xx = *ₗ-cong xx ≈ᴹ-refl record IsPrerightSemimodule (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open RightDefs R ≈ᴹ field *ᵣ-cong : Congruent _≈_ *ᵣ *ᵣ-zeroʳ : RightZero 0# 0ᴹ *ᵣ *ᵣ-distribˡ : *ᵣ DistributesOverˡ _+_ ⟶ +ᴹ *ᵣ-identityʳ : RightIdentity 1# *ᵣ *ᵣ-assoc : Associative _*_ *ᵣ *ᵣ-zeroˡ : LeftZero 0ᴹ *ᵣ *ᵣ-distribʳ : *ᵣ DistributesOverʳ +ᴹ record IsRightSemimodule (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open RightDefs R ≈ᴹ field +ᴹ-isCommutativeMonoid : IsCommutativeMonoid ≈ᴹ +ᴹ 0ᴹ isPrerightSemimodule : IsPrerightSemimodule *ᵣ open IsPrerightSemimodule isPrerightSemimodule public open IsCommutativeMonoid +ᴹ-isCommutativeMonoid public using () renaming ( assoc to +ᴹ-assoc ; comm to +ᴹ-comm ; identity to +ᴹ-identity ; identityʳ to +ᴹ-identityʳ ; identityˡ to +ᴹ-identityˡ ; isEquivalence to ≈ᴹ-isEquivalence ; isMagma to +ᴹ-isMagma ; isMonoid to +ᴹ-isMonoid ; isPartialEquivalence to ≈ᴹ-isPartialEquivalence ; isSemigroup to +ᴹ-isSemigroup ; refl to ≈ᴹ-refl ; reflexive to ≈ᴹ-reflexive ; setoid to ≈ᴹ-setoid ; sym to ≈ᴹ-sym ; trans to ≈ᴹ-trans ; ∙-cong to +ᴹ-cong ; ∙-congʳ to +ᴹ-congʳ ; ∙-congˡ to +ᴹ-congˡ ) *ᵣ-congˡ : LeftCongruent _≈_ *ᵣ *ᵣ-congˡ xx = *ᵣ-cong ≈ᴹ-refl xx *ᵣ-congʳ : RightCongruent *ᵣ *ᵣ-congʳ mm = *ᵣ-cong mm refl module _ (R-semiring : Semiring r ℓr) (S-semiring : Semiring s ℓs) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) where open Semiring R-semiring using () renaming (Carrier to R) open Semiring S-semiring using () renaming (Carrier to S) record IsBisemimodule (*ₗ : Opₗ R M) (*ᵣ : Opᵣ S M) : Set (r ⊔ s ⊔ m ⊔ ℓr ⊔ ℓs ⊔ ℓm) where open BiDefs R S ≈ᴹ field +ᴹ-isCommutativeMonoid : IsCommutativeMonoid ≈ᴹ +ᴹ 0ᴹ isPreleftSemimodule : IsPreleftSemimodule R-semiring ≈ᴹ +ᴹ 0ᴹ *ₗ isPrerightSemimodule : IsPrerightSemimodule S-semiring ≈ᴹ +ᴹ 0ᴹ *ᵣ *ₗ-*ᵣ-assoc : Associative *ₗ *ᵣ isLeftSemimodule : IsLeftSemimodule R-semiring ≈ᴹ +ᴹ 0ᴹ *ₗ isLeftSemimodule = record { +ᴹ-isCommutativeMonoid = +ᴹ-isCommutativeMonoid ; isPreleftSemimodule = isPreleftSemimodule } isRightSemimodule : IsRightSemimodule S-semiring ≈ᴹ +ᴹ 0ᴹ *ᵣ isRightSemimodule = record { +ᴹ-isCommutativeMonoid = +ᴹ-isCommutativeMonoid ; isPrerightSemimodule = isPrerightSemimodule } open IsLeftSemimodule isLeftSemimodule public hiding (+ᴹ-isCommutativeMonoid; isPreleftSemimodule) open IsPrerightSemimodule isPrerightSemimodule public open IsRightSemimodule isRightSemimodule public using (*ᵣ-congˡ; *ᵣ-congʳ) module _ (commutativeSemiring : CommutativeSemiring r ℓr) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) where open CommutativeSemiring commutativeSemiring renaming (Carrier to R) -- An R-semimodule is an R-R-bisemimodule where R is commutative. -- This means that *ₗ and *ᵣ coincide up to mathematical equality, though it -- may be that they do not coincide up to definitional equality. record IsSemimodule (*ₗ : Opₗ R M) (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isBisemimodule : IsBisemimodule semiring semiring ≈ᴹ +ᴹ 0ᴹ *ₗ *ᵣ open IsBisemimodule isBisemimodule public module _ (ring : Ring r ℓr) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (-ᴹ : Op₁ M) where open Ring ring renaming (Carrier to R) record IsLeftModule (*ₗ : Opₗ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open Defs ≈ᴹ field isLeftSemimodule : IsLeftSemimodule semiring ≈ᴹ +ᴹ 0ᴹ *ₗ -ᴹ‿cong : Congruent₁ -ᴹ -ᴹ‿inverse : Inverse 0ᴹ -ᴹ +ᴹ open IsLeftSemimodule isLeftSemimodule public +ᴹ-isAbelianGroup : IsAbelianGroup ≈ᴹ +ᴹ 0ᴹ -ᴹ +ᴹ-isAbelianGroup = record { isGroup = record { isMonoid = +ᴹ-isMonoid ; inverse = -ᴹ‿inverse ; ⁻¹-cong = -ᴹ‿cong } ; comm = +ᴹ-comm } open IsAbelianGroup +ᴹ-isAbelianGroup public using () renaming ( isGroup to +ᴹ-isGroup ; inverseˡ to -ᴹ‿inverseˡ ; inverseʳ to -ᴹ‿inverseʳ ; uniqueˡ-⁻¹ to uniqueˡ‿-ᴹ ; uniqueʳ-⁻¹ to uniqueʳ‿-ᴹ ) record IsRightModule (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where open Defs ≈ᴹ field isRightSemimodule : IsRightSemimodule semiring ≈ᴹ +ᴹ 0ᴹ *ᵣ -ᴹ‿cong : Congruent₁ -ᴹ -ᴹ‿inverse : Inverse 0ᴹ -ᴹ +ᴹ open IsRightSemimodule isRightSemimodule public +ᴹ-isAbelianGroup : IsAbelianGroup ≈ᴹ +ᴹ 0ᴹ -ᴹ +ᴹ-isAbelianGroup = record { isGroup = record { isMonoid = +ᴹ-isMonoid ; inverse = -ᴹ‿inverse ; ⁻¹-cong = -ᴹ‿cong } ; comm = +ᴹ-comm } open IsAbelianGroup +ᴹ-isAbelianGroup public using () renaming ( isGroup to +ᴹ-isGroup ; inverseˡ to -ᴹ‿inverseˡ ; inverseʳ to -ᴹ‿inverseʳ ; uniqueˡ-⁻¹ to uniqueˡ‿-ᴹ ; uniqueʳ-⁻¹ to uniqueʳ‿-ᴹ ) module _ (R-ring : Ring r ℓr) (S-ring : Ring s ℓs) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (-ᴹ : Op₁ M) where open Ring R-ring renaming (Carrier to R; semiring to R-semiring) open Ring S-ring renaming (Carrier to S; semiring to S-semiring) record IsBimodule (*ₗ : Opₗ R M) (*ᵣ : Opᵣ S M) : Set (r ⊔ s ⊔ m ⊔ ℓr ⊔ ℓs ⊔ ℓm) where open Defs ≈ᴹ field isBisemimodule : IsBisemimodule R-semiring S-semiring ≈ᴹ +ᴹ 0ᴹ *ₗ *ᵣ -ᴹ‿cong : Congruent₁ -ᴹ -ᴹ‿inverse : Inverse 0ᴹ -ᴹ +ᴹ open IsBisemimodule isBisemimodule public isLeftModule : IsLeftModule R-ring ≈ᴹ +ᴹ 0ᴹ -ᴹ *ₗ isLeftModule = record { isLeftSemimodule = isLeftSemimodule ; -ᴹ‿cong = -ᴹ‿cong ; -ᴹ‿inverse = -ᴹ‿inverse } open IsLeftModule isLeftModule public using ( +ᴹ-isAbelianGroup; +ᴹ-isGroup; -ᴹ‿inverseˡ; -ᴹ‿inverseʳ ; uniqueˡ‿-ᴹ; uniqueʳ‿-ᴹ) isRightModule : IsRightModule S-ring ≈ᴹ +ᴹ 0ᴹ -ᴹ *ᵣ isRightModule = record { isRightSemimodule = isRightSemimodule ; -ᴹ‿cong = -ᴹ‿cong ; -ᴹ‿inverse = -ᴹ‿inverse } module _ (commutativeRing : CommutativeRing r ℓr) (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (-ᴹ : Op₁ M) where open CommutativeRing commutativeRing renaming (Carrier to R) -- An R-module is an R-R-bimodule where R is commutative. -- This means that *ₗ and *ᵣ coincide up to mathematical equality, though it -- may be that they do not coincide up to definitional equality. record IsModule (*ₗ : Opₗ R M) (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isBimodule : IsBimodule ring ring ≈ᴹ +ᴹ 0ᴹ -ᴹ *ₗ *ᵣ open IsBimodule isBimodule public isSemimodule : IsSemimodule commutativeSemiring ≈ᴹ +ᴹ 0ᴹ *ₗ *ᵣ isSemimodule = record { isBisemimodule = isBisemimodule } agda-stdlib-1.7.3/src/Algebra/Module/Structures/000077500000000000000000000000001451211343400214275ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Module/Structures/Biased.agda000066400000000000000000000120521451211343400234340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module provides alternative ways of providing instances of -- structures in the Algebra.Module hierarchy. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; IsEquivalence) module Algebra.Module.Structures.Biased where open import Algebra.Bundles open import Algebra.Core open import Algebra.Module.Consequences open import Algebra.Module.Structures open import Function.Base using (flip) open import Level using (Level; _⊔_) private variable m ℓm r ℓr s ℓs : Level M : Set m module _ (commutativeSemiring : CommutativeSemiring r ℓr) where open CommutativeSemiring commutativeSemiring renaming (Carrier to R) -- A left semimodule over a commutative semiring is already a semimodule. record IsSemimoduleFromLeft (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (*ₗ : Opₗ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isLeftSemimodule : IsLeftSemimodule semiring ≈ᴹ +ᴹ 0ᴹ *ₗ open IsLeftSemimodule isLeftSemimodule isBisemimodule : IsBisemimodule semiring semiring ≈ᴹ +ᴹ 0ᴹ *ₗ (flip *ₗ) isBisemimodule = record { +ᴹ-isCommutativeMonoid = +ᴹ-isCommutativeMonoid ; isPreleftSemimodule = isPreleftSemimodule ; isPrerightSemimodule = record { *ᵣ-cong = flip *ₗ-cong ; *ᵣ-zeroʳ = *ₗ-zeroˡ ; *ᵣ-distribˡ = *ₗ-distribʳ ; *ᵣ-identityʳ = *ₗ-identityˡ ; *ᵣ-assoc = *ₗ-assoc+comm⇒*ᵣ-assoc _≈_ ≈ᴹ-setoid *ₗ-congʳ *ₗ-assoc *-comm ; *ᵣ-zeroˡ = *ₗ-zeroʳ ; *ᵣ-distribʳ = *ₗ-distribˡ } ; *ₗ-*ᵣ-assoc = *ₗ-assoc+comm⇒*ₗ-*ᵣ-assoc _≈_ ≈ᴹ-setoid *ₗ-congʳ *ₗ-assoc *-comm } isSemimodule : IsSemimodule commutativeSemiring ≈ᴹ +ᴹ 0ᴹ *ₗ (flip *ₗ) isSemimodule = record { isBisemimodule = isBisemimodule } -- Similarly, a right semimodule over a commutative semiring -- is already a semimodule. record IsSemimoduleFromRight (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isRightSemimodule : IsRightSemimodule semiring ≈ᴹ +ᴹ 0ᴹ *ᵣ open IsRightSemimodule isRightSemimodule isBisemimodule : IsBisemimodule semiring semiring ≈ᴹ +ᴹ 0ᴹ (flip *ᵣ) *ᵣ isBisemimodule = record { +ᴹ-isCommutativeMonoid = +ᴹ-isCommutativeMonoid ; isPreleftSemimodule = record { *ₗ-cong = flip *ᵣ-cong ; *ₗ-zeroˡ = *ᵣ-zeroʳ ; *ₗ-distribʳ = *ᵣ-distribˡ ; *ₗ-identityˡ = *ᵣ-identityʳ ; *ₗ-assoc = *ᵣ-assoc+comm⇒*ₗ-assoc _≈_ ≈ᴹ-setoid *ᵣ-congˡ *ᵣ-assoc *-comm ; *ₗ-zeroʳ = *ᵣ-zeroˡ ; *ₗ-distribˡ = *ᵣ-distribʳ } ; isPrerightSemimodule = isPrerightSemimodule ; *ₗ-*ᵣ-assoc = *ᵣ-assoc+comm⇒*ₗ-*ᵣ-assoc _≈_ ≈ᴹ-setoid *ᵣ-congˡ *ᵣ-assoc *-comm } isSemimodule : IsSemimodule commutativeSemiring ≈ᴹ +ᴹ 0ᴹ (flip *ᵣ) *ᵣ isSemimodule = record { isBisemimodule = isBisemimodule } module _ (commutativeRing : CommutativeRing r ℓr) where open CommutativeRing commutativeRing renaming (Carrier to R) -- A left module over a commutative ring is already a module. record IsModuleFromLeft (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (-ᴹ : Op₁ M) (*ₗ : Opₗ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isLeftModule : IsLeftModule ring ≈ᴹ +ᴹ 0ᴹ -ᴹ *ₗ open IsLeftModule isLeftModule isModule : IsModule commutativeRing ≈ᴹ +ᴹ 0ᴹ -ᴹ *ₗ (flip *ₗ) isModule = record { isBimodule = record { isBisemimodule = IsSemimoduleFromLeft.isBisemimodule {commutativeSemiring = commutativeSemiring} (record { isLeftSemimodule = isLeftSemimodule }) ; -ᴹ‿cong = -ᴹ‿cong ; -ᴹ‿inverse = -ᴹ‿inverse } } -- Similarly, a right module over a commutative ring is already a module. record IsModuleFromRight (≈ᴹ : Rel {m} M ℓm) (+ᴹ : Op₂ M) (0ᴹ : M) (-ᴹ : Op₁ M) (*ᵣ : Opᵣ R M) : Set (r ⊔ m ⊔ ℓr ⊔ ℓm) where field isRightModule : IsRightModule ring ≈ᴹ +ᴹ 0ᴹ -ᴹ *ᵣ open IsRightModule isRightModule isModule : IsModule commutativeRing ≈ᴹ +ᴹ 0ᴹ -ᴹ (flip *ᵣ) *ᵣ isModule = record { isBimodule = record { isBisemimodule = IsSemimoduleFromRight.isBisemimodule {commutativeSemiring = commutativeSemiring} (record { isRightSemimodule = isRightSemimodule }) ; -ᴹ‿cong = -ᴹ‿cong ; -ᴹ‿inverse = -ᴹ‿inverse } } agda-stdlib-1.7.3/src/Algebra/Morphism.agda000066400000000000000000000155731451211343400204460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Morphisms between algebraic structures ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Morphism where import Algebra.Morphism.Definitions as MorphismDefinitions open import Algebra import Algebra.Properties.Group as GroupP open import Function hiding (Morphism) open import Level open import Relation.Binary import Relation.Binary.Reasoning.Setoid as EqR private variable a b ℓ₁ ℓ₂ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Re-export module Definitions {a b ℓ₁} (A : Set a) (B : Set b) (_≈_ : Rel B ℓ₁) where open MorphismDefinitions A B _≈_ public open import Algebra.Morphism.Structures public ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new definitions re-exported from -- `Algebra.Morphism.Structures` as continuing support for the below is -- no guaranteed. -- Version 1.5 module _ {c₁ ℓ₁ c₂ ℓ₂} (From : Semigroup c₁ ℓ₁) (To : Semigroup c₂ ℓ₂) where private module F = Semigroup From module T = Semigroup To open Definitions F.Carrier T.Carrier T._≈_ record IsSemigroupMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field ⟦⟧-cong : ⟦_⟧ Preserves F._≈_ ⟶ T._≈_ ∙-homo : Homomorphic₂ ⟦_⟧ F._∙_ T._∙_ IsSemigroupMorphism-syntax = IsSemigroupMorphism syntax IsSemigroupMorphism-syntax From To F = F Is From -Semigroup⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : Monoid c₁ ℓ₁) (To : Monoid c₂ ℓ₂) where private module F = Monoid From module T = Monoid To open Definitions F.Carrier T.Carrier T._≈_ record IsMonoidMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field sm-homo : IsSemigroupMorphism F.semigroup T.semigroup ⟦_⟧ ε-homo : Homomorphic₀ ⟦_⟧ F.ε T.ε open IsSemigroupMorphism sm-homo public IsMonoidMorphism-syntax = IsMonoidMorphism syntax IsMonoidMorphism-syntax From To F = F Is From -Monoid⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : CommutativeMonoid c₁ ℓ₁) (To : CommutativeMonoid c₂ ℓ₂) where private module F = CommutativeMonoid From module T = CommutativeMonoid To open Definitions F.Carrier T.Carrier T._≈_ record IsCommutativeMonoidMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ open IsMonoidMorphism mn-homo public IsCommutativeMonoidMorphism-syntax = IsCommutativeMonoidMorphism syntax IsCommutativeMonoidMorphism-syntax From To F = F Is From -CommutativeMonoid⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : IdempotentCommutativeMonoid c₁ ℓ₁) (To : IdempotentCommutativeMonoid c₂ ℓ₂) where private module F = IdempotentCommutativeMonoid From module T = IdempotentCommutativeMonoid To open Definitions F.Carrier T.Carrier T._≈_ record IsIdempotentCommutativeMonoidMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ open IsMonoidMorphism mn-homo public isCommutativeMonoidMorphism : IsCommutativeMonoidMorphism F.commutativeMonoid T.commutativeMonoid ⟦_⟧ isCommutativeMonoidMorphism = record { mn-homo = mn-homo } IsIdempotentCommutativeMonoidMorphism-syntax = IsIdempotentCommutativeMonoidMorphism syntax IsIdempotentCommutativeMonoidMorphism-syntax From To F = F Is From -IdempotentCommutativeMonoid⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : Group c₁ ℓ₁) (To : Group c₂ ℓ₂) where private module F = Group From module T = Group To open Definitions F.Carrier T.Carrier T._≈_ record IsGroupMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field mn-homo : IsMonoidMorphism F.monoid T.monoid ⟦_⟧ open IsMonoidMorphism mn-homo public ⁻¹-homo : Homomorphic₁ ⟦_⟧ F._⁻¹ T._⁻¹ ⁻¹-homo x = let open EqR T.setoid in T.uniqueˡ-⁻¹ ⟦ x F.⁻¹ ⟧ ⟦ x ⟧ $ begin ⟦ x F.⁻¹ ⟧ T.∙ ⟦ x ⟧ ≈⟨ T.sym (∙-homo (x F.⁻¹) x) ⟩ ⟦ x F.⁻¹ F.∙ x ⟧ ≈⟨ ⟦⟧-cong (F.inverseˡ x) ⟩ ⟦ F.ε ⟧ ≈⟨ ε-homo ⟩ T.ε ∎ IsGroupMorphism-syntax = IsGroupMorphism syntax IsGroupMorphism-syntax From To F = F Is From -Group⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : AbelianGroup c₁ ℓ₁) (To : AbelianGroup c₂ ℓ₂) where private module F = AbelianGroup From module T = AbelianGroup To open Definitions F.Carrier T.Carrier T._≈_ record IsAbelianGroupMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field gp-homo : IsGroupMorphism F.group T.group ⟦_⟧ open IsGroupMorphism gp-homo public IsAbelianGroupMorphism-syntax = IsAbelianGroupMorphism syntax IsAbelianGroupMorphism-syntax From To F = F Is From -AbelianGroup⟶ To module _ {c₁ ℓ₁ c₂ ℓ₂} (From : Ring c₁ ℓ₁) (To : Ring c₂ ℓ₂) where private module F = Ring From module T = Ring To open Definitions F.Carrier T.Carrier T._≈_ record IsRingMorphism (⟦_⟧ : Morphism) : Set (c₁ ⊔ ℓ₁ ⊔ c₂ ⊔ ℓ₂) where field +-abgp-homo : ⟦_⟧ Is F.+-abelianGroup -AbelianGroup⟶ T.+-abelianGroup *-mn-homo : ⟦_⟧ Is F.*-monoid -Monoid⟶ T.*-monoid IsRingMorphism-syntax = IsRingMorphism syntax IsRingMorphism-syntax From To F = F Is From -Ring⟶ To {-# WARNING_ON_USAGE IsSemigroupMorphism "Warning: IsSemigroupMorphism was deprecated in v1.5. Please use IsSemigroupHomomorphism instead." #-} {-# WARNING_ON_USAGE IsMonoidMorphism "Warning: IsMonoidMorphism was deprecated in v1.5. Please use IsMonoidHomomorphism instead." #-} {-# WARNING_ON_USAGE IsCommutativeMonoidMorphism "Warning: IsCommutativeMonoidMorphism was deprecated in v1.5. Please use IsMonoidHomomorphism instead." #-} {-# WARNING_ON_USAGE IsIdempotentCommutativeMonoidMorphism "Warning: IsIdempotentCommutativeMonoidMorphism was deprecated in v1.5. Please use IsMonoidHomomorphism instead." #-} {-# WARNING_ON_USAGE IsGroupMorphism "Warning: IsGroupMorphism was deprecated in v1.5. Please use IsGroupHomomorphism instead." #-} {-# WARNING_ON_USAGE IsAbelianGroupMorphism "Warning: IsAbelianGroupMorphism was deprecated in v1.5. Please use IsGroupHomomorphism instead." #-} agda-stdlib-1.7.3/src/Algebra/Morphism/000077500000000000000000000000001451211343400176155ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Morphism/Consequences.agda000066400000000000000000000043721451211343400230740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some properties of Magma homomorphisms ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Morphism.Consequences where open import Algebra using (Magma) open import Algebra.Morphism.Definitions open import Data.Product using (_,_) open import Function.Base using (id; _∘_) open import Function.Definitions import Relation.Binary.Reasoning.Setoid as EqR --------------------------------------------------------------------------------- -- If f and g are mutually inverse maps between A and B, g is congruent, -- f is a homomorphism, then g is a homomorphism. module _ {α α= β β=} (M₁ : Magma α α=) (M₂ : Magma β β=) where private open module M₁ = Magma M₁ using () renaming (_≈_ to _≈₁_; _∙_ to _∙₁_) open module M₂ = Magma M₂ using () renaming (_≈_ to _≈₂_; _∙_ to _∙₂_) homomorphic₂-inv : ∀ {f g} → Congruent _≈₂_ _≈₁_ g → Inverseᵇ _≈₁_ _≈₂_ f g → Homomorphic₂ _ _ _≈₂_ f _∙₁_ _∙₂_ → Homomorphic₂ _ _ _≈₁_ g _∙₂_ _∙₁_ homomorphic₂-inv {f} {g} g-cong (f∘g=id , g∘f=id) homo x y = begin g (x ∙₂ y) ≈⟨ M₁.sym (g-cong (M₂.∙-cong (f∘g=id x) (f∘g=id y))) ⟩ g (f (g x) ∙₂ f (g y)) ≈⟨ M₁.sym (g-cong (homo (g x) (g y))) ⟩ g (f (g x ∙₁ g y)) ≈⟨ g∘f=id (g x ∙₁ g y) ⟩ g x ∙₁ g y ∎ where open EqR M₁.setoid homomorphic₂-inj : ∀ {f g} → Injective _≈₁_ _≈₂_ f → Inverseˡ _≈₁_ _≈₂_ f g → Homomorphic₂ _ _ _≈₂_ f _∙₁_ _∙₂_ → Homomorphic₂ _ _ _≈₁_ g _∙₂_ _∙₁_ homomorphic₂-inj {f} {g} inj invˡ homo x y = inj (begin f (g (x ∙₂ y)) ≈⟨ invˡ (x ∙₂ y) ⟩ x ∙₂ y ≈⟨ M₂.sym (M₂.∙-cong (invˡ x) (invˡ y)) ⟩ f (g x) ∙₂ f (g y) ≈⟨ M₂.sym (homo (g x) (g y)) ⟩ f (g x ∙₁ g y) ∎) where open EqR M₂.setoid agda-stdlib-1.7.3/src/Algebra/Morphism/Definitions.agda000066400000000000000000000030101451211343400227000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic definitions for morphisms between algebraic structures ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary.Core module Algebra.Morphism.Definitions {a} (A : Set a) -- The domain of the morphism {b} (B : Set b) -- The codomain of the morphism {ℓ} (_≈_ : Rel B ℓ) -- The equality relation over the codomain where open import Algebra.Core using (Op₁; Op₂) ------------------------------------------------------------------------ -- Basic definitions Homomorphic₀ : (A → B) → A → B → Set _ Homomorphic₀ ⟦_⟧ ∙ ∘ = ⟦ ∙ ⟧ ≈ ∘ Homomorphic₁ : (A → B) → Op₁ A → Op₁ B → Set _ Homomorphic₁ ⟦_⟧ ∙_ ∘_ = ∀ x → ⟦ ∙ x ⟧ ≈ (∘ ⟦ x ⟧) Homomorphic₂ : (A → B) → Op₂ A → Op₂ B → Set _ Homomorphic₂ ⟦_⟧ _∙_ _∘_ = ∀ x y → ⟦ x ∙ y ⟧ ≈ (⟦ x ⟧ ∘ ⟦ y ⟧) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.3 Morphism : Set _ Morphism = A → B {-# WARNING_ON_USAGE Morphism "Warning: Morphism was deprecated in v1.3. Please use the standard function notation (e.g. A → B) instead." #-} agda-stdlib-1.7.3/src/Algebra/Morphism/GroupMonomorphism.agda000066400000000000000000000104751451211343400241460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Consequences of a monomorphism between group-like structures ------------------------------------------------------------------------ -- See Data.Nat.Binary.Properties for examples of how this and similar -- modules can be used to easily translate properties between types. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles open import Algebra.Morphism.Structures open import Relation.Binary.Core module Algebra.Morphism.GroupMonomorphism {a b ℓ₁ ℓ₂} {G₁ : RawGroup a ℓ₁} {G₂ : RawGroup b ℓ₂} {⟦_⟧} (isGroupMonomorphism : IsGroupMonomorphism G₁ G₂ ⟦_⟧) where open IsGroupMonomorphism isGroupMonomorphism open RawGroup G₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; _⁻¹ to _⁻¹₁; ε to ε₁) open RawGroup G₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; _⁻¹ to _⁻¹₂; ε to ε₂) open import Algebra.Definitions open import Algebra.Structures open import Data.Product import Relation.Binary.Reasoning.Setoid as SetoidReasoning ------------------------------------------------------------------------ -- Re-export all properties of monoid monomorphisms open import Algebra.Morphism.MonoidMonomorphism isMonoidMonomorphism public ------------------------------------------------------------------------ -- Properties module _ (◦-isMagma : IsMagma _≈₂_ _◦_) where open IsMagma ◦-isMagma renaming (∙-cong to ◦-cong) open SetoidReasoning setoid inverseˡ : LeftInverse _≈₂_ ε₂ _⁻¹₂ _◦_ → LeftInverse _≈₁_ ε₁ _⁻¹₁ _∙_ inverseˡ invˡ x = injective (begin ⟦ x ⁻¹₁ ∙ x ⟧ ≈⟨ ∙-homo (x ⁻¹₁ ) x ⟩ ⟦ x ⁻¹₁ ⟧ ◦ ⟦ x ⟧ ≈⟨ ◦-cong (⁻¹-homo x) refl ⟩ ⟦ x ⟧ ⁻¹₂ ◦ ⟦ x ⟧ ≈⟨ invˡ ⟦ x ⟧ ⟩ ε₂ ≈˘⟨ ε-homo ⟩ ⟦ ε₁ ⟧ ∎) inverseʳ : RightInverse _≈₂_ ε₂ _⁻¹₂ _◦_ → RightInverse _≈₁_ ε₁ _⁻¹₁ _∙_ inverseʳ invʳ x = injective (begin ⟦ x ∙ x ⁻¹₁ ⟧ ≈⟨ ∙-homo x (x ⁻¹₁) ⟩ ⟦ x ⟧ ◦ ⟦ x ⁻¹₁ ⟧ ≈⟨ ◦-cong refl (⁻¹-homo x) ⟩ ⟦ x ⟧ ◦ ⟦ x ⟧ ⁻¹₂ ≈⟨ invʳ ⟦ x ⟧ ⟩ ε₂ ≈˘⟨ ε-homo ⟩ ⟦ ε₁ ⟧ ∎) inverse : Inverse _≈₂_ ε₂ _⁻¹₂ _◦_ → Inverse _≈₁_ ε₁ _⁻¹₁ _∙_ inverse (invˡ , invʳ) = inverseˡ invˡ , inverseʳ invʳ ⁻¹-cong : Congruent₁ _≈₂_ _⁻¹₂ → Congruent₁ _≈₁_ _⁻¹₁ ⁻¹-cong ⁻¹-cong {x} {y} x≈y = injective (begin ⟦ x ⁻¹₁ ⟧ ≈⟨ ⁻¹-homo x ⟩ ⟦ x ⟧ ⁻¹₂ ≈⟨ ⁻¹-cong (⟦⟧-cong x≈y) ⟩ ⟦ y ⟧ ⁻¹₂ ≈˘⟨ ⁻¹-homo y ⟩ ⟦ y ⁻¹₁ ⟧ ∎) module _ (◦-isAbelianGroup : IsAbelianGroup _≈₂_ _◦_ ε₂ _⁻¹₂) where open IsAbelianGroup ◦-isAbelianGroup renaming (∙-cong to ◦-cong; ⁻¹-cong to ⁻¹₂-cong) open SetoidReasoning setoid ⁻¹-distrib-∙ : (∀ x y → (x ◦ y) ⁻¹₂ ≈₂ (x ⁻¹₂) ◦ (y ⁻¹₂)) → (∀ x y → (x ∙ y) ⁻¹₁ ≈₁ (x ⁻¹₁) ∙ (y ⁻¹₁)) ⁻¹-distrib-∙ ⁻¹-distrib-∙ x y = injective (begin ⟦ (x ∙ y) ⁻¹₁ ⟧ ≈⟨ ⁻¹-homo (x ∙ y) ⟩ ⟦ x ∙ y ⟧ ⁻¹₂ ≈⟨ ⁻¹₂-cong (∙-homo x y) ⟩ (⟦ x ⟧ ◦ ⟦ y ⟧) ⁻¹₂ ≈⟨ ⁻¹-distrib-∙ ⟦ x ⟧ ⟦ y ⟧ ⟩ ⟦ x ⟧ ⁻¹₂ ◦ ⟦ y ⟧ ⁻¹₂ ≈⟨ sym (◦-cong (⁻¹-homo x) (⁻¹-homo y)) ⟩ ⟦ x ⁻¹₁ ⟧ ◦ ⟦ y ⁻¹₁ ⟧ ≈⟨ sym (∙-homo (x ⁻¹₁) (y ⁻¹₁)) ⟩ ⟦ (x ⁻¹₁) ∙ (y ⁻¹₁) ⟧ ∎) isGroup : IsGroup _≈₂_ _◦_ ε₂ _⁻¹₂ → IsGroup _≈₁_ _∙_ ε₁ _⁻¹₁ isGroup isGroup = record { isMonoid = isMonoid G.isMonoid ; inverse = inverse G.isMagma G.inverse ; ⁻¹-cong = ⁻¹-cong G.isMagma G.⁻¹-cong } where module G = IsGroup isGroup isAbelianGroup : IsAbelianGroup _≈₂_ _◦_ ε₂ _⁻¹₂ → IsAbelianGroup _≈₁_ _∙_ ε₁ _⁻¹₁ isAbelianGroup isAbelianGroup = record { isGroup = isGroup G.isGroup ; comm = comm G.isMagma G.comm } where module G = IsAbelianGroup isAbelianGroup agda-stdlib-1.7.3/src/Algebra/Morphism/LatticeMonomorphism.agda000066400000000000000000000120141451211343400244260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Consequences of a monomorphism between lattice-like structures ------------------------------------------------------------------------ -- See Data.Nat.Binary.Properties for examples of how this and similar -- modules can be used to easily translate properties between types. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Structures open import Algebra.Definitions open import Algebra.Bundles open import Algebra.Morphism.Structures import Relation.Binary.Morphism.RelMonomorphism as RelMonomorphisms import Algebra.Morphism.MagmaMonomorphism as MagmaMonomorphisms import Algebra.Properties.Lattice as LatticeProperties open import Data.Product using (_,_) import Relation.Binary.Reasoning.Setoid as SetoidReasoning module Algebra.Morphism.LatticeMonomorphism {a b ℓ₁ ℓ₂} {L₁ : RawLattice a ℓ₁} {L₂ : RawLattice b ℓ₂} {⟦_⟧} (isLatticeMonomorphism : IsLatticeMonomorphism L₁ L₂ ⟦_⟧) where open IsLatticeMonomorphism isLatticeMonomorphism open RawLattice L₁ renaming (_≈_ to _≈₁_; _∨_ to _∨_; _∧_ to _∧_) open RawLattice L₂ renaming (_≈_ to _≈₂_; _∨_ to _⊔_; _∧_ to _⊓_) ------------------------------------------------------------------------ -- Re-export all properties of magma monomorphisms open MagmaMonomorphisms ∨-isMagmaMonomorphism public using () renaming ( cong to ∨-cong ; assoc to ∨-assoc ; comm to ∨-comm ; idem to ∨-idem ; sel to ∨-sel ; cancelˡ to ∨-cancelˡ ; cancelʳ to ∨-cancelʳ ; cancel to ∨-cancel ) open MagmaMonomorphisms ∧-isMagmaMonomorphism public using () renaming ( cong to ∧-cong ; assoc to ∧-assoc ; comm to ∧-comm ; idem to ∧-idem ; sel to ∧-sel ; cancelˡ to ∧-cancelˡ ; cancelʳ to ∧-cancelʳ ; cancel to ∧-cancel ) ------------------------------------------------------------------------ -- Lattice-specific properties module _ (⊔-⊓-isLattice : IsLattice _≈₂_ _⊔_ _⊓_) where open IsLattice ⊔-⊓-isLattice using (isEquivalence) renaming ( ∨-congˡ to ⊔-congˡ ; ∨-congʳ to ⊔-congʳ ; ∧-cong to ⊓-cong ; ∧-congˡ to ⊓-congˡ ; ∨-absorbs-∧ to ⊔-absorbs-⊓ ; ∧-absorbs-∨ to ⊓-absorbs-⊔ ) open SetoidReasoning (record { isEquivalence = isEquivalence }) ∨-absorbs-∧ : _Absorbs_ _≈₁_ _∨_ _∧_ ∨-absorbs-∧ x y = injective (begin ⟦ x ∨ x ∧ y ⟧ ≈⟨ ∨-homo x (x ∧ y) ⟩ ⟦ x ⟧ ⊔ ⟦ x ∧ y ⟧ ≈⟨ ⊔-congˡ (∧-homo x y) ⟩ ⟦ x ⟧ ⊔ ⟦ x ⟧ ⊓ ⟦ y ⟧ ≈⟨ ⊔-absorbs-⊓ ⟦ x ⟧ ⟦ y ⟧ ⟩ ⟦ x ⟧ ∎) ∧-absorbs-∨ : _Absorbs_ _≈₁_ _∧_ _∨_ ∧-absorbs-∨ x y = injective (begin ⟦ x ∧ (x ∨ y) ⟧ ≈⟨ ∧-homo x (x ∨ y) ⟩ ⟦ x ⟧ ⊓ ⟦ x ∨ y ⟧ ≈⟨ ⊓-congˡ (∨-homo x y) ⟩ ⟦ x ⟧ ⊓ (⟦ x ⟧ ⊔ ⟦ y ⟧) ≈⟨ ⊓-absorbs-⊔ ⟦ x ⟧ ⟦ y ⟧ ⟩ ⟦ x ⟧ ∎) absorptive : Absorptive _≈₁_ _∨_ _∧_ absorptive = ∨-absorbs-∧ , ∧-absorbs-∨ distribʳ : _DistributesOverʳ_ _≈₂_ _⊔_ _⊓_ → _DistributesOverʳ_ _≈₁_ _∨_ _∧_ distribʳ distribʳ x y z = injective (begin ⟦ y ∧ z ∨ x ⟧ ≈⟨ ∨-homo (y ∧ z) x ⟩ ⟦ y ∧ z ⟧ ⊔ ⟦ x ⟧ ≈⟨ ⊔-congʳ (∧-homo y z) ⟩ ⟦ y ⟧ ⊓ ⟦ z ⟧ ⊔ ⟦ x ⟧ ≈⟨ distribʳ ⟦ x ⟧ ⟦ y ⟧ ⟦ z ⟧ ⟩ (⟦ y ⟧ ⊔ ⟦ x ⟧) ⊓ (⟦ z ⟧ ⊔ ⟦ x ⟧) ≈˘⟨ ⊓-cong (∨-homo y x) (∨-homo z x) ⟩ ⟦ y ∨ x ⟧ ⊓ ⟦ z ∨ x ⟧ ≈˘⟨ ∧-homo (y ∨ x) (z ∨ x) ⟩ ⟦ (y ∨ x) ∧ (z ∨ x) ⟧ ∎) isLattice : IsLattice _≈₂_ _⊔_ _⊓_ → IsLattice _≈₁_ _∨_ _∧_ isLattice isLattice = record { isEquivalence = RelMonomorphisms.isEquivalence isRelMonomorphism L.isEquivalence ; ∨-comm = ∨-comm LP.∨-isMagma L.∨-comm ; ∨-assoc = ∨-assoc LP.∨-isMagma L.∨-assoc ; ∨-cong = ∨-cong LP.∨-isMagma ; ∧-comm = ∧-comm LP.∧-isMagma L.∧-comm ; ∧-assoc = ∧-assoc LP.∧-isMagma L.∧-assoc ; ∧-cong = ∧-cong LP.∧-isMagma ; absorptive = absorptive isLattice } where module L = IsLattice isLattice module LP = LatticeProperties (record { isLattice = isLattice }) isDistributiveLattice : IsDistributiveLattice _≈₂_ _⊔_ _⊓_ → IsDistributiveLattice _≈₁_ _∨_ _∧_ isDistributiveLattice isDL = record { isLattice = isLattice L.isLattice ; ∨-distribʳ-∧ = distribʳ L.isLattice L.∨-distribʳ-∧ } where module L = IsDistributiveLattice isDL agda-stdlib-1.7.3/src/Algebra/Morphism/MagmaMonomorphism.agda000066400000000000000000000123411451211343400240660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Consequences of a monomorphism between magma-like structures ------------------------------------------------------------------------ -- See Data.Nat.Binary.Properties for examples of how this and similar -- modules can be used to easily translate properties between types. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core open import Algebra.Bundles open import Algebra.Morphism.Structures open import Relation.Binary.Core module Algebra.Morphism.MagmaMonomorphism {a b ℓ₁ ℓ₂} {M₁ : RawMagma a ℓ₁} {M₂ : RawMagma b ℓ₂} {⟦_⟧} (isMagmaMonomorphism : IsMagmaMonomorphism M₁ M₂ ⟦_⟧) where open IsMagmaMonomorphism isMagmaMonomorphism open RawMagma M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_) open RawMagma M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_) open import Algebra.Structures open import Algebra.Definitions open import Data.Product open import Data.Sum.Base using (inj₁; inj₂) import Relation.Binary.Reasoning.Setoid as SetoidReasoning import Relation.Binary.Morphism.RelMonomorphism isRelMonomorphism as RelMorphism ------------------------------------------------------------------------ -- Properties module _ (◦-isMagma : IsMagma _≈₂_ _◦_) where open IsMagma ◦-isMagma renaming (∙-cong to ◦-cong) open SetoidReasoning setoid cong : Congruent₂ _≈₁_ _∙_ cong {x} {y} {u} {v} x≈y u≈v = injective (begin ⟦ x ∙ u ⟧ ≈⟨ homo x u ⟩ ⟦ x ⟧ ◦ ⟦ u ⟧ ≈⟨ ◦-cong (⟦⟧-cong x≈y) (⟦⟧-cong u≈v) ⟩ ⟦ y ⟧ ◦ ⟦ v ⟧ ≈˘⟨ homo y v ⟩ ⟦ y ∙ v ⟧ ∎) assoc : Associative _≈₂_ _◦_ → Associative _≈₁_ _∙_ assoc assoc x y z = injective (begin ⟦ (x ∙ y) ∙ z ⟧ ≈⟨ homo (x ∙ y) z ⟩ ⟦ x ∙ y ⟧ ◦ ⟦ z ⟧ ≈⟨ ◦-cong (homo x y) refl ⟩ (⟦ x ⟧ ◦ ⟦ y ⟧) ◦ ⟦ z ⟧ ≈⟨ assoc ⟦ x ⟧ ⟦ y ⟧ ⟦ z ⟧ ⟩ ⟦ x ⟧ ◦ (⟦ y ⟧ ◦ ⟦ z ⟧) ≈˘⟨ ◦-cong refl (homo y z) ⟩ ⟦ x ⟧ ◦ ⟦ y ∙ z ⟧ ≈˘⟨ homo x (y ∙ z) ⟩ ⟦ x ∙ (y ∙ z) ⟧ ∎) comm : Commutative _≈₂_ _◦_ → Commutative _≈₁_ _∙_ comm comm x y = injective (begin ⟦ x ∙ y ⟧ ≈⟨ homo x y ⟩ ⟦ x ⟧ ◦ ⟦ y ⟧ ≈⟨ comm ⟦ x ⟧ ⟦ y ⟧ ⟩ ⟦ y ⟧ ◦ ⟦ x ⟧ ≈˘⟨ homo y x ⟩ ⟦ y ∙ x ⟧ ∎) idem : Idempotent _≈₂_ _◦_ → Idempotent _≈₁_ _∙_ idem idem x = injective (begin ⟦ x ∙ x ⟧ ≈⟨ homo x x ⟩ ⟦ x ⟧ ◦ ⟦ x ⟧ ≈⟨ idem ⟦ x ⟧ ⟩ ⟦ x ⟧ ∎) sel : Selective _≈₂_ _◦_ → Selective _≈₁_ _∙_ sel sel x y with sel ⟦ x ⟧ ⟦ y ⟧ ... | inj₁ x◦y≈x = inj₁ (injective (begin ⟦ x ∙ y ⟧ ≈⟨ homo x y ⟩ ⟦ x ⟧ ◦ ⟦ y ⟧ ≈⟨ x◦y≈x ⟩ ⟦ x ⟧ ∎)) ... | inj₂ x◦y≈y = inj₂ (injective (begin ⟦ x ∙ y ⟧ ≈⟨ homo x y ⟩ ⟦ x ⟧ ◦ ⟦ y ⟧ ≈⟨ x◦y≈y ⟩ ⟦ y ⟧ ∎)) cancelˡ : LeftCancellative _≈₂_ _◦_ → LeftCancellative _≈₁_ _∙_ cancelˡ cancelˡ x {y} {z} x∙y≈x∙z = injective (cancelˡ ⟦ x ⟧ (begin ⟦ x ⟧ ◦ ⟦ y ⟧ ≈˘⟨ homo x y ⟩ ⟦ x ∙ y ⟧ ≈⟨ ⟦⟧-cong x∙y≈x∙z ⟩ ⟦ x ∙ z ⟧ ≈⟨ homo x z ⟩ ⟦ x ⟧ ◦ ⟦ z ⟧ ∎)) cancelʳ : RightCancellative _≈₂_ _◦_ → RightCancellative _≈₁_ _∙_ cancelʳ cancelʳ {x} y z y∙x≈z∙x = injective (cancelʳ ⟦ y ⟧ ⟦ z ⟧ (begin ⟦ y ⟧ ◦ ⟦ x ⟧ ≈˘⟨ homo y x ⟩ ⟦ y ∙ x ⟧ ≈⟨ ⟦⟧-cong y∙x≈z∙x ⟩ ⟦ z ∙ x ⟧ ≈⟨ homo z x ⟩ ⟦ z ⟧ ◦ ⟦ x ⟧ ∎)) cancel : Cancellative _≈₂_ _◦_ → Cancellative _≈₁_ _∙_ cancel = map cancelˡ cancelʳ ------------------------------------------------------------------------ -- Structures isMagma : IsMagma _≈₂_ _◦_ → IsMagma _≈₁_ _∙_ isMagma isMagma = record { isEquivalence = RelMorphism.isEquivalence M.isEquivalence ; ∙-cong = cong isMagma } where module M = IsMagma isMagma isSemigroup : IsSemigroup _≈₂_ _◦_ → IsSemigroup _≈₁_ _∙_ isSemigroup isSemigroup = record { isMagma = isMagma S.isMagma ; assoc = assoc S.isMagma S.assoc } where module S = IsSemigroup isSemigroup isBand : IsBand _≈₂_ _◦_ → IsBand _≈₁_ _∙_ isBand isBand = record { isSemigroup = isSemigroup B.isSemigroup ; idem = idem B.isMagma B.idem } where module B = IsBand isBand isSemilattice : IsSemilattice _≈₂_ _◦_ → IsSemilattice _≈₁_ _∙_ isSemilattice isSemilattice = record { isBand = isBand S.isBand ; comm = comm S.isMagma S.comm } where module S = IsSemilattice isSemilattice isSelectiveMagma : IsSelectiveMagma _≈₂_ _◦_ → IsSelectiveMagma _≈₁_ _∙_ isSelectiveMagma isSelMagma = record { isMagma = isMagma S.isMagma ; sel = sel S.isMagma S.sel } where module S = IsSelectiveMagma isSelMagma agda-stdlib-1.7.3/src/Algebra/Morphism/MonoidMonomorphism.agda000066400000000000000000000073101451211343400242710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Consequences of a monomorphism between monoid-like structures ------------------------------------------------------------------------ -- See Data.Nat.Binary.Properties for examples of how this and similar -- modules can be used to easily translate properties between types. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles open import Algebra.Morphism.Structures open import Relation.Binary.Core module Algebra.Morphism.MonoidMonomorphism {a b ℓ₁ ℓ₂} {M₁ : RawMonoid a ℓ₁} {M₂ : RawMonoid b ℓ₂} {⟦_⟧} (isMonoidMonomorphism : IsMonoidMonomorphism M₁ M₂ ⟦_⟧) where open IsMonoidMonomorphism isMonoidMonomorphism open RawMonoid M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; ε to ε₁) open RawMonoid M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; ε to ε₂) open import Algebra.Definitions open import Algebra.Structures open import Data.Product using (map) import Relation.Binary.Reasoning.Setoid as SetoidReasoning ------------------------------------------------------------------------ -- Re-export all properties of magma monomorphisms open import Algebra.Morphism.MagmaMonomorphism isMagmaMonomorphism public ------------------------------------------------------------------------ -- Properties module _ (◦-isMagma : IsMagma _≈₂_ _◦_) where open IsMagma ◦-isMagma renaming (∙-cong to ◦-cong) open SetoidReasoning setoid identityˡ : LeftIdentity _≈₂_ ε₂ _◦_ → LeftIdentity _≈₁_ ε₁ _∙_ identityˡ idˡ x = injective (begin ⟦ ε₁ ∙ x ⟧ ≈⟨ homo ε₁ x ⟩ ⟦ ε₁ ⟧ ◦ ⟦ x ⟧ ≈⟨ ◦-cong ε-homo refl ⟩ ε₂ ◦ ⟦ x ⟧ ≈⟨ idˡ ⟦ x ⟧ ⟩ ⟦ x ⟧ ∎) identityʳ : RightIdentity _≈₂_ ε₂ _◦_ → RightIdentity _≈₁_ ε₁ _∙_ identityʳ idʳ x = injective (begin ⟦ x ∙ ε₁ ⟧ ≈⟨ homo x ε₁ ⟩ ⟦ x ⟧ ◦ ⟦ ε₁ ⟧ ≈⟨ ◦-cong refl ε-homo ⟩ ⟦ x ⟧ ◦ ε₂ ≈⟨ idʳ ⟦ x ⟧ ⟩ ⟦ x ⟧ ∎) identity : Identity _≈₂_ ε₂ _◦_ → Identity _≈₁_ ε₁ _∙_ identity = map identityˡ identityʳ zeroˡ : LeftZero _≈₂_ ε₂ _◦_ → LeftZero _≈₁_ ε₁ _∙_ zeroˡ zeˡ x = injective (begin ⟦ ε₁ ∙ x ⟧ ≈⟨ homo ε₁ x ⟩ ⟦ ε₁ ⟧ ◦ ⟦ x ⟧ ≈⟨ ◦-cong ε-homo refl ⟩ ε₂ ◦ ⟦ x ⟧ ≈⟨ zeˡ ⟦ x ⟧ ⟩ ε₂ ≈˘⟨ ε-homo ⟩ ⟦ ε₁ ⟧ ∎) zeroʳ : RightZero _≈₂_ ε₂ _◦_ → RightZero _≈₁_ ε₁ _∙_ zeroʳ zeʳ x = injective (begin ⟦ x ∙ ε₁ ⟧ ≈⟨ homo x ε₁ ⟩ ⟦ x ⟧ ◦ ⟦ ε₁ ⟧ ≈⟨ ◦-cong refl ε-homo ⟩ ⟦ x ⟧ ◦ ε₂ ≈⟨ zeʳ ⟦ x ⟧ ⟩ ε₂ ≈˘⟨ ε-homo ⟩ ⟦ ε₁ ⟧ ∎) zero : Zero _≈₂_ ε₂ _◦_ → Zero _≈₁_ ε₁ _∙_ zero = map zeroˡ zeroʳ ------------------------------------------------------------------------ -- Structures isMonoid : IsMonoid _≈₂_ _◦_ ε₂ → IsMonoid _≈₁_ _∙_ ε₁ isMonoid isMonoid = record { isSemigroup = isSemigroup M.isSemigroup ; identity = identity M.isMagma M.identity } where module M = IsMonoid isMonoid isCommutativeMonoid : IsCommutativeMonoid _≈₂_ _◦_ ε₂ → IsCommutativeMonoid _≈₁_ _∙_ ε₁ isCommutativeMonoid isCommMonoid = record { isMonoid = isMonoid C.isMonoid ; comm = comm C.isMagma C.comm } where module C = IsCommutativeMonoid isCommMonoid agda-stdlib-1.7.3/src/Algebra/Morphism/RingMonomorphism.agda000066400000000000000000000153251451211343400237500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Consequences of a monomorphism between ring-like structures ------------------------------------------------------------------------ -- See Data.Nat.Binary.Properties for examples of how this and similar -- modules can be used to easily translate properties between types. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles open import Algebra.Morphism.Structures open import Relation.Binary.Core module Algebra.Morphism.RingMonomorphism {a b ℓ₁ ℓ₂} {R₁ : RawRing a ℓ₁} {R₂ : RawRing b ℓ₂} {⟦_⟧} (isRingMonomorphism : IsRingMonomorphism R₁ R₂ ⟦_⟧) where open IsRingMonomorphism isRingMonomorphism open RawRing R₁ renaming (Carrier to A; _≈_ to _≈₁_) open RawRing R₂ renaming ( Carrier to B; _≈_ to _≈₂_; _+_ to _⊕_ ; _*_ to _⊛_; 1# to 1#₂; 0# to 0#₂; -_ to ⊝_) open import Algebra.Definitions open import Algebra.Structures open import Data.Product import Relation.Binary.Reasoning.Setoid as SetoidReasoning ------------------------------------------------------------------------ -- Re-export all properties of group and monoid monomorphisms open import Algebra.Morphism.GroupMonomorphism +-isGroupMonomorphism renaming ( assoc to +-assoc ; comm to +-comm ; cong to +-cong ; idem to +-idem ; ⁻¹-cong to neg-cong ; identity to +-identity; identityˡ to +-identityˡ; identityʳ to +-identityʳ ; cancel to +-cancel; cancelˡ to +-cancelˡ; cancelʳ to +-cancelʳ ; zero to +-zero; zeroˡ to +-zeroˡ; zeroʳ to +-zeroʳ ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ; isMonoid to +-isMonoid ; isSelectiveMagma to +-isSelectiveMagma ; isSemilattice to +-isSemilattice ; sel to +-sel ; isBand to +-isBand ; isCommutativeMonoid to +-isCommutativeMonoid ) public open import Algebra.Morphism.MonoidMonomorphism *-isMonoidMonomorphism renaming ( assoc to *-assoc ; comm to *-comm ; cong to *-cong ; idem to *-idem ; identity to *-identity; identityˡ to *-identityˡ; identityʳ to *-identityʳ ; cancel to *-cancel; cancelˡ to *-cancelˡ; cancelʳ to *-cancelʳ ; zero to *-zero; zeroˡ to *-zeroˡ; zeroʳ to *-zeroʳ ; isMagma to *-isMagma ; isSemigroup to *-isSemigroup ; isMonoid to *-isMonoid ; isSelectiveMagma to *-isSelectiveMagma ; isSemilattice to *-isSemilattice ; sel to *-sel ; isBand to *-isBand ; isCommutativeMonoid to *-isCommutativeMonoid ) public ------------------------------------------------------------------------ -- Properties module _ (+-isGroup : IsGroup _≈₂_ _⊕_ 0#₂ ⊝_) (*-isMagma : IsMagma _≈₂_ _⊛_) where open IsGroup +-isGroup hiding (setoid; refl; sym) open IsMagma *-isMagma renaming (∙-cong to ◦-cong) open SetoidReasoning setoid distribˡ : _DistributesOverˡ_ _≈₂_ _⊛_ _⊕_ → _DistributesOverˡ_ _≈₁_ _*_ _+_ distribˡ distribˡ x y z = injective (begin ⟦ x * (y + z) ⟧ ≈⟨ *-homo x (y + z) ⟩ ⟦ x ⟧ ⊛ ⟦ y + z ⟧ ≈⟨ ◦-cong refl (+-homo y z) ⟩ ⟦ x ⟧ ⊛ (⟦ y ⟧ ⊕ ⟦ z ⟧) ≈⟨ distribˡ ⟦ x ⟧ ⟦ y ⟧ ⟦ z ⟧ ⟩ ⟦ x ⟧ ⊛ ⟦ y ⟧ ⊕ ⟦ x ⟧ ⊛ ⟦ z ⟧ ≈˘⟨ ∙-cong (*-homo x y) (*-homo x z) ⟩ ⟦ x * y ⟧ ⊕ ⟦ x * z ⟧ ≈˘⟨ +-homo (x * y) (x * z) ⟩ ⟦ x * y + x * z ⟧ ∎) distribʳ : _DistributesOverʳ_ _≈₂_ _⊛_ _⊕_ → _DistributesOverʳ_ _≈₁_ _*_ _+_ distribʳ distribˡ x y z = injective (begin ⟦ (y + z) * x ⟧ ≈⟨ *-homo (y + z) x ⟩ ⟦ y + z ⟧ ⊛ ⟦ x ⟧ ≈⟨ ◦-cong (+-homo y z) refl ⟩ (⟦ y ⟧ ⊕ ⟦ z ⟧) ⊛ ⟦ x ⟧ ≈⟨ distribˡ ⟦ x ⟧ ⟦ y ⟧ ⟦ z ⟧ ⟩ ⟦ y ⟧ ⊛ ⟦ x ⟧ ⊕ ⟦ z ⟧ ⊛ ⟦ x ⟧ ≈˘⟨ ∙-cong (*-homo y x) (*-homo z x) ⟩ ⟦ y * x ⟧ ⊕ ⟦ z * x ⟧ ≈˘⟨ +-homo (y * x) (z * x) ⟩ ⟦ y * x + z * x ⟧ ∎) distrib : _DistributesOver_ _≈₂_ _⊛_ _⊕_ → _DistributesOver_ _≈₁_ _*_ _+_ distrib distrib = distribˡ (proj₁ distrib) , distribʳ (proj₂ distrib) zeroˡ : LeftZero _≈₂_ 0#₂ _⊛_ → LeftZero _≈₁_ 0# _*_ zeroˡ zeroˡ x = injective (begin ⟦ 0# * x ⟧ ≈⟨ *-homo 0# x ⟩ ⟦ 0# ⟧ ⊛ ⟦ x ⟧ ≈⟨ ◦-cong 0#-homo refl ⟩ 0#₂ ⊛ ⟦ x ⟧ ≈⟨ zeroˡ ⟦ x ⟧ ⟩ 0#₂ ≈˘⟨ 0#-homo ⟩ ⟦ 0# ⟧ ∎) zeroʳ : RightZero _≈₂_ 0#₂ _⊛_ → RightZero _≈₁_ 0# _*_ zeroʳ zeroʳ x = injective (begin ⟦ x * 0# ⟧ ≈⟨ *-homo x 0# ⟩ ⟦ x ⟧ ⊛ ⟦ 0# ⟧ ≈⟨ ◦-cong refl 0#-homo ⟩ ⟦ x ⟧ ⊛ 0#₂ ≈⟨ zeroʳ ⟦ x ⟧ ⟩ 0#₂ ≈˘⟨ 0#-homo ⟩ ⟦ 0# ⟧ ∎) zero : Zero _≈₂_ 0#₂ _⊛_ → Zero _≈₁_ 0# _*_ zero zero = zeroˡ (proj₁ zero) , zeroʳ (proj₂ zero) neg-distribˡ-* : (∀ x y → (⊝ (x ⊛ y)) ≈₂ ((⊝ x) ⊛ y)) → (∀ x y → (- (x * y)) ≈₁ ((- x) * y)) neg-distribˡ-* neg-distribˡ-* x y = injective (begin ⟦ - (x * y) ⟧ ≈⟨ ⁻¹-homo (x * y) ⟩ ⊝ ⟦ x * y ⟧ ≈⟨ ⁻¹-cong (*-homo x y) ⟩ ⊝ (⟦ x ⟧ ⊛ ⟦ y ⟧) ≈⟨ neg-distribˡ-* ⟦ x ⟧ ⟦ y ⟧ ⟩ ⊝ ⟦ x ⟧ ⊛ ⟦ y ⟧ ≈⟨ ◦-cong (sym (⁻¹-homo x)) refl ⟩ ⟦ - x ⟧ ⊛ ⟦ y ⟧ ≈⟨ sym (*-homo (- x) y) ⟩ ⟦ - x * y ⟧ ∎) neg-distribʳ-* : (∀ x y → (⊝ (x ⊛ y)) ≈₂ (x ⊛ (⊝ y))) → (∀ x y → (- (x * y)) ≈₁ (x * (- y))) neg-distribʳ-* neg-distribʳ-* x y = injective (begin ⟦ - (x * y) ⟧ ≈⟨ ⁻¹-homo (x * y) ⟩ ⊝ ⟦ x * y ⟧ ≈⟨ ⁻¹-cong (*-homo x y) ⟩ ⊝ (⟦ x ⟧ ⊛ ⟦ y ⟧) ≈⟨ neg-distribʳ-* ⟦ x ⟧ ⟦ y ⟧ ⟩ ⟦ x ⟧ ⊛ ⊝ ⟦ y ⟧ ≈⟨ ◦-cong refl (sym (⁻¹-homo y)) ⟩ ⟦ x ⟧ ⊛ ⟦ - y ⟧ ≈⟨ sym (*-homo x (- y)) ⟩ ⟦ x * - y ⟧ ∎) isRing : IsRing _≈₂_ _⊕_ _⊛_ ⊝_ 0#₂ 1#₂ → IsRing _≈₁_ _+_ _*_ -_ 0# 1# isRing isRing = record { +-isAbelianGroup = isAbelianGroup R.+-isAbelianGroup ; *-isMonoid = *-isMonoid R.*-isMonoid ; distrib = distrib R.+-isGroup R.*-isMagma R.distrib ; zero = zero R.+-isGroup R.*-isMagma R.zero } where module R = IsRing isRing isCommutativeRing : IsCommutativeRing _≈₂_ _⊕_ _⊛_ ⊝_ 0#₂ 1#₂ → IsCommutativeRing _≈₁_ _+_ _*_ -_ 0# 1# isCommutativeRing isCommRing = record { isRing = isRing C.isRing ; *-comm = *-comm C.*-isMagma C.*-comm } where module C = IsCommutativeRing isCommRing agda-stdlib-1.7.3/src/Algebra/Morphism/Structures.agda000066400000000000000000000426331451211343400226260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Morphisms between algebraic structures ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary.Core module Algebra.Morphism.Structures where open import Algebra.Core open import Algebra.Bundles import Algebra.Morphism.Definitions as MorphismDefinitions open import Level using (Level; _⊔_) import Function.Definitions as FunctionDefinitions open import Relation.Binary.Morphism.Structures private variable a b ℓ₁ ℓ₂ : Level ------------------------------------------------------------------------ -- Morphisms over magma-like structures ------------------------------------------------------------------------ module MagmaMorphisms (M₁ : RawMagma a ℓ₁) (M₂ : RawMagma b ℓ₂) where open RawMagma M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_) open RawMagma M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_) open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ record IsMagmaHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isRelHomomorphism : IsRelHomomorphism _≈₁_ _≈₂_ ⟦_⟧ homo : Homomorphic₂ ⟦_⟧ _∙_ _◦_ open IsRelHomomorphism isRelHomomorphism public renaming (cong to ⟦⟧-cong) record IsMagmaMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isMagmaHomomorphism : IsMagmaHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsMagmaHomomorphism isMagmaHomomorphism public isRelMonomorphism : IsRelMonomorphism _≈₁_ _≈₂_ ⟦_⟧ isRelMonomorphism = record { isHomomorphism = isRelHomomorphism ; injective = injective } record IsMagmaIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isMagmaMonomorphism : IsMagmaMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsMagmaMonomorphism isMagmaMonomorphism public isRelIsomorphism : IsRelIsomorphism _≈₁_ _≈₂_ ⟦_⟧ isRelIsomorphism = record { isMonomorphism = isRelMonomorphism ; surjective = surjective } ------------------------------------------------------------------------ -- Morphisms over monoid-like structures ------------------------------------------------------------------------ module MonoidMorphisms (M₁ : RawMonoid a ℓ₁) (M₂ : RawMonoid b ℓ₂) where open RawMonoid M₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; ε to ε₁) open RawMonoid M₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; ε to ε₂) open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ open MagmaMorphisms (RawMonoid.rawMagma M₁) (RawMonoid.rawMagma M₂) record IsMonoidHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isMagmaHomomorphism : IsMagmaHomomorphism ⟦_⟧ ε-homo : Homomorphic₀ ⟦_⟧ ε₁ ε₂ open IsMagmaHomomorphism isMagmaHomomorphism public record IsMonoidMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isMonoidHomomorphism : IsMonoidHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsMonoidHomomorphism isMonoidHomomorphism public isMagmaMonomorphism : IsMagmaMonomorphism ⟦_⟧ isMagmaMonomorphism = record { isMagmaHomomorphism = isMagmaHomomorphism ; injective = injective } open IsMagmaMonomorphism isMagmaMonomorphism public using (isRelMonomorphism) record IsMonoidIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isMonoidMonomorphism : IsMonoidMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsMonoidMonomorphism isMonoidMonomorphism public isMagmaIsomorphism : IsMagmaIsomorphism ⟦_⟧ isMagmaIsomorphism = record { isMagmaMonomorphism = isMagmaMonomorphism ; surjective = surjective } open IsMagmaIsomorphism isMagmaIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Morphisms over group-like structures ------------------------------------------------------------------------ module GroupMorphisms (G₁ : RawGroup a ℓ₁) (G₂ : RawGroup b ℓ₂) where open RawGroup G₁ renaming (Carrier to A; _≈_ to _≈₁_; _∙_ to _∙_; _⁻¹ to _⁻¹₁; ε to ε₁) open RawGroup G₂ renaming (Carrier to B; _≈_ to _≈₂_; _∙_ to _◦_; _⁻¹ to _⁻¹₂; ε to ε₂) open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ open MagmaMorphisms (RawGroup.rawMagma G₁) (RawGroup.rawMagma G₂) open MonoidMorphisms (RawGroup.rawMonoid G₁) (RawGroup.rawMonoid G₂) record IsGroupHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isMonoidHomomorphism : IsMonoidHomomorphism ⟦_⟧ ⁻¹-homo : Homomorphic₁ ⟦_⟧ _⁻¹₁ _⁻¹₂ open IsMonoidHomomorphism isMonoidHomomorphism public record IsGroupMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isGroupHomomorphism : IsGroupHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsGroupHomomorphism isGroupHomomorphism renaming (homo to ∙-homo) public isMonoidMonomorphism : IsMonoidMonomorphism ⟦_⟧ isMonoidMonomorphism = record { isMonoidHomomorphism = isMonoidHomomorphism ; injective = injective } open IsMonoidMonomorphism isMonoidMonomorphism public using (isRelMonomorphism) record IsGroupIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isGroupMonomorphism : IsGroupMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsGroupMonomorphism isGroupMonomorphism public isMonoidIsomorphism : IsMonoidIsomorphism ⟦_⟧ isMonoidIsomorphism = record { isMonoidMonomorphism = isMonoidMonomorphism ; surjective = surjective } open IsMonoidIsomorphism isMonoidIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Morphisms over near-semiring-like structures ------------------------------------------------------------------------ module NearSemiringMorphisms (R₁ : RawNearSemiring a ℓ₁) (R₂ : RawNearSemiring b ℓ₂) where open RawNearSemiring R₁ renaming ( Carrier to A; _≈_ to _≈₁_ ; +-rawMonoid to +-rawMonoid₁ ; *-rawMagma to *-rawMagma₁) open RawNearSemiring R₂ renaming ( Carrier to B; _≈_ to _≈₂_ ; +-rawMonoid to +-rawMonoid₂ ; *-rawMagma to *-rawMagma₂) private module + = MonoidMorphisms +-rawMonoid₁ +-rawMonoid₂ module * = MagmaMorphisms *-rawMagma₁ *-rawMagma₂ open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ record IsNearSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field +-isMonoidHomomorphism : +.IsMonoidHomomorphism ⟦_⟧ *-isMagmaHomomorphism : *.IsMagmaHomomorphism ⟦_⟧ open +.IsMonoidHomomorphism +-isMonoidHomomorphism renaming (homo to +-homo; ε-homo to 0#-homo) public open *.IsMagmaHomomorphism *-isMagmaHomomorphism renaming (homo to *-homo) public record IsNearSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isNearSemiringHomomorphism : IsNearSemiringHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsNearSemiringHomomorphism isNearSemiringHomomorphism public +-isMonoidMonomorphism : +.IsMonoidMonomorphism ⟦_⟧ +-isMonoidMonomorphism = record { isMonoidHomomorphism = +-isMonoidHomomorphism ; injective = injective } *-isMagmaMonomorphism : *.IsMagmaMonomorphism ⟦_⟧ *-isMagmaMonomorphism = record { isMagmaHomomorphism = *-isMagmaHomomorphism ; injective = injective } open *.IsMagmaMonomorphism *-isMagmaMonomorphism public using (isRelMonomorphism) record IsNearSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isNearSemiringMonomorphism : IsNearSemiringMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsNearSemiringMonomorphism isNearSemiringMonomorphism public +-isMonoidIsomorphism : +.IsMonoidIsomorphism ⟦_⟧ +-isMonoidIsomorphism = record { isMonoidMonomorphism = +-isMonoidMonomorphism ; surjective = surjective } *-isMagmaIsomorphism : *.IsMagmaIsomorphism ⟦_⟧ *-isMagmaIsomorphism = record { isMagmaMonomorphism = *-isMagmaMonomorphism ; surjective = surjective } open *.IsMagmaIsomorphism *-isMagmaIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Morphisms over semiring-like structures ------------------------------------------------------------------------ module SemiringMorphisms (R₁ : RawSemiring a ℓ₁) (R₂ : RawSemiring b ℓ₂) where open RawSemiring R₁ renaming ( Carrier to A; _≈_ to _≈₁_ ; +-rawMonoid to +-rawMonoid₁ ; *-rawMonoid to *-rawMonoid₁) open RawSemiring R₂ renaming ( Carrier to B; _≈_ to _≈₂_ ; +-rawMonoid to +-rawMonoid₂ ; *-rawMonoid to *-rawMonoid₂) private module + = MonoidMorphisms +-rawMonoid₁ +-rawMonoid₂ module * = MonoidMorphisms *-rawMonoid₁ *-rawMonoid₂ open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ record IsSemiringHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field +-isMonoidHomomorphism : +.IsMonoidHomomorphism ⟦_⟧ *-isMonoidHomomorphism : *.IsMonoidHomomorphism ⟦_⟧ open +.IsMonoidHomomorphism +-isMonoidHomomorphism renaming (homo to +-homo; ε-homo to 0#-homo) public open *.IsMonoidHomomorphism *-isMonoidHomomorphism renaming (homo to *-homo; ε-homo to 1#-homo) public record IsSemiringMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isSemiringHomomorphism : IsSemiringHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsSemiringHomomorphism isSemiringHomomorphism public +-isMonoidMonomorphism : +.IsMonoidMonomorphism ⟦_⟧ +-isMonoidMonomorphism = record { isMonoidHomomorphism = +-isMonoidHomomorphism ; injective = injective } *-isMonoidMonomorphism : *.IsMonoidMonomorphism ⟦_⟧ *-isMonoidMonomorphism = record { isMonoidHomomorphism = *-isMonoidHomomorphism ; injective = injective } open *.IsMonoidMonomorphism *-isMonoidMonomorphism public using (isRelMonomorphism) record IsSemiringIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isSemiringMonomorphism : IsSemiringMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsSemiringMonomorphism isSemiringMonomorphism public +-isMonoidIsomorphism : +.IsMonoidIsomorphism ⟦_⟧ +-isMonoidIsomorphism = record { isMonoidMonomorphism = +-isMonoidMonomorphism ; surjective = surjective } *-isMonoidIsomorphism : *.IsMonoidIsomorphism ⟦_⟧ *-isMonoidIsomorphism = record { isMonoidMonomorphism = *-isMonoidMonomorphism ; surjective = surjective } open *.IsMonoidIsomorphism *-isMonoidIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Morphisms over ring-like structures ------------------------------------------------------------------------ module RingMorphisms (R₁ : RawRing a ℓ₁) (R₂ : RawRing b ℓ₂) where open RawRing R₁ renaming ( Carrier to A; _≈_ to _≈₁_ ; *-rawMonoid to *-rawMonoid₁ ; +-rawGroup to +-rawGroup₁) open RawRing R₂ renaming ( Carrier to B; _≈_ to _≈₂_ ; *-rawMonoid to *-rawMonoid₂ ; +-rawGroup to +-rawGroup₂) module + = GroupMorphisms +-rawGroup₁ +-rawGroup₂ module * = MonoidMorphisms *-rawMonoid₁ *-rawMonoid₂ open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ record IsRingHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field +-isGroupHomomorphism : +.IsGroupHomomorphism ⟦_⟧ *-isMonoidHomomorphism : *.IsMonoidHomomorphism ⟦_⟧ open +.IsGroupHomomorphism +-isGroupHomomorphism renaming (homo to +-homo; ε-homo to 0#-homo) public open *.IsMonoidHomomorphism *-isMonoidHomomorphism renaming (homo to *-homo; ε-homo to 1#-homo) public record IsRingMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isRingHomomorphism : IsRingHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsRingHomomorphism isRingHomomorphism public +-isGroupMonomorphism : +.IsGroupMonomorphism ⟦_⟧ +-isGroupMonomorphism = record { isGroupHomomorphism = +-isGroupHomomorphism ; injective = injective } *-isMonoidMonomorphism : *.IsMonoidMonomorphism ⟦_⟧ *-isMonoidMonomorphism = record { isMonoidHomomorphism = *-isMonoidHomomorphism ; injective = injective } open *.IsMonoidMonomorphism *-isMonoidMonomorphism public using (isRelMonomorphism) record IsRingIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isRingMonomorphism : IsRingMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsRingMonomorphism isRingMonomorphism public +-isGroupIsomorphism : +.IsGroupIsomorphism ⟦_⟧ +-isGroupIsomorphism = record { isGroupMonomorphism = +-isGroupMonomorphism ; surjective = surjective } *-isMonoidIsomorphism : *.IsMonoidIsomorphism ⟦_⟧ *-isMonoidIsomorphism = record { isMonoidMonomorphism = *-isMonoidMonomorphism ; surjective = surjective } open *.IsMonoidIsomorphism *-isMonoidIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Morphisms over lattice-like structures ------------------------------------------------------------------------ module LatticeMorphisms (L₁ : RawLattice a ℓ₁) (L₂ : RawLattice b ℓ₂) where open RawLattice L₁ renaming ( Carrier to A; _≈_ to _≈₁_ ; ∧-rawMagma to ∧-rawMagma₁ ; ∨-rawMagma to ∨-rawMagma₁) open RawLattice L₂ renaming ( Carrier to B; _≈_ to _≈₂_ ; ∧-rawMagma to ∧-rawMagma₂ ; ∨-rawMagma to ∨-rawMagma₂) module ∨ = MagmaMorphisms ∨-rawMagma₁ ∨-rawMagma₂ module ∧ = MagmaMorphisms ∧-rawMagma₁ ∧-rawMagma₂ open MorphismDefinitions A B _≈₂_ open FunctionDefinitions _≈₁_ _≈₂_ record IsLatticeHomomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field ∨-isMagmaHomomorphism : ∨.IsMagmaHomomorphism ⟦_⟧ ∧-isMagmaHomomorphism : ∧.IsMagmaHomomorphism ⟦_⟧ open ∨.IsMagmaHomomorphism ∨-isMagmaHomomorphism renaming (homo to ∨-homo) public open ∧.IsMagmaHomomorphism ∧-isMagmaHomomorphism renaming (homo to ∧-homo) public record IsLatticeMonomorphism (⟦_⟧ : A → B) : Set (a ⊔ ℓ₁ ⊔ ℓ₂) where field isLatticeHomomorphism : IsLatticeHomomorphism ⟦_⟧ injective : Injective ⟦_⟧ open IsLatticeHomomorphism isLatticeHomomorphism public ∨-isMagmaMonomorphism : ∨.IsMagmaMonomorphism ⟦_⟧ ∨-isMagmaMonomorphism = record { isMagmaHomomorphism = ∨-isMagmaHomomorphism ; injective = injective } ∧-isMagmaMonomorphism : ∧.IsMagmaMonomorphism ⟦_⟧ ∧-isMagmaMonomorphism = record { isMagmaHomomorphism = ∧-isMagmaHomomorphism ; injective = injective } open ∧.IsMagmaMonomorphism ∧-isMagmaMonomorphism public using (isRelMonomorphism) record IsLatticeIsomorphism (⟦_⟧ : A → B) : Set (a ⊔ b ⊔ ℓ₁ ⊔ ℓ₂) where field isLatticeMonomorphism : IsLatticeMonomorphism ⟦_⟧ surjective : Surjective ⟦_⟧ open IsLatticeMonomorphism isLatticeMonomorphism public ∨-isMagmaIsomorphism : ∨.IsMagmaIsomorphism ⟦_⟧ ∨-isMagmaIsomorphism = record { isMagmaMonomorphism = ∨-isMagmaMonomorphism ; surjective = surjective } ∧-isMagmaIsomorphism : ∧.IsMagmaIsomorphism ⟦_⟧ ∧-isMagmaIsomorphism = record { isMagmaMonomorphism = ∧-isMagmaMonomorphism ; surjective = surjective } open ∧.IsMagmaIsomorphism ∧-isMagmaIsomorphism public using (isRelIsomorphism) ------------------------------------------------------------------------ -- Re-export contents of modules publicly open MagmaMorphisms public open MonoidMorphisms public open GroupMorphisms public open NearSemiringMorphisms public open SemiringMorphisms public open RingMorphisms public open LatticeMorphisms public agda-stdlib-1.7.3/src/Algebra/Operations/000077500000000000000000000000001451211343400201425ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Operations/CommutativeMonoid.agda000066400000000000000000000075401451211343400244310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated Table {-# OPTIONS --warn=noUserWarning #-} open import Algebra open import Data.List.Base as List using (List; []; _∷_; _++_) open import Data.Fin.Base using (Fin; zero) open import Data.Table.Base as Table using (Table) open import Data.Nat.Base as ℕ using (ℕ; zero; suc) open import Function.Base using (_∘_) open import Relation.Binary.Core using (_Preserves_⟶_; _Preserves₂_⟶_⟶_) open import Relation.Binary.PropositionalEquality as P using (_≡_) module Algebra.Operations.CommutativeMonoid {s₁ s₂} (CM : CommutativeMonoid s₁ s₂) where {-# WARNING_ON_IMPORT "Algebra.Operations.CommutativeMonoid was deprecated in v1.5. Use Algebra.Properties.CommutativeMonoid.(Sum/Mult/Exp)(.TCOptimised) instead." #-} open CommutativeMonoid CM renaming ( _∙_ to _+_ ; ε to 0# ; identityʳ to +-identityʳ ; identityˡ to +-identityˡ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; assoc to +-assoc ) open import Relation.Binary.Reasoning.Setoid setoid -- Summation over lists/tables sumₗ : List Carrier → Carrier sumₗ = List.foldr _+_ 0# sumₜ : ∀ {n} → Table Carrier n → Carrier sumₜ = Table.foldr _+_ 0# -- An alternative mathematical-style syntax for sumₜ infixl 10 sumₜ-syntax sumₜ-syntax : ∀ n → (Fin n → Carrier) → Carrier sumₜ-syntax _ = sumₜ ∘ Table.tabulate syntax sumₜ-syntax n (λ i → x) = ∑[ i < n ] x ------------------------------------------------------------------------ -- Multiplication infixr 8 _×_ _×′_ _×_ : ℕ → Carrier → Carrier 0 × x = 0# suc n × x = x + (n × x) _×′_ : ℕ → Carrier → Carrier 0 ×′ x = 0# 1 ×′ x = x suc n ×′ x = x + n ×′ x ------------------------------------------------------------------------ -- Properties of _×_ ×-congʳ : ∀ n → (n ×_) Preserves _≈_ ⟶ _≈_ ×-congʳ 0 x≈x′ = refl ×-congʳ (suc n) x≈x′ = +-cong x≈x′ (×-congʳ n x≈x′) ×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×-cong {u} P.refl x≈x′ = ×-congʳ u x≈x′ -- _×_ is homomorphic with respect to _ℕ+_/_+_. ×-homo-+ : ∀ c m n → (m ℕ.+ n) × c ≈ m × c + n × c ×-homo-+ c 0 n = sym (+-identityˡ (n × c)) ×-homo-+ c (suc m) n = begin c + (m ℕ.+ n) × c ≈⟨ +-cong refl (×-homo-+ c m n) ⟩ c + (m × c + n × c) ≈⟨ sym (+-assoc c (m × c) (n × c)) ⟩ c + m × c + n × c ∎ ------------------------------------------------------------------------ -- Properties of _×′_ 1+×′ : ∀ n x → suc n ×′ x ≈ x + n ×′ x 1+×′ 0 x = sym (+-identityʳ x) 1+×′ (suc n) x = refl -- _×_ and _×′_ are extensionally equal (up to the setoid -- equivalence). ×≈×′ : ∀ n x → n × x ≈ n ×′ x ×≈×′ 0 x = refl ×≈×′ (suc n) x = begin x + n × x ≈⟨ +-congˡ (×≈×′ n x) ⟩ x + n ×′ x ≈⟨ sym (1+×′ n x) ⟩ suc n ×′ x ∎ -- _×′_ is homomorphic with respect to _ℕ+_/_+_. ×′-homo-+ : ∀ c m n → (m ℕ.+ n) ×′ c ≈ m ×′ c + n ×′ c ×′-homo-+ c m n = begin (m ℕ.+ n) ×′ c ≈⟨ sym (×≈×′ (m ℕ.+ n) c) ⟩ (m ℕ.+ n) × c ≈⟨ ×-homo-+ c m n ⟩ m × c + n × c ≈⟨ +-cong (×≈×′ m c) (×≈×′ n c) ⟩ m ×′ c + n ×′ c ∎ -- _×′_ preserves equality. ×′-cong : _×′_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×′-cong {n} {_} {x} {y} P.refl x≈y = begin n ×′ x ≈⟨ sym (×≈×′ n x) ⟩ n × x ≈⟨ ×-congʳ n x≈y ⟩ n × y ≈⟨ ×≈×′ n y ⟩ n ×′ y ∎ agda-stdlib-1.7.3/src/Algebra/Operations/Ring.agda000066400000000000000000000014111451211343400216540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Operations.Ring {ℓ₁ ℓ₂} (ring : RawRing ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Algebra.Operations.Ring was deprecated in v1.5. Use Algebra.Properties.Semiring.Exp(.TCOptimised) instead." #-} open import Data.Nat.Base as ℕ using (ℕ; suc; zero) open RawRing ring infixr 8 _^_+1 _^_+1 : Carrier → ℕ → Carrier x ^ zero +1 = x x ^ suc n +1 = (x ^ n +1) * x infixr 8 _^_ _^_ : Carrier → ℕ → Carrier x ^ zero = 1# x ^ suc i = x ^ i +1 {-# INLINE _^_ #-} agda-stdlib-1.7.3/src/Algebra/Operations/Semiring.agda000066400000000000000000000017431451211343400225420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated -- Algebra.Operations.CommutativeMonoid {-# OPTIONS --warn=noUserWarning #-} open import Algebra import Algebra.Operations.CommutativeMonoid as MonoidOperations module Algebra.Operations.Semiring {s₁ s₂} (S : Semiring s₁ s₂) where {-# WARNING_ON_IMPORT "Algebra.Operations.Semiring was deprecated in v1.5. Use Algebra.Properties.Semiring.(Mult/Exp) instead." #-} open Semiring S ------------------------------------------------------------------------ -- Re-exports open MonoidOperations +-commutativeMonoid public open import Algebra.Properties.Semiring.Exponentiation S public open import Algebra.Properties.Semiring.Multiplication S public using (×1-homo-*; ×′1-homo-*) agda-stdlib-1.7.3/src/Algebra/Properties/000077500000000000000000000000001451211343400201535ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/AbelianGroup.agda000066400000000000000000000023561451211343400233470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Properties.AbelianGroup {a ℓ} (G : AbelianGroup a ℓ) where open AbelianGroup G open import Function open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Publicly re-export group properties open import Algebra.Properties.Group group public ------------------------------------------------------------------------ -- Properties of abelian groups xyx⁻¹≈y : ∀ x y → x ∙ y ∙ x ⁻¹ ≈ y xyx⁻¹≈y x y = begin x ∙ y ∙ x ⁻¹ ≈⟨ ∙-congʳ $ comm _ _ ⟩ y ∙ x ∙ x ⁻¹ ≈⟨ assoc _ _ _ ⟩ y ∙ (x ∙ x ⁻¹) ≈⟨ ∙-congˡ $ inverseʳ _ ⟩ y ∙ ε ≈⟨ identityʳ _ ⟩ y ∎ ⁻¹-∙-comm : ∀ x y → x ⁻¹ ∙ y ⁻¹ ≈ (x ∙ y) ⁻¹ ⁻¹-∙-comm x y = begin x ⁻¹ ∙ y ⁻¹ ≈˘⟨ ⁻¹-anti-homo-∙ y x ⟩ (y ∙ x) ⁻¹ ≈⟨ ⁻¹-cong $ comm y x ⟩ (x ∙ y) ⁻¹ ∎ agda-stdlib-1.7.3/src/Algebra/Properties/BooleanAlgebra.agda000066400000000000000000000574651451211343400236470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated names {-# OPTIONS --warn=noUserWarning #-} open import Algebra.Bundles module Algebra.Properties.BooleanAlgebra {b₁ b₂} (B : BooleanAlgebra b₁ b₂) where open BooleanAlgebra B import Algebra.Properties.DistributiveLattice as DistribLatticeProperties open import Algebra.Core open import Algebra.Structures _≈_ open import Algebra.Definitions _≈_ open import Algebra.Consequences.Setoid setoid open import Relation.Binary.Reasoning.Setoid setoid open import Relation.Binary open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product using (_,_) ------------------------------------------------------------------------ -- Export properties from distributive lattices open DistribLatticeProperties distributiveLattice public hiding (replace-equality) ------------------------------------------------------------------------ -- Some simple consequences ∨-complementˡ : LeftInverse ⊤ ¬_ _∨_ ∨-complementˡ = comm+invʳ⇒invˡ ∨-comm ∨-complementʳ ∨-complement : Inverse ⊤ ¬_ _∨_ ∨-complement = ∨-complementˡ , ∨-complementʳ ∧-complementˡ : LeftInverse ⊥ ¬_ _∧_ ∧-complementˡ = comm+invʳ⇒invˡ ∧-comm ∧-complementʳ ∧-complement : Inverse ⊥ ¬_ _∧_ ∧-complement = ∧-complementˡ , ∧-complementʳ ------------------------------------------------------------------------ -- The dual construction is also a boolean algebra ∧-∨-isBooleanAlgebra : IsBooleanAlgebra _∧_ _∨_ ¬_ ⊥ ⊤ ∧-∨-isBooleanAlgebra = record { isDistributiveLattice = ∧-∨-isDistributiveLattice ; ∨-complementʳ = ∧-complementʳ ; ∧-complementʳ = ∨-complementʳ ; ¬-cong = ¬-cong } ∧-∨-booleanAlgebra : BooleanAlgebra _ _ ∧-∨-booleanAlgebra = record { isBooleanAlgebra = ∧-∨-isBooleanAlgebra } ------------------------------------------------------------------------ -- (∨, ∧, ⊥, ⊤) and (∧, ∨, ⊤, ⊥) are commutative semirings ∧-identityʳ : RightIdentity ⊤ _∧_ ∧-identityʳ x = begin x ∧ ⊤ ≈⟨ ∧-congˡ (sym (∨-complementʳ _)) ⟩ x ∧ (x ∨ ¬ x) ≈⟨ ∧-absorbs-∨ _ _ ⟩ x ∎ ∧-identityˡ : LeftIdentity ⊤ _∧_ ∧-identityˡ = comm+idʳ⇒idˡ ∧-comm ∧-identityʳ ∧-identity : Identity ⊤ _∧_ ∧-identity = ∧-identityˡ , ∧-identityʳ ∨-identityʳ : RightIdentity ⊥ _∨_ ∨-identityʳ x = begin x ∨ ⊥ ≈⟨ ∨-congˡ $ sym (∧-complementʳ _) ⟩ x ∨ x ∧ ¬ x ≈⟨ ∨-absorbs-∧ _ _ ⟩ x ∎ ∨-identityˡ : LeftIdentity ⊥ _∨_ ∨-identityˡ = comm+idʳ⇒idˡ ∨-comm ∨-identityʳ ∨-identity : Identity ⊥ _∨_ ∨-identity = ∨-identityˡ , ∨-identityʳ ∧-zeroʳ : RightZero ⊥ _∧_ ∧-zeroʳ x = begin x ∧ ⊥ ≈˘⟨ ∧-congˡ (∧-complementʳ x) ⟩ x ∧ x ∧ ¬ x ≈˘⟨ ∧-assoc x x (¬ x) ⟩ (x ∧ x) ∧ ¬ x ≈⟨ ∧-congʳ (∧-idempotent x) ⟩ x ∧ ¬ x ≈⟨ ∧-complementʳ x ⟩ ⊥ ∎ ∧-zeroˡ : LeftZero ⊥ _∧_ ∧-zeroˡ = comm+zeʳ⇒zeˡ ∧-comm ∧-zeroʳ ∧-zero : Zero ⊥ _∧_ ∧-zero = ∧-zeroˡ , ∧-zeroʳ ∨-zeroʳ : ∀ x → x ∨ ⊤ ≈ ⊤ ∨-zeroʳ x = begin x ∨ ⊤ ≈˘⟨ ∨-congˡ (∨-complementʳ x) ⟩ x ∨ x ∨ ¬ x ≈˘⟨ ∨-assoc x x (¬ x) ⟩ (x ∨ x) ∨ ¬ x ≈⟨ ∨-congʳ (∨-idempotent x) ⟩ x ∨ ¬ x ≈⟨ ∨-complementʳ x ⟩ ⊤ ∎ ∨-zeroˡ : LeftZero ⊤ _∨_ ∨-zeroˡ = comm+zeʳ⇒zeˡ ∨-comm ∨-zeroʳ ∨-zero : Zero ⊤ _∨_ ∨-zero = ∨-zeroˡ , ∨-zeroʳ ∨-⊥-isMonoid : IsMonoid _∨_ ⊥ ∨-⊥-isMonoid = record { isSemigroup = ∨-isSemigroup ; identity = ∨-identity } ∧-⊤-isMonoid : IsMonoid _∧_ ⊤ ∧-⊤-isMonoid = record { isSemigroup = ∧-isSemigroup ; identity = ∧-identity } ∨-⊥-isCommutativeMonoid : IsCommutativeMonoid _∨_ ⊥ ∨-⊥-isCommutativeMonoid = record { isMonoid = ∨-⊥-isMonoid ; comm = ∨-comm } ∧-⊤-isCommutativeMonoid : IsCommutativeMonoid _∧_ ⊤ ∧-⊤-isCommutativeMonoid = record { isMonoid = ∧-⊤-isMonoid ; comm = ∧-comm } ∨-∧-isSemiring : IsSemiring _∨_ _∧_ ⊥ ⊤ ∨-∧-isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = ∨-⊥-isCommutativeMonoid ; *-isMonoid = ∧-⊤-isMonoid ; distrib = ∧-∨-distrib } ; zero = ∧-zero } ∧-∨-isSemiring : IsSemiring _∧_ _∨_ ⊤ ⊥ ∧-∨-isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = ∧-⊤-isCommutativeMonoid ; *-isMonoid = ∨-⊥-isMonoid ; distrib = ∨-∧-distrib } ; zero = ∨-zero } ∨-∧-isCommutativeSemiring : IsCommutativeSemiring _∨_ _∧_ ⊥ ⊤ ∨-∧-isCommutativeSemiring = record { isSemiring = ∨-∧-isSemiring ; *-comm = ∧-comm } ∧-∨-isCommutativeSemiring : IsCommutativeSemiring _∧_ _∨_ ⊤ ⊥ ∧-∨-isCommutativeSemiring = record { isSemiring = ∧-∨-isSemiring ; *-comm = ∨-comm } ∨-∧-commutativeSemiring : CommutativeSemiring _ _ ∨-∧-commutativeSemiring = record { isCommutativeSemiring = ∨-∧-isCommutativeSemiring } ∧-∨-commutativeSemiring : CommutativeSemiring _ _ ∧-∨-commutativeSemiring = record { isCommutativeSemiring = ∧-∨-isCommutativeSemiring } ------------------------------------------------------------------------ -- Some other properties -- I took the statement of this lemma (called Uniqueness of -- Complements) from some course notes, "Boolean Algebra", written -- by Gert Smolka. private lemma : ∀ x y → x ∧ y ≈ ⊥ → x ∨ y ≈ ⊤ → ¬ x ≈ y lemma x y x∧y=⊥ x∨y=⊤ = begin ¬ x ≈˘⟨ ∧-identityʳ _ ⟩ ¬ x ∧ ⊤ ≈˘⟨ ∧-congˡ x∨y=⊤ ⟩ ¬ x ∧ (x ∨ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ ¬ x ∧ x ∨ ¬ x ∧ y ≈⟨ ∨-congʳ $ ∧-complementˡ _ ⟩ ⊥ ∨ ¬ x ∧ y ≈˘⟨ ∨-congʳ x∧y=⊥ ⟩ x ∧ y ∨ ¬ x ∧ y ≈˘⟨ ∧-∨-distribʳ _ _ _ ⟩ (x ∨ ¬ x) ∧ y ≈⟨ ∧-congʳ $ ∨-complementʳ _ ⟩ ⊤ ∧ y ≈⟨ ∧-identityˡ _ ⟩ y ∎ ⊥≉⊤ : ¬ ⊥ ≈ ⊤ ⊥≉⊤ = lemma ⊥ ⊤ (∧-identityʳ _) (∨-zeroʳ _) ⊤≉⊥ : ¬ ⊤ ≈ ⊥ ⊤≉⊥ = lemma ⊤ ⊥ (∧-zeroʳ _) (∨-identityʳ _) ¬-involutive : Involutive ¬_ ¬-involutive x = lemma (¬ x) x (∧-complementˡ _) (∨-complementˡ _) deMorgan₁ : ∀ x y → ¬ (x ∧ y) ≈ ¬ x ∨ ¬ y deMorgan₁ x y = lemma (x ∧ y) (¬ x ∨ ¬ y) lem₁ lem₂ where lem₁ = begin (x ∧ y) ∧ (¬ x ∨ ¬ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ (x ∧ y) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∨-congʳ $ ∧-congʳ $ ∧-comm _ _ ⟩ (y ∧ x) ∧ ¬ x ∨ (x ∧ y) ∧ ¬ y ≈⟨ ∧-assoc _ _ _ ⟨ ∨-cong ⟩ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ ¬ x) ∨ x ∧ (y ∧ ¬ y) ≈⟨ (∧-congˡ $ ∧-complementʳ _) ⟨ ∨-cong ⟩ (∧-congˡ $ ∧-complementʳ _) ⟩ (y ∧ ⊥) ∨ (x ∧ ⊥) ≈⟨ ∧-zeroʳ _ ⟨ ∨-cong ⟩ ∧-zeroʳ _ ⟩ ⊥ ∨ ⊥ ≈⟨ ∨-identityʳ _ ⟩ ⊥ ∎ lem₃ = begin (x ∧ y) ∨ ¬ x ≈⟨ ∨-∧-distribʳ _ _ _ ⟩ (x ∨ ¬ x) ∧ (y ∨ ¬ x) ≈⟨ ∧-congʳ $ ∨-complementʳ _ ⟩ ⊤ ∧ (y ∨ ¬ x) ≈⟨ ∧-identityˡ _ ⟩ y ∨ ¬ x ≈⟨ ∨-comm _ _ ⟩ ¬ x ∨ y ∎ lem₂ = begin (x ∧ y) ∨ (¬ x ∨ ¬ y) ≈˘⟨ ∨-assoc _ _ _ ⟩ ((x ∧ y) ∨ ¬ x) ∨ ¬ y ≈⟨ ∨-congʳ lem₃ ⟩ (¬ x ∨ y) ∨ ¬ y ≈⟨ ∨-assoc _ _ _ ⟩ ¬ x ∨ (y ∨ ¬ y) ≈⟨ ∨-congˡ $ ∨-complementʳ _ ⟩ ¬ x ∨ ⊤ ≈⟨ ∨-zeroʳ _ ⟩ ⊤ ∎ deMorgan₂ : ∀ x y → ¬ (x ∨ y) ≈ ¬ x ∧ ¬ y deMorgan₂ x y = begin ¬ (x ∨ y) ≈˘⟨ ¬-cong $ ((¬-involutive _) ⟨ ∨-cong ⟩ (¬-involutive _)) ⟩ ¬ (¬ ¬ x ∨ ¬ ¬ y) ≈˘⟨ ¬-cong $ deMorgan₁ _ _ ⟩ ¬ ¬ (¬ x ∧ ¬ y) ≈⟨ ¬-involutive _ ⟩ ¬ x ∧ ¬ y ∎ ------------------------------------------------------------------------ -- (⊕, ∧, id, ⊥, ⊤) is a commutative ring -- This construction is parameterised over the definition of xor. module XorRing (xor : Op₂ Carrier) (⊕-def : ∀ x y → xor x y ≈ (x ∨ y) ∧ ¬ (x ∧ y)) where private infixl 6 _⊕_ _⊕_ : Op₂ Carrier _⊕_ = xor helper : ∀ {x y u v} → x ≈ y → u ≈ v → x ∧ ¬ u ≈ y ∧ ¬ v helper x≈y u≈v = x≈y ⟨ ∧-cong ⟩ ¬-cong u≈v ⊕-cong : Congruent₂ _⊕_ ⊕-cong {x} {y} {u} {v} x≈y u≈v = begin x ⊕ u ≈⟨ ⊕-def _ _ ⟩ (x ∨ u) ∧ ¬ (x ∧ u) ≈⟨ helper (x≈y ⟨ ∨-cong ⟩ u≈v) (x≈y ⟨ ∧-cong ⟩ u≈v) ⟩ (y ∨ v) ∧ ¬ (y ∧ v) ≈˘⟨ ⊕-def _ _ ⟩ y ⊕ v ∎ ⊕-comm : Commutative _⊕_ ⊕-comm x y = begin x ⊕ y ≈⟨ ⊕-def _ _ ⟩ (x ∨ y) ∧ ¬ (x ∧ y) ≈⟨ helper (∨-comm _ _) (∧-comm _ _) ⟩ (y ∨ x) ∧ ¬ (y ∧ x) ≈˘⟨ ⊕-def _ _ ⟩ y ⊕ x ∎ ¬-distribˡ-⊕ : ∀ x y → ¬ (x ⊕ y) ≈ ¬ x ⊕ y ¬-distribˡ-⊕ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-def _ _ ⟩ ¬ ((x ∨ y) ∧ (¬ (x ∧ y))) ≈⟨ ¬-cong (∧-∨-distribʳ _ _ _) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (x ∧ y))) ≈⟨ ¬-cong $ ∨-congˡ $ ∧-congˡ $ ¬-cong (∧-comm _ _) ⟩ ¬ ((x ∧ ¬ (x ∧ y)) ∨ (y ∧ ¬ (y ∧ x))) ≈⟨ ¬-cong $ lem _ _ ⟨ ∨-cong ⟩ lem _ _ ⟩ ¬ ((x ∧ ¬ y) ∨ (y ∧ ¬ x)) ≈⟨ deMorgan₂ _ _ ⟩ ¬ (x ∧ ¬ y) ∧ ¬ (y ∧ ¬ x) ≈⟨ ∧-congʳ $ deMorgan₁ _ _ ⟩ (¬ x ∨ (¬ ¬ y)) ∧ ¬ (y ∧ ¬ x) ≈⟨ helper (∨-congˡ $ ¬-involutive _) (∧-comm _ _) ⟩ (¬ x ∨ y) ∧ ¬ (¬ x ∧ y) ≈˘⟨ ⊕-def _ _ ⟩ ¬ x ⊕ y ∎ where lem : ∀ x y → x ∧ ¬ (x ∧ y) ≈ x ∧ ¬ y lem x y = begin x ∧ ¬ (x ∧ y) ≈⟨ ∧-congˡ $ deMorgan₁ _ _ ⟩ x ∧ (¬ x ∨ ¬ y) ≈⟨ ∧-∨-distribˡ _ _ _ ⟩ (x ∧ ¬ x) ∨ (x ∧ ¬ y) ≈⟨ ∨-congʳ $ ∧-complementʳ _ ⟩ ⊥ ∨ (x ∧ ¬ y) ≈⟨ ∨-identityˡ _ ⟩ x ∧ ¬ y ∎ ¬-distribʳ-⊕ : ∀ x y → ¬ (x ⊕ y) ≈ x ⊕ ¬ y ¬-distribʳ-⊕ x y = begin ¬ (x ⊕ y) ≈⟨ ¬-cong $ ⊕-comm _ _ ⟩ ¬ (y ⊕ x) ≈⟨ ¬-distribˡ-⊕ _ _ ⟩ ¬ y ⊕ x ≈⟨ ⊕-comm _ _ ⟩ x ⊕ ¬ y ∎ ⊕-annihilates-¬ : ∀ x y → x ⊕ y ≈ ¬ x ⊕ ¬ y ⊕-annihilates-¬ x y = begin x ⊕ y ≈˘⟨ ¬-involutive _ ⟩ ¬ ¬ (x ⊕ y) ≈⟨ ¬-cong $ ¬-distribˡ-⊕ _ _ ⟩ ¬ (¬ x ⊕ y) ≈⟨ ¬-distribʳ-⊕ _ _ ⟩ ¬ x ⊕ ¬ y ∎ ⊕-identityˡ : LeftIdentity ⊥ _⊕_ ⊕-identityˡ x = begin ⊥ ⊕ x ≈⟨ ⊕-def _ _ ⟩ (⊥ ∨ x) ∧ ¬ (⊥ ∧ x) ≈⟨ helper (∨-identityˡ _) (∧-zeroˡ _) ⟩ x ∧ ¬ ⊥ ≈⟨ ∧-congˡ ⊥≉⊤ ⟩ x ∧ ⊤ ≈⟨ ∧-identityʳ _ ⟩ x ∎ ⊕-identityʳ : RightIdentity ⊥ _⊕_ ⊕-identityʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-identityˡ _ ⊕-identity : Identity ⊥ _⊕_ ⊕-identity = ⊕-identityˡ , ⊕-identityʳ ⊕-inverseˡ : LeftInverse ⊥ id _⊕_ ⊕-inverseˡ x = begin x ⊕ x ≈⟨ ⊕-def _ _ ⟩ (x ∨ x) ∧ ¬ (x ∧ x) ≈⟨ helper (∨-idempotent _) (∧-idempotent _) ⟩ x ∧ ¬ x ≈⟨ ∧-complementʳ _ ⟩ ⊥ ∎ ⊕-inverseʳ : RightInverse ⊥ id _⊕_ ⊕-inverseʳ _ = ⊕-comm _ _ ⟨ trans ⟩ ⊕-inverseˡ _ ⊕-inverse : Inverse ⊥ id _⊕_ ⊕-inverse = ⊕-inverseˡ , ⊕-inverseʳ ∧-distribˡ-⊕ : _∧_ DistributesOverˡ _⊕_ ∧-distribˡ-⊕ x y z = begin x ∧ (y ⊕ z) ≈⟨ ∧-congˡ $ ⊕-def _ _ ⟩ x ∧ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ ¬ (y ∧ z) ≈⟨ ∧-congˡ $ deMorgan₁ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z) ≈˘⟨ ∨-identityˡ _ ⟩ ⊥ ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈⟨ ∨-congʳ lem₃ ⟩ ((x ∧ (y ∨ z)) ∧ ¬ x) ∨ ((x ∧ (y ∨ z)) ∧ (¬ y ∨ ¬ z)) ≈˘⟨ ∧-∨-distribˡ _ _ _ ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ (¬ y ∨ ¬ z)) ≈˘⟨ ∧-congˡ $ ∨-congˡ (deMorgan₁ _ _) ⟩ (x ∧ (y ∨ z)) ∧ (¬ x ∨ ¬ (y ∧ z)) ≈˘⟨ ∧-congˡ (deMorgan₁ _ _) ⟩ (x ∧ (y ∨ z)) ∧ ¬ (x ∧ (y ∧ z)) ≈⟨ helper refl lem₁ ⟩ (x ∧ (y ∨ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈⟨ ∧-congʳ $ ∧-∨-distribˡ _ _ _ ⟩ ((x ∧ y) ∨ (x ∧ z)) ∧ ¬ ((x ∧ y) ∧ (x ∧ z)) ≈˘⟨ ⊕-def _ _ ⟩ (x ∧ y) ⊕ (x ∧ z) ∎ where lem₂ = begin x ∧ (y ∧ z) ≈˘⟨ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ z ≈⟨ ∧-congʳ $ ∧-comm _ _ ⟩ (y ∧ x) ∧ z ≈⟨ ∧-assoc _ _ _ ⟩ y ∧ (x ∧ z) ∎ lem₁ = begin x ∧ (y ∧ z) ≈˘⟨ ∧-congʳ (∧-idempotent _) ⟩ (x ∧ x) ∧ (y ∧ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ (x ∧ (y ∧ z)) ≈⟨ ∧-congˡ lem₂ ⟩ x ∧ (y ∧ (x ∧ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ (x ∧ y) ∧ (x ∧ z) ∎ lem₃ = begin ⊥ ≈˘⟨ ∧-zeroʳ _ ⟩ (y ∨ z) ∧ ⊥ ≈˘⟨ ∧-congˡ (∧-complementʳ _) ⟩ (y ∨ z) ∧ (x ∧ ¬ x) ≈˘⟨ ∧-assoc _ _ _ ⟩ ((y ∨ z) ∧ x) ∧ ¬ x ≈⟨ ∧-comm _ _ ⟨ ∧-cong ⟩ refl ⟩ (x ∧ (y ∨ z)) ∧ ¬ x ∎ ∧-distribʳ-⊕ : _∧_ DistributesOverʳ _⊕_ ∧-distribʳ-⊕ = comm+distrˡ⇒distrʳ ⊕-cong ∧-comm ∧-distribˡ-⊕ ∧-distrib-⊕ : _∧_ DistributesOver _⊕_ ∧-distrib-⊕ = ∧-distribˡ-⊕ , ∧-distribʳ-⊕ private lemma₂ : ∀ x y u v → (x ∧ y) ∨ (u ∧ v) ≈ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) lemma₂ x y u v = begin (x ∧ y) ∨ (u ∧ v) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ ((x ∧ y) ∨ u) ∧ ((x ∧ y) ∨ v) ≈⟨ ∨-∧-distribʳ _ _ _ ⟨ ∧-cong ⟩ ∨-∧-distribʳ _ _ _ ⟩ ((x ∨ u) ∧ (y ∨ u)) ∧ ((x ∨ v) ∧ (y ∨ v)) ∎ ⊕-assoc : Associative _⊕_ ⊕-assoc x y z = sym $ begin x ⊕ (y ⊕ z) ≈⟨ refl ⟨ ⊕-cong ⟩ ⊕-def _ _ ⟩ x ⊕ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ⊕-def _ _ ⟩ (x ∨ ((y ∨ z) ∧ ¬ (y ∧ z))) ∧ ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ lem₃ ⟨ ∧-cong ⟩ lem₄ ⟩ (((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ ∧-assoc _ _ _ ⟩ ((x ∨ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈⟨ ∧-congˡ lem₅ ⟩ ((x ∨ y) ∨ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z))) ≈˘⟨ ∧-assoc _ _ _ ⟩ (((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈⟨ lem₁ ⟨ ∧-cong ⟩ lem₂ ⟩ (((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z) ∧ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ≈˘⟨ ⊕-def _ _ ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ⊕ z ≈˘⟨ ⊕-def _ _ ⟨ ⊕-cong ⟩ refl ⟩ (x ⊕ y) ⊕ z ∎ where lem₁ = begin ((x ∨ y) ∨ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈˘⟨ ∨-∧-distribʳ _ _ _ ⟩ ((x ∨ y) ∧ (¬ x ∨ ¬ y)) ∨ z ≈˘⟨ ∨-congʳ $ ∧-congˡ (deMorgan₁ _ _) ⟩ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ z ∎ lem₂′ = begin (x ∨ ¬ y) ∧ (¬ x ∨ y) ≈˘⟨ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ (⊤ ∧ (x ∨ ¬ y)) ∧ ((¬ x ∨ y) ∧ ⊤) ≈˘⟨ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (∧-congˡ $ ∨-complementˡ _) ⟩ ((¬ x ∨ x) ∧ (¬ y ∨ x)) ∧ ((¬ x ∨ y) ∧ (¬ y ∨ y)) ≈˘⟨ lemma₂ _ _ _ _ ⟩ (¬ x ∧ ¬ y) ∨ (x ∧ y) ≈˘⟨ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ ¬ (x ∨ y) ∨ ¬ ¬ (x ∧ y) ≈˘⟨ deMorgan₁ _ _ ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∎ lem₂ = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈˘⟨ ∨-∧-distribʳ _ _ _ ⟩ ((x ∨ ¬ y) ∧ (¬ x ∨ y)) ∨ ¬ z ≈⟨ ∨-congʳ lem₂′ ⟩ ¬ ((x ∨ y) ∧ ¬ (x ∧ y)) ∨ ¬ z ≈˘⟨ deMorgan₁ _ _ ⟩ ¬ (((x ∨ y) ∧ ¬ (x ∧ y)) ∧ z) ∎ lem₃ = begin x ∨ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ∨-congˡ $ ∧-congˡ $ deMorgan₁ _ _ ⟩ x ∨ ((y ∨ z) ∧ (¬ y ∨ ¬ z)) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ (x ∨ (y ∨ z)) ∧ (x ∨ (¬ y ∨ ¬ z)) ≈˘⟨ ∨-assoc _ _ _ ⟨ ∧-cong ⟩ ∨-assoc _ _ _ ⟩ ((x ∨ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z) ∎ lem₄′ = begin ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ deMorgan₁ _ _ ⟩ ¬ (y ∨ z) ∨ ¬ ¬ (y ∧ z) ≈⟨ deMorgan₂ _ _ ⟨ ∨-cong ⟩ ¬-involutive _ ⟩ (¬ y ∧ ¬ z) ∨ (y ∧ z) ≈⟨ lemma₂ _ _ _ _ ⟩ ((¬ y ∨ y) ∧ (¬ z ∨ y)) ∧ ((¬ y ∨ z) ∧ (¬ z ∨ z)) ≈⟨ (∨-complementˡ _ ⟨ ∧-cong ⟩ ∨-comm _ _) ⟨ ∧-cong ⟩ (∧-congˡ $ ∨-complementˡ _) ⟩ (⊤ ∧ (y ∨ ¬ z)) ∧ ((¬ y ∨ z) ∧ ⊤) ≈⟨ ∧-identityˡ _ ⟨ ∧-cong ⟩ ∧-identityʳ _ ⟩ (y ∨ ¬ z) ∧ (¬ y ∨ z) ∎ lem₄ = begin ¬ (x ∧ ((y ∨ z) ∧ ¬ (y ∧ z))) ≈⟨ deMorgan₁ _ _ ⟩ ¬ x ∨ ¬ ((y ∨ z) ∧ ¬ (y ∧ z)) ≈⟨ ∨-congˡ lem₄′ ⟩ ¬ x ∨ ((y ∨ ¬ z) ∧ (¬ y ∨ z)) ≈⟨ ∨-∧-distribˡ _ _ _ ⟩ (¬ x ∨ (y ∨ ¬ z)) ∧ (¬ x ∨ (¬ y ∨ z)) ≈˘⟨ ∨-assoc _ _ _ ⟨ ∧-cong ⟩ ∨-assoc _ _ _ ⟩ ((¬ x ∨ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z) ≈⟨ ∧-comm _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z) ∎ lem₅ = begin ((x ∨ ¬ y) ∨ ¬ z) ∧ (((¬ x ∨ ¬ y) ∨ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ≈˘⟨ ∧-assoc _ _ _ ⟩ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ ¬ y) ∨ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-congʳ $ ∧-comm _ _ ⟩ (((¬ x ∨ ¬ y) ∨ z) ∧ ((x ∨ ¬ y) ∨ ¬ z)) ∧ ((¬ x ∨ y) ∨ ¬ z) ≈⟨ ∧-assoc _ _ _ ⟩ ((¬ x ∨ ¬ y) ∨ z) ∧ (((x ∨ ¬ y) ∨ ¬ z) ∧ ((¬ x ∨ y) ∨ ¬ z)) ∎ ⊕-isMagma : IsMagma _⊕_ ⊕-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ⊕-cong } ⊕-isSemigroup : IsSemigroup _⊕_ ⊕-isSemigroup = record { isMagma = ⊕-isMagma ; assoc = ⊕-assoc } ⊕-⊥-isMonoid : IsMonoid _⊕_ ⊥ ⊕-⊥-isMonoid = record { isSemigroup = ⊕-isSemigroup ; identity = ⊕-identity } ⊕-⊥-isGroup : IsGroup _⊕_ ⊥ id ⊕-⊥-isGroup = record { isMonoid = ⊕-⊥-isMonoid ; inverse = ⊕-inverse ; ⁻¹-cong = id } ⊕-⊥-isAbelianGroup : IsAbelianGroup _⊕_ ⊥ id ⊕-⊥-isAbelianGroup = record { isGroup = ⊕-⊥-isGroup ; comm = ⊕-comm } ⊕-∧-isRing : IsRing _⊕_ _∧_ id ⊥ ⊤ ⊕-∧-isRing = record { +-isAbelianGroup = ⊕-⊥-isAbelianGroup ; *-isMonoid = ∧-⊤-isMonoid ; distrib = ∧-distrib-⊕ ; zero = ∧-zero } ⊕-∧-isCommutativeRing : IsCommutativeRing _⊕_ _∧_ id ⊥ ⊤ ⊕-∧-isCommutativeRing = record { isRing = ⊕-∧-isRing ; *-comm = ∧-comm } ⊕-∧-commutativeRing : CommutativeRing _ _ ⊕-∧-commutativeRing = record { isCommutativeRing = ⊕-∧-isCommutativeRing } ⊕-¬-distribˡ = ¬-distribˡ-⊕ {-# WARNING_ON_USAGE ⊕-¬-distribˡ "Warning: ⊕-¬-distribˡ was deprecated in v1.1. Please use ¬-distribˡ-⊕ instead." #-} ⊕-¬-distribʳ = ¬-distribʳ-⊕ {-# WARNING_ON_USAGE ⊕-¬-distribʳ "Warning: ⊕-¬-distribʳ was deprecated in v1.1. Please use ¬-distribʳ-⊕ instead." #-} isCommutativeRing = ⊕-∧-isCommutativeRing {-# WARNING_ON_USAGE isCommutativeRing "Warning: isCommutativeRing was deprecated in v1.1. Please use ⊕-∧-isCommutativeRing instead." #-} commutativeRing = ⊕-∧-commutativeRing {-# WARNING_ON_USAGE commutativeRing "Warning: commutativeRing was deprecated in v1.1. Please use ⊕-∧-commutativeRing instead." #-} infixl 6 _⊕_ _⊕_ : Op₂ Carrier x ⊕ y = (x ∨ y) ∧ ¬ (x ∧ y) module DefaultXorRing = XorRing _⊕_ (λ _ _ → refl) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 ¬⊥=⊤ = ⊥≉⊤ {-# WARNING_ON_USAGE ¬⊥=⊤ "Warning: ¬⊥=⊤ was deprecated in v1.1. Please use ⊥≉⊤ instead." #-} ¬⊤=⊥ = ⊤≉⊥ {-# WARNING_ON_USAGE ¬⊤=⊥ "Warning: ¬⊤=⊥ was deprecated in v1.1. Please use ⊤≉⊥ instead." #-} -- Version 1.4 replace-equality : {_≈′_ : Rel Carrier b₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → BooleanAlgebra _ _ replace-equality {_≈′_} ≈⇔≈′ = record { isBooleanAlgebra = record { isDistributiveLattice = DistributiveLattice.isDistributiveLattice (DistribLatticeProperties.replace-equality distributiveLattice ≈⇔≈′) ; ∨-complementʳ = λ x → to ⟨$⟩ ∨-complementʳ x ; ∧-complementʳ = λ x → to ⟨$⟩ ∧-complementʳ x ; ¬-cong = λ i≈j → to ⟨$⟩ ¬-cong (from ⟨$⟩ i≈j) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) {-# WARNING_ON_USAGE replace-equality "Warning: replace-equality was deprecated in v1.4. Please use isBooleanAlgebra from `Algebra.Construct.Subst.Equality` instead." #-} agda-stdlib-1.7.3/src/Algebra/Properties/BooleanAlgebra/000077500000000000000000000000001451211343400230105ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/BooleanAlgebra/Expression.agda000066400000000000000000000206051451211343400257700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Boolean algebra expressions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Properties.BooleanAlgebra.Expression {b} (B : BooleanAlgebra b b) where open BooleanAlgebra B open import Category.Applicative import Category.Applicative.Indexed as Applicative open import Category.Monad open import Data.Fin.Base using (Fin) open import Data.Nat.Base open import Data.Product using (_,_; proj₁; proj₂) open import Data.Vec.Base as Vec using (Vec) import Data.Vec.Categorical as VecCat import Function.Identity.Categorical as IdCat open import Data.Vec.Properties using (lookup-map) open import Data.Vec.Relation.Binary.Pointwise.Extensional as PW using (Pointwise; ext) open import Function open import Relation.Binary.PropositionalEquality as P using (_≗_) import Relation.Binary.Reflection as Reflection -- Expressions made up of variables and the operations of a boolean -- algebra. infixr 7 _and_ infixr 6 _or_ data Expr n : Set b where var : (x : Fin n) → Expr n _or_ _and_ : (e₁ e₂ : Expr n) → Expr n not : (e : Expr n) → Expr n top bot : Expr n -- The semantics of an expression, parametrised by an applicative -- functor. module Semantics {F : Set b → Set b} (A : RawApplicative F) where open RawApplicative A ⟦_⟧ : ∀ {n} → Expr n → Vec (F Carrier) n → F Carrier ⟦ var x ⟧ ρ = Vec.lookup ρ x ⟦ e₁ or e₂ ⟧ ρ = pure _∨_ ⊛ ⟦ e₁ ⟧ ρ ⊛ ⟦ e₂ ⟧ ρ ⟦ e₁ and e₂ ⟧ ρ = pure _∧_ ⊛ ⟦ e₁ ⟧ ρ ⊛ ⟦ e₂ ⟧ ρ ⟦ not e ⟧ ρ = pure ¬_ ⊛ ⟦ e ⟧ ρ ⟦ top ⟧ ρ = pure ⊤ ⟦ bot ⟧ ρ = pure ⊥ -- flip Semantics.⟦_⟧ e is natural. module Naturality {F₁ F₂ : Set b → Set b} {A₁ : RawApplicative F₁} {A₂ : RawApplicative F₂} (f : Applicative.Morphism A₁ A₂) where open P.≡-Reasoning open Applicative.Morphism f open Semantics A₁ renaming (⟦_⟧ to ⟦_⟧₁) open Semantics A₂ renaming (⟦_⟧ to ⟦_⟧₂) open RawApplicative A₁ renaming (pure to pure₁; _⊛_ to _⊛₁_) open RawApplicative A₂ renaming (pure to pure₂; _⊛_ to _⊛₂_) natural : ∀ {n} (e : Expr n) → op ∘ ⟦ e ⟧₁ ≗ ⟦ e ⟧₂ ∘ Vec.map op natural (var x) ρ = begin op (Vec.lookup ρ x) ≡⟨ P.sym $ lookup-map x op ρ ⟩ Vec.lookup (Vec.map op ρ) x ∎ natural (e₁ or e₂) ρ = begin op (pure₁ _∨_ ⊛₁ ⟦ e₁ ⟧₁ ρ ⊛₁ ⟦ e₂ ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ _∨_ ⊛₁ ⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pure₁ _∨_) ⊛₂ op (⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (P.cong₂ _⊛₂_ (op-pure _) (natural e₁ ρ)) (natural e₂ ρ) ⟩ pure₂ _∨_ ⊛₂ ⟦ e₁ ⟧₂ (Vec.map op ρ) ⊛₂ ⟦ e₂ ⟧₂ (Vec.map op ρ) ∎ natural (e₁ and e₂) ρ = begin op (pure₁ _∧_ ⊛₁ ⟦ e₁ ⟧₁ ρ ⊛₁ ⟦ e₂ ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ _∧_ ⊛₁ ⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-⊛ _ _) P.refl ⟩ op (pure₁ _∧_) ⊛₂ op (⟦ e₁ ⟧₁ ρ) ⊛₂ op (⟦ e₂ ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (P.cong₂ _⊛₂_ (op-pure _) (natural e₁ ρ)) (natural e₂ ρ) ⟩ pure₂ _∧_ ⊛₂ ⟦ e₁ ⟧₂ (Vec.map op ρ) ⊛₂ ⟦ e₂ ⟧₂ (Vec.map op ρ) ∎ natural (not e) ρ = begin op (pure₁ ¬_ ⊛₁ ⟦ e ⟧₁ ρ) ≡⟨ op-⊛ _ _ ⟩ op (pure₁ ¬_) ⊛₂ op (⟦ e ⟧₁ ρ) ≡⟨ P.cong₂ _⊛₂_ (op-pure _) (natural e ρ) ⟩ pure₂ ¬_ ⊛₂ ⟦ e ⟧₂ (Vec.map op ρ) ∎ natural top ρ = begin op (pure₁ ⊤) ≡⟨ op-pure _ ⟩ pure₂ ⊤ ∎ natural bot ρ = begin op (pure₁ ⊥) ≡⟨ op-pure _ ⟩ pure₂ ⊥ ∎ -- An example of how naturality can be used: Any boolean algebra can -- be lifted, in a pointwise manner, to vectors of carrier elements. lift : ℕ → BooleanAlgebra b b lift n = record { Carrier = Vec Carrier n ; _≈_ = Pointwise _≈_ ; _∨_ = zipWith _∨_ ; _∧_ = zipWith _∧_ ; ¬_ = map ¬_ ; ⊤ = pure ⊤ ; ⊥ = pure ⊥ ; isBooleanAlgebra = record { isDistributiveLattice = record { isLattice = record { isEquivalence = PW.isEquivalence isEquivalence ; ∨-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x or y , y or x) (∨-comm _ _) _ _ ; ∨-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x or y) or z , x or (y or z)) (∨-assoc _ _ _) _ _ _ ; ∨-cong = λ xs≈us ys≈vs → ext λ i → solve₁ i 4 (λ x y u v → x or y , u or v) _ _ _ _ (∨-cong (Pointwise.app xs≈us i) (Pointwise.app ys≈vs i)) ; ∧-comm = λ _ _ → ext λ i → solve i 2 (λ x y → x and y , y and x) (∧-comm _ _) _ _ ; ∧-assoc = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (x and y) and z , x and (y and z)) (∧-assoc _ _ _) _ _ _ ; ∧-cong = λ xs≈ys us≈vs → ext λ i → solve₁ i 4 (λ x y u v → x and y , u and v) _ _ _ _ (∧-cong (Pointwise.app xs≈ys i) (Pointwise.app us≈vs i)) ; absorptive = (λ _ _ → ext λ i → solve i 2 (λ x y → x or (x and y) , x) (∨-absorbs-∧ _ _) _ _) , (λ _ _ → ext λ i → solve i 2 (λ x y → x and (x or y) , x) (∧-absorbs-∨ _ _) _ _) } ; ∨-distribʳ-∧ = λ _ _ _ → ext λ i → solve i 3 (λ x y z → (y and z) or x , (y or x) and (z or x)) (∨-∧-distribʳ _ _ _) _ _ _ } ; ∨-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x or (not x) , top) (∨-complementʳ _) _ ; ∧-complementʳ = λ _ → ext λ i → solve i 1 (λ x → x and (not x) , bot) (∧-complementʳ _) _ ; ¬-cong = λ xs≈ys → ext λ i → solve₁ i 2 (λ x y → not x , not y) _ _ (¬-cong (Pointwise.app xs≈ys i)) } } where open RawApplicative VecCat.applicative using (pure; zipWith) renaming (_<$>_ to map) ⟦_⟧Id : ∀ {n} → Expr n → Vec Carrier n → Carrier ⟦_⟧Id = Semantics.⟦_⟧ IdCat.applicative ⟦_⟧Vec : ∀ {m n} → Expr n → Vec (Vec Carrier m) n → Vec Carrier m ⟦_⟧Vec = Semantics.⟦_⟧ VecCat.applicative open module R {n} (i : Fin n) = Reflection setoid var (λ e ρ → Vec.lookup (⟦ e ⟧Vec ρ) i) (λ e ρ → ⟦ e ⟧Id (Vec.map (flip Vec.lookup i) ρ)) (λ e ρ → sym $ reflexive $ Naturality.natural (VecCat.lookup-morphism i) e ρ) agda-stdlib-1.7.3/src/Algebra/Properties/CancellativeCommutativeSemiring.agda000066400000000000000000000032261451211343400273020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some properties of operations in CancellativeCommutativeSemiring. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (CancellativeCommutativeSemiring) open import Algebra.Definitions using (AlmostRightCancellative) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Relation.Binary using (Decidable) open import Relation.Nullary using (yes; no) open import Relation.Nullary.Negation using (contradiction) module Algebra.Properties.CancellativeCommutativeSemiring {a ℓ} (R : CancellativeCommutativeSemiring a ℓ) where open CancellativeCommutativeSemiring R open import Algebra.Consequences.Setoid setoid open import Relation.Binary.Reasoning.Setoid setoid *-almostCancelʳ : AlmostRightCancellative _≈_ 0# _*_ *-almostCancelʳ = comm+almostCancelˡ⇒almostCancelʳ *-comm *-cancelˡ-nonZero xy≈0⇒x≈0∨y≈0 : Decidable _≈_ → ∀ {x y} → x * y ≈ 0# → x ≈ 0# ⊎ y ≈ 0# xy≈0⇒x≈0∨y≈0 _≟_ {x} {y} xy≈0 with x ≟ 0# | y ≟ 0# ... | yes x≈0 | _ = inj₁ x≈0 ... | no _ | yes y≈0 = inj₂ y≈0 ... | no x≉0 | no y≉0 = contradiction y≈0 y≉0 where xy≈x*0 = trans xy≈0 (sym (zeroʳ x)) y≈0 = *-cancelˡ-nonZero y 0# x≉0 xy≈x*0 x≉0∧y≉0⇒xy≉0 : Decidable _≈_ → ∀ {x y} → x ≉ 0# → y ≉ 0# → x * y ≉ 0# x≉0∧y≉0⇒xy≉0 _≟_ x≉0 y≉0 xy≈0 with xy≈0⇒x≈0∨y≈0 _≟_ xy≈0 ... | inj₁ x≈0 = x≉0 x≈0 ... | inj₂ y≈0 = y≉0 y≈0 agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMagma/000077500000000000000000000000001451211343400234135ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMagma/Divisibility.agda000066400000000000000000000023751451211343400267040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of divisibility over commutative magmas ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (CommutativeMagma) open import Data.Product using (_×_; _,_; map) module Algebra.Properties.CommutativeMagma.Divisibility {a ℓ} (CM : CommutativeMagma a ℓ) where open CommutativeMagma CM open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------------ -- Re-export the contents of magmas open import Algebra.Properties.Magma.Divisibility magma public ------------------------------------------------------------------------------ -- Further properties x∣xy : ∀ x y → x ∣ x ∙ y x∣xy x y = y , comm y x xy≈z⇒x∣z : ∀ x y {z} → x ∙ y ≈ z → x ∣ z xy≈z⇒x∣z x y xy≈z = ∣-respʳ xy≈z (x∣xy x y) ∣-factors : ∀ x y → (x ∣ x ∙ y) × (y ∣ x ∙ y) ∣-factors x y = x∣xy x y , x∣yx y x ∣-factors-≈ : ∀ x y {z} → x ∙ y ≈ z → x ∣ z × y ∣ z ∣-factors-≈ x y xy≈z = xy≈z⇒x∣z x y xy≈z , xy≈z⇒y∣z x y xy≈z agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid.agda000066400000000000000000000234301451211343400244360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated Table {-# OPTIONS --warn=noUserWarning #-} open import Algebra.Bundles module Algebra.Properties.CommutativeMonoid {g₁ g₂} (M : CommutativeMonoid g₁ g₂) where open import Algebra.Operations.CommutativeMonoid M open import Algebra.Solver.CommutativeMonoid M open import Relation.Binary as B using (_Preserves_⟶_) open import Function open import Function.Equality using (_⟨$⟩_) open import Data.Product open import Data.Bool.Base using (Bool; true; false) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Fin.Base using (Fin; zero; suc) open import Data.List.Base as List using ([]; _∷_) import Data.Fin.Properties as FP open import Data.Fin.Permutation as Perm using (Permutation; Permutation′; _⟨$⟩ˡ_; _⟨$⟩ʳ_) open import Data.Fin.Permutation.Components as PermC open import Data.Table as Table open import Data.Table.Relation.Binary.Equality as TE using (_≗_) open import Data.Unit using (tt) import Data.Table.Properties as TP open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary as Nullary using (¬_; does; _because_) open import Relation.Nullary.Negation using (contradiction) open import Relation.Nullary.Decidable using (⌊_⌋; dec-true; dec-false) open import Relation.Nullary.Reflects using (invert) open CommutativeMonoid M renaming ( ε to 0# ; _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; comm to +-comm ) open import Algebra.Definitions _≈_ open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. module _ {n} where open B.Setoid (TE.setoid setoid n) public using () renaming (_≈_ to _≋_) -- Version 1.5 sumₜ-cong-≈ : ∀ {n} → sumₜ {n} Preserves _≋_ ⟶ _≈_ sumₜ-cong-≈ {zero} p = refl sumₜ-cong-≈ {suc n} p = +-cong (p _) (sumₜ-cong-≈ (p ∘ suc)) {-# WARNING_ON_USAGE sumₜ-cong-≈ "Warning: sumₜ-cong-≈ was deprecated in v1.5. Please use sum-cong-≋ from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} sumₜ-cong-≡ : ∀ {n} → sumₜ {n} Preserves _≗_ ⟶ _≡_ sumₜ-cong-≡ {zero} p = P.refl sumₜ-cong-≡ {suc n} p = P.cong₂ _+_ (p _) (sumₜ-cong-≡ (p ∘ suc)) {-# WARNING_ON_USAGE sumₜ-cong-≡ "Warning: sumₜ-cong-≡ was deprecated in v1.5. Please use sum-cong-≗ from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} sumₜ-idem-replicate : ∀ n {x} → _+_ IdempotentOn x → sumₜ (replicate {n = suc n} x) ≈ x sumₜ-idem-replicate zero idem = +-identityʳ _ sumₜ-idem-replicate (suc n) {x} idem = begin x + (x + sumₜ (replicate {n = n} x)) ≈⟨ sym (+-assoc _ _ _) ⟩ (x + x) + sumₜ (replicate {n = n} x) ≈⟨ +-congʳ idem ⟩ x + sumₜ (replicate {n = n} x) ≈⟨ sumₜ-idem-replicate n idem ⟩ x ∎ {-# WARNING_ON_USAGE sumₜ-idem-replicate "Warning: sumₜ-idem-replicate was deprecated in v1.5. Please use sum-replicate-idem from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} sumₜ-zero : ∀ n → sumₜ (replicate {n = n} 0#) ≈ 0# sumₜ-zero n = begin sumₜ (replicate {n = n} 0#) ≈⟨ sym (+-identityˡ _) ⟩ 0# + sumₜ (replicate {n = n} 0#) ≈⟨ sumₜ-idem-replicate n (+-identityˡ 0#) ⟩ 0# ∎ {-# WARNING_ON_USAGE sumₜ-zero "Warning: sumₜ-zero was deprecated in v1.5. Please use sum-replicate-zero from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} sumₜ-remove : ∀ {n} {i : Fin (suc n)} t → sumₜ t ≈ lookup t i + sumₜ (remove i t) sumₜ-remove {_} {zero} t = refl sumₜ-remove {suc n} {suc i} t′ = begin t₀ + ∑t ≈⟨ +-congˡ (sumₜ-remove t) ⟩ t₀ + (tᵢ + ∑t′) ≈⟨ solve 3 (λ x y z → x ⊕ (y ⊕ z) ⊜ y ⊕ (x ⊕ z)) refl t₀ tᵢ ∑t′ ⟩ tᵢ + (t₀ + ∑t′) ∎ where t = tail t′ t₀ = head t′ tᵢ = lookup t i ∑t = sumₜ t ∑t′ = sumₜ (remove i t) {-# WARNING_ON_USAGE sumₜ-remove "Warning: sumₜ-remove was deprecated in v1.5. Please use sum-remove from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} ∑-distrib-+ : ∀ n (f g : Fin n → Carrier) → ∑[ i < n ] (f i + g i) ≈ ∑[ i < n ] f i + ∑[ i < n ] g i ∑-distrib-+ zero f g = sym (+-identityˡ _) ∑-distrib-+ (suc n) f g = begin f₀ + g₀ + ∑fg ≈⟨ +-assoc _ _ _ ⟩ f₀ + (g₀ + ∑fg) ≈⟨ +-congˡ (+-congˡ (∑-distrib-+ n _ _)) ⟩ f₀ + (g₀ + (∑f + ∑g)) ≈⟨ solve 4 (λ a b c d → a ⊕ (c ⊕ (b ⊕ d)) ⊜ (a ⊕ b) ⊕ (c ⊕ d)) refl f₀ ∑f g₀ ∑g ⟩ (f₀ + ∑f) + (g₀ + ∑g) ∎ where f₀ = f zero g₀ = g zero ∑f = ∑[ i < n ] f (suc i) ∑g = ∑[ i < n ] g (suc i) ∑fg = ∑[ i < n ] (f (suc i) + g (suc i)) {-# WARNING_ON_USAGE ∑-distrib-+ "Warning: ∑-distrib-+ was deprecated in v1.5. Please use ∑-distrib-+ from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} ∑-comm : ∀ n m (f : Fin n → Fin m → Carrier) → ∑[ i < n ] ∑[ j < m ] f i j ≈ ∑[ j < m ] ∑[ i < n ] f i j ∑-comm zero m f = sym (sumₜ-zero m) ∑-comm (suc n) m f = begin ∑[ j < m ] f zero j + ∑[ i < n ] ∑[ j < m ] f (suc i) j ≈⟨ +-congˡ (∑-comm n m _) ⟩ ∑[ j < m ] f zero j + ∑[ j < m ] ∑[ i < n ] f (suc i) j ≈⟨ sym (∑-distrib-+ m _ _) ⟩ ∑[ j < m ] (f zero j + ∑[ i < n ] f (suc i) j) ∎ {-# WARNING_ON_USAGE ∑-distrib-+ "Warning: ∑-comm was deprecated in v1.5. Please use ∑-comm from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} sumₜ-permute : ∀ {m n} t (π : Permutation m n) → sumₜ t ≈ sumₜ (permute π t) sumₜ-permute {zero} {zero} t π = refl sumₜ-permute {zero} {suc n} t π = contradiction π (Perm.refute λ()) sumₜ-permute {suc m} {zero} t π = contradiction π (Perm.refute λ()) sumₜ-permute {suc m} {suc n} t π = begin sumₜ t ≡⟨⟩ lookup t 0i + sumₜ (remove 0i t) ≡⟨ P.cong₂ _+_ (P.cong (lookup t) (P.sym (Perm.inverseʳ π))) P.refl ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (remove 0i t) ≈⟨ +-congˡ (sumₜ-permute (remove 0i t) (Perm.remove (π ⟨$⟩ˡ 0i) π)) ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (permute (Perm.remove (π ⟨$⟩ˡ 0i) π) (remove 0i t)) ≡⟨ P.cong₂ _+_ P.refl (sumₜ-cong-≡ (P.sym ∘ TP.remove-permute π 0i t)) ⟩ lookup πt (π ⟨$⟩ˡ 0i) + sumₜ (remove (π ⟨$⟩ˡ 0i) πt) ≈⟨ sym (sumₜ-remove (permute π t)) ⟩ sumₜ πt ∎ where 0i = zero πt = permute π t {-# WARNING_ON_USAGE sumₜ-permute "Warning: sumₜ-permute was deprecated in v1.5. Please use sum-permute from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} ∑-permute : ∀ {m n} f (π : Permutation m n) → ∑[ i < n ] f i ≈ ∑[ i < m ] f (π ⟨$⟩ʳ i) ∑-permute = sumₜ-permute ∘ tabulate {-# WARNING_ON_USAGE ∑-permute "Warning: ∑-permute was deprecated in v1.5. Please use ∑-permute from `Algebra.Properties.CommutativeMonoid.Summation` instead." #-} -- If the function takes the same value at 'i' and 'j', then transposing 'i' and -- 'j' then selecting 'j' is the same as selecting 'i'. select-transpose : ∀ {n} t (i j : Fin n) → lookup t i ≈ lookup t j → ∀ k → (lookup (select 0# j t) ∘ PermC.transpose i j) k ≈ lookup (select 0# i t) k select-transpose _ i j e k with k FP.≟ i ... | true because _ rewrite dec-true (j FP.≟ j) P.refl = sym e ... | false because [k≢i] with k FP.≟ j ... | true because [k≡j] rewrite dec-false (i FP.≟ j) (invert [k≢i] ∘ P.trans (invert [k≡j]) ∘ P.sym) = refl ... | false because [k≢j] rewrite dec-false (k FP.≟ j) (invert [k≢j]) = refl -- Summing over a pulse gives you the single value picked out by the pulse. sumₜ-select : ∀ {n i} (t : Table Carrier n) → sumₜ (select 0# i t) ≈ lookup t i sumₜ-select {suc n} {i} t = begin sumₜ (select 0# i t) ≈⟨ sumₜ-remove {i = i} (select 0# i t) ⟩ lookup (select 0# i t) i + sumₜ (remove i (select 0# i t)) ≡⟨ P.cong₂ _+_ (TP.select-lookup t) (sumₜ-cong-≡ (TP.select-remove i t)) ⟩ lookup t i + sumₜ (replicate {n = n} 0#) ≈⟨ +-congˡ (sumₜ-zero n) ⟩ lookup t i + 0# ≈⟨ +-identityʳ _ ⟩ lookup t i ∎ -- Converting to a table then summing is the same as summing the original list sumₜ-fromList : ∀ xs → sumₜ (fromList xs) ≡ sumₗ xs sumₜ-fromList [] = P.refl sumₜ-fromList (x ∷ xs) = P.cong (_ +_) (sumₜ-fromList xs) -- Converting to a list then summing is the same as summing the original table sumₜ-toList : ∀ {n} (t : Table Carrier n) → sumₜ t ≡ sumₗ (toList t) sumₜ-toList {zero} _ = P.refl sumₜ-toList {suc n} _ = P.cong (_ +_) (sumₜ-toList {n} _) agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid/000077500000000000000000000000001451211343400236165ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid/Mult.agda000066400000000000000000000032211451211343400253530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication over a monoid (i.e. repeated addition) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (CommutativeMonoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc) module Algebra.Properties.CommutativeMonoid.Mult {a ℓ} (M : CommutativeMonoid a ℓ) where -- View of the monoid operator as addition open CommutativeMonoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congʳ to +-congʳ ; ∙-congˡ to +-congˡ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Relation.Binary.Reasoning.Setoid setoid open import Algebra.Properties.CommutativeSemigroup commutativeSemigroup ------------------------------------------------------------------------ -- Re-export definition and properties for monoids open import Algebra.Properties.Monoid.Mult monoid public ------------------------------------------------------------------------ -- Properties of _×_ ×-distrib-+ : ∀ x y n → n × (x + y) ≈ n × x + n × y ×-distrib-+ x y zero = sym (+-identityˡ 0# ) ×-distrib-+ x y (suc n) = begin x + y + n × (x + y) ≈⟨ +-congˡ (×-distrib-+ x y n) ⟩ x + y + (n × x + n × y) ≈⟨ +-assoc x y (n × x + n × y) ⟩ x + (y + (n × x + n × y)) ≈⟨ +-congˡ (x∙yz≈y∙xz y (n × x) (n × y)) ⟩ x + (n × x + suc n × y) ≈⟨ x∙yz≈xy∙z x (n × x) (suc n × y) ⟩ suc n × x + suc n × y ∎ agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid/Mult/000077500000000000000000000000001451211343400245375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid/Mult/TCOptimised.agda000066400000000000000000000032051451211343400275410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication over a monoid (i.e. repeated addition) optimised for -- type checking. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (CommutativeMonoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc) open import Relation.Binary.Core using (_Preserves_⟶_; _Preserves₂_⟶_⟶_) open import Relation.Binary.PropositionalEquality as P using (_≡_) module Algebra.Properties.CommutativeMonoid.Mult.TCOptimised {a ℓ} (M : CommutativeMonoid a ℓ) where open CommutativeMonoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Algebra.Properties.CommutativeMonoid.Mult M as U using () renaming (_×_ to _×ᵤ_) open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Re-export definition and properties for monoids open import Algebra.Properties.Monoid.Mult.TCOptimised monoid public ------------------------------------------------------------------------ -- Properties ×-distrib-+ : ∀ x y n → n × (x + y) ≈ n × x + n × y ×-distrib-+ x y n = begin n × (x + y) ≈˘⟨ ×ᵤ≈× n (x + y) ⟩ n ×ᵤ (x + y) ≈⟨ U.×-distrib-+ x y n ⟩ n ×ᵤ x + n ×ᵤ y ≈⟨ +-cong (×ᵤ≈× n x) (×ᵤ≈× n y) ⟩ n × x + n × y ∎ agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeMonoid/Sum.agda000066400000000000000000000111751451211343400252050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finite summations over a commutative monoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (CommutativeMonoid) open import Data.Bool.Base using (Bool; true; false) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; NonZero) open import Data.Fin.Base using (Fin; zero; suc) open import Data.Fin.Permutation as Perm using (Permutation; _⟨$⟩ˡ_; _⟨$⟩ʳ_) open import Data.Fin.Patterns using (0F) open import Data.Vec.Functional open import Function.Base using (_∘_) open import Function.Equality using (_⟨$⟩_) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary.Negation using (contradiction) module Algebra.Properties.CommutativeMonoid.Sum {a ℓ} (M : CommutativeMonoid a ℓ) where open CommutativeMonoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Algebra.Definitions _≈_ open import Algebra.Solver.CommutativeMonoid M open import Data.Vec.Functional.Relation.Binary.Equality.Setoid setoid open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Re-export summation over monoids open import Algebra.Properties.Monoid.Sum monoid public ------------------------------------------------------------------------ -- Properties -- When summing over a function from a finite set, we can pull out any -- value and move it to the front. sum-remove : ∀ {n} {i : Fin (suc n)} t → sum t ≈ t i + sum (remove i t) sum-remove {_} {zero} xs = refl sum-remove {suc n} {suc i} xs = begin t₀ + ∑t ≈⟨ +-congˡ (sum-remove t) ⟩ t₀ + (tᵢ + ∑t′) ≈⟨ solve 3 (λ x y z → x ⊕ (y ⊕ z) ⊜ y ⊕ (x ⊕ z)) refl t₀ tᵢ ∑t′ ⟩ tᵢ + (t₀ + ∑t′) ∎ where t = tail xs t₀ = head xs tᵢ = t i ∑t = sum t ∑t′ = sum (remove i t) -- The '∑' operator distributes over addition. ∑-distrib-+ : ∀ {n} (f g : Vector Carrier n) → ∑[ i < n ] (f i + g i) ≈ ∑[ i < n ] f i + ∑[ i < n ] g i ∑-distrib-+ {zero} f g = sym (+-identityˡ _) ∑-distrib-+ {suc n} f g = begin f₀ + g₀ + ∑fg ≈⟨ +-assoc _ _ _ ⟩ f₀ + (g₀ + ∑fg) ≈⟨ +-congˡ (+-congˡ (∑-distrib-+ (f ∘ suc) (g ∘ suc))) ⟩ f₀ + (g₀ + (∑f + ∑g)) ≈⟨ solve 4 (λ a b c d → a ⊕ (c ⊕ (b ⊕ d)) ⊜ (a ⊕ b) ⊕ (c ⊕ d)) refl f₀ ∑f g₀ ∑g ⟩ (f₀ + ∑f) + (g₀ + ∑g) ∎ where f₀ = f 0F g₀ = g 0F ∑f = ∑[ i < n ] f (suc i) ∑g = ∑[ i < n ] g (suc i) ∑fg = ∑[ i < n ] (f (suc i) + g (suc i)) -- The '∑' operator commutes with itself. ∑-comm : ∀ {m n} (f : Fin m → Fin n → Carrier) → ∑[ i < m ] ∑[ j < n ] f i j ≈ ∑[ j < n ] ∑[ i < m ] f i j ∑-comm {zero} {n} f = sym (sum-replicate-zero n) ∑-comm {suc m} {n} f = begin ∑[ j < n ] f zero j + ∑[ i < m ] ∑[ j < n ] f (suc i) j ≈⟨ +-congˡ (∑-comm (f ∘ suc)) ⟩ ∑[ j < n ] f zero j + ∑[ j < n ] ∑[ i < m ] f (suc i) j ≈⟨ sym (∑-distrib-+ (f zero) _) ⟩ ∑[ j < n ] (f zero j + ∑[ i < m ] f (suc i) j) ∎ -- Summation is insensitive to permutations of the input sum-permute : ∀ {m n} f (π : Permutation m n) → sum f ≈ sum (rearrange (π ⟨$⟩ʳ_) f) sum-permute {zero} {zero} f π = refl sum-permute {zero} {suc n} f π = contradiction π (Perm.refute λ()) sum-permute {suc m} {zero} f π = contradiction π (Perm.refute λ()) sum-permute {suc m} {suc n} f π = begin sum f ≡⟨⟩ f 0F + sum f/0 ≡˘⟨ P.cong (_+ sum f/0) (P.cong f (Perm.inverseʳ π)) ⟩ πf π₀ + sum f/0 ≈⟨ +-congˡ (sum-permute f/0 (Perm.remove π₀ π)) ⟩ πf π₀ + sum (rearrange (π/0 ⟨$⟩ʳ_) f/0) ≡˘⟨ P.cong (πf π₀ +_) (sum-cong-≗ (P.cong f ∘ Perm.punchIn-permute′ π 0F)) ⟩ πf π₀ + sum (remove π₀ πf) ≈⟨ sym (sum-remove πf) ⟩ sum πf ∎ where f/0 = remove 0F f π₀ = π ⟨$⟩ˡ 0F π/0 = Perm.remove π₀ π πf = rearrange (π ⟨$⟩ʳ_) f ∑-permute : ∀ {m n} (f : Vector Carrier n) (π : Permutation m n) → ∑[ i < n ] f i ≈ ∑[ i < m ] f (π ⟨$⟩ʳ i) ∑-permute f π = sum-permute f π agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemigroup.agda000066400000000000000000000117441451211343400251700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some theory for commutative semigroup ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (CommutativeSemigroup) module Algebra.Properties.CommutativeSemigroup {a ℓ} (CS : CommutativeSemigroup a ℓ) where open CommutativeSemigroup CS open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------------ -- Re-export the contents of semigroup open import Algebra.Properties.Semigroup semigroup public ------------------------------------------------------------------------------ -- Permutation laws for _∙_ for three factors. ------------------------------------------------------------------------------ -- Partitions (1,1). -- There are five nontrivial permutations. ------------------------------------------------------------------------------ x∙yz≈y∙xz : ∀ x y z → x ∙ (y ∙ z) ≈ y ∙ (x ∙ z) x∙yz≈y∙xz x y z = begin x ∙ (y ∙ z) ≈⟨ sym (assoc x y z) ⟩ (x ∙ y) ∙ z ≈⟨ ∙-congʳ (comm x y) ⟩ (y ∙ x) ∙ z ≈⟨ assoc y x z ⟩ y ∙ (x ∙ z) ∎ x∙yz≈z∙yx : ∀ x y z → x ∙ (y ∙ z) ≈ z ∙ (y ∙ x) x∙yz≈z∙yx x y z = begin x ∙ (y ∙ z) ≈⟨ ∙-congˡ (comm y z) ⟩ x ∙ (z ∙ y) ≈⟨ x∙yz≈y∙xz x z y ⟩ z ∙ (x ∙ y) ≈⟨ ∙-congˡ (comm x y) ⟩ z ∙ (y ∙ x) ∎ x∙yz≈x∙zy : ∀ x y z → x ∙ (y ∙ z) ≈ x ∙ (z ∙ y) x∙yz≈x∙zy _ y z = ∙-congˡ (comm y z) x∙yz≈y∙zx : ∀ x y z → x ∙ (y ∙ z) ≈ y ∙ (z ∙ x) x∙yz≈y∙zx x y z = begin x ∙ (y ∙ z) ≈⟨ comm x _ ⟩ (y ∙ z) ∙ x ≈⟨ assoc y z x ⟩ y ∙ (z ∙ x) ∎ x∙yz≈z∙xy : ∀ x y z → x ∙ (y ∙ z) ≈ z ∙ (x ∙ y) x∙yz≈z∙xy x y z = begin x ∙ (y ∙ z) ≈⟨ sym (assoc x y z) ⟩ (x ∙ y) ∙ z ≈⟨ comm _ z ⟩ z ∙ (x ∙ y) ∎ ------------------------------------------------------------------------------ -- Partitions (1,2). -- These permutation laws are proved by composing the proofs for -- partitions (1,1) with \p → trans p (sym (assoc _ _ _)). ------------------------------------------------------------------------------ x∙yz≈yx∙z : ∀ x y z → x ∙ (y ∙ z) ≈ (y ∙ x) ∙ z x∙yz≈yx∙z x y z = trans (x∙yz≈y∙xz x y z) (sym (assoc y x z)) x∙yz≈zy∙x : ∀ x y z → x ∙ (y ∙ z) ≈ (z ∙ y) ∙ x x∙yz≈zy∙x x y z = trans (x∙yz≈z∙yx x y z) (sym (assoc z y x)) x∙yz≈xz∙y : ∀ x y z → x ∙ (y ∙ z) ≈ (x ∙ z) ∙ y x∙yz≈xz∙y x y z = trans (x∙yz≈x∙zy x y z) (sym (assoc x z y)) x∙yz≈yz∙x : ∀ x y z → x ∙ (y ∙ z) ≈ (y ∙ z) ∙ x x∙yz≈yz∙x x y z = trans (x∙yz≈y∙zx _ _ _) (sym (assoc y z x)) x∙yz≈zx∙y : ∀ x y z → x ∙ (y ∙ z) ≈ (z ∙ x) ∙ y x∙yz≈zx∙y x y z = trans (x∙yz≈z∙xy x y z) (sym (assoc z x y)) ------------------------------------------------------------------------------ -- Partitions (2,1). -- Their laws are proved by composing proofs for partitions (1,1) with -- trans (assoc x y z). ------------------------------------------------------------------------------ xy∙z≈y∙xz : ∀ x y z → (x ∙ y) ∙ z ≈ y ∙ (x ∙ z) xy∙z≈y∙xz x y z = trans (assoc x y z) (x∙yz≈y∙xz x y z) xy∙z≈z∙yx : ∀ x y z → (x ∙ y) ∙ z ≈ z ∙ (y ∙ x) xy∙z≈z∙yx x y z = trans (assoc x y z) (x∙yz≈z∙yx x y z) xy∙z≈x∙zy : ∀ x y z → (x ∙ y) ∙ z ≈ x ∙ (z ∙ y) xy∙z≈x∙zy x y z = trans (assoc x y z) (x∙yz≈x∙zy x y z) xy∙z≈y∙zx : ∀ x y z → (x ∙ y) ∙ z ≈ y ∙ (z ∙ x) xy∙z≈y∙zx x y z = trans (assoc x y z) (x∙yz≈y∙zx x y z) xy∙z≈z∙xy : ∀ x y z → (x ∙ y) ∙ z ≈ z ∙ (x ∙ y) xy∙z≈z∙xy x y z = trans (assoc x y z) (x∙yz≈z∙xy x y z) ------------------------------------------------------------------------------ -- Partitions (2,2). -- These proofs are by composing with the proofs for (2,1). ------------------------------------------------------------------------------ xy∙z≈yx∙z : ∀ x y z → (x ∙ y) ∙ z ≈ (y ∙ x) ∙ z xy∙z≈yx∙z x y z = trans (xy∙z≈y∙xz _ _ _) (sym (assoc y x z)) xy∙z≈zy∙x : ∀ x y z → (x ∙ y) ∙ z ≈ (z ∙ y) ∙ x xy∙z≈zy∙x x y z = trans (xy∙z≈z∙yx x y z) (sym (assoc z y x)) xy∙z≈xz∙y : ∀ x y z → (x ∙ y) ∙ z ≈ (x ∙ z) ∙ y xy∙z≈xz∙y x y z = trans (xy∙z≈x∙zy x y z) (sym (assoc x z y)) xy∙z≈yz∙x : ∀ x y z → (x ∙ y) ∙ z ≈ (y ∙ z) ∙ x xy∙z≈yz∙x x y z = trans (xy∙z≈y∙zx x y z) (sym (assoc y z x)) xy∙z≈zx∙y : ∀ x y z → (x ∙ y) ∙ z ≈ (z ∙ x) ∙ y xy∙z≈zx∙y x y z = trans (xy∙z≈z∙xy x y z) (sym (assoc z x y)) agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemigroup/000077500000000000000000000000001451211343400243435ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemigroup/Divisibility.agda000066400000000000000000000035201451211343400276250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of divisibility over commutative semigroups ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (CommutativeSemigroup) open import Data.Product using (_,_) import Relation.Binary.Reasoning.Setoid as EqReasoning module Algebra.Properties.CommutativeSemigroup.Divisibility {a ℓ} (CS : CommutativeSemigroup a ℓ) where open CommutativeSemigroup CS open import Algebra.Properties.CommutativeSemigroup CS using (x∙yz≈xz∙y; x∙yz≈y∙xz) open EqReasoning setoid ------------------------------------------------------------------------------ -- Re-export the contents of divisibility over semigroups open import Algebra.Properties.Semigroup.Divisibility semigroup public ------------------------------------------------------------------------------ -- Re-export the contents of divisibility over commutative magmas open import Algebra.Properties.CommutativeMagma.Divisibility commutativeMagma public using (x∣xy; xy≈z⇒x∣z; ∣-factors; ∣-factors-≈) ------------------------------------------------------------------------------ -- New properties x∣y∧z∣x/y⇒xz∣y : ∀ {x y z} → ((x/y , _) : x ∣ y) → z ∣ x/y → x ∙ z ∣ y x∣y∧z∣x/y⇒xz∣y {x} {y} {z} (x/y , x/y∙x≈y) (p , pz≈x/y) = p , (begin p ∙ (x ∙ z) ≈⟨ x∙yz≈xz∙y p x z ⟩ (p ∙ z) ∙ x ≈⟨ ∙-congʳ pz≈x/y ⟩ x/y ∙ x ≈⟨ x/y∙x≈y ⟩ y ∎) x∣y⇒zx∣zy : ∀ {x y} z → x ∣ y → z ∙ x ∣ z ∙ y x∣y⇒zx∣zy {x} {y} z (q , qx≈y) = q , (begin q ∙ (z ∙ x) ≈⟨ x∙yz≈y∙xz q z x ⟩ z ∙ (q ∙ x) ≈⟨ ∙-congˡ qx≈y ⟩ z ∙ y ∎) agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemiring/000077500000000000000000000000001451211343400241465ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemiring/Exp.agda000066400000000000000000000015311451211343400255200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Exponentiation defined over a commutative semiring as repeated multiplication ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Properties.CommutativeSemiring.Exp {a ℓ} (S : CommutativeSemiring a ℓ) where open CommutativeSemiring S import Algebra.Properties.CommutativeMonoid.Mult *-commutativeMonoid as Mult ------------------------------------------------------------------------ -- Definition open import Algebra.Properties.Semiring.Exp semiring public ------------------------------------------------------------------------ -- Properties ^-distrib-* : ∀ x y n → (x * y) ^ n ≈ x ^ n * y ^ n ^-distrib-* = Mult.×-distrib-+ agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemiring/Exp/000077500000000000000000000000001451211343400247025ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/CommutativeSemiring/Exp/TCOptimised.agda000066400000000000000000000021751451211343400277110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Exponentiation over a semiring optimised for type-checking. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Nat.Base as ℕ using (zero; suc) import Data.Nat.Properties as ℕ open import Relation.Binary open import Relation.Binary.PropositionalEquality.Core using (_≡_) module Algebra.Properties.CommutativeSemiring.Exp.TCOptimised {a ℓ} (S : CommutativeSemiring a ℓ) where open CommutativeSemiring S open import Relation.Binary.Reasoning.Setoid setoid import Algebra.Properties.CommutativeMonoid.Mult.TCOptimised *-commutativeMonoid as Mult ------------------------------------------------------------------------ -- Re-export definition and properties for semirings open import Algebra.Properties.Semiring.Exp.TCOptimised semiring public ------------------------------------------------------------------------ -- Properties ^-distrib-* : ∀ x y n → (x * y) ^ n ≈ x ^ n * y ^ n ^-distrib-* = Mult.×-distrib-+ agda-stdlib-1.7.3/src/Algebra/Properties/DistributiveLattice.agda000066400000000000000000000112771451211343400247640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated names {-# OPTIONS --warn=noUserWarning #-} open import Algebra.Bundles module Algebra.Properties.DistributiveLattice {dl₁ dl₂} (DL : DistributiveLattice dl₁ dl₂) where open DistributiveLattice DL import Algebra.Properties.Lattice as LatticeProperties open import Algebra.Structures open import Algebra.Definitions _≈_ open import Relation.Binary open import Relation.Binary.Reasoning.Setoid setoid open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product using (_,_) ------------------------------------------------------------------------ -- Export properties of lattices open LatticeProperties lattice public hiding (replace-equality) ------------------------------------------------------------------------ -- Other properties ∨-distribˡ-∧ : _∨_ DistributesOverˡ _∧_ ∨-distribˡ-∧ x y z = begin x ∨ y ∧ z ≈⟨ ∨-comm _ _ ⟩ y ∧ z ∨ x ≈⟨ ∨-distribʳ-∧ _ _ _ ⟩ (y ∨ x) ∧ (z ∨ x) ≈⟨ ∨-comm _ _ ⟨ ∧-cong ⟩ ∨-comm _ _ ⟩ (x ∨ y) ∧ (x ∨ z) ∎ ∨-distrib-∧ : _∨_ DistributesOver _∧_ ∨-distrib-∧ = ∨-distribˡ-∧ , ∨-distribʳ-∧ ∧-distribˡ-∨ : _∧_ DistributesOverˡ _∨_ ∧-distribˡ-∨ x y z = begin x ∧ (y ∨ z) ≈⟨ ∧-congʳ $ sym (∧-absorbs-∨ _ _) ⟩ (x ∧ (x ∨ y)) ∧ (y ∨ z) ≈⟨ ∧-congʳ $ ∧-congˡ $ ∨-comm _ _ ⟩ (x ∧ (y ∨ x)) ∧ (y ∨ z) ≈⟨ ∧-assoc _ _ _ ⟩ x ∧ ((y ∨ x) ∧ (y ∨ z)) ≈⟨ ∧-congˡ $ sym (∨-distribˡ-∧ _ _ _) ⟩ x ∧ (y ∨ x ∧ z) ≈⟨ ∧-congʳ $ sym (∨-absorbs-∧ _ _) ⟩ (x ∨ x ∧ z) ∧ (y ∨ x ∧ z) ≈⟨ sym $ ∨-distribʳ-∧ _ _ _ ⟩ x ∧ y ∨ x ∧ z ∎ ∧-distribʳ-∨ : _∧_ DistributesOverʳ _∨_ ∧-distribʳ-∨ x y z = begin (y ∨ z) ∧ x ≈⟨ ∧-comm _ _ ⟩ x ∧ (y ∨ z) ≈⟨ ∧-distribˡ-∨ _ _ _ ⟩ x ∧ y ∨ x ∧ z ≈⟨ ∧-comm _ _ ⟨ ∨-cong ⟩ ∧-comm _ _ ⟩ y ∧ x ∨ z ∧ x ∎ ∧-distrib-∨ : _∧_ DistributesOver _∨_ ∧-distrib-∨ = ∧-distribˡ-∨ , ∧-distribʳ-∨ -- The dual construction is also a distributive lattice. ∧-∨-isDistributiveLattice : IsDistributiveLattice _≈_ _∧_ _∨_ ∧-∨-isDistributiveLattice = record { isLattice = ∧-∨-isLattice ; ∨-distribʳ-∧ = ∧-distribʳ-∨ } ∧-∨-distributiveLattice : DistributiveLattice _ _ ∧-∨-distributiveLattice = record { isDistributiveLattice = ∧-∨-isDistributiveLattice } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 ∨-∧-distribˡ = ∨-distribˡ-∧ {-# WARNING_ON_USAGE ∨-∧-distribˡ "Warning: ∨-∧-distribˡ was deprecated in v1.1. Please use ∨-distribˡ-∧ instead." #-} ∨-∧-distrib = ∨-distrib-∧ {-# WARNING_ON_USAGE ∨-∧-distrib "Warning: ∨-∧-distrib was deprecated in v1.1. Please use ∨-distrib-∧ instead." #-} ∧-∨-distribˡ = ∧-distribˡ-∨ {-# WARNING_ON_USAGE ∧-∨-distribˡ "Warning: ∧-∨-distribˡ was deprecated in v1.1. Please use ∧-distribˡ-∨ instead." #-} ∧-∨-distribʳ = ∧-distribʳ-∨ {-# WARNING_ON_USAGE ∧-∨-distribʳ "Warning: ∧-∨-distribʳ was deprecated in v1.1. Please use ∧-distribʳ-∨ instead." #-} ∧-∨-distrib = ∧-distrib-∨ {-# WARNING_ON_USAGE ∧-∨-distrib "Warning: ∧-∨-distrib was deprecated in v1.1. Please use ∧-distrib-∨ instead." #-} -- Version 1.4 replace-equality : {_≈′_ : Rel Carrier dl₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → DistributiveLattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { isDistributiveLattice = record { isLattice = Lattice.isLattice (LatticeProperties.replace-equality lattice ≈⇔≈′) ; ∨-distribʳ-∧ = λ x y z → to ⟨$⟩ ∨-distribʳ-∧ x y z } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) {-# WARNING_ON_USAGE replace-equality "Warning: replace-equality was deprecated in v1.4. Please use isDistributiveLattice from `Algebra.Construct.Subst.Equality` instead." #-} agda-stdlib-1.7.3/src/Algebra/Properties/Group.agda000066400000000000000000000114741451211343400220740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles module Algebra.Properties.Group {g₁ g₂} (G : Group g₁ g₂) where open Group G open import Algebra.Definitions _≈_ open import Relation.Binary.Reasoning.Setoid setoid open import Function open import Data.Product ε⁻¹≈ε : ε ⁻¹ ≈ ε ε⁻¹≈ε = begin ε ⁻¹ ≈⟨ sym $ identityʳ (ε ⁻¹) ⟩ ε ⁻¹ ∙ ε ≈⟨ inverseˡ ε ⟩ ε ∎ private left-helper : ∀ x y → x ≈ (x ∙ y) ∙ y ⁻¹ left-helper x y = begin x ≈⟨ sym (identityʳ x) ⟩ x ∙ ε ≈⟨ ∙-congˡ $ sym (inverseʳ y) ⟩ x ∙ (y ∙ y ⁻¹) ≈⟨ sym (assoc x y (y ⁻¹)) ⟩ (x ∙ y) ∙ y ⁻¹ ∎ right-helper : ∀ x y → y ≈ x ⁻¹ ∙ (x ∙ y) right-helper x y = begin y ≈⟨ sym (identityˡ y) ⟩ ε ∙ y ≈⟨ ∙-congʳ $ sym (inverseˡ x) ⟩ (x ⁻¹ ∙ x) ∙ y ≈⟨ assoc (x ⁻¹) x y ⟩ x ⁻¹ ∙ (x ∙ y) ∎ ∙-cancelˡ : LeftCancellative _∙_ ∙-cancelˡ x {y} {z} eq = begin y ≈⟨ right-helper x y ⟩ x ⁻¹ ∙ (x ∙ y) ≈⟨ ∙-congˡ eq ⟩ x ⁻¹ ∙ (x ∙ z) ≈˘⟨ right-helper x z ⟩ z ∎ ∙-cancelʳ : RightCancellative _∙_ ∙-cancelʳ {x} y z eq = begin y ≈⟨ left-helper y x ⟩ y ∙ x ∙ x ⁻¹ ≈⟨ ∙-congʳ eq ⟩ z ∙ x ∙ x ⁻¹ ≈˘⟨ left-helper z x ⟩ z ∎ ∙-cancel : Cancellative _∙_ ∙-cancel = ∙-cancelˡ , ∙-cancelʳ ⁻¹-involutive : ∀ x → x ⁻¹ ⁻¹ ≈ x ⁻¹-involutive x = begin x ⁻¹ ⁻¹ ≈˘⟨ identityʳ _ ⟩ x ⁻¹ ⁻¹ ∙ ε ≈˘⟨ ∙-congˡ $ inverseˡ _ ⟩ x ⁻¹ ⁻¹ ∙ (x ⁻¹ ∙ x) ≈˘⟨ right-helper (x ⁻¹) x ⟩ x ∎ ⁻¹-injective : ∀ {x y} → x ⁻¹ ≈ y ⁻¹ → x ≈ y ⁻¹-injective {x} {y} eq = ∙-cancelʳ x y ( begin x ∙ x ⁻¹ ≈⟨ inverseʳ x ⟩ ε ≈˘⟨ inverseʳ y ⟩ y ∙ y ⁻¹ ≈˘⟨ ∙-congˡ eq ⟩ y ∙ x ⁻¹ ∎ ) ⁻¹-anti-homo-∙ : ∀ x y → (x ∙ y) ⁻¹ ≈ y ⁻¹ ∙ x ⁻¹ ⁻¹-anti-homo-∙ x y = ∙-cancelˡ _ ( begin x ∙ y ∙ (x ∙ y) ⁻¹ ≈⟨ inverseʳ _ ⟩ ε ≈˘⟨ inverseʳ _ ⟩ x ∙ x ⁻¹ ≈⟨ ∙-congʳ (left-helper x y) ⟩ (x ∙ y) ∙ y ⁻¹ ∙ x ⁻¹ ≈⟨ assoc (x ∙ y) (y ⁻¹) (x ⁻¹) ⟩ x ∙ y ∙ (y ⁻¹ ∙ x ⁻¹) ∎ ) identityˡ-unique : ∀ x y → x ∙ y ≈ y → x ≈ ε identityˡ-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ y ∙ y ⁻¹ ≈⟨ inverseʳ y ⟩ ε ∎ identityʳ-unique : ∀ x y → x ∙ y ≈ x → y ≈ ε identityʳ-unique x y eq = begin y ≈⟨ right-helper x y ⟩ x ⁻¹ ∙ (x ∙ y) ≈⟨ refl ⟨ ∙-cong ⟩ eq ⟩ x ⁻¹ ∙ x ≈⟨ inverseˡ x ⟩ ε ∎ identity-unique : ∀ {x} → Identity x _∙_ → x ≈ ε identity-unique {x} id = identityˡ-unique x x (proj₂ id x) inverseˡ-unique : ∀ x y → x ∙ y ≈ ε → x ≈ y ⁻¹ inverseˡ-unique x y eq = begin x ≈⟨ left-helper x y ⟩ (x ∙ y) ∙ y ⁻¹ ≈⟨ ∙-congʳ eq ⟩ ε ∙ y ⁻¹ ≈⟨ identityˡ (y ⁻¹) ⟩ y ⁻¹ ∎ inverseʳ-unique : ∀ x y → x ∙ y ≈ ε → y ≈ x ⁻¹ inverseʳ-unique x y eq = begin y ≈⟨ sym (⁻¹-involutive y) ⟩ y ⁻¹ ⁻¹ ≈⟨ ⁻¹-cong (sym (inverseˡ-unique x y eq)) ⟩ x ⁻¹ ∎ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 left-identity-unique = identityˡ-unique {-# WARNING_ON_USAGE left-identity-unique "Warning: left-identity-unique was deprecated in v1.1. Please use identityˡ-unique instead." #-} right-identity-unique = identityʳ-unique {-# WARNING_ON_USAGE right-identity-unique "Warning: right-identity-unique was deprecated in v1.1. Please use identityʳ-unique instead." #-} left-inverse-unique = inverseˡ-unique {-# WARNING_ON_USAGE left-inverse-unique "Warning: left-inverse-unique was deprecated in v1.1. Please use inverseˡ-unique instead." #-} right-inverse-unique = inverseʳ-unique {-# WARNING_ON_USAGE right-inverse-unique "Warning: right-inverse-unique was deprecated in v1.1. Please use inverseʳ-unique instead." #-} agda-stdlib-1.7.3/src/Algebra/Properties/Lattice.agda000066400000000000000000000165711451211343400223700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles module Algebra.Properties.Lattice {l₁ l₂} (L : Lattice l₁ l₂) where open Lattice L open import Algebra.Structures _≈_ open import Algebra.Definitions _≈_ import Algebra.Properties.Semilattice as SemilatticeProperties open import Relation.Binary import Relation.Binary.Lattice as R open import Relation.Binary.Reasoning.Setoid setoid open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; module Equivalence) open import Data.Product using (_,_; swap) ------------------------------------------------------------------------ -- _∧_ is a semilattice ∧-idem : Idempotent _∧_ ∧-idem x = begin x ∧ x ≈⟨ ∧-congˡ (sym (∨-absorbs-∧ _ _)) ⟩ x ∧ (x ∨ x ∧ x) ≈⟨ ∧-absorbs-∨ _ _ ⟩ x ∎ ∧-isMagma : IsMagma _∧_ ∧-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ∧-cong } ∧-isSemigroup : IsSemigroup _∧_ ∧-isSemigroup = record { isMagma = ∧-isMagma ; assoc = ∧-assoc } ∧-isBand : IsBand _∧_ ∧-isBand = record { isSemigroup = ∧-isSemigroup ; idem = ∧-idem } ∧-isSemilattice : IsSemilattice _∧_ ∧-isSemilattice = record { isBand = ∧-isBand ; comm = ∧-comm } ∧-semilattice : Semilattice l₁ l₂ ∧-semilattice = record { isSemilattice = ∧-isSemilattice } open SemilatticeProperties ∧-semilattice public using ( ∧-isOrderTheoreticMeetSemilattice ; ∧-isOrderTheoreticJoinSemilattice ; ∧-orderTheoreticMeetSemilattice ; ∧-orderTheoreticJoinSemilattice ) ------------------------------------------------------------------------ -- _∨_ is a semilattice ∨-idem : Idempotent _∨_ ∨-idem x = begin x ∨ x ≈⟨ ∨-congˡ (sym (∧-idem _)) ⟩ x ∨ x ∧ x ≈⟨ ∨-absorbs-∧ _ _ ⟩ x ∎ ∨-isMagma : IsMagma _∨_ ∨-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = ∨-cong } ∨-isSemigroup : IsSemigroup _∨_ ∨-isSemigroup = record { isMagma = ∨-isMagma ; assoc = ∨-assoc } ∨-isBand : IsBand _∨_ ∨-isBand = record { isSemigroup = ∨-isSemigroup ; idem = ∨-idem } ∨-isSemilattice : IsSemilattice _∨_ ∨-isSemilattice = record { isBand = ∨-isBand ; comm = ∨-comm } ∨-semilattice : Semilattice l₁ l₂ ∨-semilattice = record { isSemilattice = ∨-isSemilattice } open SemilatticeProperties ∨-semilattice public using () renaming ( ∧-isOrderTheoreticMeetSemilattice to ∨-isOrderTheoreticMeetSemilattice ; ∧-isOrderTheoreticJoinSemilattice to ∨-isOrderTheoreticJoinSemilattice ; ∧-orderTheoreticMeetSemilattice to ∨-orderTheoreticMeetSemilattice ; ∧-orderTheoreticJoinSemilattice to ∨-orderTheoreticJoinSemilattice ) ------------------------------------------------------------------------ -- The dual construction is also a lattice. ∧-∨-isLattice : IsLattice _∧_ _∨_ ∧-∨-isLattice = record { isEquivalence = isEquivalence ; ∨-comm = ∧-comm ; ∨-assoc = ∧-assoc ; ∨-cong = ∧-cong ; ∧-comm = ∨-comm ; ∧-assoc = ∨-assoc ; ∧-cong = ∨-cong ; absorptive = swap absorptive } ∧-∨-lattice : Lattice _ _ ∧-∨-lattice = record { isLattice = ∧-∨-isLattice } ------------------------------------------------------------------------ -- Every algebraic lattice can be turned into an order-theoretic one. open SemilatticeProperties ∧-semilattice public using (poset) open Poset poset using (_≤_; isPartialOrder) ∨-∧-isOrderTheoreticLattice : R.IsLattice _≈_ _≤_ _∨_ _∧_ ∨-∧-isOrderTheoreticLattice = record { isPartialOrder = isPartialOrder ; supremum = supremum ; infimum = infimum } where open R.MeetSemilattice ∧-orderTheoreticMeetSemilattice using (infimum) open R.JoinSemilattice ∨-orderTheoreticJoinSemilattice using (x≤x∨y; y≤x∨y; ∨-least) renaming (_≤_ to _≤′_) -- An alternative but equivalent interpretation of the order _≤_. sound : ∀ {x y} → x ≤′ y → x ≤ y sound {x} {y} y≈y∨x = sym $ begin x ∧ y ≈⟨ ∧-congˡ y≈y∨x ⟩ x ∧ (y ∨ x) ≈⟨ ∧-congˡ (∨-comm y x) ⟩ x ∧ (x ∨ y) ≈⟨ ∧-absorbs-∨ x y ⟩ x ∎ complete : ∀ {x y} → x ≤ y → x ≤′ y complete {x} {y} x≈x∧y = sym $ begin y ∨ x ≈⟨ ∨-congˡ x≈x∧y ⟩ y ∨ (x ∧ y) ≈⟨ ∨-congˡ (∧-comm x y) ⟩ y ∨ (y ∧ x) ≈⟨ ∨-absorbs-∧ y x ⟩ y ∎ supremum : R.Supremum _≤_ _∨_ supremum x y = sound (x≤x∨y x y) , sound (y≤x∨y x y) , λ z x≤z y≤z → sound (∨-least (complete x≤z) (complete y≤z)) ∨-∧-orderTheoreticLattice : R.Lattice _ _ _ ∨-∧-orderTheoreticLattice = record { isLattice = ∨-∧-isOrderTheoreticLattice } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 ∧-idempotent = ∧-idem {-# WARNING_ON_USAGE ∧-idempotent "Warning: ∧-idempotent was deprecated in v1.1. Please use ∧-idem instead." #-} ∨-idempotent = ∨-idem {-# WARNING_ON_USAGE ∨-idempotent "Warning: ∨-idempotent was deprecated in v1.1. Please use ∨-idem instead." #-} isOrderTheoreticLattice = ∨-∧-isOrderTheoreticLattice {-# WARNING_ON_USAGE isOrderTheoreticLattice "Warning: isOrderTheoreticLattice was deprecated in v1.1. Please use ∨-∧-isOrderTheoreticLattice instead." #-} orderTheoreticLattice = ∨-∧-orderTheoreticLattice {-# WARNING_ON_USAGE orderTheoreticLattice "Warning: orderTheoreticLattice was deprecated in v1.1. Please use ∨-∧-orderTheoreticLattice instead." #-} -- Version 1.4 replace-equality : {_≈′_ : Rel Carrier l₂} → (∀ {x y} → x ≈ y ⇔ (x ≈′ y)) → Lattice _ _ replace-equality {_≈′_} ≈⇔≈′ = record { isLattice = record { isEquivalence = record { refl = to ⟨$⟩ refl ; sym = λ x≈y → to ⟨$⟩ sym (from ⟨$⟩ x≈y) ; trans = λ x≈y y≈z → to ⟨$⟩ trans (from ⟨$⟩ x≈y) (from ⟨$⟩ y≈z) } ; ∨-comm = λ x y → to ⟨$⟩ ∨-comm x y ; ∨-assoc = λ x y z → to ⟨$⟩ ∨-assoc x y z ; ∨-cong = λ x≈y u≈v → to ⟨$⟩ ∨-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; ∧-comm = λ x y → to ⟨$⟩ ∧-comm x y ; ∧-assoc = λ x y z → to ⟨$⟩ ∧-assoc x y z ; ∧-cong = λ x≈y u≈v → to ⟨$⟩ ∧-cong (from ⟨$⟩ x≈y) (from ⟨$⟩ u≈v) ; absorptive = (λ x y → to ⟨$⟩ ∨-absorbs-∧ x y) , (λ x y → to ⟨$⟩ ∧-absorbs-∨ x y) } } where open module E {x y} = Equivalence (≈⇔≈′ {x} {y}) {-# WARNING_ON_USAGE replace-equality "Warning: replace-equality was deprecated in v1.4. Please use isLattice from `Algebra.Construct.Subst.Equality` instead." #-} agda-stdlib-1.7.3/src/Algebra/Properties/Magma/000077500000000000000000000000001451211343400211755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Magma/Divisibility.agda000066400000000000000000000034071451211343400244630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Divisibility over magmas ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Magma) open import Data.Product using (_×_; _,_; ∃; map; swap) open import Relation.Binary.Definitions module Algebra.Properties.Magma.Divisibility {a ℓ} (M : Magma a ℓ) where open Magma M ------------------------------------------------------------------------ -- Re-export divisibility relations publicly open import Algebra.Definitions.RawMagma rawMagma public using (_∣_; _∤_; _∣∣_; _∤∤_) ------------------------------------------------------------------------ -- Properties of divisibility ∣-respʳ : _∣_ Respectsʳ _≈_ ∣-respʳ y≈z (q , qx≈y) = q , trans qx≈y y≈z ∣-respˡ : _∣_ Respectsˡ _≈_ ∣-respˡ x≈z (q , qx≈y) = q , trans (∙-congˡ (sym x≈z)) qx≈y ∣-resp : _∣_ Respects₂ _≈_ ∣-resp = ∣-respʳ , ∣-respˡ x∣yx : ∀ x y → x ∣ y ∙ x x∣yx x y = y , refl xy≈z⇒y∣z : ∀ x y {z} → x ∙ y ≈ z → y ∣ z xy≈z⇒y∣z x y xy≈z = ∣-respʳ xy≈z (x∣yx y x) ------------------------------------------------------------------------ -- Properties of mutual divisibility _∣∣_ ∣∣-sym : Symmetric _∣∣_ ∣∣-sym = swap ∣∣-respʳ-≈ : _∣∣_ Respectsʳ _≈_ ∣∣-respʳ-≈ y≈z (x∣y , y∣x) = ∣-respʳ y≈z x∣y , ∣-respˡ y≈z y∣x ∣∣-respˡ-≈ : _∣∣_ Respectsˡ _≈_ ∣∣-respˡ-≈ x≈z (x∣y , y∣x) = ∣-respˡ x≈z x∣y , ∣-respʳ x≈z y∣x ∣∣-resp-≈ : _∣∣_ Respects₂ _≈_ ∣∣-resp-≈ = ∣∣-respʳ-≈ , ∣∣-respˡ-≈ agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/000077500000000000000000000000001451211343400214005ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/Divisibility.agda000066400000000000000000000032671451211343400246720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of divisibility over monoids ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Monoid) open import Data.Product using (_,_) open import Relation.Binary module Algebra.Properties.Monoid.Divisibility {a ℓ} (M : Monoid a ℓ) where open Monoid M ------------------------------------------------------------------------ -- Re-export semigroup divisibility open import Algebra.Properties.Semigroup.Divisibility semigroup public ------------------------------------------------------------------------ -- Additional properties ε∣_ : ∀ x → ε ∣ x ε∣ x = x , identityʳ x ∣-refl : Reflexive _∣_ ∣-refl {x} = ε , identityˡ x ∣-reflexive : _≈_ ⇒ _∣_ ∣-reflexive x≈y = ε , trans (identityˡ _) x≈y ∣-isPreorder : IsPreorder _≈_ _∣_ ∣-isPreorder = record { isEquivalence = isEquivalence ; reflexive = ∣-reflexive ; trans = ∣-trans } ∣-preorder : Preorder a ℓ _ ∣-preorder = record { isPreorder = ∣-isPreorder } ------------------------------------------------------------------------ -- Properties of mutual divisibiity ∣∣-refl : Reflexive _∣∣_ ∣∣-refl = ∣-refl , ∣-refl ∣∣-reflexive : _≈_ ⇒ _∣∣_ ∣∣-reflexive x≈y = ∣-reflexive x≈y , ∣-reflexive (sym x≈y) ∣∣-isEquivalence : IsEquivalence _∣∣_ ∣∣-isEquivalence = record { refl = λ {x} → ∣∣-refl {x} ; sym = λ {x} {y} → ∣∣-sym {x} {y} ; trans = λ {x} {y} {z} → ∣∣-trans {x} {y} {z} } agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/Mult.agda000066400000000000000000000045651451211343400231510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication over a monoid (i.e. repeated addition) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (Monoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; NonZero) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) module Algebra.Properties.Monoid.Mult {a ℓ} (M : Monoid a ℓ) where -- View of the monoid operator as addition open Monoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congʳ to +-congʳ ; ∙-congˡ to +-congˡ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Relation.Binary.Reasoning.Setoid setoid open import Algebra.Definitions _≈_ ------------------------------------------------------------------------ -- Definition open import Algebra.Definitions.RawMonoid rawMonoid public using (_×_) ------------------------------------------------------------------------ -- Properties of _×_ ×-congʳ : ∀ n → (n ×_) Preserves _≈_ ⟶ _≈_ ×-congʳ 0 x≈x′ = refl ×-congʳ (suc n) x≈x′ = +-cong x≈x′ (×-congʳ n x≈x′) ×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×-cong {n} P.refl x≈x′ = ×-congʳ n x≈x′ -- _×_ is homomorphic with respect to _ℕ+_/_+_. ×-homo-+ : ∀ x m n → (m ℕ.+ n) × x ≈ m × x + n × x ×-homo-+ x 0 n = sym (+-identityˡ (n × x)) ×-homo-+ x (suc m) n = begin x + (m ℕ.+ n) × x ≈⟨ +-cong refl (×-homo-+ x m n) ⟩ x + (m × x + n × x) ≈⟨ sym (+-assoc x (m × x) (n × x)) ⟩ x + m × x + n × x ∎ ×-idem : ∀ {c} → _+_ IdempotentOn c → ∀ n → .{{_ : NonZero n}} → n × c ≈ c ×-idem {c} idem (suc zero) = +-identityʳ c ×-idem {c} idem (suc (suc n)) = begin c + (suc n × c) ≈⟨ +-congˡ (×-idem idem (suc n) ) ⟩ c + c ≈⟨ idem ⟩ c ∎ ×-assocˡ : ∀ x m n → m × (n × x) ≈ (m ℕ.* n) × x ×-assocˡ x zero n = refl ×-assocˡ x (suc m) n = begin n × x + m × n × x ≈⟨ +-congˡ (×-assocˡ x m n) ⟩ n × x + (m ℕ.* n) × x ≈˘⟨ ×-homo-+ x n (m ℕ.* n) ⟩ (suc m ℕ.* n) × x ∎ agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/Mult/000077500000000000000000000000001451211343400223215ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/Mult/TCOptimised.agda000066400000000000000000000056521451211343400253330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication over a monoid (i.e. repeated addition) optimised for -- type checking. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (Monoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc) open import Relation.Binary.Core using (_Preserves_⟶_; _Preserves₂_⟶_⟶_) open import Relation.Binary.PropositionalEquality as P using (_≡_) module Algebra.Properties.Monoid.Mult.TCOptimised {a ℓ} (M : Monoid a ℓ) where open Monoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Algebra.Properties.Monoid.Mult M as U using () renaming (_×_ to _×ᵤ_) open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Definition open import Algebra.Definitions.RawMonoid rawMonoid public using () renaming (_×′_ to _×_) ------------------------------------------------------------------------ -- Properties 1+× : ∀ n x → suc n × x ≈ x + n × x 1+× 0 x = sym (+-identityʳ x) 1+× 1 x = refl 1+× (suc (suc n)) x = begin (suc (suc n) × x) + x ≈⟨ +-congʳ (1+× (suc n) x) ⟩ (x + suc n × x) + x ≈⟨ +-assoc x (suc n × x) x ⟩ x + (suc n × x + x) ∎ -- The unoptimised (_×ᵤ_) and optimised (_×_) versions of multiplication -- are extensionally equal (up to the setoid equivalence). ×ᵤ≈× : ∀ n x → n ×ᵤ x ≈ n × x ×ᵤ≈× 0 x = refl ×ᵤ≈× (suc n) x = begin x + n ×ᵤ x ≈⟨ +-congˡ (×ᵤ≈× n x) ⟩ x + n × x ≈˘⟨ 1+× n x ⟩ suc n × x ∎ -- _×_ is homomorphic with respect to _ℕ.+_/_+_. ×-homo-+ : ∀ c m n → (m ℕ.+ n) × c ≈ m × c + n × c ×-homo-+ c m n = begin (m ℕ.+ n) × c ≈˘⟨ ×ᵤ≈× (m ℕ.+ n) c ⟩ (m ℕ.+ n) ×ᵤ c ≈⟨ U.×-homo-+ c m n ⟩ m ×ᵤ c + n ×ᵤ c ≈⟨ +-cong (×ᵤ≈× m c) (×ᵤ≈× n c) ⟩ m × c + n × c ∎ -- _×_ preserves equality. ×-congʳ : ∀ n → (n ×_) Preserves _≈_ ⟶ _≈_ ×-congʳ 0 x≈y = refl ×-congʳ 1 x≈y = x≈y ×-congʳ (suc (suc n)) x≈y = +-cong (×-congʳ (suc n) x≈y) x≈y ×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_ ×-cong {n} P.refl x≈y = ×-congʳ n x≈y ×-assocˡ : ∀ x m n → m × (n × x) ≈ (m ℕ.* n) × x ×-assocˡ x m n = begin m × (n × x) ≈˘⟨ ×-congʳ m (×ᵤ≈× n x) ⟩ m × (n ×ᵤ x) ≈˘⟨ ×ᵤ≈× m (n ×ᵤ x) ⟩ m ×ᵤ (n ×ᵤ x) ≈⟨ U.×-assocˡ x m n ⟩ (m ℕ.* n) ×ᵤ x ≈⟨ ×ᵤ≈× (m ℕ.* n) x ⟩ (m ℕ.* n) × x ∎ agda-stdlib-1.7.3/src/Algebra/Properties/Monoid/Sum.agda000066400000000000000000000047341451211343400227720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finite summations over a monoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (Monoid) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; NonZero) open import Data.Vec.Functional as Vector open import Data.Fin.Base using (zero; suc) open import Data.Unit using (tt) open import Function.Base using (_∘_) open import Relation.Binary as B using (_Preserves_⟶_) open import Relation.Binary.PropositionalEquality as P using (_≗_; _≡_) module Algebra.Properties.Monoid.Sum {a ℓ} (M : Monoid a ℓ) where open Monoid M renaming ( _∙_ to _+_ ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; assoc to +-assoc ; ε to 0# ) open import Data.Vec.Functional.Relation.Binary.Equality.Setoid setoid open import Algebra.Properties.Monoid.Mult M open import Algebra.Definitions _≈_ ------------------------------------------------------------------------ -- Definition open import Algebra.Definitions.RawMonoid rawMonoid public using (sum) ------------------------------------------------------------------------ -- An alternative mathematical-style syntax for sumₜ infixl 10 sum-syntax sum-syntax : ∀ n → Vector Carrier n → Carrier sum-syntax _ = sum syntax sum-syntax n (λ i → x) = ∑[ i < n ] x ------------------------------------------------------------------------ -- Properties sum-cong-≋ : ∀ {n} → sum {n} Preserves _≋_ ⟶ _≈_ sum-cong-≋ {zero} xs≋ys = refl sum-cong-≋ {suc n} xs≋ys = +-cong (xs≋ys zero) (sum-cong-≋ (xs≋ys ∘ suc)) sum-cong-≗ : ∀ {n} → sum {n} Preserves _≗_ ⟶ _≡_ sum-cong-≗ {zero} xs≗ys = P.refl sum-cong-≗ {suc n} xs≗ys = P.cong₂ _+_ (xs≗ys zero) (sum-cong-≗ (xs≗ys ∘ suc)) sum-replicate : ∀ n {x} → sum {n} (replicate x) ≈ n × x sum-replicate zero = refl sum-replicate (suc n) = +-congˡ (sum-replicate n) sum-replicate-idem : ∀ {x} → _+_ IdempotentOn x → ∀ n → .{{_ : NonZero n}} → sum {n} (replicate x) ≈ x sum-replicate-idem idem n = trans (sum-replicate n) (×-idem idem n) sum-replicate-zero : ∀ n → sum {n} (replicate 0#) ≈ 0# sum-replicate-zero zero = refl sum-replicate-zero (suc n) = sum-replicate-idem (+-identityˡ 0#) (suc n) agda-stdlib-1.7.3/src/Algebra/Properties/Ring.agda000066400000000000000000000071061451211343400216740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some basic properties of Rings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Properties.Ring {r₁ r₂} (R : Ring r₁ r₂) where open Ring R import Algebra.Properties.AbelianGroup as AbelianGroupProperties open import Function.Base using (_$_) open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Export properties of abelian groups open AbelianGroupProperties +-abelianGroup public renaming ( ε⁻¹≈ε to -0#≈0# ; ∙-cancelˡ to +-cancelˡ ; ∙-cancelʳ to +-cancelʳ ; ∙-cancel to +-cancel ; ⁻¹-involutive to -‿involutive ; ⁻¹-injective to -‿injective ; ⁻¹-anti-homo-∙ to -‿anti-homo-+ ; identityˡ-unique to +-identityˡ-unique ; identityʳ-unique to +-identityʳ-unique ; identity-unique to +-identity-unique ; inverseˡ-unique to +-inverseˡ-unique ; inverseʳ-unique to +-inverseʳ-unique ; ⁻¹-∙-comm to -‿+-comm -- DEPRECATED ; left-identity-unique to +-left-identity-unique ; right-identity-unique to +-right-identity-unique ; left-inverse-unique to +-left-inverse-unique ; right-inverse-unique to +-right-inverse-unique ) ------------------------------------------------------------------------ -- Properties of -_ -‿distribˡ-* : ∀ x y → - (x * y) ≈ - x * y -‿distribˡ-* x y = sym $ begin - x * y ≈⟨ sym $ +-identityʳ _ ⟩ - x * y + 0# ≈⟨ +-congˡ $ sym (-‿inverseʳ _) ⟩ - x * y + (x * y + - (x * y)) ≈⟨ sym $ +-assoc _ _ _ ⟩ - x * y + x * y + - (x * y) ≈⟨ +-congʳ $ sym (distribʳ _ _ _) ⟩ (- x + x) * y + - (x * y) ≈⟨ +-congʳ $ *-congʳ $ -‿inverseˡ _ ⟩ 0# * y + - (x * y) ≈⟨ +-congʳ $ zeroˡ _ ⟩ 0# + - (x * y) ≈⟨ +-identityˡ _ ⟩ - (x * y) ∎ -‿distribʳ-* : ∀ x y → - (x * y) ≈ x * - y -‿distribʳ-* x y = sym $ begin x * - y ≈⟨ sym $ +-identityˡ _ ⟩ 0# + x * - y ≈⟨ +-congʳ $ sym (-‿inverseˡ _) ⟩ - (x * y) + x * y + x * - y ≈⟨ +-assoc _ _ _ ⟩ - (x * y) + (x * y + x * - y) ≈⟨ +-congˡ $ sym (distribˡ _ _ _) ⟩ - (x * y) + x * (y + - y) ≈⟨ +-congˡ $ *-congˡ $ -‿inverseʳ _ ⟩ - (x * y) + x * 0# ≈⟨ +-congˡ $ zeroʳ _ ⟩ - (x * y) + 0# ≈⟨ +-identityʳ _ ⟩ - (x * y) ∎ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 -‿*-distribˡ : ∀ x y → - x * y ≈ - (x * y) -‿*-distribˡ x y = sym (-‿distribˡ-* x y) {-# WARNING_ON_USAGE -‿*-distribˡ "Warning: -‿*-distribˡ was deprecated in v1.1. Please use -‿distribˡ-* instead. NOTE: the equality is flipped so you will need sym (-‿distribˡ-* ...)." #-} -‿*-distribʳ : ∀ x y → x * - y ≈ - (x * y) -‿*-distribʳ x y = sym (-‿distribʳ-* x y) {-# WARNING_ON_USAGE -‿*-distribʳ "Warning: -‿*-distribʳ was deprecated in v1.1. Please use -‿distribʳ-* instead. NOTE: the equality is flipped so you will need sym (-‿distribʳ-* ...)." #-} agda-stdlib-1.7.3/src/Algebra/Properties/Semigroup.agda000066400000000000000000000007551451211343400227520ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some theory for Semigroup ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Semigroup) module Algebra.Properties.Semigroup {a ℓ} (S : Semigroup a ℓ) where open Semigroup S x∙yz≈xy∙z : ∀ x y z → x ∙ (y ∙ z) ≈ (x ∙ y) ∙ z x∙yz≈xy∙z x y z = sym (assoc x y z) agda-stdlib-1.7.3/src/Algebra/Properties/Semigroup/000077500000000000000000000000001451211343400221255ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Semigroup/Divisibility.agda000066400000000000000000000021651451211343400254130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of divisibility over semigroups ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Semigroup) open import Data.Product using (_,_) open import Relation.Binary.Definitions using (Transitive) module Algebra.Properties.Semigroup.Divisibility {a ℓ} (S : Semigroup a ℓ) where open Semigroup S ------------------------------------------------------------------------ -- Re-export magma divisibility open import Algebra.Properties.Magma.Divisibility magma public ------------------------------------------------------------------------ -- Properties of _∣_ ∣-trans : Transitive _∣_ ∣-trans (p , px≈y) (q , qy≈z) = q ∙ p , trans (assoc q p _) (trans (∙-congˡ px≈y) qy≈z) ------------------------------------------------------------------------ -- Properties of _∣∣_ ∣∣-trans : Transitive _∣∣_ ∣∣-trans (x∣y , y∣x) (y∣z , z∣y) = ∣-trans x∣y y∣z , ∣-trans z∣y y∣x agda-stdlib-1.7.3/src/Algebra/Properties/Semilattice.agda000066400000000000000000000063731451211343400232450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some derivable properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Properties.Semilattice {c ℓ} (L : Semilattice c ℓ) where open Semilattice L open import Algebra.Structures open import Function open import Data.Product open import Relation.Binary open import Relation.Binary.Reasoning.Setoid setoid import Relation.Binary.Construct.NaturalOrder.Left _≈_ _∧_ as LeftNaturalOrder open import Relation.Binary.Lattice import Relation.Binary.Properties.Poset as PosetProperties open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Every semilattice can be turned into a poset via the left natural -- order. poset : Poset c ℓ ℓ poset = LeftNaturalOrder.poset isSemilattice open Poset poset using (_≤_; isPartialOrder) open PosetProperties poset using (_≥_; ≥-isPartialOrder) ------------------------------------------------------------------------ -- Every algebraic semilattice can be turned into an order-theoretic one. ∧-isOrderTheoreticMeetSemilattice : IsMeetSemilattice _≈_ _≤_ _∧_ ∧-isOrderTheoreticMeetSemilattice = record { isPartialOrder = isPartialOrder ; infimum = LeftNaturalOrder.infimum isSemilattice } ∧-isOrderTheoreticJoinSemilattice : IsJoinSemilattice _≈_ _≥_ _∧_ ∧-isOrderTheoreticJoinSemilattice = record { isPartialOrder = ≥-isPartialOrder ; supremum = IsMeetSemilattice.infimum ∧-isOrderTheoreticMeetSemilattice } ∧-orderTheoreticMeetSemilattice : MeetSemilattice c ℓ ℓ ∧-orderTheoreticMeetSemilattice = record { isMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice } ∧-orderTheoreticJoinSemilattice : JoinSemilattice c ℓ ℓ ∧-orderTheoreticJoinSemilattice = record { isJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 isOrderTheoreticMeetSemilattice = ∧-isOrderTheoreticMeetSemilattice {-# WARNING_ON_USAGE isOrderTheoreticMeetSemilattice "Warning: isOrderTheoreticMeetSemilattice was deprecated in v1.1. Please use ∧-isOrderTheoreticMeetSemilattice instead." #-} isOrderTheoreticJoinSemilattice = ∧-isOrderTheoreticJoinSemilattice {-# WARNING_ON_USAGE isOrderTheoreticJoinSemilattice "Warning: isOrderTheoreticJoinSemilattice was deprecated in v1.1. Please use ∧-isOrderTheoreticJoinSemilattice instead." #-} orderTheoreticMeetSemilattice = ∧-orderTheoreticMeetSemilattice {-# WARNING_ON_USAGE orderTheoreticMeetSemilattice "Warning: orderTheoreticMeetSemilattice was deprecated in v1.1. Please use ∧-orderTheoreticMeetSemilattice instead." #-} orderTheoreticJoinSemilattice = ∧-orderTheoreticJoinSemilattice {-# WARNING_ON_USAGE orderTheoreticJoinSemilattice "Warning: orderTheoreticJoinSemilattice was deprecated in v1.1. Please use ∧-orderTheoreticJoinSemilattice instead." #-} agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/000077500000000000000000000000001451211343400217305ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Divisibility.agda000066400000000000000000000024311451211343400252120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of divisibility over semirings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Semiring) import Algebra.Properties.Monoid.Divisibility as MonoidDivisibility open import Data.Product using (_,_) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) module Algebra.Properties.Semiring.Divisibility {a ℓ} (R : Semiring a ℓ) where open Semiring R ------------------------------------------------------------------------ -- Re-exporting divisibility over monoids open MonoidDivisibility *-monoid public renaming (ε∣_ to 1∣_) ------------------------------------------------------------------------ -- Divisibility properties specific to semirings. _∣0 : ∀ x → x ∣ 0# x ∣0 = 0# , zeroˡ x 0∣x⇒x≈0 : ∀ {x} → 0# ∣ x → x ≈ 0# 0∣x⇒x≈0 (q , q*0≈x) = trans (sym q*0≈x) (zeroʳ q) x∣y∧y≉0⇒x≉0 : ∀ {x y} → x ∣ y → y ≉ 0# → x ≉ 0# x∣y∧y≉0⇒x≉0 x∣y y≉0 x≈0 = y≉0 (0∣x⇒x≈0 (∣-respˡ x≈0 x∣y)) 0∤1 : 0# ≉ 1# → 0# ∤ 1# 0∤1 0≉1 (q , q*0≈1) = 0≉1 (trans (sym (zeroʳ q)) q*0≈1) agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Exp.agda000066400000000000000000000026201451211343400233020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Exponentiation defined over a semiring as repeated multiplication ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Nat.Base as ℕ using (ℕ; zero; suc) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) import Data.Nat.Properties as ℕ module Algebra.Properties.Semiring.Exp {a ℓ} (S : Semiring a ℓ) where open Semiring S renaming (zero to *-zero) open import Relation.Binary.Reasoning.Setoid setoid import Algebra.Properties.Monoid.Mult *-monoid as Mult ------------------------------------------------------------------------ -- Definition open import Algebra.Definitions.RawSemiring rawSemiring public using (_^_) ------------------------------------------------------------------------ -- Properties ^-congˡ : ∀ n → (_^ n) Preserves _≈_ ⟶ _≈_ ^-congˡ = Mult.×-congʳ ^-cong : _^_ Preserves₂ _≈_ ⟶ _≡_ ⟶ _≈_ ^-cong x≈y u≡v = Mult.×-cong u≡v x≈y -- xᵐ⁺ⁿ ≈ xᵐxⁿ ^-homo-* : ∀ x m n → x ^ (m ℕ.+ n) ≈ (x ^ m) * (x ^ n) ^-homo-* = Mult.×-homo-+ -- (xᵐ)ⁿ≈xᵐ*ⁿ ^-assocʳ : ∀ x m n → (x ^ m) ^ n ≈ x ^ (m ℕ.* n) ^-assocʳ x m n rewrite ℕ.*-comm m n = Mult.×-assocˡ x n m agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Exp/000077500000000000000000000000001451211343400224645ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Exp/TCOptimised.agda000066400000000000000000000030551451211343400254710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Exponentiation over a semiring optimised for type-checking. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Nat.Base as ℕ using (zero; suc) import Data.Nat.Properties as ℕ open import Relation.Binary open import Relation.Binary.PropositionalEquality.Core using (_≡_) module Algebra.Properties.Semiring.Exp.TCOptimised {a ℓ} (S : Semiring a ℓ) where open Semiring S renaming (zero to *-zero) open import Relation.Binary.Reasoning.Setoid setoid import Algebra.Properties.Monoid.Mult.TCOptimised *-monoid as Mult open import Algebra.Properties.Semiring.Exp S as U using () renaming (_^_ to _^ᵤ_) ------------------------------------------------------------------------ -- Re-export definition from the monoid open import Algebra.Definitions.RawSemiring rawSemiring public using () renaming (_^′_ to _^_) ------------------------------------------------------------------------ -- Properties of _×_ ^-congˡ : ∀ n → (_^ n) Preserves _≈_ ⟶ _≈_ ^-congˡ = Mult.×-congʳ ^-cong : _^_ Preserves₂ _≈_ ⟶ _≡_ ⟶ _≈_ ^-cong x≈y u≡v = Mult.×-cong u≡v x≈y -- xᵐ⁺ⁿ ≈ xᵐxⁿ ^-homo-* : ∀ x m n → x ^ (m ℕ.+ n) ≈ (x ^ m) * (x ^ n) ^-homo-* = Mult.×-homo-+ -- (xᵐ)ⁿ≈xᵐ*ⁿ ^-assocʳ : ∀ x m n → (x ^ m) ^ n ≈ x ^ (m ℕ.* n) ^-assocʳ x m n rewrite ℕ.*-comm m n = Mult.×-assocˡ x n m agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Mult.agda000066400000000000000000000025271451211343400234750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication by a natural number over a semiring ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Nat.Base as ℕ using (zero; suc) module Algebra.Properties.Semiring.Mult {a ℓ} (S : Semiring a ℓ) where open Semiring S renaming (zero to *-zero) open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Re-export definition from the monoid open import Algebra.Properties.Monoid.Mult +-monoid public ------------------------------------------------------------------------ -- Properties of _×_ -- (_× 1#) is homomorphic with respect to _ℕ.*_/_*_. ×1-homo-* : ∀ m n → (m ℕ.* n) × 1# ≈ (m × 1#) * (n × 1#) ×1-homo-* 0 n = sym (zeroˡ (n × 1#)) ×1-homo-* (suc m) n = begin (n ℕ.+ m ℕ.* n) × 1# ≈⟨ ×-homo-+ 1# n (m ℕ.* n) ⟩ n × 1# + (m ℕ.* n) × 1# ≈⟨ +-congˡ (×1-homo-* m n) ⟩ n × 1# + (m × 1#) * (n × 1#) ≈˘⟨ +-congʳ (*-identityˡ _) ⟩ 1# * (n × 1#) + (m × 1#) * (n × 1#) ≈˘⟨ distribʳ (n × 1#) 1# (m × 1#) ⟩ (1# + m × 1#) * (n × 1#) ∎ agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Mult/000077500000000000000000000000001451211343400226515ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Mult/TCOptimised.agda000066400000000000000000000024401451211343400256530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Multiplication over a semiring optimised for type-checking. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Nat.Base as ℕ using (zero; suc) module Algebra.Properties.Semiring.Mult.TCOptimised {a ℓ} (S : Semiring a ℓ) where open Semiring S renaming (zero to *-zero) open import Relation.Binary.Reasoning.Setoid setoid open import Algebra.Properties.Semiring.Mult S as U using () renaming (_×_ to _×ᵤ_) ------------------------------------------------------------------------ -- Re-export definition from the monoid open import Algebra.Properties.Monoid.Mult.TCOptimised +-monoid public ------------------------------------------------------------------------ -- Properties of _×_ -- (_×′ 1#) is homomorphic with respect to _ℕ.*_/_*_. ×1-homo-* : ∀ m n → (m ℕ.* n) × 1# ≈ (m × 1#) * (n × 1#) ×1-homo-* m n = begin (m ℕ.* n) × 1# ≈˘⟨ ×ᵤ≈× (m ℕ.* n) 1# ⟩ (m ℕ.* n) ×ᵤ 1# ≈⟨ U.×1-homo-* m n ⟩ (m ×ᵤ 1#) * (n ×ᵤ 1#) ≈⟨ *-cong (×ᵤ≈× m 1#) (×ᵤ≈× n 1#) ⟩ (m × 1#) * (n × 1#) ∎ agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Primality.agda000066400000000000000000000026461451211343400245300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some theory for CancellativeCommutativeSemiring. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra using (Semiring) open import Data.Sum.Base using (reduce) open import Function.Base using (flip) open import Relation.Binary using (Symmetric) module Algebra.Properties.Semiring.Primality {a ℓ} (R : Semiring a ℓ) where open Semiring R renaming (Carrier to A) open import Algebra.Properties.Semiring.Divisibility R ------------------------------------------------------------------------ -- Re-export primality definitions open import Algebra.Definitions.RawSemiring rawSemiring public using (Coprime; Prime; mkPrime; Irreducible; mkIrred) ------------------------------------------------------------------------ -- Properties of Coprime Coprime-sym : Symmetric Coprime Coprime-sym coprime = flip coprime ∣1⇒Coprime : ∀ {x} y → x ∣ 1# → Coprime x y ∣1⇒Coprime {x} y x∣1 z∣x _ = ∣-trans z∣x x∣1 ------------------------------------------------------------------------ -- Properties of Irreducible Irreducible⇒≉0 : 0# ≉ 1# → ∀ {p} → Irreducible p → p ≉ 0# Irreducible⇒≉0 0≉1 (mkIrred _ chooseInvertible) p≈0 = 0∤1 0≉1 (reduce (chooseInvertible (trans p≈0 (sym (zeroˡ 0#))))) agda-stdlib-1.7.3/src/Algebra/Properties/Semiring/Sum.agda000066400000000000000000000023451451211343400233160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finite summations over a semiring ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles using (Semiring) module Algebra.Properties.Semiring.Sum {c} {ℓ} (R : Semiring c ℓ) where open import Data.Nat.Base using (zero; suc) open import Data.Vec.Functional open Semiring R ------------------------------------------------------------------------ -- Re-export summation over monoids open import Algebra.Properties.CommutativeMonoid.Sum +-commutativeMonoid public ------------------------------------------------------------------------ -- Properties *-distribˡ-sum : ∀ {n} x (ys : Vector Carrier n) → x * sum ys ≈ sum (map (x *_) ys) *-distribˡ-sum {zero} x ys = zeroʳ x *-distribˡ-sum {suc n} x ys = trans (distribˡ x (head ys) (sum (tail ys))) (+-congˡ (*-distribˡ-sum x (tail ys))) *-distribʳ-sum : ∀ {n} x (ys : Vector Carrier n) → sum ys * x ≈ sum (map (_* x) ys) *-distribʳ-sum {zero} x ys = zeroˡ x *-distribʳ-sum {suc n} x ys = trans (distribʳ x (head ys) (sum (tail ys))) (+-congˡ (*-distribʳ-sum x (tail ys))) agda-stdlib-1.7.3/src/Algebra/Solver/000077500000000000000000000000001451211343400172715ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Solver/CommutativeMonoid.agda000066400000000000000000000147241451211343400235620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in commutative monoids -- -- Adapted from Algebra.Solver.Monoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Solver.CommutativeMonoid {m₁ m₂} (M : CommutativeMonoid m₁ m₂) where open import Data.Fin.Base using (Fin; zero; suc) open import Data.Maybe.Base as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat as ℕ using (ℕ; zero; suc; _+_) open import Data.Nat.GeneralisedArithmetic using (fold) open import Data.Product using (_×_; uncurry) open import Data.Vec.Base using (Vec; []; _∷_; lookup; replicate) open import Function.Base using (_∘_) import Relation.Binary.Reasoning.Setoid as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Nullary.Decidable as Dec import Data.Vec.Relation.Binary.Pointwise.Inductive as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) open CommutativeMonoid M open EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ infixr 10 _•_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup ρ x ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a vector of multiplicities (a bag). Normal : ℕ → Set Normal n = Vec ℕ n -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ _ = ε ⟦ n ∷ v ⟧⇓ (a ∷ ρ) = fold (⟦ v ⟧⇓ ρ) (λ b → a ∙ b) n ------------------------------------------------------------------------ -- Constructions on normal forms -- The empty bag. empty : ∀{n} → Normal n empty = replicate 0 -- A singleton bag. sg : ∀{n} (i : Fin n) → Normal n sg zero = 1 ∷ empty sg (suc i) = 0 ∷ sg i -- The composition of normal forms. _•_ : ∀{n} (v w : Normal n) → Normal n [] • [] = [] (l ∷ v) • (m ∷ w) = l + m ∷ v • w ------------------------------------------------------------------------ -- Correctness of the constructions on normal forms -- The empty bag stands for the unit ε. empty-correct : ∀{n} (ρ : Env n) → ⟦ empty ⟧⇓ ρ ≈ ε empty-correct [] = refl empty-correct (a ∷ ρ) = empty-correct ρ -- The singleton bag stands for a single variable. sg-correct : ∀{n} (x : Fin n) (ρ : Env n) → ⟦ sg x ⟧⇓ ρ ≈ lookup ρ x sg-correct zero (x ∷ ρ) = begin x ∙ ⟦ empty ⟧⇓ ρ ≈⟨ ∙-congˡ (empty-correct ρ) ⟩ x ∙ ε ≈⟨ identityʳ _ ⟩ x ∎ sg-correct (suc x) (m ∷ ρ) = sg-correct x ρ -- Normal form composition corresponds to the composition of the monoid. comp-correct : ∀ {n} (v w : Normal n) (ρ : Env n) → ⟦ v • w ⟧⇓ ρ ≈ (⟦ v ⟧⇓ ρ ∙ ⟦ w ⟧⇓ ρ) comp-correct [] [] ρ = sym (identityˡ _) comp-correct (l ∷ v) (m ∷ w) (a ∷ ρ) = lemma l m (comp-correct v w ρ) where flip12 : ∀ a b c → a ∙ (b ∙ c) ≈ b ∙ (a ∙ c) flip12 a b c = begin a ∙ (b ∙ c) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ c ≈⟨ ∙-congʳ (comm _ _) ⟩ (b ∙ a) ∙ c ≈⟨ assoc _ _ _ ⟩ b ∙ (a ∙ c) ∎ lemma : ∀ l m {d b c} (p : d ≈ b ∙ c) → fold d (a ∙_) (l + m) ≈ fold b (a ∙_) l ∙ fold c (a ∙_) m lemma zero zero p = p lemma zero (suc m) p = trans (∙-congˡ (lemma zero m p)) (flip12 _ _ _) lemma (suc l) m p = trans (∙-congˡ (lemma l m p)) (sym (assoc a _ _)) ------------------------------------------------------------------------ -- Normalization -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = sg x normalise id = empty normalise (e₁ ⊕ e₂) = normalise e₁ • normalise e₂ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = sg-correct x ρ normalise-correct id ρ = empty-correct ρ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ • normalise e₂ ⟧⇓ ρ ≈⟨ comp-correct (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactic. open module R = Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nf₁ nf₂ : Normal n) → Dec (nf₁ ≡ nf₂) nf₁ ≟ nf₂ = Dec.map Pointwise-≡↔≡ (decidable ℕ._≟_ nf₁ nf₂) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma (decToMaybe (normalise e₁ ≟ normalise e₂)) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (e₁ e₂ : Expr n) → From-just (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ agda-stdlib-1.7.3/src/Algebra/Solver/CommutativeMonoid/000077500000000000000000000000001451211343400227345ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Solver/CommutativeMonoid/Example.agda000066400000000000000000000016461451211343400251540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.CommutativeMonoidSolver can be used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Solver.CommutativeMonoid.Example where open import Relation.Binary.PropositionalEquality using (_≡_) open import Data.Bool.Base using (_∨_) open import Data.Bool.Properties using (∨-commutativeMonoid) open import Data.Fin.Base using (zero; suc) open import Data.Vec.Base using ([]; _∷_) open import Algebra.Solver.CommutativeMonoid ∨-commutativeMonoid test : ∀ x y z → (x ∨ y) ∨ (x ∨ z) ≡ (z ∨ y) ∨ (x ∨ x) test a b c = let _∨_ = _⊕_ in prove 3 ((x ∨ y) ∨ (x ∨ z)) ((z ∨ y) ∨ (x ∨ x)) (a ∷ b ∷ c ∷ []) where x = var zero y = var (suc zero) z = var (suc (suc zero)) agda-stdlib-1.7.3/src/Algebra/Solver/IdempotentCommutativeMonoid.agda000066400000000000000000000161131451211343400256050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Solver for equations in idempotent commutative monoids -- -- Adapted from Algebra.Solver.CommutativeMonoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Data.Bool as Bool using (Bool; true; false; if_then_else_; _∨_) open import Data.Fin.Base using (Fin; zero; suc) open import Data.Maybe.Base as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; _+_) open import Data.Product using (_×_; uncurry) open import Data.Vec.Base using (Vec; []; _∷_; lookup; replicate) open import Function.Base using (_∘_) import Relation.Binary.Reasoning.Setoid as EqReasoning import Relation.Binary.Reflection as Reflection import Relation.Nullary.Decidable as Dec import Data.Vec.Relation.Binary.Pointwise.Inductive as Pointwise open import Relation.Binary.PropositionalEquality as P using (_≡_; decSetoid) open import Relation.Nullary using (Dec) module Algebra.Solver.IdempotentCommutativeMonoid {m₁ m₂} (M : IdempotentCommutativeMonoid m₁ m₂) where open IdempotentCommutativeMonoid M open EqReasoning setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ infixr 10 _•_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup ρ x ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a vector of bits (a set). Normal : ℕ → Set Normal n = Vec Bool n -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ _ = ε ⟦ b ∷ v ⟧⇓ (a ∷ ρ) = if b then a ∙ (⟦ v ⟧⇓ ρ) else (⟦ v ⟧⇓ ρ) ------------------------------------------------------------------------ -- Constructions on normal forms -- The empty set. empty : ∀{n} → Normal n empty = replicate false -- A singleton set. sg : ∀{n} (i : Fin n) → Normal n sg zero = true ∷ empty sg (suc i) = false ∷ sg i -- The composition of normal forms. _•_ : ∀{n} (v w : Normal n) → Normal n [] • [] = [] (l ∷ v) • (m ∷ w) = (l ∨ m) ∷ v • w ------------------------------------------------------------------------ -- Correctness of the constructions on normal forms -- The empty set stands for the unit ε. empty-correct : ∀{n} (ρ : Env n) → ⟦ empty ⟧⇓ ρ ≈ ε empty-correct [] = refl empty-correct (a ∷ ρ) = empty-correct ρ -- The singleton set stands for a single variable. sg-correct : ∀{n} (x : Fin n) (ρ : Env n) → ⟦ sg x ⟧⇓ ρ ≈ lookup ρ x sg-correct zero (x ∷ ρ) = begin x ∙ ⟦ empty ⟧⇓ ρ ≈⟨ ∙-congˡ (empty-correct ρ) ⟩ x ∙ ε ≈⟨ identityʳ _ ⟩ x ∎ sg-correct (suc x) (m ∷ ρ) = sg-correct x ρ -- Normal form composition corresponds to the composition of the monoid. flip12 : ∀ a b c → a ∙ (b ∙ c) ≈ b ∙ (a ∙ c) flip12 a b c = begin a ∙ (b ∙ c) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ c ≈⟨ ∙-congʳ (comm _ _) ⟩ (b ∙ a) ∙ c ≈⟨ assoc _ _ _ ⟩ b ∙ (a ∙ c) ∎ distr : ∀ a b c → a ∙ (b ∙ c) ≈ (a ∙ b) ∙ (a ∙ c) distr a b c = begin a ∙ (b ∙ c) ≈⟨ ∙-cong (sym (idem a)) refl ⟩ (a ∙ a) ∙ (b ∙ c) ≈⟨ assoc _ _ _ ⟩ a ∙ (a ∙ (b ∙ c)) ≈⟨ ∙-congˡ (sym (assoc _ _ _)) ⟩ a ∙ ((a ∙ b) ∙ c) ≈⟨ ∙-congˡ (∙-congʳ (comm _ _)) ⟩ a ∙ ((b ∙ a) ∙ c) ≈⟨ ∙-congˡ (assoc _ _ _) ⟩ a ∙ (b ∙ (a ∙ c)) ≈⟨ sym (assoc _ _ _) ⟩ (a ∙ b) ∙ (a ∙ c) ∎ comp-correct : ∀ {n} (v w : Normal n) (ρ : Env n) → ⟦ v • w ⟧⇓ ρ ≈ (⟦ v ⟧⇓ ρ ∙ ⟦ w ⟧⇓ ρ) comp-correct [] [] ρ = sym (identityˡ _) comp-correct (true ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-congˡ (comp-correct v w ρ)) (distr _ _ _) comp-correct (true ∷ v) (false ∷ w) (a ∷ ρ) = trans (∙-congˡ (comp-correct v w ρ)) (sym (assoc _ _ _)) comp-correct (false ∷ v) (true ∷ w) (a ∷ ρ) = trans (∙-congˡ (comp-correct v w ρ)) (flip12 _ _ _) comp-correct (false ∷ v) (false ∷ w) (a ∷ ρ) = comp-correct v w ρ ------------------------------------------------------------------------ -- Normalization -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = sg x normalise id = empty normalise (e₁ ⊕ e₂) = normalise e₁ • normalise e₂ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = sg-correct x ρ normalise-correct id ρ = empty-correct ρ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ • normalise e₂ ⟧⇓ ρ ≈⟨ comp-correct (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactic. open module R = Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} (nf₁ nf₂ : Normal n) → Dec (nf₁ ≡ nf₂) nf₁ ≟ nf₂ = Dec.map Pointwise-≡↔≡ (decidable Bool._≟_ nf₁ nf₂) where open Pointwise -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma (decToMaybe (normalise e₁ ≟ normalise e₂)) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (e₁ e₂ : Expr n) → From-just (prove′ e₁ e₂) prove _ e₁ e₂ = from-just (prove′ e₁ e₂) -- prove : ∀ n (es : Expr n × Expr n) → -- From-just (uncurry prove′ es) -- prove _ = from-just ∘ uncurry prove′ agda-stdlib-1.7.3/src/Algebra/Solver/IdempotentCommutativeMonoid/000077500000000000000000000000001451211343400247655ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Solver/IdempotentCommutativeMonoid/Example.agda000066400000000000000000000017151451211343400272020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An example of how Algebra.IdempotentCommutativeMonoidSolver can be -- used ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Solver.IdempotentCommutativeMonoid.Example where open import Relation.Binary.PropositionalEquality using (_≡_) open import Data.Bool.Base using (_∨_) open import Data.Bool.Properties using (∨-idempotentCommutativeMonoid) open import Data.Fin.Base using (zero; suc) open import Data.Vec.Base using ([]; _∷_) open import Algebra.Solver.IdempotentCommutativeMonoid ∨-idempotentCommutativeMonoid test : ∀ x y z → (x ∨ y) ∨ (x ∨ z) ≡ (z ∨ y) ∨ x test a b c = let _∨_ = _⊕_ in prove 3 ((x ∨ y) ∨ (x ∨ z)) ((z ∨ y) ∨ x) (a ∷ b ∷ c ∷ []) where x = var zero y = var (suc zero) z = var (suc (suc zero)) agda-stdlib-1.7.3/src/Algebra/Solver/Monoid.agda000066400000000000000000000114061451211343400213360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A solver for equations over monoids ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Solver.Monoid {m₁ m₂} (M : Monoid m₁ m₂) where open import Data.Fin.Base as Fin import Data.Fin.Properties as Fin open import Data.List.Base hiding (lookup) import Data.List.Relation.Binary.Equality.DecPropositional as ListEq open import Data.Maybe.Base as Maybe using (Maybe; decToMaybe; From-just; from-just) open import Data.Nat.Base using (ℕ) open import Data.Product open import Data.Vec.Base using (Vec; lookup) open import Function.Base using (_∘_; _$_) open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality as P using (_≡_) import Relation.Binary.Reflection open import Relation.Nullary import Relation.Nullary.Decidable as Dec open Monoid M open import Relation.Binary.Reasoning.Setoid setoid ------------------------------------------------------------------------ -- Monoid expressions -- There is one constructor for every operation, plus one for -- variables; there may be at most n variables. infixr 5 _⊕_ data Expr (n : ℕ) : Set where var : Fin n → Expr n id : Expr n _⊕_ : Expr n → Expr n → Expr n -- An environment contains one value for every variable. Env : ℕ → Set _ Env n = Vec Carrier n -- The semantics of an expression is a function from an environment to -- a value. ⟦_⟧ : ∀ {n} → Expr n → Env n → Carrier ⟦ var x ⟧ ρ = lookup ρ x ⟦ id ⟧ ρ = ε ⟦ e₁ ⊕ e₂ ⟧ ρ = ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ------------------------------------------------------------------------ -- Normal forms -- A normal form is a list of variables. Normal : ℕ → Set Normal n = List (Fin n) -- The semantics of a normal form. ⟦_⟧⇓ : ∀ {n} → Normal n → Env n → Carrier ⟦ [] ⟧⇓ ρ = ε ⟦ x ∷ nf ⟧⇓ ρ = lookup ρ x ∙ ⟦ nf ⟧⇓ ρ -- A normaliser. normalise : ∀ {n} → Expr n → Normal n normalise (var x) = x ∷ [] normalise id = [] normalise (e₁ ⊕ e₂) = normalise e₁ ++ normalise e₂ -- The normaliser is homomorphic with respect to _++_/_∙_. homomorphic : ∀ {n} (nf₁ nf₂ : Normal n) (ρ : Env n) → ⟦ nf₁ ++ nf₂ ⟧⇓ ρ ≈ (⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ) homomorphic [] nf₂ ρ = begin ⟦ nf₂ ⟧⇓ ρ ≈⟨ sym $ identityˡ _ ⟩ ε ∙ ⟦ nf₂ ⟧⇓ ρ ∎ homomorphic (x ∷ nf₁) nf₂ ρ = begin lookup ρ x ∙ ⟦ nf₁ ++ nf₂ ⟧⇓ ρ ≈⟨ ∙-congˡ (homomorphic nf₁ nf₂ ρ) ⟩ lookup ρ x ∙ (⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ) ≈⟨ sym $ assoc _ _ _ ⟩ lookup ρ x ∙ ⟦ nf₁ ⟧⇓ ρ ∙ ⟦ nf₂ ⟧⇓ ρ ∎ -- The normaliser preserves the semantics of the expression. normalise-correct : ∀ {n} (e : Expr n) (ρ : Env n) → ⟦ normalise e ⟧⇓ ρ ≈ ⟦ e ⟧ ρ normalise-correct (var x) ρ = begin lookup ρ x ∙ ε ≈⟨ identityʳ _ ⟩ lookup ρ x ∎ normalise-correct id ρ = begin ε ∎ normalise-correct (e₁ ⊕ e₂) ρ = begin ⟦ normalise e₁ ++ normalise e₂ ⟧⇓ ρ ≈⟨ homomorphic (normalise e₁) (normalise e₂) ρ ⟩ ⟦ normalise e₁ ⟧⇓ ρ ∙ ⟦ normalise e₂ ⟧⇓ ρ ≈⟨ ∙-cong (normalise-correct e₁ ρ) (normalise-correct e₂ ρ) ⟩ ⟦ e₁ ⟧ ρ ∙ ⟦ e₂ ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactic. open module R = Relation.Binary.Reflection setoid var ⟦_⟧ (⟦_⟧⇓ ∘ normalise) normalise-correct public using (solve; _⊜_) -- We can decide if two normal forms are /syntactically/ equal. infix 5 _≟_ _≟_ : ∀ {n} → Decidable {A = Normal n} _≡_ nf₁ ≟ nf₂ = Dec.map′ ≋⇒≡ ≡⇒≋ (nf₁ ≋? nf₂) where open ListEq Fin._≟_ -- We can also give a sound, but not necessarily complete, procedure -- for determining if two expressions have the same semantics. prove′ : ∀ {n} (e₁ e₂ : Expr n) → Maybe (∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ) prove′ e₁ e₂ = Maybe.map lemma $ decToMaybe (normalise e₁ ≟ normalise e₂) where lemma : normalise e₁ ≡ normalise e₂ → ∀ ρ → ⟦ e₁ ⟧ ρ ≈ ⟦ e₂ ⟧ ρ lemma eq ρ = R.prove ρ e₁ e₂ (begin ⟦ normalise e₁ ⟧⇓ ρ ≡⟨ P.cong (λ e → ⟦ e ⟧⇓ ρ) eq ⟩ ⟦ normalise e₂ ⟧⇓ ρ ∎) -- This procedure can be combined with from-just. prove : ∀ n (es : Expr n × Expr n) → From-just (uncurry prove′ es) prove _ = from-just ∘ uncurry prove′ agda-stdlib-1.7.3/src/Algebra/Solver/Ring.agda000066400000000000000000000551571451211343400210230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Old solver for commutative ring or semiring equalities ------------------------------------------------------------------------ -- Uses ideas from the Coq ring tactic. See "Proving Equalities in a -- Commutative Ring Done Right in Coq" by Grégoire and Mahboubi. The -- code below is not optimised like theirs, though (in particular, our -- Horner normal forms are not sparse). -- -- At first the `WeaklyDecidable` type may at first glance look useless -- as there is no guarantee that it doesn't always return `nothing`. -- However the implementation of it affects the power of the solver. The -- more equalities it returns, the more expressions the ring solver can -- solve. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Bundles open import Algebra.Solver.Ring.AlmostCommutativeRing open import Relation.Binary.Definitions using (WeaklyDecidable) module Algebra.Solver.Ring {r₁ r₂ r₃ r₄} (Coeff : RawRing r₁ r₄) -- Coefficient "ring". (R : AlmostCommutativeRing r₂ r₃) -- Main "ring". (morphism : Coeff -Raw-AlmostCommutative⟶ R) (_coeff≟_ : WeaklyDecidable (Induced-equivalence morphism)) where open import Algebra.Core open import Algebra.Solver.Ring.Lemmas Coeff R morphism private module C = RawRing Coeff open AlmostCommutativeRing R renaming (zero to *-zero; zeroˡ to *-zeroˡ; zeroʳ to *-zeroʳ) open import Algebra.Definitions _≈_ open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism renaming (⟦_⟧ to ⟦_⟧′) open import Algebra.Properties.Semiring.Exp semiring open import Relation.Binary open import Relation.Nullary using (yes; no) open import Relation.Binary.Reasoning.Setoid setoid import Relation.Binary.PropositionalEquality as PropEq import Relation.Binary.Reflection as Reflection open import Data.Nat.Base using (ℕ; suc; zero) open import Data.Fin.Base using (Fin; zero; suc) open import Data.Vec.Base using (Vec; []; _∷_; lookup) open import Data.Maybe.Base using (just; nothing) open import Function open import Level using (_⊔_) infix 9 :-_ -H_ -N_ infixr 9 _:×_ _:^_ _^N_ infix 8 _*x+_ _*x+HN_ _*x+H_ infixl 8 _:*_ _*N_ _*H_ _*NH_ _*HN_ infixl 7 _:+_ _:-_ _+H_ _+N_ infix 4 _≈H_ _≈N_ ------------------------------------------------------------------------ -- Polynomials data Op : Set where [+] : Op [*] : Op -- The polynomials are indexed by the number of variables. data Polynomial (m : ℕ) : Set r₁ where op : (o : Op) (p₁ : Polynomial m) (p₂ : Polynomial m) → Polynomial m con : (c : C.Carrier) → Polynomial m var : (x : Fin m) → Polynomial m _:^_ : (p : Polynomial m) (n : ℕ) → Polynomial m :-_ : (p : Polynomial m) → Polynomial m -- Short-hand notation. _:+_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:+_ = op [+] _:*_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n _:*_ = op [*] _:-_ : ∀ {n} → Polynomial n → Polynomial n → Polynomial n x :- y = x :+ :- y _:×_ : ∀ {n} → ℕ → Polynomial n → Polynomial n zero :× p = con C.0# suc m :× p = p :+ m :× p -- Semantics. sem : Op → Op₂ Carrier sem [+] = _+_ sem [*] = _*_ ⟦_⟧ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ op o p₁ p₂ ⟧ ρ = ⟦ p₁ ⟧ ρ ⟨ sem o ⟩ ⟦ p₂ ⟧ ρ ⟦ con c ⟧ ρ = ⟦ c ⟧′ ⟦ var x ⟧ ρ = lookup ρ x ⟦ p :^ n ⟧ ρ = ⟦ p ⟧ ρ ^ n ⟦ :- p ⟧ ρ = - ⟦ p ⟧ ρ ------------------------------------------------------------------------ -- Normal forms of polynomials -- A univariate polynomial of degree d, -- -- p = a_d x^d + a_{d-1}x^{d-1} + … + a_0, -- -- is represented in Horner normal form by -- -- p = ((a_d x + a_{d-1})x + …)x + a_0. -- -- Note that Horner normal forms can be represented as lists, with the -- empty list standing for the zero polynomial of degree "-1". -- -- Given this representation of univariate polynomials over an -- arbitrary ring, polynomials in any number of variables over the -- ring C can be represented via the isomorphisms -- -- C[] ≅ C -- -- and -- -- C[X_0,...X_{n+1}] ≅ C[X_0,...,X_n][X_{n+1}]. mutual -- The polynomial representations are indexed by the polynomial's -- degree. data HNF : ℕ → Set r₁ where ∅ : ∀ {n} → HNF (suc n) _*x+_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) data Normal : ℕ → Set r₁ where con : C.Carrier → Normal zero poly : ∀ {n} → HNF (suc n) → Normal (suc n) -- Note that the data types above do /not/ ensure uniqueness of -- normal forms: the zero polynomial of degree one can be -- represented using both ∅ and ∅ *x+ con C.0#. mutual -- Semantics. ⟦_⟧H : ∀ {n} → HNF (suc n) → Vec Carrier (suc n) → Carrier ⟦ ∅ ⟧H _ = 0# ⟦ p *x+ c ⟧H (x ∷ ρ) = ⟦ p ⟧H (x ∷ ρ) * x + ⟦ c ⟧N ρ ⟦_⟧N : ∀ {n} → Normal n → Vec Carrier n → Carrier ⟦ con c ⟧N _ = ⟦ c ⟧′ ⟦ poly p ⟧N ρ = ⟦ p ⟧H ρ ------------------------------------------------------------------------ -- Equality and decidability mutual -- Equality. data _≈H_ : ∀ {n} → HNF n → HNF n → Set (r₁ ⊔ r₃) where ∅ : ∀ {n} → _≈H_ {suc n} ∅ ∅ _*x+_ : ∀ {n} {p₁ p₂ : HNF (suc n)} {c₁ c₂ : Normal n} → p₁ ≈H p₂ → c₁ ≈N c₂ → (p₁ *x+ c₁) ≈H (p₂ *x+ c₂) data _≈N_ : ∀ {n} → Normal n → Normal n → Set (r₁ ⊔ r₃) where con : ∀ {c₁ c₂} → ⟦ c₁ ⟧′ ≈ ⟦ c₂ ⟧′ → con c₁ ≈N con c₂ poly : ∀ {n} {p₁ p₂ : HNF (suc n)} → p₁ ≈H p₂ → poly p₁ ≈N poly p₂ mutual -- Equality is weakly decidable. _≟H_ : ∀ {n} → WeaklyDecidable (_≈H_ {n = n}) ∅ ≟H ∅ = just ∅ ∅ ≟H (_ *x+ _) = nothing (_ *x+ _) ≟H ∅ = nothing (p₁ *x+ c₁) ≟H (p₂ *x+ c₂) with p₁ ≟H p₂ | c₁ ≟N c₂ ... | just p₁≈p₂ | just c₁≈c₂ = just (p₁≈p₂ *x+ c₁≈c₂) ... | _ | nothing = nothing ... | nothing | _ = nothing _≟N_ : ∀ {n} → WeaklyDecidable (_≈N_ {n = n}) con c₁ ≟N con c₂ with c₁ coeff≟ c₂ ... | just c₁≈c₂ = just (con c₁≈c₂) ... | nothing = nothing poly p₁ ≟N poly p₂ with p₁ ≟H p₂ ... | just p₁≈p₂ = just (poly p₁≈p₂) ... | nothing = nothing mutual -- The semantics respect the equality relations defined above. ⟦_⟧H-cong : ∀ {n} {p₁ p₂ : HNF (suc n)} → p₁ ≈H p₂ → ∀ ρ → ⟦ p₁ ⟧H ρ ≈ ⟦ p₂ ⟧H ρ ⟦ ∅ ⟧H-cong _ = refl ⟦ p₁≈p₂ *x+ c₁≈c₂ ⟧H-cong (x ∷ ρ) = (⟦ p₁≈p₂ ⟧H-cong (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ ⟦ c₁≈c₂ ⟧N-cong ρ ⟦_⟧N-cong : ∀ {n} {p₁ p₂ : Normal n} → p₁ ≈N p₂ → ∀ ρ → ⟦ p₁ ⟧N ρ ≈ ⟦ p₂ ⟧N ρ ⟦ con c₁≈c₂ ⟧N-cong _ = c₁≈c₂ ⟦ poly p₁≈p₂ ⟧N-cong ρ = ⟦ p₁≈p₂ ⟧H-cong ρ ------------------------------------------------------------------------ -- Ring operations on Horner normal forms -- Zero. 0H : ∀ {n} → HNF (suc n) 0H = ∅ 0N : ∀ {n} → Normal n 0N {zero} = con C.0# 0N {suc n} = poly 0H mutual -- One. 1H : ∀ {n} → HNF (suc n) 1H {n} = ∅ *x+ 1N {n} 1N : ∀ {n} → Normal n 1N {zero} = con C.1# 1N {suc n} = poly 1H -- A simplifying variant of _*x+_. _*x+HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) (p *x+ c′) *x+HN c = (p *x+ c′) *x+ c ∅ *x+HN c with c ≟N 0N ... | just c≈0 = ∅ ... | nothing = ∅ *x+ c mutual -- Addition. _+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ +H p = p p +H ∅ = p (p₁ *x+ c₁) +H (p₂ *x+ c₂) = (p₁ +H p₂) *x+HN (c₁ +N c₂) _+N_ : ∀ {n} → Normal n → Normal n → Normal n con c₁ +N con c₂ = con (c₁ C.+ c₂) poly p₁ +N poly p₂ = poly (p₁ +H p₂) -- Multiplication. _*x+H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) p₁ *x+H (p₂ *x+ c) = (p₁ +H p₂) *x+HN c ∅ *x+H ∅ = ∅ (p₁ *x+ c) *x+H ∅ = (p₁ *x+ c) *x+ 0N mutual _*NH_ : ∀ {n} → Normal n → HNF (suc n) → HNF (suc n) c *NH ∅ = ∅ c *NH (p *x+ c′) with c ≟N 0N ... | just c≈0 = ∅ ... | nothing = (c *NH p) *x+ (c *N c′) _*HN_ : ∀ {n} → HNF (suc n) → Normal n → HNF (suc n) ∅ *HN c = ∅ (p *x+ c′) *HN c with c ≟N 0N ... | just c≈0 = ∅ ... | nothing = (p *HN c) *x+ (c′ *N c) _*H_ : ∀ {n} → HNF (suc n) → HNF (suc n) → HNF (suc n) ∅ *H _ = ∅ (_ *x+ _) *H ∅ = ∅ (p₁ *x+ c₁) *H (p₂ *x+ c₂) = ((p₁ *H p₂) *x+H (p₁ *HN c₂ +H c₁ *NH p₂)) *x+HN (c₁ *N c₂) _*N_ : ∀ {n} → Normal n → Normal n → Normal n con c₁ *N con c₂ = con (c₁ C.* c₂) poly p₁ *N poly p₂ = poly (p₁ *H p₂) -- Exponentiation. _^N_ : ∀ {n} → Normal n → ℕ → Normal n p ^N zero = 1N p ^N suc n = p *N (p ^N n) mutual -- Negation. -H_ : ∀ {n} → HNF (suc n) → HNF (suc n) -H p = (-N 1N) *NH p -N_ : ∀ {n} → Normal n → Normal n -N con c = con (C.- c) -N poly p = poly (-H p) ------------------------------------------------------------------------ -- Normalisation normalise-con : ∀ {n} → C.Carrier → Normal n normalise-con {zero} c = con c normalise-con {suc n} c = poly (∅ *x+HN normalise-con c) normalise-var : ∀ {n} → Fin n → Normal n normalise-var zero = poly ((∅ *x+ 1N) *x+ 0N) normalise-var (suc i) = poly (∅ *x+HN normalise-var i) normalise : ∀ {n} → Polynomial n → Normal n normalise (op [+] t₁ t₂) = normalise t₁ +N normalise t₂ normalise (op [*] t₁ t₂) = normalise t₁ *N normalise t₂ normalise (con c) = normalise-con c normalise (var i) = normalise-var i normalise (t :^ k) = normalise t ^N k normalise (:- t) = -N normalise t -- Evaluation after normalisation. ⟦_⟧↓ : ∀ {n} → Polynomial n → Vec Carrier n → Carrier ⟦ p ⟧↓ ρ = ⟦ normalise p ⟧N ρ ------------------------------------------------------------------------ -- Homomorphism lemmas 0N-homo : ∀ {n} ρ → ⟦ 0N {n} ⟧N ρ ≈ 0# 0N-homo [] = 0-homo 0N-homo (x ∷ ρ) = refl -- If c is equal to 0N, then c is semantically equal to 0#. 0≈⟦0⟧ : ∀ {n} {c : Normal n} → c ≈N 0N → ∀ ρ → 0# ≈ ⟦ c ⟧N ρ 0≈⟦0⟧ {c = c} c≈0 ρ = sym (begin ⟦ c ⟧N ρ ≈⟨ ⟦ c≈0 ⟧N-cong ρ ⟩ ⟦ 0N ⟧N ρ ≈⟨ 0N-homo ρ ⟩ 0# ∎) 1N-homo : ∀ {n} ρ → ⟦ 1N {n} ⟧N ρ ≈ 1# 1N-homo [] = 1-homo 1N-homo (x ∷ ρ) = begin 0# * x + ⟦ 1N ⟧N ρ ≈⟨ refl ⟨ +-cong ⟩ 1N-homo ρ ⟩ 0# * x + 1# ≈⟨ lemma₆ _ _ ⟩ 1# ∎ -- _*x+HN_ is equal to _*x+_. *x+HN≈*x+ : ∀ {n} (p : HNF (suc n)) (c : Normal n) → ∀ ρ → ⟦ p *x+HN c ⟧H ρ ≈ ⟦ p *x+ c ⟧H ρ *x+HN≈*x+ (p *x+ c′) c ρ = refl *x+HN≈*x+ ∅ c (x ∷ ρ) with c ≟N 0N ... | just c≈0 = begin 0# ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟩ ⟦ c ⟧N ρ ≈⟨ sym $ lemma₆ _ _ ⟩ 0# * x + ⟦ c ⟧N ρ ∎ ... | nothing = refl ∅*x+HN-homo : ∀ {n} (c : Normal n) x ρ → ⟦ ∅ *x+HN c ⟧H (x ∷ ρ) ≈ ⟦ c ⟧N ρ ∅*x+HN-homo c x ρ with c ≟N 0N ... | just c≈0 = 0≈⟦0⟧ c≈0 ρ ... | nothing = lemma₆ _ _ mutual +H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) → ∀ ρ → ⟦ p₁ +H p₂ ⟧H ρ ≈ ⟦ p₁ ⟧H ρ + ⟦ p₂ ⟧H ρ +H-homo ∅ p₂ ρ = sym (+-identityˡ _) +H-homo (p₁ *x+ x₁) ∅ ρ = sym (+-identityʳ _) +H-homo (p₁ *x+ c₁) (p₂ *x+ c₂) (x ∷ ρ) = begin ⟦ (p₁ +H p₂) *x+HN (c₁ +N c₂) ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ (p₁ +H p₂) (c₁ +N c₂) (x ∷ ρ) ⟩ ⟦ p₁ +H p₂ ⟧H (x ∷ ρ) * x + ⟦ c₁ +N c₂ ⟧N ρ ≈⟨ (+H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ +N-homo c₁ c₂ ρ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) + ⟦ p₂ ⟧H (x ∷ ρ)) * x + (⟦ c₁ ⟧N ρ + ⟦ c₂ ⟧N ρ) ≈⟨ lemma₁ _ _ _ _ _ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ c₁ ⟧N ρ) + (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ +N-homo : ∀ {n} (p₁ p₂ : Normal n) → ∀ ρ → ⟦ p₁ +N p₂ ⟧N ρ ≈ ⟦ p₁ ⟧N ρ + ⟦ p₂ ⟧N ρ +N-homo (con c₁) (con c₂) _ = +-homo _ _ +N-homo (poly p₁) (poly p₂) ρ = +H-homo p₁ p₂ ρ *x+H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) x ρ → ⟦ p₁ *x+H p₂ ⟧H (x ∷ ρ) ≈ ⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ p₂ ⟧H (x ∷ ρ) *x+H-homo ∅ ∅ _ _ = sym $ lemma₆ _ _ *x+H-homo (p *x+ c) ∅ x ρ = begin ⟦ p *x+ c ⟧H (x ∷ ρ) * x + ⟦ 0N ⟧N ρ ≈⟨ refl ⟨ +-cong ⟩ 0N-homo ρ ⟩ ⟦ p *x+ c ⟧H (x ∷ ρ) * x + 0# ∎ *x+H-homo p₁ (p₂ *x+ c₂) x ρ = begin ⟦ (p₁ +H p₂) *x+HN c₂ ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ (p₁ +H p₂) c₂ (x ∷ ρ) ⟩ ⟦ p₁ +H p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ ≈⟨ (+H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) + ⟦ p₂ ⟧H (x ∷ ρ)) * x + ⟦ c₂ ⟧N ρ ≈⟨ lemma₀ _ _ _ _ ⟩ ⟦ p₁ ⟧H (x ∷ ρ) * x + (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ mutual *NH-homo : ∀ {n} (c : Normal n) (p : HNF (suc n)) x ρ → ⟦ c *NH p ⟧H (x ∷ ρ) ≈ ⟦ c ⟧N ρ * ⟦ p ⟧H (x ∷ ρ) *NH-homo c ∅ x ρ = sym (*-zeroʳ _) *NH-homo c (p *x+ c′) x ρ with c ≟N 0N ... | just c≈0 = begin 0# ≈⟨ sym (*-zeroˡ _) ⟩ 0# * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ≈⟨ 0≈⟦0⟧ c≈0 ρ ⟨ *-cong ⟩ refl ⟩ ⟦ c ⟧N ρ * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ∎ ... | nothing = begin ⟦ c *NH p ⟧H (x ∷ ρ) * x + ⟦ c *N c′ ⟧N ρ ≈⟨ (*NH-homo c p x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c c′ ρ ⟩ (⟦ c ⟧N ρ * ⟦ p ⟧H (x ∷ ρ)) * x + (⟦ c ⟧N ρ * ⟦ c′ ⟧N ρ) ≈⟨ lemma₃ _ _ _ _ ⟩ ⟦ c ⟧N ρ * (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) ∎ *HN-homo : ∀ {n} (p : HNF (suc n)) (c : Normal n) x ρ → ⟦ p *HN c ⟧H (x ∷ ρ) ≈ ⟦ p ⟧H (x ∷ ρ) * ⟦ c ⟧N ρ *HN-homo ∅ c x ρ = sym (*-zeroˡ _) *HN-homo (p *x+ c′) c x ρ with c ≟N 0N ... | just c≈0 = begin 0# ≈⟨ sym (*-zeroʳ _) ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * 0# ≈⟨ refl ⟨ *-cong ⟩ 0≈⟦0⟧ c≈0 ρ ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * ⟦ c ⟧N ρ ∎ ... | nothing = begin ⟦ p *HN c ⟧H (x ∷ ρ) * x + ⟦ c′ *N c ⟧N ρ ≈⟨ (*HN-homo p c x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c′ c ρ ⟩ (⟦ p ⟧H (x ∷ ρ) * ⟦ c ⟧N ρ) * x + (⟦ c′ ⟧N ρ * ⟦ c ⟧N ρ) ≈⟨ lemma₂ _ _ _ _ ⟩ (⟦ p ⟧H (x ∷ ρ) * x + ⟦ c′ ⟧N ρ) * ⟦ c ⟧N ρ ∎ *H-homo : ∀ {n} (p₁ p₂ : HNF (suc n)) → ∀ ρ → ⟦ p₁ *H p₂ ⟧H ρ ≈ ⟦ p₁ ⟧H ρ * ⟦ p₂ ⟧H ρ *H-homo ∅ p₂ ρ = sym $ *-zeroˡ _ *H-homo (p₁ *x+ c₁) ∅ ρ = sym $ *-zeroʳ _ *H-homo (p₁ *x+ c₁) (p₂ *x+ c₂) (x ∷ ρ) = begin ⟦ ((p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂))) *x+HN (c₁ *N c₂) ⟧H (x ∷ ρ) ≈⟨ *x+HN≈*x+ ((p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂))) (c₁ *N c₂) (x ∷ ρ) ⟩ ⟦ (p₁ *H p₂) *x+H ((p₁ *HN c₂) +H (c₁ *NH p₂)) ⟧H (x ∷ ρ) * x + ⟦ c₁ *N c₂ ⟧N ρ ≈⟨ (*x+H-homo (p₁ *H p₂) ((p₁ *HN c₂) +H (c₁ *NH p₂)) x ρ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ *N-homo c₁ c₂ ρ ⟩ (⟦ p₁ *H p₂ ⟧H (x ∷ ρ) * x + ⟦ (p₁ *HN c₂) +H (c₁ *NH p₂) ⟧H (x ∷ ρ)) * x + ⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ ≈⟨ (((*H-homo p₁ p₂ (x ∷ ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ (+H-homo (p₁ *HN c₂) (c₁ *NH p₂) (x ∷ ρ))) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ p₂ ⟧H (x ∷ ρ) * x + (⟦ p₁ *HN c₂ ⟧H (x ∷ ρ) + ⟦ c₁ *NH p₂ ⟧H (x ∷ ρ))) * x + ⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ ≈⟨ ((refl ⟨ +-cong ⟩ (*HN-homo p₁ c₂ x ρ ⟨ +-cong ⟩ *NH-homo c₁ p₂ x ρ)) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ p₂ ⟧H (x ∷ ρ) * x + (⟦ p₁ ⟧H (x ∷ ρ) * ⟦ c₂ ⟧N ρ + ⟦ c₁ ⟧N ρ * ⟦ p₂ ⟧H (x ∷ ρ))) * x + (⟦ c₁ ⟧N ρ * ⟦ c₂ ⟧N ρ) ≈⟨ lemma₄ _ _ _ _ _ ⟩ (⟦ p₁ ⟧H (x ∷ ρ) * x + ⟦ c₁ ⟧N ρ) * (⟦ p₂ ⟧H (x ∷ ρ) * x + ⟦ c₂ ⟧N ρ) ∎ *N-homo : ∀ {n} (p₁ p₂ : Normal n) → ∀ ρ → ⟦ p₁ *N p₂ ⟧N ρ ≈ ⟦ p₁ ⟧N ρ * ⟦ p₂ ⟧N ρ *N-homo (con c₁) (con c₂) _ = *-homo _ _ *N-homo (poly p₁) (poly p₂) ρ = *H-homo p₁ p₂ ρ ^N-homo : ∀ {n} (p : Normal n) (k : ℕ) → ∀ ρ → ⟦ p ^N k ⟧N ρ ≈ ⟦ p ⟧N ρ ^ k ^N-homo p zero ρ = 1N-homo ρ ^N-homo p (suc k) ρ = begin ⟦ p *N (p ^N k) ⟧N ρ ≈⟨ *N-homo p (p ^N k) ρ ⟩ ⟦ p ⟧N ρ * ⟦ p ^N k ⟧N ρ ≈⟨ refl ⟨ *-cong ⟩ ^N-homo p k ρ ⟩ ⟦ p ⟧N ρ * (⟦ p ⟧N ρ ^ k) ∎ mutual -H‿-homo : ∀ {n} (p : HNF (suc n)) → ∀ ρ → ⟦ -H p ⟧H ρ ≈ - ⟦ p ⟧H ρ -H‿-homo p (x ∷ ρ) = begin ⟦ (-N 1N) *NH p ⟧H (x ∷ ρ) ≈⟨ *NH-homo (-N 1N) p x ρ ⟩ ⟦ -N 1N ⟧N ρ * ⟦ p ⟧H (x ∷ ρ) ≈⟨ trans (-N‿-homo 1N ρ) (-‿cong (1N-homo ρ)) ⟨ *-cong ⟩ refl ⟩ - 1# * ⟦ p ⟧H (x ∷ ρ) ≈⟨ lemma₇ _ ⟩ - ⟦ p ⟧H (x ∷ ρ) ∎ -N‿-homo : ∀ {n} (p : Normal n) → ∀ ρ → ⟦ -N p ⟧N ρ ≈ - ⟦ p ⟧N ρ -N‿-homo (con c) _ = -‿homo _ -N‿-homo (poly p) ρ = -H‿-homo p ρ ------------------------------------------------------------------------ -- Correctness correct-con : ∀ {n} (c : C.Carrier) (ρ : Vec Carrier n) → ⟦ normalise-con c ⟧N ρ ≈ ⟦ c ⟧′ correct-con c [] = refl correct-con c (x ∷ ρ) = begin ⟦ ∅ *x+HN normalise-con c ⟧H (x ∷ ρ) ≈⟨ ∅*x+HN-homo (normalise-con c) x ρ ⟩ ⟦ normalise-con c ⟧N ρ ≈⟨ correct-con c ρ ⟩ ⟦ c ⟧′ ∎ correct-var : ∀ {n} (i : Fin n) → ∀ ρ → ⟦ normalise-var i ⟧N ρ ≈ lookup ρ i correct-var (suc i) (x ∷ ρ) = begin ⟦ ∅ *x+HN normalise-var i ⟧H (x ∷ ρ) ≈⟨ ∅*x+HN-homo (normalise-var i) x ρ ⟩ ⟦ normalise-var i ⟧N ρ ≈⟨ correct-var i ρ ⟩ lookup ρ i ∎ correct-var zero (x ∷ ρ) = begin (0# * x + ⟦ 1N ⟧N ρ) * x + ⟦ 0N ⟧N ρ ≈⟨ ((refl ⟨ +-cong ⟩ 1N-homo ρ) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ 0N-homo ρ ⟩ (0# * x + 1#) * x + 0# ≈⟨ lemma₅ _ ⟩ x ∎ correct : ∀ {n} (p : Polynomial n) → ∀ ρ → ⟦ p ⟧↓ ρ ≈ ⟦ p ⟧ ρ correct (op [+] p₁ p₂) ρ = begin ⟦ normalise p₁ +N normalise p₂ ⟧N ρ ≈⟨ +N-homo (normalise p₁) (normalise p₂) ρ ⟩ ⟦ p₁ ⟧↓ ρ + ⟦ p₂ ⟧↓ ρ ≈⟨ correct p₁ ρ ⟨ +-cong ⟩ correct p₂ ρ ⟩ ⟦ p₁ ⟧ ρ + ⟦ p₂ ⟧ ρ ∎ correct (op [*] p₁ p₂) ρ = begin ⟦ normalise p₁ *N normalise p₂ ⟧N ρ ≈⟨ *N-homo (normalise p₁) (normalise p₂) ρ ⟩ ⟦ p₁ ⟧↓ ρ * ⟦ p₂ ⟧↓ ρ ≈⟨ correct p₁ ρ ⟨ *-cong ⟩ correct p₂ ρ ⟩ ⟦ p₁ ⟧ ρ * ⟦ p₂ ⟧ ρ ∎ correct (con c) ρ = correct-con c ρ correct (var i) ρ = correct-var i ρ correct (p :^ k) ρ = begin ⟦ normalise p ^N k ⟧N ρ ≈⟨ ^N-homo (normalise p) k ρ ⟩ ⟦ p ⟧↓ ρ ^ k ≈⟨ correct p ρ ⟨ ^-cong ⟩ PropEq.refl {x = k} ⟩ ⟦ p ⟧ ρ ^ k ∎ correct (:- p) ρ = begin ⟦ -N normalise p ⟧N ρ ≈⟨ -N‿-homo (normalise p) ρ ⟩ - ⟦ p ⟧↓ ρ ≈⟨ -‿cong (correct p ρ) ⟩ - ⟦ p ⟧ ρ ∎ ------------------------------------------------------------------------ -- "Tactic. open Reflection setoid var ⟦_⟧ ⟦_⟧↓ correct public using (prove; solve) renaming (_⊜_ to _:=_) -- For examples of how solve and _:=_ can be used to -- semi-automatically prove ring equalities, see, for instance, -- Data.Digit or Data.Nat.DivMod. agda-stdlib-1.7.3/src/Algebra/Solver/Ring/000077500000000000000000000000001451211343400201705ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Solver/Ring/AlmostCommutativeRing.agda000066400000000000000000000115541451211343400253110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Commutative semirings with some additional structure ("almost" -- commutative rings), used by the ring solver ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Algebra.Solver.Ring.AlmostCommutativeRing where open import Algebra open import Algebra.Structures open import Algebra.Definitions import Algebra.Morphism as Morphism import Algebra.Morphism.Definitions as MorphismDefinitions open import Function hiding (Morphism) open import Level open import Relation.Binary record IsAlmostCommutativeRing {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) (_+_ _*_ : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isCommutativeSemiring : IsCommutativeSemiring _≈_ _+_ _*_ 0# 1# -‿cong : Congruent₁ _≈_ -_ -‿*-distribˡ : ∀ x y → ((- x) * y) ≈ (- (x * y)) -‿+-comm : ∀ x y → ((- x) + (- y)) ≈ (- (x + y)) open IsCommutativeSemiring isCommutativeSemiring public record AlmostCommutativeRing c ℓ : Set (suc (c ⊔ ℓ)) where infix 8 -_ infixl 7 _*_ infixl 6 _+_ infix 4 _≈_ field Carrier : Set c _≈_ : Rel Carrier ℓ _+_ : Op₂ Carrier _*_ : Op₂ Carrier -_ : Op₁ Carrier 0# : Carrier 1# : Carrier isAlmostCommutativeRing : IsAlmostCommutativeRing _≈_ _+_ _*_ -_ 0# 1# open IsAlmostCommutativeRing isAlmostCommutativeRing public commutativeSemiring : CommutativeSemiring _ _ commutativeSemiring = record { isCommutativeSemiring = isCommutativeSemiring } open CommutativeSemiring commutativeSemiring public using ( +-magma; +-semigroup ; *-magma; *-semigroup; *-commutativeSemigroup ; +-monoid; +-commutativeMonoid ; *-monoid; *-commutativeMonoid ; semiring ) rawRing : RawRing _ _ rawRing = record { _≈_ = _≈_ ; _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0# ; 1# = 1# } ------------------------------------------------------------------------ -- Homomorphisms record _-Raw-AlmostCommutative⟶_ {r₁ r₂ r₃ r₄} (From : RawRing r₁ r₄) (To : AlmostCommutativeRing r₂ r₃) : Set (r₁ ⊔ r₂ ⊔ r₃) where private module F = RawRing From module T = AlmostCommutativeRing To open MorphismDefinitions F.Carrier T.Carrier T._≈_ field ⟦_⟧ : Morphism +-homo : Homomorphic₂ ⟦_⟧ F._+_ T._+_ *-homo : Homomorphic₂ ⟦_⟧ F._*_ T._*_ -‿homo : Homomorphic₁ ⟦_⟧ F.-_ T.-_ 0-homo : Homomorphic₀ ⟦_⟧ F.0# T.0# 1-homo : Homomorphic₀ ⟦_⟧ F.1# T.1# -raw-almostCommutative⟶ : ∀ {r₁ r₂} (R : AlmostCommutativeRing r₁ r₂) → AlmostCommutativeRing.rawRing R -Raw-AlmostCommutative⟶ R -raw-almostCommutative⟶ R = record { ⟦_⟧ = id ; +-homo = λ _ _ → refl ; *-homo = λ _ _ → refl ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } where open AlmostCommutativeRing R Induced-equivalence : ∀ {c₁ c₂ ℓ₁ ℓ₂} {Coeff : RawRing c₁ ℓ₁} {R : AlmostCommutativeRing c₂ ℓ₂} → Coeff -Raw-AlmostCommutative⟶ R → Rel (RawRing.Carrier Coeff) ℓ₂ Induced-equivalence {R = R} morphism a b = ⟦ a ⟧ ≈ ⟦ b ⟧ where open AlmostCommutativeRing R open _-Raw-AlmostCommutative⟶_ morphism ------------------------------------------------------------------------ -- Conversions -- Commutative rings are almost commutative rings. fromCommutativeRing : ∀ {r₁ r₂} → CommutativeRing r₁ r₂ → AlmostCommutativeRing r₁ r₂ fromCommutativeRing CR = record { isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = -‿cong ; -‿*-distribˡ = -‿*-distribˡ ; -‿+-comm = ⁻¹-∙-comm } } where open CommutativeRing CR open import Algebra.Properties.Ring ring open import Algebra.Properties.AbelianGroup +-abelianGroup -- Commutative semirings can be viewed as almost commutative rings by -- using identity as the "almost negation". fromCommutativeSemiring : ∀ {r₁ r₂} → CommutativeSemiring r₁ r₂ → AlmostCommutativeRing _ _ fromCommutativeSemiring CS = record { -_ = id ; isAlmostCommutativeRing = record { isCommutativeSemiring = isCommutativeSemiring ; -‿cong = id ; -‿*-distribˡ = λ _ _ → refl ; -‿+-comm = λ _ _ → refl } } where open CommutativeSemiring CS agda-stdlib-1.7.3/src/Algebra/Solver/Ring/Lemmas.agda000066400000000000000000000112771451211343400222340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some boring lemmas used by the ring solver ------------------------------------------------------------------------ -- Note that these proofs use all "almost commutative ring" properties. {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Algebra.Solver.Ring.AlmostCommutativeRing module Algebra.Solver.Ring.Lemmas {r₁ r₂ r₃ r₄} (coeff : RawRing r₁ r₄) (r : AlmostCommutativeRing r₂ r₃) (morphism : coeff -Raw-AlmostCommutative⟶ r) where private module C = RawRing coeff open AlmostCommutativeRing r open import Algebra.Morphism open _-Raw-AlmostCommutative⟶_ morphism open import Relation.Binary.Reasoning.Setoid setoid open import Function lemma₀ : ∀ a b c x → (a + b) * x + c ≈ a * x + (b * x + c) lemma₀ a b c x = begin (a + b) * x + c ≈⟨ distribʳ _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * x + b * x) + c ≈⟨ +-assoc _ _ _ ⟩ a * x + (b * x + c) ∎ lemma₁ : ∀ a b c d x → (a + b) * x + (c + d) ≈ (a * x + c) + (b * x + d) lemma₁ a b c d x = begin (a + b) * x + (c + d) ≈⟨ lemma₀ _ _ _ _ ⟩ a * x + (b * x + (c + d)) ≈⟨ refl ⟨ +-cong ⟩ sym (+-assoc _ _ _) ⟩ a * x + ((b * x + c) + d) ≈⟨ refl ⟨ +-cong ⟩ (+-comm _ _ ⟨ +-cong ⟩ refl) ⟩ a * x + ((c + b * x) + d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x + (c + (b * x + d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ (a * x + c) + (b * x + d) ∎ lemma₂ : ∀ a b c x → a * c * x + b * c ≈ (a * x + b) * c lemma₂ a b c x = begin a * c * x + b * c ≈⟨ lem ⟨ +-cong ⟩ refl ⟩ a * x * c + b * c ≈⟨ sym $ distribʳ _ _ _ ⟩ (a * x + b) * c ∎ where lem = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lemma₃ : ∀ a b c x → a * b * x + a * c ≈ a * (b * x + c) lemma₃ a b c x = begin a * b * x + a * c ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * (b * x) + a * c ≈⟨ sym $ distribˡ _ _ _ ⟩ a * (b * x + c) ∎ lemma₄ : ∀ a b c d x → (a * c * x + (a * d + b * c)) * x + b * d ≈ (a * x + b) * (c * x + d) lemma₄ a b c d x = begin (a * c * x + (a * d + b * c)) * x + b * d ≈⟨ distribʳ _ _ _ ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ refl ⟨ +-cong ⟩ ((refl ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (a * c * x * x + (a * d + b * c) * x) + b * d ≈⟨ +-assoc _ _ _ ⟩ a * c * x * x + ((a * d + b * c) * x + b * d) ≈⟨ lem₁ ⟨ +-cong ⟩ (lem₂ ⟨ +-cong ⟩ refl) ⟩ a * x * (c * x) + (a * x * d + b * (c * x) + b * d) ≈⟨ refl ⟨ +-cong ⟩ +-assoc _ _ _ ⟩ a * x * (c * x) + (a * x * d + (b * (c * x) + b * d)) ≈⟨ sym $ +-assoc _ _ _ ⟩ a * x * (c * x) + a * x * d + (b * (c * x) + b * d) ≈⟨ sym $ distribˡ _ _ _ ⟨ +-cong ⟩ distribˡ _ _ _ ⟩ a * x * (c * x + d) + b * (c * x + d) ≈⟨ sym $ distribʳ _ _ _ ⟩ (a * x + b) * (c * x + d) ∎ where lem₁′ = begin a * c * x ≈⟨ *-assoc _ _ _ ⟩ a * (c * x) ≈⟨ refl ⟨ *-cong ⟩ *-comm _ _ ⟩ a * (x * c) ≈⟨ sym $ *-assoc _ _ _ ⟩ a * x * c ∎ lem₁ = begin a * c * x * x ≈⟨ lem₁′ ⟨ *-cong ⟩ refl ⟩ a * x * c * x ≈⟨ *-assoc _ _ _ ⟩ a * x * (c * x) ∎ lem₂ = begin (a * d + b * c) * x ≈⟨ distribʳ _ _ _ ⟩ a * d * x + b * c * x ≈⟨ *-assoc _ _ _ ⟨ +-cong ⟩ *-assoc _ _ _ ⟩ a * (d * x) + b * (c * x) ≈⟨ (refl ⟨ *-cong ⟩ *-comm _ _) ⟨ +-cong ⟩ refl ⟩ a * (x * d) + b * (c * x) ≈⟨ sym $ *-assoc _ _ _ ⟨ +-cong ⟩ refl ⟩ a * x * d + b * (c * x) ∎ lemma₅ : ∀ x → (0# * x + 1#) * x + 0# ≈ x lemma₅ x = begin (0# * x + 1#) * x + 0# ≈⟨ ((zeroˡ _ ⟨ +-cong ⟩ refl) ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ (0# + 1#) * x + 0# ≈⟨ (+-identityˡ _ ⟨ *-cong ⟩ refl) ⟨ +-cong ⟩ refl ⟩ 1# * x + 0# ≈⟨ +-identityʳ _ ⟩ 1# * x ≈⟨ *-identityˡ _ ⟩ x ∎ lemma₆ : ∀ a x → 0# * x + a ≈ a lemma₆ a x = begin 0# * x + a ≈⟨ zeroˡ _ ⟨ +-cong ⟩ refl ⟩ 0# + a ≈⟨ +-identityˡ _ ⟩ a ∎ lemma₇ : ∀ x → - 1# * x ≈ - x lemma₇ x = begin - 1# * x ≈⟨ -‿*-distribˡ _ _ ⟩ - (1# * x) ≈⟨ -‿cong (*-identityˡ _) ⟩ - x ∎ agda-stdlib-1.7.3/src/Algebra/Solver/Ring/NaturalCoefficients.agda000066400000000000000000000043441451211343400247430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver, using the natural numbers as the -- coefficient "ring" ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra import Algebra.Properties.Semiring.Mult as SemiringMultiplication open import Data.Maybe.Base using (Maybe; just; nothing; map) open import Algebra.Solver.Ring.AlmostCommutativeRing open import Data.Nat.Base as ℕ open import Data.Product using (module Σ) open import Function.Base using (id) open import Relation.Binary.PropositionalEquality using (_≡_) module Algebra.Solver.Ring.NaturalCoefficients {r₁ r₂} (R : CommutativeSemiring r₁ r₂) (open CommutativeSemiring R) (open SemiringMultiplication semiring using () renaming (_×_ to _×ᵤ_)) (dec : ∀ m n → Maybe (m ×ᵤ 1# ≈ n ×ᵤ 1#)) where open import Algebra.Properties.Semiring.Mult.TCOptimised semiring open import Relation.Binary.Reasoning.Setoid setoid private -- The coefficient "ring". ℕ-ring : RawRing _ _ ℕ-ring = record { Carrier = ℕ ; _≈_ = _≡_ ; _+_ = ℕ._+_ ; _*_ = ℕ._*_ ; -_ = id ; 0# = 0 ; 1# = 1 } -- There is a homomorphism from ℕ to R. -- -- Note that the optimised _×_ is used rather than unoptimised _×ᵤ_. -- If _×ᵤ_ were used, then Function.Related.TypeIsomorphisms.test would fail -- to type-check. homomorphism : ℕ-ring -Raw-AlmostCommutative⟶ fromCommutativeSemiring R homomorphism = record { ⟦_⟧ = λ n → n × 1# ; +-homo = ×-homo-+ 1# ; *-homo = ×1-homo-* ; -‿homo = λ _ → refl ; 0-homo = refl ; 1-homo = refl } -- Equality of certain expressions can be decided. dec′ : ∀ m n → Maybe (m × 1# ≈ n × 1#) dec′ m n = map to (dec m n) where to : m ×ᵤ 1# ≈ n ×ᵤ 1# → m × 1# ≈ n × 1# to m≈n = begin m × 1# ≈˘⟨ ×ᵤ≈× m 1# ⟩ m ×ᵤ 1# ≈⟨ m≈n ⟩ n ×ᵤ 1# ≈⟨ ×ᵤ≈× n 1# ⟩ n × 1# ∎ -- The instantiation. open import Algebra.Solver.Ring _ _ homomorphism dec′ public agda-stdlib-1.7.3/src/Algebra/Solver/Ring/NaturalCoefficients/000077500000000000000000000000001451211343400241205ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Solver/Ring/NaturalCoefficients/Default.agda000066400000000000000000000021771451211343400263310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the natural coefficients ring solver, using coefficient -- equality induced by ℕ. -- -- This is sufficient for proving equalities that are independent of the -- characteristic. In particular, this is enough for equalities in rings of -- characteristic 0. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Algebra.Solver.Ring.NaturalCoefficients.Default {r₁ r₂} (R : CommutativeSemiring r₁ r₂) where import Algebra.Properties.Semiring.Mult as SemiringMultiplication open import Data.Maybe.Base using (Maybe; map) open import Data.Nat using (_≟_) open import Relation.Binary.Consequences using (dec⇒weaklyDec) import Relation.Binary.PropositionalEquality as P open CommutativeSemiring R open SemiringMultiplication semiring private dec : ∀ m n → Maybe (m × 1# ≈ n × 1#) dec m n = map (λ { P.refl → refl }) (dec⇒weaklyDec _≟_ m n) open import Algebra.Solver.Ring.NaturalCoefficients R dec public agda-stdlib-1.7.3/src/Algebra/Solver/Ring/Simple.agda000066400000000000000000000013621451211343400222410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instantiates the ring solver with two copies of the same ring with -- decidable equality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Solver.Ring.AlmostCommutativeRing open import Relation.Binary open import Relation.Binary.Consequences using (dec⇒weaklyDec) module Algebra.Solver.Ring.Simple {r₁ r₂} (R : AlmostCommutativeRing r₁ r₂) (_≟_ : Decidable (AlmostCommutativeRing._≈_ R)) where open AlmostCommutativeRing R import Algebra.Solver.Ring as RS open RS rawRing R (-raw-almostCommutative⟶ R) (dec⇒weaklyDec _≟_) public agda-stdlib-1.7.3/src/Algebra/Structures.agda000066400000000000000000000411231451211343400210210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some algebraic structures (not packed up with sets, operations, -- etc.) ------------------------------------------------------------------------ -- The contents of this module should be accessed via `Algebra`, unless -- you want to parameterise it via the equality relation. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; IsEquivalence) module Algebra.Structures {a ℓ} {A : Set a} -- The underlying set (_≈_ : Rel A ℓ) -- The underlying equality relation where -- The file is divided into sections depending on the arities of the -- components of the algebraic structure. open import Algebra.Core open import Algebra.Definitions _≈_ import Algebra.Consequences.Setoid as Consequences open import Data.Product using (_,_; proj₁; proj₂) open import Level using (_⊔_) ------------------------------------------------------------------------ -- Structures with 1 binary operation ------------------------------------------------------------------------ record IsMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence _≈_ ∙-cong : Congruent₂ ∙ open IsEquivalence isEquivalence public setoid : Setoid a ℓ setoid = record { isEquivalence = isEquivalence } ∙-congˡ : LeftCongruent ∙ ∙-congˡ y≈z = ∙-cong refl y≈z ∙-congʳ : RightCongruent ∙ ∙-congʳ y≈z = ∙-cong y≈z refl record IsCommutativeMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ∙ comm : Commutative ∙ open IsMagma isMagma public record IsSelectiveMagma (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ∙ sel : Selective ∙ open IsMagma isMagma public record IsSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isMagma : IsMagma ∙ assoc : Associative ∙ open IsMagma isMagma public record IsBand (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ idem : Idempotent ∙ open IsSemigroup isSemigroup public record IsCommutativeSemigroup (∙ : Op₂ A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ comm : Commutative ∙ open IsSemigroup isSemigroup public isCommutativeMagma : IsCommutativeMagma ∙ isCommutativeMagma = record { isMagma = isMagma ; comm = comm } record IsSemilattice (∧ : Op₂ A) : Set (a ⊔ ℓ) where field isBand : IsBand ∧ comm : Commutative ∧ open IsBand isBand public renaming (∙-cong to ∧-cong; ∙-congˡ to ∧-congˡ; ∙-congʳ to ∧-congʳ) ------------------------------------------------------------------------ -- Structures with 1 binary operation & 1 element ------------------------------------------------------------------------ record IsMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ identity : Identity ε ∙ open IsSemigroup isSemigroup public identityˡ : LeftIdentity ε ∙ identityˡ = proj₁ identity identityʳ : RightIdentity ε ∙ identityʳ = proj₂ identity record IsCommutativeMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isMonoid : IsMonoid ∙ ε comm : Commutative ∙ open IsMonoid isMonoid public isCommutativeSemigroup : IsCommutativeSemigroup ∙ isCommutativeSemigroup = record { isSemigroup = isSemigroup ; comm = comm } open IsCommutativeSemigroup isCommutativeSemigroup public using (isCommutativeMagma) record IsIdempotentCommutativeMonoid (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isCommutativeMonoid : IsCommutativeMonoid ∙ ε idem : Idempotent ∙ open IsCommutativeMonoid isCommutativeMonoid public -- Idempotent commutative monoids are also known as bounded lattices. -- Note that the BoundedLattice necessarily uses the notation inherited -- from monoids rather than lattices. IsBoundedLattice = IsIdempotentCommutativeMonoid module IsBoundedLattice {∙ : Op₂ A} {ε : A} (isIdemCommMonoid : IsIdempotentCommutativeMonoid ∙ ε) = IsIdempotentCommutativeMonoid isIdemCommMonoid ------------------------------------------------------------------------ -- Structures with 1 binary operation, 1 unary operation & 1 element ------------------------------------------------------------------------ record IsGroup (_∙_ : Op₂ A) (ε : A) (_⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where field isMonoid : IsMonoid _∙_ ε inverse : Inverse ε _⁻¹ _∙_ ⁻¹-cong : Congruent₁ _⁻¹ open IsMonoid isMonoid public infixl 6 _-_ _-_ : Op₂ A x - y = x ∙ (y ⁻¹) inverseˡ : LeftInverse ε _⁻¹ _∙_ inverseˡ = proj₁ inverse inverseʳ : RightInverse ε _⁻¹ _∙_ inverseʳ = proj₂ inverse uniqueˡ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → x ≈ (y ⁻¹) uniqueˡ-⁻¹ = Consequences.assoc+id+invʳ⇒invˡ-unique setoid ∙-cong assoc identity inverseʳ uniqueʳ-⁻¹ : ∀ x y → (x ∙ y) ≈ ε → y ≈ (x ⁻¹) uniqueʳ-⁻¹ = Consequences.assoc+id+invˡ⇒invʳ-unique setoid ∙-cong assoc identity inverseˡ record IsAbelianGroup (∙ : Op₂ A) (ε : A) (⁻¹ : Op₁ A) : Set (a ⊔ ℓ) where field isGroup : IsGroup ∙ ε ⁻¹ comm : Commutative ∙ open IsGroup isGroup public isCommutativeMonoid : IsCommutativeMonoid ∙ ε isCommutativeMonoid = record { isMonoid = isMonoid ; comm = comm } open IsCommutativeMonoid isCommutativeMonoid public using (isCommutativeMagma; isCommutativeSemigroup) ------------------------------------------------------------------------ -- Structures with 2 binary operations ------------------------------------------------------------------------ -- Note that `IsLattice` is not defined in terms of `IsSemilattice` -- because the idempotence laws of ∨ and ∧ can be derived from the -- absorption laws, which makes the corresponding "idem" fields -- redundant. The derived idempotence laws are stated and proved in -- `Algebra.Properties.Lattice` along with the fact that every lattice -- consists of two semilattices. record IsLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where field isEquivalence : IsEquivalence _≈_ ∨-comm : Commutative ∨ ∨-assoc : Associative ∨ ∨-cong : Congruent₂ ∨ ∧-comm : Commutative ∧ ∧-assoc : Associative ∧ ∧-cong : Congruent₂ ∧ absorptive : Absorptive ∨ ∧ open IsEquivalence isEquivalence public ∨-absorbs-∧ : ∨ Absorbs ∧ ∨-absorbs-∧ = proj₁ absorptive ∧-absorbs-∨ : ∧ Absorbs ∨ ∧-absorbs-∨ = proj₂ absorptive ∧-congˡ : LeftCongruent ∧ ∧-congˡ y≈z = ∧-cong refl y≈z ∧-congʳ : RightCongruent ∧ ∧-congʳ y≈z = ∧-cong y≈z refl ∨-congˡ : LeftCongruent ∨ ∨-congˡ y≈z = ∨-cong refl y≈z ∨-congʳ : RightCongruent ∨ ∨-congʳ y≈z = ∨-cong y≈z refl record IsDistributiveLattice (∨ ∧ : Op₂ A) : Set (a ⊔ ℓ) where field isLattice : IsLattice ∨ ∧ ∨-distribʳ-∧ : ∨ DistributesOverʳ ∧ open IsLattice isLattice public ∨-∧-distribʳ = ∨-distribʳ-∧ {-# WARNING_ON_USAGE ∨-∧-distribʳ "Warning: ∨-∧-distribʳ was deprecated in v1.1. Please use ∨-distribʳ-∧ instead." #-} ------------------------------------------------------------------------ -- Structures with 2 binary operations & 1 element ------------------------------------------------------------------------ record IsNearSemiring (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field +-isMonoid : IsMonoid + 0# *-isSemigroup : IsSemigroup * distribʳ : * DistributesOverʳ + zeroˡ : LeftZero 0# * open IsMonoid +-isMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ) open IsSemigroup *-isSemigroup public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; isMagma to *-isMagma ) record IsSemiringWithoutOne (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field +-isCommutativeMonoid : IsCommutativeMonoid + 0# *-isSemigroup : IsSemigroup * distrib : * DistributesOver + zero : Zero 0# * open IsCommutativeMonoid +-isCommutativeMonoid public using () renaming ( comm to +-comm ; isMonoid to +-isMonoid ; isCommutativeMagma to +-isCommutativeMagma ; isCommutativeSemigroup to +-isCommutativeSemigroup ) zeroˡ : LeftZero 0# * zeroˡ = proj₁ zero zeroʳ : RightZero 0# * zeroʳ = proj₂ zero isNearSemiring : IsNearSemiring + * 0# isNearSemiring = record { +-isMonoid = +-isMonoid ; *-isSemigroup = *-isSemigroup ; distribʳ = proj₂ distrib ; zeroˡ = zeroˡ } open IsNearSemiring isNearSemiring public hiding (+-isMonoid; zeroˡ; *-isSemigroup) record IsCommutativeSemiringWithoutOne (+ * : Op₂ A) (0# : A) : Set (a ⊔ ℓ) where field isSemiringWithoutOne : IsSemiringWithoutOne + * 0# *-comm : Commutative * open IsSemiringWithoutOne isSemiringWithoutOne public *-isCommutativeSemigroup : IsCommutativeSemigroup * *-isCommutativeSemigroup = record { isSemigroup = *-isSemigroup ; comm = *-comm } open IsCommutativeSemigroup *-isCommutativeSemigroup public using () renaming (isCommutativeMagma to *-isCommutativeMagma) ------------------------------------------------------------------------ -- Structures with 2 binary operations & 2 elements ------------------------------------------------------------------------ record IsSemiringWithoutAnnihilatingZero (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field -- Note that these structures do have an additive unit, but this -- unit does not necessarily annihilate multiplication. +-isCommutativeMonoid : IsCommutativeMonoid + 0# *-isMonoid : IsMonoid * 1# distrib : * DistributesOver + distribˡ : * DistributesOverˡ + distribˡ = proj₁ distrib distribʳ : * DistributesOverʳ + distribʳ = proj₂ distrib open IsCommutativeMonoid +-isCommutativeMonoid public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; comm to +-comm ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ; isMonoid to +-isMonoid ; isCommutativeMagma to +-isCommutativeMagma ; isCommutativeSemigroup to +-isCommutativeSemigroup ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; identity to *-identity ; identityˡ to *-identityˡ ; identityʳ to *-identityʳ ; isMagma to *-isMagma ; isSemigroup to *-isSemigroup ) record IsSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero + * 0# 1# zero : Zero 0# * open IsSemiringWithoutAnnihilatingZero isSemiringWithoutAnnihilatingZero public isSemiringWithoutOne : IsSemiringWithoutOne + * 0# isSemiringWithoutOne = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isSemigroup = *-isSemigroup ; distrib = distrib ; zero = zero } open IsSemiringWithoutOne isSemiringWithoutOne public using ( isNearSemiring ; zeroˡ ; zeroʳ ) record IsCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isSemiring : IsSemiring + * 0# 1# *-comm : Commutative * open IsSemiring isSemiring public isCommutativeSemiringWithoutOne : IsCommutativeSemiringWithoutOne + * 0# isCommutativeSemiringWithoutOne = record { isSemiringWithoutOne = isSemiringWithoutOne ; *-comm = *-comm } open IsCommutativeSemiringWithoutOne isCommutativeSemiringWithoutOne public using ( *-isCommutativeMagma ; *-isCommutativeSemigroup ) *-isCommutativeMonoid : IsCommutativeMonoid * 1# *-isCommutativeMonoid = record { isMonoid = *-isMonoid ; comm = *-comm } record IsCancellativeCommutativeSemiring (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# *-cancelˡ-nonZero : AlmostLeftCancellative 0# * open IsCommutativeSemiring isCommutativeSemiring public ------------------------------------------------------------------------ -- Structures with 2 binary operations, 1 unary operation & 2 elements ------------------------------------------------------------------------ record IsRing (+ * : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field +-isAbelianGroup : IsAbelianGroup + 0# -_ *-isMonoid : IsMonoid * 1# distrib : * DistributesOver + zero : Zero 0# * open IsAbelianGroup +-isAbelianGroup public renaming ( assoc to +-assoc ; ∙-cong to +-cong ; ∙-congˡ to +-congˡ ; ∙-congʳ to +-congʳ ; identity to +-identity ; identityˡ to +-identityˡ ; identityʳ to +-identityʳ ; inverse to -‿inverse ; inverseˡ to -‿inverseˡ ; inverseʳ to -‿inverseʳ ; ⁻¹-cong to -‿cong ; comm to +-comm ; isMagma to +-isMagma ; isSemigroup to +-isSemigroup ; isMonoid to +-isMonoid ; isCommutativeMagma to +-isCommutativeMagma ; isCommutativeMonoid to +-isCommutativeMonoid ; isCommutativeSemigroup to +-isCommutativeSemigroup ; isGroup to +-isGroup ) open IsMonoid *-isMonoid public using () renaming ( assoc to *-assoc ; ∙-cong to *-cong ; ∙-congˡ to *-congˡ ; ∙-congʳ to *-congʳ ; identity to *-identity ; identityˡ to *-identityˡ ; identityʳ to *-identityʳ ; isMagma to *-isMagma ; isSemigroup to *-isSemigroup ) zeroˡ : LeftZero 0# * zeroˡ = proj₁ zero zeroʳ : RightZero 0# * zeroʳ = proj₂ zero isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero + * 0# 1# isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-isMonoid ; distrib = distrib } isSemiring : IsSemiring + * 0# 1# isSemiring = record { isSemiringWithoutAnnihilatingZero = isSemiringWithoutAnnihilatingZero ; zero = zero } open IsSemiring isSemiring public using (distribˡ; distribʳ; isNearSemiring; isSemiringWithoutOne) record IsCommutativeRing (+ * : Op₂ A) (- : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field isRing : IsRing + * - 0# 1# *-comm : Commutative * open IsRing isRing public isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# isCommutativeSemiring = record { isSemiring = isSemiring ; *-comm = *-comm } open IsCommutativeSemiring isCommutativeSemiring public using ( isCommutativeSemiringWithoutOne ; *-isCommutativeMagma ; *-isCommutativeSemigroup ; *-isCommutativeMonoid ) record IsBooleanAlgebra (∨ ∧ : Op₂ A) (¬ : Op₁ A) (⊤ ⊥ : A) : Set (a ⊔ ℓ) where field isDistributiveLattice : IsDistributiveLattice ∨ ∧ ∨-complementʳ : RightInverse ⊤ ¬ ∨ ∧-complementʳ : RightInverse ⊥ ¬ ∧ ¬-cong : Congruent₁ ¬ open IsDistributiveLattice isDistributiveLattice public agda-stdlib-1.7.3/src/Algebra/Structures/000077500000000000000000000000001451211343400202025ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Algebra/Structures/Biased.agda000066400000000000000000000143331451211343400222130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Ways to give instances of certain structures where some fields can -- be given in terms of others ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Setoid; IsEquivalence) module Algebra.Structures.Biased {a ℓ} {A : Set a} -- The underlying set (_≈_ : Rel A ℓ) -- The underlying equality relation where open import Algebra.Core open import Algebra.Definitions _≈_ open import Algebra.Structures _≈_ import Algebra.Consequences.Setoid as Consequences open import Data.Product using (_,_; proj₁; proj₂) open import Level using (_⊔_) ------------------------------------------------------------------------ -- IsCommutativeMonoid record IsCommutativeMonoidˡ (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ identityˡ : LeftIdentity ε ∙ comm : Commutative ∙ open IsSemigroup isSemigroup private identityʳ : RightIdentity ε ∙ identityʳ = Consequences.comm+idˡ⇒idʳ setoid comm identityˡ identity : Identity ε ∙ identity = (identityˡ , identityʳ) isCommutativeMonoid : IsCommutativeMonoid ∙ ε isCommutativeMonoid = record { isMonoid = record { isSemigroup = isSemigroup ; identity = identity } ; comm = comm } open IsCommutativeMonoidˡ public using () renaming (isCommutativeMonoid to isCommutativeMonoidˡ) record IsCommutativeMonoidʳ (∙ : Op₂ A) (ε : A) : Set (a ⊔ ℓ) where field isSemigroup : IsSemigroup ∙ identityʳ : RightIdentity ε ∙ comm : Commutative ∙ open IsSemigroup isSemigroup private identityˡ : LeftIdentity ε ∙ identityˡ = Consequences.comm+idʳ⇒idˡ setoid comm identityʳ identity : Identity ε ∙ identity = (identityˡ , identityʳ) isCommutativeMonoid : IsCommutativeMonoid ∙ ε isCommutativeMonoid = record { isMonoid = record { isSemigroup = isSemigroup ; identity = identity } ; comm = comm } open IsCommutativeMonoidʳ public using () renaming (isCommutativeMonoid to isCommutativeMonoidʳ) ------------------------------------------------------------------------ -- IsCommutativeSemiring record IsCommutativeSemiringˡ (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field +-isCommutativeMonoid : IsCommutativeMonoid + 0# *-isCommutativeMonoid : IsCommutativeMonoid * 1# distribʳ : * DistributesOverʳ + zeroˡ : LeftZero 0# * private module +-CM = IsCommutativeMonoid +-isCommutativeMonoid open module *-CM = IsCommutativeMonoid *-isCommutativeMonoid public using () renaming (comm to *-comm) distribˡ : * DistributesOverˡ + distribˡ = Consequences.comm+distrʳ⇒distrˡ +-CM.setoid +-CM.∙-cong *-comm distribʳ distrib : * DistributesOver + distrib = (distribˡ , distribʳ) zeroʳ : RightZero 0# * zeroʳ = Consequences.comm+zeˡ⇒zeʳ +-CM.setoid *-comm zeroˡ zero : Zero 0# * zero = (zeroˡ , zeroʳ) isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# isCommutativeSemiring = record { isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-CM.isMonoid ; distrib = distrib } ; zero = zero } ; *-comm = *-comm } open IsCommutativeSemiringˡ public using () renaming (isCommutativeSemiring to isCommutativeSemiringˡ) record IsCommutativeSemiringʳ (+ * : Op₂ A) (0# 1# : A) : Set (a ⊔ ℓ) where field +-isCommutativeMonoid : IsCommutativeMonoid + 0# *-isCommutativeMonoid : IsCommutativeMonoid * 1# distribˡ : * DistributesOverˡ + zeroʳ : RightZero 0# * private module +-CM = IsCommutativeMonoid +-isCommutativeMonoid open module *-CM = IsCommutativeMonoid *-isCommutativeMonoid public using () renaming (comm to *-comm) distribʳ : * DistributesOverʳ + distribʳ = Consequences.comm+distrˡ⇒distrʳ +-CM.setoid +-CM.∙-cong *-comm distribˡ distrib : * DistributesOver + distrib = (distribˡ , distribʳ) zeroˡ : LeftZero 0# * zeroˡ = Consequences.comm+zeʳ⇒zeˡ +-CM.setoid *-comm zeroʳ zero : Zero 0# * zero = (zeroˡ , zeroʳ) isCommutativeSemiring : IsCommutativeSemiring + * 0# 1# isCommutativeSemiring = record { isSemiring = record { isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = +-isCommutativeMonoid ; *-isMonoid = *-CM.isMonoid ; distrib = distrib } ; zero = zero } ; *-comm = *-comm } open IsCommutativeSemiringʳ public using () renaming (isCommutativeSemiring to isCommutativeSemiringʳ) ------------------------------------------------------------------------ -- IsRing -- We can recover a ring without proving that 0# annihilates *. record IsRingWithoutAnnihilatingZero (+ * : Op₂ A) (-_ : Op₁ A) (0# 1# : A) : Set (a ⊔ ℓ) where field +-isAbelianGroup : IsAbelianGroup + 0# -_ *-isMonoid : IsMonoid * 1# distrib : * DistributesOver + private module + = IsAbelianGroup +-isAbelianGroup module * = IsMonoid *-isMonoid open + using (setoid) renaming (∙-cong to +-cong) open * using () renaming (∙-cong to *-cong) zeroˡ : LeftZero 0# * zeroˡ = Consequences.assoc+distribʳ+idʳ+invʳ⇒zeˡ setoid +-cong *-cong +.assoc (proj₂ distrib) +.identityʳ +.inverseʳ zeroʳ : RightZero 0# * zeroʳ = Consequences.assoc+distribˡ+idʳ+invʳ⇒zeʳ setoid +-cong *-cong +.assoc (proj₁ distrib) +.identityʳ +.inverseʳ zero : Zero 0# * zero = (zeroˡ , zeroʳ) isRing : IsRing + * -_ 0# 1# isRing = record { +-isAbelianGroup = +-isAbelianGroup ; *-isMonoid = *-isMonoid ; distrib = distrib ; zero = zero } open IsRingWithoutAnnihilatingZero public using () renaming (isRing to isRingWithoutAnnihilatingZero) agda-stdlib-1.7.3/src/Axiom/000077500000000000000000000000001451211343400155375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Axiom/DoubleNegationElimination.agda000066400000000000000000000021771451211343400234540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning double negation elimination. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Axiom.DoubleNegationElimination where open import Axiom.ExcludedMiddle open import Level open import Relation.Nullary open import Relation.Nullary.Negation ------------------------------------------------------------------------ -- Definition -- The classical statement of double negation elimination says that -- if a property is not not true then it is true. DoubleNegationElimination : (ℓ : Level) → Set (suc ℓ) DoubleNegationElimination ℓ = {P : Set ℓ} → ¬ ¬ P → P ------------------------------------------------------------------------ -- Properties -- Double negation elimination is equivalent to excluded middle em⇒dne : ∀ {ℓ} → ExcludedMiddle ℓ → DoubleNegationElimination ℓ em⇒dne em = decidable-stable em dne⇒em : ∀ {ℓ} → DoubleNegationElimination ℓ → ExcludedMiddle ℓ dne⇒em dne = dne excluded-middle agda-stdlib-1.7.3/src/Axiom/ExcludedMiddle.agda000066400000000000000000000012421451211343400212300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning the excluded middle axiom. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Axiom.ExcludedMiddle where open import Level open import Relation.Nullary ------------------------------------------------------------------------ -- Definition -- The classical statement of excluded middle says that every -- statement/set is decidable (i.e. it either holds or it doesn't hold). ExcludedMiddle : (ℓ : Level) → Set (suc ℓ) ExcludedMiddle ℓ = {P : Set ℓ} → Dec P agda-stdlib-1.7.3/src/Axiom/Extensionality/000077500000000000000000000000001451211343400205565ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Axiom/Extensionality/Heterogeneous.agda000066400000000000000000000030501451211343400242060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning function extensionality for propositional equality ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Axiom.Extensionality.Heterogeneous where import Axiom.Extensionality.Propositional as P open import Function open import Level open import Relation.Binary.HeterogeneousEquality.Core open import Relation.Binary.PropositionalEquality.Core ------------------------------------------------------------------------ -- Function extensionality states that if two functions are -- propositionally equal for every input, then the functions themselves -- must be propositionally equal. Extensionality : (a b : Level) → Set _ Extensionality a b = {A : Set a} {B₁ B₂ : A → Set b} {f₁ : (x : A) → B₁ x} {f₂ : (x : A) → B₂ x} → (∀ x → B₁ x ≡ B₂ x) → (∀ x → f₁ x ≅ f₂ x) → f₁ ≅ f₂ ------------------------------------------------------------------------ -- Properties -- This form of extensionality follows from extensionality for _≡_. ≡-ext⇒≅-ext : ∀ {ℓ₁ ℓ₂} → P.Extensionality ℓ₁ (suc ℓ₂) → Extensionality ℓ₁ ℓ₂ ≡-ext⇒≅-ext {ℓ₁} {ℓ₂} ext B₁≡B₂ f₁≅f₂ with ext B₁≡B₂ ... | refl = ≡-to-≅ $ ext′ (≅-to-≡ ∘ f₁≅f₂) where ext′ : P.Extensionality ℓ₁ ℓ₂ ext′ = P.lower-extensionality ℓ₁ (suc ℓ₂) ext agda-stdlib-1.7.3/src/Axiom/Extensionality/Propositional.agda000066400000000000000000000045541451211343400242460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning function extensionality for propositional equality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Axiom.Extensionality.Propositional where open import Function.Base open import Level using (Level; _⊔_; suc; lift) open import Relation.Binary.Core open import Relation.Binary.PropositionalEquality.Core ------------------------------------------------------------------------ -- Function extensionality states that if two functions are -- propositionally equal for every input, then the functions themselves -- must be propositionally equal. Extensionality : (a b : Level) → Set _ Extensionality a b = {A : Set a} {B : A → Set b} {f g : (x : A) → B x} → (∀ x → f x ≡ g x) → f ≡ g -- A variant for implicit function spaces. ExtensionalityImplicit : (a b : Level) → Set _ ExtensionalityImplicit a b = {A : Set a} {B : A → Set b} {f g : {x : A} → B x} → (∀ {x} → f {x} ≡ g {x}) → (λ {x} → f {x}) ≡ (λ {x} → g {x}) ------------------------------------------------------------------------ -- Properties -- If extensionality holds for a given universe level, then it also -- holds for lower ones. lower-extensionality : ∀ {a₁ b₁} a₂ b₂ → Extensionality (a₁ ⊔ a₂) (b₁ ⊔ b₂) → Extensionality a₁ b₁ lower-extensionality a₂ b₂ ext f≡g = cong (λ h → Level.lower ∘ h ∘ lift) $ ext (cong (lift {ℓ = b₂}) ∘ f≡g ∘ Level.lower {ℓ = a₂}) -- Functional extensionality implies a form of extensionality for -- Π-types. ∀-extensionality : ∀ {a b} → Extensionality a (suc b) → {A : Set a} (B₁ B₂ : A → Set b) → (∀ x → B₁ x ≡ B₂ x) → (∀ x → B₁ x) ≡ (∀ x → B₂ x) ∀-extensionality ext B₁ B₂ B₁≡B₂ with ext B₁≡B₂ ... | refl = refl -- Extensionality for explicit function spaces implies extensionality -- for implicit function spaces. implicit-extensionality : ∀ {a b} → Extensionality a b → ExtensionalityImplicit a b implicit-extensionality ext f≡g = cong _$- (ext (λ x → f≡g)) agda-stdlib-1.7.3/src/Axiom/UniquenessOfIdentityProofs.agda000066400000000000000000000055461451211343400237160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning uniqueness of identity proofs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Axiom.UniquenessOfIdentityProofs where open import Data.Bool.Base using (true; false) open import Data.Empty open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary hiding (Irrelevant) open import Relation.Binary.Core open import Relation.Binary.Definitions open import Relation.Binary.PropositionalEquality.Core open import Relation.Binary.PropositionalEquality.Properties ------------------------------------------------------------------------ -- Definition -- -- Uniqueness of Identity Proofs (UIP) states that all proofs of -- equality are themselves equal. In other words, the equality relation -- is irrelevant. Here we define UIP relative to a given type. UIP : ∀ {a} (A : Set a) → Set a UIP A = Irrelevant {A = A} _≡_ ------------------------------------------------------------------------ -- Properties -- UIP always holds when using axiom K -- (see `Axiom.UniquenessOfIdentityProofs.WithK`). -- The existence of a constant function over proofs of equality for -- elements in A is enough to prove UIP for A. Indeed, we can relate any -- proof to its image via this function which we then know is equal to -- the image of any other proof. module Constant⇒UIP {a} {A : Set a} (f : _≡_ {A = A} ⇒ _≡_) (f-constant : ∀ {a b} (p q : a ≡ b) → f p ≡ f q) where ≡-canonical : ∀ {a b} (p : a ≡ b) → trans (sym (f refl)) (f p) ≡ p ≡-canonical refl = trans-symˡ (f refl) ≡-irrelevant : UIP A ≡-irrelevant p q = begin p ≡⟨ sym (≡-canonical p) ⟩ trans (sym (f refl)) (f p) ≡⟨ cong (trans _) (f-constant p q) ⟩ trans (sym (f refl)) (f q) ≡⟨ ≡-canonical q ⟩ q ∎ where open ≡-Reasoning -- If equality is decidable for a given type, then we can prove UIP for -- that type. Indeed, the decision procedure allows us to define a -- function over proofs of equality which is constant: it returns the -- proof produced by the decision procedure. module Decidable⇒UIP {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) where ≡-normalise : _≡_ {A = A} ⇒ _≡_ ≡-normalise {a} {b} a≡b with a ≟ b ... | true because [p] = invert [p] ... | false because [¬p] = ⊥-elim (invert [¬p] a≡b) ≡-normalise-constant : ∀ {a b} (p q : a ≡ b) → ≡-normalise p ≡ ≡-normalise q ≡-normalise-constant {a} {b} p q with a ≟ b ... | true because _ = refl ... | false because [¬p] = ⊥-elim (invert [¬p] p) ≡-irrelevant : UIP A ≡-irrelevant = Constant⇒UIP.≡-irrelevant ≡-normalise ≡-normalise-constant agda-stdlib-1.7.3/src/Axiom/UniquenessOfIdentityProofs/000077500000000000000000000000001451211343400230665ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Axiom/UniquenessOfIdentityProofs/WithK.agda000066400000000000000000000010021451211343400247230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Results concerning uniqueness of identity proofs, with axiom K ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Axiom.UniquenessOfIdentityProofs.WithK where open import Axiom.UniquenessOfIdentityProofs open import Relation.Binary.PropositionalEquality.Core -- Axiom K implies UIP. uip : ∀ {a} {A : Set a} → UIP A uip refl refl = refl agda-stdlib-1.7.3/src/Category/000077500000000000000000000000001451211343400162375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Category/Applicative.agda000066400000000000000000000023471451211343400213240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Applicative where open import Level using (Level; suc; _⊔_) open import Data.Unit open import Category.Applicative.Indexed private variable f : Level RawApplicative : (Set f → Set f) → Set (suc f) RawApplicative F = RawIApplicative {I = ⊤} λ _ _ → F module RawApplicative {F : Set f → Set f} (app : RawApplicative F) where open RawIApplicative app public RawApplicativeZero : (Set f → Set f) → Set (suc f) RawApplicativeZero F = RawIApplicativeZero {I = ⊤} (λ _ _ → F) module RawApplicativeZero {F : Set f → Set f} (app : RawApplicativeZero F) where open RawIApplicativeZero app public RawAlternative : (Set f → Set f) → Set _ RawAlternative F = RawIAlternative {I = ⊤} (λ _ _ → F) module RawAlternative {F : Set f → Set f} (app : RawAlternative F) where open RawIAlternative app public agda-stdlib-1.7.3/src/Category/Applicative/000077500000000000000000000000001451211343400205005ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Category/Applicative/Indexed.agda000066400000000000000000000070251451211343400227020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed applicative functors ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Applicative.Indexed where open import Category.Functor using (RawFunctor) open import Data.Product using (_×_; _,_) open import Function hiding (Morphism) open import Level open import Relation.Binary.PropositionalEquality as P using (_≡_) private variable a b c i f : Level A : Set a B : Set b C : Set c IFun : Set i → (ℓ : Level) → Set (i ⊔ suc ℓ) IFun I ℓ = I → I → Set ℓ → Set ℓ ------------------------------------------------------------------------ -- Type, and usual combinators record RawIApplicative {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {i} → A → F i i A _⊛_ : ∀ {i j k} → F i j (A → B) → F j k A → F i k B rawFunctor : ∀ {i j} → RawFunctor (F i j) rawFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF {i j : I} = RawFunctor (rawFunctor {i = i} {j = j}) public _<⊛_ : ∀ {i j k} → F i j A → F j k B → F i k A x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {i j k} → F i j A → F j k B → F i k B x ⊛> y = constᵣ <$> x ⊛ y _⊗_ : ∀ {i j k} → F i j A → F j k B → F i k (A × B) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {i j k} → (A → B → C) → F i j A → F j k B → F i k C zipWith f x y = f <$> x ⊛ y zip : ∀ {i j k} → F i j A → F j k B → F i k (A × B) zip = zipWith _,_ ------------------------------------------------------------------------ -- Applicative with a zero record RawIApplicativeZero {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where field applicative : RawIApplicative F ∅ : ∀ {i j} → F i j A open RawIApplicative applicative public ------------------------------------------------------------------------ -- Alternative functors: `F i j A` is a monoid record RawIAlternative {I : Set i} (F : IFun I f) : Set (i ⊔ suc f) where infixr 3 _∣_ field applicativeZero : RawIApplicativeZero F _∣_ : ∀ {i j} → F i j A → F i j A → F i j A open RawIApplicativeZero applicativeZero public ------------------------------------------------------------------------ -- Applicative functor morphisms, specialised to propositional -- equality. record Morphism {I : Set i} {F₁ F₂ : IFun I f} (A₁ : RawIApplicative F₁) (A₂ : RawIApplicative F₂) : Set (i ⊔ suc f) where module A₁ = RawIApplicative A₁ module A₂ = RawIApplicative A₂ field op : ∀ {i j} → F₁ i j A → F₂ i j A op-pure : ∀ {i} (x : A) → op (A₁.pure {i = i} x) ≡ A₂.pure x op-⊛ : ∀ {i j k} (f : F₁ i j (A → B)) (x : F₁ j k A) → op (f A₁.⊛ x) ≡ (op f A₂.⊛ op x) op-<$> : ∀ {i j} (f : A → B) (x : F₁ i j A) → op (f A₁.<$> x) ≡ (f A₂.<$> op x) op-<$> f x = begin op (A₁._⊛_ (A₁.pure f) x) ≡⟨ op-⊛ _ _ ⟩ A₂._⊛_ (op (A₁.pure f)) (op x) ≡⟨ P.cong₂ A₂._⊛_ (op-pure _) P.refl ⟩ A₂._⊛_ (A₂.pure f) (op x) ∎ where open P.≡-Reasoning agda-stdlib-1.7.3/src/Category/Applicative/Predicate.agda000066400000000000000000000027271451211343400232260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Applicative functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the applicative functor laws are not included -- here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Applicative.Predicate where open import Category.Functor.Predicate open import Data.Product open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) private variable i ℓ : Level ------------------------------------------------------------------------ record RawPApplicative {I : Set i} (F : Pt I ℓ) : Set (i ⊔ suc ℓ) where infixl 4 _⊛_ _<⊛_ _⊛>_ infix 4 _⊗_ field pure : ∀ {P} → P ⊆ F P _⊛_ : ∀ {P Q} → F (P ⇒ Q) ⊆ F P ⇒ F Q rawPFunctor : RawPFunctor F rawPFunctor = record { _<$>_ = λ g x → pure g ⊛ x } private open module RF = RawPFunctor rawPFunctor public _<⊛_ : ∀ {P Q} → F P ⊆ const (∀ {j} → F Q j) ⇒ F P x <⊛ y = const <$> x ⊛ y _⊛>_ : ∀ {P Q} → const (∀ {i} → F P i) ⊆ F Q ⇒ F Q x ⊛> y = constᵣ <$> x ⊛ y _⊗_ : ∀ {P Q} → F P ⊆ F Q ⇒ F (P ∩ Q) x ⊗ y = (_,_) <$> x ⊛ y zipWith : ∀ {P Q R} → (P ⊆ Q ⇒ R) → F P ⊆ F Q ⇒ F R zipWith f x y = f <$> x ⊛ y agda-stdlib-1.7.3/src/Category/Comonad.agda000066400000000000000000000020171451211343400204350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Comonads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Comonad where open import Level open import Function private variable a b c f : Level A : Set a B : Set b C : Set c record RawComonad (W : Set f → Set f) : Set (suc f) where infixl 1 _=>>_ _=>=_ infixr 1 _<<=_ _=<=_ field extract : W A → A extend : (W A → B) → (W A → W B) duplicate : W A → W (W A) duplicate = extend id liftW : (A → B) → W A → W B liftW f = extend (f ∘′ extract) _=>>_ : W A → (W A → B) → W B _=>>_ = flip extend _=>=_ : (W A → B) → (W B → C) → W A → C f =>= g = g ∘′ extend f _<<=_ : (W A → B) → W A → W B _<<=_ = extend _=<=_ : (W B → C) → (W A → B) → W A → C _=<=_ = flip _=>=_ agda-stdlib-1.7.3/src/Category/Functor.agda000066400000000000000000000023651451211343400205030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Functor where open import Function hiding (Morphism) open import Level open import Relation.Binary.PropositionalEquality private variable ℓ ℓ′ ℓ″ : Level A B X Y : Set ℓ record RawFunctor (F : Set ℓ → Set ℓ′) : Set (suc ℓ ⊔ ℓ′) where infixl 4 _<$>_ _<$_ infixl 1 _<&>_ field _<$>_ : (A → B) → F A → F B _<$_ : A → F B → F A x <$ y = const x <$> y _<&>_ : F A → (A → B) → F B _<&>_ = flip _<$>_ -- A functor morphism from F₁ to F₂ is an operation op such that -- op (F₁ f x) ≡ F₂ f (op x) record Morphism {F₁ : Set ℓ → Set ℓ′} {F₂ : Set ℓ → Set ℓ″} (fun₁ : RawFunctor F₁) (fun₂ : RawFunctor F₂) : Set (suc ℓ ⊔ ℓ′ ⊔ ℓ″) where open RawFunctor field op : F₁ X → F₂ X op-<$> : (f : X → Y) (x : F₁ X) → op (fun₁ ._<$>_ f x) ≡ fun₂ ._<$>_ f (op x) agda-stdlib-1.7.3/src/Category/Functor/000077500000000000000000000000001451211343400176575ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Category/Functor/Predicate.agda000066400000000000000000000015461451211343400224030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Functors on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the functor laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Functor.Predicate where open import Function open import Level open import Relation.Unary open import Relation.Unary.PredicateTransformer using (PT) private variable i j ℓ₁ ℓ₂ : Level record RawPFunctor {I : Set i} {J : Set j} (F : PT I J ℓ₁ ℓ₂) : Set (i ⊔ j ⊔ suc ℓ₁ ⊔ suc ℓ₂) where infixl 4 _<$>_ _<$_ field _<$>_ : ∀ {P Q} → P ⊆ Q → F P ⊆ F Q _<$_ : ∀ {P Q} → (∀ {i} → P i) → F Q ⊆ F P x <$ y = const x <$> y agda-stdlib-1.7.3/src/Category/Monad.agda000066400000000000000000000022231451211343400201120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Monad where open import Function open import Category.Monad.Indexed open import Data.Unit open import Level private variable f : Level RawMonad : (Set f → Set f) → Set _ RawMonad M = RawIMonad {I = ⊤} (λ _ _ → M) RawMonadT : (T : (Set f → Set f) → (Set f → Set f)) → Set _ RawMonadT T = RawIMonadT {I = ⊤} (λ M _ _ → T (M _ _)) RawMonadZero : (Set f → Set f) → Set _ RawMonadZero M = RawIMonadZero {I = ⊤} (λ _ _ → M) RawMonadPlus : (Set f → Set f) → Set _ RawMonadPlus M = RawIMonadPlus {I = ⊤} (λ _ _ → M) module RawMonad {M : Set f → Set f} (Mon : RawMonad M) where open RawIMonad Mon public module RawMonadZero {M : Set f → Set f}(Mon : RawMonadZero M) where open RawIMonadZero Mon public module RawMonadPlus {M : Set f → Set f} (Mon : RawMonadPlus M) where open RawIMonadPlus Mon public agda-stdlib-1.7.3/src/Category/Monad/000077500000000000000000000000001451211343400172755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Category/Monad/Continuation.agda000066400000000000000000000041111451211343400225620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A delimited continuation monad ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Category.Monad.Continuation where open import Category.Applicative open import Category.Applicative.Indexed open import Category.Monad open import Function.Identity.Categorical as Id using (Identity) open import Category.Monad.Indexed open import Function open import Level private variable i f : Level I : Set i ------------------------------------------------------------------------ -- Delimited continuation monads DContT : (I → Set f) → (Set f → Set f) → IFun I f DContT K M r₂ r₁ a = (a → M (K r₁)) → M (K r₂) DCont : (I → Set f) → IFun I f DCont K = DContT K Identity DContTIMonad : ∀ (K : I → Set f) {M} → RawMonad M → RawIMonad (DContT K M) DContTIMonad K Mon = record { return = λ a k → k a ; _>>=_ = λ c f k → c (flip f k) } where open RawMonad Mon DContIMonad : (K : I → Set f) → RawIMonad (DCont K) DContIMonad K = DContTIMonad K Id.monad ------------------------------------------------------------------------ -- Delimited continuation operations record RawIMonadDCont {I : Set i} (K : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M reset : ∀ {r₁ r₂ r₃} → M r₁ r₂ (K r₂) → M r₃ r₃ (K r₁) shift : ∀ {a r₁ r₂ r₃ r₄} → ((a → M r₁ r₁ (K r₂)) → M r₃ r₄ (K r₄)) → M r₃ r₂ a open RawIMonad monad public DContTIMonadDCont : ∀ (K : I → Set f) {M} → RawMonad M → RawIMonadDCont K (DContT K M) DContTIMonadDCont K Mon = record { monad = DContTIMonad K Mon ; reset = λ e k → e return >>= k ; shift = λ e k → e (λ a k′ → (k a) >>= k′) return } where open RawIMonad Mon DContIMonadDCont : (K : I → Set f) → RawIMonadDCont K (DCont K) DContIMonadDCont K = DContTIMonadDCont K Id.monad agda-stdlib-1.7.3/src/Category/Monad/Indexed.agda000066400000000000000000000042731451211343400215010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed monads ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Monad.Indexed where open import Category.Applicative.Indexed open import Function open import Level private variable a b c i f : Level A : Set a B : Set b C : Set c I : Set i record RawIMonad {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where infixl 1 _>>=_ _>>_ _>=>_ infixr 1 _=<<_ _<=<_ field return : ∀ {i} → A → M i i A _>>=_ : ∀ {i j k} → M i j A → (A → M j k B) → M i k B _>>_ : ∀ {i j k} → M i j A → M j k B → M i k B m₁ >> m₂ = m₁ >>= λ _ → m₂ _=<<_ : ∀ {i j k} → (A → M j k B) → M i j A → M i k B f =<< c = c >>= f _>=>_ : ∀ {i j k} → (A → M i j B) → (B → M j k C) → (A → M i k C) f >=> g = _=<<_ g ∘ f _<=<_ : ∀ {i j k} → (B → M j k C) → (A → M i j B) → (A → M i k C) g <=< f = f >=> g join : ∀ {i j k} → M i j (M j k A) → M i k A join m = m >>= id rawIApplicative : RawIApplicative M rawIApplicative = record { pure = return ; _⊛_ = λ f x → f >>= λ f′ → x >>= λ x′ → return (f′ x′) } open RawIApplicative rawIApplicative public RawIMonadT : {I : Set i} (T : IFun I f → IFun I f) → Set (i ⊔ suc f) RawIMonadT T = ∀ {M} → RawIMonad M → RawIMonad (T M) record RawIMonadZero {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M applicativeZero : RawIApplicativeZero M open RawIMonad monad public open RawIApplicativeZero applicativeZero using (∅) public record RawIMonadPlus {I : Set i} (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M alternative : RawIAlternative M open RawIMonad monad public open RawIAlternative alternative using (∅; _∣_) public monadZero : RawIMonadZero M monadZero = record { monad = monad ; applicativeZero = RawIAlternative.applicativeZero alternative } agda-stdlib-1.7.3/src/Category/Monad/Partiality.agda000066400000000000000000001054561451211343400222500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The partiality monad ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe --guardedness #-} module Category.Monad.Partiality where open import Codata.Musical.Notation open import Category.Monad open import Data.Bool.Base using (Bool; false; true) open import Data.Nat using (ℕ; zero; suc; _+_) open import Data.Product as Prod hiding (map) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Function.Base open import Function.Equivalence using (_⇔_; equivalence) open import Level using (Level; _⊔_) open import Relation.Binary as B hiding (Rel; _⇔_) import Relation.Binary.Properties.Setoid as SetoidProperties open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary open import Relation.Nullary.Decidable hiding (map) open import Relation.Nullary.Negation private variable a b c f s ℓ : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- The partiality monad data _⊥ (A : Set a) : Set a where now : (x : A) → A ⊥ later : (x : ∞ (A ⊥)) → A ⊥ monad : RawMonad {f = f} _⊥ monad = record { return = now ; _>>=_ = _>>=_ } where _>>=_ : A ⊥ → (A → B ⊥) → B ⊥ now x >>= f = f x later x >>= f = later (♯ (♭ x >>= f)) private module M {f} = RawMonad (monad {f}) -- Non-termination. never : A ⊥ never = later (♯ never) -- run x for n steps peels off at most n "later" constructors from x. run_for_steps : A ⊥ → ℕ → A ⊥ run now x for n steps = now x run later x for zero steps = later x run later x for suc n steps = run ♭ x for n steps -- Is the computation done? isNow : A ⊥ → Bool isNow (now x) = true isNow (later x) = false ------------------------------------------------------------------------ -- Kinds -- The partiality monad comes with two forms of equality (weak and -- strong) and one ordering. Strong equality is stronger than the -- ordering, which is stronger than weak equality. -- The three relations are defined using a single data type, indexed -- by a "kind". data OtherKind : Set where geq weak : OtherKind data Kind : Set where strong : Kind other : (k : OtherKind) → Kind -- Kind equality is decidable. infix 4 _≟-Kind_ _≟-Kind_ : Decidable (_≡_ {A = Kind}) _≟-Kind_ strong strong = yes P.refl _≟-Kind_ strong (other k) = no λ() _≟-Kind_ (other k) strong = no λ() _≟-Kind_ (other geq) (other geq) = yes P.refl _≟-Kind_ (other geq) (other weak) = no λ() _≟-Kind_ (other weak) (other geq) = no λ() _≟-Kind_ (other weak) (other weak) = yes P.refl -- A predicate which is satisfied only for equalities. Note that, for -- concrete inputs, this predicate evaluates to ⊤ or ⊥. Equality : Kind → Set Equality k = False (k ≟-Kind other geq) ------------------------------------------------------------------------ -- Equality/ordering module Equality {A : Set a} -- The "return type". (_∼_ : A → A → Set ℓ) where -- The three relations. data Rel : Kind → A ⊥ → A ⊥ → Set (a ⊔ ℓ) where now : ∀ {k x y} (x∼y : x ∼ y) → Rel k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (Rel k (♭ x) (♭ y))) → Rel k (later x) (later y) laterʳ : ∀ {x y} (x≈y : Rel (other weak) x (♭ y) ) → Rel (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : Rel (other k) (♭ x) y ) → Rel (other k) (later x) y infix 4 _≅_ _≳_ _≲_ _≈_ _≅_ : A ⊥ → A ⊥ → Set _ _≅_ = Rel strong _≳_ : A ⊥ → A ⊥ → Set _ _≳_ = Rel (other geq) _≲_ : A ⊥ → A ⊥ → Set _ _≲_ = flip _≳_ _≈_ : A ⊥ → A ⊥ → Set _ _≈_ = Rel (other weak) -- x ⇓ y means that x terminates with y. infix 4 _⇓[_]_ _⇓_ _⇓[_]_ : A ⊥ → Kind → A → Set _ x ⇓[ k ] y = Rel k x (now y) _⇓_ : A ⊥ → A → Set _ x ⇓ y = x ⇓[ other weak ] y -- x ⇓ means that x terminates. infix 4 _⇓ _⇓ : A ⊥ → Set _ x ⇓ = ∃ λ v → x ⇓ v -- x ⇑ means that x does not terminate. infix 4 _⇑[_] _⇑ _⇑[_] : A ⊥ → Kind → Set _ x ⇑[ k ] = Rel k x never _⇑ : A ⊥ → Set _ x ⇑ = x ⇑[ other weak ] ------------------------------------------------------------------------ -- Lemmas relating the three relations module _ {A : Set a} {_∼_ : A → A → Set ℓ} where open Equality _∼_ using (Rel; _≅_; _≳_; _≲_; _≈_; _⇓[_]_; _⇑[_]) open Equality.Rel -- All relations include strong equality. ≅⇒ : ∀ {k} {x y : A ⊥} → x ≅ y → Rel k x y ≅⇒ (now x∼y) = now x∼y ≅⇒ (later x≅y) = later (♯ ≅⇒ (♭ x≅y)) -- The weak equality includes the ordering. ≳⇒ : ∀ {k} {x y : A ⊥} → x ≳ y → Rel (other k) x y ≳⇒ (now x∼y) = now x∼y ≳⇒ (later x≳y) = later (♯ ≳⇒ (♭ x≳y)) ≳⇒ (laterˡ x≳y) = laterˡ (≳⇒ x≳y ) -- Weak equality includes the other relations. ⇒≈ : ∀ {k} {x y : A ⊥} → Rel k x y → x ≈ y ⇒≈ {strong} = ≅⇒ ⇒≈ {other geq} = ≳⇒ ⇒≈ {other weak} = id -- The relations agree for non-terminating computations. never⇒never : ∀ {k₁ k₂} {x : A ⊥} → Rel k₁ x never → Rel k₂ x never never⇒never (later x∼never) = later (♯ never⇒never (♭ x∼never)) never⇒never (laterʳ x≈never) = never⇒never x≈never never⇒never (laterˡ x∼never) = later (♯ never⇒never x∼never) -- The "other" relations agree when the right-hand side is a value. now⇒now : ∀ {k₁ k₂} {x} {y : A} → Rel (other k₁) x (now y) → Rel (other k₂) x (now y) now⇒now (now x∼y) = now x∼y now⇒now (laterˡ x∼now) = laterˡ (now⇒now x∼now) ------------------------------------------------------------------------ -- Later can be dropped laterʳ⁻¹ : ∀ {k} {x : A ⊥} {y} → Rel (other k) x (later y) → Rel (other k) x (♭ y) laterʳ⁻¹ (later x∼y) = laterˡ (♭ x∼y) laterʳ⁻¹ (laterʳ x≈y) = x≈y laterʳ⁻¹ (laterˡ x∼ly) = laterˡ (laterʳ⁻¹ x∼ly) laterˡ⁻¹ : ∀ {x} {y : A ⊥} → later x ≈ y → ♭ x ≈ y laterˡ⁻¹ (later x≈y) = laterʳ (♭ x≈y) laterˡ⁻¹ (laterʳ lx≈y) = laterʳ (laterˡ⁻¹ lx≈y) laterˡ⁻¹ (laterˡ x≈y) = x≈y later⁻¹ : ∀ {k} {x y : ∞ (A ⊥)} → Rel k (later x) (later y) → Rel k (♭ x) (♭ y) later⁻¹ (later x∼y) = ♭ x∼y later⁻¹ (laterʳ lx≈y) = laterˡ⁻¹ lx≈y later⁻¹ (laterˡ x∼ly) = laterʳ⁻¹ x∼ly ------------------------------------------------------------------------ -- The relations are equivalences or partial orders, given suitable -- assumptions about the underlying relation module Equivalence where -- Reflexivity. refl : Reflexive _∼_ → ∀ {k} → Reflexive (Rel k) refl refl-∼ {x = now v} = now refl-∼ refl refl-∼ {x = later x} = later (♯ refl refl-∼) -- Symmetry. sym : Symmetric _∼_ → ∀ {k} → Equality k → Symmetric (Rel k) sym sym-∼ eq (now x∼y) = now (sym-∼ x∼y) sym sym-∼ eq (later x∼y) = later (♯ sym sym-∼ eq (♭ x∼y)) sym sym-∼ eq (laterʳ x≈y) = laterˡ (sym sym-∼ eq x≈y ) sym sym-∼ eq (laterˡ {weak} x≈y) = laterʳ (sym sym-∼ eq x≈y ) -- Transitivity. private module Trans (trans-∼ : Transitive _∼_) where now-trans : ∀ {k x y} {v : A} → Rel k x y → Rel k y (now v) → Rel k x (now v) now-trans (now x∼y) (now y∼z) = now (trans-∼ x∼y y∼z) now-trans (laterˡ x∼y) y∼z = laterˡ (now-trans x∼y y∼z) now-trans x∼ly (laterˡ y∼z) = now-trans (laterʳ⁻¹ x∼ly) y∼z mutual later-trans : ∀ {k} {x y : A ⊥} {z} → Rel k x y → Rel k y (later z) → Rel k x (later z) later-trans (later x∼y) ly∼lz = later (♯ trans (♭ x∼y) (later⁻¹ ly∼lz)) later-trans (laterˡ x∼y) y∼lz = later (♯ trans x∼y (laterʳ⁻¹ y∼lz)) later-trans (laterʳ x≈y) ly≈lz = later-trans x≈y (laterˡ⁻¹ ly≈lz) later-trans x≈y (laterʳ y≈z) = laterʳ ( trans x≈y y≈z ) trans : ∀ {k} {x y z : A ⊥} → Rel k x y → Rel k y z → Rel k x z trans {z = now v} x∼y y∼v = now-trans x∼y y∼v trans {z = later z} x∼y y∼lz = later-trans x∼y y∼lz open Trans public using (trans) -- All the relations are preorders. preorder : IsPreorder _≡_ _∼_ → Kind → Preorder _ _ _ preorder pre k = record { Carrier = A ⊥ ; _≈_ = _≡_ ; _∼_ = Rel k ; isPreorder = record { isEquivalence = P.isEquivalence ; reflexive = refl′ ; trans = Equivalence.trans (IsPreorder.trans pre) } } where refl′ : ∀ {k} {x y : A ⊥} → x ≡ y → Rel k x y refl′ P.refl = Equivalence.refl (IsPreorder.refl pre) private preorder′ : IsEquivalence _∼_ → Kind → Preorder _ _ _ preorder′ equiv = preorder (SetoidProperties.isPreorder (record { isEquivalence = equiv })) -- The two equalities are equivalence relations. setoid : IsEquivalence _∼_ → (k : Kind) {eq : Equality k} → Setoid _ _ setoid equiv k {eq} = record { Carrier = A ⊥ ; _≈_ = Rel k ; isEquivalence = record { refl = Pre.refl ; sym = Equivalence.sym (IsEquivalence.sym equiv) eq ; trans = Pre.trans } } where module Pre = Preorder (preorder′ equiv k) -- The order is a partial order, with strong equality as the -- underlying equality. ≳-poset : IsEquivalence _∼_ → Poset _ _ _ ≳-poset equiv = record { Carrier = A ⊥ ; _≈_ = _≅_ ; _≤_ = _≳_ ; isPartialOrder = record { antisym = antisym ; isPreorder = record { isEquivalence = S.isEquivalence ; reflexive = ≅⇒ ; trans = Pre.trans } } } where module S = Setoid (setoid equiv strong) module Pre = Preorder (preorder′ equiv (other geq)) antisym : {x y : A ⊥} → x ≳ y → x ≲ y → x ≅ y antisym (now x∼y) (now _) = now x∼y antisym (later x≳y) (later x≲y) = later (♯ antisym (♭ x≳y) (♭ x≲y)) antisym (later x≳y) (laterˡ x≲ly) = later (♯ antisym (♭ x≳y) (laterʳ⁻¹ x≲ly)) antisym (laterˡ x≳ly) (later x≲y) = later (♯ antisym (laterʳ⁻¹ x≳ly) (♭ x≲y)) antisym (laterˡ x≳ly) (laterˡ x≲ly) = later (♯ antisym (laterʳ⁻¹ x≳ly) (laterʳ⁻¹ x≲ly)) -- Equational reasoning. module Reasoning (isEquivalence : IsEquivalence _∼_) where private module Pre {k} = Preorder (preorder′ isEquivalence k) module S {k eq} = Setoid (setoid isEquivalence k {eq}) infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≈⟨_⟩_ _≡⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≡ y → Rel k y z → Rel k x z _ ≡⟨ P.refl ⟩ y∼z = y∼z _≅⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≅ y → Rel k y z → Rel k x z _ ≅⟨ x≅y ⟩ y∼z = Pre.trans (≅⇒ x≅y) y∼z _≳⟨_⟩_ : ∀ {k} x {y z : A ⊥} → x ≳ y → Rel (other k) y z → Rel (other k) x z _ ≳⟨ x≳y ⟩ y∼z = Pre.trans (≳⇒ x≳y) y∼z _≈⟨_⟩_ : ∀ x {y z : A ⊥} → x ≈ y → y ≈ z → x ≈ z _ ≈⟨ x≈y ⟩ y≈z = Pre.trans x≈y y≈z sym : ∀ {k} {eq : Equality k} {x y : A ⊥} → Rel k x y → Rel k y x sym {eq = eq} = S.sym {eq = eq} _∎ : ∀ {k} (x : A ⊥) → Rel k x x x ∎ = Pre.refl ------------------------------------------------------------------------ -- Lemmas related to now and never -- Now is not never. now≉never : ∀ {k} {x : A} → ¬ Rel k (now x) never now≉never (laterʳ hyp) = now≉never hyp -- A partial value is either now or never (classically, when the -- underlying relation is reflexive). now-or-never : Reflexive _∼_ → ∀ {k} (x : A ⊥) → ¬ ¬ ((∃ λ y → x ⇓[ other k ] y) ⊎ x ⇑[ other k ]) now-or-never refl x = helper <$> excluded-middle where open RawMonad ¬¬-Monad not-now-is-never : (x : A ⊥) → (∄ λ y → x ≳ now y) → x ≳ never not-now-is-never (now x) hyp with hyp (-, now refl) ... | () not-now-is-never (later x) hyp = later (♯ not-now-is-never (♭ x) (hyp ∘ Prod.map id laterˡ)) helper : Dec (∃ λ y → x ≳ now y) → _ helper (yes ≳now) = inj₁ $ Prod.map id ≳⇒ ≳now helper (no ≵now) = inj₂ $ ≳⇒ $ not-now-is-never x ≵now ------------------------------------------------------------------------ -- Map-like results -- Map. map : ∀ {_∼′_ : A → A → Set a} {k} → _∼′_ ⇒ _∼_ → Equality.Rel _∼′_ k ⇒ Equality.Rel _∼_ k map ∼′⇒∼ (now x∼y) = now (∼′⇒∼ x∼y) map ∼′⇒∼ (later x∼y) = later (♯ map ∼′⇒∼ (♭ x∼y)) map ∼′⇒∼ (laterʳ x≈y) = laterʳ (map ∼′⇒∼ x≈y) map ∼′⇒∼ (laterˡ x∼y) = laterˡ (map ∼′⇒∼ x∼y) -- If a statement can be proved using propositional equality as the -- underlying relation, then it can also be proved for any other -- reflexive underlying relation. ≡⇒ : Reflexive _∼_ → ∀ {k x y} → Equality.Rel _≡_ k x y → Rel k x y ≡⇒ refl-∼ = map (flip (P.subst (_∼_ _)) refl-∼) ------------------------------------------------------------------------ -- Steps -- The number of later constructors (steps) in the terminating -- computation x. steps : ∀ {k} {x : A ⊥} {y} → x ⇓[ k ] y → ℕ steps (now _) = zero steps .{x = later x} (laterˡ {x = x} x⇓) = suc (steps {x = ♭ x} x⇓) module Steps {trans-∼ : Transitive _∼_} where left-identity : ∀ {k x y} {z : A} (x≅y : x ≅ y) (y⇓z : y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ (≅⇒ x≅y) y⇓z) ≡ steps y⇓z left-identity (now _) (now _) = P.refl left-identity (later x≅y) (laterˡ y⇓z) = P.cong suc $ left-identity (♭ x≅y) y⇓z right-identity : ∀ {k x} {y z : A} (x⇓y : x ⇓[ k ] y) (y≈z : now y ⇓[ k ] z) → steps (Equivalence.trans trans-∼ x⇓y y≈z) ≡ steps x⇓y right-identity (now x∼y) (now y∼z) = P.refl right-identity (laterˡ x∼y) (now y∼z) = P.cong suc $ right-identity x∼y (now y∼z) ------------------------------------------------------------------------ -- Laws related to bind -- Never is a left and right "zero" of bind. left-zero : (f : B → A ⊥) → let open M in (never >>= f) ≅ never left-zero f = later (♯ left-zero f) right-zero : (x : B ⊥) → let open M in (x >>= λ _ → never) ≅ never right-zero (later x) = later (♯ right-zero (♭ x)) right-zero (now x) = never≅never where never≅never : never ≅ never never≅never = later (♯ never≅never) -- Now is a left and right identity of bind (for a reflexive -- underlying relation). left-identity : Reflexive _∼_ → (x : B) (f : B → A ⊥) → let open M in (now x >>= f) ≅ f x left-identity refl-∼ x f = Equivalence.refl refl-∼ right-identity : Reflexive _∼_ → (x : A ⊥) → let open M in (x >>= now) ≅ x right-identity refl (now x) = now refl right-identity refl (later x) = later (♯ right-identity refl (♭ x)) -- Bind is associative (for a reflexive underlying relation). associative : Reflexive _∼_ → (x : C ⊥) (f : C → B ⊥) (g : B → A ⊥) → let open M in (x >>= f >>= g) ≅ (x >>= λ y → f y >>= g) associative refl-∼ (now x) f g = Equivalence.refl refl-∼ associative refl-∼ (later x) f g = later (♯ associative refl-∼ (♭ x) f g) module _ {A B : Set s} {_∼A_ : A → A → Set ℓ} {_∼B_ : B → B → Set ℓ} where open Equality private open module EqA = Equality _∼A_ using () renaming (_⇓[_]_ to _⇓[_]A_; _⇑[_] to _⇑[_]A) open module EqB = Equality _∼B_ using () renaming (_⇓[_]_ to _⇓[_]B_; _⇑[_] to _⇑[_]B) -- Bind preserves all the relations. _>>=-cong_ : ∀ {k} {x₁ x₂ : A ⊥} {f₁ f₂ : A → B ⊥} → let open M in Rel _∼A_ k x₁ x₂ → (∀ {x₁ x₂} → x₁ ∼A x₂ → Rel _∼B_ k (f₁ x₁) (f₂ x₂)) → Rel _∼B_ k (x₁ >>= f₁) (x₂ >>= f₂) now x₁∼x₂ >>=-cong f₁∼f₂ = f₁∼f₂ x₁∼x₂ later x₁∼x₂ >>=-cong f₁∼f₂ = later (♯ (♭ x₁∼x₂ >>=-cong f₁∼f₂)) laterʳ x₁≈x₂ >>=-cong f₁≈f₂ = laterʳ (x₁≈x₂ >>=-cong f₁≈f₂) laterˡ x₁∼x₂ >>=-cong f₁∼f₂ = laterˡ (x₁∼x₂ >>=-cong f₁∼f₂) -- Inversion lemmas for bind. >>=-inversion-⇓ : Reflexive _∼A_ → ∀ {k} x {f : A → B ⊥} {y} → let open M in (x>>=f⇓ : (x >>= f) ⇓[ k ]B y) → ∃ λ z → ∃₂ λ (x⇓ : x ⇓[ k ]A z) (fz⇓ : f z ⇓[ k ]B y) → steps x⇓ + steps fz⇓ ≡ steps x>>=f⇓ >>=-inversion-⇓ refl (now x) fx⇓ = (x , now refl , fx⇓ , P.refl) >>=-inversion-⇓ refl (later x) (laterˡ x>>=f⇓) = Prod.map id (Prod.map laterˡ (Prod.map id (P.cong suc))) $ >>=-inversion-⇓ refl (♭ x) x>>=f⇓ >>=-inversion-⇑ : IsEquivalence _∼A_ → ∀ {k} x {f : A → B ⊥} → let open M in Rel _∼B_ (other k) (x >>= f) never → ¬ ¬ (x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B) >>=-inversion-⇑ eqA {k} x {f} ∼never = helper <$> now-or-never IsEqA.refl x where open RawMonad ¬¬-Monad using (_<$>_) open M using (_>>=_) open Reasoning eqA module IsEqA = IsEquivalence eqA k≳ = other geq is-never : ∀ {x y} → x ⇓[ k≳ ]A y → (x >>= f) ⇑[ k≳ ]B → ∃ λ z → (y ∼A z) × f z ⇑[ k≳ ]B is-never (now x∼y) = λ fx⇑ → (_ , IsEqA.sym x∼y , fx⇑) is-never (laterˡ ≳now) = is-never ≳now ∘ later⁻¹ helper : (∃ λ y → x ⇓[ k≳ ]A y) ⊎ x ⇑[ k≳ ]A → x ⇑[ other k ]A ⊎ ∃ λ y → x ⇓[ other k ]A y × f y ⇑[ other k ]B helper (inj₂ ≳never) = inj₁ (≳⇒ ≳never) helper (inj₁ (y , ≳now)) with is-never ≳now (never⇒never ∼never) ... | (z , y∼z , fz⇑) = inj₂ (z , ≳⇒ (x ≳⟨ ≳now ⟩ now y ≅⟨ now y∼z ⟩ now z ∎) , ≳⇒ fz⇑) module _ {A B : Set ℓ} {_∼_ : B → B → Set ℓ} where open Equality -- A variant of _>>=-cong_. _≡->>=-cong_ : ∀ {k} {x₁ x₂ : A ⊥} {f₁ f₂ : A → B ⊥} → let open M in Rel _≡_ k x₁ x₂ → (∀ x → Rel _∼_ k (f₁ x) (f₂ x)) → Rel _∼_ k (x₁ >>= f₁) (x₂ >>= f₂) _≡->>=-cong_ {k} {f₁ = f₁} {f₂} x₁≈x₂ f₁≈f₂ = x₁≈x₂ >>=-cong λ {x} x≡x′ → P.subst (λ y → Rel _∼_ k (f₁ x) (f₂ y)) x≡x′ (f₁≈f₂ x) ------------------------------------------------------------------------ -- Productivity checker workaround -- The monad can be awkward to use, due to the limitations of guarded -- coinduction. The following code provides a (limited) workaround. module Workaround {a} where infixl 1 _>>=_ data _⊥P : Set a → Set (Level.suc a) where now : (x : A) → A ⊥P later : (x : ∞ (A ⊥P)) → A ⊥P _>>=_ : (x : A ⊥P) (f : A → B ⊥P) → B ⊥P private data _⊥W : Set a → Set (Level.suc a) where now : (x : A) → A ⊥W later : (x : A ⊥P) → A ⊥W mutual _>>=W_ : A ⊥W → (A → B ⊥P) → B ⊥W now x >>=W f = whnf (f x) later x >>=W f = later (x >>= f) whnf : A ⊥P → A ⊥W whnf (now x) = now x whnf (later x) = later (♭ x) whnf (x >>= f) = whnf x >>=W f mutual private ⟦_⟧W : A ⊥W → A ⊥ ⟦ now x ⟧W = now x ⟦ later x ⟧W = later (♯ ⟦ x ⟧P) ⟦_⟧P : A ⊥P → A ⊥ ⟦ x ⟧P = ⟦ whnf x ⟧W -- The definitions above make sense. ⟦_⟧P is homomorphic with -- respect to now, later and _>>=_. module Correct where private open module Eq {A : Set a} = Equality {A = A} _≡_ open module R {A : Set a} = Reasoning (P.isEquivalence {A = A}) now-hom : (x : A) → ⟦ now x ⟧P ≅ now x now-hom x = now x ∎ later-hom : (x : ∞ (A ⊥P)) → ⟦ later x ⟧P ≅ later (♯ ⟦ ♭ x ⟧P) later-hom x = later (♯ (⟦ ♭ x ⟧P ∎)) mutual private >>=-homW : (x : B ⊥W) (f : B → A ⊥P) → ⟦ x >>=W f ⟧W ≅ M._>>=_ ⟦ x ⟧W (λ y → ⟦ f y ⟧P) >>=-homW (now x) f = ⟦ f x ⟧P ∎ >>=-homW (later x) f = later (♯ >>=-hom x f) >>=-hom : (x : B ⊥P) (f : B → A ⊥P) → ⟦ x >>= f ⟧P ≅ M._>>=_ ⟦ x ⟧P (λ y → ⟦ f y ⟧P) >>=-hom x f = >>=-homW (whnf x) f ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of equality/ordering module AlternativeEquality {a ℓ} where private El : Setoid a ℓ → Set _ El = Setoid.Carrier Eq : ∀ S → B.Rel (El S) _ Eq = Setoid._≈_ open Equality using (Rel) open Equality.Rel infix 4 _∣_≅P_ _∣_≳P_ _∣_≈P_ infix 3 _∎ infixr 2 _≡⟨_⟩_ _≅⟨_⟩_ _≳⟨_⟩_ _≳⟨_⟩≅_ _≳⟨_⟩≈_ _≈⟨_⟩≅_ _≈⟨_⟩≲_ infixl 1 _>>=_ mutual -- Proof "programs". _∣_≅P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≅P_ = flip RelP strong _∣_≳P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≳P_ = flip RelP (other geq) _∣_≈P_ : ∀ S → B.Rel (El S ⊥) _ _∣_≈P_ = flip RelP (other weak) data RelP S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ ℓ)) where -- Congruences. now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelP S k (now x) (now y) later : ∀ {k x y} (x∼y : ∞ (RelP S k (♭ x) (♭ y))) → RelP S k (later x) (later y) _>>=_ : ∀ {S′ : Setoid a ℓ} {k} {x₁ x₂} {f₁ f₂ : El S′ → El S ⊥} → let open M in (x₁∼x₂ : RelP S′ k x₁ x₂) (f₁∼f₂ : ∀ {x y} → x ⟨ Eq S′ ⟩ y → RelP S k (f₁ x) (f₂ y)) → RelP S k (x₁ >>= f₁) (x₂ >>= f₂) -- Ordering/weak equality. laterʳ : ∀ {x y} (x≈y : RelP S (other weak) x (♭ y)) → RelP S (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : RelP S (other k) (♭ x) y) → RelP S (other k) (later x) y -- Equational reasoning. Note that including full transitivity -- for weak equality would make _∣_≈P_ trivial; a similar -- problem applies to _∣_≳P_ (A ∣ never ≳P now x would be -- provable). Instead the definition of RelP includes limited -- notions of transitivity, similar to weak bisimulation up-to -- various things. _∎ : ∀ {k} x → RelP S k x x sym : ∀ {k x y} {eq : Equality k} (x∼y : RelP S k x y) → RelP S k y x _≡⟨_⟩_ : ∀ {k} x {y z} (x≡y : x ≡ y) (y∼z : RelP S k y z) → RelP S k x z _≅⟨_⟩_ : ∀ {k} x {y z} (x≅y : S ∣ x ≅P y) (y∼z : RelP S k y z) → RelP S k x z _≳⟨_⟩_ : let open Equality (Eq S) in ∀ x {y z} (x≳y : x ≳ y) (y≳z : S ∣ y ≳P z) → S ∣ x ≳P z _≳⟨_⟩≅_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≳P z _≳⟨_⟩≈_ : ∀ x {y z} (x≳y : S ∣ x ≳P y) (y≈z : S ∣ y ≈P z) → S ∣ x ≈P z _≈⟨_⟩≅_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≅z : S ∣ y ≅P z) → S ∣ x ≈P z _≈⟨_⟩≲_ : ∀ x {y z} (x≈y : S ∣ x ≈P y) (y≲z : S ∣ z ≳P y) → S ∣ x ≈P z -- If any of the following transitivity-like rules were added to -- RelP, then RelP and Rel would no longer be equivalent: -- -- x ≳P y → y ≳P z → x ≳P z -- x ≳P y → y ≳ z → x ≳P z -- x ≲P y → y ≈P z → x ≈P z -- x ≈P y → y ≳P z → x ≈P z -- x ≲ y → y ≈P z → x ≈P z -- x ≈P y → y ≳ z → x ≈P z -- x ≈P y → y ≈P z → x ≈P z -- x ≈P y → y ≈ z → x ≈P z -- x ≈ y → y ≈P z → x ≈P z -- -- The reason is that any of these rules would make it possible -- to derive that never and now x are related. -- RelP is complete with respect to Rel. complete : ∀ {S k} {x y : El S ⊥} → Equality.Rel (Eq S) k x y → RelP S k x y complete (now xRy) = now xRy complete (later x∼y) = later (♯ complete (♭ x∼y)) complete (laterʳ x≈y) = laterʳ (complete x≈y) complete (laterˡ x∼y) = laterˡ (complete x∼y) -- RelP is sound with respect to Rel. private -- Proof WHNFs. data RelW S : Kind → B.Rel (El S ⊥) (Level.suc (a ⊔ ℓ)) where now : ∀ {k x y} (xRy : x ⟨ Eq S ⟩ y) → RelW S k (now x) (now y) later : ∀ {k x y} (x∼y : RelP S k (♭ x) (♭ y)) → RelW S k (later x) (later y) laterʳ : ∀ {x y} (x≈y : RelW S (other weak) x (♭ y)) → RelW S (other weak) x (later y) laterˡ : ∀ {k x y} (x∼y : RelW S (other k) (♭ x) y) → RelW S (other k) (later x) y -- WHNFs can be turned into programs. program : ∀ {S k x y} → RelW S k x y → RelP S k x y program (now xRy) = now xRy program (later x∼y) = later (♯ x∼y) program (laterˡ x∼y) = laterˡ (program x∼y) program (laterʳ x≈y) = laterʳ (program x≈y) -- Lemmas for WHNFs. _>>=W_ : ∀ {A B k x₁ x₂} {f₁ f₂ : El A → El B ⊥} → RelW A k x₁ x₂ → (∀ {x y} → x ⟨ Eq A ⟩ y → RelW B k (f₁ x) (f₂ y)) → RelW B k (M._>>=_ x₁ f₁) (M._>>=_ x₂ f₂) now xRy >>=W f₁∼f₂ = f₁∼f₂ xRy later x∼y >>=W f₁∼f₂ = later (x∼y >>= program ∘ f₁∼f₂) laterʳ x≈y >>=W f₁≈f₂ = laterʳ (x≈y >>=W f₁≈f₂) laterˡ x∼y >>=W f₁∼f₂ = laterˡ (x∼y >>=W f₁∼f₂) reflW : ∀ {S k} x → RelW S k x x reflW {S} (now x) = now (Setoid.refl S) reflW (later x) = later (♭ x ∎) symW : ∀ {S k x y} → Equality k → RelW S k x y → RelW S k y x symW {S} eq (now xRy) = now (Setoid.sym S xRy) symW eq (later x≈y) = later (sym {eq = eq} x≈y) symW eq (laterʳ x≈y) = laterˡ (symW eq x≈y) symW eq (laterˡ {weak} x≈y) = laterʳ (symW eq x≈y) trans≅W : ∀ {S x y z} → RelW S strong x y → RelW S strong y z → RelW S strong x z trans≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅W (later x≅y) (later y≅z) = later (_ ≅⟨ x≅y ⟩ y≅z) trans≳-W : ∀ {S x y z} → let open Equality (Eq S) in x ≳ y → RelW S (other geq) y z → RelW S (other geq) x z trans≳-W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳-W (later x≳y) (later y≳z) = later (_ ≳⟨ ♭ x≳y ⟩ y≳z) trans≳-W (later x≳y) (laterˡ y≳z) = laterˡ (trans≳-W (♭ x≳y) y≳z) trans≳-W (laterˡ x≳y) y≳z = laterˡ (trans≳-W x≳y y≳z) -- Strong equality programs can be turned into WHNFs. whnf≅ : ∀ {S x y} → S ∣ x ≅P y → RelW S strong x y whnf≅ (now xRy) = now xRy whnf≅ (later x≅y) = later (♭ x≅y) whnf≅ (x₁≅x₂ >>= f₁≅f₂) = whnf≅ x₁≅x₂ >>=W λ xRy → whnf≅ (f₁≅f₂ xRy) whnf≅ (x ∎) = reflW x whnf≅ (sym x≅y) = symW _ (whnf≅ x≅y) whnf≅ (x ≡⟨ P.refl ⟩ y≅z) = whnf≅ y≅z whnf≅ (x ≅⟨ x≅y ⟩ y≅z) = trans≅W (whnf≅ x≅y) (whnf≅ y≅z) -- More transitivity lemmas. _⟨_⟩≅_ : ∀ {S k} x {y z} → RelP S k x y → S ∣ y ≅P z → RelP S k x z _⟨_⟩≅_ {k = strong} x x≅y y≅z = x ≅⟨ x≅y ⟩ y≅z _⟨_⟩≅_ {k = other geq} x x≳y y≅z = x ≳⟨ x≳y ⟩≅ y≅z _⟨_⟩≅_ {k = other weak} x x≈y y≅z = x ≈⟨ x≈y ⟩≅ y≅z trans∼≅W : ∀ {S k x y z} → RelW S k x y → RelW S strong y z → RelW S k x z trans∼≅W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans∼≅W (later x∼y) (later y≅z) = later (_ ⟨ x∼y ⟩≅ y≅z) trans∼≅W (laterʳ x≈y) (later y≅z) = laterʳ (trans∼≅W x≈y (whnf≅ y≅z)) trans∼≅W (laterˡ x∼y) y≅z = laterˡ (trans∼≅W x∼y y≅z) trans≅∼W : ∀ {S k x y z} → RelW S strong x y → RelW S k y z → RelW S k x z trans≅∼W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≅∼W (later x≅y) (later y∼z) = later (_ ≅⟨ x≅y ⟩ y∼z) trans≅∼W (later x≅y) (laterˡ y∼z) = laterˡ (trans≅∼W (whnf≅ x≅y) y∼z) trans≅∼W x≅y (laterʳ ly≈z) = laterʳ (trans≅∼W x≅y ly≈z) -- Order programs can be turned into WHNFs. whnf≳ : ∀ {S x y} → S ∣ x ≳P y → RelW S (other geq) x y whnf≳ (now xRy) = now xRy whnf≳ (later x∼y) = later (♭ x∼y) whnf≳ (laterˡ x≲y) = laterˡ (whnf≳ x≲y) whnf≳ (x₁∼x₂ >>= f₁∼f₂) = whnf≳ x₁∼x₂ >>=W λ xRy → whnf≳ (f₁∼f₂ xRy) whnf≳ (x ∎) = reflW x whnf≳ (x ≡⟨ P.refl ⟩ y≳z) = whnf≳ y≳z whnf≳ (x ≅⟨ x≅y ⟩ y≳z) = trans≅∼W (whnf≅ x≅y) (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf≳ y≳z) whnf≳ (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf≳ x≳y) (whnf≅ y≅z) -- Another transitivity lemma. trans≳≈W : ∀ {S x y z} → RelW S (other geq) x y → RelW S (other weak) y z → RelW S (other weak) x z trans≳≈W {S} (now xRy) (now yRz) = now (Setoid.trans S xRy yRz) trans≳≈W (later x≳y) (later y≈z) = later (_ ≳⟨ x≳y ⟩≈ y≈z) trans≳≈W (laterˡ x≳y) y≈z = laterˡ (trans≳≈W x≳y y≈z) trans≳≈W x≳y (laterʳ y≈z) = laterʳ (trans≳≈W x≳y y≈z) trans≳≈W (later x≳y) (laterˡ y≈z) = laterˡ (trans≳≈W (whnf≳ x≳y) y≈z) -- All programs can be turned into WHNFs. whnf : ∀ {S k x y} → RelP S k x y → RelW S k x y whnf (now xRy) = now xRy whnf (later x∼y) = later (♭ x∼y) whnf (laterʳ x≈y) = laterʳ (whnf x≈y) whnf (laterˡ x∼y) = laterˡ (whnf x∼y) whnf (x₁∼x₂ >>= f₁∼f₂) = whnf x₁∼x₂ >>=W λ xRy → whnf (f₁∼f₂ xRy) whnf (x ∎) = reflW x whnf (sym {eq = eq} x≈y) = symW eq (whnf x≈y) whnf (x ≡⟨ P.refl ⟩ y∼z) = whnf y∼z whnf (x ≅⟨ x≅y ⟩ y∼z) = trans≅∼W (whnf x≅y) (whnf y∼z) whnf (x ≳⟨ x≳y ⟩ y≳z) = trans≳-W x≳y (whnf y≳z) whnf (x ≳⟨ x≳y ⟩≅ y≅z) = trans∼≅W (whnf x≳y) (whnf y≅z) whnf (x ≳⟨ x≳y ⟩≈ y≈z) = trans≳≈W (whnf x≳y) (whnf y≈z) whnf (x ≈⟨ x≈y ⟩≅ y≅z) = trans∼≅W (whnf x≈y) (whnf y≅z) whnf (x ≈⟨ x≈y ⟩≲ y≲z) = symW _ (trans≳≈W (whnf y≲z) (symW _ (whnf x≈y))) mutual -- Soundness. private soundW : ∀ {S k x y} → RelW S k x y → Rel (Eq S) k x y soundW (now xRy) = now xRy soundW (later x∼y) = later (♯ sound x∼y) soundW (laterʳ x≈y) = laterʳ (soundW x≈y) soundW (laterˡ x∼y) = laterˡ (soundW x∼y) sound : ∀ {S k x y} → RelP S k x y → Rel (Eq S) k x y sound x∼y = soundW (whnf x∼y) -- RelP and Rel are equivalent (when the underlying relation is an -- equivalence). correct : ∀ {S k x y} → RelP S k x y ⇔ Rel (Eq S) k x y correct = equivalence sound complete ------------------------------------------------------------------------ -- Another lemma -- Bind is "idempotent". idempotent : (B : Setoid ℓ ℓ) → let open M; open Setoid B using (_≈_; Carrier); open Equality _≈_ in (x : A ⊥) (f : A → A → Carrier ⊥) → (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳ (x >>= λ y′ → f y′ y′) idempotent {A = A} B x f = sound (idem x) where open AlternativeEquality hiding (_>>=_) open M open Equality.Rel using (laterˡ) open Equivalence using (refl) idem : (x : A ⊥) → B ∣ (x >>= λ y′ → x >>= λ y″ → f y′ y″) ≳P (x >>= λ y′ → f y′ y′) idem (now x) = f x x ∎ idem (later x) = later (♯ ( (♭ x >>= λ y′ → later x >>= λ y″ → f y′ y″) ≳⟨ (refl P.refl {x = ♭ x} ≡->>=-cong λ _ → laterˡ (refl (Setoid.refl B))) ⟩ (♭ x >>= λ y′ → ♭ x >>= λ y″ → f y′ y″) ≳⟨ idem (♭ x) ⟩≅ (♭ x >>= λ y′ → f y′ y′) ∎)) ------------------------------------------------------------------------ -- Example private module Example where open Data.Nat open Workaround -- McCarthy's f91: f91′ : ℕ → ℕ ⊥P f91′ n with does (n ≤? 100) ... | true = later (♯ (f91′ (11 + n) >>= f91′)) ... | false = now (n ∸ 10) f91 : ℕ → ℕ ⊥ f91 n = ⟦ f91′ n ⟧P agda-stdlib-1.7.3/src/Category/Monad/Partiality/000077500000000000000000000000001451211343400214175ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Category/Monad/Partiality/All.agda000066400000000000000000000144431451211343400227530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An All predicate for the partiality monad ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe --guardedness #-} module Category.Monad.Partiality.All where open import Category.Monad open import Category.Monad.Partiality as Partiality using (_⊥; ⇒≈) open import Codata.Musical.Notation open import Function open import Level open import Relation.Binary using (_Respects_; IsEquivalence) open import Relation.Binary.PropositionalEquality as P using (_≡_) open Partiality._⊥ open Partiality.Equality using (Rel) open Partiality.Equality.Rel private open module E {a} {A : Set a} = Partiality.Equality (_≡_ {A = A}) using (_≅_; _≳_) open module M {f} = RawMonad (Partiality.monad {f = f}) using (_>>=_) private variable a b p ℓ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- All, along with some lemmas -- All P x means that if x terminates with the value v, then P v -- holds. data All {A : Set a} (P : A → Set p) : A ⊥ → Set (a ⊔ p) where now : ∀ {v} (p : P v) → All P (now v) later : ∀ {x} (p : ∞ (All P (♭ x))) → All P (later x) -- Bind preserves All in the following way: _>>=-cong_ : ∀ {p q} {P : A → Set p} {Q : B → Set q} {x : A ⊥} {f : A → B ⊥} → All P x → (∀ {x} → P x → All Q (f x)) → All Q (x >>= f) now p >>=-cong f = f p later p >>=-cong f = later (♯ (♭ p >>=-cong f)) -- All respects all the relations, given that the predicate respects -- the underlying relation. respects : ∀ {k} {P : A → Set p} {_∼_ : A → A → Set ℓ} → P Respects _∼_ → All P Respects Rel _∼_ k respects resp (now x∼y) (now p) = now (resp x∼y p) respects resp (later x∼y) (later p) = later (♯ respects resp (♭ x∼y) (♭ p)) respects resp (laterˡ x∼y) (later p) = respects resp x∼y (♭ p) respects resp (laterʳ x≈y) p = later (♯ respects resp x≈y p) respects-flip : ∀ {k} {P : A → Set p} {_∼_ : A → A → Set ℓ} → P Respects flip _∼_ → All P Respects flip (Rel _∼_ k) respects-flip resp (now x∼y) (now p) = now (resp x∼y p) respects-flip resp (later x∼y) (later p) = later (♯ respects-flip resp (♭ x∼y) (♭ p)) respects-flip resp (laterˡ x∼y) p = later (♯ respects-flip resp x∼y p) respects-flip resp (laterʳ x≈y) (later p) = respects-flip resp x≈y (♭ p) -- "Equational" reasoning. module Reasoning {P : A → Set p} {_∼_ : A → A → Set ℓ} (resp : P Respects flip _∼_) where infix 3 finally infixr 2 _≡⟨_⟩_ _∼⟨_⟩_ _≡⟨_⟩_ : ∀ x {y} → x ≡ y → All P y → All P x _ ≡⟨ P.refl ⟩ p = p _∼⟨_⟩_ : ∀ {k} x {y} → Rel _∼_ k x y → All P y → All P x _ ∼⟨ x∼y ⟩ p = respects-flip resp (⇒≈ x∼y) p -- A cosmetic combinator. finally : (x : A ⊥) → All P x → All P x finally _ p = p syntax finally x p = x ⟨ p ⟩ -- "Equational" reasoning with _∼_ instantiated to propositional -- equality. module Reasoning-≡ {a p} {A : Set a} {P : A → Set p} = Reasoning {P = P} {_∼_ = _≡_} (P.subst P ∘ P.sym) ------------------------------------------------------------------------ -- An alternative, but equivalent, formulation of All module Alternative {a p : Level} where infix 3 _⟨_⟩P infixr 2 _≅⟨_⟩P_ _≳⟨_⟩P_ -- All "programs". data AllP {A : Set a} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllP P (now x) later : ∀ {x} (p : ∞ (AllP P (♭ x))) → AllP P (later x) _>>=-congP_ : ∀ {B : Set a} {Q : B → Set p} {x f} (p-x : AllP Q x) (p-f : ∀ {v} → Q v → AllP P (f v)) → AllP P (x >>= f) _≅⟨_⟩P_ : ∀ x {y} (x≅y : x ≅ y) (p : AllP P y) → AllP P x _≳⟨_⟩P_ : ∀ x {y} (x≳y : x ≳ y) (p : AllP P y) → AllP P x _⟨_⟩P : ∀ x (p : AllP P x) → AllP P x private -- WHNFs. data AllW {A} (P : A → Set p) : A ⊥ → Set (suc (a ⊔ p)) where now : ∀ {x} (p : P x) → AllW P (now x) later : ∀ {x} (p : AllP P (♭ x)) → AllW P (later x) -- A function which turns WHNFs into programs. program : ∀ {P : A → Set p} {x} → AllW P x → AllP P x program (now p) = now p program (later p) = later (♯ p) -- Functions which turn programs into WHNFs. trans-≅ : {P : A → Set p} {x y : A ⊥} → x ≅ y → AllW P y → AllW P x trans-≅ (now P.refl) (now p) = now p trans-≅ (later x≅y) (later p) = later (_ ≅⟨ ♭ x≅y ⟩P p) trans-≳ : {P : A → Set p} {x y : A ⊥} → x ≳ y → AllW P y → AllW P x trans-≳ (now P.refl) (now p) = now p trans-≳ (later x≳y) (later p) = later (_ ≳⟨ ♭ x≳y ⟩P p) trans-≳ (laterˡ x≳y) p = later (_ ≳⟨ x≳y ⟩P program p) mutual _>>=-congW_ : ∀ {P : A → Set p} {Q : B → Set p} {x f} → AllW P x → (∀ {v} → P v → AllP Q (f v)) → AllW Q (x >>= f) now p >>=-congW p-f = whnf (p-f p) later p >>=-congW p-f = later (p >>=-congP p-f) whnf : ∀ {P : A → Set p} {x} → AllP P x → AllW P x whnf (now p) = now p whnf (later p) = later (♭ p) whnf (p-x >>=-congP p-f) = whnf p-x >>=-congW p-f whnf (_ ≅⟨ x≅y ⟩P p) = trans-≅ x≅y (whnf p) whnf (_ ≳⟨ x≳y ⟩P p) = trans-≳ x≳y (whnf p) whnf (_ ⟨ p ⟩P) = whnf p -- AllP P is sound and complete with respect to All P. sound : ∀ {P : A → Set p} {x} → AllP P x → All P x sound = λ p → soundW (whnf p) where soundW : ∀ {A} {P : A → Set p} {x} → AllW P x → All P x soundW (now p) = now p soundW (later p) = later (♯ sound p) complete : ∀ {P : A → Set p} {x} → All P x → AllP P x complete (now p) = now p complete (later p) = later (♯ complete (♭ p)) agda-stdlib-1.7.3/src/Category/Monad/Partiality/Instances.agda000066400000000000000000000006121451211343400241630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for _⊥ ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe --guardedness #-} module Category.Monad.Partiality.Instances where open import Category.Monad.Partiality instance partialityMonad = monad agda-stdlib-1.7.3/src/Category/Monad/Predicate.agda000066400000000000000000000036401451211343400220160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Monads on indexed sets (predicates) ------------------------------------------------------------------------ -- Note that currently the monad laws are not included here. {-# OPTIONS --cubical-compatible --safe #-} module Category.Monad.Predicate where open import Category.Applicative.Indexed open import Category.Monad open import Category.Monad.Indexed open import Data.Unit open import Data.Product open import Function open import Level open import Relation.Binary.PropositionalEquality open import Relation.Unary open import Relation.Unary.PredicateTransformer using (Pt) private variable i ℓ : Level ------------------------------------------------------------------------ record RawPMonad {I : Set i} (M : Pt I (i ⊔ ℓ)) : Set (suc i ⊔ suc ℓ) where infixl 1 _?>=_ _?>_ _>?>_ infixr 1 _==_ : ∀ {P Q} → M P ⊆ const (P ⊆ M Q) ⇒ M Q m ?>= f = f ==′_ : ∀ {P Q} → M P ⊆ const (∀ j → {_ : P j} → j ∈ M Q) ⇒ M Q m ?>=′ f = m ?>= λ {j} p → f j {p} _?>_ : ∀ {P Q} → M P ⊆ const (∀ {j} → j ∈ M Q) ⇒ M Q m₁ ?> m₂ = m₁ ?>= λ _ → m₂ join? : ∀ {P} → M (M P) ⊆ M P join? m = m ?>= id _>?>_ : {P Q R : _} → P ⊆ M Q → Q ⊆ M R → P ⊆ M R f >?> g = _=?> g -- ``Angelic'' operations (the player knows the state). rawIMonad : RawIMonad (λ i j A → i ∈ M (const A ∩ ｛ j ｝)) rawIMonad = record { return = λ x → return? (x , refl) ; _>>=_ = λ m k → m ?>= λ { {._} (x , refl) → k x } } open RawIMonad rawIMonad public agda-stdlib-1.7.3/src/Category/Monad/Reader.agda000066400000000000000000000103631451211343400213200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The reader monad ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Category.Monad.Reader {r} (R : Set r) (a : Level) where open import Function open import Function.Identity.Categorical as Id using (Identity) open import Category.Applicative.Indexed open import Category.Monad.Indexed open import Category.Monad open import Data.Unit private variable ℓ : Level A B I : Set ℓ ------------------------------------------------------------------------ -- Indexed reader IReaderT : IFun I (r ⊔ a) → IFun I (r ⊔ a) IReaderT M i j A = R → M i j A module _ {M : IFun I (r ⊔ a)} where ------------------------------------------------------------------------ -- Indexed reader applicative ReaderTIApplicative : RawIApplicative M → RawIApplicative (IReaderT M) ReaderTIApplicative App = record { pure = λ x r → pure x ; _⊛_ = λ m n r → m r ⊛ n r } where open RawIApplicative App ReaderTIApplicativeZero : RawIApplicativeZero M → RawIApplicativeZero (IReaderT M) ReaderTIApplicativeZero App = record { applicative = ReaderTIApplicative applicative ; ∅ = const ∅ } where open RawIApplicativeZero App ReaderTIAlternative : RawIAlternative M → RawIAlternative (IReaderT M) ReaderTIAlternative Alt = record { applicativeZero = ReaderTIApplicativeZero applicativeZero ; _∣_ = λ m n r → m r ∣ n r } where open RawIAlternative Alt ------------------------------------------------------------------------ -- Indexed reader monad ReaderTIMonad : RawIMonad M → RawIMonad (IReaderT M) ReaderTIMonad Mon = record { return = λ x r → return x ; _>>=_ = λ m f r → m r >>= flip f r } where open RawIMonad Mon ReaderTIMonadZero : RawIMonadZero M → RawIMonadZero (IReaderT M) ReaderTIMonadZero Mon = record { monad = ReaderTIMonad monad ; applicativeZero = ReaderTIApplicativeZero applicativeZero } where open RawIMonadZero Mon ReaderTIMonadPlus : RawIMonadPlus M → RawIMonadPlus (IReaderT M) ReaderTIMonadPlus Mon = record { monad = ReaderTIMonad monad ; alternative = ReaderTIAlternative alternative } where open RawIMonadPlus Mon ------------------------------------------------------------------------ -- Reader monad operations record RawIMonadReader {I : Set ℓ} (M : IFun I (r ⊔ a)) : Set (ℓ ⊔ suc (r ⊔ a)) where field monad : RawIMonad M reader : ∀ {i} → (R → A) → M i i A local : ∀ {i j} → (R → R) → M i j A → M i j A open RawIMonad monad public ask : ∀ {i} → M i i (Lift (r ⊔ a) R) ask = reader lift asks : ∀ {i} → (R → A) → M i i A asks = reader ReaderTIMonadReader : {I : Set ℓ} {M : IFun I (r ⊔ a)} → RawIMonad M → RawIMonadReader (IReaderT M) ReaderTIMonadReader Mon = record { monad = ReaderTIMonad Mon ; reader = λ f r → return (f r) ; local = λ f m → m ∘ f } where open RawIMonad Mon ------------------------------------------------------------------------ -- Ordinary reader monads RawMonadReader : (M : Set (r ⊔ a) → Set (r ⊔ a)) → Set (suc (r ⊔ a)) RawMonadReader M = RawIMonadReader {I = ⊤} (λ _ _ → M) module RawMonadReader {M} (Mon : RawMonadReader M) where open RawIMonadReader Mon public ReaderT : (M : Set (r ⊔ a) → Set (r ⊔ a)) → Set _ → Set _ ReaderT M = IReaderT {I = ⊤} (λ _ _ → M) _ _ ReaderTMonad : ∀ {M} → RawMonad M → RawMonad (ReaderT M) ReaderTMonad = ReaderTIMonad ReaderTMonadReader : ∀ {M} → RawMonad M → RawMonadReader (ReaderT M) ReaderTMonadReader = ReaderTIMonadReader ReaderTMonadZero : ∀ {M} → RawMonadZero M → RawMonadZero (ReaderT M) ReaderTMonadZero = ReaderTIMonadZero ReaderTMonadPlus : ∀ {M} → RawMonadPlus M → RawMonadPlus (ReaderT M) ReaderTMonadPlus = ReaderTIMonadPlus Reader : Set (r ⊔ a) → Set (r ⊔ a) Reader = ReaderT Identity ReaderMonad : RawMonad Reader ReaderMonad = ReaderTIMonad Id.monad ReaderMonadReader : RawMonadReader Reader ReaderMonadReader = ReaderTIMonadReader Id.monad agda-stdlib-1.7.3/src/Category/Monad/State.agda000066400000000000000000000120161451211343400211730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The state monad ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Category.Monad.State where open import Category.Applicative.Indexed open import Category.Monad open import Function.Identity.Categorical as Id using (Identity) open import Category.Monad.Indexed open import Data.Product open import Data.Unit open import Function open import Level private variable i f : Level I : Set i ------------------------------------------------------------------------ -- Indexed state IStateT : (I → Set f) → (Set f → Set f) → IFun I f IStateT S M i j A = S i → M (A × S j) ------------------------------------------------------------------------ -- Indexed state applicative StateTIApplicative : ∀ (S : I → Set f) {M} → RawMonad M → RawIApplicative (IStateT S M) StateTIApplicative S Mon = record { pure = λ a s → return (a , s) ; _⊛_ = λ f t s → do (f′ , s′) ← f s (t′ , s′′) ← t s′ return (f′ t′ , s′′) } where open RawMonad Mon StateTIApplicativeZero : ∀ (S : I → Set f) {M} → RawMonadZero M → RawIApplicativeZero (IStateT S M) StateTIApplicativeZero S Mon = record { applicative = StateTIApplicative S monad ; ∅ = const ∅ } where open RawMonadZero Mon StateTIAlternative : ∀ (S : I → Set f) {M} → RawMonadPlus M → RawIAlternative (IStateT S M) StateTIAlternative S Mon = record { applicativeZero = StateTIApplicativeZero S monadZero ; _∣_ = λ m n s → m s ∣ n s } where open RawMonadPlus Mon ------------------------------------------------------------------------ -- Indexed state monad StateTIMonad : ∀ (S : I → Set f) {M} → RawMonad M → RawIMonad (IStateT S M) StateTIMonad S Mon = record { return = λ x s → return (x , s) ; _>>=_ = λ m f s → m s >>= uncurry f } where open RawMonad Mon StateTIMonadZero : ∀ (S : I → Set f) {M} → RawMonadZero M → RawIMonadZero (IStateT S M) StateTIMonadZero S Mon = record { monad = StateTIMonad S (RawMonadZero.monad Mon) ; applicativeZero = StateTIApplicativeZero S Mon } where open RawMonadZero Mon StateTIMonadPlus : ∀ (S : I → Set f) {M} → RawMonadPlus M → RawIMonadPlus (IStateT S M) StateTIMonadPlus S Mon = record { monad = StateTIMonad S monad ; alternative = StateTIAlternative S Mon } where open RawMonadPlus Mon ------------------------------------------------------------------------ -- State monad operations record RawIMonadState {I : Set i} (S : I → Set f) (M : IFun I f) : Set (i ⊔ suc f) where field monad : RawIMonad M get : ∀ {i} → M i i (S i) put : ∀ {i j} → S j → M i j (Lift f ⊤) open RawIMonad monad public modify : ∀ {i j} → (S i → S j) → M i j (Lift f ⊤) modify f = get >>= put ∘ f StateTIMonadState : ∀ {i f} {I : Set i} (S : I → Set f) {M} → RawMonad M → RawIMonadState S (IStateT S M) StateTIMonadState S Mon = record { monad = StateTIMonad S Mon ; get = λ s → return (s , s) ; put = λ s _ → return (_ , s) } where open RawIMonad Mon ------------------------------------------------------------------------ -- Ordinary state monads RawMonadState : Set f → (Set f → Set f) → Set (suc f) RawMonadState S M = RawIMonadState {I = ⊤} (λ _ → S) (λ _ _ → M) module RawMonadState {S : Set f} {M : Set f → Set f} (Mon : RawMonadState S M) where open RawIMonadState Mon public StateT : Set f → (Set f → Set f) → Set f → Set f StateT S M = IStateT {I = ⊤} (λ _ → S) M _ _ StateTMonad : ∀ (S : Set f) {M} → RawMonad M → RawMonad (StateT S M) StateTMonad S = StateTIMonad (λ _ → S) StateTMonadZero : ∀ (S : Set f) {M} → RawMonadZero M → RawMonadZero (StateT S M) StateTMonadZero S = StateTIMonadZero (λ _ → S) StateTMonadPlus : ∀ (S : Set f) {M} → RawMonadPlus M → RawMonadPlus (StateT S M) StateTMonadPlus S = StateTIMonadPlus (λ _ → S) StateTMonadState : ∀ (S : Set f) {M} → RawMonad M → RawMonadState S (StateT S M) StateTMonadState S = StateTIMonadState (λ _ → S) State : Set f → Set f → Set f State S = StateT S Identity StateMonad : (S : Set f) → RawMonad (State S) StateMonad S = StateTMonad S Id.monad StateMonadState : (S : Set f) → RawMonadState S (State S) StateMonadState S = StateTMonadState S Id.monad LiftMonadState : ∀ {S₁} (S₂ : Set f) {M} → RawMonadState S₁ M → RawMonadState S₁ (StateT S₂ M) LiftMonadState S₂ Mon = record { monad = StateTIMonad (λ _ → S₂) monad ; get = λ s → get >>= λ x → return (x , s) ; put = λ s′ s → put s′ >> return (_ , s) } where open RawIMonadState Mon agda-stdlib-1.7.3/src/Codata/000077500000000000000000000000001451211343400156555ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Cofin.agda000066400000000000000000000035431451211343400175360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- "Finite" sets indexed on coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Cofin where open import Size open import Codata.Thunk open import Codata.Conat as Conat using (Conat; zero; suc; infinity; _ℕ<_; sℕ≤s; _ℕ≤infinity) open import Codata.Conat.Bisimilarity as Bisim using (_⊢_≲_ ; s≲s) open import Data.Nat.Base open import Data.Fin.Base as Fin hiding (fromℕ; fromℕ≤; fromℕ<; toℕ) open import Function open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- The type -- Note that `Cofin infnity` is /not/ finite. Note also that this is not a -- coinductive type, but it is indexed on a coinductive type. data Cofin : Conat ∞ → Set where zero : ∀ {n} → Cofin (suc n) suc : ∀ {n} → Cofin (n .force) → Cofin (suc n) suc-injective : ∀ {n} {p q : Cofin (n .force)} → (Cofin (suc n) ∋ suc p) ≡ suc q → p ≡ q suc-injective refl = refl ------------------------------------------------------------------------ -- Some operations fromℕ< : ∀ {n k} → k ℕ< n → Cofin n fromℕ< {zero} () fromℕ< {suc n} {zero} (sℕ≤s p) = zero fromℕ< {suc n} {suc k} (sℕ≤s p) = suc (fromℕ< p) fromℕ : ℕ → Cofin infinity fromℕ k = fromℕ< (suc k ℕ≤infinity) toℕ : ∀ {n} → Cofin n → ℕ toℕ zero = zero toℕ (suc i) = suc (toℕ i) fromFin : ∀ {n} → Fin n → Cofin (Conat.fromℕ n) fromFin zero = zero fromFin (suc i) = suc (fromFin i) toFin : ∀ n → Cofin (Conat.fromℕ n) → Fin n toFin zero () toFin (suc n) zero = zero toFin (suc n) (suc i) = suc (toFin n i) agda-stdlib-1.7.3/src/Codata/Cofin/000077500000000000000000000000001451211343400167135ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Cofin/Literals.agda000066400000000000000000000011701451211343400213070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Conat Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Cofin.Literals where open import Data.Nat.Base open import Agda.Builtin.FromNat open import Codata.Conat open import Codata.Conat.Properties open import Codata.Cofin open import Relation.Nullary.Decidable number : ∀ n → Number (Cofin n) number n = record { Constraint = λ k → True (suc k ℕ≤? n) ; fromNat = λ n {{p}} → fromℕ< (toWitness p) } agda-stdlib-1.7.3/src/Codata/Colist.agda000066400000000000000000000136721451211343400177410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Colist type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Colist where open import Level using (Level) open import Size open import Data.Unit.Base open import Data.Nat.Base open import Data.Product using (_×_ ; _,_) open import Data.These.Base using (These; this; that; these) open import Data.Maybe.Base using (Maybe; nothing; just) open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) open import Data.Vec.Base as Vec using (Vec; []; _∷_) open import Data.Vec.Bounded.Base as Vec≤ using (Vec≤) open import Function.Base using (_$′_; _∘′_; id; _∘_) open import Codata.Thunk using (Thunk; force) open import Codata.Conat as Conat using (Conat ; zero ; suc) open import Codata.Cowriter as CW using (Cowriter; _∷_) open import Codata.Delay as Delay using (Delay ; now ; later) open import Codata.Stream using (Stream ; _∷_) open import Relation.Binary.PropositionalEquality using (_≡_; refl) private variable a b c w : Level i : Size A : Set a B : Set b C : Set c W : Set w data Colist (A : Set a) (i : Size) : Set a where [] : Colist A i _∷_ : A → Thunk (Colist A) i → Colist A i ------------------------------------------------------------------------ -- Relationship to Cowriter. fromCowriter : Cowriter W A i → Colist W i fromCowriter CW.[ _ ] = [] fromCowriter (w ∷ ca) = w ∷ λ where .force → fromCowriter (ca .force) toCowriter : Colist A i → Cowriter A ⊤ i toCowriter [] = CW.[ _ ] toCowriter (a ∷ as) = a ∷ λ where .force → toCowriter (as .force) ------------------------------------------------------------------------ -- Basic functions. [_] : A → Colist A ∞ [ a ] = a ∷ λ where .force → [] length : Colist A i → Conat i length [] = zero length (x ∷ xs) = suc λ where .force → length (xs .force) replicate : Conat i → A → Colist A i replicate zero a = [] replicate (suc n) a = a ∷ λ where .force → replicate (n .force) a infixr 5 _++_ _⁺++_ _++_ : Colist A i → Colist A i → Colist A i [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs .force ++ ys lookup : ℕ → Colist A ∞ → Maybe A lookup n [] = nothing lookup zero (a ∷ as) = just a lookup (suc n) (a ∷ as) = lookup n (as .force) colookup : Conat i → Colist A i → Delay (Maybe A) i colookup n [] = now nothing colookup zero (a ∷ as) = now (just a) colookup (suc n) (a ∷ as) = later λ where .force → colookup (n .force) (as .force) take : (n : ℕ) → Colist A ∞ → Vec≤ A n take zero xs = Vec≤.[] take n [] = Vec≤.[] take (suc n) (x ∷ xs) = x Vec≤.∷ take n (xs .force) cotake : Conat i → Stream A i → Colist A i cotake zero xs = [] cotake (suc n) (x ∷ xs) = x ∷ λ where .force → cotake (n .force) (xs .force) drop : ℕ → Colist A ∞ → Colist A ∞ drop zero xs = xs drop (suc n) [] = [] drop (suc n) (x ∷ xs) = drop n (xs .force) fromList : List A → Colist A ∞ fromList [] = [] fromList (x ∷ xs) = x ∷ λ where .force → fromList xs fromList⁺ : List⁺ A → Colist A ∞ fromList⁺ = fromList ∘′ List⁺.toList _⁺++_ : List⁺ A → Thunk (Colist A) i → Colist A i (x ∷ xs) ⁺++ ys = x ∷ λ where .force → fromList xs ++ ys .force concat : Colist (List⁺ A) i → Colist A i concat [] = [] concat (as ∷ ass) = as ⁺++ λ where .force → concat (ass .force) fromStream : Stream A i → Colist A i fromStream = cotake Conat.infinity module ChunksOf (n : ℕ) where chunksOf : Colist A ∞ → Cowriter (Vec A n) (Vec≤ A n) i chunksOfAcc : ∀ m → -- We have two continuations but we are only ever going to use one. -- If we had linear types, we'd write the type using the & conjunction here. (k≤ : Vec≤ A m → Vec≤ A n) → (k≡ : Vec A m → Vec A n) → -- Finally we chop up the input stream. Colist A ∞ → Cowriter (Vec A n) (Vec≤ A n) i chunksOf = chunksOfAcc n id id chunksOfAcc zero k≤ k≡ as = k≡ [] ∷ λ where .force → chunksOf as chunksOfAcc (suc k) k≤ k≡ [] = CW.[ k≤ Vec≤.[] ] chunksOfAcc (suc k) k≤ k≡ (a ∷ as) = chunksOfAcc k (k≤ ∘ (a Vec≤.∷_)) (k≡ ∘ (a ∷_)) (as .force) open ChunksOf using (chunksOf) public -- Test to make sure that the values are kept in the same order _ : chunksOf 3 (fromList (1 ∷ 2 ∷ 3 ∷ 4 ∷ [])) ≡ (1 ∷ 2 ∷ 3 ∷ []) ∷ _ _ = refl map : (A → B) → Colist A i → Colist B i map f [] = [] map f (a ∷ as) = f a ∷ λ where .force → map f (as .force) unfold : (A → Maybe (A × B)) → A → Colist B i unfold next seed with next seed ... | nothing = [] ... | just (seed′ , b) = b ∷ λ where .force → unfold next seed′ scanl : (B → A → B) → B → Colist A i → Colist B i scanl c n [] = n ∷ λ where .force → [] scanl c n (a ∷ as) = n ∷ λ where .force → scanl c (c n a) (as .force) alignWith : (These A B → C) → Colist A i → Colist B i → Colist C i alignWith f [] bs = map (f ∘′ that) bs alignWith f as@(_ ∷ _) [] = map (f ∘′ this) as alignWith f (a ∷ as) (b ∷ bs) = f (these a b) ∷ λ where .force → alignWith f (as .force) (bs .force) zipWith : (A → B → C) → Colist A i → Colist B i → Colist C i zipWith f [] bs = [] zipWith f as [] = [] zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) align : Colist A i → Colist B i → Colist (These A B) i align = alignWith id zip : Colist A i → Colist B i → Colist (A × B) i zip = zipWith _,_ ap : Colist (A → B) i → Colist A i → Colist B i ap = zipWith _$′_ agda-stdlib-1.7.3/src/Codata/Colist/000077500000000000000000000000001451211343400171125ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Colist/Bisimilarity.agda000066400000000000000000000065631451211343400224030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Colists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Colist.Bisimilarity where open import Level using (Level; _⊔_) open import Size open import Codata.Thunk open import Codata.Colist open import Data.List.Base using (List; []; _∷_) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) private variable a b c p q r : Level A : Set a B : Set b C : Set c i : Size data Bisim {A : Set a} {B : Set b} (R : REL A B r) (i : Size) : REL (Colist A ∞) (Colist B ∞) (r ⊔ a ⊔ b) where [] : Bisim R i [] [] _∷_ : ∀ {x y xs ys} → R x y → Thunk^R (Bisim R) i xs ys → Bisim R i (x ∷ xs) (y ∷ ys) module _ {R : Rel A r} where reflexive : Reflexive R → Reflexive (Bisim R i) reflexive refl^R {[]} = [] reflexive refl^R {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {P : REL A B p} {Q : REL B A q} where symmetric : Sym P Q → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ [] = [] symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {P : REL A B p} {Q : REL B C q} {R : REL A C r} where transitive : Trans P Q R → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR [] [] = [] transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) ------------------------------------------------------------------------ -- Congruence rules module _ {R : REL A B r} where ++⁺ : ∀ {as bs xs ys} → Pointwise R as bs → Bisim R i xs ys → Bisim R i (fromList as ++ xs) (fromList bs ++ ys) ++⁺ [] rs = rs ++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw rs ⁺++⁺ : ∀ {as bs xs ys} → Pointwise R (List⁺.toList as) (List⁺.toList bs) → Thunk^R (Bisim R) i xs ys → Bisim R i (as ⁺++ xs) (bs ⁺++ ys) ⁺++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw (rs .force) ------------------------------------------------------------------------ -- Pointwise Equality as a Bisimilarity module _ {A : Set a} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Colist A ∞ → Colist A ∞ → Set a _⊢_≈_ = Bisim _≡_ refl : Reflexive (i ⊢_≈_) refl = reflexive Eq.refl fromEq : ∀ {as bs} → as ≡ bs → i ⊢ as ≈ bs fromEq Eq.refl = refl sym : Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : Transitive (i ⊢_≈_) trans = transitive Eq.trans isEquivalence : {R : Rel A r} → IsEquivalence R → IsEquivalence (Bisim R i) isEquivalence equiv^R = record { refl = reflexive equiv^R.refl ; sym = symmetric equiv^R.sym ; trans = transitive equiv^R.trans } where module equiv^R = IsEquivalence equiv^R setoid : Setoid a r → Size → Setoid a (a ⊔ r) setoid S i = record { isEquivalence = isEquivalence {i = i} (Setoid.isEquivalence S) } module ≈-Reasoning {a} {A : Set a} {i} where open import Relation.Binary.Reasoning.Setoid (setoid (Eq.setoid A) i) public agda-stdlib-1.7.3/src/Codata/Colist/Categorical.agda000066400000000000000000000012451451211343400221470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Colist ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Colist.Categorical where open import Codata.Conat using (infinity) open import Codata.Colist open import Category.Functor open import Category.Applicative functor : ∀ {ℓ i} → RawFunctor {ℓ} (λ A → Colist A i) functor = record { _<$>_ = map } applicative : ∀ {ℓ i} → RawApplicative {ℓ} (λ A → Colist A i) applicative = record { pure = replicate infinity ; _⊛_ = ap } agda-stdlib-1.7.3/src/Codata/Colist/Properties.agda000066400000000000000000000346641451211343400221010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Colist type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Colist.Properties where open import Level using (Level) open import Size open import Codata.Thunk as Thunk using (Thunk; force) open import Codata.Colist open import Codata.Colist.Bisimilarity open import Codata.Conat open import Codata.Conat.Bisimilarity as coℕᵇ using (zero; suc) import Codata.Conat.Properties as coℕₚ open import Codata.Cowriter as Cowriter using ([_]; _∷_) open import Codata.Cowriter.Bisimilarity as coWriterᵇ using ([_]; _∷_) open import Codata.Stream as Stream using (Stream; _∷_) open import Data.Vec.Bounded as Vec≤ using (Vec≤) open import Data.List.Base as List using (List; []; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) open import Data.List.Relation.Binary.Equality.Propositional using (≋-refl) open import Data.Maybe.Base as Maybe using (Maybe; nothing; just) import Data.Maybe.Properties as Maybeₚ open import Data.Maybe.Relation.Unary.All using (All; nothing; just) open import Data.Nat.Base as ℕ using (zero; suc; z≤n; s≤s) open import Data.Product as Prod using (_×_; _,_; uncurry) open import Data.These.Base as These using (These; this; that; these) open import Data.Vec.Base as Vec using (Vec; []; _∷_) open import Function.Base open import Relation.Binary.PropositionalEquality as Eq using (_≡_; [_]) private variable a b c d : Level A : Set a B : Set b C : Set c D : Set d i : Size ------------------------------------------------------------------------ -- Functor laws map-identity : ∀ (as : Colist A ∞) → i ⊢ map id as ≈ as map-identity [] = [] map-identity (a ∷ as) = Eq.refl ∷ λ where .force → map-identity (as .force) map-map-fusion : ∀ (f : A → B) (g : B → C) as {i} → i ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g [] = [] map-map-fusion f g (a ∷ as) = Eq.refl ∷ λ where .force → map-map-fusion f g (as .force) ------------------------------------------------------------------------ -- Relation to Cowriter fromCowriter∘toCowriter≗id : ∀ (as : Colist A ∞) → i ⊢ fromCowriter (toCowriter as) ≈ as fromCowriter∘toCowriter≗id [] = [] fromCowriter∘toCowriter≗id (a ∷ as) = Eq.refl ∷ λ where .force → fromCowriter∘toCowriter≗id (as .force) ------------------------------------------------------------------------ -- Properties of length length-∷ : ∀ (a : A) as → i coℕᵇ.⊢ length (a ∷ as) ≈ 1 ℕ+ length (as .force) length-∷ a as = suc (λ where .force → coℕᵇ.refl) length-replicate : ∀ n (a : A) → i coℕᵇ.⊢ length (replicate n a) ≈ n length-replicate zero a = zero length-replicate (suc n) a = suc λ where .force → length-replicate (n .force) a length-++ : (as bs : Colist A ∞) → i coℕᵇ.⊢ length (as ++ bs) ≈ length as + length bs length-++ [] bs = coℕᵇ.refl length-++ (a ∷ as) bs = suc λ where .force → length-++ (as .force) bs length-map : ∀ (f : A → B) as → i coℕᵇ.⊢ length (map f as) ≈ length as length-map f [] = zero length-map f (a ∷ as) = suc λ where .force → length-map f (as .force) ------------------------------------------------------------------------ -- Properties of replicate replicate-+ : ∀ m n (a : A) → i ⊢ replicate (m + n) a ≈ replicate m a ++ replicate n a replicate-+ zero n a = refl replicate-+ (suc m) n a = Eq.refl ∷ λ where .force → replicate-+ (m .force) n a map-replicate : ∀ (f : A → B) n a → i ⊢ map f (replicate n a) ≈ replicate n (f a) map-replicate f zero a = [] map-replicate f (suc n) a = Eq.refl ∷ λ where .force → map-replicate f (n .force) a lookup-replicate : ∀ k n (a : A) → All (a ≡_) (lookup k (replicate n a)) lookup-replicate k zero a = nothing lookup-replicate zero (suc n) a = just Eq.refl lookup-replicate (suc k) (suc n) a = lookup-replicate k (n .force) a ------------------------------------------------------------------------ -- Properties of unfold map-unfold : ∀ (f : B → C) (alg : A → Maybe (A × B)) a → i ⊢ map f (unfold alg a) ≈ unfold (Maybe.map (Prod.map₂ f) ∘ alg) a map-unfold f alg a with alg a ... | nothing = [] ... | just (a′ , b) = Eq.refl ∷ λ where .force → map-unfold f alg a′ module _ {alg : A → Maybe (A × B)} {a} where unfold-nothing : alg a ≡ nothing → unfold alg a ≡ [] unfold-nothing eq with alg a ... | nothing = Eq.refl unfold-just : ∀ {a′ b} → alg a ≡ just (a′ , b) → i ⊢ unfold alg a ≈ b ∷ λ where .force → unfold alg a′ unfold-just eq with alg a unfold-just Eq.refl | just (a′ , b) = Eq.refl ∷ λ where .force → refl ------------------------------------------------------------------------ -- Properties of scanl length-scanl : ∀ (c : B → A → B) n as → i coℕᵇ.⊢ length (scanl c n as) ≈ 1 ℕ+ length as length-scanl c n [] = suc λ where .force → zero length-scanl c n (a ∷ as) = suc λ { .force → begin length (scanl c (c n a) (as .force)) ≈⟨ length-scanl c (c n a) (as .force) ⟩ 1 ℕ+ length (as .force) ≈˘⟨ length-∷ a as ⟩ length (a ∷ as) ∎ } where open coℕᵇ.≈-Reasoning module _ (cons : C → B → C) (alg : A → Maybe (A × B)) where private alg′ : (A × C) → Maybe ((A × C) × C) alg′ (a , c) = Maybe.map (uncurry step) (alg a) where step = λ a′ b → let b′ = cons c b in (a′ , b′) , b′ scanl-unfold : ∀ nil a → i ⊢ scanl cons nil (unfold alg a) ≈ nil ∷ (λ where .force → unfold alg′ (a , nil)) scanl-unfold nil a with alg a | Eq.inspect alg a ... | nothing | [ eq ] = Eq.refl ∷ λ { .force → sym (fromEq (unfold-nothing (Maybeₚ.map-nothing eq))) } ... | just (a′ , b) | [ eq ] = Eq.refl ∷ λ { .force → begin scanl cons (cons nil b) (unfold alg a′) ≈⟨ scanl-unfold (cons nil b) a′ ⟩ (cons nil b ∷ _) ≈⟨ Eq.refl ∷ (λ where .force → refl) ⟩ (cons nil b ∷ _) ≈˘⟨ unfold-just (Maybeₚ.map-just eq) ⟩ unfold alg′ (a , nil) ∎ } where open ≈-Reasoning ------------------------------------------------------------------------ -- Properties of alignwith map-alignWith : ∀ (f : C → D) (al : These A B → C) as bs → i ⊢ map f (alignWith al as bs) ≈ alignWith (f ∘ al) as bs map-alignWith f al [] bs = map-map-fusion (al ∘′ that) f bs map-alignWith f al as@(_ ∷ _) [] = map-map-fusion (al ∘′ this) f as map-alignWith f al (a ∷ as) (b ∷ bs) = Eq.refl ∷ λ where .force → map-alignWith f al (as .force) (bs .force) length-alignWith : ∀ (al : These A B → C) as bs → i coℕᵇ.⊢ length (alignWith al as bs) ≈ length as ⊔ length bs length-alignWith al [] bs = length-map (al ∘ that) bs length-alignWith al as@(_ ∷ _) [] = length-map (al ∘ this) as length-alignWith al (a ∷ as) (b ∷ bs) = suc λ where .force → length-alignWith al (as .force) (bs .force) ------------------------------------------------------------------------ -- Properties of zipwith map-zipWith : ∀ (f : C → D) (zp : A → B → C) as bs → i ⊢ map f (zipWith zp as bs) ≈ zipWith (λ a → f ∘ zp a) as bs map-zipWith f zp [] _ = [] map-zipWith f zp (_ ∷ _) [] = [] map-zipWith f zp (a ∷ as) (b ∷ bs) = Eq.refl ∷ λ where .force → map-zipWith f zp (as .force) (bs .force) length-zipWith : ∀ (zp : A → B → C) as bs → i coℕᵇ.⊢ length (zipWith zp as bs) ≈ length as ⊓ length bs length-zipWith zp [] bs = zero length-zipWith zp as@(_ ∷ _) [] = zero length-zipWith zp (a ∷ as) (b ∷ bs) = suc λ where .force → length-zipWith zp (as .force) (bs .force) ------------------------------------------------------------------------ -- Properties of drop drop-nil : ∀ m → i ⊢ drop {A = A} m [] ≈ [] drop-nil zero = [] drop-nil (suc m) = [] drop-drop-fusion : ∀ m n (as : Colist A ∞) → i ⊢ drop n (drop m as) ≈ drop (m ℕ.+ n) as drop-drop-fusion zero n as = refl drop-drop-fusion (suc m) n [] = drop-nil n drop-drop-fusion (suc m) n (a ∷ as) = drop-drop-fusion m n (as .force) map-drop : ∀ (f : A → B) m as → i ⊢ map f (drop m as) ≈ drop m (map f as) map-drop f zero as = refl map-drop f (suc m) [] = [] map-drop f (suc m) (a ∷ as) = map-drop f m (as .force) length-drop : ∀ m (as : Colist A ∞) → i coℕᵇ.⊢ length (drop m as) ≈ length as ∸ m length-drop zero as = coℕᵇ.refl length-drop (suc m) [] = coℕᵇ.sym (coℕₚ.0∸m≈0 m) length-drop (suc m) (a ∷ as) = length-drop m (as .force) drop-fromList-++-identity : ∀ (as : List A) bs → drop (List.length as) (fromList as ++ bs) ≡ bs drop-fromList-++-identity [] bs = Eq.refl drop-fromList-++-identity (a ∷ as) bs = drop-fromList-++-identity as bs drop-fromList-++-≤ : ∀ (as : List A) bs {m} → m ℕ.≤ List.length as → drop m (fromList as ++ bs) ≡ fromList (List.drop m as) ++ bs drop-fromList-++-≤ [] bs z≤n = Eq.refl drop-fromList-++-≤ (a ∷ as) bs z≤n = Eq.refl drop-fromList-++-≤ (a ∷ as) bs (s≤s p) = drop-fromList-++-≤ as bs p drop-fromList-++-≥ : ∀ (as : List A) bs {m} → m ℕ.≥ List.length as → drop m (fromList as ++ bs) ≡ drop (m ℕ.∸ List.length as) bs drop-fromList-++-≥ [] bs z≤n = Eq.refl drop-fromList-++-≥ (a ∷ as) bs (s≤s p) = drop-fromList-++-≥ as bs p drop-⁺++-identity : ∀ (as : List⁺ A) bs → drop (List⁺.length as) (as ⁺++ bs) ≡ bs .force drop-⁺++-identity (a ∷ as) bs = drop-fromList-++-identity as (bs .force) ------------------------------------------------------------------------ -- Properties of cotake length-cotake : ∀ n (as : Stream A ∞) → i coℕᵇ.⊢ length (cotake n as) ≈ n length-cotake zero as = zero length-cotake (suc n) (a ∷ as) = suc λ where .force → length-cotake (n .force) (as .force) map-cotake : ∀ (f : A → B) n as → i ⊢ map f (cotake n as) ≈ cotake n (Stream.map f as) map-cotake f zero as = [] map-cotake f (suc n) (a ∷ as) = Eq.refl ∷ λ where .force → map-cotake f (n .force) (as .force) ------------------------------------------------------------------------ -- Properties of chunksOf module Map-ChunksOf (f : A → B) n where open ChunksOf n using (chunksOfAcc) map-chunksOf : ∀ as → i coWriterᵇ.⊢ Cowriter.map (Vec.map f) (Vec≤.map f) (chunksOf n as) ≈ chunksOf n (map f as) map-chunksOfAcc : ∀ m as {k≤ k≡ k≤′ k≡′} → (∀ vs → Vec≤.map f (k≤ vs) ≡ k≤′ (Vec≤.map f vs)) → (∀ vs → Vec.map f (k≡ vs) ≡ k≡′ (Vec.map f vs)) → i coWriterᵇ.⊢ Cowriter.map (Vec.map f) (Vec≤.map f) (chunksOfAcc m k≤ k≡ as) ≈ chunksOfAcc m k≤′ k≡′ (map f as) map-chunksOf as = map-chunksOfAcc n as (λ vs → Eq.refl) (λ vs → Eq.refl) map-chunksOfAcc zero as eq-≤ eq-≡ = eq-≡ [] ∷ λ where .force → map-chunksOf as map-chunksOfAcc (suc m) [] eq-≤ eq-≡ = coWriterᵇ.[ eq-≤ Vec≤.[] ] map-chunksOfAcc (suc m) (a ∷ as) eq-≤ eq-≡ = map-chunksOfAcc m (as .force) (eq-≤ ∘ (a Vec≤.∷_)) (eq-≡ ∘ (a Vec.∷_)) open Map-ChunksOf using (map-chunksOf) public ------------------------------------------------------------------------ -- Properties of fromList fromList-++ : (as bs : List A) → i ⊢ fromList (as List.++ bs) ≈ fromList as ++ fromList bs fromList-++ [] bs = refl fromList-++ (a ∷ as) bs = Eq.refl ∷ λ where .force → fromList-++ as bs fromList-scanl : ∀ (c : B → A → B) n as → i ⊢ fromList (List.scanl c n as) ≈ scanl c n (fromList as) fromList-scanl c n [] = Eq.refl ∷ λ where .force → refl fromList-scanl c n (a ∷ as) = Eq.refl ∷ λ where .force → fromList-scanl c (c n a) as map-fromList : ∀ (f : A → B) as → i ⊢ map f (fromList as) ≈ fromList (List.map f as) map-fromList f [] = [] map-fromList f (a ∷ as) = Eq.refl ∷ λ where .force → map-fromList f as length-fromList : (as : List A) → i coℕᵇ.⊢ length (fromList as) ≈ fromℕ (List.length as) length-fromList [] = zero length-fromList (a ∷ as) = suc (λ where .force → length-fromList as) ------------------------------------------------------------------------ -- Properties of fromStream fromStream-++ : ∀ (as : List A) bs → i ⊢ fromStream (as Stream.++ bs) ≈ fromList as ++ fromStream bs fromStream-++ [] bs = refl fromStream-++ (a ∷ as) bs = Eq.refl ∷ λ where .force → fromStream-++ as bs fromStream-⁺++ : ∀ (as : List⁺ A) bs → i ⊢ fromStream (as Stream.⁺++ bs) ≈ fromList⁺ as ++ fromStream (bs .force) fromStream-⁺++ (a ∷ as) bs = Eq.refl ∷ λ where .force → fromStream-++ as (bs .force) fromStream-concat : (ass : Stream (List⁺ A) ∞) → i ⊢ concat (fromStream ass) ≈ fromStream (Stream.concat ass) fromStream-concat (as@(a ∷ _) ∷ ass) = begin concat (fromStream (as ∷ ass)) ≈⟨ Eq.refl ∷ (λ { .force → ++⁺ ≋-refl (fromStream-concat (ass .force))}) ⟩ a ∷ _ ≈⟨ sym (fromStream-⁺++ as _) ⟩ fromStream (Stream.concat (as ∷ ass)) ∎ where open ≈-Reasoning fromStream-scanl : ∀ (c : B → A → B) n as → i ⊢ scanl c n (fromStream as) ≈ fromStream (Stream.scanl c n as) fromStream-scanl c n (a ∷ as) = Eq.refl ∷ λ where .force → fromStream-scanl c (c n a) (as .force) map-fromStream : ∀ (f : A → B) as → i ⊢ map f (fromStream as) ≈ fromStream (Stream.map f as) map-fromStream f (a ∷ as) = Eq.refl ∷ λ where .force → map-fromStream f (as .force) agda-stdlib-1.7.3/src/Codata/Conat.agda000066400000000000000000000053661451211343400175510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Conat type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Conat where open import Size open import Codata.Thunk open import Data.Nat.Base using (ℕ ; zero ; suc) open import Relation.Nullary ------------------------------------------------------------------------ -- Definition and first values data Conat (i : Size) : Set where zero : Conat i suc : Thunk Conat i → Conat i infinity : ∀ {i} → Conat i infinity = suc λ where .force → infinity fromℕ : ℕ → Conat ∞ fromℕ zero = zero fromℕ (suc n) = suc λ where .force → fromℕ n ------------------------------------------------------------------------ -- Arithmetic operations pred : ∀ {i} {j : Size< i} → Conat i → Conat j pred zero = zero pred (suc n) = n .force infixl 6 _∸_ _+_ infixl 7 _*_ _∸_ : Conat ∞ → ℕ → Conat ∞ m ∸ zero = m m ∸ suc n = pred m ∸ n _ℕ+_ : ℕ → ∀ {i} → Conat i → Conat i zero ℕ+ n = n suc m ℕ+ n = suc λ where .force → m ℕ+ n _+ℕ_ : ∀ {i} → Conat i → ℕ → Conat i zero +ℕ n = fromℕ n suc m +ℕ n = suc λ where .force → (m .force) +ℕ n _+_ : ∀ {i} → Conat i → Conat i → Conat i zero + n = n suc m + n = suc λ where .force → (m .force) + n _*_ : ∀ {i} → Conat i → Conat i → Conat i m * zero = zero zero * n = zero suc m * suc n = suc λ where .force → n .force + (m .force * suc n) -- Max and Min infixl 6 _⊔_ infixl 7 _⊓_ _⊔_ : ∀ {i} → Conat i → Conat i → Conat i zero ⊔ n = n m ⊔ zero = m suc m ⊔ suc n = suc λ where .force → m .force ⊔ n .force _⊓_ : ∀ {i} → Conat i → Conat i → Conat i zero ⊓ n = zero m ⊓ zero = zero suc m ⊓ suc n = suc λ where .force → m .force ⊓ n .force ------------------------------------------------------------------------ -- Finiteness data Finite : Conat ∞ → Set where zero : Finite zero suc : ∀ {n} → Finite (n .force) → Finite (suc n) toℕ : ∀ {n} → Finite n → ℕ toℕ zero = zero toℕ (suc n) = suc (toℕ n) ¬Finite∞ : ¬ (Finite infinity) ¬Finite∞ (suc p) = ¬Finite∞ p ------------------------------------------------------------------------ -- Order wrt to Nat data _ℕ≤_ : ℕ → Conat ∞ → Set where zℕ≤n : ∀ {n} → zero ℕ≤ n sℕ≤s : ∀ {k n} → k ℕ≤ n .force → suc k ℕ≤ suc n _ℕ<_ : ℕ → Conat ∞ → Set k ℕ< n = suc k ℕ≤ n _ℕ≤infinity : ∀ k → k ℕ≤ infinity zero ℕ≤infinity = zℕ≤n suc k ℕ≤infinity = sℕ≤s (k ℕ≤infinity) agda-stdlib-1.7.3/src/Codata/Conat/000077500000000000000000000000001451211343400167215ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Conat/Bisimilarity.agda000066400000000000000000000042531451211343400222040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Conats ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Conat.Bisimilarity where open import Level using (0ℓ) open import Size open import Codata.Thunk open import Codata.Conat open import Relation.Binary infix 1 _⊢_≈_ data _⊢_≈_ i : (m n : Conat ∞) → Set where zero : i ⊢ zero ≈ zero suc : ∀ {m n} → Thunk^R _⊢_≈_ i m n → i ⊢ suc m ≈ suc n refl : ∀ {i m} → i ⊢ m ≈ m refl {m = zero} = zero refl {m = suc m} = suc λ where .force → refl sym : ∀ {i m n} → i ⊢ m ≈ n → i ⊢ n ≈ m sym zero = zero sym (suc eq) = suc λ where .force → sym (eq .force) trans : ∀ {i m n p} → i ⊢ m ≈ n → i ⊢ n ≈ p → i ⊢ m ≈ p trans zero zero = zero trans (suc eq₁) (suc eq₂) = suc λ where .force → trans (eq₁ .force) (eq₂ .force) isEquivalence : ∀ {i} → IsEquivalence (i ⊢_≈_) isEquivalence = record { refl = refl ; sym = sym ; trans = trans } setoid : Size → Setoid 0ℓ 0ℓ setoid i = record { isEquivalence = isEquivalence {i = i} } module ≈-Reasoning {i} where open import Relation.Binary.Reasoning.Setoid (setoid i) public infix 1 _⊢_≲_ data _⊢_≲_ i : (m n : Conat ∞) → Set where z≲n : ∀ {n} → i ⊢ zero ≲ n s≲s : ∀ {m n} → Thunk^R _⊢_≲_ i m n → i ⊢ suc m ≲ suc n ≈⇒≲ : ∀ {i m n} → i ⊢ m ≈ n → i ⊢ m ≲ n ≈⇒≲ zero = z≲n ≈⇒≲ (suc eq) = s≲s λ where .force → ≈⇒≲ (eq .force) ≲-refl : ∀ {i m} → i ⊢ m ≲ m ≲-refl = ≈⇒≲ refl ≲-antisym : ∀ {i m n} → i ⊢ m ≲ n → i ⊢ n ≲ m → i ⊢ m ≈ n ≲-antisym z≲n z≲n = zero ≲-antisym (s≲s le) (s≲s ge) = suc λ where .force → ≲-antisym (le .force) (ge .force) ≲-trans : ∀ {i m n p} → i ⊢ m ≲ n → i ⊢ n ≲ p → i ⊢ m ≲ p ≲-trans z≲n _ = z≲n ≲-trans (s≲s le₁) (s≲s le₂) = s≲s λ where .force → ≲-trans (le₁ .force) (le₂ .force) agda-stdlib-1.7.3/src/Codata/Conat/Literals.agda000066400000000000000000000007521451211343400213220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Conat Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Conat.Literals where open import Agda.Builtin.FromNat open import Data.Unit open import Codata.Conat number : ∀ {i} → Number (Conat i) number = record { Constraint = λ _ → ⊤ ; fromNat = λ n → fromℕ n } agda-stdlib-1.7.3/src/Codata/Conat/Properties.agda000066400000000000000000000023051451211343400216730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties for Conats ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Conat.Properties where open import Size open import Data.Nat.Base using (ℕ; zero; suc) open import Codata.Thunk open import Codata.Conat open import Codata.Conat.Bisimilarity open import Function open import Relation.Nullary open import Relation.Nullary.Decidable using (map′) open import Relation.Binary private variable i : Size 0∸m≈0 : ∀ m → i ⊢ zero ∸ m ≈ zero 0∸m≈0 zero = refl 0∸m≈0 (suc m) = 0∸m≈0 m sℕ≤s⁻¹ : ∀ {m n} → suc m ℕ≤ suc n → m ℕ≤ n .force sℕ≤s⁻¹ (sℕ≤s p) = p _ℕ≤?_ : Decidable _ℕ≤_ zero ℕ≤? n = yes zℕ≤n suc m ℕ≤? zero = no (λ ()) suc m ℕ≤? suc n = map′ sℕ≤s sℕ≤s⁻¹ (m ℕ≤? n .force) 0ℕ+-identity : ∀ {n} → i ⊢ 0 ℕ+ n ≈ n 0ℕ+-identity = refl +ℕ0-identity : ∀ {n} → i ⊢ n +ℕ 0 ≈ n +ℕ0-identity {n = zero} = zero +ℕ0-identity {n = suc n} = suc λ where .force → +ℕ0-identity agda-stdlib-1.7.3/src/Codata/Covec.agda000066400000000000000000000062621451211343400175400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Covec type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Covec where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat as Conat open import Codata.Conat.Bisimilarity open import Codata.Conat.Properties open import Codata.Cofin as Cofin using (Cofin; zero; suc) open import Codata.Colist as Colist using (Colist ; [] ; _∷_) open import Codata.Stream as Stream using (Stream ; _∷_) open import Function data Covec {ℓ} (A : Set ℓ) (i : Size) : Conat ∞ → Set ℓ where [] : Covec A i zero _∷_ : ∀ {n} → A → Thunk (λ i → Covec A i (n .force)) i → Covec A i (suc n) module _ {ℓ} {A : Set ℓ} where head : ∀ {n i} → Covec A i (suc n) → A head (x ∷ _) = x tail : ∀ {n} → Covec A ∞ (suc n) → Covec A ∞ (n .force) tail (_ ∷ xs) = xs .force lookup : ∀ {n} → Cofin n → Covec A ∞ n → A lookup zero = head lookup (suc k) = lookup k ∘′ tail replicate : ∀ {i} → (n : Conat ∞) → A → Covec A i n replicate zero a = [] replicate (suc n) a = a ∷ λ where .force → replicate (n .force) a cotake : ∀ {i} → (n : Conat ∞) → Stream A i → Covec A i n cotake zero xs = [] cotake (suc n) (x ∷ xs) = x ∷ λ where .force → cotake (n .force) (xs .force) infixr 5 _++_ _++_ : ∀ {i m n} → Covec A i m → Covec A i n → Covec A i (m + n) [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs .force ++ ys fromColist : ∀ {i} → (xs : Colist A ∞) → Covec A i (Colist.length xs) fromColist [] = [] fromColist (x ∷ xs) = x ∷ λ where .force → fromColist (xs .force) toColist : ∀ {i n} → Covec A i n → Colist A i toColist [] = [] toColist (x ∷ xs) = x ∷ λ where .force → toColist (xs .force) fromStream : ∀ {i} → Stream A i → Covec A i infinity fromStream = cotake infinity cast : ∀ {i} {m n} → i ⊢ m ≈ n → Covec A i m → Covec A i n cast zero [] = [] cast (suc eq) (a ∷ as) = a ∷ λ where .force → cast (eq .force) (as .force) module _ {a b} {A : Set a} {B : Set b} where map : ∀ {i n} (f : A → B) → Covec A i n → Covec B i n map f [] = [] map f (a ∷ as) = f a ∷ λ where .force → map f (as .force) ap : ∀ {i n} → Covec (A → B) i n → Covec A i n → Covec B i n ap [] [] = [] ap (f ∷ fs) (a ∷ as) = (f a) ∷ λ where .force → ap (fs .force) (as .force) scanl : ∀ {i n} → (B → A → B) → B → Covec A i n → Covec B i (1 ℕ+ n) scanl c n [] = n ∷ λ where .force → [] scanl c n (a ∷ as) = n ∷ λ where .force → cast (suc λ where .force → 0ℕ+-identity) (scanl c (c n a) (as .force)) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where zipWith : ∀ {i n} → (A → B → C) → Covec A i n → Covec B i n → Covec C i n zipWith f [] [] = [] zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) agda-stdlib-1.7.3/src/Codata/Covec/000077500000000000000000000000001451211343400167145ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Covec/Bisimilarity.agda000066400000000000000000000045451451211343400222030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Covecs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Covec.Bisimilarity where open import Level using (_⊔_) open import Size open import Codata.Thunk open import Codata.Conat hiding (_⊔_) open import Codata.Covec open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : A → B → Set r) (i : Size) : ∀ m n (xs : Covec A ∞ m) (ys : Covec B ∞ n) → Set (r ⊔ a ⊔ b) where [] : Bisim R i zero zero [] [] _∷_ : ∀ {x y m n xs ys} → R x y → Thunk^R (λ i → Bisim R i (m .force) (n .force)) i xs ys → Bisim R i (suc m) (suc n) (x ∷ xs) (y ∷ ys) module _ {a r} {A : Set a} {R : A → A → Set r} where reflexive : Reflexive R → ∀ {i m} → Reflexive (Bisim R i m m) reflexive refl^R {i} {m} {[]} = [] reflexive refl^R {i} {m} {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i m n} → Sym (Bisim P i m n) (Bisim Q i n m) symmetric sym^PQ [] = [] symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i m n p} → Trans (Bisim P i m n) (Bisim Q i n p) (Bisim R i m p) transitive trans^PQR [] [] = [] transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _,_⊢_≈_ _,_⊢_≈_ : ∀ i m → Covec A ∞ m → Covec A ∞ m → Set ℓ _,_⊢_≈_ i m = Bisim _≡_ i m m refl : ∀ {i m} → Reflexive (i , m ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i m} → Symmetric (i , m ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i m} → Transitive (i , m ⊢_≈_) trans = transitive Eq.trans agda-stdlib-1.7.3/src/Codata/Covec/Categorical.agda000066400000000000000000000012211451211343400217430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Covec ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Covec.Categorical where open import Codata.Conat open import Codata.Covec open import Category.Functor open import Category.Applicative functor : ∀ {ℓ i n} → RawFunctor {ℓ} (λ A → Covec A n i) functor = record { _<$>_ = map } applicative : ∀ {ℓ i n} → RawApplicative {ℓ} (λ A → Covec A n i) applicative = record { pure = replicate _ ; _⊛_ = ap } agda-stdlib-1.7.3/src/Codata/Covec/Instances.agda000066400000000000000000000006261451211343400214650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for Covec ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Covec.Instances where open import Codata.Covec.Categorical instance covecFunctor = functor covecApplicative = applicative agda-stdlib-1.7.3/src/Codata/Covec/Properties.agda000066400000000000000000000021011451211343400216600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Covec type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Covec.Properties where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Covec open import Codata.Covec.Bisimilarity open import Function open import Relation.Binary.PropositionalEquality as Eq -- Functor laws module _ {a} {A : Set a} where map-identity : ∀ {m} (as : Covec A ∞ m) {i} → i , m ⊢ map id as ≈ as map-identity [] = [] map-identity (a ∷ as) = Eq.refl ∷ λ where .force → map-identity (as .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where map-map-fusion : ∀ (f : A → B) (g : B → C) {m} as {i} → i , m ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g [] = [] map-map-fusion f g (a ∷ as) = Eq.refl ∷ λ where .force → map-map-fusion f g (as .force) agda-stdlib-1.7.3/src/Codata/Cowriter.agda000066400000000000000000000124371451211343400203000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Cowriter type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} -- Disabled to prevent warnings from BoundedVec {-# OPTIONS --warn=noUserWarning #-} module Codata.Cowriter where open import Size open import Level as L using (Level) open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Delay using (Delay; later; now) open import Codata.Stream as Stream using (Stream; _∷_) open import Data.Unit.Base open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Nat.Base as Nat using (ℕ; zero; suc) open import Data.Product as Prod using (_×_; _,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Data.Vec.Base using (Vec; []; _∷_) open import Data.Vec.Bounded.Base as Vec≤ using (Vec≤; _,_) open import Function.Base using (_$_; _∘′_; id) private variable a b w x : Level A : Set a B : Set b W : Set w X : Set x ------------------------------------------------------------------------ -- Definition data Cowriter (W : Set w) (A : Set a) (i : Size) : Set (a L.⊔ w) where [_] : A → Cowriter W A i _∷_ : W → Thunk (Cowriter W A) i → Cowriter W A i ------------------------------------------------------------------------ -- Relationship to Delay. fromDelay : ∀ {i} → Delay A i → Cowriter ⊤ A i fromDelay (now a) = [ a ] fromDelay (later da) = _ ∷ λ where .force → fromDelay (da .force) toDelay : ∀ {i} → Cowriter W A i → Delay A i toDelay [ a ] = now a toDelay (_ ∷ ca) = later λ where .force → toDelay (ca .force) ------------------------------------------------------------------------ -- Basic functions. fromStream : ∀ {i} → Stream W i → Cowriter W A i fromStream (w ∷ ws) = w ∷ λ where .force → fromStream (ws .force) repeat : W → Cowriter W A ∞ repeat = fromStream ∘′ Stream.repeat length : ∀ {i} → Cowriter W A i → Conat i length [ _ ] = zero length (w ∷ cw) = suc λ where .force → length (cw .force) splitAt : ∀ (n : ℕ) → Cowriter W A ∞ → (Vec W n × Cowriter W A ∞) ⊎ (Vec≤ W n × A) splitAt zero cw = inj₁ ([] , cw) splitAt (suc n) [ a ] = inj₂ (Vec≤.[] , a) splitAt (suc n) (w ∷ cw) = Sum.map (Prod.map₁ (w ∷_)) (Prod.map₁ (w Vec≤.∷_)) $ splitAt n (cw .force) take : ∀ (n : ℕ) → Cowriter W A ∞ → Vec W n ⊎ (Vec≤ W n × A) take n = Sum.map₁ Prod.proj₁ ∘′ splitAt n infixr 5 _++_ _⁺++_ _++_ : ∀ {i} → List W → Cowriter W A i → Cowriter W A i [] ++ ca = ca (w ∷ ws) ++ ca = w ∷ λ where .force → ws ++ ca _⁺++_ : ∀ {i} → List⁺ W → Thunk (Cowriter W A) i → Cowriter W A i (w ∷ ws) ⁺++ ca = w ∷ λ where .force → ws ++ ca .force concat : ∀ {i} → Cowriter (List⁺ W) A i → Cowriter W A i concat [ a ] = [ a ] concat (w ∷ ca) = w ⁺++ λ where .force → concat (ca .force) ------------------------------------------------------------------------ -- Functor, Applicative and Monad map : ∀ {i} → (W → X) → (A → B) → Cowriter W A i → Cowriter X B i map f g [ a ] = [ g a ] map f g (w ∷ cw) = f w ∷ λ where .force → map f g (cw .force) map₁ : ∀ {i} → (W → X) → Cowriter W A i → Cowriter X A i map₁ f = map f id map₂ : ∀ {i} → (A → X) → Cowriter W A i → Cowriter W X i map₂ = map id ap : ∀ {i} → Cowriter W (A → X) i → Cowriter W A i → Cowriter W X i ap [ f ] ca = map₂ f ca ap (w ∷ cf) ca = w ∷ λ where .force → ap (cf .force) ca _>>=_ : ∀ {i} → Cowriter W A i → (A → Cowriter W X i) → Cowriter W X i [ a ] >>= f = f a (w ∷ ca) >>= f = w ∷ λ where .force → ca .force >>= f ------------------------------------------------------------------------ -- Construction. unfold : ∀ {i} → (X → (W × X) ⊎ A) → X → Cowriter W A i unfold next seed with next seed ... | inj₁ (w , seed′) = w ∷ λ where .force → unfold next seed′ ... | inj₂ a = [ a ] ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.3 open import Data.BoundedVec as BVec using (BoundedVec) splitAt′ : ∀ (n : ℕ) → Cowriter W A ∞ → (Vec W n × Cowriter W A ∞) ⊎ (BoundedVec W n × A) splitAt′ zero cw = inj₁ ([] , cw) splitAt′ (suc n) [ a ] = inj₂ (BVec.[] , a) splitAt′ (suc n) (w ∷ cw) = Sum.map (Prod.map₁ (w ∷_)) (Prod.map₁ (w BVec.∷_)) $ splitAt′ n (cw .force) {-# WARNING_ON_USAGE splitAt′ "Warning: splitAt′ (and Data.BoundedVec) was deprecated in v1.3. Please use splitAt (and Data.Vec.Bounded) instead." #-} take′ : ∀ (n : ℕ) → Cowriter W A ∞ → Vec W n ⊎ (BoundedVec W n × A) take′ n = Sum.map₁ Prod.proj₁ ∘′ splitAt′ n {-# WARNING_ON_USAGE take′ "Warning: take′ (and Data.BoundedVec) was deprecated in v1.3. Please use take (and Data.Vec.Bounded) instead." #-} agda-stdlib-1.7.3/src/Codata/Cowriter/000077500000000000000000000000001451211343400174535ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Cowriter/Bisimilarity.agda000066400000000000000000000065101451211343400227340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Cowriter ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Cowriter.Bisimilarity where open import Level using (Level; _⊔_) open import Size open import Codata.Thunk open import Codata.Cowriter open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) private variable a b c p q pq r s rs v w x : Level A : Set a B : Set b C : Set c V : Set v W : Set w X : Set x i : Size data Bisim {V : Set v} {W : Set w} {A : Set a} {B : Set b} (R : REL V W r) (S : REL A B s) (i : Size) : REL (Cowriter V A ∞) (Cowriter W B ∞) (r ⊔ s ⊔ v ⊔ w ⊔ a ⊔ b) where [_] : ∀ {a b} → S a b → Bisim R S i [ a ] [ b ] _∷_ : ∀ {x y xs ys} → R x y → Thunk^R (Bisim R S) i xs ys → Bisim R S i (x ∷ xs) (y ∷ ys) module _ {R : Rel W r} {S : Rel A s} (refl^R : Reflexive R) (refl^S : Reflexive S) where reflexive : Reflexive (Bisim R S i) reflexive {x = [ a ]} = [ refl^S ] reflexive {x = w ∷ ws} = refl^R ∷ λ where .force → reflexive module _ {R : REL V W r} {S : REL W V s} {P : REL A B p} {Q : REL B A q} (sym^RS : Sym R S) (sym^PQ : Sym P Q) where symmetric : Sym (Bisim R P i) (Bisim S Q i) symmetric [ a ] = [ sym^PQ a ] symmetric (p ∷ ps) = sym^RS p ∷ λ where .force → symmetric (ps .force) module _ {R : REL V W r} {S : REL W X s} {RS : REL V X rs} {P : REL A B p} {Q : REL B C q} {PQ : REL A C pq} (trans^RS : Trans R S RS) (trans^PQ : Trans P Q PQ) where transitive : Trans (Bisim R P i) (Bisim S Q i) (Bisim RS PQ i) transitive [ p ] [ q ] = [ trans^PQ p q ] transitive (p ∷ ps) (q ∷ qs) = trans^RS p q ∷ λ where .force → transitive (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {W : Set w} {A : Set a} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Cowriter W A ∞ → Cowriter W A ∞ → Set (a ⊔ w) _⊢_≈_ = Bisim _≡_ _≡_ refl : Reflexive (i ⊢_≈_) refl = reflexive Eq.refl Eq.refl fromEq : ∀ {as bs} → as ≡ bs → i ⊢ as ≈ bs fromEq Eq.refl = refl sym : Symmetric (i ⊢_≈_) sym = symmetric Eq.sym Eq.sym trans : Transitive (i ⊢_≈_) trans = transitive Eq.trans Eq.trans module _ {R : Rel W r} {S : Rel A s} (equiv^R : IsEquivalence R) (equiv^S : IsEquivalence S) where private module equiv^R = IsEquivalence equiv^R module equiv^S = IsEquivalence equiv^S isEquivalence : IsEquivalence (Bisim R S i) isEquivalence = record { refl = reflexive equiv^R.refl equiv^S.refl ; sym = symmetric equiv^R.sym equiv^S.sym ; trans = transitive equiv^R.trans equiv^S.trans } setoid : Setoid w r → Setoid a s → Size → Setoid (w ⊔ a) (w ⊔ a ⊔ r ⊔ s) setoid R S i = record { isEquivalence = isEquivalence (Setoid.isEquivalence R) (Setoid.isEquivalence S) {i = i} } module ≈-Reasoning {W : Set w} {A : Set a} {i} where open import Relation.Binary.Reasoning.Setoid (setoid (Eq.setoid W) (Eq.setoid A) i) public agda-stdlib-1.7.3/src/Codata/Delay.agda000066400000000000000000000074351451211343400175420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Delay type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Delay where open import Size open import Codata.Thunk using (Thunk; force) open import Codata.Conat using (Conat; zero; suc; Finite) open import Data.Empty open import Relation.Nullary open import Data.Nat.Base open import Data.Maybe.Base hiding (map ; fromMaybe ; zipWith ; alignWith ; zip ; align) open import Data.Product as P hiding (map ; zip) open import Data.Sum.Base as S hiding (map) open import Data.These.Base as T using (These; this; that; these) open import Function.Base using (id) ------------------------------------------------------------------------ -- Definition data Delay {ℓ} (A : Set ℓ) (i : Size) : Set ℓ where now : A → Delay A i later : Thunk (Delay A) i → Delay A i module _ {ℓ} {A : Set ℓ} where length : ∀ {i} → Delay A i → Conat i length (now _) = zero length (later d) = suc λ where .force → length (d .force) never : ∀ {i} → Delay A i never = later λ where .force → never fromMaybe : Maybe A → Delay A ∞ fromMaybe = maybe now never runFor : ℕ → Delay A ∞ → Maybe A runFor zero d = nothing runFor (suc n) (now a) = just a runFor (suc n) (later d) = runFor n (d .force) module _ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} where map : (A → B) → ∀ {i} → Delay A i → Delay B i map f (now a) = now (f a) map f (later d) = later λ where .force → map f (d .force) bind : ∀ {i} → Delay A i → (A → Delay B i) → Delay B i bind (now a) f = f a bind (later d) f = later λ where .force → bind (d .force) f unfold : (A → A ⊎ B) → A → ∀ {i} → Delay B i unfold next seed with next seed ... | inj₁ seed′ = later λ where .force → unfold next seed′ ... | inj₂ b = now b module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where zipWith : (A → B → C) → ∀ {i} → Delay A i → Delay B i → Delay C i zipWith f (now a) d = map (f a) d zipWith f d (now b) = map (λ a → f a b) d zipWith f (later a) (later b) = later λ where .force → zipWith f (a .force) (b .force) alignWith : (These A B → C) → ∀ {i} → Delay A i → Delay B i → Delay C i alignWith f (now a) (now b) = now (f (these a b)) alignWith f (now a) (later _) = now (f (this a)) alignWith f (later _) (now b) = now (f (that b)) alignWith f (later a) (later b) = later λ where .force → alignWith f (a .force) (b .force) module _ {a b} {A : Set a} {B : Set b} where zip : ∀ {i} → Delay A i → Delay B i → Delay (A × B) i zip = zipWith _,_ align : ∀ {i} → Delay A i → Delay B i → Delay (These A B) i align = alignWith id ------------------------------------------------------------------------ -- Finite Delays module _ {ℓ} {A : Set ℓ} where infix 3 _⇓ data _⇓ : Delay A ∞ → Set ℓ where now : ∀ a → now a ⇓ later : ∀ {d} → d .force ⇓ → later d ⇓ extract : ∀ {d} → d ⇓ → A extract (now a) = a extract (later d) = extract d ¬never⇓ : ¬ (never ⇓) ¬never⇓ (later p) = ¬never⇓ p length-⇓ : ∀ {d} → d ⇓ → Finite (length d) length-⇓ (now a) = zero length-⇓ (later d⇓) = suc (length-⇓ d⇓) module _ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} where map-⇓ : ∀ (f : A → B) {d} → d ⇓ → map f d ⇓ map-⇓ f (now a) = now (f a) map-⇓ f (later d) = later (map-⇓ f d) bind-⇓ : ∀ {m} (m⇓ : m ⇓) {f : A → Delay B ∞} → f (extract m⇓) ⇓ → bind m f ⇓ bind-⇓ (now a) fa⇓ = fa⇓ bind-⇓ (later p) fa⇓ = later (bind-⇓ p fa⇓) agda-stdlib-1.7.3/src/Codata/Delay/000077500000000000000000000000001451211343400167135ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Delay/Bisimilarity.agda000066400000000000000000000042621451211343400221760ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for the Delay type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Delay.Bisimilarity where open import Size open import Codata.Thunk open import Codata.Delay open import Level open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) data Bisim {a b r} {A : Set a} {B : Set b} (R : A → B → Set r) i : (xs : Delay A ∞) (ys : Delay B ∞) → Set (a ⊔ b ⊔ r) where now : ∀ {x y} → R x y → Bisim R i (now x) (now y) later : ∀ {xs ys} → Thunk^R (Bisim R) i xs ys → Bisim R i (later xs) (later ys) module _ {a r} {A : Set a} {R : A → A → Set r} where reflexive : Reflexive R → ∀ {i} → Reflexive (Bisim R i) reflexive refl^R {i} {now r} = now refl^R reflexive refl^R {i} {later rs} = later λ where .force → reflexive refl^R module _ {a b} {A : Set a} {B : Set b} {r} {P : A → B → Set r} {Q : B → A → Set r} where symmetric : Sym P Q → ∀ {i} → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ (now p) = now (sym^PQ p) symmetric sym^PQ (later ps) = later λ where .force → symmetric sym^PQ (ps .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {r} {P : A → B → Set r} {Q : B → C → Set r} {R : A → C → Set r} where transitive : Trans P Q R → ∀ {i} → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR (now p) (now q) = now (trans^PQR p q) transitive trans^PQR (later ps) (later qs) = later λ where .force → transitive trans^PQR (ps .force) (qs .force) -- Pointwise Equality as a Bisimilarity ------------------------------------------------------------------------ module _ {ℓ} {A : Set ℓ} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Delay A ∞ → Delay A ∞ → Set ℓ _⊢_≈_ = Bisim _≡_ refl : ∀ {i} → Reflexive (i ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i} → Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i} → Transitive (i ⊢_≈_) trans = transitive Eq.trans agda-stdlib-1.7.3/src/Codata/Delay/Categorical.agda000066400000000000000000000033741451211343400217550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Delay ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Delay.Categorical where open import Codata.Delay open import Function open import Category.Functor open import Category.Applicative open import Category.Monad open import Data.These using (leftMost) functor : ∀ {i ℓ} → RawFunctor {ℓ} (λ A → Delay A i) functor = record { _<$>_ = λ f → map f } module Sequential where applicative : ∀ {i ℓ} → RawApplicative {ℓ} (λ A → Delay A i) applicative = record { pure = now ; _⊛_ = λ df da → bind df (λ f → map f da) } applicativeZero : ∀ {i ℓ} → RawApplicativeZero {ℓ} (λ A → Delay A i) applicativeZero = record { applicative = applicative ; ∅ = never } monad : ∀ {i ℓ} → RawMonad {ℓ} (λ A → Delay A i) monad = record { return = now ; _>>=_ = bind } monadZero : ∀ {i ℓ} → RawMonadZero {ℓ} (λ A → Delay A i) monadZero = record { monad = monad ; applicativeZero = applicativeZero } module Zippy where applicative : ∀ {i ℓ} → RawApplicative {ℓ} (λ A → Delay A i) applicative = record { pure = now ; _⊛_ = zipWith id } applicativeZero : ∀ {i ℓ} → RawApplicativeZero {ℓ} (λ A → Delay A i) applicativeZero = record { applicative = applicative ; ∅ = never } alternative : ∀ {i ℓ} → RawAlternative {ℓ} (λ A → Delay A i) alternative = record { applicativeZero = applicativeZero ; _∣_ = alignWith leftMost } agda-stdlib-1.7.3/src/Codata/Delay/Properties.agda000066400000000000000000000103571451211343400216730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Delay type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Delay.Properties where open import Size import Data.Sum.Base as Sum import Data.Nat as ℕ open import Codata.Thunk using (Thunk; force) open import Codata.Conat open import Codata.Conat.Bisimilarity as Coℕ using (zero ; suc) open import Codata.Delay open import Codata.Delay.Bisimilarity open import Function open import Relation.Binary.PropositionalEquality as Eq using (_≡_) module _ {a} {A : Set a} where length-never : ∀ {i} → i Coℕ.⊢ length (never {A = A}) ≈ infinity length-never = suc λ where .force → length-never module _ {a b} {A : Set a} {B : Set b} where length-map : ∀ (f : A → B) da {i} → i Coℕ.⊢ length (map f da) ≈ length da length-map f (now a) = zero length-map f (later da) = suc λ where .force → length-map f (da .force) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} where length-zipWith : ∀ (f : A → B → C) da db {i} → i Coℕ.⊢ length (zipWith f da db) ≈ length da ⊔ length db length-zipWith f (now a) db = length-map (f a) db length-zipWith f da@(later _) (now b) = length-map (λ a → f a b) da length-zipWith f (later da) (later db) = suc λ where .force → length-zipWith f (da .force) (db .force) map-map-fusion : ∀ (f : A → B) (g : B → C) da {i} → i ⊢ map g (map f da) ≈ map (g ∘′ f) da map-map-fusion f g (now a) = now Eq.refl map-map-fusion f g (later da) = later λ where .force → map-map-fusion f g (da .force) map-unfold-fusion : ∀ (f : B → C) n (s : A) {i} → i ⊢ map f (unfold n s) ≈ unfold (Sum.map id f ∘′ n) s map-unfold-fusion f n s with n s ... | Sum.inj₁ s′ = later λ where .force → map-unfold-fusion f n s′ ... | Sum.inj₂ b = now Eq.refl ------------------------------------------------------------------------ -- ⇓ ⇓-unique : ∀ {a} {A : Set a} → {d : Delay A ∞} → (d⇓₁ : d ⇓) → (d⇓₂ : d ⇓) → d⇓₁ ≡ d⇓₂ ⇓-unique {d = now s} (now s) (now s) = Eq.refl ⇓-unique {d = later d'} (later l) (later r) = Eq.cong later (⇓-unique {d = force d'} l r) module _ {a} {A B : Set a} where bind̅₁ : (d : Delay A ∞) {f : A → Delay B ∞} → bind d f ⇓ → d ⇓ bind̅₁ (now s) _ = now s bind̅₁ (later s) (later x) = later (bind̅₁ (force s) x) bind̅₂ : (d : Delay A ∞) {f : A → Delay B ∞} → (bind⇓ : bind d f ⇓) → f (extract (bind̅₁ d bind⇓)) ⇓ bind̅₂ (now s) foo = foo bind̅₂ (later s) {f} (later foo) = bind̅₂ (force s) foo -- The extracted value of a bind is equivalent to the extracted value of its -- second element extract-bind-⇓ : {d : Delay A Size.∞} → {f : A → Delay B Size.∞} → (d⇓ : d ⇓) → (f⇓ : f (extract d⇓) ⇓) → extract (bind-⇓ d⇓ {f} f⇓) ≡ extract f⇓ extract-bind-⇓ (now a) f⇓ = Eq.refl extract-bind-⇓ (later t) f⇓ = extract-bind-⇓ t f⇓ -- If the right element of a bind returns a certain value so does the entire -- bind extract-bind̅₂-bind⇓ : (d : Delay A ∞) {f : A → Delay B ∞} → (bind⇓ : bind d f ⇓) → extract (bind̅₂ d bind⇓) ≡ extract bind⇓ extract-bind̅₂-bind⇓ (now s) bind⇓ = Eq.refl extract-bind̅₂-bind⇓ (later s) (later bind⇓) = extract-bind̅₂-bind⇓ (force s) bind⇓ -- Proof that the length of a bind-⇓ is equal to the sum of the length of its -- components. bind⇓-length : {d : Delay A ∞} {f : A → Delay B ∞} → (bind⇓ : bind d f ⇓) → (d⇓ : d ⇓) → (f⇓ : f (extract d⇓) ⇓) → toℕ (length-⇓ bind⇓) ≡ toℕ (length-⇓ d⇓) ℕ.+ toℕ (length-⇓ f⇓) bind⇓-length {f = f} bind⇓ d⇓@(now s') f⇓ = Eq.cong (toℕ ∘ length-⇓) (⇓-unique bind⇓ f⇓) bind⇓-length {d = d@(later dt)} {f = f} bind⇓@(later bind'⇓) d⇓@(later r) f⇓ = Eq.cong ℕ.suc (bind⇓-length bind'⇓ r f⇓) agda-stdlib-1.7.3/src/Codata/M.agda000066400000000000000000000024461451211343400166750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- M-types (the dual of W-types) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.M where open import Size open import Level open import Codata.Thunk using (Thunk; force) open import Data.Product hiding (map) open import Data.Container.Core as C hiding (map) data M {s p} (C : Container s p) (i : Size) : Set (s ⊔ p) where inf : ⟦ C ⟧ (Thunk (M C) i) → M C i module _ {s p} {C : Container s p} where head : ∀ {i} → M C i → Shape C head (inf (x , f)) = x tail : (x : M C ∞) → Position C (head x) → M C ∞ tail (inf (x , f)) = λ p → f p .force -- map module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} (m : C₁ ⇒ C₂) where map : ∀ {i} → M C₁ i → M C₂ i map (inf t) = inf (⟪ m ⟫ (C.map (λ t → λ where .force → map (t .force)) t)) -- unfold module _ {s p ℓ} {C : Container s p} (open Container C) {S : Set ℓ} (alg : S → ⟦ C ⟧ S) where unfold : S → ∀ {i} → M C i unfold seed = let (x , next) = alg seed in inf (x , λ p → λ where .force → unfold (next p)) agda-stdlib-1.7.3/src/Codata/M/000077500000000000000000000000001451211343400160515ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/M/Bisimilarity.agda000066400000000000000000000031171451211343400213320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for M-types ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.M.Bisimilarity where open import Level open import Size open import Codata.Thunk open import Codata.M open import Data.Container.Core open import Data.Container.Relation.Binary.Pointwise using (Pointwise; _,_) open import Data.Product using (_,_) open import Function.Base open import Relation.Binary import Relation.Binary.PropositionalEquality as P data Bisim {s p} (C : Container s p) (i : Size) : Rel (M C ∞) (s ⊔ p) where inf : ∀ {t u} → Pointwise C (Thunk^R (Bisim C) i) t u → Bisim C i (inf t) (inf u) module _ {s p} {C : Container s p} where -- unfortunately the proofs are a lot nicer if we do not use the combinators -- C.refl, C.sym and C.trans refl : ∀ {i} → Reflexive (Bisim C i) refl {x = inf t} = inf (P.refl , λ where p .force → refl) sym : ∀ {i} → Symmetric (Bisim C i) sym (inf (P.refl , f)) = inf (P.refl , λ where p .force → sym (f p .force)) trans : ∀ {i} → Transitive (Bisim C i) trans (inf (P.refl , f)) (inf (P.refl , g)) = inf (P.refl , λ where p .force → trans (f p .force) (g p .force)) isEquivalence : ∀ {i} → IsEquivalence (Bisim C i) isEquivalence = record { refl = refl ; sym = sym ; trans = trans } setoid : {i : Size} → Setoid (s ⊔ p) (s ⊔ p) setoid {i} = record { isEquivalence = isEquivalence {i} } agda-stdlib-1.7.3/src/Codata/M/Properties.agda000066400000000000000000000046231451211343400210300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on M-types ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.M.Properties where open import Level open import Size open import Codata.Thunk using (Thunk; force) open import Codata.M open import Codata.M.Bisimilarity open import Data.Container.Core as C hiding (map) import Data.Container.Morphism as Mp open import Data.Product as Prod using (_,_) open import Data.Product.Properties open import Function import Relation.Binary.PropositionalEquality as P open import Data.Container.Relation.Binary.Pointwise using (_,_) import Data.Container.Relation.Binary.Equality.Setoid as EqSetoid private module Eq {a} (A : Set a) = EqSetoid (P.setoid A) open Eq using (Eq) module _ {s p} {C : Container s p} where map-id : ∀ {i} c → Bisim C i (map (Mp.id C) c) c map-id (inf (s , f)) = inf (P.refl , λ where p .force → map-id (f p .force)) module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} where map-cong : ∀ {i} {f g : C₁ ⇒ C₂} → (∀ {X} t → Eq X C₂ (⟪ f ⟫ t) (⟪ g ⟫ t)) → ∀ c₁ → Bisim C₂ i (map f c₁) (map g c₁) map-cong {f = f} {g} f≗g (inf t@(s , n)) with f≗g t ... | eqs , eqf = inf (eqs , λ where p .force {j} → P.subst (λ t → Bisim C₂ j (map f (n (position f p) .force)) (map g (t .force))) (eqf p) (map-cong f≗g (n (position f p) .force))) module _ {s₁ s₂ s₃ p₁ p₂ p₃} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} {C₃ : Container s₃ p₃} where map-compose : ∀ {i} {g : C₂ ⇒ C₃} {f : C₁ ⇒ C₂} c₁ → Bisim C₃ i (map (g Mp.∘ f) c₁) (map g $′ map f c₁) map-compose (inf (s , f)) = inf (P.refl , λ where p .force → map-compose (f _ .force)) module _ {s₁ s₂ p₁ p₂ s} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} {S : Set s} {alg : S → ⟦ C₁ ⟧ S} {f : C₁ ⇒ C₂} where map-unfold : ∀ {i} s → Bisim C₂ i (map f (unfold alg s)) (unfold (⟪ f ⟫ ∘′ alg) s) map-unfold s = inf (P.refl , λ where p .force → map-unfold _) agda-stdlib-1.7.3/src/Codata/Musical/000077500000000000000000000000001451211343400172525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Cofin.agda000066400000000000000000000031021451211343400211220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- "Finite" sets indexed on coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Codata.Musical.Cofin where open import Codata.Musical.Notation open import Codata.Musical.Conat as Conat using (Coℕ; suc; ∞ℕ) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Fin.Base using (Fin; zero; suc) open import Relation.Binary.PropositionalEquality using (_≡_ ; refl) open import Function ------------------------------------------------------------------------ -- The type -- Note that Cofin ∞ℕ is /not/ finite. Note also that this is not a -- coinductive type, but it is indexed on a coinductive type. data Cofin : Coℕ → Set where zero : ∀ {n} → Cofin (suc n) suc : ∀ {n} (i : Cofin (♭ n)) → Cofin (suc n) suc-injective : ∀ {m} {p q : Cofin (♭ m)} → (Cofin (suc m) ∋ suc p) ≡ suc q → p ≡ q suc-injective refl = refl ------------------------------------------------------------------------ -- Some operations fromℕ : ℕ → Cofin ∞ℕ fromℕ zero = zero fromℕ (suc n) = suc (fromℕ n) toℕ : ∀ {n} → Cofin n → ℕ toℕ zero = zero toℕ (suc i) = suc (toℕ i) fromFin : ∀ {n} → Fin n → Cofin (Conat.fromℕ n) fromFin zero = zero fromFin (suc i) = suc (fromFin i) toFin : ∀ n → Cofin (Conat.fromℕ n) → Fin n toFin (suc n) zero = zero toFin (suc n) (suc i) = suc (toFin n i) agda-stdlib-1.7.3/src/Codata/Musical/Colist.agda000066400000000000000000000232071451211343400213310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} -- Disabled to prevent warnings from BoundedVec {-# OPTIONS --warn=noUserWarning #-} module Codata.Musical.Colist where open import Level using (Level) open import Category.Monad open import Codata.Musical.Notation open import Codata.Musical.Conat using (Coℕ; zero; suc) import Codata.Musical.Colist.Properties import Codata.Musical.Colist.Relation.Unary.All.Properties open import Data.Bool.Base using (Bool; true; false) open import Data.Empty using (⊥) open import Data.Maybe using (Maybe; nothing; just; Is-just) open import Data.Maybe.Relation.Unary.Any using (just) open import Data.Nat.Base using (ℕ; zero; suc; _≥′_; ≤′-refl; ≤′-step) open import Data.Nat.Properties using (s≤′s) open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty using (List⁺; _∷_) open import Data.Product as Prod using (∃; _×_; _,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]′) open import Data.Vec.Bounded as Vec≤ using (Vec≤) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; _↔̇_; Inverse; inverse) open import Level using (_⊔_) open import Relation.Binary import Relation.Binary.Construct.FromRel as Ind import Relation.Binary.Reasoning.Preorder as PreR import Relation.Binary.Reasoning.PartialOrder as POR open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary open import Relation.Nullary.Negation open import Relation.Unary using (Pred) private variable a b p : Level A : Set a B : Set b P : Pred A p ------------------------------------------------------------------------ -- Re-export type and basic definitions open import Codata.Musical.Colist.Base public module Colist-injective = Codata.Musical.Colist.Properties open import Codata.Musical.Colist.Bisimilarity public open import Codata.Musical.Colist.Relation.Unary.All public module All-injective = Codata.Musical.Colist.Relation.Unary.All.Properties open import Codata.Musical.Colist.Relation.Unary.Any public open import Codata.Musical.Colist.Relation.Unary.Any.Properties public ------------------------------------------------------------------------ -- More operations take : ∀ {a} {A : Set a} (n : ℕ) → Colist A → Vec≤ A n take zero xs = Vec≤.[] take (suc n) [] = Vec≤.[] take (suc n) (x ∷ xs) = x Vec≤.∷ take n (♭ xs) module ¬¬Monad {p} where open RawMonad (¬¬-Monad {p}) public open ¬¬Monad -- we don't want the RawMonad content to be opened publicly ------------------------------------------------------------------------ -- Memberships, subsets, prefixes -- x ∈ xs means that x is a member of xs. infix 4 _∈_ _∈_ : {A : Set a} → A → Colist A → Set a x ∈ xs = Any (_≡_ x) xs -- xs ⊆ ys means that xs is a subset of ys. infix 4 _⊆_ _⊆_ : {A : Set a} → Rel (Colist A) a xs ⊆ ys = ∀ {x} → x ∈ xs → x ∈ ys -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ {A : Set a} : Rel (Colist A) a where [] : ∀ {ys} → [] ⊑ ys _∷_ : ∀ x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → x ∷ xs ⊑ x ∷ ys -- Any can be expressed using _∈_ (and vice versa). Any-∈ : ∀ {xs} → Any P xs ↔ ∃ λ x → x ∈ xs × P x Any-∈ {P = P} = record { to = P.→-to-⟶ to ; from = P.→-to-⟶ (λ { (x , x∈xs , p) → from x∈xs p }) ; inverse-of = record { left-inverse-of = from∘to ; right-inverse-of = λ { (x , x∈xs , p) → to∘from x∈xs p } } } where to : ∀ {xs} → Any P xs → ∃ λ x → x ∈ xs × P x to (here p) = _ , here P.refl , p to (there p) = Prod.map id (Prod.map there id) (to p) from : ∀ {x xs} → x ∈ xs → P x → Any P xs from (here P.refl) p = here p from (there x∈xs) p = there (from x∈xs p) to∘from : ∀ {x xs} (x∈xs : x ∈ xs) (p : P x) → to (from x∈xs p) ≡ (x , x∈xs , p) to∘from (here P.refl) p = P.refl to∘from (there x∈xs) p = P.cong (Prod.map id (Prod.map there id)) (to∘from x∈xs p) from∘to : ∀ {xs} (p : Any P xs) → let (x , x∈xs , px) = to p in from x∈xs px ≡ p from∘to (here _) = P.refl from∘to (there p) = P.cong there (from∘to p) -- Prefixes are subsets. ⊑⇒⊆ : _⊑_ {A = A} ⇒ _⊆_ ⊑⇒⊆ (x ∷ xs⊑ys) (here ≡x) = here ≡x ⊑⇒⊆ (_ ∷ xs⊑ys) (there x∈xs) = there (⊑⇒⊆ (♭ xs⊑ys) x∈xs) -- The prefix relation forms a poset. ⊑-Poset : ∀ {ℓ} → Set ℓ → Poset _ _ _ ⊑-Poset A = record { Carrier = Colist A ; _≈_ = _≈_ ; _≤_ = _⊑_ ; isPartialOrder = record { isPreorder = record { isEquivalence = Setoid.isEquivalence (setoid A) ; reflexive = reflexive ; trans = trans } ; antisym = antisym } } where reflexive : _≈_ ⇒ _⊑_ reflexive [] = [] reflexive (x ∷ xs≈) = x ∷ ♯ reflexive (♭ xs≈) trans : Transitive _⊑_ trans [] _ = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) tail : ∀ {x xs y ys} → x ∷ xs ⊑ y ∷ ys → ♭ xs ⊑ ♭ ys tail (_ ∷ p) = ♭ p antisym : Antisymmetric _≈_ _⊑_ antisym [] [] = [] antisym (x ∷ p₁) p₂ = x ∷ ♯ antisym (♭ p₁) (tail p₂) module ⊑-Reasoning {a} {A : Set a} where private module Base = POR (⊑-Poset A) open Base public hiding (step-<; begin-strict_; step-≤) infixr 2 step-⊑ step-⊑ = Base.step-≤ syntax step-⊑ x ys⊑zs xs⊑ys = x ⊑⟨ xs⊑ys ⟩ ys⊑zs -- The subset relation forms a preorder. ⊆-Preorder : ∀ {ℓ} → Set ℓ → Preorder _ _ _ ⊆-Preorder A = Ind.preorder (setoid A) _∈_ (λ xs≈ys → ⊑⇒⊆ (⊑P.reflexive xs≈ys)) where module ⊑P = Poset (⊑-Poset A) module ⊆-Reasoning {A : Set a} where private module Base = PreR (⊆-Preorder A) open Base public hiding (step-∼) infixr 2 step-⊆ infix 1 step-∈ step-⊆ = Base.step-∼ step-∈ : ∀ (x : A) {xs ys} → xs IsRelatedTo ys → x ∈ xs → x ∈ ys step-∈ x xs⊆ys x∈xs = (begin xs⊆ys) x∈xs syntax step-⊆ xs ys⊆zs xs⊆ys = xs ⊆⟨ xs⊆ys ⟩ ys⊆zs syntax step-∈ x xs⊆ys x∈xs = x ∈⟨ x∈xs ⟩ xs⊆ys -- take returns a prefix. take-⊑ : ∀ n (xs : Colist A) → let toColist = fromList {a} ∘ Vec≤.toList in toColist (take n xs) ⊑ xs take-⊑ zero xs = [] take-⊑ (suc n) [] = [] take-⊑ (suc n) (x ∷ xs) = x ∷ ♯ take-⊑ n (♭ xs) ------------------------------------------------------------------------ -- Finiteness and infiniteness -- Finite xs means that xs has finite length. data Finite {A : Set a} : Colist A → Set a where [] : Finite [] _∷_ : ∀ x {xs} (fin : Finite (♭ xs)) → Finite (x ∷ xs) module Finite-injective where ∷-injective : ∀ {x : A} {xs p q} → (Finite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective P.refl = P.refl -- Infinite xs means that xs has infinite length. data Infinite {A : Set a} : Colist A → Set a where _∷_ : ∀ x {xs} (inf : ∞ (Infinite (♭ xs))) → Infinite (x ∷ xs) module Infinite-injective where ∷-injective : ∀ {x : A} {xs p q} → (Infinite (x ∷ xs) ∋ x ∷ p) ≡ x ∷ q → p ≡ q ∷-injective P.refl = P.refl -- Colists which are not finite are infinite. not-finite-is-infinite : (xs : Colist A) → ¬ Finite xs → Infinite xs not-finite-is-infinite [] hyp = contradiction [] hyp not-finite-is-infinite (x ∷ xs) hyp = x ∷ ♯ not-finite-is-infinite (♭ xs) (hyp ∘ _∷_ x) -- Colists are either finite or infinite (classically). finite-or-infinite : (xs : Colist A) → ¬ ¬ (Finite xs ⊎ Infinite xs) finite-or-infinite xs = helper <$> excluded-middle where helper : Dec (Finite xs) → Finite xs ⊎ Infinite xs helper ( true because [fin]) = inj₁ (invert [fin]) helper (false because [¬fin]) = inj₂ $ not-finite-is-infinite xs (invert [¬fin]) -- Colists are not both finite and infinite. not-finite-and-infinite : ∀ {xs : Colist A} → Finite xs → Infinite xs → ⊥ not-finite-and-infinite (x ∷ fin) (.x ∷ inf) = not-finite-and-infinite fin (♭ inf) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.3 open import Data.BoundedVec.Inefficient as BVec using (BoundedVec; []; _∷_) take′ : (n : ℕ) → Colist A → BoundedVec A n take′ zero xs = [] take′ (suc n) [] = [] take′ (suc n) (x ∷ xs) = x ∷ take′ n (♭ xs) {-# WARNING_ON_USAGE take′ "Warning: take′ (and Data.BoundedVec) was deprecated in v1.3. Please use take (and Data.Vec.Bounded) instead." #-} take′-⊑ : ∀ n (xs : Colist A) → let toColist = fromList {a} ∘ BVec.toList in toColist (take′ n xs) ⊑ xs take′-⊑ zero xs = [] take′-⊑ (suc n) [] = [] take′-⊑ (suc n) (x ∷ xs) = x ∷ ♯ take′-⊑ n (♭ xs) {-# WARNING_ON_USAGE take′-⊑ "Warning: take′-⊑ (and Data.BoundedVec) was deprecated in v1.3. Please use take-⊑ (and Data.Vec.Bounded) instead." #-} agda-stdlib-1.7.3/src/Codata/Musical/Colist/000077500000000000000000000000001451211343400205075ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Colist/Base.agda000066400000000000000000000050251451211343400222010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists: base type and functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Base where open import Level using (Level) open import Codata.Musical.Notation open import Codata.Musical.Conat.Base using (Coℕ; zero; suc) open import Data.Bool.Base using (Bool; true; false) open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty.Base using (List⁺; _∷_) open import Data.Maybe.Base using (Maybe; nothing; just) open import Data.Nat.Base using (ℕ; zero; suc) private variable a b : Level A : Set a B : Set b ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Colist (A : Set a) : Set a where [] : Colist A _∷_ : (x : A) (xs : ∞ (Colist A)) → Colist A {-# FOREIGN GHC data AgdaColist a = Nil | Cons a (MAlonzo.RTE.Inf (AgdaColist a)) type AgdaColist' l a = AgdaColist a #-} {-# COMPILE GHC Colist = data AgdaColist' (Nil | Cons) #-} {-# COMPILE UHC Colist = data __LIST__ (__NIL__ | __CONS__) #-} ------------------------------------------------------------------------ -- Some operations null : Colist A → Bool null [] = true null (_ ∷ _) = false length : Colist A → Coℕ length [] = zero length (x ∷ xs) = suc (♯ length (♭ xs)) map : (A → B) → Colist A → Colist B map f [] = [] map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) fromList : List A → Colist A fromList [] = [] fromList (x ∷ xs) = x ∷ ♯ fromList xs replicate : Coℕ → A → Colist A replicate zero x = [] replicate (suc n) x = x ∷ ♯ replicate (♭ n) x lookup : ℕ → Colist A → Maybe A lookup n [] = nothing lookup zero (x ∷ xs) = just x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : Colist A → Colist A → Colist A [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) -- Interleaves the two colists (until the shorter one, if any, has -- been exhausted). infixr 5 _⋎_ _⋎_ : Colist A → Colist A → Colist A [] ⋎ ys = ys (x ∷ xs) ⋎ ys = x ∷ ♯ (ys ⋎ ♭ xs) concat : Colist (List⁺ A) → Colist A concat [] = [] concat ((x ∷ []) ∷ xss) = x ∷ ♯ concat (♭ xss) concat ((x ∷ (y ∷ xs)) ∷ xss) = x ∷ ♯ concat ((y ∷ xs) ∷ xss) [_] : A → Colist A [ x ] = x ∷ ♯ [] agda-stdlib-1.7.3/src/Codata/Musical/Colist/Bisimilarity.agda000066400000000000000000000031611451211343400237670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise equality of colists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Bisimilarity where open import Codata.Musical.Colist.Base open import Codata.Musical.Notation open import Level using (Level) open import Relation.Binary private variable a b : Level A : Set a B : Set b -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ {A : Set a} : Rel (Colist A) a where [] : [] ≈ [] _∷_ : ∀ x {xs ys} (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → x ∷ xs ≈ x ∷ ys -- The equality relation forms a setoid. setoid : Set a → Setoid _ _ setoid A = record { Carrier = Colist A ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {[]} = [] refl {x ∷ xs} = x ∷ ♯ refl sym : Symmetric _≈_ sym [] = [] sym (x ∷ xs≈) = x ∷ ♯ sym (♭ xs≈) trans : Transitive _≈_ trans [] [] = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) module ≈-Reasoning where import Relation.Binary.Reasoning.Setoid as EqR private open module R {a} {A : Set a} = EqR (setoid A) public -- map preserves equality. map-cong : (f : A → B) → _≈_ =[ map f ]⇒ _≈_ map-cong f [] = [] map-cong f (x ∷ xs≈) = f x ∷ ♯ map-cong f (♭ xs≈) agda-stdlib-1.7.3/src/Codata/Musical/Colist/Infinite-merge.agda000066400000000000000000000203411451211343400241670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Infinite merge operation for coinductive lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Infinite-merge where open import Codata.Musical.Notation open import Codata.Musical.Colist as Colist hiding (_⋎_) open import Data.Nat.Base open import Data.Nat.Induction using (<′-wellFounded) open import Data.Nat.Properties open import Data.Product as Prod open import Data.Sum.Base open import Data.Sum.Properties open import Data.Sum.Function.Propositional using (_⊎-cong_) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; Inverse; inverse) import Function.Related as Related open import Function.Related.TypeIsomorphisms import Induction.WellFounded as WF open import Relation.Binary.PropositionalEquality as P using (_≡_) import Relation.Binary.Construct.On as On ------------------------------------------------------------------------ -- Some code that is used to work around Agda's syntactic guardedness -- checker. private infixr 5 _∷_ _⋎_ data ColistP {a} (A : Set a) : Set a where [] : ColistP A _∷_ : A → ∞ (ColistP A) → ColistP A _⋎_ : ColistP A → ColistP A → ColistP A data ColistW {a} (A : Set a) : Set a where [] : ColistW A _∷_ : A → ColistP A → ColistW A program : ∀ {a} {A : Set a} → Colist A → ColistP A program [] = [] program (x ∷ xs) = x ∷ ♯ program (♭ xs) mutual _⋎W_ : ∀ {a} {A : Set a} → ColistW A → ColistP A → ColistW A [] ⋎W ys = whnf ys (x ∷ xs) ⋎W ys = x ∷ (ys ⋎ xs) whnf : ∀ {a} {A : Set a} → ColistP A → ColistW A whnf [] = [] whnf (x ∷ xs) = x ∷ ♭ xs whnf (xs ⋎ ys) = whnf xs ⋎W ys mutual ⟦_⟧P : ∀ {a} {A : Set a} → ColistP A → Colist A ⟦ xs ⟧P = ⟦ whnf xs ⟧W ⟦_⟧W : ∀ {a} {A : Set a} → ColistW A → Colist A ⟦ [] ⟧W = [] ⟦ x ∷ xs ⟧W = x ∷ ♯ ⟦ xs ⟧P mutual ⋎-homP : ∀ {a} {A : Set a} (xs : ColistP A) {ys} → ⟦ xs ⋎ ys ⟧P ≈ ⟦ xs ⟧P Colist.⋎ ⟦ ys ⟧P ⋎-homP xs = ⋎-homW (whnf xs) _ ⋎-homW : ∀ {a} {A : Set a} (xs : ColistW A) ys → ⟦ xs ⋎W ys ⟧W ≈ ⟦ xs ⟧W Colist.⋎ ⟦ ys ⟧P ⋎-homW (x ∷ xs) ys = x ∷ ♯ ⋎-homP ys ⋎-homW [] ys = begin ⟦ ys ⟧P ∎ where open ≈-Reasoning ⟦program⟧P : ∀ {a} {A : Set a} (xs : Colist A) → ⟦ program xs ⟧P ≈ xs ⟦program⟧P [] = [] ⟦program⟧P (x ∷ xs) = x ∷ ♯ ⟦program⟧P (♭ xs) Any-⋎P : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} → Any P ⟦ program xs ⋎ ys ⟧P ↔ (Any P xs ⊎ Any P ⟦ ys ⟧P) Any-⋎P {P = P} xs {ys} = Any P ⟦ program xs ⋎ ys ⟧P ↔⟨ Any-cong Inv.id (⋎-homP (program xs)) ⟩ Any P (⟦ program xs ⟧P Colist.⋎ ⟦ ys ⟧P) ↔⟨ Any-⋎ _ ⟩ (Any P ⟦ program xs ⟧P ⊎ Any P ⟦ ys ⟧P) ↔⟨ Any-cong Inv.id (⟦program⟧P _) ⊎-cong (_ ∎) ⟩ (Any P xs ⊎ Any P ⟦ ys ⟧P) ∎ where open Related.EquationalReasoning index-Any-⋎P : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} (p : Any P ⟦ program xs ⋎ ys ⟧P) → index p ≥′ [ index , index ]′ (Inverse.to (Any-⋎P xs) ⟨$⟩ p) index-Any-⋎P xs p with Any-resp id (⋎-homW (whnf (program xs)) _) p | index-Any-resp {f = id} (⋎-homW (whnf (program xs)) _) p index-Any-⋎P xs p | q | q≡p with Inverse.to (Any-⋎ ⟦ program xs ⟧P) ⟨$⟩ q | index-Any-⋎ ⟦ program xs ⟧P q index-Any-⋎P xs p | q | q≡p | inj₂ r | r≤q rewrite q≡p = r≤q index-Any-⋎P xs p | q | q≡p | inj₁ r | r≤q with Any-resp id (⟦program⟧P xs) r | index-Any-resp {f = id} (⟦program⟧P xs) r index-Any-⋎P xs p | q | q≡p | inj₁ r | r≤q | s | s≡r rewrite s≡r | q≡p = r≤q ------------------------------------------------------------------------ -- Infinite variant of _⋎_. private merge′ : ∀ {a} {A : Set a} → Colist (A × Colist A) → ColistP A merge′ [] = [] merge′ ((x , xs) ∷ xss) = x ∷ ♯ (program xs ⋎ merge′ (♭ xss)) merge : ∀ {a} {A : Set a} → Colist (A × Colist A) → Colist A merge xss = ⟦ merge′ xss ⟧P ------------------------------------------------------------------------ -- Any lemma for merge. module _ {a p} {A : Set a} {P : A → Set p} where Any-merge : ∀ xss → Any P (merge xss) ↔ Any (λ { (x , xs) → P x ⊎ Any P xs }) xss Any-merge xss = inverse (proj₁ ∘ to xss) from (proj₂ ∘ to xss) to∘from where open P.≡-Reasoning -- The from function. Q = λ { (x , xs) → P x ⊎ Any P xs } from : ∀ {xss} → Any Q xss → Any P (merge xss) from (here (inj₁ p)) = here p from (here (inj₂ p)) = there (Inverse.from (Any-⋎P _) ⟨$⟩ inj₁ p) from (there {x = _ , xs} p) = there (Inverse.from (Any-⋎P xs) ⟨$⟩ inj₂ (from p)) -- The from function is injective. from-injective : ∀ {xss} (p₁ p₂ : Any Q xss) → from p₁ ≡ from p₂ → p₁ ≡ p₂ from-injective (here (inj₁ p)) (here (inj₁ .p)) P.refl = P.refl from-injective (here (inj₂ p₁)) (here (inj₂ p₂)) eq = P.cong (here ∘ inj₂) $ inj₁-injective $ Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₁ p₁} {y = inj₁ p₂} $ there-injective eq from-injective (here (inj₂ p₁)) (there p₂) eq with Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₁ p₁} {y = inj₂ (from p₂)} (there-injective eq) ... | () from-injective (there p₁) (here (inj₂ p₂)) eq with Inverse.injective (Inv.sym (Any-⋎P _)) {x = inj₂ (from p₁)} {y = inj₁ p₂} (there-injective eq) ... | () from-injective (there {x = _ , xs} p₁) (there p₂) eq = P.cong there $ from-injective p₁ p₂ $ inj₂-injective $ Inverse.injective (Inv.sym (Any-⋎P xs)) {x = inj₂ (from p₁)} {y = inj₂ (from p₂)} $ there-injective eq -- The to function (defined as a right inverse of from). Input = ∃ λ xss → Any P (merge xss) Pred : Input → Set _ Pred (xss , p) = ∃ λ (q : Any Q xss) → from q ≡ p to : ∀ xss p → Pred (xss , p) to = λ xss p → WF.All.wfRec (On.wellFounded size <′-wellFounded) _ Pred step (xss , p) where size : Input → ℕ size (_ , p) = index p step : ∀ p → WF.WfRec (_<′_ on size) Pred p → Pred p step ([] , ()) rec step ((x , xs) ∷ xss , here p) rec = here (inj₁ p) , P.refl step ((x , xs) ∷ xss , there p) rec with Inverse.to (Any-⋎P xs) ⟨$⟩ p | Inverse.left-inverse-of (Any-⋎P xs) p | index-Any-⋎P xs p ... | inj₁ q | P.refl | _ = here (inj₂ q) , P.refl ... | inj₂ q | P.refl | q≤p = Prod.map there (P.cong (there ∘ _⟨$⟩_ (Inverse.from (Any-⋎P xs)) ∘ inj₂)) (rec (♭ xss , q) (s≤′s q≤p)) to∘from = λ p → from-injective _ _ (proj₂ (to xss (from p))) -- Every member of xss is a member of merge xss, and vice versa (with -- equal multiplicities). ∈-merge : ∀ {a} {A : Set a} {y : A} xss → y ∈ merge xss ↔ ∃₂ λ x xs → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs) ∈-merge {y = y} xss = y ∈ merge xss ↔⟨ Any-merge _ ⟩ Any (λ { (x , xs) → y ≡ x ⊎ y ∈ xs }) xss ↔⟨ Any-∈ ⟩ (∃ λ { (x , xs) → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs) }) ↔⟨ Σ-assoc ⟩ (∃₂ λ x xs → (x , xs) ∈ xss × (y ≡ x ⊎ y ∈ xs)) ∎ where open Related.EquationalReasoning agda-stdlib-1.7.3/src/Codata/Musical/Colist/Properties.agda000066400000000000000000000015261451211343400234650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of coinductive lists and their operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Properties where open import Level using (Level) open import Codata.Musical.Notation open import Codata.Musical.Colist.Base open import Function.Base using (_∋_) open import Relation.Binary.PropositionalEquality.Core using (_≡_; refl) private variable a b : Level A : Set a B : Set b ∷-injectiveˡ : ∀ {x y xs ys} → (Colist A ∋ x ∷ xs) ≡ y ∷ ys → x ≡ y ∷-injectiveˡ refl = refl ∷-injectiveʳ : ∀ {x y xs ys} → (Colist A ∋ x ∷ xs) ≡ y ∷ ys → xs ≡ ys ∷-injectiveʳ refl = refl agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/000077500000000000000000000000001451211343400222645ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/000077500000000000000000000000001451211343400233625ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/All.agda000066400000000000000000000013611451211343400247110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists where all elements satisfy a predicate ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Relation.Unary.All where open import Codata.Musical.Colist.Base open import Codata.Musical.Notation open import Level using (Level; _⊔_) open import Relation.Unary using (Pred) private variable a b p : Level A : Set a B : Set b P : Pred A p data All {A : Set a} (P : Pred A p) : Pred (Colist A) (a ⊔ p) where [] : All P [] _∷_ : ∀ {x xs} (px : P x) (pxs : ∞ (All P (♭ xs))) → All P (x ∷ xs) agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/All/000077500000000000000000000000001451211343400240725ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/All/Properties.agda000066400000000000000000000020601451211343400270420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists where all elements satisfy a predicate ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Relation.Unary.All.Properties where open import Codata.Musical.Colist.Base open import Codata.Musical.Colist.Relation.Unary.All open import Codata.Musical.Notation open import Function.Base using (_∋_) open import Level using (Level; _⊔_) open import Relation.Binary.PropositionalEquality.Core using (_≡_; refl) open import Relation.Unary using (Pred) private variable a b p : Level A : Set a B : Set b P : Pred A p ∷-injectiveˡ : ∀ {x xs px qx pxs qxs} → (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → px ≡ qx ∷-injectiveˡ refl = refl ∷-injectiveʳ : ∀ {x xs px qx pxs qxs} → (All P (x ∷ xs) ∋ px ∷ pxs) ≡ qx ∷ qxs → pxs ≡ qxs ∷-injectiveʳ refl = refl agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/Any.agda000066400000000000000000000020321451211343400247240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive lists where at least one element satisfies a predicate ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Relation.Unary.Any where open import Codata.Musical.Colist.Base open import Codata.Musical.Notation open import Data.Nat.Base using (ℕ; zero; suc) open import Function.Base using (_∋_) open import Level using (Level; _⊔_) open import Relation.Binary.PropositionalEquality.Core using (_≡_; refl) open import Relation.Unary using (Pred) private variable a b p : Level A : Set a B : Set b P : Pred A p data Any {A : Set a} (P : Pred A p) : Pred (Colist A) (a ⊔ p) where here : ∀ {x xs} (px : P x) → Any P (x ∷ xs) there : ∀ {x xs} (pxs : Any P (♭ xs)) → Any P (x ∷ xs) index : ∀ {xs} → Any P xs → ℕ index (here px) = zero index (there p) = suc (index p) agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/Any/000077500000000000000000000000001451211343400241115ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Colist/Relation/Unary/Any/Properties.agda000066400000000000000000000166071451211343400270750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the Any predicate on colists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Colist.Relation.Unary.Any.Properties where open import Codata.Musical.Colist.Base open import Codata.Musical.Colist.Bisimilarity open import Codata.Musical.Colist.Relation.Unary.Any open import Codata.Musical.Notation open import Data.Maybe using (Is-just) open import Data.Maybe.Relation.Unary.Any using (just) open import Data.Nat.Base using (suc; _≥′_; ≤′-refl; ≤′-step) open import Data.Nat.Properties using (s≤′s) open import Data.Sum.Base using (_⊎_; inj₁; inj₂; [_,_]′; [_,_]) open import Function.Base using (_∋_; _∘_) open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; _↔̇_; Inverse; inverse) open import Level using (Level; _⊔_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_; refl; cong) open import Relation.Unary using (Pred) private variable a b p q : Level A : Set a B : Set b P : Pred A p Q : Pred A q ------------------------------------------------------------------------ -- Equality properties here-injective : ∀ {x xs p q} → (Any P (x ∷ xs) ∋ here p) ≡ here q → p ≡ q here-injective refl = refl there-injective : ∀ {x xs p q} → (Any P (x ∷ xs) ∋ there p) ≡ there q → p ≡ q there-injective refl = refl Any-resp : ∀ {a p q} {A : Set a} {P : A → Set p} {Q : A → Set q} {xs ys} → (∀ {x} → P x → Q x) → xs ≈ ys → Any P xs → Any Q ys Any-resp f (x ∷ xs≈) (here px) = here (f px) Any-resp f (x ∷ xs≈) (there p) = there (Any-resp f (♭ xs≈) p) -- Any maps pointwise isomorphic predicates and equal colists to -- isomorphic types. Any-cong : ∀ {a p q} {A : Set a} {P : A → Set p} {Q : A → Set q} {xs ys} → P ↔̇ Q → xs ≈ ys → Any P xs ↔ Any Q ys Any-cong {A = A} {P} {Q} {xs} {ys} P↔Q = λ xs≈ys → record { to = P.→-to-⟶ (to xs≈ys) ; from = P.→-to-⟶ (from xs≈ys) ; inverse-of = record { left-inverse-of = from∘to _ ; right-inverse-of = to∘from _ } } where open Setoid (setoid _) using (sym) to : ∀ {xs ys} → xs ≈ ys → Any P xs → Any Q ys to xs≈ys = Any-resp (Inverse.to P↔Q ⟨$⟩_) xs≈ys from : ∀ {xs ys} → xs ≈ ys → Any Q ys → Any P xs from xs≈ys = Any-resp (Inverse.from P↔Q ⟨$⟩_) (sym xs≈ys) to∘from : ∀ {xs ys} (xs≈ys : xs ≈ ys) (q : Any Q ys) → to xs≈ys (from xs≈ys q) ≡ q to∘from (x ∷ xs≈) (there q) = P.cong there (to∘from (♭ xs≈) q) to∘from (x ∷ xs≈) (here qx) = P.cong here (Inverse.right-inverse-of P↔Q qx) from∘to : ∀ {xs ys} (xs≈ys : xs ≈ ys) (p : Any P xs) → from xs≈ys (to xs≈ys p) ≡ p from∘to (x ∷ xs≈) (there p) = P.cong there (from∘to (♭ xs≈) p) from∘to (x ∷ xs≈) (here px) = P.cong here (Inverse.left-inverse-of P↔Q px) ------------------------------------------------------------------------ -- map module _ {f : A → B} where map⁻ : ∀ {xs} → Any P (map f xs) → Any (P ∘ f) xs map⁻ {xs = x ∷ xs} (here px) = here px map⁻ {xs = x ∷ xs} (there p) = there (map⁻ p) map⁺ : ∀ {xs} → Any (P ∘ f) xs → Any P (map f xs) map⁺ (here px) = here px map⁺ (there p) = there (map⁺ p) Any-map : ∀ {xs} → Any P (map f xs) ↔ Any (P ∘ f) xs Any-map {xs = xs} = inverse map⁻ map⁺ from∘to to∘from where from∘to : ∀ {xs} (p : Any P (map f xs)) → map⁺ (map⁻ p) ≡ p from∘to {xs = x ∷ xs} (here px) = refl from∘to {xs = x ∷ xs} (there p) = cong there (from∘to p) to∘from : ∀ {xs} (p : Any (P ∘ f) xs) → map⁻ {P = P} (map⁺ p) ≡ p to∘from (here px) = refl to∘from (there p) = cong there (to∘from p) ------------------------------------------------------------------------ -- _⋎_ ⋎⁻ : ∀ xs {ys} → Any P (xs ⋎ ys) → Any P xs ⊎ Any P ys ⋎⁻ [] p = inj₂ p ⋎⁻ (x ∷ xs) (here px) = inj₁ (here px) ⋎⁻ (x ∷ xs) (there p) = [ inj₂ , inj₁ ∘ there ]′ (⋎⁻ _ p) mutual ⋎⁺₁ : ∀ {xs ys} → Any P xs → Any P (xs ⋎ ys) ⋎⁺₁ (here px) = here px ⋎⁺₁ {ys = ys} (there p) = there (⋎⁺₂ ys p) ⋎⁺₂ : ∀ xs {ys} → Any P ys → Any P (xs ⋎ ys) ⋎⁺₂ [] p = p ⋎⁺₂ (x ∷ xs) p = there (⋎⁺₁ p) ⋎⁺ : ∀ xs {ys} → Any P xs ⊎ Any P ys → Any P (xs ⋎ ys) ⋎⁺ xs = [ ⋎⁺₁ , ⋎⁺₂ xs ] Any-⋎ : ∀ {a p} {A : Set a} {P : A → Set p} xs {ys} → Any P (xs ⋎ ys) ↔ (Any P xs ⊎ Any P ys) Any-⋎ {P = P} = λ xs → record { to = P.→-to-⟶ (⋎⁻ xs) ; from = P.→-to-⟶ (⋎⁺ xs) ; inverse-of = record { left-inverse-of = from∘to xs ; right-inverse-of = to∘from xs } } where from∘to : ∀ xs {ys} (p : Any P (xs ⋎ ys)) → ⋎⁺ xs (⋎⁻ xs p) ≡ p from∘to [] p = refl from∘to (x ∷ xs) (here px) = refl from∘to (x ∷ xs) {ys = ys} (there p) with ⋎⁻ ys p | from∘to ys p from∘to (x ∷ xs) {ys = ys} (there .(⋎⁺₁ q)) | inj₁ q | refl = refl from∘to (x ∷ xs) {ys = ys} (there .(⋎⁺₂ ys q)) | inj₂ q | refl = refl mutual to∘from₁ : ∀ {xs ys} (p : Any P xs) → ⋎⁻ xs {ys = ys} (⋎⁺₁ p) ≡ inj₁ p to∘from₁ (here px) = refl to∘from₁ {ys = ys} (there p) rewrite to∘from₂ ys p = refl to∘from₂ : ∀ xs {ys} (p : Any P ys) → ⋎⁻ xs (⋎⁺₂ xs p) ≡ inj₂ p to∘from₂ [] p = refl to∘from₂ (x ∷ xs) {ys = ys} p rewrite to∘from₁ {xs = ys} {ys = ♭ xs} p = refl to∘from : ∀ xs {ys} (p : Any P xs ⊎ Any P ys) → ⋎⁻ xs (⋎⁺ xs p) ≡ p to∘from xs = [ to∘from₁ , to∘from₂ xs ] ------------------------------------------------------------------------ -- index -- The position returned by index is guaranteed to be within bounds. lookup-index : ∀ {xs} (p : Any P xs) → Is-just (lookup (index p) xs) lookup-index (here px) = just _ lookup-index (there p) = lookup-index p -- Any-resp preserves the index. index-Any-resp : ∀ {f : ∀ {x} → P x → Q x} {xs ys} (xs≈ys : xs ≈ ys) (p : Any P xs) → index (Any-resp f xs≈ys p) ≡ index p index-Any-resp (x ∷ xs≈) (here px) = P.refl index-Any-resp (x ∷ xs≈) (there p) = cong suc (index-Any-resp (♭ xs≈) p) -- The left-to-right direction of Any-⋎ returns a proof whose size is -- no larger than that of the input proof. index-Any-⋎ : ∀ xs {ys} (p : Any P (xs ⋎ ys)) → index p ≥′ [ index , index ]′ (Inverse.to (Any-⋎ xs) ⟨$⟩ p) index-Any-⋎ [] p = ≤′-refl index-Any-⋎ (x ∷ xs) (here px) = ≤′-refl index-Any-⋎ (x ∷ xs) {ys = ys} (there p) with Inverse.to (Any-⋎ ys) ⟨$⟩ p | index-Any-⋎ ys p ... | inj₁ q | q≤p = ≤′-step q≤p ... | inj₂ q | q≤p = s≤′s q≤p agda-stdlib-1.7.3/src/Codata/Musical/Conat.agda000066400000000000000000000037551451211343400211460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive "natural" numbers ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Codata.Musical.Conat where open import Codata.Musical.Notation open import Data.Nat.Base using (ℕ; zero; suc) open import Function.Base using (_∋_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Re-exporting the type and basic operations open import Codata.Musical.Conat.Base public ------------------------------------------------------------------------ -- Some properties module Coℕ-injective where suc-injective : ∀ {m n} → (Coℕ ∋ suc m) ≡ suc n → m ≡ n suc-injective P.refl = P.refl fromℕ-injective : ∀ {m n} → fromℕ m ≡ fromℕ n → m ≡ n fromℕ-injective {zero} {zero} eq = P.refl fromℕ-injective {suc m} {suc n} eq = P.cong suc (fromℕ-injective (P.cong pred eq)) ------------------------------------------------------------------------ -- Equality data _≈_ : Coℕ → Coℕ → Set where zero : zero ≈ zero suc : ∀ {m n} (m≈n : ∞ (♭ m ≈ ♭ n)) → suc m ≈ suc n module ≈-injective where suc-injective : ∀ {m n p q} → (suc m ≈ suc n ∋ suc p) ≡ suc q → p ≡ q suc-injective P.refl = P.refl setoid : Setoid _ _ setoid = record { Carrier = Coℕ ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {zero} = zero refl {suc n} = suc (♯ refl) sym : Symmetric _≈_ sym zero = zero sym (suc m≈n) = suc (♯ sym (♭ m≈n)) trans : Transitive _≈_ trans zero zero = zero trans (suc m≈n) (suc n≈k) = suc (♯ trans (♭ m≈n) (♭ n≈k)) agda-stdlib-1.7.3/src/Codata/Musical/Conat/000077500000000000000000000000001451211343400203165ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/Conat/Base.agda000066400000000000000000000021011451211343400220000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive "natural" numbers: base type and operations ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Codata.Musical.Conat.Base where open import Codata.Musical.Notation open import Data.Nat.Base using (ℕ; zero; suc) open import Function.Base using (_∋_) ------------------------------------------------------------------------ -- The type data Coℕ : Set where zero : Coℕ suc : (n : ∞ Coℕ) → Coℕ ------------------------------------------------------------------------ -- Constant ∞ℕ : Coℕ ∞ℕ = suc (♯ ∞ℕ) ------------------------------------------------------------------------ -- Some operations pred : Coℕ → Coℕ pred zero = zero pred (suc n) = ♭ n fromℕ : ℕ → Coℕ fromℕ zero = zero fromℕ (suc n) = suc (♯ fromℕ n) infixl 6 _+_ _+_ : Coℕ → Coℕ → Coℕ zero + n = n suc m + n = suc (♯ (♭ m + n)) agda-stdlib-1.7.3/src/Codata/Musical/Conversion.agda000066400000000000000000000062421451211343400222210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Conversion between coinductive data structures using "musical" -- coinduction and the ones using sized types. -- -- Warning: the combination of --sized-types and --guardedness is -- known to be unsound, so use these conversions at your own risk. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types --guardedness #-} module Codata.Musical.Conversion where open import Level using (Level) import Codata.Cofin as Sized import Codata.Colist as Sized import Codata.Conat as Sized import Codata.Covec as Sized import Codata.M import Codata.Stream as Sized open import Codata.Musical.Cofin hiding (module Cofin) open import Codata.Musical.Colist hiding (module Colist) open import Codata.Musical.Conat open import Codata.Musical.Covec hiding (module Covec) open import Codata.Musical.M hiding (module M) open import Codata.Musical.Notation open import Codata.Musical.Stream hiding (module Stream) open import Codata.Thunk open import Data.Product open import Data.Container.Core as C using (Container) import Size private variable a : Level A : Set a module Colist where fromMusical : ∀ {i} → Colist A → Sized.Colist A i fromMusical [] = Sized.[] fromMusical (x ∷ xs) = x Sized.∷ λ where .force → fromMusical (♭ xs) toMusical : Sized.Colist A Size.∞ → Colist A toMusical Sized.[] = [] toMusical (x Sized.∷ xs) = x ∷ ♯ toMusical (xs .force) module Conat where fromMusical : ∀ {i} → Coℕ → Sized.Conat i fromMusical zero = Sized.zero fromMusical (suc n) = Sized.suc λ where .force → fromMusical (♭ n) toMusical : Sized.Conat Size.∞ → Coℕ toMusical Sized.zero = zero toMusical (Sized.suc n) = suc (♯ toMusical (n .force)) module Cofin where fromMusical : ∀ {n} → Cofin n → Sized.Cofin (Conat.fromMusical n) fromMusical zero = Sized.zero fromMusical (suc n) = Sized.suc (fromMusical n) toMusical : ∀ {n} → Sized.Cofin n → Cofin (Conat.toMusical n) toMusical Sized.zero = zero toMusical (Sized.suc n) = suc (toMusical n) module Covec where fromMusical : ∀ {i n} → Covec A n → Sized.Covec A i (Conat.fromMusical n) fromMusical [] = Sized.[] fromMusical (x ∷ xs) = x Sized.∷ λ where .force → fromMusical (♭ xs) toMusical : ∀ {n} → Sized.Covec A Size.∞ n → Covec A (Conat.toMusical n) toMusical Sized.[] = [] toMusical (x Sized.∷ xs) = x ∷ ♯ toMusical (xs .force) module M {s p} {C : Container s p} where fromMusical : ∀ {i} → M C → Codata.M.M C i fromMusical (inf t) = Codata.M.inf (C.map rec t) where rec = λ x → λ where .force → fromMusical (♭ x) toMusical : Codata.M.M C Size.∞ → M C toMusical (Codata.M.inf (s , f)) = inf (s , λ p → ♯ toMusical (f p .force)) module Stream where fromMusical : ∀ {i} → Stream A → Sized.Stream A i fromMusical (x ∷ xs) = x Sized.∷ λ where .force → fromMusical (♭ xs) toMusical : Sized.Stream A Size.∞ → Stream A toMusical (x Sized.∷ xs) = x ∷ ♯ toMusical (xs .force) agda-stdlib-1.7.3/src/Codata/Musical/Costring.agda000066400000000000000000000012031451211343400216540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Costrings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Costring where open import Codata.Musical.Colist.Base as Colist using (Colist) open import Data.Char.Base using (Char) open import Data.String.Base as String using (String) open import Function.Base using (_∘_) -- Possibly infinite strings. Costring : Set Costring = Colist Char -- Methods toCostring : String → Costring toCostring = Colist.fromList ∘ String.toList agda-stdlib-1.7.3/src/Codata/Musical/Covec.agda000066400000000000000000000130251451211343400211300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coinductive vectors ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Covec where open import Codata.Musical.Notation open import Codata.Musical.Conat as Coℕ using (Coℕ; zero; suc; _+_) open import Codata.Musical.Cofin using (Cofin; zero; suc) open import Codata.Musical.Colist as Colist using (Colist; []; _∷_) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Vec.Base using (Vec; []; _∷_) open import Data.Product using (_,_) open import Function.Base using (_∋_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Covec {a} (A : Set a) : Coℕ → Set a where [] : Covec A zero _∷_ : ∀ {n} (x : A) (xs : ∞ (Covec A (♭ n))) → Covec A (suc n) module _ {a} {A : Set a} where ∷-injectiveˡ : ∀ {a b} {n} {as bs} → (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → a ≡ b ∷-injectiveˡ P.refl = P.refl ∷-injectiveʳ : ∀ {a b} {n} {as bs} → (Covec A (suc n) ∋ a ∷ as) ≡ b ∷ bs → as ≡ bs ∷-injectiveʳ P.refl = P.refl ------------------------------------------------------------------------ -- Some operations map : ∀ {a b} {A : Set a} {B : Set b} {n} → (A → B) → Covec A n → Covec B n map f [] = [] map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) module _ {a} {A : Set a} where fromVec : ∀ {n} → Vec A n → Covec A (Coℕ.fromℕ n) fromVec [] = [] fromVec (x ∷ xs) = x ∷ ♯ fromVec xs fromColist : (xs : Colist A) → Covec A (Colist.length xs) fromColist [] = [] fromColist (x ∷ xs) = x ∷ ♯ fromColist (♭ xs) take : ∀ m {n} → Covec A (m + n) → Covec A m take zero xs = [] take (suc n) (x ∷ xs) = x ∷ ♯ take (♭ n) (♭ xs) drop : ∀ m {n} → Covec A (Coℕ.fromℕ m + n) → Covec A n drop zero xs = xs drop (suc n) (x ∷ xs) = drop n (♭ xs) replicate : ∀ n → A → Covec A n replicate zero x = [] replicate (suc n) x = x ∷ ♯ replicate (♭ n) x lookup : ∀ {n} → Cofin n → Covec A n → A lookup zero (x ∷ xs) = x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : ∀ {m n} → Covec A m → Covec A n → Covec A (m + n) [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) [_] : A → Covec A (suc (♯ zero)) [ x ] = x ∷ ♯ [] ------------------------------------------------------------------------ -- Equality and other relations -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ : ∀ {n} (xs ys : Covec A n) → Set a where [] : [] ≈ [] _∷_ : ∀ {n} x {xs ys} (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → _≈_ {n = suc n} (x ∷ xs) (x ∷ ys) -- x ∈ xs means that x is a member of xs. infix 4 _∈_ data _∈_ : ∀ {n} → A → Covec A n → Set a where here : ∀ {n x } {xs} → _∈_ {n = suc n} x (x ∷ xs) there : ∀ {n x y} {xs} (x∈xs : x ∈ ♭ xs) → _∈_ {n = suc n} x (y ∷ xs) -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ : ∀ {m n} → Covec A m → Covec A n → Set a where [] : ∀ {n} {ys : Covec A n} → [] ⊑ ys _∷_ : ∀ {m n} x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → _⊑_ {m = suc m} {suc n} (x ∷ xs) (x ∷ ys) ------------------------------------------------------------------------ -- Some proofs setoid : ∀ {a} → Set a → Coℕ → Setoid _ _ setoid A n = record { Carrier = Covec A n ; _≈_ = _≈_ ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : ∀ {n} → Reflexive (_≈_ {n = n}) refl {x = []} = [] refl {x = x ∷ xs} = x ∷ ♯ refl sym : ∀ {n} → Symmetric (_≈_ {A = A} {n}) sym [] = [] sym (x ∷ xs≈) = x ∷ ♯ sym (♭ xs≈) trans : ∀ {n} → Transitive (_≈_ {A = A} {n}) trans [] [] = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) poset : ∀ {a} → Set a → Coℕ → Poset _ _ _ poset A n = record { Carrier = Covec A n ; _≈_ = _≈_ ; _≤_ = _⊑_ ; isPartialOrder = record { isPreorder = record { isEquivalence = Setoid.isEquivalence (setoid A n) ; reflexive = reflexive ; trans = trans } ; antisym = antisym } } where reflexive : ∀ {n} → _≈_ {n = n} ⇒ _⊑_ reflexive [] = [] reflexive (x ∷ xs≈) = x ∷ ♯ reflexive (♭ xs≈) trans : ∀ {n} → Transitive (_⊑_ {n = n}) trans [] _ = [] trans (x ∷ xs≈) (.x ∷ ys≈) = x ∷ ♯ trans (♭ xs≈) (♭ ys≈) tail : ∀ {n x y xs ys} → _∷_ {n = n} x xs ⊑ _∷_ {n = n} y ys → ♭ xs ⊑ ♭ ys tail (_ ∷ p) = ♭ p antisym : ∀ {n} → Antisymmetric (_≈_ {n = n}) _⊑_ antisym [] [] = [] antisym (x ∷ p₁) p₂ = x ∷ ♯ antisym (♭ p₁) (tail p₂) map-cong : ∀ {a b} {A : Set a} {B : Set b} {n} (f : A → B) → _≈_ {n = n} =[ map f ]⇒ _≈_ map-cong f [] = [] map-cong f (x ∷ xs≈) = f x ∷ ♯ map-cong f (♭ xs≈) take-⊑ : ∀ {a} {A : Set a} m {n} (xs : Covec A (m + n)) → take m xs ⊑ xs take-⊑ zero xs = [] take-⊑ (suc n) (x ∷ xs) = x ∷ ♯ take-⊑ (♭ n) (♭ xs) agda-stdlib-1.7.3/src/Codata/Musical/M.agda000066400000000000000000000023361451211343400202700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- M-types (the dual of W-types) ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Codata.Musical.M where open import Codata.Musical.Notation open import Level open import Data.Product hiding (map) open import Data.Container.Core as C hiding (map) -- The family of M-types. data M {s p} (C : Container s p) : Set (s ⊔ p) where inf : ⟦ C ⟧ (∞ (M C)) → M C -- Projections. module _ {s p} (C : Container s p) where head : M C → Shape C head (inf (x , _)) = x tail : (x : M C) → Position C (head x) → M C tail (inf (x , f)) b = ♭ (f b) -- map module _ {s₁ s₂ p₁ p₂} {C₁ : Container s₁ p₁} {C₂ : Container s₂ p₂} (m : C₁ ⇒ C₂) where map : M C₁ → M C₂ map (inf (x , f)) = inf (shape m x , λ p → ♯ map (♭ (f (position m p)))) -- unfold module _ {s p ℓ} {C : Container s p} (open Container C) {S : Set ℓ} (alg : S → ⟦ C ⟧ S) where unfold : S → M C unfold seed = let (x , f) = alg seed in inf (x , λ p → ♯ unfold (f p)) agda-stdlib-1.7.3/src/Codata/Musical/M/000077500000000000000000000000001451211343400174465ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Musical/M/Indexed.agda000066400000000000000000000022221451211343400216420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed M-types (the dual of indexed W-types aka Petersson-Synek -- trees). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe --guardedness #-} module Codata.Musical.M.Indexed where open import Level open import Codata.Musical.Notation open import Data.Product open import Data.Container.Indexed.Core open import Function open import Relation.Unary -- The family of indexed M-types. module _ {ℓ c r} {O : Set ℓ} (C : Container O O c r) where data M (o : O) : Set (ℓ ⊔ c ⊔ r) where inf : ⟦ C ⟧ (∞ ∘ M) o → M o open Container C -- Projections. head : M ⊆ Command head (inf (c , _)) = c tail : ∀ {o} (m : M o) (r : Response (head m)) → M (next (head m) r) tail (inf (_ , k)) r = ♭ (k r) force : M ⊆ ⟦ C ⟧ M force (inf (c , k)) = c , λ r → ♭ (k r) -- Coiteration. coit : ∀ {ℓ} {X : Pred O ℓ} → X ⊆ ⟦ C ⟧ X → X ⊆ M coit ψ x = inf (proj₁ cs , λ r → ♯ coit ψ (proj₂ cs r)) where cs = ψ x agda-stdlib-1.7.3/src/Codata/Musical/Notation.agda000066400000000000000000000005461451211343400216700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic types related to coinduction ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe --guardedness #-} module Codata.Musical.Notation where open import Agda.Builtin.Coinduction public agda-stdlib-1.7.3/src/Codata/Musical/Stream.agda000066400000000000000000000124221451211343400213240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Streams ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --guardedness #-} module Codata.Musical.Stream where open import Codata.Musical.Notation open import Codata.Musical.Colist using (Colist; []; _∷_) open import Data.Vec.Base using (Vec; []; _∷_) open import Data.Nat.Base using (ℕ; zero; suc) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- The type infixr 5 _∷_ data Stream {a} (A : Set a) : Set a where _∷_ : (x : A) (xs : ∞ (Stream A)) → Stream A {-# FOREIGN GHC data AgdaStream a = Cons a (MAlonzo.RTE.Inf (AgdaStream a)) type AgdaStream' l a = AgdaStream a #-} {-# COMPILE GHC Stream = data AgdaStream' (Cons) #-} ------------------------------------------------------------------------ -- Some operations head : ∀ {a} {A : Set a} → Stream A → A head (x ∷ xs) = x tail : ∀ {a} {A : Set a} → Stream A → Stream A tail (x ∷ xs) = ♭ xs map : ∀ {a b} {A : Set a} {B : Set b} → (A → B) → Stream A → Stream B map f (x ∷ xs) = f x ∷ ♯ map f (♭ xs) zipWith : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} → (A → B → C) → Stream A → Stream B → Stream C zipWith _∙_ (x ∷ xs) (y ∷ ys) = (x ∙ y) ∷ ♯ zipWith _∙_ (♭ xs) (♭ ys) take : ∀ {a} {A : Set a} n → Stream A → Vec A n take zero xs = [] take (suc n) (x ∷ xs) = x ∷ take n (♭ xs) drop : ∀ {a} {A : Set a} → ℕ → Stream A → Stream A drop zero xs = xs drop (suc n) (x ∷ xs) = drop n (♭ xs) repeat : ∀ {a} {A : Set a} → A → Stream A repeat x = x ∷ ♯ repeat x iterate : ∀ {a} {A : Set a} → (A → A) → A → Stream A iterate f x = x ∷ ♯ iterate f (f x) -- Interleaves the two streams. infixr 5 _⋎_ _⋎_ : ∀ {a} {A : Set a} → Stream A → Stream A → Stream A (x ∷ xs) ⋎ ys = x ∷ ♯ (ys ⋎ ♭ xs) mutual -- Takes every other element from the stream, starting with the -- first one. evens : ∀ {a} {A : Set a} → Stream A → Stream A evens (x ∷ xs) = x ∷ ♯ odds (♭ xs) -- Takes every other element from the stream, starting with the -- second one. odds : ∀ {a} {A : Set a} → Stream A → Stream A odds (x ∷ xs) = evens (♭ xs) toColist : ∀ {a} {A : Set a} → Stream A → Colist A toColist (x ∷ xs) = x ∷ ♯ toColist (♭ xs) lookup : ∀ {a} {A : Set a} → ℕ → Stream A → A lookup zero (x ∷ xs) = x lookup (suc n) (x ∷ xs) = lookup n (♭ xs) infixr 5 _++_ _++_ : ∀ {a} {A : Set a} → Colist A → Stream A → Stream A [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ ♯ (♭ xs ++ ys) ------------------------------------------------------------------------ -- Equality and other relations -- xs ≈ ys means that xs and ys are equal. infix 4 _≈_ data _≈_ {a} {A : Set a} : Stream A → Stream A → Set a where _∷_ : ∀ {x y xs ys} (x≡ : x ≡ y) (xs≈ : ∞ (♭ xs ≈ ♭ ys)) → x ∷ xs ≈ y ∷ ys -- x ∈ xs means that x is a member of xs. infix 4 _∈_ data _∈_ {a} {A : Set a} : A → Stream A → Set a where here : ∀ {x xs} → x ∈ x ∷ xs there : ∀ {x y xs} (x∈xs : x ∈ ♭ xs) → x ∈ y ∷ xs -- xs ⊑ ys means that xs is a prefix of ys. infix 4 _⊑_ data _⊑_ {a} {A : Set a} : Colist A → Stream A → Set a where [] : ∀ {ys} → [] ⊑ ys _∷_ : ∀ x {xs ys} (p : ∞ (♭ xs ⊑ ♭ ys)) → x ∷ xs ⊑ x ∷ ys ------------------------------------------------------------------------ -- Some proofs setoid : ∀ {a} → Set a → Setoid _ _ setoid A = record { Carrier = Stream A ; _≈_ = _≈_ {A = A} ; isEquivalence = record { refl = refl ; sym = sym ; trans = trans } } where refl : Reflexive _≈_ refl {_ ∷ _} = P.refl ∷ ♯ refl sym : Symmetric _≈_ sym (x≡ ∷ xs≈) = P.sym x≡ ∷ ♯ sym (♭ xs≈) trans : Transitive _≈_ trans (x≡ ∷ xs≈) (y≡ ∷ ys≈) = P.trans x≡ y≡ ∷ ♯ trans (♭ xs≈) (♭ ys≈) head-cong : ∀ {a} {A : Set a} {xs ys : Stream A} → xs ≈ ys → head xs ≡ head ys head-cong (x≡ ∷ _) = x≡ tail-cong : ∀ {a} {A : Set a} {xs ys : Stream A} → xs ≈ ys → tail xs ≈ tail ys tail-cong (_ ∷ xs≈) = ♭ xs≈ map-cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {xs ys} → xs ≈ ys → map f xs ≈ map f ys map-cong f (x≡ ∷ xs≈) = P.cong f x≡ ∷ ♯ map-cong f (♭ xs≈) zipWith-cong : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} (_∙_ : A → B → C) {xs xs′ ys ys′} → xs ≈ xs′ → ys ≈ ys′ → zipWith _∙_ xs ys ≈ zipWith _∙_ xs′ ys′ zipWith-cong _∙_ (x≡ ∷ xs≈) (y≡ ∷ ys≈) = P.cong₂ _∙_ x≡ y≡ ∷ ♯ zipWith-cong _∙_ (♭ xs≈) (♭ ys≈) infixr 5 _⋎-cong_ _⋎-cong_ : ∀ {a} {A : Set a} {xs xs′ ys ys′ : Stream A} → xs ≈ xs′ → ys ≈ ys′ → xs ⋎ ys ≈ xs′ ⋎ ys′ (x ∷ xs≈) ⋎-cong ys≈ = x ∷ ♯ (ys≈ ⋎-cong ♭ xs≈) agda-stdlib-1.7.3/src/Codata/Stream.agda000066400000000000000000000141151451211343400177300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Stream type and some operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Stream where open import Size open import Codata.Thunk as Thunk using (Thunk; force) open import Data.Nat.Base open import Data.List.Base using (List; []; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; _∷⁺_) open import Data.Vec.Base using (Vec; []; _∷_) open import Data.Product as P hiding (map) open import Function.Base open import Level using (Level) open import Relation.Binary.PropositionalEquality using (_≡_; refl) private variable a b c : Level A : Set a B : Set b C : Set c i : Size ------------------------------------------------------------------------ -- Type data Stream (A : Set a) (i : Size) : Set a where _∷_ : A → Thunk (Stream A) i → Stream A i ------------------------------------------------------------------------ -- Creating streams repeat : A → Stream A i repeat a = a ∷ λ where .force → repeat a infixr 5 _++_ _⁺++_ _++_ : List A → Stream A i → Stream A i [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ λ where .force → xs ++ ys unfold : (A → A × B) → A → Stream B i unfold next seed = let (seed′ , b) = next seed in b ∷ λ where .force → unfold next seed′ iterate : (A → A) → A → Stream A ∞ iterate f = unfold < f , id > nats : Stream ℕ ∞ nats = iterate suc zero ------------------------------------------------------------------------ -- Looking at streams head : Stream A i → A head (x ∷ xs) = x tail : {j : Size< i} → Stream A i → Stream A j tail (x ∷ xs) = xs .force lookup : ℕ → Stream A ∞ → A lookup zero xs = head xs lookup (suc k) xs = lookup k (tail xs) ------------------------------------------------------------------------ -- Transforming streams map : (A → B) → Stream A i → Stream B i map f (x ∷ xs) = f x ∷ λ where .force → map f (xs .force) ap : Stream (A → B) i → Stream A i → Stream B i ap (f ∷ fs) (x ∷ xs) = f x ∷ λ where .force → ap (fs .force) (xs .force) scanl : (B → A → B) → B → Stream A i → Stream B i scanl c n (x ∷ xs) = n ∷ λ where .force → scanl c (c n x) (xs .force) zipWith : (A → B → C) → Stream A i → Stream B i → Stream C i zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ λ where .force → zipWith f (as .force) (bs .force) ------------------------------------------------------------------------ -- List⁺-related functions _⁺++_ : List⁺ A → Thunk (Stream A) i → Stream A i (x ∷ xs) ⁺++ ys = x ∷ λ where .force → xs ++ ys .force cycle : List⁺ A → Stream A i cycle xs = xs ⁺++ λ where .force → cycle xs concat : Stream (List⁺ A) i → Stream A i concat (xs ∷ xss) = xs ⁺++ λ where .force → concat (xss .force) ------------------------------------------------------------------------ -- Chunking splitAt : (n : ℕ) → Stream A ∞ → Vec A n × Stream A ∞ splitAt zero xs = [] , xs splitAt (suc n) (x ∷ xs) = P.map₁ (x ∷_) (splitAt n (xs .force)) take : (n : ℕ) → Stream A ∞ → Vec A n take n xs = proj₁ (splitAt n xs) drop : ℕ → Stream A ∞ → Stream A ∞ drop n xs = proj₂ (splitAt n xs) chunksOf : (n : ℕ) → Stream A ∞ → Stream (Vec A n) ∞ chunksOf n = chunksOfAcc n id module ChunksOf where chunksOfAcc : ∀ k (acc : Vec A k → Vec A n) → Stream A ∞ → Stream (Vec A n) i chunksOfAcc zero acc xs = acc [] ∷ λ where .force → chunksOfAcc n id xs chunksOfAcc (suc k) acc (x ∷ xs) = chunksOfAcc k (acc ∘ (x ∷_)) (xs .force) ------------------------------------------------------------------------ -- Interleaving streams -- The most basic of interleaving strategies is to take two streams and -- alternate between emitting values from one and the other. interleave : Stream A i → Thunk (Stream A) i → Stream A i interleave (x ∷ xs) ys = x ∷ λ where .force → interleave (ys .force) xs -- This interleaving strategy can be generalised to an arbitrary non-empty -- list of streams interleave⁺ : List⁺ (Stream A i) → Stream A i interleave⁺ xss = List⁺.map head xss ⁺++ λ where .force → interleave⁺ (List⁺.map tail xss) -- To generalise this further to a stream of streams however we have to -- adopt a different strategy: if we were to start with *all* the heads -- then we would never reach any of the second elements in the streams. -- Here we use Cantor's zig zag function to explore the plane defined by -- the function `(i,j) ↦ lookup j (lookup i xss)‵ mapping coordinates to -- values in a way that guarantees that any point is reached in a finite -- amount of time. The definition is taken from the paper: -- Applications of Applicative Proof Search by Liam O'Connor cantor : Stream (Stream A ∞) ∞ → Stream A ∞ cantor (l ∷ ls) = zig (l ∷ []) (ls .force) module Cantor where zig : List⁺ (Stream A ∞) → Stream (Stream A ∞) ∞ → Stream A i zag : List⁺ A → List⁺ (Stream A ∞) → Stream (Stream A ∞) ∞ → Stream A i zig xss = zag (List⁺.map head xss) (List⁺.map tail xss) zag (x ∷ []) zs (l ∷ ls) = x ∷ λ where .force → zig (l ∷⁺ zs) (ls .force) zag (x ∷ (y ∷ xs)) zs ls = x ∷ λ where .force → zag (y ∷ xs) zs ls -- We can use the Cantor zig zag function to define a form of `bind' that -- reaches any point of the plane in a finite amount of time. plane : {B : A → Set b} → Stream A ∞ → ((a : A) → Stream (B a) ∞) → Stream (Σ A B) ∞ plane as bs = cantor (map (λ a → map (a ,_) (bs a)) as) -- Here is the beginning of the path we are following: _ : take 21 (plane nats (λ _ → nats)) ≡ (0 , 0) ∷ (1 , 0) ∷ (0 , 1) ∷ (2 , 0) ∷ (1 , 1) ∷ (0 , 2) ∷ (3 , 0) ∷ (2 , 1) ∷ (1 , 2) ∷ (0 , 3) ∷ (4 , 0) ∷ (3 , 1) ∷ (2 , 2) ∷ (1 , 3) ∷ (0 , 4) ∷ (5 , 0) ∷ (4 , 1) ∷ (3 , 2) ∷ (2 , 3) ∷ (1 , 4) ∷ (0 , 5) ∷ [] _ = refl agda-stdlib-1.7.3/src/Codata/Stream/000077500000000000000000000000001451211343400171105ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Codata/Stream/Bisimilarity.agda000066400000000000000000000057551451211343400224030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bisimilarity for Streams ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Stream.Bisimilarity where open import Size open import Codata.Thunk open import Codata.Stream open import Level open import Data.List.NonEmpty as List⁺ using (_∷_) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as Eq using (_≡_) private variable a b c p q r : Level A : Set a B : Set b C : Set c i : Size data Bisim {A : Set a} {B : Set b} (R : REL A B r) i : REL (Stream A ∞) (Stream B ∞) (a ⊔ b ⊔ r) where _∷_ : ∀ {x y xs ys} → R x y → Thunk^R (Bisim R) i xs ys → Bisim R i (x ∷ xs) (y ∷ ys) module _ {R : Rel A r} where reflexive : Reflexive R → Reflexive (Bisim R i) reflexive refl^R {r ∷ rs} = refl^R ∷ λ where .force → reflexive refl^R module _ {P : REL A B p} {Q : REL B A q} where symmetric : Sym P Q → Sym (Bisim P i) (Bisim Q i) symmetric sym^PQ (p ∷ ps) = sym^PQ p ∷ λ where .force → symmetric sym^PQ (ps .force) module _ {P : REL A B p} {Q : REL B C q} {R : REL A C r} where transitive : Trans P Q R → Trans (Bisim P i) (Bisim Q i) (Bisim R i) transitive trans^PQR (p ∷ ps) (q ∷ qs) = trans^PQR p q ∷ λ where .force → transitive trans^PQR (ps .force) (qs .force) isEquivalence : {R : Rel A r} → IsEquivalence R → IsEquivalence (Bisim R i) isEquivalence equiv^R = record { refl = reflexive equiv^R.refl ; sym = symmetric equiv^R.sym ; trans = transitive equiv^R.trans } where module equiv^R = IsEquivalence equiv^R setoid : Setoid a r → Size → Setoid a (a ⊔ r) setoid S i = record { isEquivalence = isEquivalence {i = i} (Setoid.isEquivalence S) } module _ {R : REL A B r} where ++⁺ : ∀ {as bs xs ys} → Pointwise R as bs → Bisim R i xs ys → Bisim R i (as ++ xs) (bs ++ ys) ++⁺ [] rs = rs ++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw rs ⁺++⁺ : ∀ {as bs xs ys} → Pointwise R (List⁺.toList as) (List⁺.toList bs) → Thunk^R (Bisim R) i xs ys → Bisim R i (as ⁺++ xs) (bs ⁺++ ys) ⁺++⁺ (r ∷ pw) rs = r ∷ λ where .force → ++⁺ pw (rs .force) ------------------------------------------------------------------------ -- Pointwise Equality as a Bisimilarity module _ {A : Set a} where infix 1 _⊢_≈_ _⊢_≈_ : ∀ i → Stream A ∞ → Stream A ∞ → Set a _⊢_≈_ = Bisim _≡_ refl : ∀ {i} → Reflexive (i ⊢_≈_) refl = reflexive Eq.refl sym : ∀ {i} → Symmetric (i ⊢_≈_) sym = symmetric Eq.sym trans : ∀ {i} → Transitive (i ⊢_≈_) trans = transitive Eq.trans module ≈-Reasoning {a} {A : Set a} {i} where open import Relation.Binary.Reasoning.Setoid (setoid (Eq.setoid A) i) public agda-stdlib-1.7.3/src/Codata/Stream/Categorical.agda000066400000000000000000000015421451211343400221450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Stream ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Stream.Categorical where open import Data.Product using (<_,_>) open import Codata.Stream open import Function open import Category.Functor open import Category.Applicative open import Category.Comonad functor : ∀ {ℓ i} → RawFunctor {ℓ} (λ A → Stream A i) functor = record { _<$>_ = λ f → map f } applicative : ∀ {ℓ i} → RawApplicative {ℓ} (λ A → Stream A i) applicative = record { pure = repeat ; _⊛_ = ap } comonad : ∀ {ℓ} → RawComonad {ℓ} (λ A → Stream A _) comonad = record { extract = head ; extend = unfold ∘′ < tail ,_> } agda-stdlib-1.7.3/src/Codata/Stream/Instances.agda000066400000000000000000000006651451211343400216640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for Stream ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Stream.Instances where open import Codata.Stream.Categorical instance streamFunctor = functor streamApplicative = applicative streamComonad = comonad agda-stdlib-1.7.3/src/Codata/Stream/Properties.agda000066400000000000000000000141431451211343400220650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on the Stream type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Stream.Properties where open import Level using (Level) open import Size open import Codata.Thunk as Thunk using (Thunk; force) open import Codata.Stream open import Codata.Stream.Bisimilarity open import Data.Nat.Base open import Data.Nat.GeneralisedArithmetic using (fold; fold-pull) open import Data.List.Base as List using ([]; _∷_) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) import Data.List.Relation.Binary.Equality.Propositional as Eq open import Data.Product as Prod using (_,_) open import Data.Vec.Base as Vec using (_∷_) open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_) private variable a b c : Level A : Set a B : Set b C : Set c i : Size ------------------------------------------------------------------------ -- repeat lookup-repeat-identity : (n : ℕ) (a : A) → lookup n (repeat a) ≡ a lookup-repeat-identity zero a = P.refl lookup-repeat-identity (suc n) a = lookup-repeat-identity n a take-repeat-identity : (n : ℕ) (a : A) → take n (repeat a) ≡ Vec.replicate a take-repeat-identity zero a = P.refl take-repeat-identity (suc n) a = P.cong (a Vec.∷_) (take-repeat-identity n a) splitAt-repeat-identity : (n : ℕ) (a : A) → splitAt n (repeat a) ≡ (Vec.replicate a , repeat a) splitAt-repeat-identity zero a = P.refl splitAt-repeat-identity (suc n) a = P.cong (Prod.map₁ (a ∷_)) (splitAt-repeat-identity n a) replicate-repeat : ∀ {i} (n : ℕ) (a : A) → i ⊢ List.replicate n a ++ repeat a ≈ repeat a replicate-repeat zero a = refl replicate-repeat (suc n) a = P.refl ∷ λ where .force → replicate-repeat n a cycle-replicate : ∀ {i} (n : ℕ) (n≢0 : n ≢ 0) (a : A) → i ⊢ cycle (List⁺.replicate n n≢0 a) ≈ repeat a cycle-replicate {i} n n≢0 a = let as = List⁺.replicate n n≢0 a in begin cycle as ≡⟨⟩ as ⁺++ _ ≈⟨ ⁺++⁺ Eq.≋-refl (λ where .force → cycle-replicate n n≢0 a) ⟩ as ⁺++ (λ where .force → repeat a) ≈⟨ P.refl ∷ (λ where .force → replicate-repeat (pred n) a) ⟩ repeat a ∎ where open ≈-Reasoning module _ {a b} {A : Set a} {B : Set b} where map-repeat : ∀ (f : A → B) a {i} → i ⊢ map f (repeat a) ≈ repeat (f a) map-repeat f a = P.refl ∷ λ where .force → map-repeat f a ap-repeat : ∀ (f : A → B) a {i} → i ⊢ ap (repeat f) (repeat a) ≈ repeat (f a) ap-repeat f a = P.refl ∷ λ where .force → ap-repeat f a ap-repeatˡ : ∀ (f : A → B) as {i} → i ⊢ ap (repeat f) as ≈ map f as ap-repeatˡ f (a ∷ as) = P.refl ∷ λ where .force → ap-repeatˡ f (as .force) ap-repeatʳ : ∀ (fs : Stream (A → B) ∞) (a : A) {i} → i ⊢ ap fs (repeat a) ≈ map (_$ a) fs ap-repeatʳ (f ∷ fs) a = P.refl ∷ λ where .force → ap-repeatʳ (fs .force) a map-++ : ∀ {i} (f : A → B) as xs → i ⊢ map f (as ++ xs) ≈ List.map f as ++ map f xs map-++ f [] xs = refl map-++ f (a ∷ as) xs = P.refl ∷ λ where .force → map-++ f as xs map-⁺++ : ∀ {i} (f : A → B) as xs → i ⊢ map f (as ⁺++ xs) ≈ List⁺.map f as ⁺++ Thunk.map (map f) xs map-⁺++ f (a ∷ as) xs = P.refl ∷ (λ where .force → map-++ f as (xs .force)) map-cycle : ∀ {i} (f : A → B) as → i ⊢ map f (cycle as) ≈ cycle (List⁺.map f as) map-cycle f as = begin map f (cycle as) ≈⟨ map-⁺++ f as _ ⟩ List⁺.map f as ⁺++ _ ≈⟨ ⁺++⁺ Eq.≋-refl (λ where .force → map-cycle f as) ⟩ cycle (List⁺.map f as) ∎ where open ≈-Reasoning ------------------------------------------------------------------------ -- Functor laws map-identity : ∀ (as : Stream A ∞) → i ⊢ map id as ≈ as map-identity (a ∷ as) = P.refl ∷ λ where .force → map-identity (as .force) map-map-fusion : ∀ (f : A → B) (g : B → C) as → i ⊢ map g (map f as) ≈ map (g ∘ f) as map-map-fusion f g (a ∷ as) = P.refl ∷ λ where .force → map-map-fusion f g (as .force) ------------------------------------------------------------------------ -- splitAt splitAt-map : ∀ n (f : A → B) xs → splitAt n (map f xs) ≡ Prod.map (Vec.map f) (map f) (splitAt n xs) splitAt-map zero f xs = P.refl splitAt-map (suc n) f (x ∷ xs) = P.cong (Prod.map₁ (f x Vec.∷_)) (splitAt-map n f (xs .force)) ------------------------------------------------------------------------ -- iterate lookup-iterate-identity : ∀ n f (a : A) → lookup n (iterate f a) ≡ fold a f n lookup-iterate-identity zero f a = P.refl lookup-iterate-identity (suc n) f a = begin lookup (suc n) (iterate f a) ≡⟨⟩ lookup n (iterate f (f a)) ≡⟨ lookup-iterate-identity n f (f a) ⟩ fold (f a) f n ≡⟨ fold-pull (const ∘′ f) (f a) P.refl (λ _ → P.refl) n ⟩ f (fold a f n) ≡⟨⟩ fold a f (suc n) ∎ where open P.≡-Reasoning ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 repeat-ap-identity = ap-repeatˡ {-# WARNING_ON_USAGE repeat-ap-identity "Warning: repeat-ap-identity was deprecated in v1.1. Please use ap-repeatˡ instead." #-} ap-repeat-identity = ap-repeatʳ {-# WARNING_ON_USAGE ap-repeat-identity "Warning: ap-repeat-identity was deprecated in v1.1. Please use ap-repeatʳ instead." #-} ap-repeat-commute = ap-repeat {-# WARNING_ON_USAGE ap-repeat-commute "Warning: ap-repeat-commute was deprecated in v1.1. Please use ap-repeat instead." #-} map-repeat-commute = map-repeat {-# WARNING_ON_USAGE map-repeat-commute "Warning: map-repeat-commute was deprecated in v1.1. Please use map-repeat instead." #-} agda-stdlib-1.7.3/src/Codata/Thunk.agda000066400000000000000000000040421451211343400175640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Thunk wrappers for sized codata, copredicates and corelations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Codata.Thunk where open import Size open import Relation.Unary.Sized ------------------------------------------------------------------------ -- Basic types. record Thunk {ℓ} (F : SizedSet ℓ) (i : Size) : Set ℓ where coinductive field force : {j : Size< i} → F j open Thunk public Thunk^P : ∀ {f p} {F : SizedSet f} (P : Size → F ∞ → Set p) (i : Size) (tf : Thunk F ∞) → Set p Thunk^P P i tf = Thunk (λ i → P i (tf .force)) i Thunk^R : ∀ {f g r} {F : SizedSet f} {G : SizedSet g} (R : Size → F ∞ → G ∞ → Set r) (i : Size) (tf : Thunk F ∞) (tg : Thunk G ∞) → Set r Thunk^R R i tf tg = Thunk (λ i → R i (tf .force) (tg .force)) i ------------------------------------------------------------------------ -- Syntax Thunk-syntax : ∀ {ℓ} → SizedSet ℓ → Size → Set ℓ Thunk-syntax = Thunk syntax Thunk-syntax (λ j → e) i = Thunk[ j < i ] e ------------------------------------------------------------------------ -- Basic functions. -- Thunk is a functor module _ {p q} {P : SizedSet p} {Q : SizedSet q} where map : ∀[ P ⇒ Q ] → ∀[ Thunk P ⇒ Thunk Q ] map f p .force = f (p .force) -- Thunk is a comonad module _ {p} {P : SizedSet p} where extract : ∀[ Thunk P ] → P ∞ extract p = p .force duplicate : ∀[ Thunk P ⇒ Thunk (Thunk P) ] duplicate p .force .force = p .force module _ {p q} {P : SizedSet p} {Q : SizedSet q} where infixl 1 _<*>_ _<*>_ : ∀[ Thunk (P ⇒ Q) ⇒ Thunk P ⇒ Thunk Q ] (f <*> p) .force = f .force (p .force) -- We can take cofixpoints of functions only making Thunk'd recursive calls module _ {p} (P : SizedSet p) where cofix : ∀[ Thunk P ⇒ P ] → ∀[ P ] cofix f = f λ where .force → cofix f agda-stdlib-1.7.3/src/Data/000077500000000000000000000000001451211343400153335ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/AVL.agda000066400000000000000000000010421451211343400165700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL was deprecated in v1.4. Use Data.Tree.AVL instead." #-} open import Data.Tree.AVL strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/000077500000000000000000000000001451211343400157555ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/AVL/Height.agda000066400000000000000000000006531451211343400200070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.AVL.Height where {-# WARNING_ON_IMPORT "Data.AVL.Height was deprecated in v1.4. Use Data.Tree.AVL.Height instead." #-} open import Data.Tree.AVL.Height public agda-stdlib-1.7.3/src/Data/AVL/Indexed.agda000066400000000000000000000011011451211343400201440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL.Indexed {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL.Indexed was deprecated in v1.4. Use Data.Tree.AVL.Indexed instead." #-} open import Data.Tree.AVL.Indexed strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/Indexed/000077500000000000000000000000001451211343400173355ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/AVL/Indexed/WithK.agda000066400000000000000000000012441451211343400212020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} open import Relation.Binary open import Relation.Binary.PropositionalEquality using (_≡_; refl; subst) module Data.AVL.Indexed.WithK {k r} (Key : Set k) {_<_ : Rel Key r} (isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_) where {-# WARNING_ON_IMPORT "Data.AVL.Indexed.WithK was deprecated in v1.4. Use Data.Tree.AVL.Indexed.WithK instead." #-} open import Data.Tree.AVL.Indexed.WithK Key isStrictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/IndexedMap.agda000066400000000000000000000014411451211343400206110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.Product as Prod open import Relation.Binary open import Relation.Binary.PropositionalEquality using (_≡_; cong; subst) import Data.Tree.AVL.Value module Data.AVL.IndexedMap {i k v ℓ} {Index : Set i} {Key : Index → Set k} (Value : Index → Set v) {_<_ : Rel (∃ Key) ℓ} (isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_) where {-# WARNING_ON_IMPORT "Data.AVL.IndexedMap was deprecated in v1.4. Use Data.Tree.AVL.IndexedMap instead." #-} open import Data.Tree.AVL.IndexedMap Value isStrictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/Key.agda000066400000000000000000000010301451211343400173150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ----------------------------------------------------------------------- {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.AVL.Key {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL.Key was deprecated in v1.4. Use Data.Tree.AVL.Key instead." #-} open import Data.Tree.AVL.Key strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/Map.agda000066400000000000000000000010621451211343400173070ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL.Map {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL.Map was deprecated in v1.4. Use Data.Tree.AVL.Map instead." #-} open import Data.Tree.AVL.Map strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/NonEmpty.agda000066400000000000000000000011041451211343400203400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL.NonEmpty {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL.NonEmpty was deprecated in v1.4. Use Data.Tree.AVL.NonEmpty instead." #-} open import Data.Tree.AVL.NonEmpty strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/NonEmpty/000077500000000000000000000000001451211343400175265ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/AVL/NonEmpty/Propositional.agda000066400000000000000000000013671451211343400232150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; IsStrictTotalOrder; StrictTotalOrder) open import Relation.Binary.PropositionalEquality using (_≡_; refl; subst) module Data.AVL.NonEmpty.Propositional {k r} {Key : Set k} {_<_ : Rel Key r} (isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_) where {-# WARNING_ON_IMPORT "Data.AVL.NonEmpty.Propositional was deprecated in v1.4. Use Data.Tree.AVL.NonEmpty.Propositonal instead." #-} open import Data.Tree.AVL.NonEmpty.Propositional isStrictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/Sets.agda000066400000000000000000000010661451211343400175140ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.AVL.Sets {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where {-# WARNING_ON_IMPORT "Data.AVL.Sets was deprecated in v1.4. Use Data.Tree.AVL.Sets instead." #-} open import Data.Tree.AVL.Sets strictTotalOrder public agda-stdlib-1.7.3/src/Data/AVL/Value.agda000066400000000000000000000007571451211343400176600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. ----------------------------------------------------------------------- {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Setoid) module Data.AVL.Value {a ℓ} (S : Setoid a ℓ) where {-# WARNING_ON_IMPORT "Data.AVL.Value was deprecated in v1.4. Use Data.Tree.AVL.Value instead." #-} open import Data.Tree.AVL.Value S public agda-stdlib-1.7.3/src/Data/Bin.agda000066400000000000000000000170251451211343400166660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Nat.Binary` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from deprecated names {-# OPTIONS --warn=noUserWarning #-} module Data.Bin where {-# WARNING_ON_IMPORT "Data.Bin was deprecated in v1.2. Use Data.Nat.Binary instead." #-} open import Data.Nat as Nat using (ℕ; zero; z≤n; s≤s) renaming (suc to 1+_) open import Data.Digit using (fromDigits; toDigits; Bit) open import Data.Fin.Base as Fin using (Fin; zero) renaming (suc to 1+_) open import Data.Fin.Properties as FP using (_+′_) open import Data.List.Base as List hiding (downFrom) open import Function.Base open import Data.Product using (uncurry; _,_; _×_) open import Relation.Binary open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; sym) open import Relation.Nullary open import Relation.Nullary.Decidable ------------------------------------------------------------------------ -- Bits pattern 0b = zero pattern 1b = 1+ zero pattern ⊥b = 1+ 1+ () ------------------------------------------------------------------------ -- The type -- A representation of binary natural numbers in which there is -- exactly one representative for every number. The function toℕ below -- defines the meaning of Bin. -- `bs 1#` stands for the binary number "1" e.g. -- `(0b ∷ []) 1#` represents "10" -- `(0b ∷ 1b ∷ 1b ∷ []) 1#` represents "1110" Bin⁺ : Set Bin⁺ = List Bit infix 8 _1# data Bin : Set where 0# : Bin _1# : (bs : Bin⁺) → Bin ------------------------------------------------------------------------ -- Conversion functions -- Converting to a list of bits starting with the _least_ significant -- one. toBits : Bin → List Bit toBits 0# = [ 0b ] toBits (bs 1#) = bs ++ [ 1b ] -- Converting to a natural number. toℕ : Bin → ℕ toℕ = fromDigits ∘ toBits -- Converting from a list of bits, starting with the _least_ -- significant one. fromBits : List Bit → Bin fromBits [] = 0# fromBits (b ∷ bs) with fromBits bs fromBits (b ∷ bs) | bs′ 1# = (b ∷ bs′) 1# fromBits (0b ∷ bs) | 0# = 0# fromBits (1b ∷ bs) | 0# = [] 1# fromBits (⊥b ∷ bs) | _ private pattern 2+_ n = 1+ 1+ n ntoBits′ : ℕ → ℕ → List Bit ntoBits′ 0 _ = [] ntoBits′ 1 0 = 0b ∷ 1b ∷ [] ntoBits′ 1 1 = 1b ∷ [] ntoBits′ (2+ k) 0 = 0b ∷ ntoBits′ (1+ k) k ntoBits′ (2+ k) 1 = 1b ∷ ntoBits′ (1+ k) (1+ k) ntoBits′ (1+ k) (2+ n) = ntoBits′ k n ntoBits : ℕ → List Bit ntoBits n = ntoBits′ n n -- Converting from a natural number. fromℕ : ℕ → Bin fromℕ n = fromBits $ ntoBits n ------------------------------------------------------------------------ -- Order relation. -- Wrapped so that the parameters can be inferred. infix 4 _<_ data _<_ (b₁ b₂ : Bin) : Set where less : (lt : (Nat._<_ on toℕ) b₁ b₂) → b₁ < b₂ less-injective : ∀ {b₁ b₂} {lt₁ lt₂} → (b₁ < b₂ ∋ less lt₁) ≡ less lt₂ → lt₁ ≡ lt₂ less-injective refl = refl ------------------------------------------------------------------------ -- Arithmetic -- Power of two. infixr 8 2^_ 2^_ : ℕ → Bin⁺ 2^ 0 = [] 2^ (1+ n) = 0b ∷ 2^ n -- Base 2 logarithm (rounded downwards). ⌊log₂_⌋ : Bin⁺ → ℕ ⌊log₂ (b ∷ bs) ⌋ = 1+ ⌊log₂ bs ⌋ ⌊log₂ [] ⌋ = 0 -- Multiplication by 2. infix 7 _*2 _*2+1 _*2 : Bin → Bin 0# *2 = 0# (bs 1#) *2 = (0b ∷ bs) 1# _*2+1 : Bin → Bin 0# *2+1 = [] 1# (bs 1#) *2+1 = (1b ∷ bs) 1# -- Division by 2, rounded downwards. ⌊_/2⌋ : Bin → Bin ⌊ 0# /2⌋ = 0# ⌊ [] 1# /2⌋ = 0# ⌊ (b ∷ bs) 1# /2⌋ = bs 1# -- Addition. Carry : Set Carry = Bit addBits : Carry → Bit → Bit → Carry × Bit addBits c b₁ b₂ with c +′ (b₁ +′ b₂) ... | zero = (0b , 0b) ... | 1+ zero = (0b , 1b) ... | 1+ 1+ zero = (1b , 0b) ... | 1+ 1+ 1+ zero = (1b , 1b) ... | 1+ 1+ 1+ 1+ () addCarryToBitList : Carry → List Bit → List Bit addCarryToBitList 0b bs = bs addCarryToBitList 1b [] = 1b ∷ [] addCarryToBitList 1b (0b ∷ bs) = 1b ∷ bs addCarryToBitList 1b (1b ∷ bs) = 0b ∷ addCarryToBitList 1b bs addCarryToBitList ⊥b _ addCarryToBitList _ (⊥b ∷ _) addBitLists : Carry → List Bit → List Bit → List Bit addBitLists c [] bs₂ = addCarryToBitList c bs₂ addBitLists c bs₁ [] = addCarryToBitList c bs₁ addBitLists c (b₁ ∷ bs₁) (b₂ ∷ bs₂) with addBits c b₁ b₂ ... | (c' , b') = b' ∷ addBitLists c' bs₁ bs₂ infixl 6 _+_ _+_ : Bin → Bin → Bin m + n = fromBits (addBitLists 0b (toBits m) (toBits n)) -- Multiplication. infixl 7 _*_ _*_ : Bin → Bin → Bin 0# * n = 0# [] 1# * n = n -- (b + 2 * bs 1#) * n = b * n + 2 * (bs 1# * n) (b ∷ bs) 1# * n with bs 1# * n (b ∷ bs) 1# * n | 0# = 0# (0b ∷ bs) 1# * n | bs' 1# = (0b ∷ bs') 1# (1b ∷ bs) 1# * n | bs' 1# = n + (0b ∷ bs') 1# (⊥b ∷ _) 1# * _ | _ -- Successor. suc : Bin → Bin suc n = [] 1# + n -- Division by 2, rounded upwards. ⌈_/2⌉ : Bin → Bin ⌈ n /2⌉ = ⌊ suc n /2⌋ -- Predecessor. pred : Bin⁺ → Bin pred [] = 0# pred (0b ∷ bs) = pred bs *2+1 pred (1b ∷ bs) = (zero ∷ bs) 1# pred (⊥b ∷ bs) -- downFrom n enumerates all numbers from n - 1 to 0. This function is -- linear in n. Analysis: fromℕ takes linear time, and the preds used -- take amortised constant time (to see this, let the cost of a pred -- be 2, and put 1 debit on every bit which is 1). downFrom : ℕ → List Bin downFrom n = helper n (fromℕ n) where helper : ℕ → Bin → List Bin helper zero 0# = [] helper (1+ n) (bs 1#) = n′ ∷ helper n n′ where n′ = pred bs -- Impossible cases: helper zero (_ 1#) = [] helper (1+ _) 0# = [] ------------------------------------------------------------------------ -- Tests -- The tests below are run when this module is type checked. -- First some test helpers: private testLimit : ℕ testLimit = 5 nats : List ℕ nats = List.downFrom testLimit nats⁺ : List ℕ nats⁺ = filter (1 Nat.≤?_) nats natPairs : List (ℕ × ℕ) natPairs = List.zip nats (reverse nats) _=[_]_ : (ℕ → ℕ) → List ℕ → (Bin → Bin) → Set f =[ ns ] g = List.map f ns ≡ List.map (toℕ ∘ g ∘ fromℕ) ns _=[_]₂_ : (ℕ → ℕ → ℕ) → List (ℕ × ℕ) → (Bin → Bin → Bin) → Set f =[ ps ]₂ g = List.map (uncurry f) ps ≡ List.map (toℕ ∘ uncurry (g on fromℕ)) ps -- And then the tests: private test-*2+1 : (λ n → Nat._+_ (Nat._*_ n 2) 1) =[ nats ] _*2+1 test-*2+1 = refl test-*2 : (λ n → Nat._*_ n 2) =[ nats ] _*2 test-*2 = refl test-⌊_/2⌋ : Nat.⌊_/2⌋ =[ nats ] ⌊_/2⌋ test-⌊_/2⌋ = refl test-+ : Nat._+_ =[ natPairs ]₂ _+_ test-+ = refl test-* : Nat._*_ =[ natPairs ]₂ _*_ test-* = refl test-suc : 1+_ =[ nats ] suc test-suc = refl test-⌈_/2⌉ : Nat.⌈_/2⌉ =[ nats ] ⌈_/2⌉ test-⌈_/2⌉ = refl drop-1# : Bin → Bin⁺ drop-1# 0# = [] drop-1# (bs 1#) = bs test-pred : Nat.pred =[ nats⁺ ] (pred ∘ drop-1#) test-pred = refl test-downFrom : List.map toℕ (downFrom testLimit) ≡ List.downFrom testLimit test-downFrom = refl agda-stdlib-1.7.3/src/Data/Bin/000077500000000000000000000000001451211343400160435ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Bin/Properties.agda000066400000000000000000000127261451211343400210250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Nat.Binary` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Bin.Properties where {-# WARNING_ON_IMPORT "Data.Bin.Properties was deprecated in v1.2. Use Data.Nat.Binary.Properties instead." #-} open import Data.Bin open import Data.Digit using (Bit; Expansion) import Data.Fin.Base as Fin import Data.Fin.Properties as 𝔽ₚ open import Data.List.Base using (List; []; _∷_) open import Data.List.Properties using (∷-injective) open import Data.Nat.Base using (ℕ; zero; z≤n; s≤s) renaming (suc to 1+_; _+_ to _+ℕ_; _*_ to _*ℕ_; _≤_ to _≤ℕ_) import Data.Nat.Properties as ℕₚ open import Data.Product using (proj₁; proj₂; uncurry) open import Function.Base using (_∘_) open import Relation.Binary open import Relation.Binary.Consequences open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl; sym; isEquivalence; resp₂; decSetoid; cong; cong₂) open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (map′) open import Relation.Nullary.Product using (_×-dec_) ------------------------------------------------------------------------ -- (Bin, _≡_) is a decidable setoid 1#-injective : ∀ {as bs} → as 1# ≡ bs 1# → as ≡ bs 1#-injective refl = refl infix 4 _≟_ _≟ₑ_ _≟ₑ_ : ∀ {base} → Decidable (_≡_ {A = Expansion base}) _≟ₑ_ [] [] = yes refl _≟ₑ_ [] (_ ∷ _) = no λ() _≟ₑ_ (_ ∷ _) [] = no λ() _≟ₑ_ (x ∷ xs) (y ∷ ys) = map′ (uncurry (cong₂ _∷_)) ∷-injective (x Fin.≟ y ×-dec xs ≟ₑ ys) _≟_ : Decidable {A = Bin} _≡_ 0# ≟ 0# = yes refl 0# ≟ bs 1# = no λ() as 1# ≟ 0# = no λ() as 1# ≟ bs 1# = map′ (cong _1#) 1#-injective (as ≟ₑ bs) ≡-isDecEquivalence : IsDecEquivalence _≡_ ≡-isDecEquivalence = record { isEquivalence = isEquivalence ; _≟_ = _≟_ } ≡-decSetoid : DecSetoid _ _ ≡-decSetoid = decSetoid _≟_ ------------------------------------------------------------------------ -- (Bin _≡_ _<_) is a strict total order <-trans : Transitive _<_ <-trans (less lt₁) (less lt₂) = less (ℕₚ.<-trans lt₁ lt₂) <-asym : Asymmetric _<_ <-asym (less lt) (less gt) = ℕₚ.<-asym lt gt <-irrefl : Irreflexive _≡_ _<_ <-irrefl refl (less lt) = ℕₚ.<-irrefl refl lt ∷ʳ-mono-< : ∀ {a b as bs} → as 1# < bs 1# → (a ∷ as) 1# < (b ∷ bs) 1# ∷ʳ-mono-< {a} {b} {as} {bs} (less lt) = less (begin 1+ (m₁ +ℕ n₁ *ℕ 2) ≤⟨ s≤s (ℕₚ.+-monoˡ-≤ _ (𝔽ₚ.toℕ≤pred[n] a)) ⟩ 1+ (1 +ℕ n₁ *ℕ 2) ≡⟨ refl ⟩ 1+ n₁ *ℕ 2 ≤⟨ ℕₚ.*-mono-≤ lt ℕₚ.≤-refl ⟩ n₂ *ℕ 2 ≤⟨ ℕₚ.m≤n+m (n₂ *ℕ 2) m₂ ⟩ m₂ +ℕ n₂ *ℕ 2 ∎) where open ℕₚ.≤-Reasoning m₁ = Fin.toℕ a; m₂ = Fin.toℕ b n₁ = toℕ (as 1#); n₂ = toℕ (bs 1#) ∷ˡ-mono-< : ∀ {a b bs} → a Fin.< b → (a ∷ bs) 1# < (b ∷ bs) 1# ∷ˡ-mono-< {a} {b} {bs} lt = less (begin 1 +ℕ (m₁ +ℕ n *ℕ 2) ≡⟨ sym (ℕₚ.+-assoc 1 m₁ (n *ℕ 2)) ⟩ (1 +ℕ m₁) +ℕ n *ℕ 2 ≤⟨ ℕₚ.+-monoˡ-≤ _ lt ⟩ m₂ +ℕ n *ℕ 2 ∎) where open ℕₚ.≤-Reasoning m₁ = Fin.toℕ a; m₂ = Fin.toℕ b; n = toℕ (bs 1#) 1<[23] : ∀ {b} → [] 1# < (b ∷ []) 1# 1<[23] {b} = less (ℕₚ.m≤n+m 2 (Fin.toℕ b)) 1<2+ : ∀ {b bs} → [] 1# < (b ∷ bs) 1# 1<2+ {_} {[]} = 1<[23] 1<2+ {_} {b ∷ bs} = <-trans 1<[23] (∷ʳ-mono-< {a = b} 1<2+) 0<1+ : ∀ {bs} → 0# < bs 1# 0<1+ {[]} = less (s≤s z≤n) 0<1+ {b ∷ bs} = <-trans (less (s≤s z≤n)) 1<2+ <⇒≢ : ∀ {a b} → a < b → a ≢ b <⇒≢ lt eq = asym⇒irr (resp₂ _<_) sym <-asym eq lt <-cmp : Trichotomous _≡_ _<_ <-cmp 0# 0# = tri≈ (<-irrefl refl) refl (<-irrefl refl) <-cmp 0# (_ 1#) = tri< 0<1+ (<⇒≢ 0<1+) (<-asym 0<1+) <-cmp (_ 1#) 0# = tri> (<-asym 0<1+) (<⇒≢ 0<1+ ∘ sym) 0<1+ <-cmp ([] 1#) ([] 1#) = tri≈ (<-irrefl refl) refl (<-irrefl refl) <-cmp ([] 1#) ((b ∷ bs) 1#) = tri< 1<2+ (<⇒≢ 1<2+) (<-asym 1<2+) <-cmp ((a ∷ as) 1#) ([] 1#) = tri> (<-asym 1<2+) (<⇒≢ 1<2+ ∘ sym) 1<2+ <-cmp ((a ∷ as) 1#) ((b ∷ bs) 1#) with <-cmp (as 1#) (bs 1#) ... | tri< lt ¬eq ¬gt = tri< (∷ʳ-mono-< lt) (<⇒≢ (∷ʳ-mono-< lt)) (<-asym (∷ʳ-mono-< lt)) ... | tri> ¬lt ¬eq gt = tri> (<-asym (∷ʳ-mono-< gt)) (<⇒≢ (∷ʳ-mono-< gt) ∘ sym) (∷ʳ-mono-< gt) ... | tri≈ ¬lt refl ¬gt with 𝔽ₚ.<-cmp a b ... | tri≈ ¬lt′ refl ¬gt′ = tri≈ (<-irrefl refl) refl (<-irrefl refl) ... | tri< lt′ ¬eq ¬gt′ = tri< (∷ˡ-mono-< lt′) (<⇒≢ (∷ˡ-mono-< lt′)) (<-asym (∷ˡ-mono-< lt′)) ... | tri> ¬lt′ ¬eq gt′ = tri> (<-asym (∷ˡ-mono-< gt′)) (<⇒≢ (∷ˡ-mono-< gt′) ∘ sym) (∷ˡ-mono-< gt′) <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ <-isStrictTotalOrder = record { isEquivalence = isEquivalence ; trans = <-trans ; compare = <-cmp } <-strictTotalOrder : StrictTotalOrder _ _ _ <-strictTotalOrder = record { Carrier = Bin ; _≈_ = _≡_ ; _<_ = _<_ ; isStrictTotalOrder = <-isStrictTotalOrder } agda-stdlib-1.7.3/src/Data/Bool.agda000066400000000000000000000022451451211343400170470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Booleans ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Bool where open import Relation.Nullary open import Relation.Binary open import Relation.Binary.PropositionalEquality as PropEq using (_≡_; refl) ------------------------------------------------------------------------ -- The boolean type and some operations open import Data.Bool.Base public ------------------------------------------------------------------------ -- Publicly re-export queries open import Data.Bool.Properties public using (T?; _≟_; _≤?_; _ (λ()) (λ()) f ¬lt ¬eq gt = tri> ¬lt (≉⇒≢ ¬eq) gt <-irrefl : Irreflexive _≡_ _<_ <-irrefl = ℕₚ.<-irrefl ∘′ cong toℕ <-trans : Transitive _<_ <-trans {c} {d} {e} = On.transitive toℕ ℕ._<_ ℕₚ.<-trans {c} {d} {e} <-asym : Asymmetric _<_ <-asym {c} {d} = On.asymmetric toℕ ℕ._<_ ℕₚ.<-asym {c} {d} <-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<_ <-isStrictPartialOrder = record { isEquivalence = PropEq.isEquivalence ; irrefl = <-irrefl ; trans = λ {a} {b} {c} → <-trans {a} {b} {c} ; <-resp-≈ = (λ {c} → PropEq.subst (c <_)) , (λ {c} → PropEq.subst (_< c)) } <-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<_ <-isStrictTotalOrder = record { isEquivalence = PropEq.isEquivalence ; trans = λ {a} {b} {c} → <-trans {a} {b} {c} ; compare = <-cmp } <-strictPartialOrder : StrictPartialOrder _ _ _ <-strictPartialOrder = record { isStrictPartialOrder = <-isStrictPartialOrder } <-strictTotalOrder : StrictTotalOrder _ _ _ <-strictTotalOrder = record { isStrictTotalOrder = <-isStrictTotalOrder } ------------------------------------------------------------------------ -- Properties of _≤_ infix 4 _≤?_ _≤?_ : Decidable _≤_ _≤?_ = Reflₚ.decidable <-cmp ≤-reflexive : _≡_ ⇒ _≤_ ≤-reflexive = Refl.reflexive ≤-trans : Transitive _≤_ ≤-trans = Reflₚ.trans (λ {a} {b} {c} → <-trans {a} {b} {c}) ≤-antisym : Antisymmetric _≡_ _≤_ ≤-antisym = Reflₚ.antisym _≡_ refl ℕₚ.<-asym ≤-isPreorder : IsPreorder _≡_ _≤_ ≤-isPreorder = record { isEquivalence = PropEq.isEquivalence ; reflexive = ≤-reflexive ; trans = ≤-trans } ≤-isPartialOrder : IsPartialOrder _≡_ _≤_ ≤-isPartialOrder = record { isPreorder = ≤-isPreorder ; antisym = ≤-antisym } ≤-isDecPartialOrder : IsDecPartialOrder _≡_ _≤_ ≤-isDecPartialOrder = record { isPartialOrder = ≤-isPartialOrder ; _≟_ = _≟_ ; _≤?_ = _≤?_ } ≤-preorder : Preorder _ _ _ ≤-preorder = record { isPreorder = ≤-isPreorder } ≤-poset : Poset _ _ _ ≤-poset = record { isPartialOrder = ≤-isPartialOrder } ≤-decPoset : DecPoset _ _ _ ≤-decPoset = record { isDecPartialOrder = ≤-isDecPartialOrder } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.1 toNat-injective = toℕ-injective {-# WARNING_ON_USAGE toℕ-injective "Warning: toNat-injective was deprecated in v1.1. Please use toℕ-injective instead." #-} strictTotalOrder = On.strictTotalOrder ℕₚ.<-strictTotalOrder toℕ {-# WARNING_ON_USAGE strictTotalOrder "Warning: strictTotalOrder was deprecated in v1.1. Please use <-strictTotalOrder-≈ instead." #-} -- Version 1.5 infix 4 _≈?_ _≈?_ : Decidable _≈_ x ≈? y = toℕ x ℕₚ.≟ toℕ y {-# WARNING_ON_USAGE _≈?_ "Warning: _≈?_ was deprecated in v1.5. Please use _≟_ instead." #-} ≈-refl : Reflexive _≈_ ≈-refl = refl {-# WARNING_ON_USAGE ≈-refl "Warning: ≈-refl was deprecated in v1.5. Please use Propositional Equality's refl instead." #-} ≈-sym : Symmetric _≈_ ≈-sym = sym {-# WARNING_ON_USAGE ≈-sym "Warning: ≈-sym was deprecated in v1.5. Please use Propositional Equality's sym instead." #-} ≈-trans : Transitive _≈_ ≈-trans = trans {-# WARNING_ON_USAGE ≈-trans "Warning: ≈-trans was deprecated in v1.5. Please use Propositional Equality's trans instead." #-} ≈-subst : ∀ {ℓ} → Substitutive _≈_ ℓ ≈-subst P x≈y p = subst P (≈⇒≡ x≈y) p {-# WARNING_ON_USAGE ≈-subst "Warning: ≈-subst was deprecated in v1.5. Please use Propositional Equality's subst instead." #-} ≈-isEquivalence : IsEquivalence _≈_ ≈-isEquivalence = record { refl = λ {i} → refl ; sym = λ {i j} → ≈-sym {i} {j} ; trans = λ {i j k} → ≈-trans {i} {j} {k} } {-# WARNING_ON_USAGE ≈-isEquivalence "Warning: ≈-isEquivalence was deprecated in v1.5. Please use Propositional Equality's isEquivalence instead." #-} ≈-setoid : Setoid _ _ ≈-setoid = record { isEquivalence = ≈-isEquivalence } {-# WARNING_ON_USAGE ≈-setoid "Warning: ≈-setoid was deprecated in v1.5. Please use Propositional Equality's setoid instead." #-} ≈-isDecEquivalence : IsDecEquivalence _≈_ ≈-isDecEquivalence = record { isEquivalence = ≈-isEquivalence ; _≟_ = _≈?_ } {-# WARNING_ON_USAGE ≈-isDecEquivalence "Warning: ≈-isDecEquivalence was deprecated in v1.5. Please use Propositional Equality's isDecEquivalence instead." #-} ≈-decSetoid : DecSetoid _ _ ≈-decSetoid = record { isDecEquivalence = ≈-isDecEquivalence } {-# WARNING_ON_USAGE ≈-decSetoid "Warning: ≈-decSetoid was deprecated in v1.5. Please use Propositional Equality's decSetoid instead." #-} ≡-setoid : Setoid _ _ ≡-setoid = setoid {-# WARNING_ON_USAGE ≡-setoid "Warning: ≡-setoid was deprecated in v1.5. Please use setoid instead." #-} ≡-decSetoid : DecSetoid _ _ ≡-decSetoid = decSetoid {-# WARNING_ON_USAGE ≡-decSetoid "Warning: ≡-decSetoid was deprecated in v1.5. Please use decSetoid instead." #-} <-isStrictPartialOrder-≈ : IsStrictPartialOrder _≈_ _<_ <-isStrictPartialOrder-≈ = On.isStrictPartialOrder toℕ ℕₚ.<-isStrictPartialOrder {-# WARNING_ON_USAGE <-isStrictPartialOrder-≈ "Warning: <-isStrictPartialOrder-≈ was deprecated in v1.5. Please use <-isStrictPartialOrder instead." #-} <-isStrictTotalOrder-≈ : IsStrictTotalOrder _≈_ _<_ <-isStrictTotalOrder-≈ = On.isStrictTotalOrder toℕ ℕₚ.<-isStrictTotalOrder {-# WARNING_ON_USAGE <-isStrictTotalOrder-≈ "Warning: <-isStrictTotalOrder-≈ was deprecated in v1.5. Please use <-isStrictTotalOrder instead." #-} <-strictPartialOrder-≈ : StrictPartialOrder _ _ _ <-strictPartialOrder-≈ = On.strictPartialOrder ℕₚ.<-strictPartialOrder toℕ {-# WARNING_ON_USAGE <-strictPartialOrder-≈ "Warning: <-strictPartialOrder-≈ was deprecated in v1.5. Please use <-strictPartialOrder instead." #-} <-strictTotalOrder-≈ : StrictTotalOrder _ _ _ <-strictTotalOrder-≈ = On.strictTotalOrder ℕₚ.<-strictTotalOrder toℕ {-# WARNING_ON_USAGE <-strictTotalOrder-≈ "Warning: <-strictTotalOrder-≈ was deprecated in v1.5. Please use <-strictTotalOrder instead." #-} agda-stdlib-1.7.3/src/Data/Container.agda000066400000000000000000000034721451211343400201010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Containers, based on the work of Abbott and others ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level using (Level; _⊔_) open import Data.W using (W) module Data.Container where ------------------------------------------------------------------------ -- Re-exporting content to maintain backwards compatibility open import Data.Container.Core public open import Data.Container.Relation.Unary.Any using (◇) renaming (map to ◇-map) public open import Data.Container.Relation.Unary.All using (□) renaming (map to □-map) public open import Data.Container.Membership using (_∈_) public open import Data.Container.Relation.Binary.Pointwise using () renaming (Pointwise to Eq) public open import Data.Container.Relation.Binary.Pointwise.Properties using (refl; sym; trans) public open import Data.Container.Relation.Binary.Equality.Setoid using (isEquivalence; setoid) public open import Data.Container.Properties using () renaming (map-identity to identity; map-compose to composition) public open import Data.Container.Related public module Morphism where open import Data.Container.Morphism.Properties using (Natural; NT; natural; complete; id-correct; ∘-correct) public open import Data.Container.Morphism using (id; _∘_) public private variable s p : Level -- The least fixpoint of a container. μ : Container s p → Set (s ⊔ p) μ = W -- The greatest fixpoint of a container can be found -- in `Data.Container.Fixpoints.Guarded` as it relies -- on the `guardedness` flag. -- You can find sized alternatives in `Data.Container.Fixpoints.Sized` -- as they rely on the unsafe flag `--sized-types`. agda-stdlib-1.7.3/src/Data/Container/000077500000000000000000000000001451211343400172555ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Container/Any.agda000066400000000000000000000007161451211343400206260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.Container.Relation.Unary.Any directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Any where open import Data.Container.Relation.Unary.Any public open import Data.Container.Relation.Unary.Any.Properties public agda-stdlib-1.7.3/src/Data/Container/Combinator.agda000066400000000000000000000050621451211343400221730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Container combinators ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Combinator where open import Level using (Level; _⊔_) open import Data.Empty.Polymorphic using (⊥) open import Data.Product as P using (_,_; proj₁; proj₂; ∃) open import Data.Sum.Base as S using ([_,_]′) open import Data.Unit.Polymorphic.Base using (⊤) import Function as F open import Data.Container.Core open import Data.Container.Relation.Unary.Any ------------------------------------------------------------------------ -- Combinators module _ {s p : Level} where -- Identity. id : Container s p id .Shape = ⊤ id .Position = F.const ⊤ -- Constant. const : Set s → Container s p const X .Shape = X const X .Position = F.const ⊥ -- Composition. infixr 9 _∘_ _∘_ : ∀ {s₁ s₂ p₁ p₂} → Container s₁ p₁ → Container s₂ p₂ → Container (s₁ ⊔ s₂ ⊔ p₁) (p₁ ⊔ p₂) (C₁ ∘ C₂) .Shape = ⟦ C₁ ⟧ (Shape C₂) (C₁ ∘ C₂) .Position = ◇ C₁ (Position C₂) -- Product. (Note that, up to isomorphism, this is a special case of -- indexed product.) infixr 2 _×_ _×_ : ∀ {s₁ s₂ p₁ p₂} → Container s₁ p₁ → Container s₂ p₂ → Container (s₁ ⊔ s₂) (p₁ ⊔ p₂) (C₁ × C₂) .Shape = Shape C₁ P.× Shape C₂ (C₁ × C₂) .Position = P.uncurry λ s₁ s₂ → (Position C₁ s₁) S.⊎ (Position C₂ s₂) -- Indexed product. Π : ∀ {i s p} (I : Set i) → (I → Container s p) → Container (i ⊔ s) (i ⊔ p) Π I C .Shape = ∀ i → Shape (C i) Π I C .Position = λ s → ∃ λ i → Position (C i) (s i) -- Constant exponentiation. (Note that this is a special case of -- indexed product.) infix 0 const[_]⟶_ const[_]⟶_ : ∀ {i s p} → Set i → Container s p → Container (i ⊔ s) (i ⊔ p) const[ X ]⟶ C = Π X (F.const C) -- Sum. (Note that, up to isomorphism, this is a special case of -- indexed sum.) infixr 1 _⊎_ _⊎_ : ∀ {s₁ s₂ p} → Container s₁ p → Container s₂ p → Container (s₁ ⊔ s₂) p (C₁ ⊎ C₂) .Shape = (Shape C₁ S.⊎ Shape C₂) (C₁ ⊎ C₂) .Position = [ Position C₁ , Position C₂ ]′ -- Indexed sum. Σ : ∀ {i s p} (I : Set i) → (I → Container s p) → Container (i ⊔ s) p Σ I C .Shape = ∃ λ i → Shape (C i) Σ I C .Position = λ s → Position (C (proj₁ s)) (proj₂ s) agda-stdlib-1.7.3/src/Data/Container/Combinator/000077500000000000000000000000001451211343400213525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Container/Combinator/Properties.agda000066400000000000000000000121361451211343400243270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Correctness proofs for container combinators ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Combinator.Properties where open import Axiom.Extensionality.Propositional using (Extensionality) open import Data.Container.Core open import Data.Container.Combinator open import Data.Container.Relation.Unary.Any open import Data.Empty using (⊥-elim) open import Data.Product as Prod using (∃; _,_; proj₁; proj₂; <_,_>; uncurry; curry) open import Data.Sum.Base as S using (inj₁; inj₂; [_,_]′; [_,_]) open import Function as F using (_∘′_) open import Function.Inverse as Inv using (_↔_; inverse; module Inverse) open import Level using (_⊔_; lower) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≗_) -- I have proved some of the correctness statements under the -- assumption of functional extensionality. I could have reformulated -- the statements using suitable setoids, but I could not be bothered. module Identity where correct : ∀ {s p x} {X : Set x} → ⟦ id {s} {p} ⟧ X ↔ F.id X correct {X = X} = inverse to from (λ _ → P.refl) (λ _ → P.refl) where to : ⟦ id ⟧ X → F.id X to xs = proj₂ xs _ from : F.id X → ⟦ id ⟧ X from x = (_ , λ _ → x) module Constant (ext : ∀ {ℓ ℓ′} → Extensionality ℓ ℓ′) where correct : ∀ {x p y} (X : Set x) {Y : Set y} → ⟦ const {x} {p ⊔ y} X ⟧ Y ↔ F.const X Y correct {x} {y} X {Y} = inverse proj₁ from from∘to λ _ → P.refl where from : X → ⟦ const X ⟧ Y from = < F.id , F.const (⊥-elim ∘′ lower) > from∘to : (x : ⟦ const X ⟧ Y) → from (proj₁ x) ≡ x from∘to xs = P.cong (proj₁ xs ,_) (ext (λ x → ⊥-elim (lower x))) module Composition {s₁ s₂ p₁ p₂} (C₁ : Container s₁ p₁) (C₂ : Container s₂ p₂) where correct : ∀ {x} {X : Set x} → ⟦ C₁ ∘ C₂ ⟧ X ↔ (⟦ C₁ ⟧ F.∘ ⟦ C₂ ⟧) X correct {X = X} = inverse to from (λ _ → P.refl) (λ _ → P.refl) where to : ⟦ C₁ ∘ C₂ ⟧ X → ⟦ C₁ ⟧ (⟦ C₂ ⟧ X) to ((s , f) , g) = (s , < f , curry (g ∘′ any) >) from : ⟦ C₁ ⟧ (⟦ C₂ ⟧ X) → ⟦ C₁ ∘ C₂ ⟧ X from (s , f) = ((s , proj₁ F.∘ f) , uncurry (proj₂ F.∘ f) ∘′ ◇.proof) module Product (ext : ∀ {ℓ ℓ′} → Extensionality ℓ ℓ′) {s₁ s₂ p₁ p₂} (C₁ : Container s₁ p₁) (C₂ : Container s₂ p₂) where correct : ∀ {x} {X : Set x} → ⟦ C₁ × C₂ ⟧ X ↔ (⟦ C₁ ⟧ X Prod.× ⟦ C₂ ⟧ X) correct {X = X} = inverse to from from∘to (λ _ → P.refl) where to : ⟦ C₁ × C₂ ⟧ X → ⟦ C₁ ⟧ X Prod.× ⟦ C₂ ⟧ X to ((s₁ , s₂) , f) = ((s₁ , f F.∘ inj₁) , (s₂ , f F.∘ inj₂)) from : ⟦ C₁ ⟧ X Prod.× ⟦ C₂ ⟧ X → ⟦ C₁ × C₂ ⟧ X from ((s₁ , f₁) , (s₂ , f₂)) = ((s₁ , s₂) , [ f₁ , f₂ ]′) from∘to : from F.∘ to ≗ F.id from∘to (s , f) = P.cong (s ,_) (ext [ (λ _ → P.refl) , (λ _ → P.refl) ]) module IndexedProduct {i s p} {I : Set i} (Cᵢ : I → Container s p) where correct : ∀ {x} {X : Set x} → ⟦ Π I Cᵢ ⟧ X ↔ (∀ i → ⟦ Cᵢ i ⟧ X) correct {X = X} = inverse to from (λ _ → P.refl) (λ _ → P.refl) where to : ⟦ Π I Cᵢ ⟧ X → ∀ i → ⟦ Cᵢ i ⟧ X to (s , f) = λ i → (s i , λ p → f (i , p)) from : (∀ i → ⟦ Cᵢ i ⟧ X) → ⟦ Π I Cᵢ ⟧ X from f = (proj₁ F.∘ f , uncurry (proj₂ F.∘ f)) module Sum {s₁ s₂ p} (C₁ : Container s₁ p) (C₂ : Container s₂ p) where correct : ∀ {x} {X : Set x} → ⟦ C₁ ⊎ C₂ ⟧ X ↔ (⟦ C₁ ⟧ X S.⊎ ⟦ C₂ ⟧ X) correct {X = X} = inverse to from from∘to to∘from where to : ⟦ C₁ ⊎ C₂ ⟧ X → ⟦ C₁ ⟧ X S.⊎ ⟦ C₂ ⟧ X to (inj₁ s₁ , f) = inj₁ (s₁ , f) to (inj₂ s₂ , f) = inj₂ (s₂ , f) from : ⟦ C₁ ⟧ X S.⊎ ⟦ C₂ ⟧ X → ⟦ C₁ ⊎ C₂ ⟧ X from = [ Prod.map inj₁ F.id , Prod.map inj₂ F.id ]′ from∘to : from F.∘ to ≗ F.id from∘to (inj₁ s₁ , f) = P.refl from∘to (inj₂ s₂ , f) = P.refl to∘from : to F.∘ from ≗ F.id to∘from = [ (λ _ → P.refl) , (λ _ → P.refl) ] module IndexedSum {i s p} {I : Set i} (C : I → Container s p) where correct : ∀ {x} {X : Set x} → ⟦ Σ I C ⟧ X ↔ (∃ λ i → ⟦ C i ⟧ X) correct {X = X} = inverse to from (λ _ → P.refl) (λ _ → P.refl) where to : ⟦ Σ I C ⟧ X → ∃ λ i → ⟦ C i ⟧ X to ((i , s) , f) = (i , (s , f)) from : (∃ λ i → ⟦ C i ⟧ X) → ⟦ Σ I C ⟧ X from (i , (s , f)) = ((i , s) , f) module ConstantExponentiation {i s p} {I : Set i} (C : Container s p) where correct : ∀ {x} {X : Set x} → ⟦ const[ I ]⟶ C ⟧ X ↔ (I → ⟦ C ⟧ X) correct = IndexedProduct.correct (F.const C) agda-stdlib-1.7.3/src/Data/Container/Core.agda000066400000000000000000000041521451211343400207650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Containers core ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Core where open import Level open import Data.Product as Prod using (Σ-syntax) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Inverse using (_↔_; module Inverse) open import Relation.Unary using (Pred; _⊆_) -- Definition of Containers infix 5 _▷_ record Container (s p : Level) : Set (suc (s ⊔ p)) where constructor _▷_ field Shape : Set s Position : Shape → Set p open Container public -- The semantics ("extension") of a container. ⟦_⟧ : ∀ {s p ℓ} → Container s p → Set ℓ → Set (s ⊔ p ⊔ ℓ) ⟦ S ▷ P ⟧ X = Σ[ s ∈ S ] (P s → X) -- The extension is a functor map : ∀ {s p x y} {C : Container s p} {X : Set x} {Y : Set y} → (X → Y) → ⟦ C ⟧ X → ⟦ C ⟧ Y map f = Prod.map₂ (f ∘_) -- Representation of container morphisms. record _⇒_ {s₁ s₂ p₁ p₂} (C₁ : Container s₁ p₁) (C₂ : Container s₂ p₂) : Set (s₁ ⊔ s₂ ⊔ p₁ ⊔ p₂) where constructor _▷_ field shape : Shape C₁ → Shape C₂ position : ∀ {s} → Position C₂ (shape s) → Position C₁ s ⟪_⟫ : ∀ {x} {X : Set x} → ⟦ C₁ ⟧ X → ⟦ C₂ ⟧ X ⟪_⟫ = Prod.map shape (_∘′ position) open _⇒_ public -- Linear container morphisms record _⊸_ {s₁ s₂ p₁ p₂} (C₁ : Container s₁ p₁) (C₂ : Container s₂ p₂) : Set (s₁ ⊔ s₂ ⊔ p₁ ⊔ p₂) where field shape⊸ : Shape C₁ → Shape C₂ position⊸ : ∀ {s} → Position C₂ (shape⊸ s) ↔ Position C₁ s morphism : C₁ ⇒ C₂ morphism = record { shape = shape⊸ ; position = _⟨$⟩_ (Inverse.to position⊸) } ⟪_⟫⊸ : ∀ {x} {X : Set x} → ⟦ C₁ ⟧ X → ⟦ C₂ ⟧ X ⟪_⟫⊸ = ⟪ morphism ⟫ open _⊸_ public using (shape⊸; position⊸; ⟪_⟫⊸) agda-stdlib-1.7.3/src/Data/Container/Fixpoints/000077500000000000000000000000001451211343400212405ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Container/Fixpoints/Guarded.agda000066400000000000000000000012761451211343400234370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Fixpoints for containers - using guardedness ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Data.Container.Fixpoints.Guarded where open import Level using (Level; _⊔_) open import Codata.Musical.M using (M) open import Data.Container using (Container) private variable s p : Level -- The least fixpoint can be found in `Data.Container` open Data.Container public using (μ) -- This lives in its own module due to its use of guardedness. ν : Container s p → Set (s ⊔ p) ν C = M C agda-stdlib-1.7.3/src/Data/Container/Fixpoints/Sized.agda000066400000000000000000000012471451211343400231400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sized fixpoints of containers, based on the work of Abbott and others ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --sized-types #-} module Data.Container.Fixpoints.Sized where open import Level open import Size open import Codata.M open import Data.W.Sized open import Data.Container hiding (μ) public private variable s p : Level -- The sized least and greatest fixpoints of a container. μ : Container s p → Size → Set (s ⊔ p) μ = W ν : Container s p → Size → Set (s ⊔ p) ν = M agda-stdlib-1.7.3/src/Data/Container/FreeMonad.agda000066400000000000000000000041601451211343400217340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The free monad construction on containers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.FreeMonad where open import Level open import Data.Sum.Base using (inj₁; inj₂ ; [_,_]′) open import Data.Product open import Data.Container open import Data.Container.Combinator using (const; _⊎_) open import Data.W using (sup) open import Category.Monad infixl 1 _⋆C_ infix 1 _⋆_ ------------------------------------------------------------------------ -- The free monad construction over a container and a set is, in -- universal algebra terminology, also known as the term algebra over a -- signature (a container) and a set (of variable symbols). The return -- of the free monad corresponds to variables and the bind operator -- corresponds to (parallel) substitution. -- A useful intuition is to think of containers describing single -- operations and the free monad construction over a container and a set -- describing a tree of operations as nodes and elements of the set as -- leafs. If one starts at the root, then any path will pass finitely -- many nodes (operations described by the container) and eventually end -- up in a leaf (element of the set) -- hence the Kleene star notation -- (the type can be read as a regular expression). _⋆C_ : ∀ {x s p} → Container s p → Set x → Container (s ⊔ x) p C ⋆C X = const X ⊎ C _⋆_ : ∀ {x s p} → Container s p → Set x → Set (x ⊔ s ⊔ p) C ⋆ X = μ (C ⋆C X) module _ {s p} {C : Container s p} where inn : ∀ {x} {X : Set x} → ⟦ C ⟧ (C ⋆ X) → C ⋆ X inn (s , f) = sup (inj₂ s , f) rawMonad : ∀ {x} → RawMonad {s ⊔ p ⊔ x} (C ⋆_) rawMonad = record { return = return; _>>=_ = _>>=_ } where return : ∀ {X} → X → C ⋆ X return x = sup (inj₁ x , λ ()) _>>=_ : ∀ {X Y} → C ⋆ X → (X → C ⋆ Y) → C ⋆ Y sup (inj₁ x , _) >>= k = k x sup (inj₂ s , f) >>= k = inn (s , λ p → f p >>= k) agda-stdlib-1.7.3/src/Data/Container/Indexed.agda000066400000000000000000000161421451211343400214570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed containers aka interaction structures aka polynomial -- functors. The notation and presentation here is closest to that of -- Hancock and Hyvernat in "Programming interfaces and basic topology" -- (2006/9). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Indexed where open import Level open import Data.Product as Prod hiding (map) open import Data.W.Indexed open import Function.Base renaming (id to ⟨id⟩; _∘_ to _⟨∘⟩_) open import Function.Equality using (_⟨$⟩_) open import Function.Inverse using (_↔_; module Inverse) open import Relation.Unary using (Pred; _⊆_) import Relation.Binary as B open import Relation.Binary.PropositionalEquality as P using (_≡_; _≗_; refl) ------------------------------------------------------------------------ -- The type and its semantics ("extension"). open import Data.Container.Indexed.Core public open Container public -- Abbreviation for the commonly used level one version of indexed -- containers. _▷_ : Set → Set → Set₁ I ▷ O = Container I O zero zero -- The least and greatest fixpoint. μ : ∀ {o c r} {O : Set o} → Container O O c r → Pred O _ μ = W -- An equivalence relation is defined in Data.Container.Indexed.WithK. ------------------------------------------------------------------------ -- Functoriality -- Indexed containers are functors. map : ∀ {i o c r ℓ₁ ℓ₂} {I : Set i} {O : Set o} (C : Container I O c r) {X : Pred I ℓ₁} {Y : Pred I ℓ₂} → X ⊆ Y → ⟦ C ⟧ X ⊆ ⟦ C ⟧ Y map _ f = Prod.map ⟨id⟩ (λ g → f ⟨∘⟩ g) -- Some properties are proved in Data.Container.Indexed.WithK. ------------------------------------------------------------------------ -- Container morphisms module _ {i₁ i₂ o₁ o₂} {I₁ : Set i₁} {I₂ : Set i₂} {O₁ : Set o₁} {O₂ : Set o₂} where -- General container morphism. record ContainerMorphism {c₁ c₂ r₁ r₂ ℓ₁ ℓ₂} (C₁ : Container I₁ O₁ c₁ r₁) (C₂ : Container I₂ O₂ c₂ r₂) (f : I₁ → I₂) (g : O₁ → O₂) (_∼_ : B.Rel I₂ ℓ₁) (_≈_ : B.REL (Set r₂) (Set r₁) ℓ₂) (_·_ : ∀ {A B} → A ≈ B → A → B) : Set (i₁ ⊔ i₂ ⊔ o₁ ⊔ o₂ ⊔ c₁ ⊔ c₂ ⊔ r₁ ⊔ r₂ ⊔ ℓ₁ ⊔ ℓ₂) where field command : Command C₁ ⊆ Command C₂ ⟨∘⟩ g response : ∀ {o} {c₁ : Command C₁ o} → Response C₂ (command c₁) ≈ Response C₁ c₁ coherent : ∀ {o} {c₁ : Command C₁ o} {r₂ : Response C₂ (command c₁)} → f (next C₁ c₁ (response · r₂)) ∼ next C₂ (command c₁) r₂ open ContainerMorphism public -- Plain container morphism. _⇒[_/_]_ : ∀ {c₁ c₂ r₁ r₂} → Container I₁ O₁ c₁ r₁ → (I₁ → I₂) → (O₁ → O₂) → Container I₂ O₂ c₂ r₂ → Set _ C₁ ⇒[ f / g ] C₂ = ContainerMorphism C₁ C₂ f g _≡_ (λ R₂ R₁ → R₂ → R₁) _$_ -- Linear container morphism. _⊸[_/_]_ : ∀ {c₁ c₂ r₁ r₂} → Container I₁ O₁ c₁ r₁ → (I₁ → I₂) → (O₁ → O₂) → Container I₂ O₂ c₂ r₂ → Set _ C₁ ⊸[ f / g ] C₂ = ContainerMorphism C₁ C₂ f g _≡_ _↔_ (λ r₂↔r₁ r₂ → Inverse.to r₂↔r₁ ⟨$⟩ r₂) -- Cartesian container morphism. _⇒C[_/_]_ : ∀ {c₁ c₂ r} → Container I₁ O₁ c₁ r → (I₁ → I₂) → (O₁ → O₂) → Container I₂ O₂ c₂ r → Set _ C₁ ⇒C[ f / g ] C₂ = ContainerMorphism C₁ C₂ f g _≡_ (λ R₂ R₁ → R₂ ≡ R₁) (λ r₂≡r₁ r₂ → P.subst ⟨id⟩ r₂≡r₁ r₂) -- Degenerate cases where no reindexing is performed. module _ {i o c r} {I : Set i} {O : Set o} where _⇒_ : B.Rel (Container I O c r) _ C₁ ⇒ C₂ = C₁ ⇒[ ⟨id⟩ / ⟨id⟩ ] C₂ _⊸_ : B.Rel (Container I O c r) _ C₁ ⊸ C₂ = C₁ ⊸[ ⟨id⟩ / ⟨id⟩ ] C₂ _⇒C_ : B.Rel (Container I O c r) _ C₁ ⇒C C₂ = C₁ ⇒C[ ⟨id⟩ / ⟨id⟩ ] C₂ ------------------------------------------------------------------------ -- Plain morphisms -- Interpretation of _⇒_. ⟪_⟫ : ∀ {i o c r ℓ} {I : Set i} {O : Set o} {C₁ C₂ : Container I O c r} → C₁ ⇒ C₂ → (X : Pred I ℓ) → ⟦ C₁ ⟧ X ⊆ ⟦ C₂ ⟧ X ⟪ m ⟫ X (c , k) = command m c , λ r₂ → P.subst X (coherent m) (k (response m r₂)) module PlainMorphism {i o c r} {I : Set i} {O : Set o} where -- Identity. id : (C : Container I O c r) → C ⇒ C id _ = record { command = ⟨id⟩ ; response = ⟨id⟩ ; coherent = refl } -- Composition. infixr 9 _∘_ _∘_ : {C₁ C₂ C₃ : Container I O c r} → C₂ ⇒ C₃ → C₁ ⇒ C₂ → C₁ ⇒ C₃ f ∘ g = record { command = command f ⟨∘⟩ command g ; response = response g ⟨∘⟩ response f ; coherent = coherent g ⟨ P.trans ⟩ coherent f } -- Identity commutes with ⟪_⟫. id-correct : ∀ {ℓ} {C : Container I O c r} → ∀ {X : Pred I ℓ} {o} → ⟪ id C ⟫ X {o} ≗ ⟨id⟩ id-correct _ = refl -- More properties are proved in Data.Container.Indexed.WithK. ------------------------------------------------------------------------ -- Linear container morphisms module LinearMorphism {i o c r} {I : Set i} {O : Set o} {C₁ C₂ : Container I O c r} (m : C₁ ⊸ C₂) where morphism : C₁ ⇒ C₂ morphism = record { command = command m ; response = _⟨$⟩_ (Inverse.to (response m)) ; coherent = coherent m } ⟪_⟫⊸ : ∀ {ℓ} (X : Pred I ℓ) → ⟦ C₁ ⟧ X ⊆ ⟦ C₂ ⟧ X ⟪_⟫⊸ = ⟪ morphism ⟫ open LinearMorphism public using (⟪_⟫⊸) ------------------------------------------------------------------------ -- Cartesian morphisms module CartesianMorphism {i o c r} {I : Set i} {O : Set o} {C₁ C₂ : Container I O c r} (m : C₁ ⇒C C₂) where morphism : C₁ ⇒ C₂ morphism = record { command = command m ; response = P.subst ⟨id⟩ (response m) ; coherent = coherent m } ⟪_⟫C : ∀ {ℓ} (X : Pred I ℓ) → ⟦ C₁ ⟧ X ⊆ ⟦ C₂ ⟧ X ⟪_⟫C = ⟪ morphism ⟫ open CartesianMorphism public using (⟪_⟫C) ------------------------------------------------------------------------ -- All and any -- □ and ◇ are defined in the core module. module _ {i o c r ℓ₁ ℓ₂} {I : Set i} {O : Set o} (C : Container I O c r) {X : Pred I ℓ₁} {P Q : Pred (Σ I X) ℓ₂} where -- All. □-map : P ⊆ Q → □ C P ⊆ □ C Q □-map P⊆Q = _⟨∘⟩_ P⊆Q -- Any. ◇-map : P ⊆ Q → ◇ C P ⊆ ◇ C Q ◇-map P⊆Q = Prod.map ⟨id⟩ P⊆Q -- Membership is defined in Data.Container.Indexed.WithK. agda-stdlib-1.7.3/src/Data/Container/Indexed/000077500000000000000000000000001451211343400206355ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Container/Indexed/Combinator.agda000066400000000000000000000235441451211343400235600ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed container combinators ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Indexed.Combinator where open import Axiom.Extensionality.Propositional using (Extensionality) open import Data.Container.Indexed open import Data.Empty.Polymorphic using (⊥; ⊥-elim) open import Data.Unit.Polymorphic.Base using (⊤) open import Data.Product as Prod hiding (Σ) renaming (_×_ to _⟨×⟩_) open import Data.Sum renaming (_⊎_ to _⟨⊎⟩_) open import Data.Sum.Relation.Unary.All as All using (All) open import Function as F hiding (id; const) renaming (_∘_ to _⟨∘⟩_) open import Function.Inverse using (_↔̇_; inverse) open import Level open import Relation.Unary using (Pred; _⊆_; _∪_; _∩_; ⋃; ⋂) renaming (_⟨×⟩_ to _⟪×⟫_; _⟨⊙⟩_ to _⟪⊙⟫_; _⟨⊎⟩_ to _⟪⊎⟫_) open import Relation.Binary.PropositionalEquality as P using (_≗_; refl) private variable ℓ ℓ₁ ℓ₂ i j k o c c₁ c₂ r r₁ r₂ x z : Level I J K O X Z : Set _ ------------------------------------------------------------------------ -- Combinators -- Identity. id : Container O O c r id = F.const ⊤ ◃ F.const ⊤ / (λ {o} _ _ → o) -- Constant. const : Pred O c → Container I O c r const X = X ◃ F.const ⊥ / F.const ⊥-elim -- Composition. infixr 9 _∘_ _∘_ : Container J K c₁ r₁ → Container I J c₂ r₂ → Container I K _ _ C₁ ∘ C₂ = C ◃ R / n where C : ∀ k → Set _ C = ⟦ C₁ ⟧ (Command C₂) R : ∀ {k} → ⟦ C₁ ⟧ (Command C₂) k → Set _ R (c , k) = ◇ C₁ {X = Command C₂} (Response C₂ ⟨∘⟩ proj₂) (_ , c , k) n : ∀ {k} (c : ⟦ C₁ ⟧ (Command C₂) k) → R c → _ n (_ , f) (r₁ , r₂) = next C₂ (f r₁) r₂ -- Duality. _^⊥ : Container I O c r → Container I O (c ⊔ r) c (C ^⊥) .Command o = (c : C .Command o) → C .Response c (C ^⊥) .Response {o} _ = C .Command o (C ^⊥) .next f c = C .next c (f c) -- Strength. infixl 3 _⋊_ _⋊_ : Container I O c r → (Z : Set z) → Container (I ⟨×⟩ Z) (O ⟨×⟩ Z) c r (C ⋊ Z) .Command (o , z) = C .Command o (C ⋊ Z) .Response = C .Response (C ⋊ Z) .next {o , z} c r = C .next c r , z infixr 3 _⋉_ _⋉_ : (Z : Set z) → Container I O c r → Container (Z ⟨×⟩ I) (Z ⟨×⟩ O) c r (Z ⋉ C) .Command (z , o) = C .Command o (Z ⋉ C) .Response = C .Response (Z ⋉ C) .next {z , o} c r = z , C .next c r -- Product. (Note that, up to isomorphism, and ignoring universe level -- issues, this is a special case of indexed product.) infixr 2 _×_ _×_ : Container I O c₁ r₁ → Container I O c₂ r₂ → Container I O _ _ (C₁ ◃ R₁ / n₁) × (C₂ ◃ R₂ / n₂) = record { Command = C₁ ∩ C₂ ; Response = R₁ ⟪⊙⟫ R₂ ; next = λ { (c₁ , c₂) → [ n₁ c₁ , n₂ c₂ ] } } -- Indexed product. Π : (X → Container I O c r) → Container I O _ _ Π {X = X} C = record { Command = ⋂ X (Command ⟨∘⟩ C) ; Response = ⋃[ x ∶ X ] λ c → Response (C x) (c x) ; next = λ { c (x , r) → next (C x) (c x) r } } -- Sum. (Note that, up to isomorphism, and ignoring universe level -- issues, this is a special case of indexed sum.) infixr 1 _⊎_ _⊎′_ _⊎_ : Container I O c₁ r₁ → Container I O c₂ r₂ → Container I O _ _ (C₁ ⊎ C₂) .Command = C₁ .Command ∪ C₂ .Command (C₁ ⊎ C₂) .Response = All (C₁ .Response) (C₂ .Response) (C₁ ⊎ C₂) .next = All.[ C₁ .next , C₂ .next ] -- A simplified version for responses at the same level r: _⊎′_ : Container I O c₁ r → Container I O c₂ r → Container I O _ r (C₁ ◃ R₁ / n₁) ⊎′ (C₂ ◃ R₂ / n₂) = record { Command = C₁ ∪ C₂ ; Response = [ R₁ , R₂ ] ; next = [ n₁ , n₂ ] } -- Indexed sum. Σ : (X → Container I O c r) → Container I O _ r Σ {X = X} C = record { Command = ⋃ X (Command ⟨∘⟩ C) ; Response = λ { (x , c) → Response (C x) c } ; next = λ { (x , c) r → next (C x) c r } } -- Constant exponentiation. (Note that this is a special case of -- indexed product.) infix 0 const[_]⟶_ const[_]⟶_ : (X : Set ℓ) → Container I O c r → Container I O _ _ const[ X ]⟶ C = Π {X = X} (F.const C) ------------------------------------------------------------------------ -- Correctness proofs module Identity where correct : {X : Pred O ℓ} → ⟦ id {c = c}{r} ⟧ X ↔̇ F.id X correct {X = X} = inverse to from (λ _ → refl) (λ _ → refl) where to : ∀ {x} → ⟦ id ⟧ X x → F.id X x to xs = proj₂ xs _ from : ∀ {x} → F.id X x → ⟦ id ⟧ X x from x = (_ , λ _ → x) module Constant (ext : ∀ {ℓ} → Extensionality ℓ ℓ) where correct : (X : Pred O ℓ₁) {Y : Pred O ℓ₂} → ⟦ const X ⟧ Y ↔̇ F.const X Y correct X {Y} = record { to = P.→-to-⟶ to ; from = P.→-to-⟶ from ; inverse-of = record { right-inverse-of = λ _ → refl ; left-inverse-of = to∘from } } where to : ⟦ const X ⟧ Y ⊆ X to = proj₁ from : X ⊆ ⟦ const X ⟧ Y from = < F.id , F.const ⊥-elim > to∘from : _ to∘from xs = P.cong (proj₁ xs ,_) (ext ⊥-elim) module Duality where correct : (C : Container I O c r) (X : Pred I ℓ) → ⟦ C ^⊥ ⟧ X ↔̇ (λ o → (c : Command C o) → ∃ λ r → X (next C c r)) correct C X = inverse (λ { (f , g) → < f , g > }) (λ f → proj₁ ⟨∘⟩ f , proj₂ ⟨∘⟩ f) (λ _ → refl) (λ _ → refl) module Composition where correct : (C₁ : Container J K c r) (C₂ : Container I J c r) → {X : Pred I ℓ} → ⟦ C₁ ∘ C₂ ⟧ X ↔̇ (⟦ C₁ ⟧ ⟨∘⟩ ⟦ C₂ ⟧) X correct C₁ C₂ {X} = inverse to from (λ _ → refl) (λ _ → refl) where to : ⟦ C₁ ∘ C₂ ⟧ X ⊆ ⟦ C₁ ⟧ (⟦ C₂ ⟧ X) to ((c , f) , g) = (c , < f , curry g >) from : ⟦ C₁ ⟧ (⟦ C₂ ⟧ X) ⊆ ⟦ C₁ ∘ C₂ ⟧ X from (c , f) = ((c , proj₁ ⟨∘⟩ f) , uncurry (proj₂ ⟨∘⟩ f)) module Product (ext : ∀ {ℓ} → Extensionality ℓ ℓ) where correct : (C₁ C₂ : Container I O c r) {X : Pred I _} → ⟦ C₁ × C₂ ⟧ X ↔̇ (⟦ C₁ ⟧ X ∩ ⟦ C₂ ⟧ X) correct C₁ C₂ {X} = inverse to from from∘to (λ _ → refl) where to : ⟦ C₁ × C₂ ⟧ X ⊆ ⟦ C₁ ⟧ X ∩ ⟦ C₂ ⟧ X to ((c₁ , c₂) , k) = ((c₁ , k ⟨∘⟩ inj₁) , (c₂ , k ⟨∘⟩ inj₂)) from : ⟦ C₁ ⟧ X ∩ ⟦ C₂ ⟧ X ⊆ ⟦ C₁ × C₂ ⟧ X from ((c₁ , k₁) , (c₂ , k₂)) = ((c₁ , c₂) , [ k₁ , k₂ ]) from∘to : from ⟨∘⟩ to ≗ F.id from∘to (c , _) = P.cong (c ,_) (ext [ (λ _ → refl) , (λ _ → refl) ]) module IndexedProduct where correct : (C : X → Container I O c r) {Y : Pred I ℓ} → ⟦ Π C ⟧ Y ↔̇ ⋂[ x ∶ X ] ⟦ C x ⟧ Y correct {X = X} C {Y} = inverse to from (λ _ → refl) (λ _ → refl) where to : ⟦ Π C ⟧ Y ⊆ ⋂[ x ∶ X ] ⟦ C x ⟧ Y to (c , k) = λ x → (c x , λ r → k (x , r)) from : ⋂[ x ∶ X ] ⟦ C x ⟧ Y ⊆ ⟦ Π C ⟧ Y from f = (proj₁ ⟨∘⟩ f , uncurry (proj₂ ⟨∘⟩ f)) module Sum (ext : ∀ {ℓ₁ ℓ₂} → Extensionality ℓ₁ ℓ₂) where correct : (C₁ C₂ : Container I O c r) {X : Pred I ℓ} → ⟦ C₁ ⊎ C₂ ⟧ X ↔̇ (⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X) correct C₁ C₂ {X} = inverse to from from∘to to∘from where to : ⟦ C₁ ⊎ C₂ ⟧ X ⊆ ⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X to (inj₁ c₁ , k) = inj₁ (c₁ , λ r → k (All.inj₁ r)) to (inj₂ c₂ , k) = inj₂ (c₂ , λ r → k (All.inj₂ r)) from : ⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X ⊆ ⟦ C₁ ⊎ C₂ ⟧ X from (inj₁ (c , f)) = inj₁ c , λ{ (All.inj₁ r) → f r} from (inj₂ (c , f)) = inj₂ c , λ{ (All.inj₂ r) → f r} from∘to : from ⟨∘⟩ to ≗ F.id from∘to (inj₁ _ , _) = P.cong (inj₁ _ ,_) (ext λ{ (All.inj₁ r) → refl}) from∘to (inj₂ _ , _) = P.cong (inj₂ _ ,_) (ext λ{ (All.inj₂ r) → refl}) to∘from : to ⟨∘⟩ from ≗ F.id to∘from = [ (λ _ → refl) , (λ _ → refl) ] module Sum′ where correct : (C₁ C₂ : Container I O c r) {X : Pred I ℓ} → ⟦ C₁ ⊎′ C₂ ⟧ X ↔̇ (⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X) correct C₁ C₂ {X} = inverse to from from∘to to∘from where to : ⟦ C₁ ⊎′ C₂ ⟧ X ⊆ ⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X to (inj₁ c₁ , k) = inj₁ (c₁ , k) to (inj₂ c₂ , k) = inj₂ (c₂ , k) from : ⟦ C₁ ⟧ X ∪ ⟦ C₂ ⟧ X ⊆ ⟦ C₁ ⊎′ C₂ ⟧ X from = [ Prod.map inj₁ F.id , Prod.map inj₂ F.id ] from∘to : from ⟨∘⟩ to ≗ F.id from∘to (inj₁ _ , _) = refl from∘to (inj₂ _ , _) = refl to∘from : to ⟨∘⟩ from ≗ F.id to∘from = [ (λ _ → refl) , (λ _ → refl) ] module IndexedSum where correct : (C : X → Container I O c r) {Y : Pred I ℓ} → ⟦ Σ C ⟧ Y ↔̇ ⋃[ x ∶ X ] ⟦ C x ⟧ Y correct {X = X} C {Y} = inverse to from (λ _ → refl) (λ _ → refl) where to : ⟦ Σ C ⟧ Y ⊆ ⋃[ x ∶ X ] ⟦ C x ⟧ Y to ((x , c) , k) = (x , (c , k)) from : ⋃[ x ∶ X ] ⟦ C x ⟧ Y ⊆ ⟦ Σ C ⟧ Y from (x , (c , k)) = ((x , c) , k) module ConstantExponentiation where correct : (C : Container I O c r) {Y : Pred I ℓ} → ⟦ const[ X ]⟶ C ⟧ Y ↔̇ (⋂ X (F.const (⟦ C ⟧ Y))) correct C {Y} = IndexedProduct.correct (F.const C) {Y} agda-stdlib-1.7.3/src/Data/Container/Indexed/Core.agda000066400000000000000000000025311451211343400223440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Indexed containers core ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Indexed.Core where open import Level open import Data.Product open import Relation.Unary infix 5 _◃_/_ record Container {i o} (I : Set i) (O : Set o) (c r : Level) : Set (i ⊔ o ⊔ suc c ⊔ suc r) where constructor _◃_/_ field Command : (o : O) → Set c Response : ∀ {o} → Command o → Set r next : ∀ {o} (c : Command o) → Response c → I -- The semantics ("extension") of an indexed container. ⟦_⟧ : ∀ {i o c r ℓ} {I : Set i} {O : Set o} → Container I O c r → Pred I ℓ → Pred O _ ⟦ C ◃ R / n ⟧ X o = Σ[ c ∈ C o ] ((r : R c) → X (n c r)) ------------------------------------------------------------------------ -- All and any module _ {i o c r ℓ} {I : Set i} {O : Set o} (C : Container I O c r) {X : Pred I ℓ} where -- All. □ : ∀ {ℓ′} → Pred (Σ I X) ℓ′ → Pred (Σ O (⟦ C ⟧ X)) _ □ P (_ , _ , k) = ∀ r → P (_ , k r) -- Any. ◇ : ∀ {ℓ′} → Pred (Σ I X) ℓ′ → Pred (Σ O (⟦ C ⟧ X)) _ ◇ P (_ , _ , k) = ∃ λ r → P (_ , k r) agda-stdlib-1.7.3/src/Data/Container/Indexed/Fixpoints/000077500000000000000000000000001451211343400226205ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Container/Indexed/Fixpoints/Guarded.agda000066400000000000000000000014421451211343400250120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Greatest fixpoint for indexed containers - using guardedness ------------------------------------------------------------------------ {-# OPTIONS --safe --cubical-compatible --guardedness #-} module Data.Container.Indexed.Fixpoints.Guarded where open import Level using (Level; _⊔_) open import Codata.Musical.M.Indexed using (M) open import Data.Container.Indexed using (Container) open import Relation.Unary using (Pred) private variable o c r : Level O : Set o -- The least fixpoint can be found in `Data.Container` open Data.Container.Indexed public using (μ) -- This lives in its own module due to its use of guardedness. ν : Container O O c r → Pred O _ ν = M agda-stdlib-1.7.3/src/Data/Container/Indexed/FreeMonad.agda000066400000000000000000000041771451211343400233240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The free monad construction on indexed containers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Container.Indexed.FreeMonad where open import Level open import Function hiding (const) open import Category.Monad.Predicate open import Data.Container.Indexed open import Data.Container.Indexed.Combinator hiding (id; _∘_) open import Data.Empty open import Data.Sum.Base using (inj₁; inj₂) open import Data.Product open import Data.W.Indexed open import Relation.Unary open import Relation.Unary.PredicateTransformer open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ infixl 9 _⋆C_ infix 9 _⋆_ _⋆C_ : ∀ {i o c r} {I : Set i} {O : Set o} → Container I O c r → Pred O c → Container I O _ _ C ⋆C X = const X ⊎′ C _⋆_ : ∀ {ℓ} {O : Set ℓ} → Container O O ℓ ℓ → Pt O ℓ C ⋆ X = μ (C ⋆C X) pattern returnP x = (inj₁ x , _) pattern doP c k = (inj₂ c , k) inn : ∀ {ℓ} {O : Set ℓ} {C : Container O O ℓ ℓ} {X} → ⟦ C ⟧ (C ⋆ X) ⊆ C ⋆ X inn (c , k) = sup (doP c k) rawPMonad : ∀ {ℓ} {O : Set ℓ} {C : Container O O ℓ ℓ} → RawPMonad {ℓ = ℓ} (_⋆_ C) rawPMonad {C = C} = record { return? = return ; _=_ _<*>_ : Erased (A → B) → Erased A → Erased B [ f ] <*> [ a ] = [ f a ] infixl 1 _>>=_ _>>=_ : Erased A → (.A → Erased B) → Erased B [ a ] >>= f = f a ------------------------------------------------------------------------ -- Other functions zipWith : (A → B → C) → Erased A → Erased B → Erased C zipWith f a b = ⦇ f a b ⦈ agda-stdlib-1.7.3/src/Data/Fin.agda000066400000000000000000000015221451211343400166650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finite sets ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin where open import Relation.Nullary.Decidable.Core open import Data.Nat.Base using (suc) import Data.Nat.Properties as ℕₚ ------------------------------------------------------------------------ -- Publicly re-export the contents of the base module open import Data.Fin.Base public ------------------------------------------------------------------------ -- Publicly re-export queries open import Data.Fin.Properties public using (_≟_; _≤?_; _i then j-1 else j -- This is a variant of the thick function from Conor -- McBride's "First-order unification by structural recursion". punchOut : ∀ {m} {i j : Fin (suc m)} → i ≢ j → Fin m punchOut {_} {zero} {zero} i≢j = ⊥-elim (i≢j refl) punchOut {_} {zero} {suc j} _ = j punchOut {suc m} {suc i} {zero} _ = zero punchOut {suc m} {suc i} {suc j} i≢j = suc (punchOut (i≢j ∘ cong suc)) -- The function f(i,j) = if j≥i then j+1 else j punchIn : ∀ {m} → Fin (suc m) → Fin m → Fin (suc m) punchIn zero j = suc j punchIn (suc i) zero = zero punchIn (suc i) (suc j) = suc (punchIn i j) -- The function f(i,j) such that f(i,j) = if j≤i then j else j-1 pinch : ∀ {n} → Fin n → Fin (suc n) → Fin n pinch {suc n} _ zero = zero pinch {suc n} zero (suc j) = j pinch {suc n} (suc i) (suc j) = suc (pinch i j) ------------------------------------------------------------------------ -- Order relations infix 4 _≤_ _≥_ _<_ _>_ _≤_ : ∀ {n} → Rel (Fin n) 0ℓ _≤_ = ℕ._≤_ on toℕ _≥_ : ∀ {n} → Rel (Fin n) 0ℓ _≥_ = ℕ._≥_ on toℕ _<_ : ∀ {n} → Rel (Fin n) 0ℓ _<_ = ℕ._<_ on toℕ _>_ : ∀ {n} → Rel (Fin n) 0ℓ _>_ = ℕ._>_ on toℕ data _≺_ : ℕ → ℕ → Set where _≻toℕ_ : ∀ n (i : Fin n) → toℕ i ≺ n ------------------------------------------------------------------------ -- An ordering view. data Ordering {n : ℕ} : Fin n → Fin n → Set where less : ∀ greatest (least : Fin′ greatest) → Ordering (inject least) greatest equal : ∀ i → Ordering i i greater : ∀ greatest (least : Fin′ greatest) → Ordering greatest (inject least) compare : ∀ {n} (i j : Fin n) → Ordering i j compare zero zero = equal zero compare zero (suc j) = less (suc j) zero compare (suc i) zero = greater (suc i) zero compare (suc i) (suc j) with compare i j ... | less greatest least = less (suc greatest) (suc least) ... | greater greatest least = greater (suc greatest) (suc least) ... | equal i = equal (suc i) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.2 fromℕ≤ = fromℕ< {-# WARNING_ON_USAGE fromℕ≤ "Warning: fromℕ≤ was deprecated in v1.2. Please use fromℕ< instead." #-} fromℕ≤″ = fromℕ<″ {-# WARNING_ON_USAGE fromℕ≤″ "Warning: fromℕ≤″ was deprecated in v1.2. Please use fromℕ<″ instead." #-} agda-stdlib-1.7.3/src/Data/Fin/Dec.agda000066400000000000000000000013311451211343400173560ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use the Data.Fin.Properties -- and Data.Fin.Subset.Properties directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Dec where open import Data.Fin.Properties public using (decFinSubset; any?; all?; ¬∀⟶∃¬-smallest; ¬∀⟶∃¬) open import Data.Fin.Subset.Properties public using (_∈?_; _⊆?_; nonempty?; anySubset?) renaming (Lift? to decLift) {-# WARNING_ON_IMPORT "Data.Fin.Dec was deprecated in v0.17. Use Data.Fin.Properties and Data.Fin.Subset.Properties instead." #-} agda-stdlib-1.7.3/src/Data/Fin/Induction.agda000066400000000000000000000071471451211343400206320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Induction over Fin ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.Fin.Base open import Data.Fin.Properties open import Data.Nat.Base as ℕ using (ℕ; zero; suc; z≤n; s≤s; _∸_) import Data.Nat.Induction as ℕ import Data.Nat.Properties as ℕ open import Induction open import Induction.WellFounded as WF open import Level using (Level) import Relation.Binary.Construct.On as On open import Relation.Unary using (Pred) open import Relation.Nullary using (yes; no) open import Relation.Binary.PropositionalEquality module Data.Fin.Induction where private variable ℓ : Level n : ℕ ------------------------------------------------------------------------ -- Re-export accessability open WF public using (Acc; acc) ------------------------------------------------------------------------ -- Induction over _<_ <-wellFounded : WellFounded {A = Fin n} _<_ <-wellFounded = On.wellFounded toℕ ℕ.<-wellFounded <-weakInduction : (P : Pred (Fin (suc n)) ℓ) → P zero → (∀ i → P (inject₁ i) → P (suc i)) → ∀ i → P i <-weakInduction P P₀ Pᵢ⇒Pᵢ₊₁ i = induct (<-wellFounded i) where induct : ∀ {i} → Acc _<_ i → P i induct {zero} _ = P₀ induct {suc i} (acc rec) = Pᵢ⇒Pᵢ₊₁ i (induct (rec (inject₁ i) i_ private acc-map : ∀ {x : Fin n} → Acc ℕ._<_ (n ∸ toℕ x) → Acc _>_ x acc-map {n} (acc rs) = acc (λ y y>x → acc-map (rs (n ∸ toℕ y) (ℕ.∸-monoʳ-< y>x (toℕ≤n y)))) >-wellFounded : WellFounded {A = Fin n} _>_ >-wellFounded {n} x = acc-map (ℕ.<-wellFounded (n ∸ toℕ x)) >-weakInduction : (P : Pred (Fin (suc n)) ℓ) → P (fromℕ n) → (∀ i → P (suc i) → P (inject₁ i)) → ∀ i → P i >-weakInduction {n = n} P Pₙ Pᵢ₊₁⇒Pᵢ i = induct (>-wellFounded i) where induct : ∀ {i} → Acc _>_ i → P i induct {i} (acc rec) with n ℕ.≟ toℕ i ... | yes n≡i = subst P (toℕ-injective (trans (toℕ-fromℕ n) n≡i)) Pₙ ... | no n≢i = subst P (inject₁-lower₁ i n≢i) (Pᵢ₊₁⇒Pᵢ _ Pᵢ₊₁) where Pᵢ₊₁ = induct (rec _ (s≤s (ℕ.≤-reflexive (sym (toℕ-lower₁ i n≢i))))) ------------------------------------------------------------------------ -- Induction over _≺_ ≺-Rec : RecStruct ℕ ℓ ℓ ≺-Rec = WfRec _≺_ ≺-wellFounded : WellFounded _≺_ ≺-wellFounded = Subrelation.wellFounded ≺⇒<′ ℕ.<′-wellFounded module _ {ℓ} where open WF.All ≺-wellFounded ℓ public renaming ( wfRecBuilder to ≺-recBuilder ; wfRec to ≺-rec ) hiding (wfRec-builder) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 ≺-rec-builder = ≺-recBuilder {-# WARNING_ON_USAGE ≺-rec-builder "Warning: ≺-rec-builder was deprecated in v0.15. Please use ≺-recBuilder instead." #-} ≺-well-founded = ≺-wellFounded {-# WARNING_ON_USAGE ≺-well-founded "Warning: ≺-well-founded was deprecated in v0.15. Please use ≺-wellFounded instead." #-} agda-stdlib-1.7.3/src/Data/Fin/Instances.agda000066400000000000000000000007041451211343400206150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances for finite sets ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Instances where open import Data.Fin.Base open import Data.Fin.Properties instance Fin-≡-isDecEquivalence = ≡-isDecEquivalence Fin-≤-isDecTotalOrder = ≤-isDecTotalOrder agda-stdlib-1.7.3/src/Data/Fin/Literals.agda000066400000000000000000000011131451211343400204400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Fin Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Literals where open import Agda.Builtin.FromNat open import Data.Nat using (suc; _≤?_) open import Data.Fin using (Fin ; #_) open import Relation.Nullary.Decidable using (True) number : ∀ n → Number (Fin n) number n = record { Constraint = λ m → True (suc m ≤? n) ; fromNat = λ m {{pr}} → (# m) {n} {pr} } agda-stdlib-1.7.3/src/Data/Fin/Patterns.agda000066400000000000000000000011141451211343400204620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Patterns for Fin ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Patterns where open import Data.Fin.Base ------------------------------------------------------------------------ -- Constants pattern 0F = zero pattern 1F = suc 0F pattern 2F = suc 1F pattern 3F = suc 2F pattern 4F = suc 3F pattern 5F = suc 4F pattern 6F = suc 5F pattern 7F = suc 6F pattern 8F = suc 7F pattern 9F = suc 8F agda-stdlib-1.7.3/src/Data/Fin/Permutation.agda000066400000000000000000000217641451211343400212060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bijections on finite sets (i.e. permutations). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Permutation where open import Data.Bool using (true; false) open import Data.Empty using (⊥-elim) open import Data.Fin.Base open import Data.Fin.Patterns open import Data.Fin.Properties import Data.Fin.Permutation.Components as PC open import Data.Nat.Base using (ℕ; suc; zero) open import Data.Product using (proj₂) open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_) open import Function.Equality using (_⟨$⟩_) open import Function.Base using (_∘_) open import Level using (0ℓ) open import Relation.Binary using (Rel) open import Relation.Nullary using (does; ¬_; yes; no) open import Relation.Nullary.Negation using (contradiction) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl; trans; sym; →-to-⟶; cong; cong₂) open P.≡-Reasoning private variable m n o : ℕ ------------------------------------------------------------------------ -- Types -- A bijection between finite sets of potentially different sizes. -- There only exist inhabitants of this type if in fact m = n, however -- it is often easier to prove the existence of a bijection without -- first proving that the sets have the same size. Indeed such a -- bijection is a useful way to prove that the sets are in fact the same -- size. See '↔-≡' below. Permutation : ℕ → ℕ → Set Permutation m n = Fin m ↔ Fin n Permutation′ : ℕ → Set Permutation′ n = Permutation n n ------------------------------------------------------------------------ -- Helper functions permutation : ∀ (f : Fin m → Fin n) (g : Fin n → Fin m) → (→-to-⟶ g) InverseOf (→-to-⟶ f) → Permutation m n permutation f g inv = record { to = →-to-⟶ f ; from = →-to-⟶ g ; inverse-of = inv } infixl 5 _⟨$⟩ʳ_ _⟨$⟩ˡ_ _⟨$⟩ʳ_ : Permutation m n → Fin m → Fin n _⟨$⟩ʳ_ = _⟨$⟩_ ∘ Inverse.to _⟨$⟩ˡ_ : Permutation m n → Fin n → Fin m _⟨$⟩ˡ_ = _⟨$⟩_ ∘ Inverse.from inverseˡ : ∀ (π : Permutation m n) {i} → π ⟨$⟩ˡ (π ⟨$⟩ʳ i) ≡ i inverseˡ π = Inverse.left-inverse-of π _ inverseʳ : ∀ (π : Permutation m n) {i} → π ⟨$⟩ʳ (π ⟨$⟩ˡ i) ≡ i inverseʳ π = Inverse.right-inverse-of π _ ------------------------------------------------------------------------ -- Equality infix 6 _≈_ _≈_ : Rel (Permutation m n) 0ℓ π ≈ ρ = ∀ i → π ⟨$⟩ʳ i ≡ ρ ⟨$⟩ʳ i ------------------------------------------------------------------------ -- Example permutations -- Identity id : Permutation′ n id = Inverse.id -- Transpose two indices transpose : Fin n → Fin n → Permutation′ n transpose i j = permutation (PC.transpose i j) (PC.transpose j i) record { left-inverse-of = λ _ → PC.transpose-inverse _ _ ; right-inverse-of = λ _ → PC.transpose-inverse _ _ } -- Reverse the order of indices reverse : Permutation′ n reverse = permutation PC.reverse PC.reverse record { left-inverse-of = PC.reverse-involutive ; right-inverse-of = PC.reverse-involutive } ------------------------------------------------------------------------ -- Operations -- Composition infixr 9 _∘ₚ_ _∘ₚ_ : Permutation m n → Permutation n o → Permutation m o π₁ ∘ₚ π₂ = π₂ Inverse.∘ π₁ -- Flip flip : Permutation m n → Permutation n m flip = Inverse.sym -- Element removal -- -- `remove k [0 ↦ i₀, …, k ↦ iₖ, …, n ↦ iₙ]` yields -- -- [0 ↦ i₀, …, k-1 ↦ iₖ₋₁, k ↦ iₖ₊₁, k+1 ↦ iₖ₊₂, …, n-1 ↦ iₙ] remove : Fin (suc m) → Permutation (suc m) (suc n) → Permutation m n remove {m} {n} i π = permutation to from record { left-inverse-of = left-inverse-of ; right-inverse-of = right-inverse-of } where πʳ = π ⟨$⟩ʳ_ πˡ = π ⟨$⟩ˡ_ permute-≢ : ∀ {i j} → i ≢ j → πʳ i ≢ πʳ j permute-≢ p = p ∘ (Inverse.injective π) to-punchOut : ∀ {j : Fin m} → πʳ i ≢ πʳ (punchIn i j) to-punchOut = permute-≢ (punchInᵢ≢i _ _ ∘ sym) from-punchOut : ∀ {j : Fin n} → i ≢ πˡ (punchIn (πʳ i) j) from-punchOut {j} p = punchInᵢ≢i (πʳ i) j (sym (begin πʳ i ≡⟨ cong πʳ p ⟩ πʳ (πˡ (punchIn (πʳ i) j)) ≡⟨ inverseʳ π ⟩ punchIn (πʳ i) j ∎)) to : Fin m → Fin n to j = punchOut (to-punchOut {j}) from : Fin n → Fin m from j = punchOut {j = πˡ (punchIn (πʳ i) j)} from-punchOut left-inverse-of : ∀ j → from (to j) ≡ j left-inverse-of j = begin from (to j) ≡⟨⟩ punchOut {i = i} {πˡ (punchIn (πʳ i) (punchOut to-punchOut))} _ ≡⟨ punchOut-cong′ i (cong πˡ (punchIn-punchOut _)) ⟩ punchOut {i = i} {πˡ (πʳ (punchIn i j))} _ ≡⟨ punchOut-cong i (inverseˡ π) ⟩ punchOut {i = i} {punchIn i j} _ ≡⟨ punchOut-punchIn i ⟩ j ∎ right-inverse-of : ∀ j → to (from j) ≡ j right-inverse-of j = begin to (from j) ≡⟨⟩ punchOut {i = πʳ i} {πʳ (punchIn i (punchOut from-punchOut))} _ ≡⟨ punchOut-cong′ (πʳ i) (cong πʳ (punchIn-punchOut _)) ⟩ punchOut {i = πʳ i} {πʳ (πˡ (punchIn (πʳ i) j))} _ ≡⟨ punchOut-cong (πʳ i) (inverseʳ π) ⟩ punchOut {i = πʳ i} {punchIn (πʳ i) j} _ ≡⟨ punchOut-punchIn (πʳ i) ⟩ j ∎ -- lift: takes a permutation m → n and creates a permutation (suc m) → (suc n) -- by mapping 0 to 0 and applying the input permutation to everything else lift₀ : Permutation m n → Permutation (suc m) (suc n) lift₀ {m} {n} π = permutation to from record { left-inverse-of = left-inverse-of ; right-inverse-of = right-inverse-of } where to : Fin (suc m) → Fin (suc n) to 0F = 0F to (suc i) = suc (π ⟨$⟩ʳ i) from : Fin (suc n) → Fin (suc m) from 0F = 0F from (suc i) = suc (π ⟨$⟩ˡ i) left-inverse-of : ∀ j → from (to j) ≡ j left-inverse-of 0F = refl left-inverse-of (suc j) = cong suc (inverseˡ π) right-inverse-of : ∀ j → to (from j) ≡ j right-inverse-of 0F = refl right-inverse-of (suc j) = cong suc (inverseʳ π) ------------------------------------------------------------------------ -- Other properties module _ (π : Permutation (suc m) (suc n)) where private πʳ = π ⟨$⟩ʳ_ πˡ = π ⟨$⟩ˡ_ punchIn-permute : ∀ i j → πʳ (punchIn i j) ≡ punchIn (πʳ i) (remove i π ⟨$⟩ʳ j) punchIn-permute i j = sym (punchIn-punchOut _) punchIn-permute′ : ∀ i j → πʳ (punchIn (πˡ i) j) ≡ punchIn i (remove (πˡ i) π ⟨$⟩ʳ j) punchIn-permute′ i j = begin πʳ (punchIn (πˡ i) j) ≡⟨ punchIn-permute _ _ ⟩ punchIn (πʳ (πˡ i)) (remove (πˡ i) π ⟨$⟩ʳ j) ≡⟨ cong₂ punchIn (inverseʳ π) refl ⟩ punchIn i (remove (πˡ i) π ⟨$⟩ʳ j) ∎ lift₀-remove : πʳ 0F ≡ 0F → lift₀ (remove 0F π) ≈ π lift₀-remove p 0F = sym p lift₀-remove p (suc i) = punchOut-zero (πʳ (suc i)) p where punchOut-zero : ∀ {i} (j : Fin (suc n)) {neq} → i ≡ 0F → suc (punchOut {i = i} {j} neq) ≡ j punchOut-zero 0F {neq} p = ⊥-elim (neq p) punchOut-zero (suc j) refl = refl ↔⇒≡ : Permutation m n → m ≡ n ↔⇒≡ {zero} {zero} π = refl ↔⇒≡ {zero} {suc n} π = contradiction (π ⟨$⟩ˡ 0F) ¬Fin0 ↔⇒≡ {suc m} {zero} π = contradiction (π ⟨$⟩ʳ 0F) ¬Fin0 ↔⇒≡ {suc m} {suc n} π = cong suc (↔⇒≡ (remove 0F π)) fromPermutation : Permutation m n → Permutation′ m fromPermutation π = P.subst (Permutation _) (sym (↔⇒≡ π)) π refute : m ≢ n → ¬ Permutation m n refute m≢n π = contradiction (↔⇒≡ π) m≢n lift₀-id : (i : Fin (suc n)) → lift₀ id ⟨$⟩ʳ i ≡ i lift₀-id 0F = refl lift₀-id (suc i) = refl lift₀-comp : ∀ (π : Permutation m n) (ρ : Permutation n o) → lift₀ π ∘ₚ lift₀ ρ ≈ lift₀ (π ∘ₚ ρ) lift₀-comp π ρ 0F = refl lift₀-comp π ρ (suc i) = refl lift₀-cong : ∀ (π ρ : Permutation m n) → π ≈ ρ → lift₀ π ≈ lift₀ ρ lift₀-cong π ρ f 0F = refl lift₀-cong π ρ f (suc i) = cong suc (f i) lift₀-transpose : ∀ (i j : Fin n) → transpose (suc i) (suc j) ≈ lift₀ (transpose i j) lift₀-transpose i j 0F = refl lift₀-transpose i j (suc k) with does (k ≟ i) ... | true = refl ... | false with does (k ≟ j) ... | false = refl ... | true = refl agda-stdlib-1.7.3/src/Data/Fin/Permutation/000077500000000000000000000000001451211343400203565ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Fin/Permutation/Components.agda000066400000000000000000000064371451211343400233330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Component functions of permutations found in `Data.Fin.Permutation` ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Fin.Permutation.Components where open import Data.Bool.Base using (Bool; true; false) open import Data.Fin.Base open import Data.Fin.Properties open import Data.Nat.Base as ℕ using (zero; suc; _∸_) import Data.Nat.Properties as ℕₚ open import Data.Product using (proj₂) open import Function.Base using (_∘_) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary using (does; _because_; yes; no) open import Relation.Nullary.Decidable using (dec-true; dec-false) open import Relation.Binary.PropositionalEquality open import Algebra.Definitions using (Involutive) open ≡-Reasoning -------------------------------------------------------------------------------- -- Functions -------------------------------------------------------------------------------- -- 'tranpose i j' swaps the places of 'i' and 'j'. transpose : ∀ {n} → Fin n → Fin n → Fin n → Fin n transpose i j k with does (k ≟ i) ... | true = j ... | false with does (k ≟ j) ... | true = i ... | false = k -- reverse i = n ∸ 1 ∸ i reverse : ∀ {n} → Fin n → Fin n reverse {suc n} i = inject≤ (n ℕ- i) (ℕₚ.m∸n≤m (suc n) (toℕ i)) -------------------------------------------------------------------------------- -- Properties -------------------------------------------------------------------------------- transpose-inverse : ∀ {n} (i j : Fin n) {k} → transpose i j (transpose j i k) ≡ k transpose-inverse i j {k} with k ≟ j ... | true because [k≡j] rewrite dec-true (i ≟ i) refl = sym (invert [k≡j]) ... | false because [k≢j] with k ≟ i ... | true because [k≡i] rewrite dec-false (j ≟ i) (invert [k≢j] ∘ trans (invert [k≡i]) ∘ sym) | dec-true (j ≟ j) refl = sym (invert [k≡i]) ... | false because [k≢i] rewrite dec-false (k ≟ i) (invert [k≢i]) | dec-false (k ≟ j) (invert [k≢j]) = refl reverse-prop : ∀ {n} → (i : Fin n) → toℕ (reverse i) ≡ n ∸ suc (toℕ i) reverse-prop {suc n} i = begin toℕ (inject≤ (n ℕ- i) _) ≡⟨ toℕ-inject≤ _ (ℕₚ.m∸n≤m (suc n) (toℕ i)) ⟩ toℕ (n ℕ- i) ≡⟨ toℕ‿ℕ- n i ⟩ n ∸ toℕ i ∎ reverse-involutive : ∀ {n} → Involutive _≡_ (reverse {n}) reverse-involutive {suc n} i = toℕ-injective (begin toℕ (reverse (reverse i)) ≡⟨ reverse-prop (reverse i) ⟩ n ∸ (toℕ (reverse i)) ≡⟨ cong (n ∸_) (reverse-prop i) ⟩ n ∸ (n ∸ (toℕ i)) ≡⟨ ℕₚ.m∸[m∸n]≡n (ℕₚ.≤-pred (toℕ) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂; [_,_]; [_,_]′) open import Data.Sum.Properties using ([,]-map-commute; [,]-∘-distr) open import Function.Base using (_∘_; id; _$_) open import Function.Bundles using (_↔_; mk↔′) open import Function.Definitions.Core2 using (Surjective) open import Function.Equivalence using (_⇔_; equivalence) open import Function.Injection using (_↣_) open import Relation.Binary as B hiding (Decidable; _⇔_) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl; sym; trans; cong; subst; module ≡-Reasoning) open import Relation.Nullary.Decidable as Dec using (map′) open import Relation.Nullary.Reflects open import Relation.Nullary.Negation using (contradiction) open import Relation.Nullary using (Reflects; ofʸ; ofⁿ; Dec; _because_; does; proof; yes; no; ¬_) open import Relation.Nullary.Product using (_×-dec_) open import Relation.Nullary.Sum using (_⊎-dec_) open import Relation.Unary as U using (U; Pred; Decidable; _⊆_; Satisfiable; Universal) open import Relation.Unary.Properties using (U?) ------------------------------------------------------------------------ -- Fin ------------------------------------------------------------------------ ¬Fin0 : ¬ Fin 0 ¬Fin0 () ------------------------------------------------------------------------ -- Bundles Fin0↔⊥ : Fin 0 ↔ ⊥ Fin0↔⊥ = mk↔′ ¬Fin0 (λ ()) (λ ()) (λ ()) ------------------------------------------------------------------------ -- Properties of _≡_ ------------------------------------------------------------------------ suc-injective : ∀ {o} {m n : Fin o} → Fin.suc m ≡ suc n → m ≡ n suc-injective refl = refl infix 4 _≟_ _≟_ : ∀ {n} → B.Decidable {A = Fin n} _≡_ zero ≟ zero = yes refl zero ≟ suc y = no λ() suc x ≟ zero = no λ() suc x ≟ suc y = map′ (cong suc) suc-injective (x ≟ y) ------------------------------------------------------------------------ -- Structures ≡-isDecEquivalence : ∀ {n} → IsDecEquivalence (_≡_ {A = Fin n}) ≡-isDecEquivalence = record { isEquivalence = P.isEquivalence ; _≟_ = _≟_ } ------------------------------------------------------------------------ -- Bundles ≡-preorder : ℕ → Preorder _ _ _ ≡-preorder n = P.preorder (Fin n) ≡-setoid : ℕ → Setoid _ _ ≡-setoid n = P.setoid (Fin n) ≡-decSetoid : ℕ → DecSetoid _ _ ≡-decSetoid n = record { isDecEquivalence = ≡-isDecEquivalence {n} } ------------------------------------------------------------------------ -- toℕ ------------------------------------------------------------------------ toℕ-injective : ∀ {n} {i j : Fin n} → toℕ i ≡ toℕ j → i ≡ j toℕ-injective {zero} {} {} _ toℕ-injective {suc n} {zero} {zero} eq = refl toℕ-injective {suc n} {suc i} {suc j} eq = cong suc (toℕ-injective (cong ℕ.pred eq)) toℕ-strengthen : ∀ {n} (i : Fin n) → toℕ (strengthen i) ≡ toℕ i toℕ-strengthen zero = refl toℕ-strengthen (suc i) = cong suc (toℕ-strengthen i) toℕ-raise : ∀ {m} n (i : Fin m) → toℕ (raise n i) ≡ n ℕ.+ toℕ i toℕ-raise zero i = refl toℕ-raise (suc n) i = cong suc (toℕ-raise n i) toℕ (λ()) (λ()) (s≤s z≤n) <-cmp (suc i) (suc j) with <-cmp i j ... | tri< i i≮j i≢j j (i≮j ∘ ℕₚ.≤-pred) (i≢j ∘ suc-injective) (s≤s j ∃-here : P zero → ∃⟨ P ⟩ ∃-here = zero ,_ ∃-there : ∃⟨ P ∘ suc ⟩ → ∃⟨ P ⟩ ∃-there = map suc id ∃-toSum : ∃⟨ P ⟩ → P zero ⊎ ∃⟨ P ∘ suc ⟩ ∃-toSum ( zero , P₀ ) = inj₁ P₀ ∃-toSum (suc f , P₁₊) = inj₂ (f , P₁₊) ⊎⇔∃ : (P zero ⊎ ∃⟨ P ∘ suc ⟩) ⇔ ∃⟨ P ⟩ ⊎⇔∃ = equivalence [ ∃-here , ∃-there ] ∃-toSum decFinSubset : ∀ {n p q} {P : Pred (Fin n) p} {Q : Pred (Fin n) q} → Decidable Q → (∀ {f} → Q f → Dec (P f)) → Dec (Q ⊆ P) decFinSubset {zero} Q? P? = yes λ {} decFinSubset {suc n} {P = P} {Q} Q? P? with Q? zero | ∀-cons {P = λ x → Q x → P x} ... | false because [¬Q0] | cons = map′ (λ f {x} → cons (⊥-elim ∘ invert [¬Q0]) (λ x → f {x}) x) (λ f {x} → f {suc x}) (decFinSubset (Q? ∘ suc) P?) ... | true because [Q0] | cons = map′ (uncurry λ P0 rec {x} → cons (λ _ → P0) (λ x → rec {x}) x) < _$ invert [Q0] , (λ f {x} → f {suc x}) > (P? (invert [Q0]) ×-dec decFinSubset (Q? ∘ suc) P?) any? : ∀ {n p} {P : Fin n → Set p} → Decidable P → Dec (∃ P) any? {zero} {P = _} P? = no λ { (() , _) } any? {suc n} {P = P} P? = Dec.map ⊎⇔∃ (P? zero ⊎-dec any? (P? ∘ suc)) all? : ∀ {n p} {P : Pred (Fin n) p} → Decidable P → Dec (∀ f → P f) all? P? = map′ (λ ∀p f → ∀p tt) (λ ∀p {x} _ → ∀p x) (decFinSubset U? (λ {f} _ → P? f)) private -- A nice computational property of `all?`: -- The boolean component of the result is exactly the -- obvious fold of boolean tests (`foldr _∧_ true`). note : ∀ {p} {P : Pred (Fin 3) p} (P? : Decidable P) → ∃ λ z → does (all? P?) ≡ z note P? = does (P? 0F) ∧ does (P? 1F) ∧ does (P? 2F) ∧ true , refl -- If a decidable predicate P over a finite set is sometimes false, -- then we can find the smallest value for which this is the case. ¬∀⟶∃¬-smallest : ∀ n {p} (P : Pred (Fin n) p) → Decidable P → ¬ (∀ i → P i) → ∃ λ i → ¬ P i × ((j : Fin′ i) → P (inject j)) ¬∀⟶∃¬-smallest zero P P? ¬∀P = contradiction (λ()) ¬∀P ¬∀⟶∃¬-smallest (suc n) P P? ¬∀P with P? zero ... | false because [¬P₀] = (zero , invert [¬P₀] , λ ()) ... | true because [P₀] = map suc (map id (∀-cons (invert [P₀]))) (¬∀⟶∃¬-smallest n (P ∘ suc) (P? ∘ suc) (¬∀P ∘ (∀-cons (invert [P₀])))) -- When P is a decidable predicate over a finite set the following -- lemma can be proved. ¬∀⟶∃¬ : ∀ n {p} (P : Pred (Fin n) p) → Decidable P → ¬ (∀ i → P i) → (∃ λ i → ¬ P i) ¬∀⟶∃¬ n P P? ¬P = map id proj₁ (¬∀⟶∃¬-smallest n P P? ¬P) -- The pigeonhole principle. pigeonhole : ∀ {m n} → m ℕ.< n → (f : Fin n → Fin m) → ∃₂ λ i j → i ≢ j × f i ≡ f j pigeonhole (s≤s z≤n) f = contradiction (f zero) λ() pigeonhole (s≤s (s≤s m≤n)) f with any? (λ k → f zero ≟ f (suc k)) ... | yes (j , f₀≡fⱼ) = zero , suc j , (λ()) , f₀≡fⱼ ... | no f₀≢fₖ with pigeonhole (s≤s m≤n) (λ j → punchOut (f₀≢fₖ ∘ (j ,_ ))) ... | (i , j , i≢j , fᵢ≡fⱼ) = suc i , suc j , i≢j ∘ suc-injective , punchOut-injective (f₀≢fₖ ∘ (i ,_)) _ fᵢ≡fⱼ ------------------------------------------------------------------------ -- Categorical ------------------------------------------------------------------------ module _ {f} {F : Set f → Set f} (RA : RawApplicative F) where open RawApplicative RA sequence : ∀ {n} {P : Pred (Fin n) f} → (∀ i → F (P i)) → F (∀ i → P i) sequence {zero} ∀iPi = pure λ() sequence {suc n} ∀iPi = ∀-cons <$> ∀iPi zero ⊛ sequence (∀iPi ∘ suc) module _ {f} {F : Set f → Set f} (RF : RawFunctor F) where open RawFunctor RF sequence⁻¹ : ∀ {A : Set f} {P : Pred A f} → F (∀ i → P i) → (∀ i → F (P i)) sequence⁻¹ F∀iPi i = (λ f → f i) <$> F∀iPi ------------------------------------------------------------------------ -- If there is an injection from a type to a finite set, then the type -- has decidable equality. module _ {a} {A : Set a} where eq? : ∀ {n} → A ↣ Fin n → B.Decidable {A = A} _≡_ eq? inj = Dec.via-injection inj _≟_ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 cmp = <-cmp {-# WARNING_ON_USAGE cmp "Warning: cmp was deprecated in v0.15. Please use <-cmp instead." #-} strictTotalOrder = <-strictTotalOrder {-# WARNING_ON_USAGE strictTotalOrder "Warning: strictTotalOrder was deprecated in v0.15. Please use <-strictTotalOrder instead." #-} -- Version 0.16 to-from = toℕ-fromℕ {-# WARNING_ON_USAGE to-from "Warning: to-from was deprecated in v0.16. Please use toℕ-fromℕ instead." #-} from-to = fromℕ-toℕ {-# WARNING_ON_USAGE from-to "Warning: from-to was deprecated in v0.16. Please use fromℕ-toℕ instead." #-} bounded = toℕ>=_) open import Data.Nat as ℕ using (ℕ; _≤?_; __ _≰_ _≱_ _≮_ _≯_ infix 4 _≤ᵇ_ ------------------------------------------------------------------------ -- Types open import Agda.Builtin.Int public using () renaming ( Int to ℤ ; pos to +_ -- "+ n" stands for "n" ; negsuc to -[1+_] -- "-[1+ n ]" stands for "- (1 + n)" ) -- Some additional patterns that provide symmetry around 0 pattern +0 = + 0 pattern +[1+_] n = + (ℕ.suc n) ------------------------------------------------------------------------ -- Constants 0ℤ : ℤ 0ℤ = +0 -1ℤ : ℤ -1ℤ = -[1+ 0 ] 1ℤ : ℤ 1ℤ = +[1+ 0 ] ------------------------------------------------------------------------ -- Conversion -- Absolute value. ∣_∣ : ℤ → ℕ ∣ + n ∣ = n ∣ -[1+ n ] ∣ = ℕ.suc n -- Gives the sign. For zero the sign is arbitrarily chosen to be +. sign : ℤ → Sign sign (+ _) = Sign.+ sign -[1+ _ ] = Sign.- ------------------------------------------------------------------------ -- Ordering data _≤_ : ℤ → ℤ → Set where -≤- : ∀ {m n} → (n≤m : n ℕ.≤ m) → -[1+ m ] ≤ -[1+ n ] -≤+ : ∀ {m n} → -[1+ m ] ≤ + n +≤+ : ∀ {m n} → (m≤n : m ℕ.≤ n) → + m ≤ + n data _<_ : ℤ → ℤ → Set where -<- : ∀ {m n} → (n_ : Rel ℤ 0ℓ x > y = y < x _≰_ : Rel ℤ 0ℓ x ≰ y = ¬ (x ≤ y) _≱_ : Rel ℤ 0ℓ x ≱ y = ¬ (x ≥ y) _≮_ : Rel ℤ 0ℓ x ≮ y = ¬ (x < y) _≯_ : Rel ℤ 0ℓ x ≯ y = ¬ (x > y) ------------------------------------------------------------------------ -- Boolean ordering -- A boolean version. _≤ᵇ_ : ℤ → ℤ → Bool -[1+ m ] ≤ᵇ -[1+ n ] = n ℕ.≤ᵇ m (+ m) ≤ᵇ -[1+ n ] = false -[1+ m ] ≤ᵇ (+ n) = true (+ m) ≤ᵇ (+ n) = m ℕ.≤ᵇ n ------------------------------------------------------------------------ -- Simple predicates -- See `Data.Nat.Base` for a discussion on the design of these. NonZero : Pred ℤ 0ℓ NonZero i = ℕ.NonZero ∣ i ∣ Positive : Pred ℤ 0ℓ Positive +[1+ n ] = ⊤ Positive +0 = ⊥ Positive -[1+ n ] = ⊥ Negative : Pred ℤ 0ℓ Negative (+ n) = ⊥ Negative -[1+ n ] = ⊤ NonPositive : Pred ℤ 0ℓ NonPositive +[1+ n ] = ⊥ NonPositive +0 = ⊤ NonPositive -[1+ n ] = ⊤ NonNegative : Pred ℤ 0ℓ NonNegative (+ n) = ⊤ NonNegative -[1+ n ] = ⊥ -- Constructors ≢-nonZero : ∀ {i} → i ≢ 0ℤ → NonZero i ≢-nonZero { +[1+ n ]} _ = _ ≢-nonZero { +0} 0≢0 = 0≢0 refl ≢-nonZero { -[1+ n ]} _ = _ >-nonZero : ∀ {i} → i > 0ℤ → NonZero i >-nonZero (+<+ (s≤s m 0ℤ → Positive i positive (+<+ (s≤s m′_ _≮′_ _≯′_ _<′_ : Rel ℤ _ x <′ y = suc x ≤ y {-# WARNING_ON_USAGE _<′_ "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} _>′_ : Rel ℤ _ x >′ y = y <′ x {-# WARNING_ON_USAGE _>′_ "Warning: _>′_ was deprecated in v1.1. Please use _>_ instead." #-} _≮′_ : Rel ℤ _ x ≮′ y = ¬ (x <′ y) {-# WARNING_ON_USAGE _≮′_ "Warning: _≮′_ was deprecated in v1.1. Please use _≮_ instead." #-} _≯′_ : Rel ℤ _ x ≯′ y = ¬ (x >′ y) {-# WARNING_ON_USAGE _≯′_ "Warning: _≯′_ was deprecated in v1.1. Please use _≯_ instead." #-} agda-stdlib-1.7.3/src/Data/Integer/Coprimality.agda000066400000000000000000000022511451211343400220420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Coprimality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Integer.Coprimality where open import Data.Integer.Base open import Data.Integer.Divisibility open import Data.Integer.Properties import Data.Nat.Coprimality as ℕ import Data.Nat.Divisibility as ℕ open import Function.Base using (_on_) open import Level using (0ℓ) open import Relation.Binary using (Rel; Decidable; Symmetric) open import Relation.Binary.PropositionalEquality using (subst) ------------------------------------------------------------------------ -- Definition Coprime : Rel ℤ 0ℓ Coprime = ℕ.Coprime on ∣_∣ ------------------------------------------------------------------------ -- Properties of coprimality sym : Symmetric Coprime sym = ℕ.sym coprime? : Decidable Coprime coprime? x y = ℕ.coprime? ∣ x ∣ ∣ y ∣ coprime-divisor : ∀ i j k → Coprime i j → i ∣ j * k → i ∣ k coprime-divisor i j k c eq = ℕ.coprime-divisor c (subst (∣ i ∣ ℕ.∣_ ) (abs-*-commute j k) eq) agda-stdlib-1.7.3/src/Data/Integer/DivMod.agda000066400000000000000000000174761451211343400207470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Integer division ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Integer.DivMod where open import Data.Bool.Base using (true; false) open import Data.Fin.Base as Fin using (Fin) import Data.Fin.Properties as FProp open import Data.Integer.Base as ℤ open import Data.Integer.Properties open import Data.Nat as ℕ using (ℕ) import Data.Nat.Properties as NProp import Data.Nat.DivMod as NDM import Data.Sign as S import Data.Sign.Properties as SProp open import Function open import Relation.Nullary.Decidable open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Definition infixl 7 _divℕ_ _div_ _modℕ_ _mod_ _divℕ_ : (dividend : ℤ) (divisor : ℕ) {≢0 : False (divisor ℕ.≟ 0)} → ℤ (+ n divℕ d) {d≠0} = + (n NDM./ d) {d≠0} (-[1+ n ] divℕ d) {d≠0} with (ℕ.suc n NDM.divMod d) {d≠0} ... | NDM.result q Fin.zero eq = - (+ q) ... | NDM.result q (Fin.suc r) eq = -[1+ q ] _div_ : (dividend divisor : ℤ) {≢0 : False (∣ divisor ∣ ℕ.≟ 0)} → ℤ (n div d) {d≢0} = (sign d ◃ 1) ℤ.* (n divℕ ∣ d ∣) {d≢0} _modℕ_ : (dividend : ℤ) (divisor : ℕ) {≢0 : False (divisor ℕ.≟ 0)} → ℕ (+ n modℕ d) {d≠0} = (n NDM.% d) {d≠0} (-[1+ n ] modℕ d) {d≠0} with (ℕ.suc n NDM.divMod d) {d≠0} ... | NDM.result q Fin.zero eq = 0 ... | NDM.result q (Fin.suc r) eq = d ℕ.∸ ℕ.suc (Fin.toℕ r) _mod_ : (dividend divisor : ℤ) {≢0 : False (∣ divisor ∣ ℕ.≟ 0)} → ℕ (n mod d) {d≢0} = (n modℕ ∣ d ∣) {d≢0} ------------------------------------------------------------------------ -- Properties n%ℕd : _≰_ ⇒ _>_ ≰⇒> {+ n} {+_ n₁} i≰j = +<+ (ℕₚ.≰⇒> (i≰j ∘ +≤+)) ≰⇒> {+ n} { -[1+_] n₁} i≰j = -<+ ≰⇒> { -[1+_] n} {+_ n₁} i≰j = contradiction -≤+ i≰j ≰⇒> { -[1+_] n} { -[1+_] n₁} i≰j = -<- (ℕₚ.≰⇒> (i≰j ∘ -≤-)) ≮⇒≥ : _≮_ ⇒ _≥_ ≮⇒≥ {+ i} {+ j} i≮j = +≤+ (ℕₚ.≮⇒≥ (i≮j ∘ +<+)) ≮⇒≥ {+ i} { -[1+_] j} i≮j = -≤+ ≮⇒≥ { -[1+_] i} {+ j} i≮j = contradiction -<+ i≮j ≮⇒≥ { -[1+_] i} { -[1+_] j} i≮j = -≤- (ℕₚ.≮⇒≥ (i≮j ∘ -<-)) >⇒≰ : _>_ ⇒ _≰_ >⇒≰ = <⇒≱ ≤∧≢⇒< : ∀ {x y} → x ≤ y → x ≢ y → x < y ≤∧≢⇒< (-≤- m≤n) x≢y = -<- (ℕₚ.≤∧≢⇒< m≤n (x≢y ∘ cong -[1+_] ∘ sym)) ≤∧≢⇒< -≤+ x≢y = -<+ ≤∧≢⇒< (+≤+ n≤m) x≢y = +<+ (ℕₚ.≤∧≢⇒< n≤m (x≢y ∘ cong (+_))) ≤∧≮⇒≡ : ∀ {x y} → x ≤ y → x ≮ y → x ≡ y ≤∧≮⇒≡ x≤y x≮y = ≤-antisym x≤y (≮⇒≥ x≮y) ------------------------------------------------------------------------ -- Relational properties <-irrefl : Irreflexive _≡_ _<_ <-irrefl { -[1+ n ]} refl = ℕₚ.<-irrefl refl ∘ drop‿-<- <-irrefl { +0} refl (+<+ ()) <-irrefl { +[1+ n ]} refl = ℕₚ.<-irrefl refl ∘ drop‿+<+ <-asym : Asymmetric _<_ <-asym (-<- n +≮0 (λ()) (+<+ (s≤s z≤n)) <-cmp (+ m) -[1+ n ] = tri> +≮- (λ()) -<+ <-cmp -[1+ m ] (+ n) = tri< -<+ (λ()) +≮- <-cmp -[1+ m ] -[1+ n ] with ℕₚ.<-cmp m n ... | tri< m (n≯m ∘ drop‿-<-) (m≢n ∘ -[1+-injective) (-<- m m≮n m≢n n>m = tri< (-<- n>m) (m≢n ∘ -[1+-injective) (m≮n ∘ drop‿-<-) <-cmp +[1+ m ] +[1+ n ] with ℕₚ.<-cmp m n ... | tri< m m≮n m≢n n>m = tri> (m≮n ∘ ℕₚ.≤-pred ∘ drop‿+<+) (m≢n ∘ +[1+-injective) (+<+ (s≤s n>m)) infix 4 _-irrefl : Irreflexive _≡_ _>_ >-irrefl = <-irrefl ∘ sym ------------------------------------------------------------------------ -- A specialised module for reasoning about the _≤_ and _<_ relations ------------------------------------------------------------------------ module ≤-Reasoning where open import Relation.Binary.Reasoning.Base.Triple ≤-isPreorder <-trans (resp₂ _<_) <⇒≤ <-≤-trans ≤-<-trans public hiding (step-≈; step-≈˘) ------------------------------------------------------------------------ -- Properties of Positive/NonPositive/Negative/NonNegative and _≤_/_<_ positive⁻¹ : ∀ {n} → Positive n → n > 0ℤ positive⁻¹ {+[1+ n ]} _ = +<+ (s≤s z≤n) nonNegative⁻¹ : ∀ {n} → NonNegative n → n ≥ 0ℤ nonNegative⁻¹ {+ n} _ = +≤+ z≤n negative⁻¹ : ∀ {n} → Negative n → n < 0ℤ negative⁻¹ { -[1+ n ]} _ = -<+ nonPositive⁻¹ : ∀ {q} → NonPositive q → q ≤ 0ℤ nonPositive⁻¹ {+ zero} _ = +≤+ z≤n nonPositive⁻¹ { -[1+ n ]} _ = -≤+ negative0 = <-trans (negative⁻¹ m<0) (positive⁻¹ n>0) ------------------------------------------------------------------------ -- Properties of -_ ------------------------------------------------------------------------ neg-involutive : ∀ n → - - n ≡ n neg-involutive -[1+ n ] = refl neg-involutive +0 = refl neg-involutive +[1+ n ] = refl neg-injective : ∀ {m n} → - m ≡ - n → m ≡ n neg-injective {m} {n} -m≡-n = begin m ≡⟨ sym (neg-involutive m) ⟩ - - m ≡⟨ cong -_ -m≡-n ⟩ - - n ≡⟨ neg-involutive n ⟩ n ∎ where open ≡-Reasoning neg-≤-pos : ∀ {m n} → - (+ m) ≤ + n neg-≤-pos {zero} = +≤+ z≤n neg-≤-pos {suc m} = -≤+ neg-mono-< : -_ Preserves _<_ ⟶ _>_ neg-mono-< { -[1+ _ ]} { -[1+ _ ]} (-<- n n neg-cancel-< { +[1+ m ]} { +[1+ n ]} (-<- n ∣⊖∣-< : ∀ {m n} → m ℕ.< n → ∣ m ⊖ n ∣ ≡ n ∸ m ∣⊖∣-< {m} {n} p = begin ∣ m ⊖ n ∣ ≡⟨ cong ∣_∣ (⊖-< p) ⟩ ∣ - (+ (n ∸ m)) ∣ ≡⟨ ∣-n∣≡∣n∣ (+ (n ∸ m)) ⟩ ∣ + (n ∸ m) ∣ ≡⟨⟩ n ∸ m ∎ where open ≡-Reasoning ∣⊖∣-≰ : ∀ {m n} → n ℕ.≰ m → ∣ m ⊖ n ∣ ≡ n ∸ m ∣⊖∣-≰ = ∣⊖∣-< ∘ ℕₚ.≰⇒> -m+n≡n⊖m : ∀ m n → - (+ m) + + n ≡ n ⊖ m -m+n≡n⊖m zero n = refl -m+n≡n⊖m (suc m) n = refl m-n≡m⊖n : ∀ m n → + m + (- + n) ≡ m ⊖ n m-n≡m⊖n zero zero = refl m-n≡m⊖n zero (suc n) = refl m-n≡m⊖n (suc m) zero = cong +[1+_] (ℕₚ.+-identityʳ m) m-n≡m⊖n (suc m) (suc n) = refl -[n⊖m]≡-m+n : ∀ m n → - (m ⊖ n) ≡ (- (+ m)) + (+ n) -[n⊖m]≡-m+n m n with m ℕ.<ᵇ n | Reflects.invert (ℕₚ.<ᵇ-reflects-< m n) ... | true | p = begin - (- (+ (n ∸ m))) ≡⟨ neg-involutive (+ (n ∸ m)) ⟩ + (n ∸ m) ≡˘⟨ ⊖-≥ (ℕₚ.≤-trans (ℕₚ.m≤n+m m 1) p) ⟩ n ⊖ m ≡˘⟨ -m+n≡n⊖m m n ⟩ - (+ m) + + n ∎ where open ≡-Reasoning ... | false | p = begin - (+ (m ∸ n)) ≡˘⟨ ⊖-≤ (ℕₚ.≮⇒≥ p) ⟩ n ⊖ m ≡˘⟨ -m+n≡n⊖m m n ⟩ - (+ m) + + n ∎ where open ≡-Reasoning ∣m⊖n∣≡∣n⊖m∣ : ∀ x y → ∣ x ⊖ y ∣ ≡ ∣ y ⊖ x ∣ ∣m⊖n∣≡∣n⊖m∣ x y = begin ∣ x ⊖ y ∣ ≡⟨ cong ∣_∣ (⊖-swap x y) ⟩ ∣ - (y ⊖ x) ∣ ≡⟨ ∣-n∣≡∣n∣ (y ⊖ x) ⟩ ∣ y ⊖ x ∣ ∎ where open ≡-Reasoning +-cancelˡ-⊖ : ∀ a b c → (a ℕ.+ b) ⊖ (a ℕ.+ c) ≡ b ⊖ c +-cancelˡ-⊖ zero b c = refl +-cancelˡ-⊖ (suc a) b c = begin suc (a ℕ.+ b) ⊖ suc (a ℕ.+ c) ≡⟨ [1+m]⊖[1+n]≡m⊖n (a ℕ.+ b) (a ℕ.+ c) ⟩ a ℕ.+ b ⊖ (a ℕ.+ c) ≡⟨ +-cancelˡ-⊖ a b c ⟩ b ⊖ c ∎ where open ≡-Reasoning m⊖n≤m : ∀ m n → m ⊖ n ≤ + m m⊖n≤m m zero = ≤-refl m⊖n≤m zero (suc n) = -≤+ m⊖n≤m (suc m) (suc n) = begin suc m ⊖ suc n ≡⟨ [1+m]⊖[1+n]≡m⊖n m n ⟩ m ⊖ n ≤⟨ m⊖n≤m m n ⟩ + m ≤⟨ +≤+ (ℕₚ.n≤1+n m) ⟩ +[1+ m ] ∎ where open ≤-Reasoning m⊖n<1+m : ∀ m n → m ⊖ n < +[1+ m ] m⊖n<1+m m n = ≤-<-trans (m⊖n≤m m n) (+<+ (ℕₚ.m ⊖-monoʳ-≥-≤ : ∀ p → (p ⊖_) Preserves ℕ._≥_ ⟶ _≤_ ⊖-monoʳ-≥-≤ zero (z≤n {n}) = 0⊖m≤+ n ⊖-monoʳ-≥-≤ zero (s≤s m≤n) = -≤- m≤n ⊖-monoʳ-≥-≤ (suc p) (z≤n {zero}) = ≤-refl ⊖-monoʳ-≥-≤ (suc p) (z≤n {suc n}) = begin suc p ⊖ suc n ≡⟨ [1+m]⊖[1+n]≡m⊖n p n ⟩ p ⊖ n ≤⟨ <⇒≤ (m⊖n<1+m p n) ⟩ +[1+ p ] ∎ where open ≤-Reasoning ⊖-monoʳ-≥-≤ (suc p) {suc m} {suc n} (s≤s m≤n) = begin suc p ⊖ suc m ≡⟨ [1+m]⊖[1+n]≡m⊖n p m ⟩ p ⊖ m ≤⟨ ⊖-monoʳ-≥-≤ p m≤n ⟩ p ⊖ n ≡˘⟨ [1+m]⊖[1+n]≡m⊖n p n ⟩ suc p ⊖ suc n ∎ where open ≤-Reasoning ⊖-monoˡ-≤ : ∀ p → (_⊖ p) Preserves ℕ._≤_ ⟶ _≤_ ⊖-monoˡ-≤ zero m≤n = +≤+ m≤n ⊖-monoˡ-≤ (suc p) (z≤n {0}) = ≤-refl ⊖-monoˡ-≤ (suc p) (z≤n {(suc m)}) = begin zero ⊖ suc p ≤⟨ ⊖-monoʳ-≥-≤ 0 (ℕₚ.n≤1+n p) ⟩ zero ⊖ p ≤⟨ ⊖-monoˡ-≤ p z≤n ⟩ m ⊖ p ≡˘⟨ [1+m]⊖[1+n]≡m⊖n m p ⟩ suc m ⊖ suc p ∎ where open ≤-Reasoning ⊖-monoˡ-≤ (suc p) {suc m} {suc n} (s≤s m≤n) = begin suc m ⊖ suc p ≡⟨ [1+m]⊖[1+n]≡m⊖n m p ⟩ m ⊖ p ≤⟨ ⊖-monoˡ-≤ p m≤n ⟩ n ⊖ p ≡˘⟨ [1+m]⊖[1+n]≡m⊖n n p ⟩ suc n ⊖ suc p ∎ where open ≤-Reasoning ⊖-monoʳ->-< : ∀ p → (p ⊖_) Preserves ℕ._>_ ⟶ _<_ ⊖-monoʳ->-< zero {_} (s≤s z≤n) = -<+ ⊖-monoʳ->-< zero {_} (s≤s (s≤s m≤n)) = -<- (s≤s m≤n) ⊖-monoʳ->-< (suc p) {suc m} (s≤s z≤n) = begin-strict suc p ⊖ suc m ≡⟨ [1+m]⊖[1+n]≡m⊖n p m ⟩ p ⊖ m <⟨ m⊖n<1+m p m ⟩ +[1+ p ] ∎ where open ≤-Reasoning ⊖-monoʳ->-< (suc p) {suc m} {suc n} (s≤s (s≤s m≤n)) = begin-strict suc p ⊖ suc m ≡⟨ [1+m]⊖[1+n]≡m⊖n p m ⟩ p ⊖ m <⟨ ⊖-monoʳ->-< p (s≤s m≤n) ⟩ p ⊖ n ≡˘⟨ [1+m]⊖[1+n]≡m⊖n p n ⟩ suc p ⊖ suc n ∎ where open ≤-Reasoning ⊖-monoˡ-< : ∀ p → (_⊖ p) Preserves ℕ._<_ ⟶ _<_ ⊖-monoˡ-< zero m-< n (s≤s o_ *-monoˡ-<-neg n {m} {o} m_ *-monoʳ-<-neg n {m} {o} m j *-cancelˡ-<-neg n {i} {j} -[1+n]i<-[1+n]j = neg-cancel-< (*-cancelˡ-<-nonNeg (suc n) (begin-strict +[1+ n ] * - i ≡˘⟨ neg-distribʳ-* +[1+ n ] i ⟩ -(+[1+ n ] * i) ≡⟨ neg-distribˡ-* +[1+ n ] i ⟩ -[1+ n ] * i <⟨ -[1+n]i<-[1+n]j ⟩ -[1+ n ] * j ≡˘⟨ neg-distribˡ-* +[1+ n ] j ⟩ -(+[1+ n ] * j) ≡⟨ neg-distribʳ-* +[1+ n ] j ⟩ +[1+ n ] * - j ∎)) where open ≤-Reasoning *-cancelˡ-<-nonPos : ∀ n {i j} → NonPositive n → n * i < n * j → i > j *-cancelˡ-<-nonPos +0 {i} {j} n≤0 (+<+ ()) *-cancelˡ-<-nonPos -[1+ n ] {i} {j} n≤0 ni j *-cancelʳ-<-neg n {i} {j} i[-[1+n]] j *-cancelʳ-<-nonPos -[1+ n ] {i} {j} n≤0 in _ _ m>n = trans (cong f (i≥j⇒i⊓j≡j (<⇒≤ m>n))) (sym (i≥j⇒i⊓j≡j (<⇒≤ (f-mono-< m>n)))) mono-<-distrib-⊔ : ∀ f → f Preserves _<_ ⟶ _<_ → ∀ m n → f (m ⊔ n) ≡ f m ⊔ f n mono-<-distrib-⊔ f f-mono-< m n with <-cmp m n ... | tri< m _ _ m>n = trans (cong f (i≥j⇒i⊔j≡i (<⇒≤ m>n))) (sym (i≥j⇒i⊔j≡i (<⇒≤ (f-mono-< m>n)))) antimono-<-distrib-⊔ : ∀ f → f Preserves _<_ ⟶ _>_ → ∀ m n → f (m ⊔ n) ≡ f m ⊓ f n antimono-<-distrib-⊔ f f-mono-< m n with <-cmp m n ... | tri< m _ _ m>n = trans (cong f (i≥j⇒i⊔j≡i (<⇒≤ m>n))) (sym (i≤j⇒i⊓j≡i (<⇒≤ (f-mono-< m>n)))) antimono-<-distrib-⊓ : ∀ f → f Preserves _<_ ⟶ _>_ → ∀ m n → f (m ⊓ n) ≡ f m ⊔ f n antimono-<-distrib-⊓ f f-mono-< m n with <-cmp m n ... | tri< m _ _ m>n = trans (cong f (i≥j⇒i⊓j≡j (<⇒≤ m>n))) (sym (i≤j⇒i⊔j≡j (<⇒≤ (f-mono-< m>n)))) ------------------------------------------------------------------------ -- Other properties of _⊓_, _⊔_ and -_ neg-distrib-⊔-⊓ : ∀ m n → - (m ⊔ n) ≡ - m ⊓ - n neg-distrib-⊔-⊓ = antimono-<-distrib-⊔ -_ neg-mono-< neg-distrib-⊓-⊔ : ∀ m n → - (m ⊓ n) ≡ - m ⊔ - n neg-distrib-⊓-⊔ = antimono-<-distrib-⊓ -_ neg-mono-< ------------------------------------------------------------------------ -- Other properties of _⊓_, _⊔_ and _*_ *-distribˡ-⊓-nonNeg : ∀ m n o → + m * (n ⊓ o) ≡ (+ m * n) ⊓ (+ m * o) *-distribˡ-⊓-nonNeg zero _ _ = refl *-distribˡ-⊓-nonNeg (suc m) = mono-≤-distrib-⊓ (*-monoˡ-≤-pos m) *-distribʳ-⊓-nonNeg : ∀ m n o → (n ⊓ o) * + m ≡ (n * + m) ⊓ (o * + m) *-distribʳ-⊓-nonNeg (suc m) = mono-≤-distrib-⊓ (*-monoʳ-≤-pos m) *-distribʳ-⊓-nonNeg zero n o = begin-equality (n ⊓ o) * + zero ≡⟨ *-zeroʳ (n ⊓ o) ⟩ + zero ≡⟨⟩ + zero ⊓ + zero ≡˘⟨ cong₂ _⊓_ (*-zeroʳ n) (*-zeroʳ o) ⟩ (n * + zero) ⊓ (o * + zero) ∎ where open ≤-Reasoning *-distribˡ-⊓-nonPos : ∀ m → NonPositive m → ∀ n o → m * (n ⊓ o) ≡ (m * n) ⊔ (m * o) *-distribˡ-⊓-nonPos +0 m≤0 = λ _ _ → refl *-distribˡ-⊓-nonPos -[1+ m ] m≤0 = antimono-≤-distrib-⊓ (*-monoˡ-≤-neg m) *-distribʳ-⊓-nonPos : ∀ m → NonPositive m → ∀ n o → (n ⊓ o) * m ≡ (n * m) ⊔ (o * m) *-distribʳ-⊓-nonPos m m≤0 n o = begin-equality (n ⊓ o) * m ≡˘⟨ *-comm m (n ⊓ o) ⟩ m * (n ⊓ o) ≡⟨ *-distribˡ-⊓-nonPos m m≤0 n o ⟩ (m * n) ⊔ (m * o) ≡⟨ cong₂ _⊔_ (*-comm m n) (*-comm m o) ⟩ (n * m) ⊔ (o * m) ∎ where open ≤-Reasoning *-distribˡ-⊔-nonNeg : ∀ m n o → + m * (n ⊔ o) ≡ (+ m * n) ⊔ (+ m * o) *-distribˡ-⊔-nonNeg zero = λ _ _ → refl *-distribˡ-⊔-nonNeg (suc m) = mono-≤-distrib-⊔ (*-monoˡ-≤-pos m) *-distribʳ-⊔-nonNeg : ∀ m n o → (n ⊔ o) * + m ≡ (n * + m) ⊔ (o * + m) *-distribʳ-⊔-nonNeg m n o = begin-equality (n ⊔ o) * + m ≡˘⟨ *-comm (+ m) (n ⊔ o) ⟩ + m * (n ⊔ o) ≡⟨ *-distribˡ-⊔-nonNeg m n o ⟩ (+ m * n) ⊔ (+ m * o) ≡⟨ cong₂ _⊔_ (*-comm (+ m) n) (*-comm (+ m) o) ⟩ (n * + m) ⊔ (o * + m) ∎ where open ≤-Reasoning *-distribˡ-⊔-nonPos : ∀ m → NonPositive m → ∀ n o → m * (n ⊔ o) ≡ (m * n) ⊓ (m * o) *-distribˡ-⊔-nonPos +0 m≤0 = λ _ _ → refl *-distribˡ-⊔-nonPos -[1+ m ] m≤0 = antimono-≤-distrib-⊔ (*-monoˡ-≤-neg m) *-distribʳ-⊔-nonPos : ∀ m → NonPositive m → ∀ n o → (n ⊔ o) * m ≡ (n * m) ⊓ (o * m) *-distribʳ-⊔-nonPos m m≤0 n o = begin-equality (n ⊔ o) * m ≡˘⟨ *-comm m (n ⊔ o) ⟩ m * (n ⊔ o) ≡⟨ *-distribˡ-⊔-nonPos m m≤0 n o ⟩ (m * n) ⊓ (m * o) ≡⟨ cong₂ _⊓_ (*-comm m n) (*-comm m o) ⟩ (n * m) ⊓ (o * m) ∎ where open ≤-Reasoning ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 inverseˡ = +-inverseˡ {-# WARNING_ON_USAGE inverseˡ "Warning: inverseˡ was deprecated in v0.15. Please use +-inverseˡ instead." #-} inverseʳ = +-inverseʳ {-# WARNING_ON_USAGE inverseʳ "Warning: inverseʳ was deprecated in v0.15. Please use +-inverseʳ instead." #-} distribʳ = *-distribʳ-+ {-# WARNING_ON_USAGE distribʳ "Warning: distribʳ was deprecated in v0.15. Please use *-distribʳ-+ instead." #-} isCommutativeSemiring = +-*-isCommutativeSemiring {-# WARNING_ON_USAGE isCommutativeSemiring "Warning: isCommutativeSemiring was deprecated in v0.15. Please use +-*-isCommutativeSemiring instead." #-} commutativeRing = +-*-commutativeRing {-# WARNING_ON_USAGE commutativeRing "Warning: commutativeRing was deprecated in v0.15. Please use +-*-commutativeRing instead." #-} *-+-right-mono = *-monoʳ-≤-pos {-# WARNING_ON_USAGE *-+-right-mono "Warning: *-+-right-mono was deprecated in v0.15. Please use *-monoʳ-≤-pos instead." #-} cancel-*-+-right-≤ = *-cancelʳ-≤-pos {-# WARNING_ON_USAGE cancel-*-+-right-≤ "Warning: cancel-*-+-right-≤ was deprecated in v0.15. Please use *-cancelʳ-≤-pos instead." #-} cancel-*-right = *-cancelʳ-≡ {-# WARNING_ON_USAGE cancel-*-right "Warning: cancel-*-right was deprecated in v0.15. Please use *-cancelʳ-≡ instead." #-} doubleNeg = neg-involutive {-# WARNING_ON_USAGE doubleNeg "Warning: doubleNeg was deprecated in v0.15. Please use neg-involutive instead." #-} -‿involutive = neg-involutive {-# WARNING_ON_USAGE -‿involutive "Warning: -‿involutive was deprecated in v0.15. Please use neg-involutive instead." #-} +-⊖-left-cancel = +-cancelˡ-⊖ {-# WARNING_ON_USAGE +-⊖-left-cancel "Warning: +-⊖-left-cancel was deprecated in v0.15. Please use +-cancelˡ-⊖ instead." #-} -- Version 1.0 ≰→> = ≰⇒> {-# WARNING_ON_USAGE ≰→> "Warning: ≰→> was deprecated in v1.0. Please use ≰⇒> instead." #-} ≤-irrelevance = ≤-irrelevant {-# WARNING_ON_USAGE ≤-irrelevance "Warning: ≤-irrelevance was deprecated in v1.0. Please use ≤-irrelevant instead." #-} <-irrelevance = <-irrelevant {-# WARNING_ON_USAGE <-irrelevance "Warning: <-irrelevance was deprecated in v1.0. Please use <-irrelevant instead." #-} -- Version 1.1 -<′+ : ∀ {m n} → -[1+ m ] <′ + n -<′+ {0} = +≤+ z≤n -<′+ {suc _} = -≤+ {-# WARNING_ON_USAGE -<′+ "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-irrefl : Irreflexive _≡_ _<′_ <′-irrefl { + n} refl (+≤+ 1+n≤n) = ℕₚ.<-irrefl refl 1+n≤n <′-irrefl { -[1+ suc n ]} refl (-≤- 1+n≤n) = ℕₚ.<-irrefl refl 1+n≤n {-# WARNING_ON_USAGE <′-irrefl "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} >′-irrefl : Irreflexive _≡_ _>′_ >′-irrefl = <′-irrefl ∘ sym {-# WARNING_ON_USAGE >′-irrefl "Warning: _>′_ was deprecated in v1.1. Please use _>_ instead." #-} <′-asym : Asymmetric _<′_ <′-asym {+ n} {+ m} (+≤+ n m≮n m≢n m>n = tri> (m≮n ∘ drop‿+≤+) (m≢n ∘ +-injective) (+≤+ m>n) <′-cmp (+_ m) -[1+ 0 ] = tri> (λ()) (λ()) (+≤+ z≤n) <′-cmp (+_ m) -[1+ suc n ] = tri> (λ()) (λ()) -≤+ <′-cmp -[1+ 0 ] (+ n) = tri< (+≤+ z≤n) (λ()) (λ()) <′-cmp -[1+ suc m ] (+ n) = tri< -≤+ (λ()) (λ()) <′-cmp -[1+ 0 ] -[1+ 0 ] = tri≈ (λ()) refl (λ()) <′-cmp -[1+ 0 ] -[1+ suc n ] = tri> (λ()) (λ()) (-≤- z≤n) <′-cmp -[1+ suc m ] -[1+ 0 ] = tri< (-≤- z≤n) (λ()) (λ()) <′-cmp -[1+ suc m ] -[1+ suc n ] with ℕₚ.<-cmp (suc m) (suc n) ... | tri< m (m≯n ∘ s≤s ∘ drop‿-≤-) (m≢n ∘ -[1+-injective) (-≤- (ℕₚ.≤-pred m m≮n m≢n m>n = tri< (-≤- (ℕₚ.≤-pred m>n)) (m≢n ∘ -[1+-injective) (m≮n ∘ s≤s ∘ drop‿-≤-) {-# WARNING_ON_USAGE <′-cmp "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-isStrictPartialOrder : IsStrictPartialOrder _≡_ _<′_ <′-isStrictPartialOrder = record { isEquivalence = isEquivalence ; irrefl = <′-irrefl ; trans = λ {i} → <′-trans {i} ; <-resp-≈ = (λ {x} → subst (x <′_)) , subst (_<′ _) } {-# WARNING_ON_USAGE <′-isStrictPartialOrder "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-strictPartialOrder : StrictPartialOrder _ _ _ <′-strictPartialOrder = record { isStrictPartialOrder = <′-isStrictPartialOrder } {-# WARNING_ON_USAGE <′-strictPartialOrder "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-isStrictTotalOrder : IsStrictTotalOrder _≡_ _<′_ <′-isStrictTotalOrder = record { isEquivalence = isEquivalence ; trans = λ {i} → <′-trans {i} ; compare = <′-cmp } {-# WARNING_ON_USAGE <′-isStrictTotalOrder "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-strictTotalOrder : StrictTotalOrder _ _ _ <′-strictTotalOrder = record { isStrictTotalOrder = <′-isStrictTotalOrder } {-# WARNING_ON_USAGE <′-strictTotalOrder "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} n≮′n : ∀ {n} → n ≮′ n n≮′n {+ n} (+≤+ n′⇒≰′ : ∀ {x y} → x >′ y → x ≰ y >′⇒≰′ {y = y} x>y x≤y = contradiction (<′-≤-trans {i = y} x>y x≤y) n≮′n {-# WARNING_ON_USAGE >′⇒≰′ "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} ≰⇒>′ : ∀ {x y} → x ≰ y → x >′ y ≰⇒>′ {+ m} {+ n} m≰n = +≤+ (ℕₚ.≰⇒> (m≰n ∘ +≤+)) ≰⇒>′ {+ m} { -[1+ n ]} _ = -<′+ {n} {m} ≰⇒>′ { -[1+ m ]} {+ _} m≰n = contradiction -≤+ m≰n ≰⇒>′ { -[1+ 0 ]} { -[1+ 0 ]} m≰n = contradiction ≤-refl m≰n ≰⇒>′ { -[1+ suc _ ]} { -[1+ 0 ]} m≰n = contradiction (-≤- z≤n) m≰n ≰⇒>′ { -[1+ m ]} { -[1+ suc n ]} m≰n with m ℕ.≤? n ... | yes m≤n = -≤- m≤n ... | no m≰n′ = contradiction (-≤- (ℕₚ.≰⇒> m≰n′)) m≰n {-# WARNING_ON_USAGE ≰⇒>′ "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} <′-irrelevant : Irrelevant _<′_ <′-irrelevant = ≤-irrelevant {-# WARNING_ON_USAGE <′-irrelevant "Warning: _<′_ was deprecated in v1.1. Please use _<_ instead." #-} +-monoˡ-<′ : ∀ n → (_+ n) Preserves _<′_ ⟶ _<′_ +-monoˡ-<′ n {i} {j} i = neg-mono-< {-# WARNING_ON_USAGE neg-mono-<-> "Warning: neg-mono-<-> was deprecated in v1.5. Please use neg-mono-< instead." #-} neg-mono-≤-≥ = neg-mono-≤ {-# WARNING_ON_USAGE neg-mono-≤-≥ "Warning: neg-mono-≤-≥ was deprecated in v1.5. Please use neg-mono-≤ instead." #-} *-monoʳ-≤-non-neg = *-monoʳ-≤-nonNeg {-# WARNING_ON_USAGE *-monoʳ-≤-non-neg "Warning: *-monoʳ-≤-non-neg was deprecated in v1.5. Please use *-monoʳ-≤-nonNeg instead." #-} *-monoˡ-≤-non-neg = *-monoˡ-≤-nonNeg {-# WARNING_ON_USAGE *-monoˡ-≤-non-neg "Warning: *-monoˡ-≤-non-neg deprecated in v1.5. Please use *-monoˡ-≤-nonNeg instead." #-} *-cancelˡ-<-non-neg = *-cancelˡ-<-nonNeg {-# WARNING_ON_USAGE *-cancelˡ-<-non-neg "Warning: *-cancelˡ-<-non-neg was deprecated in v1.5. Please use *-cancelˡ-<-nonNeg instead." #-} *-cancelʳ-<-non-neg = *-cancelʳ-<-nonNeg {-# WARNING_ON_USAGE *-cancelʳ-<-non-neg "Warning: *-cancelʳ-<-non-neg was deprecated in v1.5. Please use *-cancelʳ-<-nonNeg instead." #-} -- Version 1.6 m≤n⇒m⊓n≡m = i≤j⇒i⊓j≡i {-# WARNING_ON_USAGE m≤n⇒m⊓n≡m "Warning: m≤n⇒m⊓n≡m was deprecated in v1.6 Please use i≤j⇒i⊓j≡i instead." #-} m⊓n≡m⇒m≤n = i⊓j≡i⇒i≤j {-# WARNING_ON_USAGE m⊓n≡m⇒m≤n "Warning: m≤n⇒m⊓n≡m was deprecated in v1.6 Please use i⊓j≡i⇒i≤j instead." #-} m≥n⇒m⊓n≡n = i≥j⇒i⊓j≡j {-# WARNING_ON_USAGE m≥n⇒m⊓n≡n "Warning: m≥n⇒m⊓n≡n was deprecated in v1.6 Please use i≥j⇒i⊓j≡j instead." #-} m⊓n≡n⇒m≥n = i⊓j≡j⇒j≤i {-# WARNING_ON_USAGE m⊓n≡n⇒m≥n "Warning: m⊓n≡n⇒m≥n was deprecated in v1.6 Please use i⊓j≡j⇒j≤i instead." #-} m⊓n≤n = i⊓j≤j {-# WARNING_ON_USAGE m⊓n≤n "Warning: m⊓n≤n was deprecated in v1.6 Please use i⊓j≤j instead." #-} m⊓n≤m = i⊓j≤i {-# WARNING_ON_USAGE m⊓n≤m "Warning: m⊓n≤m was deprecated in v1.6 Please use i⊓j≤i instead." #-} m≤n⇒m⊔n≡n = i≤j⇒i⊔j≡j {-# WARNING_ON_USAGE m≤n⇒m⊔n≡n "Warning: m≤n⇒m⊔n≡n was deprecated in v1.6 Please use i≤j⇒i⊔j≡j instead." #-} m⊔n≡n⇒m≤n = i⊔j≡j⇒i≤j {-# WARNING_ON_USAGE m⊔n≡n⇒m≤n "Warning: m⊔n≡n⇒m≤n was deprecated in v1.6 Please use i⊔j≡j⇒i≤j instead." #-} m≥n⇒m⊔n≡m = i≥j⇒i⊔j≡i {-# WARNING_ON_USAGE m≥n⇒m⊔n≡m "Warning: m≥n⇒m⊔n≡m was deprecated in v1.6 Please use i≥j⇒i⊔j≡i instead." #-} m⊔n≡m⇒m≥n = i⊔j≡i⇒j≤i {-# WARNING_ON_USAGE m⊔n≡m⇒m≥n "Warning: m⊔n≡m⇒m≥n was deprecated in v1.6 Please use i⊔j≡i⇒j≤i instead." #-} m≤m⊔n = i≤i⊔j {-# WARNING_ON_USAGE m≤m⊔n "Warning: m≤m⊔n was deprecated in v1.6 Please use i≤i⊔j instead." #-} n≤m⊔n = i≤j⊔i {-# WARNING_ON_USAGE n≤m⊔n "Warning: n≤m⊔n was deprecated in v1.6 Please use i≤j⊔i instead." #-} agda-stdlib-1.7.3/src/Data/Integer/Show.agda000066400000000000000000000013051451211343400204650ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Showing integers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Integer.Show where open import Data.Integer.Base using (ℤ; +_; -[1+_]) open import Data.Nat.Base using (suc) open import Data.Nat.Show using () renaming (show to showℕ) open import Data.String.Base using (String; _++_) ------------------------------------------------------------------------ -- Show -- Decimal notation -- Time complexity is O(log₁₀(n)) show : ℤ → String show (+ n) = showℕ n show -[1+ n ] = "-" ++ showℕ (suc n) agda-stdlib-1.7.3/src/Data/Integer/Solver.agda000066400000000000000000000014231451211343400210200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over integers ------------------------------------------------------------------------ -- See README.Integer for examples of how to use this solver {-# OPTIONS --cubical-compatible --safe #-} module Data.Integer.Solver where import Algebra.Solver.Ring.Simple as Solver import Algebra.Solver.Ring.AlmostCommutativeRing as ACR open import Data.Integer.Properties using (_≟_; +-*-commutativeRing) ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ module +-*-Solver = Solver (ACR.fromCommutativeRing +-*-commutativeRing) _≟_ agda-stdlib-1.7.3/src/Data/Integer/Tactic/000077500000000000000000000000001451211343400201375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Integer/Tactic/RingSolver.agda000066400000000000000000000023021451211343400230440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over integers ------------------------------------------------------------------------ -- See README.Integer for examples of how to use this solver {-# OPTIONS --cubical-compatible --safe #-} module Data.Integer.Tactic.RingSolver where open import Agda.Builtin.Reflection open import Data.Maybe.Base using (just; nothing) open import Data.Integer.Base open import Data.Integer.Properties open import Level using (0ℓ) open import Data.Unit using (⊤) open import Relation.Binary.PropositionalEquality import Tactic.RingSolver as Solver import Tactic.RingSolver.Core.AlmostCommutativeRing as ACR ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ ring : ACR.AlmostCommutativeRing 0ℓ 0ℓ ring = ACR.fromCommutativeRing +-*-commutativeRing λ { +0 → just refl; _ → nothing } macro solve-∀ : Term → TC ⊤ solve-∀ = Solver.solve-∀-macro (quote ring) macro solve : Term → Term → TC ⊤ solve n = Solver.solve-macro n (quote ring) agda-stdlib-1.7.3/src/Data/List.agda000066400000000000000000000007321451211343400170660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists ------------------------------------------------------------------------ -- See README.Data.List for examples of how to use and reason about -- lists. {-# OPTIONS --cubical-compatible --safe #-} module Data.List where ------------------------------------------------------------------------ -- Types and basic operations open import Data.List.Base public agda-stdlib-1.7.3/src/Data/List/000077500000000000000000000000001451211343400162465ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/All.agda000066400000000000000000000007541451211343400176020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use Data.List.Relation.Unary.All -- directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.All where open import Data.List.Relation.Unary.All public {-# WARNING_ON_IMPORT "Data.List.All was deprecated in v1.0. Use Data.List.Relation.Unary.All instead." #-} agda-stdlib-1.7.3/src/Data/List/All/000077500000000000000000000000001451211343400167565ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/All/Properties.agda000066400000000000000000000010431451211343400217260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.List.Relation.Unary.Any.Properties directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.All.Properties where open import Data.List.Relation.Unary.All.Properties public {-# WARNING_ON_IMPORT "Data.List.All.Properties was deprecated in v1.0. Use Data.List.Relation.Unary.All.Properties instead." #-} agda-stdlib-1.7.3/src/Data/List/Any.agda000066400000000000000000000007541451211343400176210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use Data.List.Relation.Unary.Any -- directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Any where open import Data.List.Relation.Unary.Any public {-# WARNING_ON_IMPORT "Data.List.Any was deprecated in v1.0. Use Data.List.Relation.Unary.Any instead." #-} agda-stdlib-1.7.3/src/Data/List/Any/000077500000000000000000000000001451211343400167755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Any/Properties.agda000066400000000000000000000010431451211343400217450ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.List.Relation.Unary.Any.Properties directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Any.Properties where open import Data.List.Relation.Unary.Any.Properties public {-# WARNING_ON_IMPORT "Data.List.Any.Properties was deprecated in v1.0. Use Data.List.Relation.Unary.Any.Properties instead." #-} agda-stdlib-1.7.3/src/Data/List/Base.agda000066400000000000000000000346211451211343400177440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists, basic types and operations ------------------------------------------------------------------------ -- See README.Data.List for examples of how to use and reason about -- lists. {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Base where open import Data.Bool.Base as Bool using (Bool; false; true; not; _∧_; _∨_; if_then_else_) open import Data.Fin.Base using (Fin; zero; suc) open import Data.Maybe.Base as Maybe using (Maybe; nothing; just; maybe′) open import Data.Nat.Base as ℕ using (ℕ; zero; suc; _+_; _*_ ; _≤_ ; s≤s) open import Data.Product as Prod using (_×_; _,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Data.These.Base as These using (These; this; that; these) open import Function.Base using (id; _∘_ ; _∘′_; const; flip) open import Level using (Level) open import Relation.Nullary using (does) open import Relation.Nullary.Negation.Core using (¬?) open import Relation.Unary using (Pred; Decidable) open import Relation.Unary.Properties using (∁?) open import Relation.Binary.Core using (Rel) import Relation.Binary.Definitions as B private variable a b c p ℓ : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Types open import Agda.Builtin.List public using (List; []; _∷_) ------------------------------------------------------------------------ -- Operations for transforming lists map : (A → B) → List A → List B map f [] = [] map f (x ∷ xs) = f x ∷ map f xs mapMaybe : (A → Maybe B) → List A → List B mapMaybe p [] = [] mapMaybe p (x ∷ xs) with p x ... | just y = y ∷ mapMaybe p xs ... | nothing = mapMaybe p xs infixr 5 _++_ _++_ : List A → List A → List A [] ++ ys = ys (x ∷ xs) ++ ys = x ∷ (xs ++ ys) intersperse : A → List A → List A intersperse x [] = [] intersperse x (y ∷ []) = y ∷ [] intersperse x (y ∷ ys) = y ∷ x ∷ intersperse x ys intercalate : List A → List (List A) → List A intercalate xs [] = [] intercalate xs (ys ∷ []) = ys intercalate xs (ys ∷ yss) = ys ++ xs ++ intercalate xs yss cartesianProductWith : (A → B → C) → List A → List B → List C cartesianProductWith f [] _ = [] cartesianProductWith f (x ∷ xs) ys = map (f x) ys ++ cartesianProductWith f xs ys cartesianProduct : List A → List B → List (A × B) cartesianProduct = cartesianProductWith _,_ ------------------------------------------------------------------------ -- Aligning and zipping alignWith : (These A B → C) → List A → List B → List C alignWith f [] bs = map (f ∘′ that) bs alignWith f as [] = map (f ∘′ this) as alignWith f (a ∷ as) (b ∷ bs) = f (these a b) ∷ alignWith f as bs zipWith : (A → B → C) → List A → List B → List C zipWith f (x ∷ xs) (y ∷ ys) = f x y ∷ zipWith f xs ys zipWith f _ _ = [] unalignWith : (A → These B C) → List A → List B × List C unalignWith f [] = [] , [] unalignWith f (a ∷ as) with f a ... | this b = Prod.map₁ (b ∷_) (unalignWith f as) ... | that c = Prod.map₂ (c ∷_) (unalignWith f as) ... | these b c = Prod.map (b ∷_) (c ∷_) (unalignWith f as) unzipWith : (A → B × C) → List A → List B × List C unzipWith f [] = [] , [] unzipWith f (xy ∷ xys) = Prod.zip _∷_ _∷_ (f xy) (unzipWith f xys) partitionSumsWith : (A → B ⊎ C) → List A → List B × List C partitionSumsWith f = unalignWith (These.fromSum ∘′ f) align : List A → List B → List (These A B) align = alignWith id zip : List A → List B → List (A × B) zip = zipWith (_,_) unalign : List (These A B) → List A × List B unalign = unalignWith id unzip : List (A × B) → List A × List B unzip = unzipWith id partitionSums : List (A ⊎ B) → List A × List B partitionSums = partitionSumsWith id merge : {R : Rel A ℓ} → B.Decidable R → List A → List A → List A merge R? [] ys = ys merge R? xs [] = xs merge R? (x ∷ xs) (y ∷ ys) = if does (R? x y) then x ∷ merge R? xs (y ∷ ys) else y ∷ merge R? (x ∷ xs) ys ------------------------------------------------------------------------ -- Operations for reducing lists foldr : (A → B → B) → B → List A → B foldr c n [] = n foldr c n (x ∷ xs) = c x (foldr c n xs) foldl : (A → B → A) → A → List B → A foldl c n [] = n foldl c n (x ∷ xs) = foldl c (c n x) xs concat : List (List A) → List A concat = foldr _++_ [] concatMap : (A → List B) → List A → List B concatMap f = concat ∘ map f null : List A → Bool null [] = true null (x ∷ xs) = false and : List Bool → Bool and = foldr _∧_ true or : List Bool → Bool or = foldr _∨_ false any : (A → Bool) → List A → Bool any p = or ∘ map p all : (A → Bool) → List A → Bool all p = and ∘ map p sum : List ℕ → ℕ sum = foldr _+_ 0 product : List ℕ → ℕ product = foldr _*_ 1 length : List A → ℕ length = foldr (const suc) 0 ------------------------------------------------------------------------ -- Operations for constructing lists [_] : A → List A [ x ] = x ∷ [] fromMaybe : Maybe A → List A fromMaybe (just x) = [ x ] fromMaybe nothing = [] replicate : ℕ → A → List A replicate zero x = [] replicate (suc n) x = x ∷ replicate n x inits : List A → List (List A) inits [] = [] ∷ [] inits (x ∷ xs) = [] ∷ map (x ∷_) (inits xs) tails : List A → List (List A) tails [] = [] ∷ [] tails (x ∷ xs) = (x ∷ xs) ∷ tails xs -- Scans scanr : (A → B → B) → B → List A → List B scanr f e [] = e ∷ [] scanr f e (x ∷ xs) with scanr f e xs ... | [] = [] -- dead branch ... | y ∷ ys = f x y ∷ y ∷ ys scanl : (A → B → A) → A → List B → List A scanl f e [] = e ∷ [] scanl f e (x ∷ xs) = e ∷ scanl f (f e x) xs -- Tabulation applyUpTo : (ℕ → A) → ℕ → List A applyUpTo f zero = [] applyUpTo f (suc n) = f zero ∷ applyUpTo (f ∘ suc) n applyDownFrom : (ℕ → A) → ℕ → List A applyDownFrom f zero = [] applyDownFrom f (suc n) = f n ∷ applyDownFrom f n tabulate : ∀ {n} (f : Fin n → A) → List A tabulate {n = zero} f = [] tabulate {n = suc n} f = f zero ∷ tabulate (f ∘ suc) lookup : ∀ (xs : List A) → Fin (length xs) → A lookup (x ∷ xs) zero = x lookup (x ∷ xs) (suc i) = lookup xs i -- Numerical upTo : ℕ → List ℕ upTo = applyUpTo id downFrom : ℕ → List ℕ downFrom = applyDownFrom id allFin : ∀ n → List (Fin n) allFin n = tabulate id unfold : ∀ (P : ℕ → Set b) (f : ∀ {n} → P (suc n) → Maybe (A × P n)) → ∀ {n} → P n → List A unfold P f {n = zero} s = [] unfold P f {n = suc n} s with f s ... | nothing = [] ... | just (x , s′) = x ∷ unfold P f s′ ------------------------------------------------------------------------ -- Operations for deconstructing lists -- Note that although the following three combinators can be useful for -- programming, when proving it is often a better idea to manually -- destruct a list argument as each branch of the pattern-matching will -- have a refined type. uncons : List A → Maybe (A × List A) uncons [] = nothing uncons (x ∷ xs) = just (x , xs) head : List A → Maybe A head [] = nothing head (x ∷ _) = just x tail : List A → Maybe (List A) tail [] = nothing tail (_ ∷ xs) = just xs last : List A → Maybe A last [] = nothing last (x ∷ []) = just x last (_ ∷ xs) = last xs take : ℕ → List A → List A take zero xs = [] take (suc n) [] = [] take (suc n) (x ∷ xs) = x ∷ take n xs drop : ℕ → List A → List A drop zero xs = xs drop (suc n) [] = [] drop (suc n) (x ∷ xs) = drop n xs splitAt : ℕ → List A → (List A × List A) splitAt zero xs = ([] , xs) splitAt (suc n) [] = ([] , []) splitAt (suc n) (x ∷ xs) with splitAt n xs ... | (ys , zs) = (x ∷ ys , zs) takeWhile : ∀ {P : Pred A p} → Decidable P → List A → List A takeWhile P? [] = [] takeWhile P? (x ∷ xs) with does (P? x) ... | true = x ∷ takeWhile P? xs ... | false = [] dropWhile : ∀ {P : Pred A p} → Decidable P → List A → List A dropWhile P? [] = [] dropWhile P? (x ∷ xs) with does (P? x) ... | true = dropWhile P? xs ... | false = x ∷ xs filter : ∀ {P : Pred A p} → Decidable P → List A → List A filter P? [] = [] filter P? (x ∷ xs) with does (P? x) ... | false = filter P? xs ... | true = x ∷ filter P? xs partition : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) partition P? [] = ([] , []) partition P? (x ∷ xs) with does (P? x) | partition P? xs ... | true | (ys , zs) = (x ∷ ys , zs) ... | false | (ys , zs) = (ys , x ∷ zs) span : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) span P? [] = ([] , []) span P? (x ∷ xs) with does (P? x) ... | true = Prod.map (x ∷_) id (span P? xs) ... | false = ([] , x ∷ xs) break : ∀ {P : Pred A p} → Decidable P → List A → (List A × List A) break P? = span (∁? P?) derun : ∀ {R : Rel A p} → B.Decidable R → List A → List A derun R? [] = [] derun R? (x ∷ []) = x ∷ [] derun R? (x ∷ y ∷ xs) with does (R? x y) | derun R? (y ∷ xs) ... | true | ys = ys ... | false | ys = x ∷ ys deduplicate : ∀ {R : Rel A p} → B.Decidable R → List A → List A deduplicate R? [] = [] deduplicate R? (x ∷ xs) = x ∷ filter (¬? ∘ R? x) (deduplicate R? xs) ------------------------------------------------------------------------ -- Actions on single elements infixl 5 _[_]%=_ _[_]∷=_ _─_ _[_]%=_ : (xs : List A) → Fin (length xs) → (A → A) → List A (x ∷ xs) [ zero ]%= f = f x ∷ xs (x ∷ xs) [ suc k ]%= f = x ∷ (xs [ k ]%= f) _[_]∷=_ : (xs : List A) → Fin (length xs) → A → List A xs [ k ]∷= v = xs [ k ]%= const v _─_ : (xs : List A) → Fin (length xs) → List A (x ∷ xs) ─ zero = xs (x ∷ xs) ─ suc k = x ∷ (xs ─ k) ------------------------------------------------------------------------ -- Operations for reversing lists reverseAcc : List A → List A → List A reverseAcc = foldl (flip _∷_) reverse : List A → List A reverse = reverseAcc [] -- "Reverse append" xs ʳ++ ys = reverse xs ++ ys infixr 5 _ʳ++_ _ʳ++_ : List A → List A → List A _ʳ++_ = flip reverseAcc -- Snoc: Cons, but from the right. infixl 6 _∷ʳ_ _∷ʳ_ : List A → A → List A xs ∷ʳ x = xs ++ [ x ] -- Conditional versions of cons and snoc infixr 5 _?∷_ _?∷_ : Maybe A → List A → List A _?∷_ = maybe′ _∷_ id infixl 6 _∷ʳ?_ _∷ʳ?_ : List A → Maybe A → List A xs ∷ʳ? x = maybe′ (xs ∷ʳ_) xs x -- Backwards initialisation infixl 5 _∷ʳ′_ data InitLast {A : Set a} : List A → Set a where [] : InitLast [] _∷ʳ′_ : (xs : List A) (x : A) → InitLast (xs ∷ʳ x) initLast : (xs : List A) → InitLast xs initLast [] = [] initLast (x ∷ xs) with initLast xs ... | [] = [] ∷ʳ′ x ... | ys ∷ʳ′ y = (x ∷ ys) ∷ʳ′ y -- uncons, but from the right unsnoc : List A → Maybe (List A × A) unsnoc as with initLast as ... | [] = nothing ... | xs ∷ʳ′ x = just (xs , x) ------------------------------------------------------------------------ -- Splitting a list -- The predicate `P` represents the notion of newline character for the type `A` -- It is used to split the input list into a list of lines. Some lines may be -- empty if the input contains at least two consecutive newline characters. linesBy : ∀ {P : Pred A p} → Decidable P → List A → List (List A) linesBy {A = A} P? = go nothing where go : Maybe (List A) → List A → List (List A) go acc [] = maybe′ ([_] ∘′ reverse) [] acc go acc (c ∷ cs) with does (P? c) ... | true = reverse (Maybe.fromMaybe [] acc) ∷ go nothing cs ... | false = go (just (c ∷ Maybe.fromMaybe [] acc)) cs -- The predicate `P` represents the notion of space character for the type `A`. -- It is used to split the input list into a list of words. All the words are -- non empty and the output does not contain any space characters. wordsBy : ∀ {P : Pred A p} → Decidable P → List A → List (List A) wordsBy {A = A} P? = go [] where cons : List A → List (List A) → List (List A) cons [] ass = ass cons as ass = reverse as ∷ ass go : List A → List A → List (List A) go acc [] = cons acc [] go acc (c ∷ cs) with does (P? c) ... | true = cons acc (go [] cs) ... | false = go (c ∷ acc) cs ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- -- Note that the `boolX` functions are not given warnings as they are -- used by other deprecated proofs throughout the library. -- Version 0.15 gfilter = mapMaybe {-# WARNING_ON_USAGE gfilter "Warning: gfilter was deprecated in v0.15. Please use mapMaybe instead." #-} boolFilter : (A → Bool) → List A → List A boolFilter p = mapMaybe (λ x → if p x then just x else nothing) boolPartition : (A → Bool) → List A → (List A × List A) boolPartition p [] = ([] , []) boolPartition p (x ∷ xs) with p x | boolPartition p xs ... | true | (ys , zs) = (x ∷ ys , zs) ... | false | (ys , zs) = (ys , x ∷ zs) -- Version 0.16 boolTakeWhile : (A → Bool) → List A → List A boolTakeWhile p [] = [] boolTakeWhile p (x ∷ xs) with p x ... | true = x ∷ boolTakeWhile p xs ... | false = [] boolDropWhile : (A → Bool) → List A → List A boolDropWhile p [] = [] boolDropWhile p (x ∷ xs) with p x ... | true = boolDropWhile p xs ... | false = x ∷ xs boolSpan : (A → Bool) → List A → (List A × List A) boolSpan p [] = ([] , []) boolSpan p (x ∷ xs) with p x ... | true = Prod.map (x ∷_) id (boolSpan p xs) ... | false = ([] , x ∷ xs) boolBreak : (A → Bool) → List A → (List A × List A) boolBreak p = boolSpan (not ∘ p) -- Version 1.4 infixl 5 _∷ʳ'_ _∷ʳ'_ : (xs : List A) (x : A) → InitLast (xs ∷ʳ x) _∷ʳ'_ = InitLast._∷ʳ′_ {-# WARNING_ON_USAGE _∷ʳ'_ "Warning: _∷ʳ'_ (ending in an apostrophe) was deprecated in v1.4. Please use _∷ʳ′_ (ending in a prime) instead." #-} agda-stdlib-1.7.3/src/Data/List/Categorical.agda000066400000000000000000000247011451211343400213050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of List ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Categorical where open import Category.Functor open import Category.Applicative open import Category.Monad open import Data.Bool.Base using (false; true) open import Data.List.Base open import Data.List.Properties open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; _≗_; refl) open P.≡-Reasoning ------------------------------------------------------------------------ -- List applicative functor functor : ∀ {ℓ} → RawFunctor {ℓ} List functor = record { _<$>_ = map } applicative : ∀ {ℓ} → RawApplicative {ℓ} List applicative = record { pure = [_] ; _⊛_ = λ fs as → concatMap (λ f → map f as) fs } applicativeZero : ∀ {ℓ} → RawApplicativeZero {ℓ} List applicativeZero = record { applicative = applicative ; ∅ = [] } alternative : ∀ {ℓ} → RawAlternative {ℓ} List alternative = record { applicativeZero = applicativeZero ; _∣_ = _++_ } ------------------------------------------------------------------------ -- List monad monad : ∀ {ℓ} → RawMonad {ℓ} List monad = record { return = [_] ; _>>=_ = flip concatMap } monadZero : ∀ {ℓ} → RawMonadZero {ℓ} List monadZero = record { monad = monad ; applicativeZero = applicativeZero } monadPlus : ∀ {ℓ} → RawMonadPlus {ℓ} List monadPlus = record { monad = monad ; alternative = alternative } ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {f F} (App : RawApplicative {f} F) where open RawApplicative App sequenceA : ∀ {A} → List (F A) → F (List A) sequenceA [] = pure [] sequenceA (x ∷ xs) = _∷_ <$> x ⊛ sequenceA xs mapA : ∀ {a} {A : Set a} {B} → (A → F B) → List A → F (List B) mapA f = sequenceA ∘ map f forA : ∀ {a} {A : Set a} {B} → List A → (A → F B) → F (List B) forA = flip mapA module TraversableM {m M} (Mon : RawMonad {m} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) ------------------------------------------------------------------------ -- List monad transformer monadT : ∀ {ℓ} → RawMonadT {ℓ} (_∘′ List) monadT M = record { return = pure ∘′ [_] ; _>>=_ = λ mas f → mas >>= λ as → concat <$> mapM f as } where open RawMonad M; open TraversableM M ------------------------------------------------------------------------ -- The list monad. private open module LMP {ℓ} = RawMonadPlus (monadPlus {ℓ = ℓ}) module MonadProperties where left-identity : ∀ {ℓ} {A B : Set ℓ} (x : A) (f : A → List B) → (return x >>= f) ≡ f x left-identity x f = ++-identityʳ (f x) right-identity : ∀ {ℓ} {A : Set ℓ} (xs : List A) → (xs >>= return) ≡ xs right-identity [] = refl right-identity (x ∷ xs) = P.cong (x ∷_) (right-identity xs) left-zero : ∀ {ℓ} {A B : Set ℓ} (f : A → List B) → (∅ >>= f) ≡ ∅ left-zero f = refl right-zero : ∀ {ℓ} {A B : Set ℓ} (xs : List A) → (xs >>= const ∅) ≡ ∅ {A = B} right-zero [] = refl right-zero (x ∷ xs) = right-zero xs private not-left-distributive : let xs = true ∷ false ∷ []; f = return; g = return in (xs >>= λ x → f x ∣ g x) ≢ ((xs >>= f) ∣ (xs >>= g)) not-left-distributive () right-distributive : ∀ {ℓ} {A B : Set ℓ} (xs ys : List A) (f : A → List B) → (xs ∣ ys >>= f) ≡ ((xs >>= f) ∣ (ys >>= f)) right-distributive [] ys f = refl right-distributive (x ∷ xs) ys f = begin f x ∣ (xs ∣ ys >>= f) ≡⟨ P.cong (f x ∣_) $ right-distributive xs ys f ⟩ f x ∣ ((xs >>= f) ∣ (ys >>= f)) ≡⟨ P.sym $ ++-assoc (f x) _ _ ⟩ ((f x ∣ (xs >>= f)) ∣ (ys >>= f)) ∎ associative : ∀ {ℓ} {A B C : Set ℓ} (xs : List A) (f : A → List B) (g : B → List C) → (xs >>= λ x → f x >>= g) ≡ (xs >>= f >>= g) associative [] f g = refl associative (x ∷ xs) f g = begin (f x >>= g) ∣ (xs >>= λ x → f x >>= g) ≡⟨ P.cong ((f x >>= g) ∣_) $ associative xs f g ⟩ (f x >>= g) ∣ (xs >>= f >>= g) ≡⟨ P.sym $ right-distributive (f x) (xs >>= f) g ⟩ (f x ∣ (xs >>= f) >>= g) ∎ cong : ∀ {ℓ} {A B : Set ℓ} {xs₁ xs₂} {f₁ f₂ : A → List B} → xs₁ ≡ xs₂ → f₁ ≗ f₂ → (xs₁ >>= f₁) ≡ (xs₂ >>= f₂) cong {xs₁ = xs} refl f₁≗f₂ = P.cong concat (map-cong f₁≗f₂ xs) ------------------------------------------------------------------------ -- The applicative functor derived from the list monad. -- Note that these proofs (almost) show that RawIMonad.rawIApplicative -- is correctly defined. The proofs can be reused if proof components -- are ever added to RawIMonad and RawIApplicative. module Applicative where private module MP = MonadProperties -- A variant of flip map. pam : ∀ {ℓ} {A B : Set ℓ} → List A → (A → B) → List B pam xs f = xs >>= return ∘ f -- ∅ is a left zero for _⊛_. left-zero : ∀ {ℓ} {A B : Set ℓ} (xs : List A) → (∅ ⊛ xs) ≡ ∅ {A = B} left-zero xs = begin ∅ ⊛ xs ≡⟨⟩ (∅ >>= pam xs) ≡⟨ MonadProperties.left-zero (pam xs) ⟩ ∅ ∎ -- ∅ is a right zero for _⊛_. right-zero : ∀ {ℓ} {A B : Set ℓ} (fs : List (A → B)) → (fs ⊛ ∅) ≡ ∅ right-zero {ℓ} fs = begin fs ⊛ ∅ ≡⟨⟩ (fs >>= pam ∅) ≡⟨ (MP.cong (refl {x = fs}) λ f → MP.left-zero (return ∘ f)) ⟩ (fs >>= λ _ → ∅) ≡⟨ MP.right-zero fs ⟩ ∅ ∎ -- _⊛_ distributes over _∣_ from the right. right-distributive : ∀ {ℓ} {A B : Set ℓ} (fs₁ fs₂ : List (A → B)) xs → ((fs₁ ∣ fs₂) ⊛ xs) ≡ (fs₁ ⊛ xs ∣ fs₂ ⊛ xs) right-distributive fs₁ fs₂ xs = begin (fs₁ ∣ fs₂) ⊛ xs ≡⟨⟩ (fs₁ ∣ fs₂ >>= pam xs) ≡⟨ MonadProperties.right-distributive fs₁ fs₂ (pam xs) ⟩ (fs₁ >>= pam xs) ∣ (fs₂ >>= pam xs) ≡⟨⟩ (fs₁ ⊛ xs ∣ fs₂ ⊛ xs) ∎ -- _⊛_ does not distribute over _∣_ from the left. private not-left-distributive : let fs = id ∷ id ∷ []; xs₁ = true ∷ []; xs₂ = true ∷ false ∷ [] in (fs ⊛ (xs₁ ∣ xs₂)) ≢ (fs ⊛ xs₁ ∣ fs ⊛ xs₂) not-left-distributive () -- Applicative functor laws. identity : ∀ {a} {A : Set a} (xs : List A) → (return id ⊛ xs) ≡ xs identity xs = begin return id ⊛ xs ≡⟨⟩ (return id >>= pam xs) ≡⟨ MonadProperties.left-identity id (pam xs) ⟩ (xs >>= return) ≡⟨ MonadProperties.right-identity xs ⟩ xs ∎ private pam-lemma : ∀ {ℓ} {A B C : Set ℓ} (xs : List A) (f : A → B) (fs : B → List C) → (pam xs f >>= fs) ≡ (xs >>= λ x → fs (f x)) pam-lemma xs f fs = begin (pam xs f >>= fs) ≡⟨ P.sym $ MP.associative xs (return ∘ f) fs ⟩ (xs >>= λ x → return (f x) >>= fs) ≡⟨ MP.cong (refl {x = xs}) (λ x → MP.left-identity (f x) fs) ⟩ (xs >>= λ x → fs (f x)) ∎ composition : ∀ {ℓ} {A B C : Set ℓ} (fs : List (B → C)) (gs : List (A → B)) xs → (return _∘′_ ⊛ fs ⊛ gs ⊛ xs) ≡ (fs ⊛ (gs ⊛ xs)) composition {ℓ} fs gs xs = begin return _∘′_ ⊛ fs ⊛ gs ⊛ xs ≡⟨⟩ (return _∘′_ >>= pam fs >>= pam gs >>= pam xs) ≡⟨ MP.cong (MP.cong (MP.left-identity _∘′_ (pam fs)) (λ f → refl {x = pam gs f})) (λ fg → refl {x = pam xs fg}) ⟩ (pam fs _∘′_ >>= pam gs >>= pam xs) ≡⟨ MP.cong (pam-lemma fs _∘′_ (pam gs)) (λ _ → refl) ⟩ ((fs >>= λ f → pam gs (f ∘′_)) >>= pam xs) ≡⟨ P.sym $ MP.associative fs (λ f → pam gs (_∘′_ f)) (pam xs) ⟩ (fs >>= λ f → pam gs (f ∘′_) >>= pam xs) ≡⟨ (MP.cong (refl {x = fs}) λ f → pam-lemma gs (f ∘′_) (pam xs)) ⟩ (fs >>= λ f → gs >>= λ g → pam xs (f ∘′ g)) ≡⟨ (MP.cong (refl {x = fs}) λ f → MP.cong (refl {x = gs}) λ g → P.sym $ pam-lemma xs g (return ∘ f)) ⟩ (fs >>= λ f → gs >>= λ g → pam (pam xs g) f) ≡⟨ (MP.cong (refl {x = fs}) λ f → MP.associative gs (pam xs) (return ∘ f)) ⟩ (fs >>= pam (gs >>= pam xs)) ≡⟨⟩ fs ⊛ (gs ⊛ xs) ∎ homomorphism : ∀ {ℓ} {A B : Set ℓ} (f : A → B) x → (return f ⊛ return x) ≡ return (f x) homomorphism f x = begin return f ⊛ return x ≡⟨⟩ (return f >>= pam (return x)) ≡⟨ MP.left-identity f (pam (return x)) ⟩ pam (return x) f ≡⟨ MP.left-identity x (return ∘ f) ⟩ return (f x) ∎ interchange : ∀ {ℓ} {A B : Set ℓ} (fs : List (A → B)) {x} → (fs ⊛ return x) ≡ (return (λ f → f x) ⊛ fs) interchange fs {x} = begin fs ⊛ return x ≡⟨⟩ (fs >>= pam (return x)) ≡⟨ (MP.cong (refl {x = fs}) λ f → MP.left-identity x (return ∘ f)) ⟩ (fs >>= λ f → return (f x)) ≡⟨⟩ (pam fs (λ f → f x)) ≡⟨ P.sym $ MP.left-identity (λ f → f x) (pam fs) ⟩ (return (λ f → f x) >>= pam fs) ≡⟨⟩ return (λ f → f x) ⊛ fs ∎ agda-stdlib-1.7.3/src/Data/List/Countdown.agda000066400000000000000000000227701451211343400210540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A data structure which keeps track of an upper bound on the number -- of elements /not/ in a given list ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level using (0ℓ) open import Relation.Binary module Data.List.Countdown (D : DecSetoid 0ℓ 0ℓ) where open import Data.Empty open import Data.Fin.Base using (Fin; zero; suc; punchOut) open import Data.Fin.Properties using (suc-injective; punchOut-injective) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Injection using (Injection; module Injection) open import Data.Bool.Base using (true; false) open import Data.List hiding (lookup) open import Data.List.Relation.Unary.Any as Any using (here; there) open import Data.Nat.Base using (ℕ; zero; suc) open import Data.Product open import Data.Sum.Base open import Data.Sum.Properties open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary open import Relation.Nullary.Decidable using (dec-true; dec-false) open import Relation.Binary.PropositionalEquality as PropEq using (_≡_; _≢_; refl; cong) open PropEq.≡-Reasoning private open module D = DecSetoid D hiding (refl) renaming (Carrier to Elem) open import Data.List.Membership.Setoid D.setoid ------------------------------------------------------------------------ -- Helper functions private -- The /first/ occurrence of x in xs. first-occurrence : ∀ {xs} x → x ∈ xs → x ∈ xs first-occurrence x (here x≈y) = here x≈y first-occurrence x (there {x = y} x∈xs) with x ≟ y ... | true because [x≈y] = here (invert [x≈y]) ... | false because _ = there $ first-occurrence x x∈xs -- The index of the first occurrence of x in xs. first-index : ∀ {xs} x → x ∈ xs → Fin (length xs) first-index x x∈xs = Any.index $ first-occurrence x x∈xs -- first-index preserves equality of its first argument. first-index-cong : ∀ {x₁ x₂ xs} (x₁∈xs : x₁ ∈ xs) (x₂∈xs : x₂ ∈ xs) → x₁ ≈ x₂ → first-index x₁ x₁∈xs ≡ first-index x₂ x₂∈xs first-index-cong {x₁} {x₂} x₁∈xs x₂∈xs x₁≈x₂ = helper x₁∈xs x₂∈xs where helper : ∀ {xs} (x₁∈xs : x₁ ∈ xs) (x₂∈xs : x₂ ∈ xs) → first-index x₁ x₁∈xs ≡ first-index x₂ x₂∈xs helper (here x₁≈x) (here x₂≈x) = refl helper (here x₁≈x) (there {x = x} x₂∈xs) with x₂ ≟ x | dec-true (x₂ ≟ x) (trans (sym x₁≈x₂) x₁≈x) ... | _ | refl = refl helper (there {x = x} x₁∈xs) (here x₂≈x) with x₁ ≟ x | dec-true (x₁ ≟ x) (trans x₁≈x₂ x₂≈x) ... | _ | refl = refl helper (there {x = x} x₁∈xs) (there x₂∈xs) with x₁ ≟ x | x₂ ≟ x ... | true because _ | true because _ = refl ... | false because _ | false because _ = cong suc $ helper x₁∈xs x₂∈xs ... | yes x₁≈x | no x₂≉x = ⊥-elim (x₂≉x (trans (sym x₁≈x₂) x₁≈x)) ... | no x₁≉x | yes x₂≈x = ⊥-elim (x₁≉x (trans x₁≈x₂ x₂≈x)) -- first-index is injective in its first argument. first-index-injective : ∀ {x₁ x₂ xs} (x₁∈xs : x₁ ∈ xs) (x₂∈xs : x₂ ∈ xs) → first-index x₁ x₁∈xs ≡ first-index x₂ x₂∈xs → x₁ ≈ x₂ first-index-injective {x₁} {x₂} = helper where helper : ∀ {xs} (x₁∈xs : x₁ ∈ xs) (x₂∈xs : x₂ ∈ xs) → first-index x₁ x₁∈xs ≡ first-index x₂ x₂∈xs → x₁ ≈ x₂ helper (here x₁≈x) (here x₂≈x) _ = trans x₁≈x (sym x₂≈x) helper (here x₁≈x) (there {x = x} x₂∈xs) _ with x₂ ≟ x helper (here x₁≈x) (there {x = x} x₂∈xs) _ | yes x₂≈x = trans x₁≈x (sym x₂≈x) helper (here x₁≈x) (there {x = x} x₂∈xs) () | no x₂≉x helper (there {x = x} x₁∈xs) (here x₂≈x) _ with x₁ ≟ x helper (there {x = x} x₁∈xs) (here x₂≈x) _ | yes x₁≈x = trans x₁≈x (sym x₂≈x) helper (there {x = x} x₁∈xs) (here x₂≈x) () | no x₁≉x helper (there {x = x} x₁∈xs) (there x₂∈xs) _ with x₁ ≟ x | x₂ ≟ x helper (there {x = x} x₁∈xs) (there x₂∈xs) _ | yes x₁≈x | yes x₂≈x = trans x₁≈x (sym x₂≈x) helper (there {x = x} x₁∈xs) (there x₂∈xs) () | yes x₁≈x | no x₂≉x helper (there {x = x} x₁∈xs) (there x₂∈xs) () | no x₁≉x | yes x₂≈x helper (there {x = x} x₁∈xs) (there x₂∈xs) eq | no x₁≉x | no x₂≉x = helper x₁∈xs x₂∈xs (suc-injective eq) ------------------------------------------------------------------------ -- The countdown data structure -- If counted ⊕ n is inhabited then there are at most n values of type -- Elem which are not members of counted (up to _≈_). You can read the -- symbol _⊕_ as partitioning Elem into two parts: counted and -- uncounted. infix 4 _⊕_ record _⊕_ (counted : List Elem) (n : ℕ) : Set where field -- An element can be of two kinds: -- ⑴ It is provably in counted. -- ⑵ It is one of at most n elements which may or may not be in -- counted. The "at most n" part is guaranteed by the field -- "injective". kind : ∀ x → x ∈ counted ⊎ Fin n injective : ∀ {x y i} → kind x ≡ inj₂ i → kind y ≡ inj₂ i → x ≈ y -- A countdown can be initialised by proving that Elem is finite. empty : ∀ {n} → Injection D.setoid (PropEq.setoid (Fin n)) → [] ⊕ n empty inj = record { kind = inj₂ ∘ _⟨$⟩_ to ; injective = λ {x} {y} {i} eq₁ eq₂ → injective (begin to ⟨$⟩ x ≡⟨ inj₂-injective eq₁ ⟩ i ≡⟨ PropEq.sym $ inj₂-injective eq₂ ⟩ to ⟨$⟩ y ∎) } where open Injection inj -- A countdown can also be initialised by proving that Elem is finite. emptyFromList : (counted : List Elem) → (∀ x → x ∈ counted) → [] ⊕ length counted emptyFromList counted complete = empty record { to = record { _⟨$⟩_ = λ x → first-index x (complete x) ; cong = first-index-cong (complete _) (complete _) } ; injective = first-index-injective (complete _) (complete _) } -- Finds out if an element has been counted yet. lookup : ∀ {counted n} → counted ⊕ n → ∀ x → Dec (x ∈ counted) lookup {counted} _ x = Any.any? (_≟_ x) counted -- When no element remains to be counted all elements have been -- counted. lookup! : ∀ {counted} → counted ⊕ zero → ∀ x → x ∈ counted lookup! counted⊕0 x with _⊕_.kind counted⊕0 x ... | inj₁ x∈counted = x∈counted ... | inj₂ () private -- A variant of lookup!. lookup‼ : ∀ {m counted} → counted ⊕ m → ∀ x → x ∉ counted → ∃ λ n → m ≡ suc n lookup‼ {suc m} counted⊕n x x∉counted = (m , refl) lookup‼ {zero} counted⊕n x x∉counted = ⊥-elim (x∉counted $ lookup! counted⊕n x) -- Counts a previously uncounted element. insert : ∀ {counted n} → counted ⊕ suc n → ∀ x → x ∉ counted → x ∷ counted ⊕ n insert {counted} {n} counted⊕1+n x x∉counted = record { kind = kind′; injective = inj } where open _⊕_ counted⊕1+n helper : ∀ x y i {j} → kind x ≡ inj₂ i → kind y ≡ inj₂ j → i ≡ j → x ≈ y helper _ _ _ eq₁ eq₂ refl = injective eq₁ eq₂ kind′ : ∀ y → y ∈ x ∷ counted ⊎ Fin n kind′ y with y ≟ x | kind x | kind y | helper x y kind′ y | yes y≈x | _ | _ | _ = inj₁ (here y≈x) kind′ y | _ | inj₁ x∈counted | _ | _ = ⊥-elim (x∉counted x∈counted) kind′ y | _ | _ | inj₁ y∈counted | _ = inj₁ (there y∈counted) kind′ y | no y≉x | inj₂ i | inj₂ j | hlp = inj₂ (punchOut (y≉x ∘ sym ∘ hlp _ refl refl)) inj : ∀ {y z i} → kind′ y ≡ inj₂ i → kind′ z ≡ inj₂ i → y ≈ z inj {y} {z} eq₁ eq₂ with y ≟ x | z ≟ x | kind x | kind y | kind z | helper x y | helper x z | helper y z inj () _ | yes _ | _ | _ | _ | _ | _ | _ | _ inj _ () | _ | yes _ | _ | _ | _ | _ | _ | _ inj _ _ | no _ | no _ | inj₁ x∈counted | _ | _ | _ | _ | _ = ⊥-elim (x∉counted x∈counted) inj () _ | no _ | no _ | inj₂ _ | inj₁ _ | _ | _ | _ | _ inj _ () | no _ | no _ | inj₂ _ | _ | inj₁ _ | _ | _ | _ inj eq₁ eq₂ | no _ | no _ | inj₂ i | inj₂ _ | inj₂ _ | _ | _ | hlp = hlp _ refl refl $ punchOut-injective {i = i} _ _ $ (PropEq.trans (inj₂-injective eq₁) (PropEq.sym (inj₂-injective eq₂))) -- Counts an element if it has not already been counted. lookupOrInsert : ∀ {counted m} → counted ⊕ m → ∀ x → x ∈ counted ⊎ ∃ λ n → m ≡ suc n × x ∷ counted ⊕ n lookupOrInsert counted⊕n x with lookup counted⊕n x ... | yes x∈counted = inj₁ x∈counted ... | no x∉counted with lookup‼ counted⊕n x x∉counted ... | (n , refl) = inj₂ (n , refl , insert counted⊕n x x∉counted) agda-stdlib-1.7.3/src/Data/List/Extrema.agda000066400000000000000000000257761451211343400205120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finding the maximum/minimum values in a list ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (TotalOrder; Setoid) module Data.List.Extrema {b ℓ₁ ℓ₂} (totalOrder : TotalOrder b ℓ₁ ℓ₂) where import Algebra.Construct.NaturalChoice.Min as Min import Algebra.Construct.NaturalChoice.Max as Max open import Data.List.Base using (List; foldr) open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.List.Relation.Unary.All using (All; []; _∷_; lookup; map; tabulate) open import Data.List.Membership.Propositional using (_∈_; lose) open import Data.List.Membership.Propositional.Properties using (foldr-selective) open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_; _⊇_) open import Data.List.Properties open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Function.Base using (id; flip; _on_; _∘_) open import Level using (Level) open import Relation.Unary using (Pred) import Relation.Binary.Construct.NonStrictToStrict as NonStrictToStrict open import Relation.Binary.PropositionalEquality.Core using (_≡_; sym; subst) renaming (refl to ≡-refl) import Relation.Binary.Construct.On as On ------------------------------------------------------------------------------ -- Setup open TotalOrder totalOrder renaming (Carrier to B) open NonStrictToStrict _≈_ _≤_ using (_<_) open import Data.List.Extrema.Core totalOrder renaming (⊓ᴸ to ⊓-lift; ⊔ᴸ to ⊔-lift) private variable a p : Level A : Set a ------------------------------------------------------------------------------ -- Functions argmin : (A → B) → A → List A → A argmin f = foldr (⊓-lift f) argmax : (A → B) → A → List A → A argmax f = foldr (⊔-lift f) min : B → List B → B min = argmin id max : B → List B → B max = argmax id ------------------------------------------------------------------------------ -- Properties of argmin module _ {f : A → B} where f[argmin]≤v⁺ : ∀ {v} ⊤ xs → (f ⊤ ≤ v) ⊎ (Any (λ x → f x ≤ v) xs) → f (argmin f ⊤ xs) ≤ v f[argmin]≤v⁺ = foldr-preservesᵒ (⊓ᴸ-presᵒ-≤v f) f[argmin]*_ to _<*>_ ; _>>=*_ to _>>=_ ; mapAccumˡ* to mapAccumˡ ; mapAccumʳ* to mapAccumʳ ; _[_]* to _[_] ; applyUpTo* to applyUpTo ; upTo* to upTo ; zipWith* to zipWith ; unzipWith* to unzipWith ; partitionSumsWith* to partitionSumsWith ; reverse* to reverse ) ------------------------------------------------------------------------ -- A pattern which mimics Data.List._∷_ infixr 5 _∷_ pattern _∷_ x xs = Kleene.∹ x Kleene.& xs ------------------------------------------------------------------------ -- The following functions change the type of the list (from ⁺ to * or vice -- versa) in Data.KleeneList, so we reimplement them here to keep the -- type the same. scanr : (A → B → B) → B → List A → List B scanr f b xs = Kleene.∹ Kleene.scanr* f b xs scanl : (B → A → B) → B → List A → List B scanl f b xs = Kleene.∹ Kleene.scanl* f b xs tails : List A → List (List A) tails xs = foldr (λ x xs → (Kleene.∹ x) ∷ xs) ([] ∷ []) (Kleene.tails* xs) agda-stdlib-1.7.3/src/Data/List/Kleene/Base.agda000066400000000000000000000227221451211343400211460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists, based on the Kleene star and plus, basic types and operations. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Kleene.Base where open import Data.Product as Product using (_×_; _,_; map₂; map₁; proj₁; proj₂) open import Data.Nat as ℕ using (ℕ; suc; zero) open import Data.Maybe as Maybe using (Maybe; just; nothing) open import Data.Sum as Sum using (_⊎_; inj₁; inj₂) open import Level as Level using (Level) open import Algebra.Core using (Op₂) open import Function.Base private variable a b c : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Definitions -- -- These lists are exactly equivalent to normal lists, except the "cons" -- case is split into its own data type. This lets us write all the same -- functions as before, but it has 2 advantages: -- -- * Some functions are easier to express on the non-empty type. Head, -- for instance, has a natural safe implementation. Having the -- non-empty type be defined mutually with the normal type makes the -- use of this non-empty type occasionally more ergonomic. -- * It can make some proofs easier. By using the non-empty type where -- possible, we can avoid an extra pattern match, which can really -- simplify certain proofs. infixr 5 _&_ ∹_ record _+ {a} (A : Set a) : Set a data _* {a} (A : Set a) : Set a -- Non-Empty Lists record _+ A where inductive constructor _&_ field head : A tail : A * -- Possibly Empty Lists data _* A where [] : A * ∹_ : A + → A * open _+ public ------------------------------------------------------------------------ -- Uncons uncons : A * → Maybe (A +) uncons [] = nothing uncons (∹ xs) = just xs ------------------------------------------------------------------------ -- FoldMap foldMap+ : Op₂ B → (A → B) → A + → B foldMap+ _∙_ f (x & []) = f x foldMap+ _∙_ f (x & ∹ xs) = f x ∙ foldMap+ _∙_ f xs foldMap* : Op₂ B → B → (A → B) → A * → B foldMap* _∙_ ε f [] = ε foldMap* _∙_ ε f (∹ xs) = foldMap+ _∙_ f xs ------------------------------------------------------------------------ -- Folds module _ (f : A → B → B) (b : B) where foldr+ : A + → B foldr* : A * → B foldr+ (x & xs) = f x (foldr* xs) foldr* [] = b foldr* (∹ xs) = foldr+ xs module _ (f : B → A → B) where foldl+ : B → A + → B foldl* : B → A * → B foldl+ b (x & xs) = foldl* (f b x) xs foldl* b [] = b foldl* b (∹ xs) = foldl+ b xs ------------------------------------------------------------------------ -- Concatenation module Concat where _++++_ : A + → A + → A + _+++*_ : A + → A * → A + _*+++_ : A * → A + → A + _*++*_ : A * → A * → A * head (xs +++* ys) = head xs tail (xs +++* ys) = tail xs *++* ys xs *++* ys = foldr* (λ x zs → ∹ x & zs) ys xs xs ++++ ys = foldr+ (λ x zs → x & ∹ zs) ys xs [] *+++ ys = ys (∹ xs) *+++ ys = xs ++++ ys open Concat public using () renaming (_++++_ to _+++_; _*++*_ to _++*_) ------------------------------------------------------------------------ -- Mapping module _ (f : A → B) where map+ : A + → B + map* : A * → B * head (map+ xs) = f (head xs) tail (map+ xs) = map* (tail xs) map* [] = [] map* (∹ xs) = ∹ map+ xs module _ (f : A → Maybe B) where mapMaybe+ : A + → B * mapMaybe* : A * → B * mapMaybe+ (x & xs) with f x ... | just y = ∹ y & mapMaybe* xs ... | nothing = mapMaybe* xs mapMaybe* [] = [] mapMaybe* (∹ xs) = mapMaybe+ xs ------------------------------------------------------------------------ -- Applicative Operations pure+ : A → A + head (pure+ x) = x tail (pure+ x) = [] pure* : A → A * pure* x = ∹ pure+ x module Apply where _*<*>*_ : (A → B) * → A * → B * _+<*>*_ : (A → B) + → A * → B * _*<*>+_ : (A → B) * → A + → B * _+<*>+_ : (A → B) + → A + → B + [] *<*>* xs = [] (∹ fs) *<*>* xs = fs +<*>* xs fs +<*>* xs = map* (head fs) xs ++* (tail fs *<*>* xs) [] *<*>+ xs = [] (∹ fs) *<*>+ xs = ∹ fs +<*>+ xs fs +<*>+ xs = map+ (head fs) xs Concat.+++* (tail fs *<*>+ xs) open Apply public using () renaming (_*<*>*_ to _<*>*_; _+<*>+_ to _<*>+_) ------------------------------------------------------------------------ -- Monadic Operations module Bind where _+>>=+_ : A + → (A → B +) → B + _+>>=*_ : A + → (A → B *) → B * _*>>=+_ : A * → (A → B +) → B * _*>>=*_ : A * → (A → B *) → B * (x & xs) +>>=+ k = k x Concat.+++* (xs *>>=+ k) (x & xs) +>>=* k = k x Concat.*++* (xs *>>=* k) [] *>>=* k = [] (∹ xs) *>>=* k = xs +>>=* k [] *>>=+ k = [] (∹ xs) *>>=+ k = ∹ xs +>>=+ k open Bind public using () renaming (_*>>=*_ to _>>=*_; _+>>=+_ to _>>=+_) ------------------------------------------------------------------------ -- Scans module Scanr (f : A → B → B) (b : B) where cons : A → B + → B + head (cons x xs) = f x (head xs) tail (cons x xs) = ∹ xs scanr+ : A + → B + scanr* : A * → B + scanr* = foldr* cons (b & []) scanr+ = foldr+ cons (b & []) open Scanr public using (scanr+; scanr*) module _ (f : B → A → B) where scanl* : B → A * → B + head (scanl* b xs) = b tail (scanl* b []) = [] tail (scanl* b (∹ xs)) = ∹ scanl* (f b (head xs)) (tail xs) scanl+ : B → A + → B + head (scanl+ b xs) = b tail (scanl+ b xs) = ∹ scanl* (f b (head xs)) (tail xs) scanl₁ : B → A + → B + scanl₁ b xs = scanl* (f b (head xs)) (tail xs) ------------------------------------------------------------------------ -- Accumulating maps module _ (f : B → A → (B × C)) where mapAccumˡ* : B → A * → (B × C *) mapAccumˡ+ : B → A + → (B × C +) mapAccumˡ* b [] = b , [] mapAccumˡ* b (∹ xs) = map₂ ∹_ (mapAccumˡ+ b xs) mapAccumˡ+ b (x & xs) = let y , ys = f b x z , zs = mapAccumˡ* y xs in z , ys & zs module _ (f : A → B → (C × B)) (b : B) where mapAccumʳ* : A * → (C * × B) mapAccumʳ+ : A + → (C + × B) mapAccumʳ* [] = [] , b mapAccumʳ* (∹ xs) = map₁ ∹_ (mapAccumʳ+ xs) mapAccumʳ+ (x & xs) = let ys , y = mapAccumʳ* xs zs , z = f x y in zs & ys , z ------------------------------------------------------------------------ -- Non-Empty Folds last : A + → A last (x & []) = x last (_ & ∹ xs) = last xs module _ (f : A → A → A) where foldr₁ : A + → A foldr₁ (x & []) = x foldr₁ (x & ∹ xs) = f x (foldr₁ xs) foldl₁ : A + → A foldl₁ (x & xs) = foldl* f x xs module _ (f : A → Maybe B → B) where foldrMaybe* : A * → Maybe B foldrMaybe+ : A + → B foldrMaybe* [] = nothing foldrMaybe* (∹ xs) = just (foldrMaybe+ xs) foldrMaybe+ xs = f (head xs) (foldrMaybe* (tail xs)) ------------------------------------------------------------------------ -- Indexing _[_]* : A * → ℕ → Maybe A _[_]+ : A + → ℕ → Maybe A [] [ _ ]* = nothing (∹ xs) [ i ]* = xs [ i ]+ xs [ zero ]+ = just (head xs) xs [ suc i ]+ = tail xs [ i ]* applyUpTo* : (ℕ → A) → ℕ → A * applyUpTo+ : (ℕ → A) → ℕ → A + applyUpTo* f zero = [] applyUpTo* f (suc n) = ∹ applyUpTo+ f n head (applyUpTo+ f n) = f zero tail (applyUpTo+ f n) = applyUpTo* (f ∘ suc) n upTo* : ℕ → ℕ * upTo* = applyUpTo* id upTo+ : ℕ → ℕ + upTo+ = applyUpTo+ id ------------------------------------------------------------------------ -- Manipulation module ZipWith (f : A → B → C) where +zipWith+ : A + → B + → C + *zipWith+ : A * → B + → C * +zipWith* : A + → B * → C * *zipWith* : A * → B * → C * head (+zipWith+ xs ys) = f (head xs) (head ys) tail (+zipWith+ xs ys) = *zipWith* (tail xs) (tail ys) *zipWith+ [] ys = [] *zipWith+ (∹ xs) ys = ∹ +zipWith+ xs ys +zipWith* xs [] = [] +zipWith* xs (∹ ys) = ∹ +zipWith+ xs ys *zipWith* [] ys = [] *zipWith* (∹ xs) ys = +zipWith* xs ys open ZipWith public renaming (+zipWith+ to zipWith+; *zipWith* to zipWith*) module Unzip (f : A → B × C) where cons : B × C → B * × C * → B + × C + cons = Product.zip′ _&_ _&_ unzipWith* : A * → B * × C * unzipWith+ : A + → B + × C + unzipWith* = foldr* (λ x xs → Product.map ∹_ ∹_ (cons (f x) xs)) ([] , []) unzipWith+ xs = cons (f (head xs)) (unzipWith* (tail xs)) open Unzip using (unzipWith+; unzipWith*) public module Partition (f : A → B ⊎ C) where cons : B ⊎ C → B * × C * → B * × C * proj₁ (cons (inj₁ x) xs) = ∹ x & proj₁ xs proj₂ (cons (inj₁ x) xs) = proj₂ xs proj₂ (cons (inj₂ x) xs) = ∹ x & proj₂ xs proj₁ (cons (inj₂ x) xs) = proj₁ xs partitionSumsWith* : A * → B * × C * partitionSumsWith+ : A + → B * × C * partitionSumsWith* = foldr* (cons ∘ f) ([] , []) partitionSumsWith+ = foldr+ (cons ∘ f) ([] , []) open Partition using (partitionSumsWith+; partitionSumsWith*) public tails* : A * → (A +) * tails+ : A + → (A +) + head (tails+ xs) = xs tail (tails+ xs) = tails* (tail xs) tails* [] = [] tails* (∹ xs) = ∹ tails+ xs reverse* : A * → A * reverse* = foldl* (λ xs x → ∹ x & xs) [] reverse+ : A + → A + reverse+ (x & xs) = foldl* (λ ys y → y & ∹ ys) (x & []) xs agda-stdlib-1.7.3/src/Data/List/Literals.agda000066400000000000000000000010541451211343400206430ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- List Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Literals where open import Agda.Builtin.FromString open import Data.Unit open import Agda.Builtin.Char open import Agda.Builtin.List open import Data.String.Base using (toList) isString : IsString (List Char) isString = record { Constraint = λ _ → ⊤ ; fromString = λ s → toList s } agda-stdlib-1.7.3/src/Data/List/Membership/000077500000000000000000000000001451211343400203415ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Membership/DecPropositional.agda000066400000000000000000000014151451211343400244360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Decidable propositional membership over lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality using (_≡_; decSetoid) module Data.List.Membership.DecPropositional {a} {A : Set a} (_≟_ : Decidable (_≡_ {A = A})) where ------------------------------------------------------------------------ -- Re-export contents of propositional membership open import Data.List.Membership.Propositional {A = A} public open import Data.List.Membership.DecSetoid (decSetoid _≟_) public using (_∈?_; _∉?_) agda-stdlib-1.7.3/src/Data/List/Membership/DecSetoid.agda000066400000000000000000000016561451211343400230320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Decidable setoid membership over lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Decidable; DecSetoid) open import Relation.Nullary.Negation using (¬?) module Data.List.Membership.DecSetoid {a ℓ} (DS : DecSetoid a ℓ) where open import Data.List.Relation.Unary.Any using (any?) open DecSetoid DS ------------------------------------------------------------------------ -- Re-export contents of propositional membership open import Data.List.Membership.Setoid (DecSetoid.setoid DS) public ------------------------------------------------------------------------ -- Other operations infix 4 _∈?_ _∉?_ _∈?_ : Decidable _∈_ x ∈? xs = any? (x ≟_) xs _∉?_ : Decidable _∉_ x ∉? xs = ¬? (x ∈? xs) agda-stdlib-1.7.3/src/Data/List/Membership/Propositional.agda000066400000000000000000000023141451211343400240210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Data.List.Any.Membership instantiated with propositional equality, -- along with some additional definitions. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Membership.Propositional {a} {A : Set a} where open import Data.List.Relation.Unary.Any using (Any) open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; setoid; subst) import Data.List.Membership.Setoid as SetoidMembership ------------------------------------------------------------------------ -- Re-export contents of setoid membership open SetoidMembership (setoid A) public hiding (lose) ------------------------------------------------------------------------ -- Different members _≢∈_ : ∀ {x y : A} {xs} → x ∈ xs → y ∈ xs → Set _ _≢∈_ x∈xs y∈xs = ∀ x≡y → subst (_∈ _) x≡y x∈xs ≢ y∈xs ------------------------------------------------------------------------ -- Other operations lose : ∀ {p} {P : A → Set p} {x xs} → x ∈ xs → P x → Any P xs lose = SetoidMembership.lose (setoid A) (subst _) agda-stdlib-1.7.3/src/Data/List/Membership/Propositional/000077500000000000000000000000001451211343400232035ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Membership/Propositional/Properties.agda000066400000000000000000000407061451211343400261640ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to propositional list membership ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Membership.Propositional.Properties where open import Algebra using (Op₂; Selective) open import Category.Monad using (RawMonad) open import Data.Bool.Base using (Bool; false; true; T) open import Data.Fin.Base using (Fin) open import Data.List.Base as List open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.List.Relation.Unary.Any.Properties open import Data.List.Membership.Propositional import Data.List.Membership.Setoid.Properties as Membershipₛ open import Data.List.Relation.Binary.Equality.Propositional using (_≋_; ≡⇒≋; ≋⇒≡) open import Data.List.Categorical using (monad) open import Data.Nat.Base using (ℕ; zero; suc; pred; s≤s; _≤_; _<_; _≤ᵇ_) open import Data.Nat.Properties open import Data.Product hiding (map) open import Data.Product.Function.NonDependent.Propositional using (_×-cong_) import Data.Product.Function.Dependent.Propositional as Σ open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (module Equivalence) open import Function.Injection using (Injection; Injective; _↣_) open import Function.Inverse as Inv using (_↔_; module Inverse) import Function.Related as Related open import Function.Related.TypeIsomorphisms open import Level using (Level) open import Relation.Binary as B hiding (Decidable) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl; sym; trans; cong; subst; →-to-⟶; _≗_) import Relation.Binary.Properties.DecTotalOrder as DTOProperties open import Relation.Unary using (_⟨×⟩_; Decidable) import Relation.Nullary.Reflects as Reflects open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary using (¬_; Dec; does; yes; no; _because_) open import Relation.Nullary.Negation private open module ListMonad {ℓ} = RawMonad (monad {ℓ = ℓ}) variable ℓ : Level A B C : Set ℓ ------------------------------------------------------------------------ -- Publicly re-export properties from Core open import Data.List.Membership.Propositional.Properties.Core public ------------------------------------------------------------------------ -- Equality ∈-resp-≋ : ∀ {x : A} → (x ∈_) Respects _≋_ ∈-resp-≋ = Membershipₛ.∈-resp-≋ (P.setoid _) ∉-resp-≋ : ∀ {x : A} → (x ∉_) Respects _≋_ ∉-resp-≋ = Membershipₛ.∉-resp-≋ (P.setoid _) ------------------------------------------------------------------------ -- mapWith∈ mapWith∈-cong : ∀ (xs : List A) → (f g : ∀ {x} → x ∈ xs → B) → (∀ {x} → (x∈xs : x ∈ xs) → f x∈xs ≡ g x∈xs) → mapWith∈ xs f ≡ mapWith∈ xs g mapWith∈-cong [] f g cong = refl mapWith∈-cong (x ∷ xs) f g cong = P.cong₂ _∷_ (cong (here refl)) (mapWith∈-cong xs (f ∘ there) (g ∘ there) (cong ∘ there)) mapWith∈≗map : ∀ (f : A → B) xs → mapWith∈ xs (λ {x} _ → f x) ≡ map f xs mapWith∈≗map f xs = ≋⇒≡ (Membershipₛ.mapWith∈≗map (P.setoid _) (P.setoid _) f xs) ------------------------------------------------------------------------ -- map module _ (f : A → B) where ∈-map⁺ : ∀ {x xs} → x ∈ xs → f x ∈ map f xs ∈-map⁺ = Membershipₛ.∈-map⁺ (P.setoid A) (P.setoid B) (P.cong f) ∈-map⁻ : ∀ {y xs} → y ∈ map f xs → ∃ λ x → x ∈ xs × y ≡ f x ∈-map⁻ = Membershipₛ.∈-map⁻ (P.setoid A) (P.setoid B) map-∈↔ : ∀ {y xs} → (∃ λ x → x ∈ xs × y ≡ f x) ↔ y ∈ map f xs map-∈↔ {y} {xs} = (∃ λ x → x ∈ xs × y ≡ f x) ↔⟨ Any↔ ⟩ Any (λ x → y ≡ f x) xs ↔⟨ map↔ ⟩ y ∈ List.map f xs ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _++_ module _ {v : A} where ∈-++⁺ˡ : ∀ {xs ys} → v ∈ xs → v ∈ xs ++ ys ∈-++⁺ˡ = Membershipₛ.∈-++⁺ˡ (P.setoid A) ∈-++⁺ʳ : ∀ xs {ys} → v ∈ ys → v ∈ xs ++ ys ∈-++⁺ʳ = Membershipₛ.∈-++⁺ʳ (P.setoid A) ∈-++⁻ : ∀ xs {ys} → v ∈ xs ++ ys → (v ∈ xs) ⊎ (v ∈ ys) ∈-++⁻ = Membershipₛ.∈-++⁻ (P.setoid A) ∈-insert : ∀ xs {ys} → v ∈ xs ++ [ v ] ++ ys ∈-insert xs = Membershipₛ.∈-insert (P.setoid A) xs refl ∈-∃++ : ∀ {xs} → v ∈ xs → ∃₂ λ ys zs → xs ≡ ys ++ [ v ] ++ zs ∈-∃++ v∈xs with Membershipₛ.∈-∃++ (P.setoid A) v∈xs ... | ys , zs , _ , refl , eq = ys , zs , ≋⇒≡ eq ------------------------------------------------------------------------ -- concat module _ {v : A} where ∈-concat⁺ : ∀ {xss} → Any (v ∈_) xss → v ∈ concat xss ∈-concat⁺ = Membershipₛ.∈-concat⁺ (P.setoid A) ∈-concat⁻ : ∀ xss → v ∈ concat xss → Any (v ∈_) xss ∈-concat⁻ = Membershipₛ.∈-concat⁻ (P.setoid A) ∈-concat⁺′ : ∀ {vs xss} → v ∈ vs → vs ∈ xss → v ∈ concat xss ∈-concat⁺′ v∈vs vs∈xss = Membershipₛ.∈-concat⁺′ (P.setoid A) v∈vs (Any.map ≡⇒≋ vs∈xss) ∈-concat⁻′ : ∀ xss → v ∈ concat xss → ∃ λ xs → v ∈ xs × xs ∈ xss ∈-concat⁻′ xss v∈c with Membershipₛ.∈-concat⁻′ (P.setoid A) xss v∈c ... | xs , v∈xs , xs∈xss = xs , v∈xs , Any.map ≋⇒≡ xs∈xss concat-∈↔ : ∀ {xss : List (List A)} → (∃ λ xs → v ∈ xs × xs ∈ xss) ↔ v ∈ concat xss concat-∈↔ {xss} = (∃ λ xs → v ∈ xs × xs ∈ xss) ↔⟨ Σ.cong Inv.id $ ×-comm _ _ ⟩ (∃ λ xs → xs ∈ xss × v ∈ xs) ↔⟨ Any↔ ⟩ Any (Any (v ≡_)) xss ↔⟨ concat↔ ⟩ v ∈ concat xss ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- cartesianProductWith module _ (f : A → B → C) where ∈-cartesianProductWith⁺ : ∀ {xs ys a b} → a ∈ xs → b ∈ ys → f a b ∈ cartesianProductWith f xs ys ∈-cartesianProductWith⁺ = Membershipₛ.∈-cartesianProductWith⁺ (P.setoid A) (P.setoid B) (P.setoid C) (P.cong₂ f) ∈-cartesianProductWith⁻ : ∀ xs ys {v} → v ∈ cartesianProductWith f xs ys → ∃₂ λ a b → a ∈ xs × b ∈ ys × v ≡ f a b ∈-cartesianProductWith⁻ = Membershipₛ.∈-cartesianProductWith⁻ (P.setoid A) (P.setoid B) (P.setoid C) f ------------------------------------------------------------------------ -- cartesianProduct ∈-cartesianProduct⁺ : ∀ {x : A} {y : B} {xs ys} → x ∈ xs → y ∈ ys → (x , y) ∈ cartesianProduct xs ys ∈-cartesianProduct⁺ = ∈-cartesianProductWith⁺ _,_ ∈-cartesianProduct⁻ : ∀ xs ys {xy@(x , y) : A × B} → xy ∈ cartesianProduct xs ys → x ∈ xs × y ∈ ys ∈-cartesianProduct⁻ xs ys xy∈p[xs,ys] with ∈-cartesianProductWith⁻ _,_ xs ys xy∈p[xs,ys] ... | (x , y , x∈xs , y∈ys , refl) = x∈xs , y∈ys ------------------------------------------------------------------------ -- applyUpTo module _ (f : ℕ → A) where ∈-applyUpTo⁺ : ∀ {i n} → i < n → f i ∈ applyUpTo f n ∈-applyUpTo⁺ = Membershipₛ.∈-applyUpTo⁺ (P.setoid _) f ∈-applyUpTo⁻ : ∀ {v n} → v ∈ applyUpTo f n → ∃ λ i → i < n × v ≡ f i ∈-applyUpTo⁻ = Membershipₛ.∈-applyUpTo⁻ (P.setoid _) f ------------------------------------------------------------------------ -- upTo ∈-upTo⁺ : ∀ {n i} → i < n → i ∈ upTo n ∈-upTo⁺ = ∈-applyUpTo⁺ id ∈-upTo⁻ : ∀ {n i} → i ∈ upTo n → i < n ∈-upTo⁻ p with ∈-applyUpTo⁻ id p ... | _ , i>=_ >>=-∈↔ : ∀ {xs} {f : A → List B} {y} → (∃ λ x → x ∈ xs × y ∈ f x) ↔ y ∈ (xs >>= f) >>=-∈↔ {xs = xs} {f} {y} = (∃ λ x → x ∈ xs × y ∈ f x) ↔⟨ Any↔ ⟩ Any (Any (y ≡_) ∘ f) xs ↔⟨ >>=↔ ⟩ y ∈ (xs >>= f) ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _⊛_ ⊛-∈↔ : ∀ (fs : List (A → B)) {xs y} → (∃₂ λ f x → f ∈ fs × x ∈ xs × y ≡ f x) ↔ y ∈ (fs ⊛ xs) ⊛-∈↔ fs {xs} {y} = (∃₂ λ f x → f ∈ fs × x ∈ xs × y ≡ f x) ↔⟨ Σ.cong Inv.id (∃∃↔∃∃ _) ⟩ (∃ λ f → f ∈ fs × ∃ λ x → x ∈ xs × y ≡ f x) ↔⟨ Σ.cong Inv.id ((_ ∎) ⟨ _×-cong_ ⟩ Any↔) ⟩ (∃ λ f → f ∈ fs × Any (_≡_ y ∘ f) xs) ↔⟨ Any↔ ⟩ Any (λ f → Any (_≡_ y ∘ f) xs) fs ↔⟨ ⊛↔ ⟩ y ∈ (fs ⊛ xs) ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _⊗_ ⊗-∈↔ : ∀ {xs ys} {x : A} {y : B} → (x ∈ xs × y ∈ ys) ↔ (x , y) ∈ (xs ⊗ ys) ⊗-∈↔ {xs = xs} {ys} {x} {y} = (x ∈ xs × y ∈ ys) ↔⟨ ⊗↔′ ⟩ Any (x ≡_ ⟨×⟩ y ≡_) (xs ⊗ ys) ↔⟨ Any-cong ×-≡×≡↔≡,≡ (_ ∎) ⟩ (x , y) ∈ (xs ⊗ ys) ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- length ∈-length : ∀ {x : A} {xs} → x ∈ xs → 1 ≤ length xs ∈-length = Membershipₛ.∈-length (P.setoid _) ------------------------------------------------------------------------ -- lookup ∈-lookup : ∀ {xs : List A} i → lookup xs i ∈ xs ∈-lookup {xs = xs} i = Membershipₛ.∈-lookup (P.setoid _) xs i ------------------------------------------------------------------------ -- foldr module _ {_•_ : Op₂ A} where foldr-selective : Selective _≡_ _•_ → ∀ e xs → (foldr _•_ e xs ≡ e) ⊎ (foldr _•_ e xs ∈ xs) foldr-selective = Membershipₛ.foldr-selective (P.setoid A) ------------------------------------------------------------------------ -- allFin ∈-allFin : ∀ {n} (k : Fin n) → k ∈ allFin n ∈-allFin = ∈-tabulate⁺ ------------------------------------------------------------------------ -- inits []∈inits : ∀ {a} {A : Set a} (as : List A) → [] ∈ inits as []∈inits [] = here refl []∈inits (a ∷ as) = here refl ------------------------------------------------------------------------ -- Other properties -- Only a finite number of distinct elements can be members of a -- given list. finite : (f : ℕ ↣ A) → ∀ xs → ¬ (∀ i → Injection.to f ⟨$⟩ i ∈ xs) finite inj [] fᵢ∈[] = ¬Any[] (fᵢ∈[] 0) finite inj (x ∷ xs) fᵢ∈x∷xs = excluded-middle helper where open Injection inj renaming (injective to f-inj) f : ℕ → _ f = to ⟨$⟩_ not-x : ∀ {i} → f i ≢ x → f i ∈ xs not-x {i} fᵢ≢x with fᵢ∈x∷xs i ... | here fᵢ≡x = contradiction fᵢ≡x fᵢ≢x ... | there fᵢ∈xs = fᵢ∈xs helper : ¬ Dec (∃ λ i → f i ≡ x) helper (no fᵢ≢x) = finite inj xs (λ i → not-x (fᵢ≢x ∘ _,_ i)) helper (yes (i , fᵢ≡x)) = finite f′-inj xs f′ⱼ∈xs where f′ : ℕ → _ f′ j with does (i ≤? j) ... | true = f (suc j) ... | false = f j ∈-if-not-i : ∀ {j} → i ≢ j → f j ∈ xs ∈-if-not-i i≢j = not-x (i≢j ∘ f-inj ∘ trans fᵢ≡x ∘ sym) lemma : ∀ {k j} → i ≤ j → ¬ (i ≤ k) → suc j ≢ k lemma i≤j i≰1+j refl = i≰1+j (≤-step i≤j) f′ⱼ∈xs : ∀ j → f′ j ∈ xs f′ⱼ∈xs j with i ≤ᵇ j | Reflects.invert (≤ᵇ-reflects-≤ i j) ... | true | p = ∈-if-not-i (<⇒≢ (s≤s p)) ... | false | p = ∈-if-not-i (<⇒≢ (≰⇒> p) ∘ sym) f′-injective′ : Injective {B = P.setoid _} (→-to-⟶ f′) f′-injective′ {j} {k} eq with i ≤ᵇ j | Reflects.invert (≤ᵇ-reflects-≤ i j) | i ≤ᵇ k | Reflects.invert (≤ᵇ-reflects-≤ i k) ... | true | p | true | q = P.cong pred (f-inj eq) ... | true | p | false | q = contradiction (f-inj eq) (lemma p q) ... | false | p | true | q = contradiction (f-inj eq) (lemma q p ∘ sym) ... | false | p | false | q = f-inj eq f′-inj = record { to = →-to-⟶ f′ ; injective = f′-injective′ } ------------------------------------------------------------------------ -- Different members there-injective-≢∈ : ∀ {xs} {x y z : A} {x∈xs : x ∈ xs} {y∈xs : y ∈ xs} → there {x = z} x∈xs ≢∈ there y∈xs → x∈xs ≢∈ y∈xs there-injective-≢∈ neq refl eq = neq refl (P.cong there eq) ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 boolFilter-∈ : ∀ (p : A → Bool) (xs : List A) {x} → x ∈ xs → p x ≡ true → x ∈ boolFilter p xs boolFilter-∈ p (x ∷ xs) (here refl) px≡true rewrite px≡true = here refl boolFilter-∈ p (y ∷ xs) (there pxs) px≡true with p y ... | true = there (boolFilter-∈ p xs pxs px≡true) ... | false = boolFilter-∈ p xs pxs px≡true {-# WARNING_ON_USAGE boolFilter-∈ "Warning: boolFilter was deprecated in v0.15. Please use filter instead." #-} -- Version 0.16 filter-∈ = ∈-filter⁺ {-# WARNING_ON_USAGE filter-∈ "Warning: filter-∈ was deprecated in v0.16. Please use ∈-filter⁺ instead." #-} agda-stdlib-1.7.3/src/Data/List/Membership/Propositional/Properties/000077500000000000000000000000001451211343400253375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Membership/Propositional/Properties/Core.agda000066400000000000000000000061721451211343400270530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Core properties related to propositional list membership. ------------------------------------------------------------------------ -- This file is needed to break the cyclic dependency with the proof -- `Any-cong` in `Data.Any.Properties` which relies on `Any↔` in this -- file. {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Membership.Propositional.Properties.Core where open import Function.Base using (flip; id; _∘_) open import Function.Inverse using (_↔_; inverse) open import Data.List.Base using (List) open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.List.Membership.Propositional open import Data.Product as Prod using (_,_; proj₁; proj₂; uncurry′; ∃; _×_) open import Level using (Level) open import Relation.Binary.PropositionalEquality as P using (_≡_; refl) open import Relation.Unary using (Pred; _⊆_) private variable a p q : Level A : Set a ------------------------------------------------------------------------ -- Lemmas relating map and find. map∘find : ∀ {P : Pred A p} {xs} (p : Any P xs) → let p′ = find p in {f : _≡_ (proj₁ p′) ⊆ P} → f refl ≡ proj₂ (proj₂ p′) → Any.map f (proj₁ (proj₂ p′)) ≡ p map∘find (here p) hyp = P.cong here hyp map∘find (there p) hyp = P.cong there (map∘find p hyp) find∘map : ∀ {P : Pred A p} {Q : Pred A q} {xs : List A} (p : Any P xs) (f : P ⊆ Q) → find (Any.map f p) ≡ Prod.map id (Prod.map id f) (find p) find∘map (here p) f = refl find∘map (there p) f rewrite find∘map p f = refl ------------------------------------------------------------------------ -- find satisfies a simple equality when the predicate is a -- propositional equality. find-∈ : ∀ {x : A} {xs : List A} (x∈xs : x ∈ xs) → find x∈xs ≡ (x , x∈xs , refl) find-∈ (here refl) = refl find-∈ (there x∈xs) rewrite find-∈ x∈xs = refl ------------------------------------------------------------------------ -- find and lose are inverses (more or less). lose∘find : ∀ {P : Pred A p} {xs : List A} (p : Any P xs) → uncurry′ lose (proj₂ (find p)) ≡ p lose∘find p = map∘find p P.refl find∘lose : ∀ (P : Pred A p) {x xs} (x∈xs : x ∈ xs) (pp : P x) → find {P = P} (lose x∈xs pp) ≡ (x , x∈xs , pp) find∘lose P x∈xs p rewrite find∘map x∈xs (flip (P.subst P) p) | find-∈ x∈xs = refl ------------------------------------------------------------------------ -- Any can be expressed using _∈_ module _ {P : Pred A p} where ∃∈-Any : ∀ {xs} → (∃ λ x → x ∈ xs × P x) → Any P xs ∃∈-Any = uncurry′ lose ∘ proj₂ Any↔ : ∀ {xs} → (∃ λ x → x ∈ xs × P x) ↔ Any P xs Any↔ = inverse ∃∈-Any find from∘to lose∘find where from∘to : ∀ v → find (∃∈-Any v) ≡ v from∘to p = find∘lose _ (proj₁ (proj₂ p)) (proj₂ (proj₂ p)) agda-stdlib-1.7.3/src/Data/List/Membership/Propositional/Properties/WithK.agda000066400000000000000000000017701451211343400272100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to propositional list membership, that rely on -- the K rule ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.List.Membership.Propositional.Properties.WithK where open import Data.List.Base open import Data.List.Relation.Unary.Unique.Propositional open import Data.List.Membership.Propositional import Data.List.Membership.Setoid.Properties as Membershipₛ open import Relation.Unary using (Irrelevant) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Binary.PropositionalEquality.WithK ------------------------------------------------------------------------ -- Irrelevance unique⇒irrelevant : ∀ {a} {A : Set a} {xs : List A} → Unique xs → Irrelevant (_∈ xs) unique⇒irrelevant = Membershipₛ.unique⇒irrelevant (P.setoid _) ≡-irrelevant agda-stdlib-1.7.3/src/Data/List/Membership/Setoid.agda000066400000000000000000000042661451211343400224160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- List membership and some related definitions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Membership.Setoid {c ℓ} (S : Setoid c ℓ) where open import Function.Base using (_∘_; id; flip) open import Data.Fin.Base using (Fin; zero; suc) open import Data.List.Base as List using (List; []; _∷_; length; lookup) open import Data.List.Relation.Unary.Any using (Any; index; map; here; there) open import Data.Product as Prod using (∃; _×_; _,_) open import Relation.Unary using (Pred) open import Relation.Nullary using (¬_) open Setoid S renaming (Carrier to A) ------------------------------------------------------------------------ -- Definitions infix 4 _∈_ _∉_ _∈_ : A → List A → Set _ x ∈ xs = Any (x ≈_) xs _∉_ : A → List A → Set _ x ∉ xs = ¬ x ∈ xs ------------------------------------------------------------------------ -- Operations open Data.List.Relation.Unary.Any using (_∷=_; _─_) public mapWith∈ : ∀ {b} {B : Set b} (xs : List A) → (∀ {x} → x ∈ xs → B) → List B mapWith∈ [] f = [] mapWith∈ (x ∷ xs) f = f (here refl) ∷ mapWith∈ xs (f ∘ there) ------------------------------------------------------------------------ -- Finding and losing witnesses module _ {p} {P : Pred A p} where find : ∀ {xs} → Any P xs → ∃ λ x → x ∈ xs × P x find (here px) = (_ , here refl , px) find (there pxs) = Prod.map id (Prod.map there id) (find pxs) lose : P Respects _≈_ → ∀ {x xs} → x ∈ xs → P x → Any P xs lose resp x∈xs px = map (flip resp px) x∈xs ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.16 map-with-∈ = mapWith∈ {-# WARNING_ON_USAGE map-with-∈ "Warning: map-with-∈ was deprecated in v0.16. Please use mapWith∈ instead." #-} agda-stdlib-1.7.3/src/Data/List/Membership/Setoid/000077500000000000000000000000001451211343400215705ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Membership/Setoid/Properties.agda000066400000000000000000000375411451211343400245540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to setoid list membership ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Membership.Setoid.Properties where open import Algebra using (Op₂; Selective) open import Data.Bool.Base using (true; false) open import Data.Fin.Base using (Fin; zero; suc) open import Data.List.Base open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.List.Relation.Unary.All as All using (All) import Data.List.Relation.Unary.Any.Properties as Any import Data.List.Membership.Setoid as Membership import Data.List.Relation.Binary.Equality.Setoid as Equality import Data.List.Relation.Unary.Unique.Setoid as Unique open import Data.Nat.Base using (suc; z≤n; s≤s; _≤_; _<_) open import Data.Nat.Properties using (≤-trans; n≤1+n) open import Data.Product as Prod using (∃; _×_; _,_ ; ∃₂; proj₁; proj₂) open import Data.Product.Relation.Binary.Pointwise.NonDependent using (_×ₛ_) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Function.Base using (_$_; flip; _∘_; id) open import Level using (Level) open import Relation.Binary as B hiding (Decidable) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Unary as U using (Decidable; Pred) open import Relation.Nullary using (¬_; does; _because_; yes; no) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary.Negation using (¬?; contradiction) open Setoid using (Carrier) private variable c c₁ c₂ c₃ p ℓ ℓ₁ ℓ₂ ℓ₃ : Level ------------------------------------------------------------------------ -- Equality properties module _ (S : Setoid c ℓ) where open Setoid S open Equality S open Membership S -- _∈_ respects the underlying equality ∈-resp-≈ : ∀ {xs} → (_∈ xs) Respects _≈_ ∈-resp-≈ x≈y x∈xs = Any.map (trans (sym x≈y)) x∈xs ∉-resp-≈ : ∀ {xs} → (_∉ xs) Respects _≈_ ∉-resp-≈ v≈w v∉xs w∈xs = v∉xs (∈-resp-≈ (sym v≈w) w∈xs) ∈-resp-≋ : ∀ {x} → (x ∈_) Respects _≋_ ∈-resp-≋ = Any.lift-resp (flip trans) ∉-resp-≋ : ∀ {x} → (x ∉_) Respects _≋_ ∉-resp-≋ xs≋ys v∉xs v∈ys = v∉xs (∈-resp-≋ (≋-sym xs≋ys) v∈ys) ------------------------------------------------------------------------ -- Irrelevance module _ (S : Setoid c ℓ) where open Setoid S open Unique S open Membership S private ∉×∈⇒≉ : ∀ {x y xs} → All (y ≉_) xs → x ∈ xs → x ≉ y ∉×∈⇒≉ = All.lookupWith λ y≉z x≈z x≈y → y≉z (trans (sym x≈y) x≈z) unique⇒irrelevant : B.Irrelevant _≈_ → ∀ {xs} → Unique xs → U.Irrelevant (_∈ xs) unique⇒irrelevant ≈-irr _ (here p) (here q) = P.cong here (≈-irr p q) unique⇒irrelevant ≈-irr (_ ∷ u) (there p) (there q) = P.cong there (unique⇒irrelevant ≈-irr u p q) unique⇒irrelevant ≈-irr (≉s ∷ _) (here p) (there q) = contradiction p (∉×∈⇒≉ ≉s q) unique⇒irrelevant ≈-irr (≉s ∷ _) (there p) (here q) = contradiction q (∉×∈⇒≉ ≉s p) ------------------------------------------------------------------------ -- mapWith∈ module _ (S₁ : Setoid c₁ ℓ₁) (S₂ : Setoid c₂ ℓ₂) where open Setoid S₁ renaming (Carrier to A₁; _≈_ to _≈₁_; refl to refl₁) open Setoid S₂ renaming (Carrier to A₂; _≈_ to _≈₂_; refl to refl₂) open Equality S₁ using ([]; _∷_) renaming (_≋_ to _≋₁_) open Equality S₂ using () renaming (_≋_ to _≋₂_) open Membership S₁ mapWith∈-cong : ∀ {xs ys} → xs ≋₁ ys → (f : ∀ {x} → x ∈ xs → A₂) → (g : ∀ {y} → y ∈ ys → A₂) → (∀ {x y} → x ≈₁ y → (x∈xs : x ∈ xs) (y∈ys : y ∈ ys) → f x∈xs ≈₂ g y∈ys) → mapWith∈ xs f ≋₂ mapWith∈ ys g mapWith∈-cong [] f g cong = [] mapWith∈-cong (x≈y ∷ xs≋ys) f g cong = cong x≈y (here refl₁) (here refl₁) ∷ mapWith∈-cong xs≋ys (f ∘ there) (g ∘ there) (λ x≈y x∈xs y∈ys → cong x≈y (there x∈xs) (there y∈ys)) mapWith∈≗map : ∀ f xs → mapWith∈ xs (λ {x} _ → f x) ≋₂ map f xs mapWith∈≗map f [] = [] mapWith∈≗map f (x ∷ xs) = refl₂ ∷ mapWith∈≗map f xs module _ (S : Setoid c ℓ) where open Setoid S open Membership S length-mapWith∈ : ∀ {a} {A : Set a} xs {f : ∀ {x} → x ∈ xs → A} → length (mapWith∈ xs f) ≡ length xs length-mapWith∈ [] = P.refl length-mapWith∈ (x ∷ xs) = P.cong suc (length-mapWith∈ xs) ------------------------------------------------------------------------ -- map module _ (S₁ : Setoid c₁ ℓ₁) (S₂ : Setoid c₂ ℓ₂) where open Setoid S₁ renaming (Carrier to A₁; _≈_ to _≈₁_; refl to refl₁) open Setoid S₂ renaming (Carrier to A₂; _≈_ to _≈₂_) private module M₁ = Membership S₁; open M₁ using (find) renaming (_∈_ to _∈₁_) private module M₂ = Membership S₂; open M₂ using () renaming (_∈_ to _∈₂_) ∈-map⁺ : ∀ {f} → f Preserves _≈₁_ ⟶ _≈₂_ → ∀ {v xs} → v ∈₁ xs → f v ∈₂ map f xs ∈-map⁺ pres x∈xs = Any.map⁺ (Any.map pres x∈xs) ∈-map⁻ : ∀ {v xs f} → v ∈₂ map f xs → ∃ λ x → x ∈₁ xs × v ≈₂ f x ∈-map⁻ x∈map = find (Any.map⁻ x∈map) map-∷= : ∀ {f} (f≈ : f Preserves _≈₁_ ⟶ _≈₂_) {xs x v} → (x∈xs : x ∈₁ xs) → map f (x∈xs M₁.∷= v) ≡ ∈-map⁺ f≈ x∈xs M₂.∷= f v map-∷= f≈ (here x≈y) = P.refl map-∷= f≈ (there x∈xs) = P.cong (_ ∷_) (map-∷= f≈ x∈xs) ------------------------------------------------------------------------ -- _++_ module _ (S : Setoid c ℓ) where open Membership S using (_∈_) open Setoid S open Equality S using (_≋_; _∷_; ≋-refl) ∈-++⁺ˡ : ∀ {v xs ys} → v ∈ xs → v ∈ xs ++ ys ∈-++⁺ˡ = Any.++⁺ˡ ∈-++⁺ʳ : ∀ {v} xs {ys} → v ∈ ys → v ∈ xs ++ ys ∈-++⁺ʳ = Any.++⁺ʳ ∈-++⁻ : ∀ {v} xs {ys} → v ∈ xs ++ ys → (v ∈ xs) ⊎ (v ∈ ys) ∈-++⁻ = Any.++⁻ ∈-insert : ∀ xs {ys v w} → v ≈ w → v ∈ xs ++ [ w ] ++ ys ∈-insert xs = Any.++-insert xs ∈-∃++ : ∀ {v xs} → v ∈ xs → ∃₂ λ ys zs → ∃ λ w → v ≈ w × xs ≋ ys ++ [ w ] ++ zs ∈-∃++ (here px) = [] , _ , _ , px , ≋-refl ∈-∃++ (there {d} v∈xs) with ∈-∃++ v∈xs ... | hs , _ , _ , v≈v′ , eq = d ∷ hs , _ , _ , v≈v′ , refl ∷ eq ------------------------------------------------------------------------ -- concat module _ (S : Setoid c ℓ) where open Setoid S using (_≈_) open Membership S using (_∈_) open Equality S using (≋-setoid) open Membership ≋-setoid using (find) renaming (_∈_ to _∈ₗ_) ∈-concat⁺ : ∀ {v xss} → Any (v ∈_) xss → v ∈ concat xss ∈-concat⁺ = Any.concat⁺ ∈-concat⁻ : ∀ {v} xss → v ∈ concat xss → Any (v ∈_) xss ∈-concat⁻ = Any.concat⁻ ∈-concat⁺′ : ∀ {v vs xss} → v ∈ vs → vs ∈ₗ xss → v ∈ concat xss ∈-concat⁺′ v∈vs = ∈-concat⁺ ∘ Any.map (flip (∈-resp-≋ S) v∈vs) ∈-concat⁻′ : ∀ {v} xss → v ∈ concat xss → ∃ λ xs → v ∈ xs × xs ∈ₗ xss ∈-concat⁻′ xss v∈c[xss] with find (∈-concat⁻ xss v∈c[xss]) ... | xs , t , s = xs , s , t ------------------------------------------------------------------------ -- cartesianProductWith module _ (S₁ : Setoid c₁ ℓ₁) (S₂ : Setoid c₂ ℓ₂) (S₃ : Setoid c₃ ℓ₃) where open Setoid S₁ renaming (_≈_ to _≈₁_; refl to refl₁) open Setoid S₂ renaming (_≈_ to _≈₂_) open Setoid S₃ renaming (_≈_ to _≈₃_) open Membership S₁ renaming (_∈_ to _∈₁_) open Membership S₂ renaming (_∈_ to _∈₂_) open Membership S₃ renaming (_∈_ to _∈₃_) ∈-cartesianProductWith⁺ : ∀ {f} → f Preserves₂ _≈₁_ ⟶ _≈₂_ ⟶ _≈₃_ → ∀ {xs ys a b} → a ∈₁ xs → b ∈₂ ys → f a b ∈₃ cartesianProductWith f xs ys ∈-cartesianProductWith⁺ pres = Any.cartesianProductWith⁺ _ pres ∈-cartesianProductWith⁻ : ∀ f xs ys {v} → v ∈₃ cartesianProductWith f xs ys → ∃₂ λ a b → a ∈₁ xs × b ∈₂ ys × v ≈₃ f a b ∈-cartesianProductWith⁻ f (x ∷ xs) ys v∈c with ∈-++⁻ S₃ (map (f x) ys) v∈c ∈-cartesianProductWith⁻ f (x ∷ xs) ys v∈c | inj₁ v∈map with ∈-map⁻ S₂ S₃ v∈map ... | (b , b∈ys , v≈fxb) = x , b , here refl₁ , b∈ys , v≈fxb ∈-cartesianProductWith⁻ f (x ∷ xs) ys v∈c | inj₂ v∈com with ∈-cartesianProductWith⁻ f xs ys v∈com ... | (a , b , a∈xs , b∈ys , v≈fab) = a , b , there a∈xs , b∈ys , v≈fab ------------------------------------------------------------------------ -- cartesianProduct module _ (S₁ : Setoid c₁ ℓ₁) (S₂ : Setoid c₂ ℓ₂) where open Setoid S₁ renaming (Carrier to A) open Setoid S₂ renaming (Carrier to B) open Membership S₁ renaming (_∈_ to _∈₁_) open Membership S₂ renaming (_∈_ to _∈₂_) open Membership (S₁ ×ₛ S₂) renaming (_∈_ to _∈₁₂_) ∈-cartesianProduct⁺ : ∀ {x y xs ys} → x ∈₁ xs → y ∈₂ ys → (x , y) ∈₁₂ cartesianProduct xs ys ∈-cartesianProduct⁺ = Any.cartesianProduct⁺ ∈-cartesianProduct⁻ : ∀ xs ys {xy@(x , y) : A × B} → xy ∈₁₂ cartesianProduct xs ys → x ∈₁ xs × y ∈₂ ys ∈-cartesianProduct⁻ xs ys = Any.cartesianProduct⁻ xs ys ------------------------------------------------------------------------ -- applyUpTo module _ (S : Setoid c ℓ) where open Setoid S using (_≈_; refl) open Membership S using (_∈_) ∈-applyUpTo⁺ : ∀ f {i n} → i < n → f i ∈ applyUpTo f n ∈-applyUpTo⁺ f = Any.applyUpTo⁺ f refl ∈-applyUpTo⁻ : ∀ {v} f {n} → v ∈ applyUpTo f n → ∃ λ i → i < n × v ≈ f i ∈-applyUpTo⁻ = Any.applyUpTo⁻ ------------------------------------------------------------------------ -- applyDownFrom ∈-applyDownFrom⁺ : ∀ f {i n} → i < n → f i ∈ applyDownFrom f n ∈-applyDownFrom⁺ f = Any.applyDownFrom⁺ f refl ∈-applyDownFrom⁻ : ∀ {v} f {n} → v ∈ applyDownFrom f n → ∃ λ i → i < n × v ≈ f i ∈-applyDownFrom⁻ = Any.applyDownFrom⁻ ------------------------------------------------------------------------ -- tabulate module _ (S : Setoid c ℓ) where open Setoid S using (_≈_; refl) renaming (Carrier to A) open Membership S using (_∈_) ∈-tabulate⁺ : ∀ {n} {f : Fin n → A} i → f i ∈ tabulate f ∈-tabulate⁺ i = Any.tabulate⁺ i refl ∈-tabulate⁻ : ∀ {n} {f : Fin n → A} {v} → v ∈ tabulate f → ∃ λ i → v ≈ f i ∈-tabulate⁻ = Any.tabulate⁻ ------------------------------------------------------------------------ -- filter module _ (S : Setoid c ℓ) {P : Pred (Carrier S) p} (P? : Decidable P) (resp : P Respects (Setoid._≈_ S)) where open Setoid S using (_≈_; sym) open Membership S using (_∈_) ∈-filter⁺ : ∀ {v xs} → v ∈ xs → P v → v ∈ filter P? xs ∈-filter⁺ {xs = x ∷ _} (here v≈x) Pv with P? x ... | true because _ = here v≈x ... | false because [¬Px] = contradiction (resp v≈x Pv) (invert [¬Px]) ∈-filter⁺ {xs = x ∷ _} (there v∈xs) Pv with does (P? x) ... | true = there (∈-filter⁺ v∈xs Pv) ... | false = ∈-filter⁺ v∈xs Pv ∈-filter⁻ : ∀ {v xs} → v ∈ filter P? xs → v ∈ xs × P v ∈-filter⁻ {xs = x ∷ xs} v∈f[x∷xs] with P? x ... | false because _ = Prod.map there id (∈-filter⁻ v∈f[x∷xs]) ... | true because [Px] with v∈f[x∷xs] ... | here v≈x = here v≈x , resp (sym v≈x) (invert [Px]) ... | there v∈fxs = Prod.map there id (∈-filter⁻ v∈fxs) ------------------------------------------------------------------------ -- derun and deduplicate module _ (S : Setoid c ℓ) {R : Rel (Carrier S) ℓ₂} (R? : B.Decidable R) where open Setoid S using (_≈_) open Membership S using (_∈_) ∈-derun⁺ : _≈_ Respectsʳ R → ∀ {xs z} → z ∈ xs → z ∈ derun R? xs ∈-derun⁺ ≈-resp-R z∈xs = Any.derun⁺ R? ≈-resp-R z∈xs ∈-deduplicate⁺ : _≈_ Respectsʳ (flip R) → ∀ {xs z} → z ∈ xs → z ∈ deduplicate R? xs ∈-deduplicate⁺ ≈-resp-R z∈xs = Any.deduplicate⁺ R? ≈-resp-R z∈xs ∈-derun⁻ : ∀ xs {z} → z ∈ derun R? xs → z ∈ xs ∈-derun⁻ xs z∈derun[R,xs] = Any.derun⁻ R? z∈derun[R,xs] ∈-deduplicate⁻ : ∀ xs {z} → z ∈ deduplicate R? xs → z ∈ xs ∈-deduplicate⁻ xs z∈dedup[R,xs] = Any.deduplicate⁻ R? z∈dedup[R,xs] ------------------------------------------------------------------------ -- length module _ (S : Setoid c ℓ) where open Membership S using (_∈_) ∈-length : ∀ {x xs} → x ∈ xs → 1 ≤ length xs ∈-length (here px) = s≤s z≤n ∈-length (there x∈xs) = ≤-trans (∈-length x∈xs) (n≤1+n _) ------------------------------------------------------------------------ -- lookup module _ (S : Setoid c ℓ) where open Setoid S using (refl) open Membership S using (_∈_) ∈-lookup : ∀ xs i → lookup xs i ∈ xs ∈-lookup (x ∷ xs) zero = here refl ∈-lookup (x ∷ xs) (suc i) = there (∈-lookup xs i) ------------------------------------------------------------------------ -- foldr module _ (S : Setoid c ℓ) {_•_ : Op₂ (Carrier S)} where open Setoid S using (_≈_; refl; sym; trans) open Membership S using (_∈_) foldr-selective : Selective _≈_ _•_ → ∀ e xs → (foldr _•_ e xs ≈ e) ⊎ (foldr _•_ e xs ∈ xs) foldr-selective •-sel i [] = inj₁ refl foldr-selective •-sel i (x ∷ xs) with •-sel x (foldr _•_ i xs) ... | inj₁ x•f≈x = inj₂ (here x•f≈x) ... | inj₂ x•f≈f with foldr-selective •-sel i xs ... | inj₁ f≈i = inj₁ (trans x•f≈f f≈i) ... | inj₂ f∈xs = inj₂ (∈-resp-≈ S (sym x•f≈f) (there f∈xs)) ------------------------------------------------------------------------ -- _∷=_ module _ (S : Setoid c ℓ) where open Setoid S open Membership S ∈-∷=⁺-updated : ∀ {xs x v} (x∈xs : x ∈ xs) → v ∈ (x∈xs ∷= v) ∈-∷=⁺-updated (here px) = here refl ∈-∷=⁺-updated (there pxs) = there (∈-∷=⁺-updated pxs) ∈-∷=⁺-untouched : ∀ {xs x y v} (x∈xs : x ∈ xs) → (¬ x ≈ y) → y ∈ xs → y ∈ (x∈xs ∷= v) ∈-∷=⁺-untouched (here x≈z) x≉y (here y≈z) = contradiction (trans x≈z (sym y≈z)) x≉y ∈-∷=⁺-untouched (here x≈z) x≉y (there y∈xs) = there y∈xs ∈-∷=⁺-untouched (there x∈xs) x≉y (here y≈z) = here y≈z ∈-∷=⁺-untouched (there x∈xs) x≉y (there y∈xs) = there (∈-∷=⁺-untouched x∈xs x≉y y∈xs) ∈-∷=⁻ : ∀ {xs x y v} (x∈xs : x ∈ xs) → (¬ y ≈ v) → y ∈ (x∈xs ∷= v) → y ∈ xs ∈-∷=⁻ (here x≈z) y≉v (here y≈v) = contradiction y≈v y≉v ∈-∷=⁻ (here x≈z) y≉v (there y∈) = there y∈ ∈-∷=⁻ (there x∈xs) y≉v (here y≈z) = here y≈z ∈-∷=⁻ (there x∈xs) y≉v (there y∈) = there (∈-∷=⁻ x∈xs y≉v y∈) agda-stdlib-1.7.3/src/Data/List/NonEmpty.agda000066400000000000000000000152311451211343400206370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Non-empty lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.NonEmpty where open import Level using (Level) open import Category.Monad open import Data.Bool.Base using (Bool; false; true; not; T) open import Data.Bool.Properties open import Data.List.Base as List using (List; []; _∷_) open import Data.Maybe.Base using (Maybe ; nothing; just) open import Data.Nat.Base as ℕ open import Data.Product as Prod using (∃; _×_; proj₁; proj₂; _,_; -,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Data.These.Base as These using (These; this; that; these) open import Data.Unit.Base using (tt) open import Data.Vec.Base as Vec using (Vec; []; _∷_) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using () renaming (module Equivalence to Eq) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl) open import Relation.Nullary.Decidable using (isYes) private variable a b c : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Re-export basic type and operations open import Data.List.NonEmpty.Base public ------------------------------------------------------------------------ -- More operations -- Groups all contiguous elements for which the predicate returns the -- same result into lists. split : (p : A → Bool) → List A → List (List⁺ (∃ (T ∘ p)) ⊎ List⁺ (∃ (T ∘ not ∘ p))) split p [] = [] split p (x ∷ xs) with p x | P.inspect p x | split p xs ... | true | P.[ px≡t ] | inj₁ xs′ ∷ xss = inj₁ ((x , Eq.from T-≡ ⟨$⟩ px≡t) ∷⁺ xs′) ∷ xss ... | true | P.[ px≡t ] | xss = inj₁ [ x , Eq.from T-≡ ⟨$⟩ px≡t ] ∷ xss ... | false | P.[ px≡f ] | inj₂ xs′ ∷ xss = inj₂ ((x , Eq.from T-not-≡ ⟨$⟩ px≡f) ∷⁺ xs′) ∷ xss ... | false | P.[ px≡f ] | xss = inj₂ [ x , Eq.from T-not-≡ ⟨$⟩ px≡f ] ∷ xss -- If we flatten the list returned by split, then we get the list we -- started with. flatten : ∀ {p q} {P : A → Set p} {Q : A → Set q} → List (List⁺ (∃ P) ⊎ List⁺ (∃ Q)) → List A flatten = List.concat ∘ List.map Sum.[ toList ∘ map proj₁ , toList ∘ map proj₁ ] flatten-split : (p : A → Bool) (xs : List A) → flatten (split p xs) ≡ xs flatten-split p [] = refl flatten-split p (x ∷ xs) with p x | P.inspect p x | split p xs | flatten-split p xs ... | true | P.[ _ ] | [] | hyp = P.cong (_∷_ x) hyp ... | true | P.[ _ ] | inj₁ _ ∷ _ | hyp = P.cong (_∷_ x) hyp ... | true | P.[ _ ] | inj₂ _ ∷ _ | hyp = P.cong (_∷_ x) hyp ... | false | P.[ _ ] | [] | hyp = P.cong (_∷_ x) hyp ... | false | P.[ _ ] | inj₁ _ ∷ _ | hyp = P.cong (_∷_ x) hyp ... | false | P.[ _ ] | inj₂ _ ∷ _ | hyp = P.cong (_∷_ x) hyp -- Groups all contiguous elements /not/ satisfying the predicate into -- lists. Elements satisfying the predicate are dropped. wordsBy : (A → Bool) → List A → List (List⁺ A) wordsBy p = List.mapMaybe Sum.[ const nothing , just ∘′ map proj₁ ] ∘ split p ------------------------------------------------------------------------ -- Examples -- Note that these examples are simple unit tests, because the type -- checker verifies them. private module Examples {A B : Set} (_⊕_ : A → B → B) (_⊗_ : B → A → B) (_⊙_ : A → A → A) (f : A → B) (a b c : A) where hd : head (a ∷⁺ b ∷⁺ [ c ]) ≡ a hd = refl tl : tail (a ∷⁺ b ∷⁺ [ c ]) ≡ b ∷ c ∷ [] tl = refl mp : map f (a ∷⁺ b ∷⁺ [ c ]) ≡ f a ∷⁺ f b ∷⁺ [ f c ] mp = refl right : foldr _⊕_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊕ (b ⊕ f c)) right = refl right₁ : foldr₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ (a ⊙ (b ⊙ c)) right₁ = refl left : foldl _⊗_ f (a ∷⁺ b ∷⁺ [ c ]) ≡ ((f a ⊗ b) ⊗ c) left = refl left₁ : foldl₁ _⊙_ (a ∷⁺ b ∷⁺ [ c ]) ≡ ((a ⊙ b) ⊙ c) left₁ = refl ⁺app⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺++⁺ (b ∷⁺ [ c ]) ≡ a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ] ⁺app⁺ = refl ⁺app : (a ∷⁺ b ∷⁺ [ c ]) ⁺++ (b ∷ c ∷ []) ≡ a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ] ⁺app = refl app⁺ : (a ∷ b ∷ c ∷ []) ++⁺ (b ∷⁺ [ c ]) ≡ a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ] app⁺ = refl conc : concat ((a ∷⁺ b ∷⁺ [ c ]) ∷⁺ [ b ∷⁺ [ c ] ]) ≡ a ∷⁺ b ∷⁺ c ∷⁺ b ∷⁺ [ c ] conc = refl rev : reverse (a ∷⁺ b ∷⁺ [ c ]) ≡ c ∷⁺ b ∷⁺ [ a ] rev = refl snoc : (a ∷ b ∷ c ∷ []) ∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ] snoc = refl snoc⁺ : (a ∷⁺ b ∷⁺ [ c ]) ⁺∷ʳ a ≡ a ∷⁺ b ∷⁺ c ∷⁺ [ a ] snoc⁺ = refl split-true : split (const true) (a ∷ b ∷ c ∷ []) ≡ inj₁ ((a , tt) ∷⁺ (b , tt) ∷⁺ [ c , tt ]) ∷ [] split-true = refl split-false : split (const false) (a ∷ b ∷ c ∷ []) ≡ inj₂ ((a , tt) ∷⁺ (b , tt) ∷⁺ [ c , tt ]) ∷ [] split-false = refl split-≡1 : split (ℕ._≡ᵇ 1) (1 ∷ 2 ∷ 3 ∷ 1 ∷ 1 ∷ 2 ∷ 1 ∷ []) ≡ inj₁ [ 1 , tt ] ∷ inj₂ ((2 , tt) ∷⁺ [ 3 , tt ]) ∷ inj₁ ((1 , tt) ∷⁺ [ 1 , tt ]) ∷ inj₂ [ 2 , tt ] ∷ inj₁ [ 1 , tt ] ∷ [] split-≡1 = refl wordsBy-true : wordsBy (const true) (a ∷ b ∷ c ∷ []) ≡ [] wordsBy-true = refl wordsBy-false : wordsBy (const false) (a ∷ b ∷ c ∷ []) ≡ (a ∷⁺ b ∷⁺ [ c ]) ∷ [] wordsBy-false = refl wordsBy-≡1 : wordsBy (ℕ._≡ᵇ 1) (1 ∷ 2 ∷ 3 ∷ 1 ∷ 1 ∷ 2 ∷ 1 ∷ []) ≡ (2 ∷⁺ [ 3 ]) ∷ [ 2 ] ∷ [] wordsBy-≡1 = refl ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.4 infixl 5 _∷ʳ'_ _∷ʳ'_ : (xs : List A) (x : A) → SnocView (xs ∷ʳ x) _∷ʳ'_ = SnocView._∷ʳ′_ {-# WARNING_ON_USAGE _∷ʳ'_ "Warning: _∷ʳ'_ (ending in an apostrophe) was deprecated in v1.4. Please use _∷ʳ′_ (ending in a prime) instead." #-} agda-stdlib-1.7.3/src/Data/List/NonEmpty/000077500000000000000000000000001451211343400200175ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/NonEmpty/Base.agda000066400000000000000000000126731451211343400215200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Non-empty lists: base type and operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.NonEmpty.Base where open import Level using (Level) open import Data.Bool.Base using (Bool; false; true; not; T) open import Data.List.Base as List using (List; []; _∷_) open import Data.Maybe.Base using (Maybe ; nothing; just) open import Data.Nat.Base as ℕ open import Data.Product as Prod using (∃; _×_; proj₁; proj₂; _,_; -,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Data.These.Base as These using (These; this; that; these) open import Data.Vec.Base as Vec using (Vec; []; _∷_) open import Function.Base open import Relation.Binary.PropositionalEquality.Core using (_≢_) private variable a b c : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Non-empty lists infixr 5 _∷_ record List⁺ (A : Set a) : Set a where constructor _∷_ field head : A tail : List A open List⁺ public -- Basic combinators uncons : List⁺ A → A × List A uncons (hd ∷ tl) = hd , tl [_] : A → List⁺ A [ x ] = x ∷ [] infixr 5 _∷⁺_ _∷⁺_ : A → List⁺ A → List⁺ A x ∷⁺ y ∷ xs = x ∷ y ∷ xs length : List⁺ A → ℕ length (x ∷ xs) = suc (List.length xs) ------------------------------------------------------------------------ -- Conversion toList : List⁺ A → List A toList (x ∷ xs) = x ∷ xs fromList : List A → Maybe (List⁺ A) fromList [] = nothing fromList (x ∷ xs) = just (x ∷ xs) fromVec : ∀ {n} → Vec A (suc n) → List⁺ A fromVec (x ∷ xs) = x ∷ Vec.toList xs toVec : (xs : List⁺ A) → Vec A (length xs) toVec (x ∷ xs) = x ∷ Vec.fromList xs lift : (∀ {m} → Vec A (suc m) → ∃ λ n → Vec B (suc n)) → List⁺ A → List⁺ B lift f xs = fromVec (proj₂ (f (toVec xs))) ------------------------------------------------------------------------ -- Other operations map : (A → B) → List⁺ A → List⁺ B map f (x ∷ xs) = (f x ∷ List.map f xs) replicate : ∀ n → n ≢ 0 → A → List⁺ A replicate n n≢0 a = a ∷ List.replicate (pred n) a -- Right fold. Note that s is only applied to the last element (see -- the examples below). foldr : (A → B → B) → (A → B) → List⁺ A → B foldr {A = A} {B = B} c s (x ∷ xs) = foldr′ x xs where foldr′ : A → List A → B foldr′ x [] = s x foldr′ x (y ∷ xs) = c x (foldr′ y xs) -- Right fold. foldr₁ : (A → A → A) → List⁺ A → A foldr₁ f = foldr f id -- Left fold. Note that s is only applied to the first element (see -- the examples below). foldl : (B → A → B) → (A → B) → List⁺ A → B foldl c s (x ∷ xs) = List.foldl c (s x) xs -- Left fold. foldl₁ : (A → A → A) → List⁺ A → A foldl₁ f = foldl f id -- Append (several variants). infixr 5 _⁺++⁺_ _++⁺_ _⁺++_ _⁺++⁺_ : List⁺ A → List⁺ A → List⁺ A (x ∷ xs) ⁺++⁺ (y ∷ ys) = x ∷ (xs List.++ y ∷ ys) _⁺++_ : List⁺ A → List A → List⁺ A (x ∷ xs) ⁺++ ys = x ∷ (xs List.++ ys) _++⁺_ : List A → List⁺ A → List⁺ A xs ++⁺ ys = List.foldr _∷⁺_ ys xs concat : List⁺ (List⁺ A) → List⁺ A concat (xs ∷ xss) = xs ⁺++ List.concat (List.map toList xss) concatMap : (A → List⁺ B) → List⁺ A → List⁺ B concatMap f = concat ∘′ map f -- Reverse reverse : List⁺ A → List⁺ A reverse = lift (-,_ ∘′ Vec.reverse) -- Align and Zip alignWith : (These A B → C) → List⁺ A → List⁺ B → List⁺ C alignWith f (a ∷ as) (b ∷ bs) = f (these a b) ∷ List.alignWith f as bs zipWith : (A → B → C) → List⁺ A → List⁺ B → List⁺ C zipWith f (a ∷ as) (b ∷ bs) = f a b ∷ List.zipWith f as bs unalignWith : (A → These B C) → List⁺ A → These (List⁺ B) (List⁺ C) unalignWith f = foldr (These.alignWith mcons mcons ∘′ f) (These.map [_] [_] ∘′ f) where mcons : ∀ {e} {E : Set e} → These E (List⁺ E) → List⁺ E mcons = These.fold [_] id _∷⁺_ unzipWith : (A → B × C) → List⁺ A → List⁺ B × List⁺ C unzipWith f (a ∷ as) = Prod.zip _∷_ _∷_ (f a) (List.unzipWith f as) align : List⁺ A → List⁺ B → List⁺ (These A B) align = alignWith id zip : List⁺ A → List⁺ B → List⁺ (A × B) zip = zipWith _,_ unalign : List⁺ (These A B) → These (List⁺ A) (List⁺ B) unalign = unalignWith id unzip : List⁺ (A × B) → List⁺ A × List⁺ B unzip = unzipWith id -- Snoc. infixl 5 _∷ʳ_ _⁺∷ʳ_ _∷ʳ_ : List A → A → List⁺ A [] ∷ʳ y = [ y ] (x ∷ xs) ∷ʳ y = x ∷ (xs List.∷ʳ y) _⁺∷ʳ_ : List⁺ A → A → List⁺ A xs ⁺∷ʳ x = toList xs ∷ʳ x -- A snoc-view of non-empty lists. infixl 5 _∷ʳ′_ data SnocView {A : Set a} : List⁺ A → Set a where _∷ʳ′_ : (xs : List A) (x : A) → SnocView (xs ∷ʳ x) snocView : (xs : List⁺ A) → SnocView xs snocView (x ∷ xs) with List.initLast xs snocView (x ∷ .[]) | [] = [] ∷ʳ′ x snocView (x ∷ .(xs List.∷ʳ y)) | xs List.∷ʳ′ y = (x ∷ xs) ∷ʳ′ y -- The last element in the list. last : List⁺ A → A last xs with snocView xs last .(ys ∷ʳ y) | ys ∷ʳ′ y = y agda-stdlib-1.7.3/src/Data/List/NonEmpty/Categorical.agda000066400000000000000000000051071451211343400230550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of List⁺ ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.NonEmpty.Categorical where open import Agda.Builtin.List import Data.List.Categorical as List open import Data.List.NonEmpty open import Data.Product using (uncurry) open import Category.Functor open import Category.Applicative open import Category.Monad open import Category.Comonad open import Function ------------------------------------------------------------------------ -- List⁺ applicative functor functor : ∀ {f} → RawFunctor {f} List⁺ functor = record { _<$>_ = map } applicative : ∀ {f} → RawApplicative {f} List⁺ applicative = record { pure = [_] ; _⊛_ = λ fs as → concatMap (λ f → map f as) fs } ------------------------------------------------------------------------ -- List⁺ monad monad : ∀ {f} → RawMonad {f} List⁺ monad = record { return = [_] ; _>>=_ = flip concatMap } ------------------------------------------------------------------------ -- List⁺ comonad comonad : ∀ {f} → RawComonad {f} List⁺ comonad = record { extract = head ; extend = λ f → uncurry (extend f) ∘′ uncons } where extend : ∀ {A B} → (List⁺ A → B) → A → List A → List⁺ B extend f x xs@[] = f (x ∷ xs) ∷ [] extend f x xs@(y ∷ ys) = f (x ∷ xs) ∷⁺ extend f y ys ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {f F} (App : RawApplicative {f} F) where open RawApplicative App sequenceA : ∀ {A} → List⁺ (F A) → F (List⁺ A) sequenceA (x ∷ xs) = _∷_ <$> x ⊛ List.TraversableA.sequenceA App xs mapA : ∀ {a} {A : Set a} {B} → (A → F B) → List⁺ A → F (List⁺ B) mapA f = sequenceA ∘ map f forA : ∀ {a} {A : Set a} {B} → List⁺ A → (A → F B) → F (List⁺ B) forA = flip mapA module TraversableM {m M} (Mon : RawMonad {m} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) ------------------------------------------------------------------------ -- List⁺ monad transformer monadT : ∀ {f} → RawMonadT {f} (_∘′ List⁺) monadT M = record { return = pure ∘′ [_] ; _>>=_ = λ mas f → mas >>= λ as → concat <$> mapM f as } where open RawMonad M; open TraversableM M agda-stdlib-1.7.3/src/Data/List/NonEmpty/Instances.agda000066400000000000000000000010561451211343400225660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for List⁺ ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.NonEmpty.Instances where open import Data.List.NonEmpty.Categorical instance nonEmptyListFunctor = functor nonEmptyListApplicative = applicative nonEmptyListMonad = monad nonEmptyListComonad = comonad nonEmptyListMonadT = λ {ℓ} {M} {{inst}} → monadT {ℓ} {M} inst agda-stdlib-1.7.3/src/Data/List/NonEmpty/Properties.agda000066400000000000000000000036371451211343400230020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of non-empty lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.NonEmpty.Properties where open import Category.Monad open import Data.List.Base as List using (List; []; _∷_; _++_) open import Data.List.Categorical using () renaming (monad to listMonad) open import Data.List.NonEmpty.Categorical using () renaming (monad to list⁺Monad) open import Data.List.NonEmpty as List⁺ open import Data.List.Properties open import Function open import Relation.Binary.PropositionalEquality open ≡-Reasoning private open module LMo {a} = RawMonad {f = a} listMonad using () renaming (_>>=_ to _⋆>>=_) open module L⁺Mo {a} = RawMonad {f = a} list⁺Monad η : ∀ {a} {A : Set a} (xs : List⁺ A) → head xs ∷ tail xs ≡ List⁺.toList xs η _ = refl toList-fromList : ∀ {a} {A : Set a} x (xs : List A) → x ∷ xs ≡ List⁺.toList (x ∷ xs) toList-fromList _ _ = refl toList-⁺++ : ∀ {a} {A : Set a} (xs : List⁺ A) ys → List⁺.toList xs ++ ys ≡ List⁺.toList (xs ⁺++ ys) toList-⁺++ _ _ = refl toList-⁺++⁺ : ∀ {a} {A : Set a} (xs ys : List⁺ A) → List⁺.toList xs ++ List⁺.toList ys ≡ List⁺.toList (xs ⁺++⁺ ys) toList-⁺++⁺ _ _ = refl toList->>= : ∀ {ℓ} {A B : Set ℓ} (f : A → List⁺ B) (xs : List⁺ A) → (List⁺.toList xs ⋆>>= List⁺.toList ∘ f) ≡ (List⁺.toList (xs >>= f)) toList->>= f (x ∷ xs) = begin List.concat (List.map (List⁺.toList ∘ f) (x ∷ xs)) ≡⟨ cong List.concat $ map-compose {g = List⁺.toList} (x ∷ xs) ⟩ List.concat (List.map List⁺.toList (List.map f (x ∷ xs))) ∎ agda-stdlib-1.7.3/src/Data/List/Properties.agda000066400000000000000000001252631451211343400212310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- List-related properties ------------------------------------------------------------------------ -- Note that the lemmas below could be generalised to work with other -- equalities than _≡_. {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Properties where open import Algebra.Bundles open import Algebra.Definitions as AlgebraicDefinitions using (Involutive) import Algebra.Structures as AlgebraicStructures open import Data.Bool.Base using (Bool; false; true; not; if_then_else_) open import Data.Fin.Base using (Fin; zero; suc; cast; toℕ; inject₁) open import Data.List.Base as List open import Data.List.Relation.Unary.All using (All; []; _∷_) open import Data.List.Relation.Unary.Any using (Any; here; there) open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Nat.Base open import Data.Nat.Properties open import Data.Product as Prod hiding (map; zip) import Data.Product.Relation.Unary.All as Prod using (All) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Data.These.Base as These using (These; this; that; these) open import Function open import Level using (Level) open import Relation.Binary as B using (DecidableEquality) import Relation.Binary.Reasoning.Setoid as EqR open import Relation.Binary.PropositionalEquality as P hiding ([_]) open import Relation.Binary as B using (Rel) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary using (¬_; Dec; does; _because_; yes; no) open import Relation.Nullary.Negation using (contradiction; ¬?) open import Relation.Nullary.Decidable as Decidable using (isYes; map′; ⌊_⌋) open import Relation.Nullary.Product using (_×-dec_) open import Relation.Unary using (Pred; Decidable; ∁) open import Relation.Unary.Properties using (∁?) open ≡-Reasoning private variable a b c d e p : Level A : Set a B : Set b C : Set c D : Set d E : Set e ----------------------------------------------------------------------- -- _∷_ module _ {x y : A} {xs ys : List A} where ∷-injective : x ∷ xs ≡ y List.∷ ys → x ≡ y × xs ≡ ys ∷-injective refl = (refl , refl) ∷-injectiveˡ : x ∷ xs ≡ y List.∷ ys → x ≡ y ∷-injectiveˡ refl = refl ∷-injectiveʳ : x ∷ xs ≡ y List.∷ ys → xs ≡ ys ∷-injectiveʳ refl = refl ∷-dec : Dec (x ≡ y) → Dec (xs ≡ ys) → Dec (x List.∷ xs ≡ y ∷ ys) ∷-dec x≟y xs≟ys = Decidable.map′ (uncurry (cong₂ _∷_)) ∷-injective (x≟y ×-dec xs≟ys) ≡-dec : DecidableEquality A → DecidableEquality (List A) ≡-dec _≟_ [] [] = yes refl ≡-dec _≟_ (x ∷ xs) [] = no λ() ≡-dec _≟_ [] (y ∷ ys) = no λ() ≡-dec _≟_ (x ∷ xs) (y ∷ ys) = ∷-dec (x ≟ y) (≡-dec _≟_ xs ys) ------------------------------------------------------------------------ -- map map-id : map id ≗ id {A = List A} map-id [] = refl map-id (x ∷ xs) = cong (x ∷_) (map-id xs) map-id₂ : ∀ {f : A → A} {xs} → All (λ x → f x ≡ x) xs → map f xs ≡ xs map-id₂ [] = refl map-id₂ (fx≡x ∷ pxs) = cong₂ _∷_ fx≡x (map-id₂ pxs) map-++-commute : ∀ (f : A → B) xs ys → map f (xs ++ ys) ≡ map f xs ++ map f ys map-++-commute f [] ys = refl map-++-commute f (x ∷ xs) ys = cong (f x ∷_) (map-++-commute f xs ys) map-cong : ∀ {f g : A → B} → f ≗ g → map f ≗ map g map-cong f≗g [] = refl map-cong f≗g (x ∷ xs) = cong₂ _∷_ (f≗g x) (map-cong f≗g xs) map-cong₂ : ∀ {f g : A → B} {xs} → All (λ x → f x ≡ g x) xs → map f xs ≡ map g xs map-cong₂ [] = refl map-cong₂ (fx≡gx ∷ fxs≡gxs) = cong₂ _∷_ fx≡gx (map-cong₂ fxs≡gxs) length-map : ∀ (f : A → B) xs → length (map f xs) ≡ length xs length-map f [] = refl length-map f (x ∷ xs) = cong suc (length-map f xs) map-compose : {g : B → C} {f : A → B} → map (g ∘ f) ≗ map g ∘ map f map-compose [] = refl map-compose (x ∷ xs) = cong (_ ∷_) (map-compose xs) map-injective : ∀ {f : A → B} → Injective _≡_ _≡_ f → Injective _≡_ _≡_ (map f) map-injective finj {[]} {[]} eq = refl map-injective finj {x ∷ xs} {y ∷ ys} eq = let fx≡fy , fxs≡fys = ∷-injective eq in cong₂ _∷_ (finj fx≡fy) (map-injective finj fxs≡fys) ------------------------------------------------------------------------ -- mapMaybe mapMaybe-just : (xs : List A) → mapMaybe just xs ≡ xs mapMaybe-just [] = refl mapMaybe-just (x ∷ xs) = cong (x ∷_) (mapMaybe-just xs) mapMaybe-nothing : (xs : List A) → mapMaybe {B = A} (λ _ → nothing) xs ≡ [] mapMaybe-nothing [] = refl mapMaybe-nothing (x ∷ xs) = mapMaybe-nothing xs module _ (f : A → Maybe B) where mapMaybe-concatMap : mapMaybe f ≗ concatMap (fromMaybe ∘ f) mapMaybe-concatMap [] = refl mapMaybe-concatMap (x ∷ xs) with f x ... | just y = cong (y ∷_) (mapMaybe-concatMap xs) ... | nothing = mapMaybe-concatMap xs length-mapMaybe : ∀ xs → length (mapMaybe f xs) ≤ length xs length-mapMaybe [] = z≤n length-mapMaybe (x ∷ xs) with f x ... | just y = s≤s (length-mapMaybe xs) ... | nothing = ≤-step (length-mapMaybe xs) ------------------------------------------------------------------------ -- _++_ length-++ : ∀ (xs : List A) {ys} → length (xs ++ ys) ≡ length xs + length ys length-++ [] = refl length-++ (x ∷ xs) = cong suc (length-++ xs) module _ {A : Set a} where open AlgebraicDefinitions {A = List A} _≡_ open AlgebraicStructures {A = List A} _≡_ ++-assoc : Associative _++_ ++-assoc [] ys zs = refl ++-assoc (x ∷ xs) ys zs = cong (x ∷_) (++-assoc xs ys zs) ++-identityˡ : LeftIdentity [] _++_ ++-identityˡ xs = refl ++-identityʳ : RightIdentity [] _++_ ++-identityʳ [] = refl ++-identityʳ (x ∷ xs) = cong (x ∷_) (++-identityʳ xs) ++-identity : Identity [] _++_ ++-identity = ++-identityˡ , ++-identityʳ ++-identityʳ-unique : ∀ (xs : List A) {ys} → xs ≡ xs ++ ys → ys ≡ [] ++-identityʳ-unique [] refl = refl ++-identityʳ-unique (x ∷ xs) eq = ++-identityʳ-unique xs (proj₂ (∷-injective eq)) ++-identityˡ-unique : ∀ {xs} (ys : List A) → xs ≡ ys ++ xs → ys ≡ [] ++-identityˡ-unique [] _ = refl ++-identityˡ-unique {xs = x ∷ xs} (y ∷ ys) eq with ++-identityˡ-unique (ys ++ [ x ]) (begin xs ≡⟨ proj₂ (∷-injective eq) ⟩ ys ++ x ∷ xs ≡⟨ sym (++-assoc ys [ x ] xs) ⟩ (ys ++ [ x ]) ++ xs ∎) ++-identityˡ-unique {xs = x ∷ xs} (y ∷ [] ) eq | () ++-identityˡ-unique {xs = x ∷ xs} (y ∷ _ ∷ _) eq | () ++-cancelˡ : ∀ xs {ys zs : List A} → xs ++ ys ≡ xs ++ zs → ys ≡ zs ++-cancelˡ [] ys≡zs = ys≡zs ++-cancelˡ (x ∷ xs) x∷xs++ys≡x∷xs++zs = ++-cancelˡ xs (∷-injectiveʳ x∷xs++ys≡x∷xs++zs) ++-cancelʳ : ∀ {xs : List A} ys zs → ys ++ xs ≡ zs ++ xs → ys ≡ zs ++-cancelʳ {_} [] [] _ = refl ++-cancelʳ {xs} [] (z ∷ zs) eq = contradiction (trans (cong length eq) (length-++ (z ∷ zs))) (m≢1+n+m (length xs)) ++-cancelʳ {xs} (y ∷ ys) [] eq = contradiction (trans (sym (length-++ (y ∷ ys))) (cong length eq)) (m≢1+n+m (length xs) ∘ sym) ++-cancelʳ {_} (y ∷ ys) (z ∷ zs) eq = cong₂ _∷_ (∷-injectiveˡ eq) (++-cancelʳ ys zs (∷-injectiveʳ eq)) ++-cancel : Cancellative _++_ ++-cancel = ++-cancelˡ , ++-cancelʳ ++-conicalˡ : ∀ (xs ys : List A) → xs ++ ys ≡ [] → xs ≡ [] ++-conicalˡ [] _ refl = refl ++-conicalʳ : ∀ (xs ys : List A) → xs ++ ys ≡ [] → ys ≡ [] ++-conicalʳ [] _ refl = refl ++-conical : Conical [] _++_ ++-conical = ++-conicalˡ , ++-conicalʳ ++-isMagma : IsMagma _++_ ++-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = cong₂ _++_ } ++-isSemigroup : IsSemigroup _++_ ++-isSemigroup = record { isMagma = ++-isMagma ; assoc = ++-assoc } ++-isMonoid : IsMonoid _++_ [] ++-isMonoid = record { isSemigroup = ++-isSemigroup ; identity = ++-identity } module _ (A : Set a) where ++-semigroup : Semigroup a a ++-semigroup = record { Carrier = List A ; isSemigroup = ++-isSemigroup } ++-monoid : Monoid a a ++-monoid = record { Carrier = List A ; isMonoid = ++-isMonoid } ------------------------------------------------------------------------ -- alignWith module _ {f g : These A B → C} where alignWith-cong : f ≗ g → ∀ as → alignWith f as ≗ alignWith g as alignWith-cong f≗g [] bs = map-cong (f≗g ∘ that) bs alignWith-cong f≗g as@(_ ∷ _) [] = map-cong (f≗g ∘ this) as alignWith-cong f≗g (a ∷ as) (b ∷ bs) = cong₂ _∷_ (f≗g (these a b)) (alignWith-cong f≗g as bs) length-alignWith : ∀ xs ys → length (alignWith f xs ys) ≡ length xs ⊔ length ys length-alignWith [] ys = length-map (f ∘′ that) ys length-alignWith xs@(_ ∷ _) [] = length-map (f ∘′ this) xs length-alignWith (x ∷ xs) (y ∷ ys) = cong suc (length-alignWith xs ys) alignWith-map : (g : D → A) (h : E → B) → ∀ xs ys → alignWith f (map g xs) (map h ys) ≡ alignWith (f ∘′ These.map g h) xs ys alignWith-map g h [] ys = sym (map-compose ys) alignWith-map g h xs@(_ ∷ _) [] = sym (map-compose xs) alignWith-map g h (x ∷ xs) (y ∷ ys) = cong₂ _∷_ refl (alignWith-map g h xs ys) map-alignWith : ∀ (g : C → D) → ∀ xs ys → map g (alignWith f xs ys) ≡ alignWith (g ∘′ f) xs ys map-alignWith g [] ys = sym (map-compose ys) map-alignWith g xs@(_ ∷ _) [] = sym (map-compose xs) map-alignWith g (x ∷ xs) (y ∷ ys) = cong₂ _∷_ refl (map-alignWith g xs ys) ------------------------------------------------------------------------ -- zipWith module _ (f : A → A → B) where zipWith-comm : (∀ x y → f x y ≡ f y x) → ∀ xs ys → zipWith f xs ys ≡ zipWith f ys xs zipWith-comm f-comm [] [] = refl zipWith-comm f-comm [] (x ∷ ys) = refl zipWith-comm f-comm (x ∷ xs) [] = refl zipWith-comm f-comm (x ∷ xs) (y ∷ ys) = cong₂ _∷_ (f-comm x y) (zipWith-comm f-comm xs ys) module _ (f : A → B → C) where zipWith-identityˡ : ∀ xs → zipWith f [] xs ≡ [] zipWith-identityˡ [] = refl zipWith-identityˡ (x ∷ xs) = refl zipWith-identityʳ : ∀ xs → zipWith f xs [] ≡ [] zipWith-identityʳ [] = refl zipWith-identityʳ (x ∷ xs) = refl length-zipWith : ∀ xs ys → length (zipWith f xs ys) ≡ length xs ⊓ length ys length-zipWith [] [] = refl length-zipWith [] (y ∷ ys) = refl length-zipWith (x ∷ xs) [] = refl length-zipWith (x ∷ xs) (y ∷ ys) = cong suc (length-zipWith xs ys) zipWith-map : ∀ {d e} {D : Set d} {E : Set e} (g : D → A) (h : E → B) → ∀ xs ys → zipWith f (map g xs) (map h ys) ≡ zipWith (λ x y → f (g x) (h y)) xs ys zipWith-map g h [] [] = refl zipWith-map g h [] (y ∷ ys) = refl zipWith-map g h (x ∷ xs) [] = refl zipWith-map g h (x ∷ xs) (y ∷ ys) = cong₂ _∷_ refl (zipWith-map g h xs ys) map-zipWith : ∀ {d} {D : Set d} (g : C → D) → ∀ xs ys → map g (zipWith f xs ys) ≡ zipWith (λ x y → g (f x y)) xs ys map-zipWith g [] [] = refl map-zipWith g [] (y ∷ ys) = refl map-zipWith g (x ∷ xs) [] = refl map-zipWith g (x ∷ xs) (y ∷ ys) = cong₂ _∷_ refl (map-zipWith g xs ys) ------------------------------------------------------------------------ -- unalignWith unalignWith-this : unalignWith ((A → These A B) ∋ this) ≗ (_, []) unalignWith-this [] = refl unalignWith-this (a ∷ as) = cong (Prod.map₁ (a ∷_)) (unalignWith-this as) unalignWith-that : unalignWith ((B → These A B) ∋ that) ≗ ([] ,_) unalignWith-that [] = refl unalignWith-that (b ∷ bs) = cong (Prod.map₂ (b ∷_)) (unalignWith-that bs) module _ {f g : C → These A B} where unalignWith-cong : f ≗ g → unalignWith f ≗ unalignWith g unalignWith-cong f≗g [] = refl unalignWith-cong f≗g (c ∷ cs) with f c | g c | f≗g c ... | this a | ._ | refl = cong (Prod.map₁ (a ∷_)) (unalignWith-cong f≗g cs) ... | that b | ._ | refl = cong (Prod.map₂ (b ∷_)) (unalignWith-cong f≗g cs) ... | these a b | ._ | refl = cong (Prod.map (a ∷_) (b ∷_)) (unalignWith-cong f≗g cs) module _ (f : C → These A B) where unalignWith-map : (g : D → C) → ∀ ds → unalignWith f (map g ds) ≡ unalignWith (f ∘′ g) ds unalignWith-map g [] = refl unalignWith-map g (d ∷ ds) with f (g d) ... | this a = cong (Prod.map₁ (a ∷_)) (unalignWith-map g ds) ... | that b = cong (Prod.map₂ (b ∷_)) (unalignWith-map g ds) ... | these a b = cong (Prod.map (a ∷_) (b ∷_)) (unalignWith-map g ds) map-unalignWith : (g : A → D) (h : B → E) → Prod.map (map g) (map h) ∘′ unalignWith f ≗ unalignWith (These.map g h ∘′ f) map-unalignWith g h [] = refl map-unalignWith g h (c ∷ cs) with f c ... | this a = cong (Prod.map₁ (g a ∷_)) (map-unalignWith g h cs) ... | that b = cong (Prod.map₂ (h b ∷_)) (map-unalignWith g h cs) ... | these a b = cong (Prod.map (g a ∷_) (h b ∷_)) (map-unalignWith g h cs) unalignWith-alignWith : (g : These A B → C) → f ∘′ g ≗ id → ∀ as bs → unalignWith f (alignWith g as bs) ≡ (as , bs) unalignWith-alignWith g g∘f≗id [] bs = begin unalignWith f (map (g ∘′ that) bs) ≡⟨ unalignWith-map (g ∘′ that) bs ⟩ unalignWith (f ∘′ g ∘′ that) bs ≡⟨ unalignWith-cong (g∘f≗id ∘ that) bs ⟩ unalignWith that bs ≡⟨ unalignWith-that bs ⟩ [] , bs ∎ unalignWith-alignWith g g∘f≗id as@(_ ∷ _) [] = begin unalignWith f (map (g ∘′ this) as) ≡⟨ unalignWith-map (g ∘′ this) as ⟩ unalignWith (f ∘′ g ∘′ this) as ≡⟨ unalignWith-cong (g∘f≗id ∘ this) as ⟩ unalignWith this as ≡⟨ unalignWith-this as ⟩ as , [] ∎ unalignWith-alignWith g g∘f≗id (a ∷ as) (b ∷ bs) rewrite g∘f≗id (these a b) = cong (Prod.map (a ∷_) (b ∷_)) (unalignWith-alignWith g g∘f≗id as bs) ------------------------------------------------------------------------ -- unzipWith module _ (f : A → B × C) where length-unzipWith₁ : ∀ xys → length (proj₁ (unzipWith f xys)) ≡ length xys length-unzipWith₁ [] = refl length-unzipWith₁ (x ∷ xys) = cong suc (length-unzipWith₁ xys) length-unzipWith₂ : ∀ xys → length (proj₂ (unzipWith f xys)) ≡ length xys length-unzipWith₂ [] = refl length-unzipWith₂ (x ∷ xys) = cong suc (length-unzipWith₂ xys) zipWith-unzipWith : (g : B → C → A) → uncurry′ g ∘ f ≗ id → uncurry′ (zipWith g) ∘ (unzipWith f) ≗ id zipWith-unzipWith g f∘g≗id [] = refl zipWith-unzipWith g f∘g≗id (x ∷ xs) = cong₂ _∷_ (f∘g≗id x) (zipWith-unzipWith g f∘g≗id xs) ------------------------------------------------------------------------ -- foldr foldr-universal : ∀ (h : List A → B) f e → (h [] ≡ e) → (∀ x xs → h (x ∷ xs) ≡ f x (h xs)) → h ≗ foldr f e foldr-universal h f e base step [] = base foldr-universal h f e base step (x ∷ xs) = begin h (x ∷ xs) ≡⟨ step x xs ⟩ f x (h xs) ≡⟨ cong (f x) (foldr-universal h f e base step xs) ⟩ f x (foldr f e xs) ∎ foldr-cong : ∀ {f g : A → B → B} {d e : B} → (∀ x y → f x y ≡ g x y) → d ≡ e → foldr f d ≗ foldr g e foldr-cong f≗g refl [] = refl foldr-cong f≗g d≡e (x ∷ xs) rewrite foldr-cong f≗g d≡e xs = f≗g x _ foldr-fusion : ∀ (h : B → C) {f : A → B → B} {g : A → C → C} (e : B) → (∀ x y → h (f x y) ≡ g x (h y)) → h ∘ foldr f e ≗ foldr g (h e) foldr-fusion h {f} {g} e fuse = foldr-universal (h ∘ foldr f e) g (h e) refl (λ x xs → fuse x (foldr f e xs)) id-is-foldr : id {A = List A} ≗ foldr _∷_ [] id-is-foldr = foldr-universal id _∷_ [] refl (λ _ _ → refl) ++-is-foldr : (xs ys : List A) → xs ++ ys ≡ foldr _∷_ ys xs ++-is-foldr xs ys = begin xs ++ ys ≡⟨ cong (_++ ys) (id-is-foldr xs) ⟩ foldr _∷_ [] xs ++ ys ≡⟨ foldr-fusion (_++ ys) [] (λ _ _ → refl) xs ⟩ foldr _∷_ ([] ++ ys) xs ≡⟨⟩ foldr _∷_ ys xs ∎ foldr-++ : ∀ (f : A → B → B) x ys zs → foldr f x (ys ++ zs) ≡ foldr f (foldr f x zs) ys foldr-++ f x [] zs = refl foldr-++ f x (y ∷ ys) zs = cong (f y) (foldr-++ f x ys zs) map-is-foldr : {f : A → B} → map f ≗ foldr (λ x ys → f x ∷ ys) [] map-is-foldr {f = f} xs = begin map f xs ≡⟨ cong (map f) (id-is-foldr xs) ⟩ map f (foldr _∷_ [] xs) ≡⟨ foldr-fusion (map f) [] (λ _ _ → refl) xs ⟩ foldr (λ x ys → f x ∷ ys) [] xs ∎ foldr-∷ʳ : ∀ (f : A → B → B) x y ys → foldr f x (ys ∷ʳ y) ≡ foldr f (f y x) ys foldr-∷ʳ f x y [] = refl foldr-∷ʳ f x y (z ∷ ys) = cong (f z) (foldr-∷ʳ f x y ys) -- Interaction with predicates module _ {P : Pred A p} {f : A → A → A} where foldr-forcesᵇ : (∀ x y → P (f x y) → P x × P y) → ∀ e xs → P (foldr f e xs) → All P xs foldr-forcesᵇ _ _ [] _ = [] foldr-forcesᵇ forces _ (x ∷ xs) Pfold with forces _ _ Pfold ... | (px , pfxs) = px ∷ foldr-forcesᵇ forces _ xs pfxs foldr-preservesᵇ : (∀ {x y} → P x → P y → P (f x y)) → ∀ {e xs} → P e → All P xs → P (foldr f e xs) foldr-preservesᵇ _ Pe [] = Pe foldr-preservesᵇ pres Pe (px ∷ pxs) = pres px (foldr-preservesᵇ pres Pe pxs) foldr-preservesʳ : (∀ x {y} → P y → P (f x y)) → ∀ {e} → P e → ∀ xs → P (foldr f e xs) foldr-preservesʳ pres Pe [] = Pe foldr-preservesʳ pres Pe (_ ∷ xs) = pres _ (foldr-preservesʳ pres Pe xs) foldr-preservesᵒ : (∀ x y → P x ⊎ P y → P (f x y)) → ∀ e xs → P e ⊎ Any P xs → P (foldr f e xs) foldr-preservesᵒ pres e [] (inj₁ Pe) = Pe foldr-preservesᵒ pres e (x ∷ xs) (inj₁ Pe) = pres _ _ (inj₂ (foldr-preservesᵒ pres e xs (inj₁ Pe))) foldr-preservesᵒ pres e (x ∷ xs) (inj₂ (here px)) = pres _ _ (inj₁ px) foldr-preservesᵒ pres e (x ∷ xs) (inj₂ (there pxs)) = pres _ _ (inj₂ (foldr-preservesᵒ pres e xs (inj₂ pxs))) ------------------------------------------------------------------------ -- foldl foldl-++ : ∀ (f : A → B → A) x ys zs → foldl f x (ys ++ zs) ≡ foldl f (foldl f x ys) zs foldl-++ f x [] zs = refl foldl-++ f x (y ∷ ys) zs = foldl-++ f (f x y) ys zs foldl-∷ʳ : ∀ (f : A → B → A) x y ys → foldl f x (ys ∷ʳ y) ≡ f (foldl f x ys) y foldl-∷ʳ f x y [] = refl foldl-∷ʳ f x y (z ∷ ys) = foldl-∷ʳ f (f x z) y ys ------------------------------------------------------------------------ -- concat concat-map : ∀ {f : A → B} → concat ∘ map (map f) ≗ map f ∘ concat concat-map {f = f} xss = begin concat (map (map f) xss) ≡⟨ cong concat (map-is-foldr xss) ⟩ concat (foldr (λ xs → map f xs ∷_) [] xss) ≡⟨ foldr-fusion concat [] (λ _ _ → refl) xss ⟩ foldr (λ ys → map f ys ++_) [] xss ≡⟨ sym (foldr-fusion (map f) [] (map-++-commute f) xss) ⟩ map f (concat xss) ∎ concat-++ : (xss yss : List (List A)) → concat xss ++ concat yss ≡ concat (xss ++ yss) concat-++ [] yss = refl concat-++ ([] ∷ xss) yss = concat-++ xss yss concat-++ ((x ∷ xs) ∷ xss) yss = cong (x ∷_) (concat-++ (xs ∷ xss) yss) concat-concat : concat {A = A} ∘ map concat ≗ concat ∘ concat concat-concat [] = refl concat-concat (xss ∷ xsss) = begin concat (map concat (xss ∷ xsss)) ≡⟨ cong (concat xss ++_) (concat-concat xsss) ⟩ concat xss ++ concat (concat xsss) ≡⟨ concat-++ xss (concat xsss) ⟩ concat (concat (xss ∷ xsss)) ∎ concat-[-] : concat {A = A} ∘ map [_] ≗ id concat-[-] [] = refl concat-[-] (x ∷ xs) = cong (x ∷_) (concat-[-] xs) ------------------------------------------------------------------------ -- sum sum-++-commute : ∀ xs ys → sum (xs ++ ys) ≡ sum xs + sum ys sum-++-commute [] ys = refl sum-++-commute (x ∷ xs) ys = begin x + sum (xs ++ ys) ≡⟨ cong (x +_) (sum-++-commute xs ys) ⟩ x + (sum xs + sum ys) ≡⟨ sym (+-assoc x _ _) ⟩ (x + sum xs) + sum ys ∎ ------------------------------------------------------------------------ -- replicate length-replicate : ∀ n {x : A} → length (replicate n x) ≡ n length-replicate zero = refl length-replicate (suc n) = cong suc (length-replicate n) ------------------------------------------------------------------------ -- scanr scanr-defn : ∀ (f : A → B → B) (e : B) → scanr f e ≗ map (foldr f e) ∘ tails scanr-defn f e [] = refl scanr-defn f e (x ∷ []) = refl scanr-defn f e (x ∷ y ∷ xs) with scanr f e (y ∷ xs) | scanr-defn f e (y ∷ xs) ... | [] | () ... | z ∷ zs | eq with ∷-injective eq ... | z≡fy⦇f⦈xs , _ = cong₂ (λ z → f x z ∷_) z≡fy⦇f⦈xs eq ------------------------------------------------------------------------ -- scanl scanl-defn : ∀ (f : A → B → A) (e : A) → scanl f e ≗ map (foldl f e) ∘ inits scanl-defn f e [] = refl scanl-defn f e (x ∷ xs) = cong (e ∷_) (begin scanl f (f e x) xs ≡⟨ scanl-defn f (f e x) xs ⟩ map (foldl f (f e x)) (inits xs) ≡⟨ refl ⟩ map (foldl f e ∘ (x ∷_)) (inits xs) ≡⟨ map-compose (inits xs) ⟩ map (foldl f e) (map (x ∷_) (inits xs)) ∎) ------------------------------------------------------------------------ -- applyUpTo length-applyUpTo : ∀ (f : ℕ → A) n → length (applyUpTo f n) ≡ n length-applyUpTo f zero = refl length-applyUpTo f (suc n) = cong suc (length-applyUpTo (f ∘ suc) n) lookup-applyUpTo : ∀ (f : ℕ → A) n i → lookup (applyUpTo f n) i ≡ f (toℕ i) lookup-applyUpTo f (suc n) zero = refl lookup-applyUpTo f (suc n) (suc i) = lookup-applyUpTo (f ∘ suc) n i ------------------------------------------------------------------------ -- applyUpTo module _ (f : ℕ → A) where length-applyDownFrom : ∀ n → length (applyDownFrom f n) ≡ n length-applyDownFrom zero = refl length-applyDownFrom (suc n) = cong suc (length-applyDownFrom n) lookup-applyDownFrom : ∀ n i → lookup (applyDownFrom f n) i ≡ f (n ∸ (suc (toℕ i))) lookup-applyDownFrom (suc n) zero = refl lookup-applyDownFrom (suc n) (suc i) = lookup-applyDownFrom n i ------------------------------------------------------------------------ -- upTo length-upTo : ∀ n → length (upTo n) ≡ n length-upTo = length-applyUpTo id lookup-upTo : ∀ n i → lookup (upTo n) i ≡ toℕ i lookup-upTo = lookup-applyUpTo id ------------------------------------------------------------------------ -- downFrom length-downFrom : ∀ n → length (downFrom n) ≡ n length-downFrom = length-applyDownFrom id lookup-downFrom : ∀ n i → lookup (downFrom n) i ≡ n ∸ (suc (toℕ i)) lookup-downFrom = lookup-applyDownFrom id ------------------------------------------------------------------------ -- tabulate tabulate-cong : ∀ {n} {f g : Fin n → A} → f ≗ g → tabulate f ≡ tabulate g tabulate-cong {n = zero} p = refl tabulate-cong {n = suc n} p = cong₂ _∷_ (p zero) (tabulate-cong (p ∘ suc)) tabulate-lookup : ∀ (xs : List A) → tabulate (lookup xs) ≡ xs tabulate-lookup [] = refl tabulate-lookup (x ∷ xs) = cong (_ ∷_) (tabulate-lookup xs) length-tabulate : ∀ {n} → (f : Fin n → A) → length (tabulate f) ≡ n length-tabulate {n = zero} f = refl length-tabulate {n = suc n} f = cong suc (length-tabulate (λ z → f (suc z))) lookup-tabulate : ∀ {n} → (f : Fin n → A) → ∀ i → let i′ = cast (sym (length-tabulate f)) i in lookup (tabulate f) i′ ≡ f i lookup-tabulate f zero = refl lookup-tabulate f (suc i) = lookup-tabulate (f ∘ suc) i map-tabulate : ∀ {n} (g : Fin n → A) (f : A → B) → map f (tabulate g) ≡ tabulate (f ∘ g) map-tabulate {n = zero} g f = refl map-tabulate {n = suc n} g f = cong (_ ∷_) (map-tabulate (g ∘ suc) f) ------------------------------------------------------------------------ -- _[_]%=_ length-%= : ∀ xs k (f : A → A) → length (xs [ k ]%= f) ≡ length xs length-%= (x ∷ xs) zero f = refl length-%= (x ∷ xs) (suc k) f = cong suc (length-%= xs k f) ------------------------------------------------------------------------ -- _[_]∷=_ length-∷= : ∀ xs k (v : A) → length (xs [ k ]∷= v) ≡ length xs length-∷= xs k v = length-%= xs k (const v) map-∷= : ∀ xs k (v : A) (f : A → B) → let eq = sym (length-map f xs) in map f (xs [ k ]∷= v) ≡ map f xs [ cast eq k ]∷= f v map-∷= (x ∷ xs) zero v f = refl map-∷= (x ∷ xs) (suc k) v f = cong (f x ∷_) (map-∷= xs k v f) ------------------------------------------------------------------------ -- _─_ length-─ : ∀ (xs : List A) k → length (xs ─ k) ≡ pred (length xs) length-─ (x ∷ xs) zero = refl length-─ (x ∷ y ∷ xs) (suc k) = cong suc (length-─ (y ∷ xs) k) map-─ : ∀ xs k (f : A → B) → let eq = sym (length-map f xs) in map f (xs ─ k) ≡ map f xs ─ cast eq k map-─ (x ∷ xs) zero f = refl map-─ (x ∷ xs) (suc k) f = cong (f x ∷_) (map-─ xs k f) ------------------------------------------------------------------------ -- take length-take : ∀ n (xs : List A) → length (take n xs) ≡ n ⊓ (length xs) length-take zero xs = refl length-take (suc n) [] = refl length-take (suc n) (x ∷ xs) = cong suc (length-take n xs) ------------------------------------------------------------------------ -- drop length-drop : ∀ n (xs : List A) → length (drop n xs) ≡ length xs ∸ n length-drop zero xs = refl length-drop (suc n) [] = refl length-drop (suc n) (x ∷ xs) = length-drop n xs take++drop : ∀ n (xs : List A) → take n xs ++ drop n xs ≡ xs take++drop zero xs = refl take++drop (suc n) [] = refl take++drop (suc n) (x ∷ xs) = cong (x ∷_) (take++drop n xs) ------------------------------------------------------------------------ -- splitAt splitAt-defn : ∀ n → splitAt {A = A} n ≗ < take n , drop n > splitAt-defn zero xs = refl splitAt-defn (suc n) [] = refl splitAt-defn (suc n) (x ∷ xs) with splitAt n xs | splitAt-defn n xs ... | (ys , zs) | ih = cong (Prod.map (x ∷_) id) ih ------------------------------------------------------------------------ -- takeWhile, dropWhile, and span module _ {P : Pred A p} (P? : Decidable P) where takeWhile++dropWhile : ∀ xs → takeWhile P? xs ++ dropWhile P? xs ≡ xs takeWhile++dropWhile [] = refl takeWhile++dropWhile (x ∷ xs) with does (P? x) ... | true = cong (x ∷_) (takeWhile++dropWhile xs) ... | false = refl span-defn : span P? ≗ < takeWhile P? , dropWhile P? > span-defn [] = refl span-defn (x ∷ xs) with does (P? x) ... | true = cong (Prod.map (x ∷_) id) (span-defn xs) ... | false = refl ------------------------------------------------------------------------ -- filter module _ {P : Pred A p} (P? : Decidable P) where length-filter : ∀ xs → length (filter P? xs) ≤ length xs length-filter [] = z≤n length-filter (x ∷ xs) with does (P? x) ... | false = ≤-step (length-filter xs) ... | true = s≤s (length-filter xs) filter-all : ∀ {xs} → All P xs → filter P? xs ≡ xs filter-all {[]} [] = refl filter-all {x ∷ xs} (px ∷ pxs) with P? x ... | no ¬px = contradiction px ¬px ... | true because _ = cong (x ∷_) (filter-all pxs) filter-notAll : ∀ xs → Any (∁ P) xs → length (filter P? xs) < length xs filter-notAll (x ∷ xs) (here ¬px) with P? x ... | false because _ = s≤s (length-filter xs) ... | yes px = contradiction px ¬px filter-notAll (x ∷ xs) (there any) with does (P? x) ... | false = ≤-step (filter-notAll xs any) ... | true = s≤s (filter-notAll xs any) filter-some : ∀ {xs} → Any P xs → 0 < length (filter P? xs) filter-some {x ∷ xs} (here px) with P? x ... | true because _ = s≤s z≤n ... | no ¬px = contradiction px ¬px filter-some {x ∷ xs} (there pxs) with does (P? x) ... | true = ≤-step (filter-some pxs) ... | false = filter-some pxs filter-none : ∀ {xs} → All (∁ P) xs → filter P? xs ≡ [] filter-none {[]} [] = refl filter-none {x ∷ xs} (¬px ∷ ¬pxs) with P? x ... | false because _ = filter-none ¬pxs ... | yes px = contradiction px ¬px filter-complete : ∀ {xs} → length (filter P? xs) ≡ length xs → filter P? xs ≡ xs filter-complete {[]} eq = refl filter-complete {x ∷ xs} eq with does (P? x) ... | false = contradiction eq (<⇒≢ (s≤s (length-filter xs))) ... | true = cong (x ∷_) (filter-complete (suc-injective eq)) filter-accept : ∀ {x xs} → P x → filter P? (x ∷ xs) ≡ x ∷ (filter P? xs) filter-accept {x} Px with P? x ... | true because _ = refl ... | no ¬Px = contradiction Px ¬Px filter-reject : ∀ {x xs} → ¬ P x → filter P? (x ∷ xs) ≡ filter P? xs filter-reject {x} ¬Px with P? x ... | yes Px = contradiction Px ¬Px ... | false because _ = refl filter-idem : filter P? ∘ filter P? ≗ filter P? filter-idem [] = refl filter-idem (x ∷ xs) with does (P? x) | inspect does (P? x) ... | false | _ = filter-idem xs ... | true | P.[ eq ] rewrite eq = cong (x ∷_) (filter-idem xs) filter-++ : ∀ xs ys → filter P? (xs ++ ys) ≡ filter P? xs ++ filter P? ys filter-++ [] ys = refl filter-++ (x ∷ xs) ys with does (P? x) ... | true = cong (x ∷_) (filter-++ xs ys) ... | false = filter-++ xs ys ------------------------------------------------------------------------ -- derun and deduplicate module _ {R : Rel A p} (R? : B.Decidable R) where length-derun : ∀ xs → length (derun R? xs) ≤ length xs length-derun [] = ≤-refl length-derun (x ∷ []) = ≤-refl length-derun (x ∷ y ∷ xs) with does (R? x y) | length-derun (y ∷ xs) ... | true | r = ≤-step r ... | false | r = s≤s r length-deduplicate : ∀ xs → length (deduplicate R? xs) ≤ length xs length-deduplicate [] = z≤n length-deduplicate (x ∷ xs) = ≤-begin 1 + length (filter (¬? ∘ R? x) r) ≤⟨ s≤s (length-filter (¬? ∘ R? x) r) ⟩ 1 + length r ≤⟨ s≤s (length-deduplicate xs) ⟩ 1 + length xs ≤-∎ where open ≤-Reasoning renaming (begin_ to ≤-begin_; _∎ to _≤-∎) r = deduplicate R? xs derun-reject : ∀ {x y} xs → R x y → derun R? (x ∷ y ∷ xs) ≡ derun R? (y ∷ xs) derun-reject {x} {y} xs Rxy with R? x y ... | yes _ = refl ... | no ¬Rxy = contradiction Rxy ¬Rxy derun-accept : ∀ {x y} xs → ¬ R x y → derun R? (x ∷ y ∷ xs) ≡ x ∷ derun R? (y ∷ xs) derun-accept {x} {y} xs ¬Rxy with R? x y ... | yes Rxy = contradiction Rxy ¬Rxy ... | no _ = refl ------------------------------------------------------------------------ -- partition module _ {P : Pred A p} (P? : Decidable P) where partition-defn : partition P? ≗ < filter P? , filter (∁? P?) > partition-defn [] = refl partition-defn (x ∷ xs) with does (P? x) ... | true = cong (Prod.map (x ∷_) id) (partition-defn xs) ... | false = cong (Prod.map id (x ∷_)) (partition-defn xs) length-partition : ∀ xs → (let (ys , zs) = partition P? xs) → length ys ≤ length xs × length zs ≤ length xs length-partition [] = z≤n , z≤n length-partition (x ∷ xs) with does (P? x) | length-partition xs ... | true | rec = Prod.map s≤s ≤-step rec ... | false | rec = Prod.map ≤-step s≤s rec ------------------------------------------------------------------------ -- _ʳ++_ ʳ++-defn : ∀ (xs : List A) {ys} → xs ʳ++ ys ≡ reverse xs ++ ys ʳ++-defn [] = refl ʳ++-defn (x ∷ xs) {ys} = begin (x ∷ xs) ʳ++ ys ≡⟨⟩ xs ʳ++ x ∷ ys ≡⟨⟩ xs ʳ++ [ x ] ++ ys ≡⟨ ʳ++-defn xs ⟩ reverse xs ++ [ x ] ++ ys ≡⟨ sym (++-assoc (reverse xs) _ _) ⟩ (reverse xs ++ [ x ]) ++ ys ≡⟨ cong (_++ ys) (sym (ʳ++-defn xs)) ⟩ (xs ʳ++ [ x ]) ++ ys ≡⟨⟩ reverse (x ∷ xs) ++ ys ∎ -- Reverse-append of append is reverse-append after reverse-append. ʳ++-++ : ∀ (xs {ys zs} : List A) → (xs ++ ys) ʳ++ zs ≡ ys ʳ++ xs ʳ++ zs ʳ++-++ [] = refl ʳ++-++ (x ∷ xs) {ys} {zs} = begin (x ∷ xs ++ ys) ʳ++ zs ≡⟨⟩ (xs ++ ys) ʳ++ x ∷ zs ≡⟨ ʳ++-++ xs ⟩ ys ʳ++ xs ʳ++ x ∷ zs ≡⟨⟩ ys ʳ++ (x ∷ xs) ʳ++ zs ∎ -- Reverse-append of reverse-append is commuted reverse-append after append. ʳ++-ʳ++ : ∀ (xs {ys zs} : List A) → (xs ʳ++ ys) ʳ++ zs ≡ ys ʳ++ xs ++ zs ʳ++-ʳ++ [] = refl ʳ++-ʳ++ (x ∷ xs) {ys} {zs} = begin ((x ∷ xs) ʳ++ ys) ʳ++ zs ≡⟨⟩ (xs ʳ++ x ∷ ys) ʳ++ zs ≡⟨ ʳ++-ʳ++ xs ⟩ (x ∷ ys) ʳ++ xs ++ zs ≡⟨⟩ ys ʳ++ (x ∷ xs) ++ zs ∎ -- Length of reverse-append length-ʳ++ : ∀ (xs {ys} : List A) → length (xs ʳ++ ys) ≡ length xs + length ys length-ʳ++ [] = refl length-ʳ++ (x ∷ xs) {ys} = begin length ((x ∷ xs) ʳ++ ys) ≡⟨⟩ length (xs ʳ++ x ∷ ys) ≡⟨ length-ʳ++ xs ⟩ length xs + length (x ∷ ys) ≡⟨ +-suc _ _ ⟩ length (x ∷ xs) + length ys ∎ -- map distributes over reverse-append. map-ʳ++ : (f : A → B) (xs {ys} : List A) → map f (xs ʳ++ ys) ≡ map f xs ʳ++ map f ys map-ʳ++ f [] = refl map-ʳ++ f (x ∷ xs) {ys} = begin map f ((x ∷ xs) ʳ++ ys) ≡⟨⟩ map f (xs ʳ++ x ∷ ys) ≡⟨ map-ʳ++ f xs ⟩ map f xs ʳ++ map f (x ∷ ys) ≡⟨⟩ map f xs ʳ++ f x ∷ map f ys ≡⟨⟩ (f x ∷ map f xs) ʳ++ map f ys ≡⟨⟩ map f (x ∷ xs) ʳ++ map f ys ∎ -- A foldr after a reverse is a foldl. foldr-ʳ++ : ∀ (f : A → B → B) b xs {ys} → foldr f b (xs ʳ++ ys) ≡ foldl (flip f) (foldr f b ys) xs foldr-ʳ++ f b [] {_} = refl foldr-ʳ++ f b (x ∷ xs) {ys} = begin foldr f b ((x ∷ xs) ʳ++ ys) ≡⟨⟩ foldr f b (xs ʳ++ x ∷ ys) ≡⟨ foldr-ʳ++ f b xs ⟩ foldl (flip f) (foldr f b (x ∷ ys)) xs ≡⟨⟩ foldl (flip f) (f x (foldr f b ys)) xs ≡⟨⟩ foldl (flip f) (foldr f b ys) (x ∷ xs) ∎ -- A foldl after a reverse is a foldr. foldl-ʳ++ : ∀ (f : B → A → B) b xs {ys} → foldl f b (xs ʳ++ ys) ≡ foldl f (foldr (flip f) b xs) ys foldl-ʳ++ f b [] {_} = refl foldl-ʳ++ f b (x ∷ xs) {ys} = begin foldl f b ((x ∷ xs) ʳ++ ys) ≡⟨⟩ foldl f b (xs ʳ++ x ∷ ys) ≡⟨ foldl-ʳ++ f b xs ⟩ foldl f (foldr (flip f) b xs) (x ∷ ys) ≡⟨⟩ foldl f (f (foldr (flip f) b xs) x) ys ≡⟨⟩ foldl f (foldr (flip f) b (x ∷ xs)) ys ∎ ------------------------------------------------------------------------ -- reverse -- reverse of cons is snoc of reverse. unfold-reverse : ∀ (x : A) xs → reverse (x ∷ xs) ≡ reverse xs ∷ʳ x unfold-reverse x xs = ʳ++-defn xs -- reverse is an involution with respect to append. reverse-++-commute : (xs ys : List A) → reverse (xs ++ ys) ≡ reverse ys ++ reverse xs reverse-++-commute xs ys = begin reverse (xs ++ ys) ≡⟨⟩ (xs ++ ys) ʳ++ [] ≡⟨ ʳ++-++ xs ⟩ ys ʳ++ xs ʳ++ [] ≡⟨⟩ ys ʳ++ reverse xs ≡⟨ ʳ++-defn ys ⟩ reverse ys ++ reverse xs ∎ -- reverse is involutive. reverse-involutive : Involutive {A = List A} _≡_ reverse reverse-involutive xs = begin reverse (reverse xs) ≡⟨⟩ (xs ʳ++ []) ʳ++ [] ≡⟨ ʳ++-ʳ++ xs ⟩ [] ʳ++ xs ++ [] ≡⟨⟩ xs ++ [] ≡⟨ ++-identityʳ xs ⟩ xs ∎ -- reverse is injective. reverse-injective : ∀ {xs ys : List A} → reverse xs ≡ reverse ys → xs ≡ ys reverse-injective = subst₂ _≡_ (reverse-involutive _) (reverse-involutive _) ∘ cong reverse -- reverse preserves length. length-reverse : ∀ (xs : List A) → length (reverse xs) ≡ length xs length-reverse xs = begin length (reverse xs) ≡⟨⟩ length (xs ʳ++ []) ≡⟨ length-ʳ++ xs ⟩ length xs + 0 ≡⟨ +-identityʳ _ ⟩ length xs ∎ reverse-map-commute : (f : A → B) → map f ∘ reverse ≗ reverse ∘ map f reverse-map-commute f xs = begin map f (reverse xs) ≡⟨⟩ map f (xs ʳ++ []) ≡⟨ map-ʳ++ f xs ⟩ map f xs ʳ++ [] ≡⟨⟩ reverse (map f xs) ∎ reverse-foldr : ∀ (f : A → B → B) b → foldr f b ∘ reverse ≗ foldl (flip f) b reverse-foldr f b xs = foldr-ʳ++ f b xs reverse-foldl : ∀ (f : B → A → B) b xs → foldl f b (reverse xs) ≡ foldr (flip f) b xs reverse-foldl f b xs = foldl-ʳ++ f b xs ------------------------------------------------------------------------ -- _∷ʳ_ module _ {x y : A} where ∷ʳ-injective : ∀ xs ys → xs ∷ʳ x ≡ ys ∷ʳ y → xs ≡ ys × x ≡ y ∷ʳ-injective [] [] refl = (refl , refl) ∷ʳ-injective (x ∷ xs) (y ∷ ys) eq with ∷-injective eq ... | refl , eq′ = Prod.map (cong (x ∷_)) id (∷ʳ-injective xs ys eq′) ∷ʳ-injective [] (_ ∷ _ ∷ _) () ∷ʳ-injective (_ ∷ _ ∷ _) [] () ∷ʳ-injectiveˡ : ∀ (xs ys : List A) → xs ∷ʳ x ≡ ys ∷ʳ y → xs ≡ ys ∷ʳ-injectiveˡ xs ys eq = proj₁ (∷ʳ-injective xs ys eq) ∷ʳ-injectiveʳ : ∀ (xs ys : List A) → xs ∷ʳ x ≡ ys ∷ʳ y → x ≡ y ∷ʳ-injectiveʳ xs ys eq = proj₂ (∷ʳ-injective xs ys eq) ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 gfilter-just = mapMaybe-just {-# WARNING_ON_USAGE gfilter-just "Warning: gfilter-just was deprecated in v0.15. Please use mapMaybe-just instead." #-} gfilter-nothing = mapMaybe-nothing {-# WARNING_ON_USAGE gfilter-nothing "Warning: gfilter-nothing was deprecated in v0.15. Please use mapMaybe-nothing instead." #-} gfilter-concatMap = mapMaybe-concatMap {-# WARNING_ON_USAGE gfilter-concatMap "Warning: gfilter-concatMap was deprecated in v0.15. Please use mapMaybe-concatMap instead." #-} length-gfilter = length-mapMaybe {-# WARNING_ON_USAGE length-gfilter "Warning: length-gfilter was deprecated in v0.15. Please use length-mapMaybe instead." #-} right-identity-unique = ++-identityʳ-unique {-# WARNING_ON_USAGE right-identity-unique "Warning: right-identity-unique was deprecated in v0.15. Please use ++-identityʳ-unique instead." #-} left-identity-unique = ++-identityˡ-unique {-# WARNING_ON_USAGE left-identity-unique "Warning: left-identity-unique was deprecated in v0.15. Please use ++-identityˡ-unique instead." #-} -- Version 0.16 module _ (p : A → Bool) where boolTakeWhile++boolDropWhile : ∀ xs → boolTakeWhile p xs ++ boolDropWhile p xs ≡ xs boolTakeWhile++boolDropWhile [] = refl boolTakeWhile++boolDropWhile (x ∷ xs) with p x ... | true = cong (x ∷_) (boolTakeWhile++boolDropWhile xs) ... | false = refl {-# WARNING_ON_USAGE boolTakeWhile++boolDropWhile "Warning: boolTakeWhile and boolDropWhile were deprecated in v0.16. Please use takeWhile and dropWhile instead." #-} boolSpan-defn : boolSpan p ≗ < boolTakeWhile p , boolDropWhile p > boolSpan-defn [] = refl boolSpan-defn (x ∷ xs) with p x ... | true = cong (Prod.map (x ∷_) id) (boolSpan-defn xs) ... | false = refl {-# WARNING_ON_USAGE boolSpan-defn "Warning: boolSpan, boolTakeWhile and boolDropWhile were deprecated in v0.16. Please use span, takeWhile and dropWhile instead." #-} length-boolFilter : ∀ xs → length (boolFilter p xs) ≤ length xs length-boolFilter xs = length-mapMaybe (λ x → if p x then just x else nothing) xs {-# WARNING_ON_USAGE length-boolFilter "Warning: boolFilter was deprecated in v0.16. Please use filter instead." #-} boolPartition-defn : boolPartition p ≗ < boolFilter p , boolFilter (not ∘ p) > boolPartition-defn [] = refl boolPartition-defn (x ∷ xs) with p x ... | true = cong (Prod.map (x ∷_) id) (boolPartition-defn xs) ... | false = cong (Prod.map id (x ∷_)) (boolPartition-defn xs) {-# WARNING_ON_USAGE boolPartition-defn "Warning: boolPartition and boolFilter were deprecated in v0.16. Please use partition and filter instead." #-} module _ (P : A → Set p) (P? : Decidable P) where boolFilter-filters : ∀ xs → All P (boolFilter (isYes ∘ P?) xs) boolFilter-filters [] = [] boolFilter-filters (x ∷ xs) with P? x ... | true because [px] = invert [px] ∷ boolFilter-filters xs ... | false because _ = boolFilter-filters xs {-# WARNING_ON_USAGE boolFilter-filters "Warning: boolFilter was deprecated in v0.16. Please use filter instead." #-} -- Version 0.17 idIsFold = id-is-foldr {-# WARNING_ON_USAGE idIsFold "Warning: idIsFold was deprecated in v0.17. Please use id-is-foldr instead." #-} ++IsFold = ++-is-foldr {-# WARNING_ON_USAGE ++IsFold "Warning: ++IsFold was deprecated in v0.17. Please use ++-is-foldr instead." #-} mapIsFold = map-is-foldr {-# WARNING_ON_USAGE mapIsFold "Warning: mapIsFold was deprecated in v0.17. Please use map-is-foldr instead." #-} agda-stdlib-1.7.3/src/Data/List/Relation/000077500000000000000000000000001451211343400200235ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/BagAndSetEquality.agda000066400000000000000000000011071451211343400241460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.List.Relation.Binary.BagAndSetEquality directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.BagAndSetEquality where open import Data.List.Relation.Binary.BagAndSetEquality public {-# WARNING_ON_IMPORT "Data.List.Relation.BagAndSetEquality was deprecated in v1.0. Use Data.List.Relation.Binary.BagAndSetEquality instead." #-} agda-stdlib-1.7.3/src/Data/List/Relation/Binary/000077500000000000000000000000001451211343400212475ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/BagAndSetEquality.agda000066400000000000000000000633511451211343400254030ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bag and set equality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.BagAndSetEquality where open import Algebra using (Idempotent; CommutativeMonoid) open import Algebra.Structures.Biased using (isCommutativeMonoidˡ) open import Category.Monad using (RawMonad) open import Data.Empty open import Data.Fin.Base open import Data.List.Base open import Data.List.Categorical using (monad; module MonadProperties) import Data.List.Properties as LP open import Data.List.Relation.Unary.Any using (Any; here; there) open import Data.List.Relation.Unary.Any.Properties hiding (++-comm) open import Data.List.Membership.Propositional using (_∈_) open import Data.List.Relation.Binary.Subset.Propositional.Properties using (⊆-preorder) open import Data.List.Relation.Binary.Permutation.Propositional open import Data.List.Relation.Binary.Permutation.Propositional.Properties open import Data.Product as Prod hiding (map) import Data.Product.Function.Dependent.Propositional as Σ open import Data.Sum.Base as Sum hiding (map) open import Data.Sum.Properties hiding (map-cong) open import Data.Sum.Function.Propositional using (_⊎-cong_) open import Data.Unit.Polymorphic.Base open import Function.Base open import Function.Equality using (_⟨$⟩_) import Function.Equivalence as FE open import Function.Inverse as Inv using (_↔_; Inverse; inverse) open import Function.Related as Related using (↔⇒; ⌊_⌋; ⌊_⌋→; ⇒→; K-refl; SK-sym) open import Function.Related.TypeIsomorphisms open import Relation.Binary import Relation.Binary.Reasoning.Setoid as EqR import Relation.Binary.Reasoning.Preorder as PreorderReasoning open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; _≗_; refl) open import Relation.Nullary open import Data.List.Membership.Propositional.Properties ------------------------------------------------------------------------ -- Definitions open Related public using (Kind; Symmetric-kind) renaming ( implication to subset ; reverse-implication to superset ; equivalence to set ; injection to subbag ; reverse-injection to superbag ; bijection to bag ) [_]-Order : Kind → ∀ {a} → Set a → Preorder _ _ _ [ k ]-Order A = Related.InducedPreorder₂ k {A = A} _∈_ [_]-Equality : Symmetric-kind → ∀ {a} → Set a → Setoid _ _ [ k ]-Equality A = Related.InducedEquivalence₂ k {A = A} _∈_ infix 4 _∼[_]_ _∼[_]_ : ∀ {a} {A : Set a} → List A → Kind → List A → Set _ _∼[_]_ {A = A} xs k ys = Preorder._∼_ ([ k ]-Order A) xs ys private module Eq {k a} {A : Set a} = Setoid ([ k ]-Equality A) module Ord {k a} {A : Set a} = Preorder ([ k ]-Order A) open module ListMonad {ℓ} = RawMonad (monad {ℓ = ℓ}) module MP = MonadProperties ------------------------------------------------------------------------ -- Bag equality implies the other relations. bag-=⇒ : ∀ {k a} {A : Set a} {xs ys : List A} → xs ∼[ bag ] ys → xs ∼[ k ] ys bag-=⇒ xs≈ys = ↔⇒ xs≈ys ------------------------------------------------------------------------ -- "Equational" reasoning for _⊆_ along with an additional relatedness module ⊆-Reasoning where private module PreOrder {a} {A : Set a} = PreorderReasoning (⊆-preorder A) open PreOrder public hiding (step-≈; step-≈˘; step-∼) infixr 2 step-∼ step-⊆ infix 1 step-∈ step-⊆ = PreOrder.step-∼ step-∈ : ∀ {a} {A : Set a} x {xs ys : List A} → xs IsRelatedTo ys → x ∈ xs → x ∈ ys step-∈ x xs⊆ys x∈xs = (begin xs⊆ys) x∈xs step-∼ : ∀ {k a} {A : Set a} xs {ys zs : List A} → ys IsRelatedTo zs → xs ∼[ ⌊ k ⌋→ ] ys → xs IsRelatedTo zs step-∼ xs ys⊆zs xs≈ys = step-⊆ xs ys⊆zs (⇒→ xs≈ys) syntax step-∈ x xs⊆ys x∈xs = x ∈⟨ x∈xs ⟩ xs⊆ys syntax step-∼ xs ys⊆zs xs≈ys = xs ∼⟨ xs≈ys ⟩ ys⊆zs syntax step-⊆ xs ys⊆zs xs⊆ys = xs ⊆⟨ xs⊆ys ⟩ ys⊆zs ------------------------------------------------------------------------ -- Congruence lemmas ------------------------------------------------------------------------ -- _∷_ module _ {a k} {A : Set a} {x y : A} {xs ys} where ∷-cong : x ≡ y → xs ∼[ k ] ys → x ∷ xs ∼[ k ] y ∷ ys ∷-cong refl xs≈ys {y} = y ∈ x ∷ xs ↔⟨ SK-sym $ ∷↔ (y ≡_) ⟩ (y ≡ x ⊎ y ∈ xs) ∼⟨ (y ≡ x ∎) ⊎-cong xs≈ys ⟩ (y ≡ x ⊎ y ∈ ys) ↔⟨ ∷↔ (y ≡_) ⟩ y ∈ x ∷ ys ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- map module _ {ℓ k} {A B : Set ℓ} {f g : A → B} {xs ys} where map-cong : f ≗ g → xs ∼[ k ] ys → map f xs ∼[ k ] map g ys map-cong f≗g xs≈ys {x} = x ∈ map f xs ↔⟨ SK-sym $ map↔ ⟩ Any (λ y → x ≡ f y) xs ∼⟨ Any-cong (↔⇒ ∘ helper) xs≈ys ⟩ Any (λ y → x ≡ g y) ys ↔⟨ map↔ ⟩ x ∈ map g ys ∎ where open Related.EquationalReasoning helper : ∀ y → x ≡ f y ↔ x ≡ g y helper y = record { to = P.→-to-⟶ (λ x≡fy → P.trans x≡fy ( f≗g y)) ; from = P.→-to-⟶ (λ x≡gy → P.trans x≡gy (P.sym $ f≗g y)) ; inverse-of = record { left-inverse-of = λ { P.refl → P.trans-symʳ (f≗g y) } ; right-inverse-of = λ { P.refl → P.trans-symˡ (f≗g y) } } } ------------------------------------------------------------------------ -- _++_ module _ {a k} {A : Set a} {xs₁ xs₂ ys₁ ys₂ : List A} where ++-cong : xs₁ ∼[ k ] xs₂ → ys₁ ∼[ k ] ys₂ → xs₁ ++ ys₁ ∼[ k ] xs₂ ++ ys₂ ++-cong xs₁≈xs₂ ys₁≈ys₂ {x} = x ∈ xs₁ ++ ys₁ ↔⟨ SK-sym $ ++↔ ⟩ (x ∈ xs₁ ⊎ x ∈ ys₁) ∼⟨ xs₁≈xs₂ ⊎-cong ys₁≈ys₂ ⟩ (x ∈ xs₂ ⊎ x ∈ ys₂) ↔⟨ ++↔ ⟩ x ∈ xs₂ ++ ys₂ ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- concat module _ {a k} {A : Set a} {xss yss : List (List A)} where concat-cong : xss ∼[ k ] yss → concat xss ∼[ k ] concat yss concat-cong xss≈yss {x} = x ∈ concat xss ↔⟨ SK-sym concat↔ ⟩ Any (Any (x ≡_)) xss ∼⟨ Any-cong (λ _ → _ ∎) xss≈yss ⟩ Any (Any (x ≡_)) yss ↔⟨ concat↔ ⟩ x ∈ concat yss ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _>>=_ module _ {ℓ k} {A B : Set ℓ} {xs ys} {f g : A → List B} where >>=-cong : xs ∼[ k ] ys → (∀ x → f x ∼[ k ] g x) → (xs >>= f) ∼[ k ] (ys >>= g) >>=-cong xs≈ys f≈g {x} = x ∈ (xs >>= f) ↔⟨ SK-sym >>=↔ ⟩ Any (λ y → x ∈ f y) xs ∼⟨ Any-cong (λ x → f≈g x) xs≈ys ⟩ Any (λ y → x ∈ g y) ys ↔⟨ >>=↔ ⟩ x ∈ (ys >>= g) ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _⊛_ module _ {ℓ k} {A B : Set ℓ} {fs gs : List (A → B)} {xs ys} where ⊛-cong : fs ∼[ k ] gs → xs ∼[ k ] ys → (fs ⊛ xs) ∼[ k ] (gs ⊛ ys) ⊛-cong fs≈gs xs≈ys = >>=-cong fs≈gs λ f → >>=-cong xs≈ys λ x → _ ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _⊗_ module _ {ℓ k} {A B : Set ℓ} {xs₁ xs₂ : List A} {ys₁ ys₂ : List B} where ⊗-cong : xs₁ ∼[ k ] xs₂ → ys₁ ∼[ k ] ys₂ → (xs₁ ⊗ ys₁) ∼[ k ] (xs₂ ⊗ ys₂) ⊗-cong xs₁≈xs₂ ys₁≈ys₂ = ⊛-cong (⊛-cong (Ord.refl {x = [ _,_ ]}) xs₁≈xs₂) ys₁≈ys₂ ------------------------------------------------------------------------ -- Other properties -- _++_ and [] form a commutative monoid, with either bag or set -- equality as the underlying equality. commutativeMonoid : ∀ {a} → Symmetric-kind → Set a → CommutativeMonoid _ _ commutativeMonoid {a} k A = record { Carrier = List A ; _≈_ = _∼[ ⌊ k ⌋ ]_ ; _∙_ = _++_ ; ε = [] ; isCommutativeMonoid = isCommutativeMonoidˡ record { isSemigroup = record { isMagma = record { isEquivalence = Eq.isEquivalence ; ∙-cong = ++-cong } ; assoc = λ xs ys zs → Eq.reflexive (LP.++-assoc xs ys zs) } ; identityˡ = λ xs {x} → x ∈ xs ∎ ; comm = λ xs ys {x} → x ∈ xs ++ ys ↔⟨ ++↔++ xs ys ⟩ x ∈ ys ++ xs ∎ } } where open Related.EquationalReasoning -- The only list which is bag or set equal to the empty list (or a -- subset or subbag of the list) is the empty list itself. empty-unique : ∀ {k a} {A : Set a} {xs : List A} → xs ∼[ ⌊ k ⌋→ ] [] → xs ≡ [] empty-unique {xs = []} _ = refl empty-unique {xs = _ ∷ _} ∷∼[] with ⇒→ ∷∼[] (here refl) ... | () -- _++_ is idempotent (under set equality). ++-idempotent : ∀ {a} {A : Set a} → Idempotent {A = List A} _∼[ set ]_ _++_ ++-idempotent {a} xs {x} = x ∈ xs ++ xs ∼⟨ FE.equivalence ([ id , id ]′ ∘ _⟨$⟩_ (Inverse.from $ ++↔)) (_⟨$⟩_ (Inverse.to $ ++↔) ∘ inj₁) ⟩ x ∈ xs ∎ where open Related.EquationalReasoning -- The list monad's bind distributes from the left over _++_. >>=-left-distributive : ∀ {ℓ} {A B : Set ℓ} (xs : List A) {f g : A → List B} → (xs >>= λ x → f x ++ g x) ∼[ bag ] (xs >>= f) ++ (xs >>= g) >>=-left-distributive {ℓ} xs {f} {g} {y} = y ∈ (xs >>= λ x → f x ++ g x) ↔⟨ SK-sym $ >>=↔ ⟩ Any (λ x → y ∈ f x ++ g x) xs ↔⟨ SK-sym (Any-cong (λ _ → ++↔) (_ ∎)) ⟩ Any (λ x → y ∈ f x ⊎ y ∈ g x) xs ↔⟨ SK-sym $ ⊎↔ ⟩ (Any (λ x → y ∈ f x) xs ⊎ Any (λ x → y ∈ g x) xs) ↔⟨ >>=↔ ⟨ _⊎-cong_ ⟩ >>=↔ ⟩ (y ∈ (xs >>= f) ⊎ y ∈ (xs >>= g)) ↔⟨ ++↔ ⟩ y ∈ (xs >>= f) ++ (xs >>= g) ∎ where open Related.EquationalReasoning -- The same applies to _⊛_. ⊛-left-distributive : ∀ {ℓ} {A B : Set ℓ} (fs : List (A → B)) xs₁ xs₂ → (fs ⊛ (xs₁ ++ xs₂)) ∼[ bag ] (fs ⊛ xs₁) ++ (fs ⊛ xs₂) ⊛-left-distributive {B = B} fs xs₁ xs₂ = begin fs ⊛ (xs₁ ++ xs₂) ≡⟨⟩ (fs >>= λ f → xs₁ ++ xs₂ >>= return ∘ f) ≡⟨ (MP.cong (refl {x = fs}) λ f → MP.right-distributive xs₁ xs₂ (return ∘ f)) ⟩ (fs >>= λ f → (xs₁ >>= return ∘ f) ++ (xs₂ >>= return ∘ f)) ≈⟨ >>=-left-distributive fs ⟩ (fs >>= λ f → xs₁ >>= return ∘ f) ++ (fs >>= λ f → xs₂ >>= return ∘ f) ≡⟨⟩ (fs ⊛ xs₁) ++ (fs ⊛ xs₂) ∎ where open EqR ([ bag ]-Equality B) private -- If x ∷ xs is set equal to x ∷ ys, then xs and ys are not -- necessarily set equal. ¬-drop-cons : ∀ {a} {A : Set a} {x : A} → ¬ (∀ {xs ys} → x ∷ xs ∼[ set ] x ∷ ys → xs ∼[ set ] ys) ¬-drop-cons {x = x} drop-cons with FE.Equivalence.to x∼[] ⟨$⟩ here refl where x,x≈x : (x ∷ x ∷ []) ∼[ set ] [ x ] x,x≈x = ++-idempotent [ x ] x∼[] : [ x ] ∼[ set ] [] x∼[] = drop-cons x,x≈x ... | () -- However, the corresponding property does hold for bag equality. drop-cons : ∀ {a} {A : Set a} {x : A} {xs ys} → x ∷ xs ∼[ bag ] x ∷ ys → xs ∼[ bag ] ys drop-cons {A = A} {x} {xs} {ys} x∷xs≈x∷ys = ⊎-left-cancellative (∼→⊎↔⊎ x∷xs≈x∷ys) (lemma x∷xs≈x∷ys) (lemma (SK-sym x∷xs≈x∷ys)) where -- TODO: Some of the code below could perhaps be exposed to users. -- List membership can be expressed as "there is an index which -- points to the element". ∈-index : ∀ {a} {A : Set a} {z} (xs : List A) → z ∈ xs ↔ ∃ λ i → z ≡ lookup xs i ∈-index {z = z} [] = z ∈ [] ↔⟨ SK-sym ⊥↔Any[] ⟩ ⊥ ↔⟨ SK-sym $ inverse (λ { (() , _) }) (λ ()) (λ { (() , _) }) (λ ()) ⟩ (∃ λ (i : Fin 0) → z ≡ lookup [] i) ∎ where open Related.EquationalReasoning ∈-index {z = z} (x ∷ xs) = z ∈ x ∷ xs ↔⟨ SK-sym (∷↔ _) ⟩ (z ≡ x ⊎ z ∈ xs) ↔⟨ K-refl ⊎-cong ∈-index xs ⟩ (z ≡ x ⊎ ∃ λ i → z ≡ lookup xs i) ↔⟨ SK-sym $ inverse (λ { (zero , p) → inj₁ p; (suc i , p) → inj₂ (i , p) }) (λ { (inj₁ p) → zero , p; (inj₂ (i , p)) → suc i , p }) (λ { (zero , _) → refl; (suc _ , _) → refl }) (λ { (inj₁ _) → refl; (inj₂ _) → refl }) ⟩ (∃ λ i → z ≡ lookup (x ∷ xs) i) ∎ where open Related.EquationalReasoning -- The index which points to the element. index-of : ∀ {a} {A : Set a} {z} {xs : List A} → z ∈ xs → Fin (length xs) index-of = proj₁ ∘ (Inverse.to (∈-index _) ⟨$⟩_) -- The type ∃ λ z → z ∈ xs is isomorphic to Fin n, where n is the -- length of xs. -- -- Thierry Coquand pointed out that (a variant of) this statement is -- a generalisation of the fact that singletons are contractible. Fin-length : ∀ {a} {A : Set a} (xs : List A) → (∃ λ z → z ∈ xs) ↔ Fin (length xs) Fin-length xs = (∃ λ z → z ∈ xs) ↔⟨ Σ.cong K-refl (∈-index xs) ⟩ (∃ λ z → ∃ λ i → z ≡ lookup xs i) ↔⟨ ∃∃↔∃∃ _ ⟩ (∃ λ i → ∃ λ z → z ≡ lookup xs i) ↔⟨ Σ.cong K-refl (inverse _ (λ _ → _ , refl) (λ { (_ , refl) → refl }) (λ _ → refl)) ⟩ (Fin (length xs) × ⊤) ↔⟨ ×-identityʳ _ _ ⟩ Fin (length xs) ∎ where open Related.EquationalReasoning -- From this lemma we get that lists which are bag equivalent have -- related lengths. Fin-length-cong : ∀ {a} {A : Set a} {xs ys : List A} → xs ∼[ bag ] ys → Fin (length xs) ↔ Fin (length ys) Fin-length-cong {xs = xs} {ys} xs≈ys = Fin (length xs) ↔⟨ SK-sym $ Fin-length xs ⟩ ∃ (λ z → z ∈ xs) ↔⟨ Σ.cong K-refl xs≈ys ⟩ ∃ (λ z → z ∈ ys) ↔⟨ Fin-length ys ⟩ Fin (length ys) ∎ where open Related.EquationalReasoning -- The index-of function commutes with applications of certain -- inverses. index-of-commutes : ∀ {a} {A : Set a} {z : A} {xs ys} → (xs≈ys : xs ∼[ bag ] ys) (p : z ∈ xs) → index-of (Inverse.to xs≈ys ⟨$⟩ p) ≡ Inverse.to (Fin-length-cong xs≈ys) ⟨$⟩ index-of p index-of-commutes {z = z} {xs} {ys} xs≈ys p = index-of (to xs≈ys ⟨$⟩ p) ≡⟨ lemma z p ⟩ index-of (to xs≈ys ⟨$⟩ proj₂ (from (Fin-length xs) ⟨$⟩ (to (Fin-length xs) ⟨$⟩ (z , p)))) ≡⟨⟩ index-of (proj₂ (Prod.map id (to xs≈ys ⟨$⟩_) (from (Fin-length xs) ⟨$⟩ (to (Fin-length xs) ⟨$⟩ (z , p))))) ≡⟨⟩ to (Fin-length ys) ⟨$⟩ Prod.map id (to xs≈ys ⟨$⟩_) (from (Fin-length xs) ⟨$⟩ index-of p) ≡⟨⟩ to (Fin-length-cong xs≈ys) ⟨$⟩ index-of p ∎ where open P.≡-Reasoning open Inverse lemma : ∀ z p → index-of (to xs≈ys ⟨$⟩ p) ≡ index-of (to xs≈ys ⟨$⟩ proj₂ (from (Fin-length xs) ⟨$⟩ (to (Fin-length xs) ⟨$⟩ (z , p)))) lemma z p with to (Fin-length xs) ⟨$⟩ (z , p) | left-inverse-of (Fin-length xs) (z , p) lemma .(lookup xs i) .(from (∈-index xs) ⟨$⟩ (i , refl)) | i | refl = refl -- Bag equivalence isomorphisms preserve index equality. Note that -- this means that, even if the underlying equality is proof -- relevant, a bag equivalence isomorphism cannot map two distinct -- proofs, that point to the same position, to different positions. index-equality-preserved : ∀ {a} {A : Set a} {z : A} {xs ys} {p q : z ∈ xs} (xs≈ys : xs ∼[ bag ] ys) → index-of p ≡ index-of q → index-of (Inverse.to xs≈ys ⟨$⟩ p) ≡ index-of (Inverse.to xs≈ys ⟨$⟩ q) index-equality-preserved {p = p} {q} xs≈ys eq = index-of (Inverse.to xs≈ys ⟨$⟩ p) ≡⟨ index-of-commutes xs≈ys p ⟩ Inverse.to (Fin-length-cong xs≈ys) ⟨$⟩ index-of p ≡⟨ P.cong (Inverse.to (Fin-length-cong xs≈ys) ⟨$⟩_) eq ⟩ Inverse.to (Fin-length-cong xs≈ys) ⟨$⟩ index-of q ≡⟨ P.sym $ index-of-commutes xs≈ys q ⟩ index-of (Inverse.to xs≈ys ⟨$⟩ q) ∎ where open P.≡-Reasoning -- The old inspect idiom. inspect : ∀ {a} {A : Set a} (x : A) → ∃ (x ≡_) inspect x = x , refl -- A function is "well-behaved" if any "left" element which is the -- image of a "right" element is in turn not mapped to another -- "left" element. Well-behaved : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} → (A ⊎ B → A ⊎ C) → Set _ Well-behaved f = ∀ {b a a′} → f (inj₂ b) ≡ inj₁ a → f (inj₁ a) ≢ inj₁ a′ -- The type constructor _⊎_ is left cancellative for certain -- well-behaved inverses. ⊎-left-cancellative : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} (f : (A ⊎ B) ↔ (A ⊎ C)) → Well-behaved (Inverse.to f ⟨$⟩_) → Well-behaved (Inverse.from f ⟨$⟩_) → B ↔ C ⊎-left-cancellative {A = A} = λ inv to-hyp from-hyp → inverse (g (to inv ⟨$⟩_) to-hyp) (g (from inv ⟨$⟩_) from-hyp) (g∘g inv to-hyp from-hyp) (g∘g (SK-sym inv) from-hyp to-hyp) where open Inverse module _ {a b c} {A : Set a} {B : Set b} {C : Set c} (f : A ⊎ B → A ⊎ C) (hyp : Well-behaved f) where mutual g : B → C g b = g′ (inspect (f (inj₂ b))) g′ : ∀ {b} → ∃ (f (inj₂ b) ≡_) → C g′ (inj₂ c , _) = c g′ (inj₁ a , eq) = g″ eq (inspect (f (inj₁ a))) g″ : ∀ {a b} → f (inj₂ b) ≡ inj₁ a → ∃ (f (inj₁ a) ≡_) → C g″ _ (inj₂ c , _) = c g″ eq₁ (inj₁ _ , eq₂) = ⊥-elim $ hyp eq₁ eq₂ g∘g : ∀ {b c} {B : Set b} {C : Set c} (f : (A ⊎ B) ↔ (A ⊎ C)) → (to-hyp : Well-behaved (to f ⟨$⟩_)) → (from-hyp : Well-behaved (from f ⟨$⟩_)) → ∀ b → g (from f ⟨$⟩_) from-hyp (g (to f ⟨$⟩_) to-hyp b) ≡ b g∘g f to-hyp from-hyp b = g∘g′ where open P.≡-Reasoning g∘g′ : g (from f ⟨$⟩_) from-hyp (g (to f ⟨$⟩_) to-hyp b) ≡ b g∘g′ with inspect (to f ⟨$⟩ inj₂ b) g∘g′ | inj₂ c , eq₁ with inspect (from f ⟨$⟩ inj₂ c) g∘g′ | inj₂ c , eq₁ | inj₂ b′ , eq₂ = inj₂-injective ( inj₂ b′ ≡⟨ P.sym eq₂ ⟩ from f ⟨$⟩ inj₂ c ≡⟨ to-from f eq₁ ⟩ inj₂ b ∎) g∘g′ | inj₂ c , eq₁ | inj₁ a , eq₂ with inj₁ a ≡⟨ P.sym eq₂ ⟩ from f ⟨$⟩ inj₂ c ≡⟨ to-from f eq₁ ⟩ inj₂ b ∎ ... | () g∘g′ | inj₁ a , eq₁ with inspect (to f ⟨$⟩ inj₁ a) g∘g′ | inj₁ a , eq₁ | inj₁ a′ , eq₂ = ⊥-elim $ to-hyp eq₁ eq₂ g∘g′ | inj₁ a , eq₁ | inj₂ c , eq₂ with inspect (from f ⟨$⟩ inj₂ c) g∘g′ | inj₁ a , eq₁ | inj₂ c , eq₂ | inj₂ b′ , eq₃ with inj₁ a ≡⟨ P.sym $ to-from f eq₂ ⟩ from f ⟨$⟩ inj₂ c ≡⟨ eq₃ ⟩ inj₂ b′ ∎ ... | () g∘g′ | inj₁ a , eq₁ | inj₂ c , eq₂ | inj₁ a′ , eq₃ with inspect (from f ⟨$⟩ inj₁ a′) g∘g′ | inj₁ a , eq₁ | inj₂ c , eq₂ | inj₁ a′ , eq₃ | inj₁ a″ , eq₄ = ⊥-elim $ from-hyp eq₃ eq₄ g∘g′ | inj₁ a , eq₁ | inj₂ c , eq₂ | inj₁ a′ , eq₃ | inj₂ b′ , eq₄ = inj₂-injective ( let lemma = inj₁ a′ ≡⟨ P.sym eq₃ ⟩ from f ⟨$⟩ inj₂ c ≡⟨ to-from f eq₂ ⟩ inj₁ a ∎ in inj₂ b′ ≡⟨ P.sym eq₄ ⟩ from f ⟨$⟩ inj₁ a′ ≡⟨ P.cong ((from f ⟨$⟩_) ∘ inj₁) $ inj₁-injective lemma ⟩ from f ⟨$⟩ inj₁ a ≡⟨ to-from f eq₁ ⟩ inj₂ b ∎) -- Some final lemmas. ∼→⊎↔⊎ : ∀ {x : A} {xs ys} → x ∷ xs ∼[ bag ] x ∷ ys → ∀ {z} → (z ≡ x ⊎ z ∈ xs) ↔ (z ≡ x ⊎ z ∈ ys) ∼→⊎↔⊎ {x} {xs} {ys} x∷xs≈x∷ys {z} = (z ≡ x ⊎ z ∈ xs) ↔⟨ ∷↔ _ ⟩ z ∈ x ∷ xs ↔⟨ x∷xs≈x∷ys ⟩ z ∈ x ∷ ys ↔⟨ SK-sym (∷↔ _) ⟩ (z ≡ x ⊎ z ∈ ys) ∎ where open Related.EquationalReasoning lemma : ∀ {xs ys} (inv : x ∷ xs ∼[ bag ] x ∷ ys) {z} → Well-behaved (Inverse.to (∼→⊎↔⊎ inv {z}) ⟨$⟩_) lemma {xs} inv {b = z∈xs} {a = p} {a′ = q} hyp₁ hyp₂ with zero ≡⟨⟩ index-of {xs = x ∷ xs} (here p) ≡⟨⟩ index-of {xs = x ∷ xs} (to (∷↔ _) ⟨$⟩ inj₁ p) ≡⟨ P.cong (index-of ∘ (to (∷↔ (_ ≡_)) ⟨$⟩_)) $ P.sym $ to-from (∼→⊎↔⊎ inv) {x = inj₁ p} hyp₂ ⟩ index-of {xs = x ∷ xs} (to (∷↔ _) ⟨$⟩ (from (∼→⊎↔⊎ inv) ⟨$⟩ inj₁ q)) ≡⟨ P.cong index-of $ right-inverse-of (∷↔ _) (from inv ⟨$⟩ here q) ⟩ index-of {xs = x ∷ xs} (to (SK-sym inv) ⟨$⟩ here q) ≡⟨ index-equality-preserved (SK-sym inv) refl ⟩ index-of {xs = x ∷ xs} (to (SK-sym inv) ⟨$⟩ here p) ≡⟨ P.cong index-of $ P.sym $ right-inverse-of (∷↔ _) (from inv ⟨$⟩ here p) ⟩ index-of {xs = x ∷ xs} (to (∷↔ _) ⟨$⟩ (from (∼→⊎↔⊎ inv) ⟨$⟩ inj₁ p)) ≡⟨ P.cong (index-of ∘ (to (∷↔ (_ ≡_)) ⟨$⟩_)) $ to-from (∼→⊎↔⊎ inv) {x = inj₂ z∈xs} hyp₁ ⟩ index-of {xs = x ∷ xs} (to (∷↔ _) ⟨$⟩ inj₂ z∈xs) ≡⟨⟩ index-of {xs = x ∷ xs} (there z∈xs) ≡⟨⟩ suc (index-of {xs = xs} z∈xs) ∎ where open Inverse open P.≡-Reasoning ... | () ------------------------------------------------------------------------ -- Relationships to other relations module _ {a} {A : Set a} where ↭⇒∼bag : _↭_ ⇒ _∼[ bag ]_ ↭⇒∼bag xs↭ys {v} = inverse (to xs↭ys) (from xs↭ys) (from∘to xs↭ys) (to∘from xs↭ys) where to : ∀ {xs ys} → xs ↭ ys → v ∈ xs → v ∈ ys to xs↭ys = Any-resp-↭ {A = A} xs↭ys from : ∀ {xs ys} → xs ↭ ys → v ∈ ys → v ∈ xs from xs↭ys = Any-resp-↭ (↭-sym xs↭ys) from∘to : ∀ {xs ys} (p : xs ↭ ys) (q : v ∈ xs) → from p (to p q) ≡ q from∘to refl v∈xs = refl from∘to (prep _ _) (here refl) = refl from∘to (prep _ p) (there v∈xs) = P.cong there (from∘to p v∈xs) from∘to (swap x y p) (here refl) = refl from∘to (swap x y p) (there (here refl)) = refl from∘to (swap x y p) (there (there v∈xs)) = P.cong (there ∘ there) (from∘to p v∈xs) from∘to (trans p₁ p₂) v∈xs rewrite from∘to p₂ (Any-resp-↭ p₁ v∈xs) | from∘to p₁ v∈xs = refl to∘from : ∀ {xs ys} (p : xs ↭ ys) (q : v ∈ ys) → to p (from p q) ≡ q to∘from p with from∘to (↭-sym p) ... | res rewrite ↭-sym-involutive p = res ∼bag⇒↭ : _∼[ bag ]_ ⇒ _↭_ ∼bag⇒↭ {[]} eq with empty-unique {A = A} (Inv.sym eq) ... | refl = refl ∼bag⇒↭ {x ∷ xs} eq with ∈-∃++ (to ⟨$⟩ (here P.refl)) where open Inv.Inverse (eq {x}) ... | zs₁ , zs₂ , p rewrite p = begin x ∷ xs <⟨ ∼bag⇒↭ (drop-cons (Inv._∘_ (comm zs₁ (x ∷ zs₂)) eq)) ⟩ x ∷ (zs₂ ++ zs₁) <⟨ ++-comm zs₂ zs₁ ⟩ x ∷ (zs₁ ++ zs₂) ↭˘⟨ shift x zs₁ zs₂ ⟩ zs₁ ++ x ∷ zs₂ ∎ where open CommutativeMonoid (commutativeMonoid bag A) open PermutationReasoning agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Disjoint/000077500000000000000000000000001451211343400230325ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Disjoint/Propositional.agda000066400000000000000000000013001451211343400265040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pairs of lists that share no common elements (propositional equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Disjoint.Propositional {a} {A : Set a} where open import Relation.Binary.PropositionalEquality using (setoid) open import Data.List.Relation.Binary.Disjoint.Setoid as DisjointUnique ------------------------------------------------------------------------ -- Re-export the contents of setoid uniqueness open DisjointUnique (setoid A) public agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Disjoint/Setoid.agda000066400000000000000000000025171451211343400251040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pairs of lists that share no common elements (setoid equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Disjoint.Setoid {c ℓ} (S : Setoid c ℓ) where open import Level using (_⊔_) open import Relation.Nullary using (¬_) open import Function.Base using (_∘_) open import Data.List.Base using (List; []; [_]; _∷_) open import Data.List.Relation.Unary.Any using (here; there) open import Data.Product using (_×_; _,_) open Setoid S renaming (Carrier to A) open import Data.List.Membership.Setoid S using (_∈_; _∉_) ------------------------------------------------------------------------ -- Definition Disjoint : Rel (List A) (ℓ ⊔ c) Disjoint xs ys = ∀ {v} → ¬ (v ∈ xs × v ∈ ys) ------------------------------------------------------------------------ -- Operations contractₗ : ∀ {x xs ys} → Disjoint (x ∷ xs) ys → Disjoint xs ys contractₗ x∷xs∩ys=∅ (v∈xs , v∈ys) = x∷xs∩ys=∅ (there v∈xs , v∈ys) contractᵣ : ∀ {xs y ys} → Disjoint xs (y ∷ ys) → Disjoint xs ys contractᵣ xs#y∷ys (v∈xs , v∈ys) = xs#y∷ys (v∈xs , there v∈ys) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Disjoint/Setoid/000077500000000000000000000000001451211343400242615ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Disjoint/Setoid/Properties.agda000066400000000000000000000042411451211343400272340ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of disjoint lists (setoid equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Disjoint.Setoid.Properties where open import Data.List.Base open import Data.List.Relation.Binary.Disjoint.Setoid import Data.List.Relation.Unary.Any as Any open import Data.List.Relation.Unary.All as All open import Data.List.Relation.Unary.All.Properties using (¬Any⇒All¬) open import Data.List.Relation.Unary.Any.Properties using (++⁻) open import Data.Product using (_,_) open import Data.Sum.Base using (inj₁; inj₂) open import Relation.Binary open import Relation.Nullary using (¬_) ------------------------------------------------------------------------ -- Relational properties ------------------------------------------------------------------------ module _ {c ℓ} (S : Setoid c ℓ) where sym : Symmetric (Disjoint S) sym xs#ys (v∈ys , v∈xs) = xs#ys (v∈xs , v∈ys) ------------------------------------------------------------------------ -- Relationship with other predicates ------------------------------------------------------------------------ module _ {c ℓ} (S : Setoid c ℓ) where open Setoid S Disjoint⇒AllAll : ∀ {xs ys} → Disjoint S xs ys → All (λ x → All (λ y → ¬ x ≈ y) ys) xs Disjoint⇒AllAll xs#ys = All.map (¬Any⇒All¬ _) (All.tabulate (λ v∈xs v∈ys → xs#ys (Any.map reflexive v∈xs , v∈ys))) ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- concat module _ {c ℓ} (S : Setoid c ℓ) where concat⁺ʳ : ∀ {vs xss} → All (Disjoint S vs) xss → Disjoint S vs (concat xss) concat⁺ʳ {xss = xs ∷ xss} (vs#xs ∷ vs#xss) (v∈vs , v∈xs++concatxss) with ++⁻ xs v∈xs++concatxss ... | inj₁ v∈xs = vs#xs (v∈vs , v∈xs) ... | inj₂ v∈xss = concat⁺ʳ vs#xss (v∈vs , v∈xss) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Equality/000077500000000000000000000000001451211343400230445ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Equality/DecPropositional.agda000066400000000000000000000024321451211343400271410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Decidable pointwise equality over lists using propositional equality ------------------------------------------------------------------------ -- Note think carefully about using this module as pointwise -- propositional equality can usually be replaced with propositional -- equality. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary open import Relation.Binary.PropositionalEquality module Data.List.Relation.Binary.Equality.DecPropositional {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) where open import Data.List.Base using (List) open import Data.List.Properties using (≡-dec) import Data.List.Relation.Binary.Equality.Propositional as PropositionalEq import Data.List.Relation.Binary.Equality.DecSetoid as DecSetoidEq ------------------------------------------------------------------------ -- Publically re-export everything from decSetoid and propositional -- equality open PropositionalEq public open DecSetoidEq (decSetoid _≟_) public using (_≋?_; ≋-isDecEquivalence; ≋-decSetoid) ------------------------------------------------------------------------ -- Additional proofs _≡?_ : Decidable (_≡_ {A = List A}) _≡?_ = ≡-dec _≟_ agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Equality/DecSetoid.agda000066400000000000000000000021451451211343400255270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise decidable equality over lists parameterised by a setoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Equality.DecSetoid {a ℓ} (DS : DecSetoid a ℓ) where import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality import Data.List.Relation.Binary.Pointwise as PW open import Level open import Relation.Binary using (Decidable) open DecSetoid DS ------------------------------------------------------------------------ -- Make all definitions from setoid equality available open SetoidEquality setoid public ------------------------------------------------------------------------ -- Additional properties infix 4 _≋?_ _≋?_ : Decidable _≋_ _≋?_ = PW.decidable _≟_ ≋-isDecEquivalence : IsDecEquivalence _≋_ ≋-isDecEquivalence = PW.isDecEquivalence isDecEquivalence ≋-decSetoid : DecSetoid a (a ⊔ ℓ) ≋-decSetoid = PW.decSetoid DS agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Equality/Propositional.agda000066400000000000000000000021761451211343400265320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise equality over lists using propositional equality ------------------------------------------------------------------------ -- Note think carefully about using this module as pointwise -- propositional equality can usually be replaced with propositional -- equality. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Equality.Propositional {a} {A : Set a} where open import Data.List.Base import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Re-export everything from setoid equality open SetoidEquality (P.setoid A) public ------------------------------------------------------------------------ -- ≋ is propositional ≋⇒≡ : _≋_ ⇒ _≡_ ≋⇒≡ [] = P.refl ≋⇒≡ (P.refl ∷ xs≈ys) = P.cong (_ ∷_) (≋⇒≡ xs≈ys) ≡⇒≋ : _≡_ ⇒ _≋_ ≡⇒≋ P.refl = ≋-refl agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Equality/Setoid.agda000066400000000000000000000116611451211343400251160ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise equality over lists parameterised by a setoid ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra.Core using (Op₂) open import Relation.Binary using (Setoid) module Data.List.Relation.Binary.Equality.Setoid {a ℓ} (S : Setoid a ℓ) where open import Data.Fin.Base open import Data.List.Base open import Data.List.Relation.Binary.Pointwise as PW using (Pointwise) open import Data.List.Relation.Unary.Unique.Setoid S using (Unique) open import Function.Base using (_∘_) open import Level open import Relation.Binary renaming (Rel to Rel₂) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Binary.Properties.Setoid S using (≉-resp₂) open import Relation.Unary as U using (Pred) open Setoid S renaming (Carrier to A) private variable p q : Level ------------------------------------------------------------------------ -- Definition of equality ------------------------------------------------------------------------ infix 4 _≋_ _≋_ : Rel₂ (List A) (a ⊔ ℓ) _≋_ = Pointwise _≈_ open PW public using ([]; _∷_) ------------------------------------------------------------------------ -- Relational properties ------------------------------------------------------------------------ ≋-refl : Reflexive _≋_ ≋-refl = PW.refl refl ≋-reflexive : _≡_ ⇒ _≋_ ≋-reflexive P.refl = ≋-refl ≋-sym : Symmetric _≋_ ≋-sym = PW.symmetric sym ≋-trans : Transitive _≋_ ≋-trans = PW.transitive trans ≋-isEquivalence : IsEquivalence _≋_ ≋-isEquivalence = PW.isEquivalence isEquivalence ≋-setoid : Setoid _ _ ≋-setoid = PW.setoid S ------------------------------------------------------------------------ -- Relationships to predicates ------------------------------------------------------------------------ open PW public using () renaming ( Any-resp-Pointwise to Any-resp-≋ ; All-resp-Pointwise to All-resp-≋ ; AllPairs-resp-Pointwise to AllPairs-resp-≋ ) Unique-resp-≋ : Unique Respects _≋_ Unique-resp-≋ = AllPairs-resp-≋ ≉-resp₂ ------------------------------------------------------------------------ -- List operations ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- length ≋-length : ∀ {xs ys} → xs ≋ ys → length xs ≡ length ys ≋-length = PW.Pointwise-length ------------------------------------------------------------------------ -- map module _ {b ℓ₂} (T : Setoid b ℓ₂) where open Setoid T using () renaming (_≈_ to _≈′_) private _≋′_ = Pointwise _≈′_ map⁺ : ∀ {f} → f Preserves _≈_ ⟶ _≈′_ → ∀ {xs ys} → xs ≋ ys → map f xs ≋′ map f ys map⁺ {f} pres xs≋ys = PW.map⁺ f f (PW.map pres xs≋ys) ------------------------------------------------------------------------ -- foldr foldr⁺ : ∀ {_•_ : Op₂ A} {_◦_ : Op₂ A} → (∀ {w x y z} → w ≈ x → y ≈ z → (w • y) ≈ (x ◦ z)) → ∀ {xs ys e f} → e ≈ f → xs ≋ ys → foldr _•_ e xs ≈ foldr _◦_ f ys foldr⁺ ∙⇔◦ e≈f xs≋ys = PW.foldr⁺ ∙⇔◦ e≈f xs≋ys ------------------------------------------------------------------------ -- _++_ ++⁺ : ∀ {ws xs ys zs} → ws ≋ xs → ys ≋ zs → ws ++ ys ≋ xs ++ zs ++⁺ = PW.++⁺ ++-cancelˡ : ∀ xs {ys zs} → xs ++ ys ≋ xs ++ zs → ys ≋ zs ++-cancelˡ xs = PW.++-cancelˡ xs ++-cancelʳ : ∀ {xs} ys zs → ys ++ xs ≋ zs ++ xs → ys ≋ zs ++-cancelʳ = PW.++-cancelʳ ------------------------------------------------------------------------ -- concat concat⁺ : ∀ {xss yss} → Pointwise _≋_ xss yss → concat xss ≋ concat yss concat⁺ = PW.concat⁺ ------------------------------------------------------------------------ -- tabulate tabulate⁺ : ∀ {n} {f : Fin n → A} {g : Fin n → A} → (∀ i → f i ≈ g i) → tabulate f ≋ tabulate g tabulate⁺ = PW.tabulate⁺ tabulate⁻ : ∀ {n} {f : Fin n → A} {g : Fin n → A} → tabulate f ≋ tabulate g → (∀ i → f i ≈ g i) tabulate⁻ = PW.tabulate⁻ ------------------------------------------------------------------------ -- filter module _ {P : Pred A p} (P? : U.Decidable P) (resp : P Respects _≈_) where filter⁺ : ∀ {xs ys} → xs ≋ ys → filter P? xs ≋ filter P? ys filter⁺ xs≋ys = PW.filter⁺ P? P? resp (resp ∘ sym) xs≋ys ------------------------------------------------------------------------ -- reverse ʳ++⁺ : ∀{xs xs′ ys ys′} → xs ≋ xs′ → ys ≋ ys′ → xs ʳ++ ys ≋ xs′ ʳ++ ys′ ʳ++⁺ = PW.ʳ++⁺ reverse⁺ : ∀ {xs ys} → xs ≋ ys → reverse xs ≋ reverse ys reverse⁺ = PW.reverse⁺ agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/000077500000000000000000000000001451211343400223245ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/Heterogeneous.agda000066400000000000000000000040551451211343400257620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the heterogeneous infix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Infix.Heterogeneous where open import Level open import Relation.Binary using (REL; _⇒_) open import Data.List.Base as List using (List; []; _∷_; _++_) open import Data.List.Relation.Binary.Pointwise using (Pointwise) open import Data.List.Relation.Binary.Prefix.Heterogeneous as Prefix using (Prefix; []; _∷_; _++ᵖ_) private variable a b r s : Level A : Set a B : Set b R : REL A B r S : REL A B s module _ {A : Set a} {B : Set b} (R : REL A B r) where data Infix : REL (List A) (List B) (a ⊔ b ⊔ r) where here : ∀ {as bs} → Prefix R as bs → Infix as bs there : ∀ {b as bs} → Infix as bs → Infix as (b ∷ bs) data View (as : List A) : List B → Set (a ⊔ b ⊔ r) where MkView : ∀ pref {inf} → Pointwise R as inf → ∀ suff → View as (pref List.++ inf List.++ suff) infixr 5 _++ⁱ_ _ⁱ++_ _++ⁱ_ : ∀ xs {as bs} → Infix R as bs → Infix R as (xs ++ bs) [] ++ⁱ rs = rs (x ∷ xs) ++ⁱ rs = there (xs ++ⁱ rs) _ⁱ++_ : ∀ {as bs} → Infix R as bs → ∀ xs → Infix R as (bs ++ xs) here rs ⁱ++ xs = here (rs ++ᵖ xs) there rs ⁱ++ xs = there (rs ⁱ++ xs) map : R ⇒ S → Infix R ⇒ Infix S map R⇒S (here pref) = here (Prefix.map R⇒S pref) map R⇒S (there inf) = there (map R⇒S inf) toView : ∀ {as bs} → Infix R as bs → View R as bs toView (here p) with Prefix.toView p ...| inf Prefix.++ suff = MkView [] inf suff toView (there p) with toView p ... | MkView pref inf suff = MkView (_ ∷ pref) inf suff fromView : ∀ {as bs} → View R as bs → Infix R as bs fromView (MkView [] inf suff) = here (Prefix.fromView (inf Prefix.++ suff)) fromView (MkView (a ∷ pref) inf suff) = there (fromView (MkView pref inf suff)) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/Heterogeneous/000077500000000000000000000000001451211343400251405ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/Heterogeneous/Properties.agda000066400000000000000000000163161451211343400301210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the heterogeneous infix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Infix.Heterogeneous.Properties where open import Level open import Data.Bool.Base using (true; false) open import Data.Empty using (⊥-elim) open import Data.List.Base as List using (List; []; _∷_; length; map; filter; replicate) open import Data.Nat.Base using (zero; suc; _≤_; s≤s) import Data.Nat.Properties as ℕₚ open import Data.Sum.Base using (_⊎_; inj₁; inj₂; [_,_]′) open import Function.Base using (case_of_; _$′_) open import Relation.Nullary using (¬_; yes; no; does) open import Relation.Nullary.Decidable using (map′) open import Relation.Nullary.Negation using (contradiction) open import Relation.Nullary.Sum using (_⊎-dec_) open import Relation.Unary as U using (Pred) open import Relation.Binary using (REL; _⇒_; Decidable; Trans; Antisym) open import Relation.Binary.PropositionalEquality using (_≢_; refl; cong) open import Data.List.Relation.Binary.Pointwise as Pointwise using (Pointwise) open import Data.List.Relation.Binary.Infix.Heterogeneous open import Data.List.Relation.Binary.Prefix.Heterogeneous as Prefix using (Prefix; []; _∷_) import Data.List.Relation.Binary.Prefix.Heterogeneous.Properties as Prefixₚ open import Data.List.Relation.Binary.Suffix.Heterogeneous as Suffix using (Suffix; here; there) private variable a b r s : Level A : Set a B : Set b R : REL A B r S : REL A B s ------------------------------------------------------------------------ -- Conversion functions fromPointwise : ∀ {as bs} → Pointwise R as bs → Infix R as bs fromPointwise pw = here (Prefixₚ.fromPointwise pw) fromSuffix : ∀ {as bs} → Suffix R as bs → Infix R as bs fromSuffix (here pw) = fromPointwise pw fromSuffix (there p) = there (fromSuffix p) module _ {c t} {C : Set c} {T : REL A C t} where fromPrefixSuffix : Trans R S T → Trans (Prefix R) (Suffix S) (Infix T) fromPrefixSuffix tr p (here q) = here (Prefixₚ.trans tr p (Prefixₚ.fromPointwise q)) fromPrefixSuffix tr p (there q) = there (fromPrefixSuffix tr p q) fromSuffixPrefix : Trans R S T → Trans (Suffix R) (Prefix S) (Infix T) fromSuffixPrefix tr (here p) q = here (Prefixₚ.trans tr (Prefixₚ.fromPointwise p) q) fromSuffixPrefix tr (there p) (_ ∷ q) = there (fromSuffixPrefix tr p q) ∷⁻ : ∀ {as b bs} → Infix R as (b ∷ bs) → Prefix R as (b ∷ bs) ⊎ Infix R as bs ∷⁻ (here pref) = inj₁ pref ∷⁻ (there inf) = inj₂ inf ------------------------------------------------------------------------ -- length length-mono : ∀ {as bs} → Infix R as bs → length as ≤ length bs length-mono (here pref) = Prefixₚ.length-mono pref length-mono (there p) = ℕₚ.≤-step (length-mono p) ------------------------------------------------------------------------ -- As an order module _ {c t} {C : Set c} {T : REL A C t} where Prefix-Infix-trans : Trans R S T → Trans (Prefix R) (Infix S) (Infix T) Prefix-Infix-trans tr p (here q) = here (Prefixₚ.trans tr p q) Prefix-Infix-trans tr p (there q) = there (Prefix-Infix-trans tr p q) Infix-Prefix-trans : Trans R S T → Trans (Infix R) (Prefix S) (Infix T) Infix-Prefix-trans tr (here p) q = here (Prefixₚ.trans tr p q) Infix-Prefix-trans tr (there p) (_ ∷ q) = there (Infix-Prefix-trans tr p q) Suffix-Infix-trans : Trans R S T → Trans (Suffix R) (Infix S) (Infix T) Suffix-Infix-trans tr p (here q) = fromSuffixPrefix tr p q Suffix-Infix-trans tr p (there q) = there (Suffix-Infix-trans tr p q) Infix-Suffix-trans : Trans R S T → Trans (Infix R) (Suffix S) (Infix T) Infix-Suffix-trans tr p (here q) = Infix-Prefix-trans tr p (Prefixₚ.fromPointwise q) Infix-Suffix-trans tr p (there q) = there (Infix-Suffix-trans tr p q) trans : Trans R S T → Trans (Infix R) (Infix S) (Infix T) trans tr p (here q) = Infix-Prefix-trans tr p q trans tr p (there q) = there (trans tr p q) antisym : Antisym R S T → Antisym (Infix R) (Infix S) (Pointwise T) antisym asym (here p) (here q) = Prefixₚ.antisym asym p q antisym asym {i = a ∷ as} {j = bs} p@(here _) (there q) = ⊥-elim $′ ℕₚ.<-irrefl refl $′ begin-strict length as <⟨ length-mono p ⟩ length bs ≤⟨ length-mono q ⟩ length as ∎ where open ℕₚ.≤-Reasoning antisym asym {i = as} {j = b ∷ bs} (there p) q@(here _) = ⊥-elim $′ ℕₚ.<-irrefl refl $′ begin-strict length bs <⟨ length-mono q ⟩ length as ≤⟨ length-mono p ⟩ length bs ∎ where open ℕₚ.≤-Reasoning antisym asym {i = a ∷ as} {j = b ∷ bs} (there p) (there q) = ⊥-elim $′ ℕₚ.<-irrefl refl $′ begin-strict length as <⟨ length-mono p ⟩ length bs <⟨ length-mono q ⟩ length as ∎ where open ℕₚ.≤-Reasoning ------------------------------------------------------------------------ -- map module _ {c d r} {C : Set c} {D : Set d} {R : REL C D r} where map⁺ : ∀ {as bs} (f : A → C) (g : B → D) → Infix (λ a b → R (f a) (g b)) as bs → Infix R (List.map f as) (List.map g bs) map⁺ f g (here p) = here (Prefixₚ.map⁺ f g p) map⁺ f g (there p) = there (map⁺ f g p) map⁻ : ∀ {as bs} (f : A → C) (g : B → D) → Infix R (List.map f as) (List.map g bs) → Infix (λ a b → R (f a) (g b)) as bs map⁻ {bs = []} f g (here p) = here (Prefixₚ.map⁻ f g p) map⁻ {bs = b ∷ bs} f g (here p) = here (Prefixₚ.map⁻ f g p) map⁻ {bs = b ∷ bs} f g (there p) = there (map⁻ f g p) ------------------------------------------------------------------------ -- filter module _ {p q} {P : Pred A p} {Q : Pred B q} (P? : U.Decidable P) (Q? : U.Decidable Q) (P⇒Q : ∀ {a b} → P a → Q b) (Q⇒P : ∀ {a b} → Q b → P a) where filter⁺ : ∀ {as bs} → Infix R as bs → Infix R (filter P? as) (filter Q? bs) filter⁺ (here p) = here (Prefixₚ.filter⁺ P? Q? (λ _ → P⇒Q) (λ _ → Q⇒P) p) filter⁺ {bs = b ∷ bs} (there p) with does (Q? b) ... | true = there (filter⁺ p) ... | false = filter⁺ p ------------------------------------------------------------------------ -- replicate replicate⁺ : ∀ {m n a b} → m ≤ n → R a b → Infix R (replicate m a) (replicate n b) replicate⁺ m≤n r = here (Prefixₚ.replicate⁺ m≤n r) replicate⁻ : ∀ {m n a b} → m ≢ 0 → Infix R (replicate m a) (replicate n b) → R a b replicate⁻ {m = m} {n = zero} m≢0 (here p) = Prefixₚ.replicate⁻ m≢0 p replicate⁻ {m = m} {n = suc n} m≢0 (here p) = Prefixₚ.replicate⁻ m≢0 p replicate⁻ {m = m} {n = suc n} m≢0 (there p) = replicate⁻ m≢0 p ------------------------------------------------------------------------ -- decidability infix? : Decidable R → Decidable (Infix R) infix? R? [] [] = yes (here []) infix? R? (a ∷ as) [] = no (λ where (here ())) infix? R? as bbs@(_ ∷ bs) = map′ [ here , there ]′ ∷⁻ (Prefixₚ.prefix? R? as bbs ⊎-dec infix? R? as bs) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/Homogeneous/000077500000000000000000000000001451211343400246145ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Infix/Homogeneous/Properties.agda000066400000000000000000000030431451211343400275660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the homogeneous infix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Infix.Homogeneous.Properties where open import Level open import Function.Base using (_∘′_) open import Relation.Binary open import Data.List.Relation.Binary.Pointwise as Pointwise using (Pointwise) open import Data.List.Relation.Binary.Infix.Heterogeneous open import Data.List.Relation.Binary.Infix.Heterogeneous.Properties private variable a b r s : Level A : Set a B : Set b R : REL A B r S : REL A B s isPreorder : IsPreorder R S → IsPreorder (Pointwise R) (Infix S) isPreorder po = record { isEquivalence = Pointwise.isEquivalence PO.isEquivalence ; reflexive = fromPointwise ∘′ Pointwise.map PO.reflexive ; trans = trans PO.trans } where module PO = IsPreorder po isPartialOrder : IsPartialOrder R S → IsPartialOrder (Pointwise R) (Infix S) isPartialOrder po = record { isPreorder = isPreorder PO.isPreorder ; antisym = antisym PO.antisym } where module PO = IsPartialOrder po isDecPartialOrder : IsDecPartialOrder R S → IsDecPartialOrder (Pointwise R) (Infix S) isDecPartialOrder dpo = record { isPartialOrder = isPartialOrder DPO.isPartialOrder ; _≟_ = Pointwise.decidable DPO._≟_ ; _≤?_ = infix? DPO._≤?_ } where module DPO = IsDecPartialOrder dpo agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Lex.agda000066400000000000000000000115661451211343400226260ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lexicographic ordering of lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Lex where open import Data.Empty using (⊥; ⊥-elim) open import Data.Unit.Base using (⊤; tt) open import Data.Product using (_×_; _,_; proj₁; proj₂; uncurry) open import Data.List.Base using (List; []; _∷_) open import Data.Sum.Base using (_⊎_; inj₁; inj₂; [_,_]) open import Function.Base using (_∘_; flip; id) open import Function.Equivalence using (_⇔_; equivalence) open import Level using (_⊔_) open import Relation.Nullary using (Dec; yes; no; ¬_) import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Product using (_×-dec_) open import Relation.Nullary.Sum using (_⊎-dec_) open import Relation.Binary hiding (_⇔_) open import Data.List.Relation.Binary.Pointwise.Base using (Pointwise; []; _∷_; head; tail) ------------------------------------------------------------------------ -- Re-exporting the core definitions and properties open import Data.List.Relation.Binary.Lex.Core public ------------------------------------------------------------------------ -- Properties module _ {a ℓ₁ ℓ₂} {A : Set a} {P : Set} {_≈_ : Rel A ℓ₁} {_≺_ : Rel A ℓ₂} where private _≋_ = Pointwise _≈_ _<_ = Lex P _≈_ _≺_ ¬≤-this : ∀ {x y xs ys} → ¬ (x ≈ y) → ¬ (x ≺ y) → ¬ (x ∷ xs) < (y ∷ ys) ¬≤-this x≉y x≮y (this x≺y) = x≮y x≺y ¬≤-this x≉y x≮y (next x≈y xs (λ()) (λ()) halt <-compare sym tri (x ∷ xs) (y ∷ ys) with tri x y ... | tri< x x≮y x≉y y (¬≤-this x≉y x≮y) (x≉y ∘ head) (this y xs≮ys xs≉ys ys (¬≤-next x≮y xs≮ys) (xs≉ys ∘ tail) (next (sym x≈y) ys _ _ y) open import Data.List.Base using (List; []; _∷_) open import Level open import Relation.Binary.Core using (REL; _⇒_) private variable a b c ℓ : Level A : Set a B : Set b x y : A xs ys : List A R S : REL A B ℓ ------------------------------------------------------------------------ -- Definition ------------------------------------------------------------------------ infixr 5 _∷_ data Pointwise {A : Set a} {B : Set b} (R : REL A B ℓ) : List A → List B → Set (a ⊔ b ⊔ ℓ) where [] : Pointwise R [] [] _∷_ : (x∼y : R x y) (xs∼ys : Pointwise R xs ys) → Pointwise R (x ∷ xs) (y ∷ ys) ------------------------------------------------------------------------ -- Operations ------------------------------------------------------------------------ head : Pointwise R (x ∷ xs) (y ∷ ys) → R x y head (x∼y ∷ xs∼ys) = x∼y tail : Pointwise R (x ∷ xs) (y ∷ ys) → Pointwise R xs ys tail (x∼y ∷ xs∼ys) = xs∼ys uncons : Pointwise R (x ∷ xs) (y ∷ ys) → R x y × Pointwise R xs ys uncons = < head , tail > rec : ∀ (P : ∀ {xs ys} → Pointwise R xs ys → Set c) → (∀ {x y xs ys} {Rxsys : Pointwise R xs ys} → (Rxy : R x y) → P Rxsys → P (Rxy ∷ Rxsys)) → P [] → ∀ {xs ys} (Rxsys : Pointwise R xs ys) → P Rxsys rec P c n [] = n rec P c n (Rxy ∷ Rxsys) = c Rxy (rec P c n Rxsys) map : R ⇒ S → Pointwise R ⇒ Pointwise S map R⇒S [] = [] map R⇒S (Rxy ∷ Rxsys) = R⇒S Rxy ∷ map R⇒S Rxsys agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Pointwise/Properties.agda000066400000000000000000000056511451211343400262110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of pointwise lifting of relations to lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Pointwise.Properties where open import Data.Product using (_,_; uncurry) open import Data.List.Base using (List; []; _∷_) open import Level open import Relation.Binary.Core using (REL; _⇒_) open import Relation.Binary.Definitions import Relation.Binary.PropositionalEquality as P open import Relation.Nullary using (yes; no) open import Relation.Nullary.Product using (_×-dec_) import Relation.Nullary.Decidable as Dec open import Data.List.Relation.Binary.Pointwise.Base private variable a b ℓ : Level A : Set a B : Set b R S T : REL A B ℓ ------------------------------------------------------------------------ -- Relational properties ------------------------------------------------------------------------ reflexive : R ⇒ S → Pointwise R ⇒ Pointwise S reflexive = map refl : Reflexive R → Reflexive (Pointwise R) refl rfl {[]} = [] refl rfl {x ∷ xs} = rfl ∷ refl rfl symmetric : Sym R S → Sym (Pointwise R) (Pointwise S) symmetric sym [] = [] symmetric sym (x∼y ∷ xs∼ys) = sym x∼y ∷ symmetric sym xs∼ys transitive : Trans R S T → Trans (Pointwise R) (Pointwise S) (Pointwise T) transitive trans [] [] = [] transitive trans (x∼y ∷ xs∼ys) (y∼z ∷ ys∼zs) = trans x∼y y∼z ∷ transitive trans xs∼ys ys∼zs antisymmetric : Antisym R S T → Antisym (Pointwise R) (Pointwise S) (Pointwise T) antisymmetric antisym [] [] = [] antisymmetric antisym (x∼y ∷ xs∼ys) (y∼x ∷ ys∼xs) = antisym x∼y y∼x ∷ antisymmetric antisym xs∼ys ys∼xs respʳ : R Respectsʳ S → (Pointwise R) Respectsʳ (Pointwise S) respʳ resp [] [] = [] respʳ resp (x≈y ∷ xs≈ys) (z∼x ∷ zs∼xs) = resp x≈y z∼x ∷ respʳ resp xs≈ys zs∼xs respˡ : R Respectsˡ S → (Pointwise R) Respectsˡ (Pointwise S) respˡ resp [] [] = [] respˡ resp (x≈y ∷ xs≈ys) (x∼z ∷ xs∼zs) = resp x≈y x∼z ∷ respˡ resp xs≈ys xs∼zs respects₂ : R Respects₂ S → (Pointwise R) Respects₂ (Pointwise S) respects₂ (rʳ , rˡ) = respʳ rʳ , respˡ rˡ decidable : Decidable R → Decidable (Pointwise R) decidable _ [] [] = yes [] decidable _ [] (y ∷ ys) = no λ() decidable _ (x ∷ xs) [] = no λ() decidable R? (x ∷ xs) (y ∷ ys) = Dec.map′ (uncurry _∷_) uncons (R? x y ×-dec decidable R? xs ys) irrelevant : Irrelevant R → Irrelevant (Pointwise R) irrelevant irr [] [] = P.refl irrelevant irr (r ∷ rs) (r₁ ∷ rs₁) = P.cong₂ _∷_ (irr r r₁) (irrelevant irr rs rs₁) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/000077500000000000000000000000001451211343400225045ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/Heterogeneous.agda000066400000000000000000000041201451211343400261330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the heterogeneous prefix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Prefix.Heterogeneous where open import Level open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Data.Product using (∃; _×_; _,_; uncurry) open import Relation.Binary using (REL; _⇒_) module _ {a b r} {A : Set a} {B : Set b} (R : REL A B r) where infixr 5 _∷_ _++_ data Prefix : REL (List A) (List B) (a ⊔ b ⊔ r) where [] : ∀ {bs} → Prefix [] bs _∷_ : ∀ {a b as bs} → R a b → Prefix as bs → Prefix (a ∷ as) (b ∷ bs) data PrefixView (as : List A) : List B → Set (a ⊔ b ⊔ r) where _++_ : ∀ {cs} → Pointwise R as cs → ∀ ds → PrefixView as (cs List.++ ds) module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} {a b as bs} where head : Prefix R (a ∷ as) (b ∷ bs) → R a b head (r ∷ rs) = r tail : Prefix R (a ∷ as) (b ∷ bs) → Prefix R as bs tail (r ∷ rs) = rs uncons : Prefix R (a ∷ as) (b ∷ bs) → R a b × Prefix R as bs uncons (r ∷ rs) = r , rs module _ {a b r s} {A : Set a} {B : Set b} {R : REL A B r} {S : REL A B s} where map : R ⇒ S → Prefix R ⇒ Prefix S map R⇒S [] = [] map R⇒S (r ∷ rs) = R⇒S r ∷ map R⇒S rs module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where _++ᵖ_ : ∀ {as bs} → Prefix R as bs → ∀ suf → Prefix R as (bs List.++ suf) [] ++ᵖ suf = [] (r ∷ rs) ++ᵖ suf = r ∷ (rs ++ᵖ suf) toView : ∀ {as bs} → Prefix R as bs → PrefixView R as bs toView [] = [] ++ _ toView (r ∷ rs) with toView rs ... | rs′ ++ ds = (r ∷ rs′) ++ ds fromView : ∀ {as bs} → PrefixView R as bs → Prefix R as bs fromView ([] ++ ds) = [] fromView ((r ∷ rs) ++ ds) = r ∷ fromView (rs ++ ds) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/Heterogeneous/000077500000000000000000000000001451211343400253205ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/Heterogeneous/Properties.agda000066400000000000000000000211331451211343400302720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the heterogeneous prefix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Prefix.Heterogeneous.Properties where open import Level open import Data.Bool.Base using (true; false) open import Data.Empty open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All open import Data.List.Base as List hiding (map; uncons) open import Data.List.Membership.Propositional.Properties using ([]∈inits) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Data.List.Relation.Binary.Prefix.Heterogeneous as Prefix hiding (PrefixView; _++_) open import Data.Nat.Base using (ℕ; zero; suc; _≤_; z≤n; s≤s) open import Data.Nat.Properties using (suc-injective) open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; uncurry) open import Function open import Relation.Nullary using (yes; no; ¬_; _because_) import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Product using (_×-dec_) open import Relation.Unary as U using (Pred) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_) private variable a b r s : Level A : Set a B : Set b R : REL A B r S : REL A B s ------------------------------------------------------------------------ -- First as a decidable partial order (once made homogeneous) fromPointwise : Pointwise R ⇒ Prefix R fromPointwise [] = [] fromPointwise (r ∷ rs) = r ∷ fromPointwise rs toPointwise : ∀ {as bs} → length as ≡ length bs → Prefix R as bs → Pointwise R as bs toPointwise {bs = []} eq [] = [] toPointwise eq (r ∷ rs) = r ∷ toPointwise (suc-injective eq) rs module _ {a b c r s t} {A : Set a} {B : Set b} {C : Set c} {R : REL A B r} {S : REL B C s} {T : REL A C t} where trans : Trans R S T → Trans (Prefix R) (Prefix S) (Prefix T) trans rs⇒t [] ss = [] trans rs⇒t (r ∷ rs) (s ∷ ss) = rs⇒t r s ∷ trans rs⇒t rs ss module _ {a b r s e} {A : Set a} {B : Set b} {R : REL A B r} {S : REL B A s} {E : REL A B e} where antisym : Antisym R S E → Antisym (Prefix R) (Prefix S) (Pointwise E) antisym rs⇒e [] [] = [] antisym rs⇒e (r ∷ rs) (s ∷ ss) = rs⇒e r s ∷ antisym rs⇒e rs ss ------------------------------------------------------------------------ -- length length-mono : ∀ {as bs} → Prefix R as bs → length as ≤ length bs length-mono [] = z≤n length-mono (r ∷ rs) = s≤s (length-mono rs) ------------------------------------------------------------------------ -- _++_ ++⁺ : ∀ {as bs cs ds} → Pointwise R as bs → Prefix R cs ds → Prefix R (as ++ cs) (bs ++ ds) ++⁺ [] cs⊆ds = cs⊆ds ++⁺ (r ∷ rs) cs⊆ds = r ∷ (++⁺ rs cs⊆ds) ++⁻ : ∀ {as bs cs ds} → length as ≡ length bs → Prefix R (as ++ cs) (bs ++ ds) → Prefix R cs ds ++⁻ {as = []} {[]} eq rs = rs ++⁻ {as = _ ∷ _} {_ ∷ _} eq (_ ∷ rs) = ++⁻ (suc-injective eq) rs ------------------------------------------------------------------------ -- map module _ {a b c d r} {A : Set a} {B : Set b} {C : Set c} {D : Set d} {R : REL C D r} where map⁺ : ∀ {as bs} (f : A → C) (g : B → D) → Prefix (λ a b → R (f a) (g b)) as bs → Prefix R (List.map f as) (List.map g bs) map⁺ f g [] = [] map⁺ f g (r ∷ rs) = r ∷ map⁺ f g rs map⁻ : ∀ {as bs} (f : A → C) (g : B → D) → Prefix R (List.map f as) (List.map g bs) → Prefix (λ a b → R (f a) (g b)) as bs map⁻ {[]} {bs} f g rs = [] map⁻ {a ∷ as} {b ∷ bs} f g (r ∷ rs) = r ∷ map⁻ f g rs ------------------------------------------------------------------------ -- filter module _ {p q} {P : Pred A p} {Q : Pred B q} (P? : U.Decidable P) (Q? : U.Decidable Q) (P⇒Q : ∀ {a b} → R a b → P a → Q b) (Q⇒P : ∀ {a b} → R a b → Q b → P a) where filter⁺ : ∀ {as bs} → Prefix R as bs → Prefix R (filter P? as) (filter Q? bs) filter⁺ [] = [] filter⁺ {a ∷ as} {b ∷ bs} (r ∷ rs) with P? a | Q? b ... | true because _ | true because _ = r ∷ filter⁺ rs ... | yes pa | no ¬qb = ⊥-elim (¬qb (P⇒Q r pa)) ... | no ¬pa | yes qb = ⊥-elim (¬pa (Q⇒P r qb)) ... | false because _ | false because _ = filter⁺ rs ------------------------------------------------------------------------ -- take take⁺ : ∀ {as bs} n → Prefix R as bs → Prefix R (take n as) (take n bs) take⁺ zero rs = [] take⁺ (suc n) [] = [] take⁺ (suc n) (r ∷ rs) = r ∷ take⁺ n rs take⁻ : ∀ {as bs} n → Prefix R (take n as) (take n bs) → Prefix R (drop n as) (drop n bs) → Prefix R as bs take⁻ zero hds tls = tls take⁻ {as = []} (suc n) hds tls = [] take⁻ {as = a ∷ as} {b ∷ bs} (suc n) (r ∷ hds) tls = r ∷ take⁻ n hds tls ------------------------------------------------------------------------ -- drop drop⁺ : ∀ {as bs} n → Prefix R as bs → Prefix R (drop n as) (drop n bs) drop⁺ zero rs = rs drop⁺ (suc n) [] = [] drop⁺ (suc n) (r ∷ rs) = drop⁺ n rs drop⁻ : ∀ {as bs} n → Pointwise R (take n as) (take n bs) → Prefix R (drop n as) (drop n bs) → Prefix R as bs drop⁻ zero hds tls = tls drop⁻ {as = []} (suc n) hds tls = [] drop⁻ {as = _ ∷ _} {_ ∷ _} (suc n) (r ∷ hds) tls = r ∷ (drop⁻ n hds tls) ------------------------------------------------------------------------ -- replicate replicate⁺ : ∀ {m n a b} → m ≤ n → R a b → Prefix R (replicate m a) (replicate n b) replicate⁺ z≤n r = [] replicate⁺ (s≤s m≤n) r = r ∷ replicate⁺ m≤n r replicate⁻ : ∀ {m n a b} → m ≢ 0 → Prefix R (replicate m a) (replicate n b) → R a b replicate⁻ {m = zero} {n} m≢0 r = ⊥-elim (m≢0 P.refl) replicate⁻ {m = suc m} {suc n} m≢0 rs = Prefix.head rs ------------------------------------------------------------------------ -- inits module _ {a r} {A : Set a} {R : Rel A r} where inits⁺ : ∀ {as} → Pointwise R as as → All (flip (Prefix R) as) (inits as) inits⁺ [] = [] ∷ [] inits⁺ (r ∷ rs) = [] ∷ All.map⁺ (All.map (r ∷_) (inits⁺ rs)) inits⁻ : ∀ {as} → All (flip (Prefix R) as) (inits as) → Pointwise R as as inits⁻ {as = []} rs = [] inits⁻ {as = a ∷ as} (r ∷ rs) = let (hd , tls) = All.unzip (All.map uncons (All.map⁻ rs)) in All.lookup hd ([]∈inits as) ∷ inits⁻ tls ------------------------------------------------------------------------ -- zip(With) module _ {a b c} {A : Set a} {B : Set b} {C : Set c} {d e f} {D : Set d} {E : Set e} {F : Set f} {r s t} {R : REL A D r} {S : REL B E s} {T : REL C F t} where zipWith⁺ : ∀ {as bs ds es} {f : A → B → C} {g : D → E → F} → (∀ {a b c d} → R a c → S b d → T (f a b) (g c d)) → Prefix R as ds → Prefix S bs es → Prefix T (zipWith f as bs) (zipWith g ds es) zipWith⁺ f [] ss = [] zipWith⁺ f (r ∷ rs) [] = [] zipWith⁺ f (r ∷ rs) (s ∷ ss) = f r s ∷ zipWith⁺ f rs ss module _ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} {r s} {R : REL A C r} {S : REL B D s} where private R×S : REL (A × B) (C × D) _ R×S (a , b) (c , d) = R a c × S b d zip⁺ : ∀ {as bs cs ds} → Prefix R as cs → Prefix S bs ds → Prefix R×S (zip as bs) (zip cs ds) zip⁺ = zipWith⁺ _,_ ------------------------------------------------------------------------ -- Irrelevance module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where irrelevant : Irrelevant R → Irrelevant (Prefix R) irrelevant R-irr [] [] = P.refl irrelevant R-irr (r ∷ rs) (r′ ∷ rs′) = P.cong₂ _∷_ (R-irr r r′) (irrelevant R-irr rs rs′) ------------------------------------------------------------------------ -- Decidability prefix? : Decidable R → Decidable (Prefix R) prefix? R? [] bs = yes [] prefix? R? (a ∷ as) [] = no (λ ()) prefix? R? (a ∷ as) (b ∷ bs) = Dec.map′ (uncurry _∷_) uncons $ R? a b ×-dec prefix? R? as bs agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/Homogeneous/000077500000000000000000000000001451211343400247745ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Prefix/Homogeneous/Properties.agda000066400000000000000000000030531451211343400277470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the homogeneous prefix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Prefix.Homogeneous.Properties where open import Level open import Function.Base using (_∘′_) open import Relation.Binary open import Data.List.Relation.Binary.Pointwise as Pointwise using (Pointwise) open import Data.List.Relation.Binary.Prefix.Heterogeneous open import Data.List.Relation.Binary.Prefix.Heterogeneous.Properties private variable a b r s : Level A : Set a B : Set b R : REL A B r S : REL A B s isPreorder : IsPreorder R S → IsPreorder (Pointwise R) (Prefix S) isPreorder po = record { isEquivalence = Pointwise.isEquivalence PO.isEquivalence ; reflexive = fromPointwise ∘′ Pointwise.map PO.reflexive ; trans = trans PO.trans } where module PO = IsPreorder po isPartialOrder : IsPartialOrder R S → IsPartialOrder (Pointwise R) (Prefix S) isPartialOrder po = record { isPreorder = isPreorder PO.isPreorder ; antisym = antisym PO.antisym } where module PO = IsPartialOrder po isDecPartialOrder : IsDecPartialOrder R S → IsDecPartialOrder (Pointwise R) (Prefix S) isDecPartialOrder dpo = record { isPartialOrder = isPartialOrder DPO.isPartialOrder ; _≟_ = Pointwise.decidable DPO._≟_ ; _≤?_ = prefix? DPO._≤?_ } where module DPO = IsDecPartialOrder dpo agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/000077500000000000000000000000001451211343400226745ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecPropositional.agda000066400000000000000000000027261451211343400267770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the sublist relation for types which have -- a decidable equality. This is commonly known as Order Preserving -- Embeddings (OPE). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary open import Agda.Builtin.Equality using (_≡_) module Data.List.Relation.Binary.Sublist.DecPropositional {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) where open import Data.List.Relation.Binary.Equality.DecPropositional _≟_ using (_≡?_) import Data.List.Relation.Binary.Sublist.DecSetoid as DecSetoidSublist import Data.List.Relation.Binary.Sublist.Propositional as PropositionalSublist open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Re-export core definitions and operations open PropositionalSublist {A = A} public open DecSetoidSublist (decSetoid _≟_) using (_⊆?_) public ------------------------------------------------------------------------ -- Additional relational properties ⊆-isDecPartialOrder : IsDecPartialOrder _≡_ _⊆_ ⊆-isDecPartialOrder = record { isPartialOrder = ⊆-isPartialOrder ; _≟_ = _≡?_ ; _≤?_ = _⊆?_ } ⊆-decPoset : DecPoset a a a ⊆-decPoset = record { isDecPartialOrder = ⊆-isDecPartialOrder } agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecPropositional/000077500000000000000000000000001451211343400261525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecPropositional/Solver.agda000066400000000000000000000013031451211343400302370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A solver for proving that one list is a sublist of the other for types -- which enjoy decidable equalities. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Decidable) open import Agda.Builtin.Equality using (_≡_) module Data.List.Relation.Binary.Sublist.DecPropositional.Solver {a} {A : Set a} (_≟_ : Decidable {A = A} _≡_) where import Relation.Binary.PropositionalEquality as P open import Data.List.Relation.Binary.Sublist.DecSetoid.Solver (P.decSetoid _≟_) public agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecSetoid.agda000066400000000000000000000027251451211343400253630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the sublist relation with respect to a -- setoid which is decidable. This is a generalisation of what is -- commonly known as Order Preserving Embeddings (OPE). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Sublist.DecSetoid {c ℓ} (S : DecSetoid c ℓ) where import Data.List.Relation.Binary.Equality.DecSetoid as DecSetoidEquality import Data.List.Relation.Binary.Sublist.Setoid as SetoidSublist import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties as HeterogeneousProperties open import Level using (_⊔_) open DecSetoid S open DecSetoidEquality S infix 4 _⊆?_ ------------------------------------------------------------------------ -- Re-export core definitions open SetoidSublist setoid public ------------------------------------------------------------------------ -- Additional relational properties _⊆?_ : Decidable _⊆_ _⊆?_ = HeterogeneousProperties.sublist? _≟_ ⊆-isDecPartialOrder : IsDecPartialOrder _≋_ _⊆_ ⊆-isDecPartialOrder = record { isPartialOrder = ⊆-isPartialOrder ; _≟_ = _≋?_ ; _≤?_ = _⊆?_ } ⊆-decPoset : DecPoset c (c ⊔ ℓ) (c ⊔ ℓ) ⊆-decPoset = record { isDecPartialOrder = ⊆-isDecPartialOrder } agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecSetoid/000077500000000000000000000000001451211343400245375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/DecSetoid/Solver.agda000066400000000000000000000011241451211343400266250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A solver for proving that one list is a sublist of the other. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (DecSetoid) module Data.List.Relation.Binary.Sublist.DecSetoid.Solver {c ℓ} (S : DecSetoid c ℓ) where open DecSetoid S open import Data.List.Relation.Binary.Sublist.Heterogeneous.Solver _≈_ refl _≟_ using (Item; module Item; TList; module TList; prove) public agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Heterogeneous.agda000066400000000000000000000106641451211343400263350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the heterogeneous sublist relation -- This is a generalisation of what is commonly known as Order -- Preserving Embeddings (OPE). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.List.Base using (List; []; _∷_; [_]) open import Data.List.Relation.Unary.Any using (Any; here; there) open import Level using (_⊔_) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Unary using (Pred) module Data.List.Relation.Binary.Sublist.Heterogeneous {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ------------------------------------------------------------------------ -- Re-export core definitions open import Data.List.Relation.Binary.Sublist.Heterogeneous.Core public ------------------------------------------------------------------------ -- Type and basic combinators module _ {s} {S : REL A B s} where map : R ⇒ S → Sublist R ⇒ Sublist S map f [] = [] map f (y ∷ʳ rs) = y ∷ʳ map f rs map f (r ∷ rs) = f r ∷ map f rs minimum : Min (Sublist R) [] minimum [] = [] minimum (x ∷ xs) = x ∷ʳ minimum xs ------------------------------------------------------------------------ -- Conversion to and from Any -- Special case: Sublist R [ a ] bs → Any (R a) bs toAny : ∀ {a as bs} → Sublist R (a ∷ as) bs → Any (R a) bs toAny (y ∷ʳ rs) = there (toAny rs) toAny (r ∷ rs) = here r fromAny : ∀ {a bs} → Any (R a) bs → Sublist R [ a ] bs fromAny (here r) = r ∷ minimum _ fromAny (there p) = _ ∷ʳ fromAny p ------------------------------------------------------------------------ -- Generalised lookup based on a proof of Any module _ {p q} {P : Pred A p} {Q : Pred B q} (resp : P ⟶ Q Respects R) where lookup : ∀ {xs ys} → Sublist R xs ys → Any P xs → Any Q ys lookup (y ∷ʳ p) k = there (lookup p k) lookup (rxy ∷ p) (here px) = here (resp rxy px) lookup (rxy ∷ p) (there k) = there (lookup p k) ------------------------------------------------------------------------ -- Disjoint sublists xs,ys ⊆ zs -- -- NB: This does not imply that xs and ys partition zs; -- zs may have additional elements. private infix 4 _⊆_ _⊆_ = Sublist R infixr 5 _∷ₙ_ _∷ₗ_ _∷ᵣ_ data Disjoint : ∀ {xs ys zs} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → Set (a ⊔ b ⊔ r) where [] : Disjoint [] [] -- Element y of zs is neither in xs nor in ys: _∷ₙ_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → (y : B) → Disjoint τ₁ τ₂ → Disjoint (y ∷ʳ τ₁) (y ∷ʳ τ₂) -- Element y of zs is in xs as x with x≈y: _∷ₗ_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {x y} → (x≈y : R x y) → Disjoint τ₁ τ₂ → Disjoint (x≈y ∷ τ₁) (y ∷ʳ τ₂) -- Element y of zs is in ys as x with x≈y: _∷ᵣ_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {x y} → (x≈y : R x y) → Disjoint τ₁ τ₂ → Disjoint (y ∷ʳ τ₁) (x≈y ∷ τ₂) ------------------------------------------------------------------------ -- Disjoint union of two sublists xs,ys ⊆ zs -- -- This is the Cover relation without overlap of Section 6 of -- Conor McBride, Everybody's Got To Be Somewhere, -- MSFP@FSCD 2018: 53-69. data DisjointUnion : ∀ {xs ys zs us} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) (τ : us ⊆ zs) → Set (a ⊔ b ⊔ r) where [] : DisjointUnion [] [] [] -- Element y of zs is neither in xs nor in ys: skip. _∷ₙ_ : ∀ {xs ys zs us} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : us ⊆ zs} → (y : B) → DisjointUnion τ₁ τ₂ τ → DisjointUnion (y ∷ʳ τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ) -- Element y of zs is in xs as x with x≈y: add to us. _∷ₗ_ : ∀ {xs ys zs us} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : us ⊆ zs} {x y} → (x≈y : R x y) → DisjointUnion τ₁ τ₂ τ → DisjointUnion (x≈y ∷ τ₁) (y ∷ʳ τ₂) (x≈y ∷ τ) -- Element y of zs is in ys as x with x≈y: add to us. _∷ᵣ_ : ∀ {xs ys zs us} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : us ⊆ zs} {x y} → (x≈y : R x y) → DisjointUnion τ₁ τ₂ τ → DisjointUnion (y ∷ʳ τ₁) (x≈y ∷ τ₂) (x≈y ∷ τ) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Heterogeneous/000077500000000000000000000000001451211343400255105ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Heterogeneous/Core.agda000066400000000000000000000021551451211343400272210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This file contains some core definitions which are re-exported by -- Data.List.Relation.Binary.Sublist.Heterogeneous. ------------------------------------------------------------------------ -- This module has R as explicit parameter, in contrast to the implicit -- parameter R of the main module Sublist.Heterogeneous. -- Parameterized data modules (https://github.com/agda/agda/issues/3210) -- may simplify this setup, making this module obsolete. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (REL) module Data.List.Relation.Binary.Sublist.Heterogeneous.Core {a b r} {A : Set a} {B : Set b} (R : REL A B r) where open import Level using (_⊔_) open import Data.List.Base using (List; []; _∷_) infixr 5 _∷_ _∷ʳ_ data Sublist : REL (List A) (List B) (a ⊔ b ⊔ r) where [] : Sublist [] [] _∷ʳ_ : ∀ {xs ys} → ∀ y → Sublist xs ys → Sublist xs (y ∷ ys) _∷_ : ∀ {x xs y ys} → R x y → Sublist xs ys → Sublist (x ∷ xs) (y ∷ ys) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Heterogeneous/Properties.agda000066400000000000000000000774621451211343400305020ustar00rootroot00000000000000----------------------------------------------------------------------- -- The Agda standard library -- -- Properties of the heterogeneous sublist relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Sublist.Heterogeneous.Properties where open import Level open import Data.Bool.Base using (true; false) open import Data.Empty open import Data.List.Relation.Unary.All using (Null; []; _∷_) open import Data.List.Relation.Unary.Any using (Any; here; there) open import Data.List.Base as List hiding (map; _∷ʳ_) import Data.List.Properties as Lₚ open import Data.List.Relation.Unary.Any.Properties using (here-injective; there-injective) open import Data.List.Relation.Binary.Pointwise as Pw using (Pointwise; []; _∷_) open import Data.List.Relation.Binary.Sublist.Heterogeneous open import Data.Maybe.Relation.Unary.All as MAll using (nothing; just) open import Data.Nat.Base using (ℕ; _≤_; _≥_); open ℕ; open _≤_ import Data.Nat.Properties as ℕₚ open import Data.Product using (∃₂; _×_; _,_; proj₂; uncurry) open import Function.Base open import Function.Bijection using (_⤖_; bijection) open import Function.Equivalence using (_⇔_ ; equivalence) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary using (Dec; does; _because_; yes; no; ¬_) open import Relation.Nullary.Negation using (¬?) import Relation.Nullary.Decidable as Dec open import Relation.Unary as U using (Pred) open import Relation.Binary hiding (_⇔_) open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Injectivity of constructors module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ∷-injectiveˡ : ∀ {x y xs ys} {px qx : R x y} {pxs qxs : Sublist R xs ys} → (Sublist R (x ∷ xs) (y ∷ ys) ∋ px ∷ pxs) ≡ (qx ∷ qxs) → px ≡ qx ∷-injectiveˡ P.refl = P.refl ∷-injectiveʳ : ∀ {x y xs ys} {px qx : R x y} {pxs qxs : Sublist R xs ys} → (Sublist R (x ∷ xs) (y ∷ ys) ∋ px ∷ pxs) ≡ (qx ∷ qxs) → pxs ≡ qxs ∷-injectiveʳ P.refl = P.refl ∷ʳ-injective : ∀ {y xs ys} {pxs qxs : Sublist R xs ys} → (Sublist R xs (y ∷ ys) ∋ y ∷ʳ pxs) ≡ (y ∷ʳ qxs) → pxs ≡ qxs ∷ʳ-injective P.refl = P.refl module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where length-mono-≤ : ∀ {as bs} → Sublist R as bs → length as ≤ length bs length-mono-≤ [] = z≤n length-mono-≤ (y ∷ʳ rs) = ℕₚ.≤-step (length-mono-≤ rs) length-mono-≤ (r ∷ rs) = s≤s (length-mono-≤ rs) ------------------------------------------------------------------------ -- Conversion to and from Pointwise (proto-reflexivity) fromPointwise : Pointwise R ⇒ Sublist R fromPointwise [] = [] fromPointwise (p ∷ ps) = p ∷ fromPointwise ps toPointwise : ∀ {as bs} → length as ≡ length bs → Sublist R as bs → Pointwise R as bs toPointwise {bs = []} eq [] = [] toPointwise {bs = b ∷ bs} eq (r ∷ rs) = r ∷ toPointwise (ℕₚ.suc-injective eq) rs toPointwise {bs = b ∷ bs} eq (b ∷ʳ rs) = ⊥-elim $ ℕₚ.<-irrefl eq (s≤s (length-mono-≤ rs)) ------------------------------------------------------------------------ -- Various functions' outputs are sublists -- These lemmas are generalisations of results of the form `f xs ⊆ xs`. -- (where _⊆_ stands for Sublist R). If R is reflexive then we can indeed -- obtain `f xs ⊆ xs` from `xs ⊆ ys → f xs ⊆ ys`. The other direction is -- only true if R is both reflexive and transitive. module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where tail-Sublist : ∀ {as bs} → Sublist R as bs → MAll.All (λ as → Sublist R as bs) (tail as) tail-Sublist [] = nothing tail-Sublist (b ∷ʳ ps) = MAll.map (b ∷ʳ_) (tail-Sublist ps) tail-Sublist (p ∷ ps) = just (_ ∷ʳ ps) take-Sublist : ∀ {as bs} n → Sublist R as bs → Sublist R (take n as) bs take-Sublist n (y ∷ʳ rs) = y ∷ʳ take-Sublist n rs take-Sublist zero rs = minimum _ take-Sublist (suc n) [] = [] take-Sublist (suc n) (r ∷ rs) = r ∷ take-Sublist n rs drop-Sublist : ∀ n → Sublist R ⇒ (Sublist R ∘′ drop n) drop-Sublist n (y ∷ʳ rs) = y ∷ʳ drop-Sublist n rs drop-Sublist zero rs = rs drop-Sublist (suc n) [] = [] drop-Sublist (suc n) (r ∷ rs) = _ ∷ʳ drop-Sublist n rs module _ {a b r p} {A : Set a} {B : Set b} {R : REL A B r} {P : Pred A p} (P? : U.Decidable P) where takeWhile-Sublist : ∀ {as bs} → Sublist R as bs → Sublist R (takeWhile P? as) bs takeWhile-Sublist [] = [] takeWhile-Sublist (y ∷ʳ rs) = y ∷ʳ takeWhile-Sublist rs takeWhile-Sublist {a ∷ as} (r ∷ rs) with does (P? a) ... | true = r ∷ takeWhile-Sublist rs ... | false = minimum _ dropWhile-Sublist : ∀ {as bs} → Sublist R as bs → Sublist R (dropWhile P? as) bs dropWhile-Sublist [] = [] dropWhile-Sublist (y ∷ʳ rs) = y ∷ʳ dropWhile-Sublist rs dropWhile-Sublist {a ∷ as} (r ∷ rs) with does (P? a) ... | true = _ ∷ʳ dropWhile-Sublist rs ... | false = r ∷ rs filter-Sublist : ∀ {as bs} → Sublist R as bs → Sublist R (filter P? as) bs filter-Sublist [] = [] filter-Sublist (y ∷ʳ rs) = y ∷ʳ filter-Sublist rs filter-Sublist {a ∷ as} (r ∷ rs) with does (P? a) ... | true = r ∷ filter-Sublist rs ... | false = _ ∷ʳ filter-Sublist rs ------------------------------------------------------------------------ -- Various functions are increasing wrt _⊆_ -- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` -- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ------------------------------------------------------------------------ -- _∷_ ∷ˡ⁻ : ∀ {a as bs} → Sublist R (a ∷ as) bs → Sublist R as bs ∷ˡ⁻ (y ∷ʳ rs) = y ∷ʳ ∷ˡ⁻ rs ∷ˡ⁻ (r ∷ rs) = _ ∷ʳ rs ∷ʳ⁻ : ∀ {a as b bs} → ¬ R a b → Sublist R (a ∷ as) (b ∷ bs) → Sublist R (a ∷ as) bs ∷ʳ⁻ ¬r (y ∷ʳ rs) = rs ∷ʳ⁻ ¬r (r ∷ rs) = ⊥-elim (¬r r) ∷⁻ : ∀ {a as b bs} → Sublist R (a ∷ as) (b ∷ bs) → Sublist R as bs ∷⁻ (y ∷ʳ rs) = ∷ˡ⁻ rs ∷⁻ (x ∷ rs) = rs module _ {a b c d r} {A : Set a} {B : Set b} {C : Set c} {D : Set d} {R : REL C D r} where ------------------------------------------------------------------------ -- map map⁺ : ∀ {as bs} (f : A → C) (g : B → D) → Sublist (λ a b → R (f a) (g b)) as bs → Sublist R (List.map f as) (List.map g bs) map⁺ f g [] = [] map⁺ f g (y ∷ʳ rs) = g y ∷ʳ map⁺ f g rs map⁺ f g (r ∷ rs) = r ∷ map⁺ f g rs map⁻ : ∀ {as bs} (f : A → C) (g : B → D) → Sublist R (List.map f as) (List.map g bs) → Sublist (λ a b → R (f a) (g b)) as bs map⁻ {[]} {bs} f g rs = minimum _ map⁻ {a ∷ as} {b ∷ bs} f g (_ ∷ʳ rs) = b ∷ʳ map⁻ f g rs map⁻ {a ∷ as} {b ∷ bs} f g (r ∷ rs) = r ∷ map⁻ f g rs module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ------------------------------------------------------------------------ -- _++_ ++⁺ : ∀ {as bs cs ds} → Sublist R as bs → Sublist R cs ds → Sublist R (as ++ cs) (bs ++ ds) ++⁺ [] cds = cds ++⁺ (y ∷ʳ abs) cds = y ∷ʳ ++⁺ abs cds ++⁺ (ab ∷ abs) cds = ab ∷ ++⁺ abs cds ++⁻ : ∀ {as bs cs ds} → length as ≡ length bs → Sublist R (as ++ cs) (bs ++ ds) → Sublist R cs ds ++⁻ {[]} {[]} eq rs = rs ++⁻ {a ∷ as} {b ∷ bs} eq rs = ++⁻ (ℕₚ.suc-injective eq) (∷⁻ rs) ++ˡ : ∀ {as bs} (cs : List B) → Sublist R as bs → Sublist R as (cs ++ bs) ++ˡ zs = ++⁺ (minimum zs) ++ʳ : ∀ {as bs} (cs : List B) → Sublist R as bs → Sublist R as (bs ++ cs) ++ʳ cs [] = minimum cs ++ʳ cs (y ∷ʳ rs) = y ∷ʳ ++ʳ cs rs ++ʳ cs (r ∷ rs) = r ∷ ++ʳ cs rs ------------------------------------------------------------------------ -- concat concat⁺ : ∀ {ass bss} → Sublist (Sublist R) ass bss → Sublist R (concat ass) (concat bss) concat⁺ [] = [] concat⁺ (y ∷ʳ rss) = ++ˡ y (concat⁺ rss) concat⁺ (rs ∷ rss) = ++⁺ rs (concat⁺ rss) ------------------------------------------------------------------------ -- take / drop take⁺ : ∀ {m n as bs} → m ≤ n → Pointwise R as bs → Sublist R (take m as) (take n bs) take⁺ z≤n ps = minimum _ take⁺ (s≤s m≤n) [] = [] take⁺ (s≤s m≤n) (p ∷ ps) = p ∷ take⁺ m≤n ps drop⁺ : ∀ {m n as bs} → m ≥ n → Sublist R as bs → Sublist R (drop m as) (drop n bs) drop⁺ {m} z≤n rs = drop-Sublist m rs drop⁺ (s≤s m≥n) [] = [] drop⁺ (s≤s m≥n) (y ∷ʳ rs) = drop⁺ (ℕₚ.≤-step m≥n) rs drop⁺ (s≤s m≥n) (r ∷ rs) = drop⁺ m≥n rs drop⁺-≥ : ∀ {m n as bs} → m ≥ n → Pointwise R as bs → Sublist R (drop m as) (drop n bs) drop⁺-≥ m≥n pw = drop⁺ m≥n (fromPointwise pw) drop⁺-⊆ : ∀ {as bs} m → Sublist R as bs → Sublist R (drop m as) (drop m bs) drop⁺-⊆ m = drop⁺ (ℕₚ.≤-refl {m}) module _ {a b r p q} {A : Set a} {B : Set b} {R : REL A B r} {P : Pred A p} {Q : Pred B q} (P? : U.Decidable P) (Q? : U.Decidable Q) where ⊆-takeWhile-Sublist : ∀ {as bs} → (∀ {a b} → R a b → P a → Q b) → Pointwise R as bs → Sublist R (takeWhile P? as) (takeWhile Q? bs) ⊆-takeWhile-Sublist rp⇒q [] = [] ⊆-takeWhile-Sublist {a ∷ as} {b ∷ bs} rp⇒q (p ∷ ps) with P? a | Q? b ... | false because _ | _ = minimum _ ... | true because _ | true because _ = p ∷ ⊆-takeWhile-Sublist rp⇒q ps ... | yes pa | no ¬qb = ⊥-elim $ ¬qb $ rp⇒q p pa ⊇-dropWhile-Sublist : ∀ {as bs} → (∀ {a b} → R a b → Q b → P a) → Pointwise R as bs → Sublist R (dropWhile P? as) (dropWhile Q? bs) ⊇-dropWhile-Sublist rq⇒p [] = [] ⊇-dropWhile-Sublist {a ∷ as} {b ∷ bs} rq⇒p (p ∷ ps) with P? a | Q? b ... | true because _ | true because _ = ⊇-dropWhile-Sublist rq⇒p ps ... | true because _ | false because _ = b ∷ʳ dropWhile-Sublist P? (fromPointwise ps) ... | false because _ | false because _ = p ∷ fromPointwise ps ... | no ¬pa | yes qb = ⊥-elim $ ¬pa $ rq⇒p p qb ⊆-filter-Sublist : ∀ {as bs} → (∀ {a b} → R a b → P a → Q b) → Sublist R as bs → Sublist R (filter P? as) (filter Q? bs) ⊆-filter-Sublist rp⇒q [] = [] ⊆-filter-Sublist rp⇒q (y ∷ʳ rs) with does (Q? y) ... | true = y ∷ʳ ⊆-filter-Sublist rp⇒q rs ... | false = ⊆-filter-Sublist rp⇒q rs ⊆-filter-Sublist {a ∷ as} {b ∷ bs} rp⇒q (r ∷ rs) with P? a | Q? b ... | true because _ | true because _ = r ∷ ⊆-filter-Sublist rp⇒q rs ... | false because _ | true because _ = _ ∷ʳ ⊆-filter-Sublist rp⇒q rs ... | false because _ | false because _ = ⊆-filter-Sublist rp⇒q rs ... | yes pa | no ¬qb = ⊥-elim $ ¬qb $ rp⇒q r pa module _ {a r p} {A : Set a} {R : Rel A r} {P : Pred A p} (P? : U.Decidable P) where takeWhile-filter : ∀ {as} → Pointwise R as as → Sublist R (takeWhile P? as) (filter P? as) takeWhile-filter [] = [] takeWhile-filter {a ∷ as} (p ∷ ps) with does (P? a) ... | true = p ∷ takeWhile-filter ps ... | false = minimum _ filter-dropWhile : ∀ {as} → Pointwise R as as → Sublist R (filter P? as) (dropWhile (¬? ∘ P?) as) filter-dropWhile [] = [] filter-dropWhile {a ∷ as} (p ∷ ps) with does (P? a) ... | true = p ∷ filter-Sublist P? (fromPointwise ps) ... | false = filter-dropWhile ps ------------------------------------------------------------------------ -- reverse module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where reverseAcc⁺ : ∀ {as bs cs ds} → Sublist R as bs → Sublist R cs ds → Sublist R (reverseAcc cs as) (reverseAcc ds bs) reverseAcc⁺ [] cds = cds reverseAcc⁺ (y ∷ʳ abs) cds = reverseAcc⁺ abs (y ∷ʳ cds) reverseAcc⁺ (r ∷ abs) cds = reverseAcc⁺ abs (r ∷ cds) ʳ++⁺ : ∀ {as bs cs ds} → Sublist R as bs → Sublist R cs ds → Sublist R (as ʳ++ cs) (bs ʳ++ ds) ʳ++⁺ = reverseAcc⁺ reverse⁺ : ∀ {as bs} → Sublist R as bs → Sublist R (reverse as) (reverse bs) reverse⁺ rs = reverseAcc⁺ rs [] reverse⁻ : ∀ {as bs} → Sublist R (reverse as) (reverse bs) → Sublist R as bs reverse⁻ {as} {bs} p = cast (reverse⁺ p) where cast = P.subst₂ (Sublist R) (Lₚ.reverse-involutive as) (Lₚ.reverse-involutive bs) ------------------------------------------------------------------------ -- Inversion lemmas module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} {a as b bs} where ∷⁻¹ : R a b → Sublist R as bs ⇔ Sublist R (a ∷ as) (b ∷ bs) ∷⁻¹ r = equivalence (r ∷_) ∷⁻ ∷ʳ⁻¹ : ¬ R a b → Sublist R (a ∷ as) bs ⇔ Sublist R (a ∷ as) (b ∷ bs) ∷ʳ⁻¹ ¬r = equivalence (_ ∷ʳ_) (∷ʳ⁻ ¬r) ------------------------------------------------------------------------ -- Irrelevant special case module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where Sublist-[]-irrelevant : U.Irrelevant (Sublist R []) Sublist-[]-irrelevant [] [] = P.refl Sublist-[]-irrelevant (y ∷ʳ p) (.y ∷ʳ q) = P.cong (y ∷ʳ_) (Sublist-[]-irrelevant p q) ------------------------------------------------------------------------ -- (to/from)Any is a bijection toAny-injective : ∀ {xs x} {p q : Sublist R [ x ] xs} → toAny p ≡ toAny q → p ≡ q toAny-injective {p = y ∷ʳ p} {y ∷ʳ q} = P.cong (y ∷ʳ_) ∘′ toAny-injective ∘′ there-injective toAny-injective {p = _ ∷ p} {_ ∷ q} = P.cong₂ (flip _∷_) (Sublist-[]-irrelevant p q) ∘′ here-injective fromAny-injective : ∀ {xs x} {p q : Any (R x) xs} → fromAny {R = R} p ≡ fromAny q → p ≡ q fromAny-injective {p = here px} {here qx} = P.cong here ∘′ ∷-injectiveˡ fromAny-injective {p = there p} {there q} = P.cong there ∘′ fromAny-injective ∘′ ∷ʳ-injective toAny∘fromAny≗id : ∀ {xs x} (p : Any (R x) xs) → toAny (fromAny {R = R} p) ≡ p toAny∘fromAny≗id (here px) = P.refl toAny∘fromAny≗id (there p) = P.cong there (toAny∘fromAny≗id p) Sublist-[x]-bijection : ∀ {x xs} → (Sublist R [ x ] xs) ⤖ (Any (R x) xs) Sublist-[x]-bijection = bijection toAny fromAny toAny-injective toAny∘fromAny≗id ------------------------------------------------------------------------ -- Relational properties module Reflexivity {a r} {A : Set a} {R : Rel A r} (R-refl : Reflexive R) where reflexive : _≡_ ⇒ Sublist R reflexive P.refl = fromPointwise (Pw.refl R-refl) refl : Reflexive (Sublist R) refl = reflexive P.refl open Reflexivity public module Transitivity {a b c r s t} {A : Set a} {B : Set b} {C : Set c} {R : REL A B r} {S : REL B C s} {T : REL A C t} (rs⇒t : Trans R S T) where trans : Trans (Sublist R) (Sublist S) (Sublist T) trans rs (y ∷ʳ ss) = y ∷ʳ trans rs ss trans (y ∷ʳ rs) (s ∷ ss) = _ ∷ʳ trans rs ss trans (r ∷ rs) (s ∷ ss) = rs⇒t r s ∷ trans rs ss trans [] [] = [] open Transitivity public module Antisymmetry {a b r s e} {A : Set a} {B : Set b} {R : REL A B r} {S : REL B A s} {E : REL A B e} (rs⇒e : Antisym R S E) where open ℕₚ.≤-Reasoning antisym : Antisym (Sublist R) (Sublist S) (Pointwise E) antisym [] [] = [] antisym (r ∷ rs) (s ∷ ss) = rs⇒e r s ∷ antisym rs ss -- impossible cases antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷ʳ_ {ys₂} {zs} z ss) = ⊥-elim $ ℕₚ.<-irrefl P.refl $ begin length (y ∷ ys₁) ≤⟨ length-mono-≤ ss ⟩ length zs ≤⟨ ℕₚ.n≤1+n (length zs) ⟩ length (z ∷ zs) ≤⟨ length-mono-≤ rs ⟩ length ys₁ ∎ antisym (_∷ʳ_ {xs} {ys₁} y rs) (_∷_ {y} {ys₂} {z} {zs} s ss) = ⊥-elim $ ℕₚ.<-irrefl P.refl $ begin length (z ∷ zs) ≤⟨ length-mono-≤ rs ⟩ length ys₁ ≤⟨ length-mono-≤ ss ⟩ length zs ∎ antisym (_∷_ {x} {xs} {y} {ys₁} r rs) (_∷ʳ_ {ys₂} {zs} z ss) = ⊥-elim $ ℕₚ.<-irrefl P.refl $ begin length (y ∷ ys₁) ≤⟨ length-mono-≤ ss ⟩ length xs ≤⟨ length-mono-≤ rs ⟩ length ys₁ ∎ open Antisymmetry public module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} (R? : Decidable R) where sublist? : Decidable (Sublist R) sublist? [] ys = yes (minimum ys) sublist? (x ∷ xs) [] = no λ () sublist? (x ∷ xs) (y ∷ ys) with R? x y ... | true because [r] = Dec.map (∷⁻¹ (invert [r])) (sublist? xs ys) ... | false because [¬r] = Dec.map (∷ʳ⁻¹ (invert [¬r])) (sublist? (x ∷ xs) ys) module _ {a e r} {A : Set a} {E : Rel A e} {R : Rel A r} where isPreorder : IsPreorder E R → IsPreorder (Pointwise E) (Sublist R) isPreorder ER-isPreorder = record { isEquivalence = Pw.isEquivalence ER.isEquivalence ; reflexive = fromPointwise ∘ Pw.map ER.reflexive ; trans = trans ER.trans } where module ER = IsPreorder ER-isPreorder isPartialOrder : IsPartialOrder E R → IsPartialOrder (Pointwise E) (Sublist R) isPartialOrder ER-isPartialOrder = record { isPreorder = isPreorder ER.isPreorder ; antisym = antisym ER.antisym } where module ER = IsPartialOrder ER-isPartialOrder isDecPartialOrder : IsDecPartialOrder E R → IsDecPartialOrder (Pointwise E) (Sublist R) isDecPartialOrder ER-isDecPartialOrder = record { isPartialOrder = isPartialOrder ER.isPartialOrder ; _≟_ = Pw.decidable ER._≟_ ; _≤?_ = sublist? ER._≤?_ } where module ER = IsDecPartialOrder ER-isDecPartialOrder module _ {a e r} where preorder : Preorder a e r → Preorder _ _ _ preorder ER-preorder = record { isPreorder = isPreorder ER.isPreorder } where module ER = Preorder ER-preorder poset : Poset a e r → Poset _ _ _ poset ER-poset = record { isPartialOrder = isPartialOrder ER.isPartialOrder } where module ER = Poset ER-poset decPoset : DecPoset a e r → DecPoset _ _ _ decPoset ER-poset = record { isDecPartialOrder = isDecPartialOrder ER.isDecPartialOrder } where module ER = DecPoset ER-poset ------------------------------------------------------------------------ -- Properties of disjoint sublists module Disjointness {a b r} {A : Set a} {B : Set b} {R : REL A B r} where private infix 4 _⊆_ _⊆_ = Sublist R -- Forgetting the union DisjointUnion→Disjoint : ∀ {xs ys zs us} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : us ⊆ zs} → DisjointUnion τ₁ τ₂ τ → Disjoint τ₁ τ₂ DisjointUnion→Disjoint [] = [] DisjointUnion→Disjoint (y ∷ₙ u) = y ∷ₙ DisjointUnion→Disjoint u DisjointUnion→Disjoint (x≈y ∷ₗ u) = x≈y ∷ₗ DisjointUnion→Disjoint u DisjointUnion→Disjoint (x≈y ∷ᵣ u) = x≈y ∷ᵣ DisjointUnion→Disjoint u -- Reconstructing the union Disjoint→DisjointUnion : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → Disjoint τ₁ τ₂ → ∃₂ λ us (τ : us ⊆ zs) → DisjointUnion τ₁ τ₂ τ Disjoint→DisjointUnion [] = _ , _ , [] Disjoint→DisjointUnion (y ∷ₙ u) = _ , _ , y ∷ₙ proj₂ (proj₂ (Disjoint→DisjointUnion u)) Disjoint→DisjointUnion (x≈y ∷ₗ u) = _ , _ , x≈y ∷ₗ proj₂ (proj₂ (Disjoint→DisjointUnion u)) Disjoint→DisjointUnion (x≈y ∷ᵣ u) = _ , _ , x≈y ∷ᵣ proj₂ (proj₂ (Disjoint→DisjointUnion u)) -- Disjoint is decidable ⊆-disjoint? : ∀ {xs ys zs} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → Dec (Disjoint τ₁ τ₂) ⊆-disjoint? [] [] = yes [] -- Present in both sublists: not disjoint. ⊆-disjoint? (x≈z ∷ τ₁) (y≈z ∷ τ₂) = no λ() -- Present in either sublist: ok. ⊆-disjoint? (y ∷ʳ τ₁) (x≈y ∷ τ₂) = Dec.map′ (x≈y ∷ᵣ_) (λ{ (_ ∷ᵣ d) → d }) (⊆-disjoint? τ₁ τ₂) ⊆-disjoint? (x≈y ∷ τ₁) (y ∷ʳ τ₂) = Dec.map′ (x≈y ∷ₗ_) (λ{ (_ ∷ₗ d) → d }) (⊆-disjoint? τ₁ τ₂) -- Present in neither sublist: ok. ⊆-disjoint? (y ∷ʳ τ₁) (.y ∷ʳ τ₂) = Dec.map′ (y ∷ₙ_) (λ{ (_ ∷ₙ d) → d }) (⊆-disjoint? τ₁ τ₂) -- Disjoint is proof-irrelevant Disjoint-irrelevant : ∀{xs ys zs} → Irrelevant (Disjoint {R = R} {xs} {ys} {zs}) Disjoint-irrelevant [] [] = P.refl Disjoint-irrelevant (y ∷ₙ d₁) (.y ∷ₙ d₂) = P.cong (y ∷ₙ_) (Disjoint-irrelevant d₁ d₂) Disjoint-irrelevant (x≈y ∷ₗ d₁) (.x≈y ∷ₗ d₂) = P.cong (x≈y ∷ₗ_) (Disjoint-irrelevant d₁ d₂) Disjoint-irrelevant (x≈y ∷ᵣ d₁) (.x≈y ∷ᵣ d₂) = P.cong (x≈y ∷ᵣ_) (Disjoint-irrelevant d₁ d₂) -- Note: DisjointUnion is not proof-irrelevant unless the underlying relation R is. -- The proof is not entirely trivial, thus, we leave it for future work: -- -- DisjointUnion-irrelevant : Irrelevant R → -- ∀{xs ys us zs} {τ : us ⊆ zs} → -- Irrelevant (λ (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → DisjointUnion τ₁ τ₂ τ) -- Irreflexivity Disjoint-irrefl′ : ∀{xs ys} {τ : xs ⊆ ys} → Disjoint τ τ → Null xs Disjoint-irrefl′ [] = [] Disjoint-irrefl′ (y ∷ₙ d) = Disjoint-irrefl′ d Disjoint-irrefl : ∀{x xs ys} → Irreflexive {A = x ∷ xs ⊆ ys } _≡_ Disjoint Disjoint-irrefl P.refl x with Disjoint-irrefl′ x ... | () ∷ _ -- Symmetry DisjointUnion-sym : ∀ {xs ys xys} {zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : xys ⊆ zs} → DisjointUnion τ₁ τ₂ τ → DisjointUnion τ₂ τ₁ τ DisjointUnion-sym [] = [] DisjointUnion-sym (y ∷ₙ d) = y ∷ₙ DisjointUnion-sym d DisjointUnion-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ DisjointUnion-sym d DisjointUnion-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ DisjointUnion-sym d Disjoint-sym : ∀ {xs ys} {zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → Disjoint τ₁ τ₂ → Disjoint τ₂ τ₁ Disjoint-sym [] = [] Disjoint-sym (y ∷ₙ d) = y ∷ₙ Disjoint-sym d Disjoint-sym (x≈y ∷ₗ d) = x≈y ∷ᵣ Disjoint-sym d Disjoint-sym (x≈y ∷ᵣ d) = x≈y ∷ₗ Disjoint-sym d -- Empty sublist DisjointUnion-[]ˡ : ∀{xs ys} {ε : [] ⊆ ys} {τ : xs ⊆ ys} → DisjointUnion ε τ τ DisjointUnion-[]ˡ {ε = []} {τ = []} = [] DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ˡ DisjointUnion-[]ˡ {ε = y ∷ʳ ε} {τ = x≈y ∷ τ} = x≈y ∷ᵣ DisjointUnion-[]ˡ DisjointUnion-[]ʳ : ∀{xs ys} {ε : [] ⊆ ys} {τ : xs ⊆ ys} → DisjointUnion τ ε τ DisjointUnion-[]ʳ {ε = []} {τ = []} = [] DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = y ∷ʳ τ} = y ∷ₙ DisjointUnion-[]ʳ DisjointUnion-[]ʳ {ε = y ∷ʳ ε} {τ = x≈y ∷ τ} = x≈y ∷ₗ DisjointUnion-[]ʳ -- A sublist τ : x∷xs ⊆ ys can be split into two disjoint sublists -- [x] ⊆ ys (canonical choice) and (∷ˡ⁻ τ) : xs ⊆ ys. DisjointUnion-fromAny∘toAny-∷ˡ⁻ : ∀ {x xs ys} (τ : (x ∷ xs) ⊆ ys) → DisjointUnion (fromAny (toAny τ)) (∷ˡ⁻ τ) τ DisjointUnion-fromAny∘toAny-∷ˡ⁻ (y ∷ʳ τ) = y ∷ₙ DisjointUnion-fromAny∘toAny-∷ˡ⁻ τ DisjointUnion-fromAny∘toAny-∷ˡ⁻ (xRy ∷ τ) = xRy ∷ₗ DisjointUnion-[]ˡ -- Disjoint union of three mutually disjoint lists. -- -- τᵢⱼ denotes the disjoint union of τᵢ and τⱼ: DisjointUnion τᵢ τⱼ τᵢⱼ record DisjointUnion³ {xs ys zs ts} (τ₁ : xs ⊆ ts) (τ₂ : ys ⊆ ts) (τ₃ : zs ⊆ ts) {xys xzs yzs} (τ₁₂ : xys ⊆ ts) (τ₁₃ : xzs ⊆ ts) (τ₂₃ : yzs ⊆ ts) : Set (a ⊔ b ⊔ r) where field {union³} : List A sub³ : union³ ⊆ ts join₁ : DisjointUnion τ₁ τ₂₃ sub³ join₂ : DisjointUnion τ₂ τ₁₃ sub³ join₃ : DisjointUnion τ₃ τ₁₂ sub³ infixr 5 _∷ʳ-DisjointUnion³_ _∷₁-DisjointUnion³_ _∷₂-DisjointUnion³_ _∷₃-DisjointUnion³_ -- Weakening the target list ts of a disjoint union. _∷ʳ-DisjointUnion³_ : ∀ {xs ys zs ts} {τ₁ : xs ⊆ ts} {τ₂ : ys ⊆ ts} {τ₃ : zs ⊆ ts} → ∀ {xys xzs yzs} {τ₁₂ : xys ⊆ ts} {τ₁₃ : xzs ⊆ ts} {τ₂₃ : yzs ⊆ ts} → ∀ y → DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ → DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (y ∷ʳ τ₁₂) (y ∷ʳ τ₁₃) (y ∷ʳ τ₂₃) y ∷ʳ-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record { sub³ = y ∷ʳ σ ; join₁ = y ∷ₙ d₁ ; join₂ = y ∷ₙ d₂ ; join₃ = y ∷ₙ d₃ } -- Adding an element to the first list. _∷₁-DisjointUnion³_ : ∀ {xs ys zs ts} {τ₁ : xs ⊆ ts} {τ₂ : ys ⊆ ts} {τ₃ : zs ⊆ ts} → ∀ {xys xzs yzs} {τ₁₂ : xys ⊆ ts} {τ₁₃ : xzs ⊆ ts} {τ₂₃ : yzs ⊆ ts} → ∀ {x y} (xRy : R x y) → DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ → DisjointUnion³ (xRy ∷ τ₁) (y ∷ʳ τ₂) (y ∷ʳ τ₃) (xRy ∷ τ₁₂) (xRy ∷ τ₁₃) (y ∷ʳ τ₂₃) xRy ∷₁-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record { sub³ = xRy ∷ σ ; join₁ = xRy ∷ₗ d₁ ; join₂ = xRy ∷ᵣ d₂ ; join₃ = xRy ∷ᵣ d₃ } -- Adding an element to the second list. _∷₂-DisjointUnion³_ : ∀ {xs ys zs ts} {τ₁ : xs ⊆ ts} {τ₂ : ys ⊆ ts} {τ₃ : zs ⊆ ts} → ∀ {xys xzs yzs} {τ₁₂ : xys ⊆ ts} {τ₁₃ : xzs ⊆ ts} {τ₂₃ : yzs ⊆ ts} → ∀ {x y} (xRy : R x y) → DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ → DisjointUnion³ (y ∷ʳ τ₁) (xRy ∷ τ₂) (y ∷ʳ τ₃) (xRy ∷ τ₁₂) (y ∷ʳ τ₁₃) (xRy ∷ τ₂₃) xRy ∷₂-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record { sub³ = xRy ∷ σ ; join₁ = xRy ∷ᵣ d₁ ; join₂ = xRy ∷ₗ d₂ ; join₃ = xRy ∷ᵣ d₃ } -- Adding an element to the third list. _∷₃-DisjointUnion³_ : ∀ {xs ys zs ts} {τ₁ : xs ⊆ ts} {τ₂ : ys ⊆ ts} {τ₃ : zs ⊆ ts} → ∀ {xys xzs yzs} {τ₁₂ : xys ⊆ ts} {τ₁₃ : xzs ⊆ ts} {τ₂₃ : yzs ⊆ ts} → ∀ {x y} (xRy : R x y) → DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ → DisjointUnion³ (y ∷ʳ τ₁) (y ∷ʳ τ₂) (xRy ∷ τ₃) (y ∷ʳ τ₁₂) (xRy ∷ τ₁₃) (xRy ∷ τ₂₃) xRy ∷₃-DisjointUnion³ record{ sub³ = σ ; join₁ = d₁ ; join₂ = d₂ ; join₃ = d₃ } = record { sub³ = xRy ∷ σ ; join₁ = xRy ∷ᵣ d₁ ; join₂ = xRy ∷ᵣ d₂ ; join₃ = xRy ∷ₗ d₃ } -- Computing the disjoint union of three disjoint lists. disjointUnion³ : ∀{xs ys zs ts} {τ₁ : xs ⊆ ts} {τ₂ : ys ⊆ ts} {τ₃ : zs ⊆ ts} {xys xzs yzs} {τ₁₂ : xys ⊆ ts} {τ₁₃ : xzs ⊆ ts} {τ₂₃ : yzs ⊆ ts} → DisjointUnion τ₁ τ₂ τ₁₂ → DisjointUnion τ₁ τ₃ τ₁₃ → DisjointUnion τ₂ τ₃ τ₂₃ → DisjointUnion³ τ₁ τ₂ τ₃ τ₁₂ τ₁₃ τ₂₃ disjointUnion³ [] [] [] = record { sub³ = [] ; join₁ = [] ; join₂ = [] ; join₃ = [] } disjointUnion³ (y ∷ₙ d₁₂) (.y ∷ₙ d₁₃) (.y ∷ₙ d₂₃) = y ∷ʳ-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ disjointUnion³ (y ∷ₙ d₁₂) (xRy ∷ᵣ d₁₃) (.xRy ∷ᵣ d₂₃) = xRy ∷₃-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ disjointUnion³ (xRy ∷ᵣ d₁₂) (y ∷ₙ d₁₃) (.xRy ∷ₗ d₂₃) = xRy ∷₂-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ disjointUnion³ (xRy ∷ₗ d₁₂) (.xRy ∷ₗ d₁₃) (y ∷ₙ d₂₃) = xRy ∷₁-DisjointUnion³ disjointUnion³ d₁₂ d₁₃ d₂₃ disjointUnion³ (xRy ∷ᵣ d₁₂) (xRy′ ∷ᵣ d₁₃) () -- If a sublist τ is disjoint to two lists σ₁ and σ₂, -- then also to their disjoint union σ. disjoint⇒disjoint-to-union : ∀{xs ys zs yzs ts} {τ : xs ⊆ ts} {σ₁ : ys ⊆ ts} {σ₂ : zs ⊆ ts} {σ : yzs ⊆ ts} → Disjoint τ σ₁ → Disjoint τ σ₂ → DisjointUnion σ₁ σ₂ σ → Disjoint τ σ disjoint⇒disjoint-to-union d₁ d₂ u = let _ , _ , u₁ = Disjoint→DisjointUnion d₁ _ , _ , u₂ = Disjoint→DisjointUnion d₂ in DisjointUnion→Disjoint (DisjointUnion³.join₁ (disjointUnion³ u₁ u₂ u)) open Disjointness public -- Monotonicity of disjointness. module DisjointnessMonotonicity {a b c r s t} {A : Set a} {B : Set b} {C : Set c} {R : REL A B r} {S : REL B C s} {T : REL A C t} (rs⇒t : Trans R S T) where -- We can enlarge and convert the target list of a disjoint union. weakenDisjointUnion : ∀ {xs ys xys zs ws} {τ₁ : Sublist R xs zs} {τ₂ : Sublist R ys zs} {τ : Sublist R xys zs} (σ : Sublist S zs ws) → DisjointUnion τ₁ τ₂ τ → DisjointUnion (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) (trans rs⇒t τ σ) weakenDisjointUnion [] [] = [] weakenDisjointUnion (w ∷ʳ σ) d = w ∷ₙ weakenDisjointUnion σ d weakenDisjointUnion (_ ∷ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjointUnion σ d weakenDisjointUnion (zSw ∷ σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjointUnion σ d weakenDisjointUnion (zSw ∷ σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjointUnion σ d weakenDisjoint : ∀ {xs ys zs ws} {τ₁ : Sublist R xs zs} {τ₂ : Sublist R ys zs} (σ : Sublist S zs ws) → Disjoint τ₁ τ₂ → Disjoint (trans rs⇒t τ₁ σ) (trans rs⇒t τ₂ σ) weakenDisjoint [] [] = [] weakenDisjoint (w ∷ʳ σ) d = w ∷ₙ weakenDisjoint σ d weakenDisjoint (_ ∷ σ) (y ∷ₙ d) = _ ∷ₙ weakenDisjoint σ d weakenDisjoint (zSw ∷ σ) (xRz ∷ₗ d) = rs⇒t xRz zSw ∷ₗ weakenDisjoint σ d weakenDisjoint (zSw ∷ σ) (yRz ∷ᵣ d) = rs⇒t yRz zSw ∷ᵣ weakenDisjoint σ d -- Lists remain disjoint when elements are removed. shrinkDisjoint : ∀ {us vs xs ys zs} (σ₁ : Sublist R us xs) {τ₁ : Sublist S xs zs} (σ₂ : Sublist R vs ys) {τ₂ : Sublist S ys zs} → Disjoint τ₁ τ₂ → Disjoint (trans rs⇒t σ₁ τ₁) (trans rs⇒t σ₂ τ₂) shrinkDisjoint σ₁ σ₂ (y ∷ₙ d) = y ∷ₙ shrinkDisjoint σ₁ σ₂ d shrinkDisjoint (x ∷ʳ σ₁) σ₂ (xSz ∷ₗ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d shrinkDisjoint (uRx ∷ σ₁) σ₂ (xSz ∷ₗ d) = rs⇒t uRx xSz ∷ₗ shrinkDisjoint σ₁ σ₂ d shrinkDisjoint σ₁ (y ∷ʳ σ₂) (ySz ∷ᵣ d) = _ ∷ₙ shrinkDisjoint σ₁ σ₂ d shrinkDisjoint σ₁ (vRy ∷ σ₂) (ySz ∷ᵣ d) = rs⇒t vRy ySz ∷ᵣ shrinkDisjoint σ₁ σ₂ d shrinkDisjoint [] [] [] = [] open DisjointnessMonotonicity public agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Heterogeneous/Solver.agda000066400000000000000000000122301451211343400275760ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A solver for proving that one list is a sublist of the other. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel; Reflexive; Decidable) module Data.List.Relation.Binary.Sublist.Heterogeneous.Solver {a r} {A : Set a} (R : Rel A r) (R-refl : Reflexive R) (R? : Decidable R) where -- Note that we only need the above two constraints to define the -- solver itself. The data structures do not depend on them. However, -- having the whole module parametrised by them means that we can -- instantiate them upon import. open import Level using (_⊔_) open import Data.Fin as Fin open import Data.Maybe.Base as M open import Data.Nat.Base as Nat using (ℕ) open import Data.Product open import Data.Vec.Base as Vec using (Vec ; lookup) open import Data.List hiding (lookup) open import Data.List.Properties open import Data.List.Relation.Binary.Sublist.Heterogeneous hiding (lookup) open import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; _≗_; sym; cong; cong₂; subst₂) open import Relation.Nullary open P.≡-Reasoning infix 4 _⊆I_ _⊆R_ _⊆T_ ------------------------------------------------------------------------ -- Reified list expressions -- Basic building blocks: variables and values data Item (n : ℕ) : Set a where var : Fin n → Item n val : A → Item n -- Abstract Syntax Trees infixr 5 _<>_ data TList (n : ℕ) : Set a where It : Item n → TList n _<>_ : TList n → TList n → TList n [] : TList n -- Equivalent linearised representation RList : ∀ n → Set a RList n = List (Item n) -- Semantics ⟦_⟧I : ∀ {n} → Item n → Vec (List A) n → List A ⟦ var k ⟧I ρ = lookup ρ k ⟦ val a ⟧I ρ = [ a ] ⟦_⟧T : ∀ {n} → TList n → Vec (List A) n → List A ⟦ It it ⟧T ρ = ⟦ it ⟧I ρ ⟦ t <> u ⟧T ρ = ⟦ t ⟧T ρ ++ ⟦ u ⟧T ρ ⟦ [] ⟧T ρ = [] ⟦_⟧R : ∀ {n} → RList n → Vec (List A) n → List A ⟦ [] ⟧R ρ = [] ⟦ x ∷ xs ⟧R ρ = ⟦ x ⟧I ρ ++ ⟦ xs ⟧R ρ -- Orders data _⊆I_ {n} : (d e : Item n) → Set (a ⊔ r) where var : ∀ {k l} → k ≡ l → var k ⊆I var l val : ∀ {a b} → R a b → val a ⊆I val b _⊆T_ : ∀ {n} → (d e : TList n) → Set (a ⊔ r) d ⊆T e = ∀ ρ → Sublist R (⟦ d ⟧T ρ) (⟦ e ⟧T ρ) _⊆R_ : ∀ {n} (d e : RList n) → Set (a ⊔ r) d ⊆R e = ∀ ρ → Sublist R (⟦ d ⟧R ρ) (⟦ e ⟧R ρ) -- Flattening in a semantics-respecting manner ⟦++⟧R : ∀ {n} xs ys (ρ : Vec (List A) n) → ⟦ xs ++ ys ⟧R ρ ≡ ⟦ xs ⟧R ρ ++ ⟦ ys ⟧R ρ ⟦++⟧R [] ys ρ = P.refl ⟦++⟧R (x ∷ xs) ys ρ = begin ⟦ x ⟧I ρ ++ ⟦ xs ++ ys ⟧R ρ ≡⟨ cong (⟦ x ⟧I ρ ++_) (⟦++⟧R xs ys ρ) ⟩ ⟦ x ⟧I ρ ++ ⟦ xs ⟧R ρ ++ ⟦ ys ⟧R ρ ≡⟨ sym $ ++-assoc (⟦ x ⟧I ρ) (⟦ xs ⟧R ρ) (⟦ ys ⟧R ρ) ⟩ (⟦ x ⟧I ρ ++ ⟦ xs ⟧R ρ) ++ ⟦ ys ⟧R ρ ∎ flatten : ∀ {n} (t : TList n) → Σ[ r ∈ RList n ] ⟦ r ⟧R ≗ ⟦ t ⟧T flatten [] = [] , λ _ → P.refl flatten (It it) = it ∷ [] , λ ρ → ++-identityʳ (⟦ It it ⟧T ρ) flatten (t <> u) = let (rt , eqt) = flatten t (ru , equ) = flatten u in rt ++ ru , λ ρ → begin ⟦ rt ++ ru ⟧R ρ ≡⟨ ⟦++⟧R rt ru ρ ⟩ ⟦ rt ⟧R ρ ++ ⟦ ru ⟧R ρ ≡⟨ cong₂ _++_ (eqt ρ) (equ ρ) ⟩ ⟦ t ⟧T ρ ++ ⟦ u ⟧T ρ ≡⟨⟩ ⟦ t <> u ⟧T ρ ∎ ------------------------------------------------------------------------ -- Solver for the sublist problem -- auxiliary lemmas private keep-it : ∀ {n a b} → a ⊆I b → (xs ys : RList n) → xs ⊆R ys → (a ∷ xs) ⊆R (b ∷ ys) keep-it (var a≡b) xs ys hyp ρ = ++⁺ (reflexive R-refl (cong _ a≡b)) (hyp ρ) keep-it (val rab) xs ys hyp ρ = rab ∷ hyp ρ skip-it : ∀ {n} it (d e : RList n) → d ⊆R e → d ⊆R (it ∷ e) skip-it it d ys hyp ρ = ++ˡ (⟦ it ⟧I ρ) (hyp ρ) -- Solver for items solveI : ∀ {n} (a b : Item n) → Maybe (a ⊆I b) solveI (var k) (var l) = M.map var $ decToMaybe (k Fin.≟ l) solveI (val a) (val b) = M.map val $ decToMaybe (R? a b) solveI _ _ = nothing -- Solver for linearised expressions solveR : ∀ {n} (d e : RList n) → Maybe (d ⊆R e) -- trivial solveR [] e = just (λ ρ → minimum _) solveR d [] = nothing -- actual work solveR (a ∷ d) (b ∷ e) with solveI a b ... | just it = M.map (keep-it it d e) (solveR d e) ... | nothing = M.map (skip-it b (a ∷ d) e) (solveR (a ∷ d) e) -- Coming back to ASTs thanks to flatten solveT : ∀ {n} (t u : TList n) → Maybe (t ⊆T u) solveT t u = let (rt , eqt) = flatten t (ru , equ) = flatten u in case solveR rt ru of λ where (just hyp) → just (λ ρ → subst₂ (Sublist R) (eqt ρ) (equ ρ) (hyp ρ)) nothing → nothing -- Prover for ASTs prove : ∀ {n} (d e : TList n) → From-just (solveT d e) prove d e = from-just (solveT d e) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional.agda000066400000000000000000000127231451211343400263610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the sublist relation. This is commonly -- known as Order Preserving Embeddings (OPE). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Sublist.Propositional {a} {A : Set a} where open import Data.List.Base using (List) open import Data.List.Relation.Binary.Equality.Propositional using (≋⇒≡) import Data.List.Relation.Binary.Sublist.Setoid as SetoidSublist open import Data.List.Relation.Unary.Any using (Any) open import Relation.Binary open import Relation.Binary.PropositionalEquality open import Relation.Unary using (Pred) ------------------------------------------------------------------------ -- Re-export definition and operations from setoid sublists open SetoidSublist (setoid A) public hiding (lookup; ⊆-reflexive; ⊆-antisym ; ⊆-isPreorder; ⊆-isPartialOrder ; ⊆-preorder; ⊆-poset ) ------------------------------------------------------------------------ -- Additional operations module _ {p} {P : Pred A p} where lookup : ∀ {xs ys} → xs ⊆ ys → Any P xs → Any P ys lookup = SetoidSublist.lookup (setoid A) (subst _) ------------------------------------------------------------------------ -- Relational properties ⊆-reflexive : _≡_ ⇒ _⊆_ ⊆-reflexive refl = ⊆-refl ⊆-antisym : Antisymmetric _≡_ _⊆_ ⊆-antisym xs⊆ys ys⊆xs = ≋⇒≡ (SetoidSublist.⊆-antisym (setoid A) xs⊆ys ys⊆xs) ⊆-isPreorder : IsPreorder _≡_ _⊆_ ⊆-isPreorder = record { isEquivalence = isEquivalence ; reflexive = ⊆-reflexive ; trans = ⊆-trans } ⊆-isPartialOrder : IsPartialOrder _≡_ _⊆_ ⊆-isPartialOrder = record { isPreorder = ⊆-isPreorder ; antisym = ⊆-antisym } ⊆-preorder : Preorder a a a ⊆-preorder = record { isPreorder = ⊆-isPreorder } ⊆-poset : Poset a a a ⊆-poset = record { isPartialOrder = ⊆-isPartialOrder } ------------------------------------------------------------------------ -- Separating two sublists -- -- Two possibly overlapping sublists τ : xs ⊆ zs and σ : ys ⊆ zs -- can be turned into disjoint lists τρ : xs ⊆ zs and τρ : ys ⊆ zs′ -- by duplicating all entries of zs that occur both in xs and ys, -- resulting in an extension ρ : zs ⊆ zs′ of zs. record Separation {xs ys zs} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) : Set a where field {inflation} : List A separator₁ : zs ⊆ inflation separator₂ : zs ⊆ inflation separated₁ = ⊆-trans τ₁ separator₁ separated₂ = ⊆-trans τ₂ separator₂ field disjoint : Disjoint separated₁ separated₂ infixr 5 _∷ₙ-Sep_ _∷ₗ-Sep_ _∷ᵣ-Sep_ -- Empty separation []-Sep : Separation [] [] []-Sep = record { separator₁ = [] ; separator₂ = [] ; disjoint = [] } -- Weaken a separation _∷ₙ-Sep_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → ∀ z → Separation τ₁ τ₂ → Separation (z ∷ʳ τ₁) (z ∷ʳ τ₂) z ∷ₙ-Sep record{ separator₁ = ρ₁; separator₂ = ρ₂; disjoint = d } = record { separator₁ = refl ∷ ρ₁ ; separator₂ = refl ∷ ρ₂ ; disjoint = z ∷ₙ d } -- Extend a separation by an element of the first sublist. -- -- Note: this requires a category law from the underlying equality, -- trans x=z refl = x=z, thus, separation is not available for Sublist.Setoid. _∷ₗ-Sep_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → ∀ {x z} (x≡z : x ≡ z) → Separation τ₁ τ₂ → Separation (x≡z ∷ τ₁) (z ∷ʳ τ₂) refl ∷ₗ-Sep record{ separator₁ = ρ₁; separator₂ = ρ₂; disjoint = d } = record { separator₁ = refl ∷ ρ₁ ; separator₂ = refl ∷ ρ₂ ; disjoint = refl ∷ₗ d } -- Extend a separation by an element of the second sublist. _∷ᵣ-Sep_ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → ∀ {y z} (y≡z : y ≡ z) → Separation τ₁ τ₂ → Separation (z ∷ʳ τ₁) (y≡z ∷ τ₂) refl ∷ᵣ-Sep record{ separator₁ = ρ₁; separator₂ = ρ₂; disjoint = d } = record { separator₁ = refl ∷ ρ₁ ; separator₂ = refl ∷ ρ₂ ; disjoint = refl ∷ᵣ d } -- Extend a separation by a common element of both sublists. -- -- Left-biased: the left separator gets the first copy -- of the common element. ∷-Sepˡ : ∀ {xs ys zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → ∀ {x y z} (x≡z : x ≡ z) (y≡z : y ≡ z) → Separation τ₁ τ₂ → Separation (x≡z ∷ τ₁) (y≡z ∷ τ₂) ∷-Sepˡ refl refl record{ separator₁ = ρ₁; separator₂ = ρ₂; disjoint = d } = record { separator₁ = _ ∷ʳ refl ∷ ρ₁ ; separator₂ = refl ∷ _ ∷ʳ ρ₂ ; disjoint = refl ∷ᵣ (refl ∷ₗ d) } -- Left-biased separation of two sublists. Of common elements, -- the first sublist receives the first copy. separateˡ : ∀ {xs ys zs} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) → Separation τ₁ τ₂ separateˡ [] [] = []-Sep separateˡ (z ∷ʳ τ₁) (z ∷ʳ τ₂) = z ∷ₙ-Sep separateˡ τ₁ τ₂ separateˡ (z ∷ʳ τ₁) (y≡z ∷ τ₂) = y≡z ∷ᵣ-Sep separateˡ τ₁ τ₂ separateˡ (x≡z ∷ τ₁) (z ∷ʳ τ₂) = x≡z ∷ₗ-Sep separateˡ τ₁ τ₂ separateˡ (x≡z ∷ τ₁) (y≡z ∷ τ₂) = ∷-Sepˡ x≡z y≡z (separateˡ τ₁ τ₂) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional/000077500000000000000000000000001451211343400255365ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional/Disjoint.agda000066400000000000000000000052671451211343400301510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sublist-related properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Sublist.Propositional.Disjoint {a} {A : Set a} where open import Data.List.Base using (List) open import Data.List.Relation.Binary.Sublist.Propositional open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong) ------------------------------------------------------------------------ -- A Union where the triangles commute is a -- Cospan in the slice category (_ ⊆ zs). record IsCospan {xs ys zs : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} (u : UpperBound τ₁ τ₂) : Set a where field tri₁ : ⊆-trans (UpperBound.inj₁ u) (UpperBound.sub u) ≡ τ₁ tri₂ : ⊆-trans (UpperBound.inj₂ u) (UpperBound.sub u) ≡ τ₂ record Cospan {xs ys zs : List A} (τ₁ : xs ⊆ zs) (τ₂ : ys ⊆ zs) : Set a where field upperBound : UpperBound τ₁ τ₂ isCospan : IsCospan upperBound open UpperBound upperBound public open IsCospan isCospan public open IsCospan open Cospan module _ {x : A} {xs ys zs : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} (d : Disjoint τ₁ τ₂) (c : IsCospan (⊆-disjoint-union d)) where ∷ₙ-cospan : IsCospan (⊆-disjoint-union (x ∷ₙ d)) ∷ₙ-cospan = record { tri₁ = cong (x ∷ʳ_) (c .tri₁) ; tri₂ = cong (x ∷ʳ_) (c .tri₂) } ∷ₗ-cospan : IsCospan (⊆-disjoint-union (refl {x = x} ∷ₗ d)) ∷ₗ-cospan = record { tri₁ = cong (refl ∷_) (c .tri₁) ; tri₂ = cong (x ∷ʳ_) (c .tri₂) } ∷ᵣ-cospan : IsCospan (⊆-disjoint-union (refl {x = x} ∷ᵣ d)) ∷ᵣ-cospan = record { tri₁ = cong (x ∷ʳ_) (c .tri₁) ; tri₂ = cong (refl ∷_) (c .tri₂) } ⊆-disjoint-union-is-cospan : ∀ {xs ys zs : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → (d : Disjoint τ₁ τ₂) → IsCospan (⊆-disjoint-union d) ⊆-disjoint-union-is-cospan [] = record { tri₁ = refl ; tri₂ = refl } ⊆-disjoint-union-is-cospan (x ∷ₙ d) = ∷ₙ-cospan d (⊆-disjoint-union-is-cospan d) ⊆-disjoint-union-is-cospan (refl ∷ₗ d) = ∷ₗ-cospan d (⊆-disjoint-union-is-cospan d) ⊆-disjoint-union-is-cospan (refl ∷ᵣ d) = ∷ᵣ-cospan d (⊆-disjoint-union-is-cospan d) ⊆-disjoint-union-cospan : ∀ {xs ys zs : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} → Disjoint τ₁ τ₂ → Cospan τ₁ τ₂ ⊆-disjoint-union-cospan d = record { upperBound = ⊆-disjoint-union d ; isCospan = ⊆-disjoint-union-is-cospan d } agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional/Example/000077500000000000000000000000001451211343400271315ustar00rootroot00000000000000UniqueBoundVariables.agda000066400000000000000000000370221451211343400337630ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional/Example------------------------------------------------------------------------ -- The Agda standard library -- -- A larger example for sublists (propositional case): -- Simply-typed lambda terms with globally unique variables -- (both bound and free ones). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Sublist.Propositional.Example.UniqueBoundVariables (Base : Set) where open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; cong; subst; module ≡-Reasoning) open ≡-Reasoning open import Data.List.Base using (List; []; _∷_; [_]) open import Data.List.Membership.Propositional using (_∈_) open import Data.List.Relation.Unary.All using (Null; []) open import Data.List.Relation.Binary.Sublist.Propositional using ( _⊆_; []; _∷_; _∷ʳ_ ; ⊆-refl; ⊆-trans; minimum ; from∈; to∈; lookup ; ⊆-pushoutˡ; RawPushout ; Disjoint; DisjointUnion ; separateˡ; Separation ) open import Data.List.Relation.Binary.Sublist.Propositional.Properties using ( ∷ˡ⁻ ; ⊆-trans-assoc ; from∈∘to∈; from∈∘lookup; lookup-⊆-trans ; ⊆-pushoutˡ-is-wpo ; Disjoint→DisjointUnion; DisjointUnion→Disjoint ; Disjoint-sym; DisjointUnion-inj₁; DisjointUnion-inj₂; DisjointUnion-[]ʳ ; weakenDisjoint; weakenDisjointUnion; shrinkDisjointˡ ; disjoint⇒disjoint-to-union; DisjointUnion-fromAny∘toAny-∷ˡ⁻ ; equalize-separators ) open import Data.Product using (_,_; proj₁; proj₂) infixr 8 _⇒_ infix 1 _⊢_~_▷_ -- Simple types over a set Base of base types. data Ty : Set where base : (o : Base) → Ty _⇒_ : (a b : Ty) → Ty -- Typing contexts are lists of types. Cxt = List Ty variable a b : Ty Γ Δ : Cxt x y : a ∈ Γ -- The familiar intrinsically well-typed formulation of STLC -- where a de Bruijn index x is a pointer into the context. module DeBruijn where data Tm (Δ : Cxt) : (a : Ty) → Set where var : (x : a ∈ Δ) → Tm Δ a abs : (t : Tm (a ∷ Δ) b) → Tm Δ (a ⇒ b) app : (t : Tm Δ (a ⇒ b)) (u : Tm Δ a) → Tm Δ b -- We formalize now intrinsically well-typed STLC with -- named variables that are globally unique, i.e., -- each variable can be bound at most once. -- List of bound variables of a term. BVars = List Ty variable B : BVars noBV : Null B -- There is a single global context Γ of all variables used in the terms. -- Each list of bound variables B is a sublist of Γ. variable β βₜ βᵤ yβ β\y : B ⊆ Γ -- Named terms are parameterized by a sublist β : B ⊆ Γ of bound variables. -- Variables outside B can occur as free variables in a term. -- -- * Variables x do not contain any bound variables (Null B). -- -- * The bound variables of an application (t u) is the disjoint union -- of the bound variables βₜ of t and βᵤ of u. -- -- * The bound variables β of an abstraction λyt is the disjoint union -- of the single variable y and the bound variables β\y of t. module UniquelyNamed where data Tm (β : B ⊆ Γ) : (a : Ty) → Set where var : (noBV : Null B) (x : a ∈ Γ) → Tm β a abs : (y : a ∈ Γ) (y# : DisjointUnion (from∈ y) β\y β) (t : Tm β\y b) → Tm β (a ⇒ b) app : (t : Tm βₜ (a ⇒ b)) (u : Tm βᵤ a) (t#u : DisjointUnion βₜ βᵤ β) → Tm β b pattern var! x = var [] x -- Bound variables β : B ⊆ Γ can be considered in a larger context Γ′ -- obtained by γ : Γ ⊆ Γ′. The embedding β′ : B ⊆ Γ′ is simply the -- composition of β and γ, and terms can be coerced recursively: weakenBV : ∀ {Γ B Γ′} {β : B ⊆ Γ} (γ : Γ ⊆ Γ′) → Tm β a → Tm (⊆-trans β γ) a weakenBV γ (var noBV x) = var noBV (lookup γ x) weakenBV γ (app t u t#u) = app (weakenBV γ t) (weakenBV γ u) (weakenDisjointUnion γ t#u) weakenBV γ (abs y y# t) = abs y′ y′# (weakenBV γ t) where y′ = lookup γ y -- Typing: y′# : DisjointUnion (from∈ y′) (⊆-trans β\y γ) (⊆-trans β γ) y′# = subst (λ □ → DisjointUnion □ _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#) -- We bring de Bruijn terms into scope as Exp. open DeBruijn renaming (Tm to Exp) open UniquelyNamed variable t u : Tm β a f e : Exp Δ a -- Relating de Bruijn terms and uniquely named terms. -- -- The judgement δ ⊢ e ~ β ▷ t relates a de Bruijn term e with potentially free variables δ : Δ ⊆ Γ -- to a named term t with exact bound variables β : B ⊆ Γ. The intention is to relate exactly -- the terms with the same meaning. -- -- The judgement will imply the disjointness of Δ and B. variable δ yδ : Δ ⊆ Γ data _⊢_~_▷_ {Γ Δ : Cxt} (δ : Δ ⊆ Γ) : ∀{a} (e : Exp Δ a) {B} (β : B ⊆ Γ) (t : Tm β a) → Set where -- Free de Bruijn index x : a ∈ Δ is related to free variable y : a ∈ Γ -- if δ : Δ ⊆ Γ maps x to y. var : ∀{y} (δx≡y : lookup δ x ≡ y) (δ#β : Disjoint δ β) → δ ⊢ var x ~ β ▷ var! y -- Unnamed lambda δ ⊢ λ.e is related to named lambda y,β ▷ λy.t -- if body y,δ ⊢ e is related to body β ▷ t. abs : (y#δ : DisjointUnion (from∈ y) δ yδ) → (y#β : DisjointUnion (from∈ y) β yβ) → yδ ⊢ e ~ β ▷ t → δ ⊢ abs e ~ yβ ▷ abs y y#β t -- Application δ ⊢ f e is related to application βₜ,βᵤ ▷ t u -- if function δ ⊢ f is related to βₜ ▷ t -- and argument δ ⊢ e is related to βᵤ ▷ u. app : δ ⊢ f ~ βₜ ▷ t → δ ⊢ e ~ βᵤ ▷ u → (t#u : DisjointUnion βₜ βᵤ β) → δ ⊢ app f e ~ β ▷ app t u t#u -- A dependent substitution lemma for ~. -- Trivial, but needed because term equality t : Tm β a ≡ t′ : Tm β′ a is heterogeneous, -- or, more precisely, indexed by a sublist equality β ≡ β′. subst~ : ∀ {a Δ Γ B} {δ δ′ : Δ ⊆ Γ} {β β′ : B ⊆ Γ} {e : Exp Δ a} {t : Tm β a} {t′ : Tm β′ a} (δ≡δ′ : δ ≡ δ′) (β≡β′ : β ≡ β′) (t≡t′ : subst (λ □ → Tm □ a) β≡β′ t ≡ t′) → δ ⊢ e ~ β ▷ t → δ′ ⊢ e ~ β′ ▷ t′ subst~ refl refl refl d = d -- The judgement δ ⊢ e ~ β ▷ t relative to Γ -- can be transported to a bigger context γ : Γ ⊆ Γ′. weaken~ : ∀{a Δ B Γ Γ′} {δ : Δ ⊆ Γ} {β : B ⊆ Γ} {e : Exp Δ a} {t : Tm β a} (γ : Γ ⊆ Γ′) (let δ′ = ⊆-trans δ γ) (let β′ = ⊆-trans β γ) (let t′ = weakenBV γ t) → δ ⊢ e ~ β ▷ t → δ′ ⊢ e ~ β′ ▷ t′ weaken~ γ (var refl δ#β) = var (lookup-⊆-trans γ _) (weakenDisjoint γ δ#β) weaken~ γ (abs y#δ y#β d) = abs y′#δ′ y′#β′ (weaken~ γ d) where y′#δ′ = subst (λ □ → DisjointUnion □ _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#δ) y′#β′ = subst (λ □ → DisjointUnion □ _ _) (sym (from∈∘lookup _ _)) (weakenDisjointUnion γ y#β) weaken~ γ (app dₜ dᵤ t#u) = app (weaken~ γ dₜ) (weaken~ γ dᵤ) (weakenDisjointUnion γ t#u) -- Lemma: If δ ⊢ e ~ β ▷ t, then -- the (potentially) free variables δ of the de Bruijn term e -- are disjoint from the bound variables β of the named term t. disjoint-fv-bv : δ ⊢ e ~ β ▷ t → Disjoint δ β disjoint-fv-bv (var _ δ#β) = δ#β disjoint-fv-bv {β = yβ} (abs y⊎δ y⊎β d) = δ#yβ where δ#y = Disjoint-sym (DisjointUnion→Disjoint y⊎δ) yδ#β = disjoint-fv-bv d δ⊆yδ,eq = DisjointUnion-inj₂ y⊎δ δ⊆yδ = proj₁ δ⊆yδ,eq eq = proj₂ δ⊆yδ,eq δ#β = subst (λ □ → Disjoint □ _) eq (shrinkDisjointˡ δ⊆yδ yδ#β) δ#yβ = disjoint⇒disjoint-to-union δ#y δ#β y⊎β disjoint-fv-bv (app dₜ dᵤ βₜ⊎βᵤ) = disjoint⇒disjoint-to-union δ#βₜ δ#βᵤ βₜ⊎βᵤ where δ#βₜ = disjoint-fv-bv dₜ δ#βᵤ = disjoint-fv-bv dᵤ -- Translating de Bruijn terms to uniquely named terms. -- -- Given a de Bruijn term Δ ⊢ e : a, we seek to produce a named term β ▷ t : a -- that is related to the de Bruijn term. On the way, we have to compute the -- global context Γ that hosts all free and bound variables of t. -- Record (NamedOf e) collects all the outputs of the translation of e. record NamedOf (e : Exp Δ a) : Set where constructor mkNamedOf field {glob} : Cxt -- Γ emb : Δ ⊆ glob -- δ : Δ ⊆ Γ {bv} : BVars -- B bound : bv ⊆ glob -- β : B ⊆ Γ {tm} : Tm bound a -- t : Tm β a relate : emb ⊢ e ~ bound ▷ tm -- δ ⊢ e ~ β ▷ t -- The translation. dB→Named : (e : Exp Δ a) → NamedOf e -- For the translation of a variable x : a ∈ Δ, we can pick Γ := Δ and B := []. -- Δ and B are obviously disjoint subsets of Γ. dB→Named (var x) = record { emb = ⊆-refl -- Γ := Δ ; bound = minimum _ -- no bound variables ; relate = var refl (DisjointUnion→Disjoint DisjointUnion-[]ʳ) } -- For the translation of an abstraction -- -- abs (t : Exp (a ∷ Δ) b) : Exp Δ (a ⇒ b) -- -- we recursively have Γ, B and β : B ⊆ Γ with z,δ : (a ∷ Δ) ⊆ Γ -- and know that B # a∷Δ. -- -- We keep Γ and produce embedding δ : Δ ⊆ Γ and bound variables z ⊎ β. dB→Named {Δ = Δ} {a = a ⇒ b} (abs e) with dB→Named e ... | record{ glob = Γ; emb = zδ; bound = β; relate = d } = record { glob = Γ ; emb = δ̇ ; bound = proj₁ (proj₂ z⊎β) ; relate = abs [a]⊆Γ⊎δ (proj₂ (proj₂ z⊎β)) d } where -- Typings: -- zδ : a ∷ Δ ⊆ Γ -- β : bv ⊆ Γ zδ#β = disjoint-fv-bv d z : a ∈ Γ z = to∈ zδ [a]⊆Γ = from∈ z δ̇ = ∷ˡ⁻ zδ [a]⊆Γ⊎δ = DisjointUnion-fromAny∘toAny-∷ˡ⁻ zδ [a]⊆aΔ : [ a ] ⊆ (a ∷ Δ) [a]⊆aΔ = refl ∷ minimum _ eq : ⊆-trans [a]⊆aΔ zδ ≡ [a]⊆Γ eq = sym (from∈∘to∈ _) z#β : Disjoint [a]⊆Γ β z#β = subst (λ □ → Disjoint □ β) eq (shrinkDisjointˡ [a]⊆aΔ zδ#β) z⊎β = Disjoint→DisjointUnion z#β -- For the translation of an application (f e) we have by induction hypothesis -- two independent extensions δ₁ : Δ ⊆ Γ₁ and δ₂ : Δ ⊆ Γ₂ -- and two bound variable lists β₁ : B₁ ⊆ Γ₁ and β₂ : B₂ ⊆ Γ₂. -- We need to find a common global context Γ such that -- -- (a) δ : Δ ⊆ Γ and -- (b) the bound variables embed disjointly as β₁″ : B₁ ⊆ Γ and β₂″ : B₂ ⊆ Γ. -- -- (a) δ is (eventually) found via a weak pushout of δ₁ and δ₂, giving -- ϕ₁ : Γ₁ ⊆ Γ₁₂ and ϕ₂ : Γ₂ ⊆ Γ₁₂. -- -- (b) The bound variable embeddings -- -- β₁′ = β₁ϕ₁ : B₁ ⊆ Γ₁₂ and -- β₂′ = β₂ϕ₂ : B₂ ⊆ Γ₁₂ and -- -- may be overlapping, but we can separate them by enlarging the global context -- to Γ with two embeddings -- -- γ₁ : Γ₁₂ ⊆ Γ -- γ₂ : Γ₁₂ ⊆ Γ -- -- such that -- -- β₁″ = β₁′γ₁ : B₁ ⊆ Γ -- β₂″ = β₂′γ₂ : B₂ ⊆ Γ -- -- are disjoint. Since Δ is disjoint to both B₁ and B₂ we have equality of -- -- δ₁ϕ₁γ₁ : Δ ⊆ Γ -- δ₂ϕ₂γ₂ : Δ ⊆ Γ -- -- Thus, we can return either of them as δ. dB→Named (app f e) with dB→Named f | dB→Named e ... | mkNamedOf {Γ₁} δ₁ β₁ {t} d₁ | mkNamedOf {Γ₂} δ₂ β₂ {u} d₂ = mkNamedOf δ̇ β̇ (app d₁″ d₂″ β₁″⊎β₂″) where -- Disjointness of δᵢ and βᵢ from induction hypotheses. δ₁#β₁ = disjoint-fv-bv d₁ δ₂#β₂ = disjoint-fv-bv d₂ -- join δ₁ and δ₂ via weak pushout po = ⊆-pushoutˡ δ₁ δ₂ Γ₁₂ = RawPushout.upperBound po ϕ₁ = RawPushout.leg₁ po ϕ₂ = RawPushout.leg₂ po δ₁′ = ⊆-trans δ₁ ϕ₁ δ₂′ = ⊆-trans δ₂ ϕ₂ β₁′ = ⊆-trans β₁ ϕ₁ β₂′ = ⊆-trans β₂ ϕ₂ δ₁′#β₁′ : Disjoint δ₁′ β₁′ δ₁′#β₁′ = weakenDisjoint ϕ₁ δ₁#β₁ δ₂′#β₂′ : Disjoint δ₂′ β₂′ δ₂′#β₂′ = weakenDisjoint ϕ₂ δ₂#β₂ δ₁′≡δ₂′ : δ₁′ ≡ δ₂′ δ₁′≡δ₂′ = ⊆-pushoutˡ-is-wpo δ₁ δ₂ δ₂′#β₁′ : Disjoint δ₂′ β₁′ δ₂′#β₁′ = subst (λ □ → Disjoint □ β₁′) δ₁′≡δ₂′ δ₁′#β₁′ -- separate β₁ and β₂ sep : Separation β₁′ β₂′ sep = separateˡ β₁′ β₂′ γ₁ = Separation.separator₁ sep γ₂ = Separation.separator₂ sep β₁″ = Separation.separated₁ sep β₂″ = Separation.separated₂ sep -- produce their disjoint union uni = Disjoint→DisjointUnion (Separation.disjoint sep) β̇ = proj₁ (proj₂ uni) β₁″⊎β₂″ : DisjointUnion β₁″ β₂″ β̇ β₁″⊎β₂″ = proj₂ (proj₂ uni) ι₁ = DisjointUnion-inj₁ β₁″⊎β₂″ ι₂ = DisjointUnion-inj₂ β₁″⊎β₂″ -- after separation, the FVs are still disjoint from the BVs. δ₁″ = ⊆-trans δ₂′ γ₁ δ₂″ = ⊆-trans δ₂′ γ₂ δ₁″≡δ₂″ : δ₁″ ≡ δ₂″ δ₁″≡δ₂″ = equalize-separators δ₂′#β₁′ δ₂′#β₂′ δ₁″#β₁″ : Disjoint δ₁″ β₁″ δ₁″#β₁″ = weakenDisjoint γ₁ δ₂′#β₁′ δ₂″#β₂″ : Disjoint δ₂″ β₂″ δ₂″#β₂″ = weakenDisjoint γ₂ δ₂′#β₂′ δ̇ = δ₂″ δ₂″#β₁″ : Disjoint δ₂″ β₁″ δ₂″#β₁″ = subst (λ □ → Disjoint □ β₁″) δ₁″≡δ₂″ δ₁″#β₁″ δ̇#β̇ : Disjoint δ̇ β̇ δ̇#β̇ = disjoint⇒disjoint-to-union δ₂″#β₁″ δ₂″#β₂″ β₁″⊎β₂″ -- Combined weakening from Γᵢ to Γ γ₁′ = ⊆-trans ϕ₁ γ₁ γ₂′ = ⊆-trans ϕ₂ γ₂ -- Weakening and converting the first derivation. d₁′ : ⊆-trans δ₁ γ₁′ ⊢ f ~ ⊆-trans β₁ γ₁′ ▷ weakenBV γ₁′ t d₁′ = weaken~ γ₁′ d₁ δ₁≤δ̇ : ⊆-trans δ₁ γ₁′ ≡ ⊆-trans δ₂′ γ₂ δ₁≤δ̇ = begin ⊆-trans δ₁ γ₁′ ≡⟨ ⊆-trans-assoc ⟩ ⊆-trans δ₁′ γ₁ ≡⟨ cong (λ □ → ⊆-trans □ γ₁) δ₁′≡δ₂′ ⟩ ⊆-trans δ₂′ γ₁ ≡⟨⟩ δ₁″ ≡⟨ δ₁″≡δ₂″ ⟩ δ₂″ ≡⟨⟩ δ̇ ∎ β₁≤β₁″ : ⊆-trans β₁ γ₁′ ≡ β₁″ β₁≤β₁″ = ⊆-trans-assoc d₁″ : δ̇ ⊢ f ~ β₁″ ▷ subst (λ □ → Tm □ _) β₁≤β₁″ (weakenBV γ₁′ t) d₁″ = subst~ δ₁≤δ̇ β₁≤β₁″ refl d₁′ -- Weakening and converting the second derivation. d₂′ : ⊆-trans δ₂ γ₂′ ⊢ e ~ ⊆-trans β₂ γ₂′ ▷ weakenBV γ₂′ u d₂′ = weaken~ γ₂′ d₂ β₂≤β₂″ : ⊆-trans β₂ γ₂′ ≡ β₂″ β₂≤β₂″ = ⊆-trans-assoc δ₂≤δ̇ : ⊆-trans δ₂ γ₂′ ≡ δ̇ δ₂≤δ̇ = ⊆-trans-assoc d₂″ : δ̇ ⊢ e ~ β₂″ ▷ subst (λ □ → Tm □ _) β₂≤β₂″ (weakenBV γ₂′ u) d₂″ = subst~ δ₂≤δ̇ β₂≤β₂″ refl d₂′ agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Propositional/Properties.agda000066400000000000000000000301771451211343400305200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sublist-related properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Sublist.Propositional.Properties {a} {A : Set a} where open import Data.List.Base using (List; []; _∷_; map) open import Data.List.Membership.Propositional using (_∈_) open import Data.List.Relation.Unary.All using (All; []; _∷_) open import Data.List.Relation.Unary.Any using (Any; here; there) open import Data.List.Relation.Unary.Any.Properties using (here-injective; there-injective) open import Data.List.Relation.Binary.Sublist.Propositional hiding (map) import Data.List.Relation.Binary.Sublist.Setoid.Properties as SetoidProperties open import Data.Product using (∃; _,_; proj₂) open import Function.Base open import Level using (Level) open import Relation.Binary using (_Respects_) open import Relation.Binary.PropositionalEquality open import Relation.Unary using (Pred) private variable b ℓ : Level B : Set b ------------------------------------------------------------------------ -- Re-exporting setoid properties open SetoidProperties (setoid A) public hiding (map⁺) map⁺ : ∀ {as bs} (f : A → B) → as ⊆ bs → map f as ⊆ map f bs map⁺ {B = B} f = SetoidProperties.map⁺ (setoid A) (setoid B) (cong f) ------------------------------------------------------------------------ -- Category laws for _⊆_ ⊆-trans-idˡ : ∀ {xs ys : List A} {τ : xs ⊆ ys} → ⊆-trans ⊆-refl τ ≡ τ ⊆-trans-idˡ {_} {τ = [] } = refl ⊆-trans-idˡ {_} {τ = _ ∷ _} = cong (_ ∷_ ) ⊆-trans-idˡ ⊆-trans-idˡ {[]} {τ = _ ∷ʳ _} = cong (_ ∷ʳ_) ⊆-trans-idˡ ⊆-trans-idˡ {_ ∷ _} {τ = _ ∷ʳ _} = cong (_ ∷ʳ_) ⊆-trans-idˡ ⊆-trans-idʳ : ∀ {xs ys : List A} {τ : xs ⊆ ys} → ⊆-trans τ ⊆-refl ≡ τ ⊆-trans-idʳ {τ = [] } = refl ⊆-trans-idʳ {τ = _ ∷ʳ _ } = cong (_ ∷ʳ_ ) ⊆-trans-idʳ ⊆-trans-idʳ {τ = refl ∷ _} = cong (refl ∷_) ⊆-trans-idʳ -- Note: The associativity law is oriented such that rewriting with it -- may trigger reductions of ⊆-trans, which matches first on its -- second argument and then on its first argument. ⊆-trans-assoc : ∀ {ws xs ys zs : List A} {τ₁ : ws ⊆ xs} {τ₂ : xs ⊆ ys} {τ₃ : ys ⊆ zs} → ⊆-trans τ₁ (⊆-trans τ₂ τ₃) ≡ ⊆-trans (⊆-trans τ₁ τ₂) τ₃ ⊆-trans-assoc {τ₁ = _} {_} {_ ∷ʳ _} = cong (_ ∷ʳ_) ⊆-trans-assoc ⊆-trans-assoc {τ₁ = _} {_ ∷ʳ _} {_ ∷ _} = cong (_ ∷ʳ_) ⊆-trans-assoc ⊆-trans-assoc {τ₁ = _ ∷ʳ _ } {_ ∷ _} {_ ∷ _} = cong (_ ∷ʳ_) ⊆-trans-assoc ⊆-trans-assoc {τ₁ = refl ∷ _} {_ ∷ _} {_ ∷ _} = cong (_ ∷_ ) ⊆-trans-assoc ⊆-trans-assoc {τ₁ = []} {[]} {[]} = refl ------------------------------------------------------------------------ -- Laws concerning ⊆-trans and ∷ˡ⁻ ⊆-trans-∷ˡ⁻ᵣ : ∀ {y} {xs ys zs : List A} {τ : xs ⊆ ys} {σ : (y ∷ ys) ⊆ zs} → ⊆-trans τ (∷ˡ⁻ σ) ≡ ⊆-trans (y ∷ʳ τ) σ ⊆-trans-∷ˡ⁻ᵣ {σ = x ∷ σ} = refl ⊆-trans-∷ˡ⁻ᵣ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ᵣ ⊆-trans-∷ˡ⁻ₗ : ∀ {x} {xs ys zs : List A} {τ : (x ∷ xs) ⊆ ys} {σ : ys ⊆ zs} → ⊆-trans (∷ˡ⁻ τ) σ ≡ ∷ˡ⁻ (⊆-trans τ σ) ⊆-trans-∷ˡ⁻ₗ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ₗ ⊆-trans-∷ˡ⁻ₗ {τ = y ∷ʳ τ} {σ = refl ∷ σ} = cong (y ∷ʳ_) ⊆-trans-∷ˡ⁻ₗ ⊆-trans-∷ˡ⁻ₗ {τ = refl ∷ τ} {σ = refl ∷ σ} = refl ⊆-∷ˡ⁻trans-∷ : ∀ {y} {xs ys zs : List A} {τ : xs ⊆ ys} {σ : (y ∷ ys) ⊆ zs} → ∷ˡ⁻ (⊆-trans (refl ∷ τ) σ) ≡ ⊆-trans (y ∷ʳ τ) σ ⊆-∷ˡ⁻trans-∷ {σ = y ∷ʳ σ} = cong (y ∷ʳ_) ⊆-∷ˡ⁻trans-∷ ⊆-∷ˡ⁻trans-∷ {σ = refl ∷ σ} = refl ------------------------------------------------------------------------ -- Relationships to other predicates -- All P is a contravariant functor from _⊆_ to Set. All-resp-⊆ : {P : Pred A ℓ} → (All P) Respects _⊇_ All-resp-⊆ [] [] = [] All-resp-⊆ (_ ∷ʳ p) (_ ∷ xs) = All-resp-⊆ p xs All-resp-⊆ (refl ∷ p) (x ∷ xs) = x ∷ All-resp-⊆ p xs -- Any P is a covariant functor from _⊆_ to Set. Any-resp-⊆ : {P : Pred A ℓ} → (Any P) Respects _⊆_ Any-resp-⊆ = lookup ------------------------------------------------------------------------ -- Functor laws for All-resp-⊆ -- First functor law: identity. All-resp-⊆-refl : ∀ {P : Pred A ℓ} {xs : List A} → All-resp-⊆ ⊆-refl ≗ id {A = All P xs} All-resp-⊆-refl [] = refl All-resp-⊆-refl (p ∷ ps) = cong (p ∷_) (All-resp-⊆-refl ps) -- Second functor law: composition. All-resp-⊆-trans : ∀ {P : Pred A ℓ} {xs ys zs} {τ : xs ⊆ ys} (τ′ : ys ⊆ zs) → All-resp-⊆ {P = P} (⊆-trans τ τ′) ≗ All-resp-⊆ τ ∘ All-resp-⊆ τ′ All-resp-⊆-trans (_ ∷ʳ τ′) (p ∷ ps) = All-resp-⊆-trans τ′ ps All-resp-⊆-trans {τ = _ ∷ʳ _ } (refl ∷ τ′) (p ∷ ps) = All-resp-⊆-trans τ′ ps All-resp-⊆-trans {τ = refl ∷ _} (refl ∷ τ′) (p ∷ ps) = cong (p ∷_) (All-resp-⊆-trans τ′ ps) All-resp-⊆-trans {τ = [] } ([] ) [] = refl ------------------------------------------------------------------------ -- Functor laws for Any-resp-⊆ / lookup -- First functor law: identity. Any-resp-⊆-refl : ∀ {P : Pred A ℓ} {xs} → Any-resp-⊆ ⊆-refl ≗ id {A = Any P xs} Any-resp-⊆-refl (here p) = refl Any-resp-⊆-refl (there i) = cong there (Any-resp-⊆-refl i) lookup-⊆-refl = Any-resp-⊆-refl -- Second functor law: composition. Any-resp-⊆-trans : ∀ {P : Pred A ℓ} {xs ys zs} {τ : xs ⊆ ys} (τ′ : ys ⊆ zs) → Any-resp-⊆ {P = P} (⊆-trans τ τ′) ≗ Any-resp-⊆ τ′ ∘ Any-resp-⊆ τ Any-resp-⊆-trans (_ ∷ʳ τ′) i = cong there (Any-resp-⊆-trans τ′ i) Any-resp-⊆-trans {τ = _ ∷ʳ _} (_ ∷ τ′) i = cong there (Any-resp-⊆-trans τ′ i) Any-resp-⊆-trans {τ = _ ∷ _} (_ ∷ τ′) (there i) = cong there (Any-resp-⊆-trans τ′ i) Any-resp-⊆-trans {τ = refl ∷ _} (_ ∷ τ′) (here _) = refl Any-resp-⊆-trans {τ = [] } [] () lookup-⊆-trans = Any-resp-⊆-trans ------------------------------------------------------------------------ -- The `lookup` function for `xs ⊆ ys` is injective. -- -- Note: `lookup` can be seen as a strictly increasing reindexing function -- for indices into `xs`, producing indices into `ys`. lookup-injective : ∀ {P : Pred A ℓ} {xs ys} {τ : xs ⊆ ys} {i j : Any P xs} → lookup τ i ≡ lookup τ j → i ≡ j lookup-injective {τ = _ ∷ʳ _} = lookup-injective ∘′ there-injective lookup-injective {τ = x≡y ∷ _} {here _} {here _} = cong here ∘′ subst-injective x≡y ∘′ here-injective -- Note: instead of using subst-injective, we could match x≡y against refl on the lhs. -- However, this turns the following clause into a non-strict match. lookup-injective {τ = _ ∷ _} {there _} {there _} = cong there ∘′ lookup-injective ∘′ there-injective ------------------------------------------------------------------------- -- from∈ ∘ to∈ turns a sublist morphism τ : x∷xs ⊆ ys into a morphism -- [x] ⊆ ys. The same morphism is obtained by pre-composing τ with -- the canonial morphism [x] ⊆ x∷xs. -- -- Note: This lemma does not hold for Sublist.Setoid, but could hold for -- a hypothetical Sublist.Groupoid where trans refl = id. from∈∘to∈ : ∀ {x : A} {xs ys} (τ : x ∷ xs ⊆ ys) → from∈ (to∈ τ) ≡ ⊆-trans (refl ∷ minimum xs) τ from∈∘to∈ (x≡y ∷ τ) = cong (x≡y ∷_) ([]⊆-irrelevant _ _) from∈∘to∈ (y ∷ʳ τ) = cong (y ∷ʳ_) (from∈∘to∈ τ) from∈∘lookup : ∀{x : A} {xs ys} (τ : xs ⊆ ys) (i : x ∈ xs) → from∈ (lookup τ i) ≡ ⊆-trans (from∈ i) τ from∈∘lookup (y ∷ʳ τ) i = cong (y ∷ʳ_) (from∈∘lookup τ i) from∈∘lookup (_ ∷ τ) (there i) = cong (_ ∷ʳ_) (from∈∘lookup τ i) from∈∘lookup (refl ∷ τ) (here refl) = cong (refl ∷_) ([]⊆-irrelevant _ _) ------------------------------------------------------------------------ -- Weak pushout (wpo) -- A raw pushout is a weak pushout if the pushout square commutes. IsWeakPushout : ∀{xs ys zs : List A} {τ : xs ⊆ ys} {σ : xs ⊆ zs} → RawPushout τ σ → Set a IsWeakPushout {τ = τ} {σ = σ} rpo = ⊆-trans τ (RawPushout.leg₁ rpo) ≡ ⊆-trans σ (RawPushout.leg₂ rpo) -- Joining two list extensions with ⊆-pushout produces a weak pushout. ⊆-pushoutˡ-is-wpo : ∀{xs ys zs : List A} (τ : xs ⊆ ys) (σ : xs ⊆ zs) → IsWeakPushout (⊆-pushoutˡ τ σ) ⊆-pushoutˡ-is-wpo [] σ rewrite ⊆-trans-idʳ {τ = σ} = ⊆-trans-idˡ {xs = []} ⊆-pushoutˡ-is-wpo (y ∷ʳ τ) σ = cong (y ∷ʳ_) (⊆-pushoutˡ-is-wpo τ σ) ⊆-pushoutˡ-is-wpo (x≡y ∷ τ) (z ∷ʳ σ) = cong (z ∷ʳ_) (⊆-pushoutˡ-is-wpo (x≡y ∷ τ) σ) ⊆-pushoutˡ-is-wpo (refl ∷ τ) (refl ∷ σ) = cong (refl ∷_) (⊆-pushoutˡ-is-wpo τ σ) ------------------------------------------------------------------------ -- Properties of disjointness -- From τ₁ ⊎ τ₂ = τ, compute the injection ι₁ such that τ₁ = ⊆-trans ι₁ τ. DisjointUnion-inj₁ : ∀ {xs ys zs xys : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : xys ⊆ zs} → DisjointUnion τ₁ τ₂ τ → ∃ λ (ι₁ : xs ⊆ xys) → ⊆-trans ι₁ τ ≡ τ₁ DisjointUnion-inj₁ [] = [] , refl DisjointUnion-inj₁ (y ∷ₙ d) = _ , cong (y ∷ʳ_) (proj₂ (DisjointUnion-inj₁ d)) DisjointUnion-inj₁ (x≈y ∷ₗ d) = refl ∷ _ , cong (x≈y ∷_) (proj₂ (DisjointUnion-inj₁ d)) DisjointUnion-inj₁ (x≈y ∷ᵣ d) = _ ∷ʳ _ , cong (_ ∷ʳ_) (proj₂ (DisjointUnion-inj₁ d)) -- From τ₁ ⊎ τ₂ = τ, compute the injection ι₂ such that τ₂ = ⊆-trans ι₂ τ. DisjointUnion-inj₂ : ∀ {xs ys zs xys : List A} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} {τ : xys ⊆ zs} → DisjointUnion τ₁ τ₂ τ → ∃ λ (ι₂ : ys ⊆ xys) → ⊆-trans ι₂ τ ≡ τ₂ DisjointUnion-inj₂ [] = [] , refl DisjointUnion-inj₂ (y ∷ₙ d) = _ , cong (y ∷ʳ_) (proj₂ (DisjointUnion-inj₂ d)) DisjointUnion-inj₂ (x≈y ∷ᵣ d) = refl ∷ _ , cong (x≈y ∷_) (proj₂ (DisjointUnion-inj₂ d)) DisjointUnion-inj₂ (x≈y ∷ₗ d) = _ ∷ʳ _ , cong (_ ∷ʳ_) (proj₂ (DisjointUnion-inj₂ d)) -- A sublist σ disjoint to both τ₁ and τ₂ is an equalizer -- for the separators of τ₁ and τ₂. equalize-separators : ∀ {us xs ys zs : List A} {σ : us ⊆ zs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} (let s = separateˡ τ₁ τ₂) → Disjoint σ τ₁ → Disjoint σ τ₂ → ⊆-trans σ (Separation.separator₁ s) ≡ ⊆-trans σ (Separation.separator₂ s) equalize-separators [] [] = refl equalize-separators (y ∷ₙ d₁) (.y ∷ₙ d₂) = cong (y ∷ʳ_) (equalize-separators d₁ d₂) equalize-separators (y ∷ₙ d₁) (refl ∷ᵣ d₂) = cong (y ∷ʳ_) (equalize-separators d₁ d₂) equalize-separators (refl ∷ᵣ d₁) (y ∷ₙ d₂) = cong (y ∷ʳ_) (equalize-separators d₁ d₂) equalize-separators {τ₁ = refl ∷ _} {τ₂ = refl ∷ _} -- match here to work around deficiency of Agda's forcing translation (_ ∷ᵣ d₁) (_ ∷ᵣ d₂) = cong (_ ∷ʳ_) (cong (_ ∷ʳ_) (equalize-separators d₁ d₂)) equalize-separators (x≈y ∷ₗ d₁) (.x≈y ∷ₗ d₂) = cong (trans x≈y refl ∷_) (equalize-separators d₁ d₂) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Setoid.agda000066400000000000000000000220231451211343400247400ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the sublist relation with respect to a -- setoid. This is a generalisation of what is commonly known as Order -- Preserving Embeddings (OPE). ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} {-# OPTIONS --postfix-projections #-} open import Relation.Binary using (Setoid; Rel) module Data.List.Relation.Binary.Sublist.Setoid {c ℓ} (S : Setoid c ℓ) where open import Level using (_⊔_) open import Data.List.Base using (List; []; _∷_) import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality import Data.List.Relation.Binary.Sublist.Heterogeneous as Heterogeneous import Data.List.Relation.Binary.Sublist.Heterogeneous.Core as HeterogeneousCore import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties as HeterogeneousProperties open import Data.Product using (∃; ∃₂; _×_; _,_; proj₂) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary using (¬_; Dec; yes; no) open Setoid S renaming (Carrier to A) open SetoidEquality S ------------------------------------------------------------------------ -- Definition infix 4 _⊆_ _⊇_ _⊂_ _⊃_ _⊈_ _⊉_ _⊄_ _⊅_ _⊆_ : Rel (List A) (c ⊔ ℓ) _⊆_ = Heterogeneous.Sublist _≈_ _⊇_ : Rel (List A) (c ⊔ ℓ) xs ⊇ ys = ys ⊆ xs _⊂_ : Rel (List A) (c ⊔ ℓ) xs ⊂ ys = xs ⊆ ys × ¬ (xs ≋ ys) _⊃_ : Rel (List A) (c ⊔ ℓ) xs ⊃ ys = ys ⊂ xs _⊈_ : Rel (List A) (c ⊔ ℓ) xs ⊈ ys = ¬ (xs ⊆ ys) _⊉_ : Rel (List A) (c ⊔ ℓ) xs ⊉ ys = ¬ (xs ⊇ ys) _⊄_ : Rel (List A) (c ⊔ ℓ) xs ⊄ ys = ¬ (xs ⊂ ys) _⊅_ : Rel (List A) (c ⊔ ℓ) xs ⊅ ys = ¬ (xs ⊃ ys) ------------------------------------------------------------------------ -- Re-export definitions and operations from heterogeneous sublists open HeterogeneousCore _≈_ public using ([]; _∷_; _∷ʳ_) open Heterogeneous {R = _≈_} public hiding (Sublist; []; _∷_; _∷ʳ_) renaming ( toAny to to∈ ; fromAny to from∈ ) open Disjoint public using ([]) open DisjointUnion public using ([]) ------------------------------------------------------------------------ -- Relational properties holding for Setoid case ⊆-reflexive : _≋_ ⇒ _⊆_ ⊆-reflexive = HeterogeneousProperties.fromPointwise open HeterogeneousProperties.Reflexivity {R = _≈_} refl public using () renaming (refl to ⊆-refl) -- ⊆-refl : Reflexive _⊆_ open HeterogeneousProperties.Transitivity {R = _≈_} {S = _≈_} {T = _≈_} trans public using () renaming (trans to ⊆-trans) -- ⊆-trans : Transitive _⊆_ open HeterogeneousProperties.Antisymmetry {R = _≈_} {S = _≈_} (λ x≈y _ → x≈y) public using () renaming (antisym to ⊆-antisym) -- ⊆-antisym : Antisymmetric _≋_ _⊆_ ⊆-isPreorder : IsPreorder _≋_ _⊆_ ⊆-isPreorder = record { isEquivalence = ≋-isEquivalence ; reflexive = ⊆-reflexive ; trans = ⊆-trans } ⊆-isPartialOrder : IsPartialOrder _≋_ _⊆_ ⊆-isPartialOrder = record { isPreorder = ⊆-isPreorder ; antisym = ⊆-antisym } ⊆-preorder : Preorder c (c ⊔ ℓ) (c ⊔ ℓ) ⊆-preorder = record { isPreorder = ⊆-isPreorder } ⊆-poset : Poset c (c ⊔ ℓ) (c ⊔ ℓ) ⊆-poset = record { isPartialOrder = ⊆-isPartialOrder } ------------------------------------------------------------------------ -- Raw pushout -- -- The category _⊆_ does not have proper pushouts. For instance consider: -- -- τᵤ : [] ⊆ (u ∷ []) -- τᵥ : [] ⊆ (v ∷ []) -- -- Then, there are two unrelated upper bounds (u ∷ v ∷ []) and (v ∷ u ∷ []), -- since _⊆_ does not include permutations. -- -- Even though there are no unique least upper bounds, we can merge two -- extensions of a list, producing a minimial superlist of both. -- -- For the example, the left-biased merge would produce the pair: -- -- τᵤ′ : (u ∷ []) ⊆ (u ∷ v ∷ []) -- τᵥ′ : (v ∷ []) ⊆ (u ∷ v ∷ []) -- -- We call such a pair a raw pushout. It is then a weak pushout if the -- resulting square commutes, i.e.: -- -- ⊆-trans τᵤ τᵤ′ ~ ⊆-trans τᵥ τᵥ′ -- -- This requires a notion of equality _~_ on sublist morphisms. -- -- Further, commutation requires a similar commutation property -- for the underlying equality _≈_, namely -- -- trans x≈y (sym x≈y) == trans x≈z (sym x≈z) -- -- for some notion of equality _==_ for equality proofs _≈_. -- Such a property is given e.g. if _≈_ is proof irrelevant -- or forms a groupoid. record RawPushout {xs ys zs : List A} (τ : xs ⊆ ys) (σ : xs ⊆ zs) : Set (c ⊔ ℓ) where field {upperBound} : List A leg₁ : ys ⊆ upperBound leg₂ : zs ⊆ upperBound open RawPushout ------------------------------------------------------------------------ -- Extending corners of a raw pushout square -- Extending the right upper corner. infixr 5 _∷ʳ₁_ _∷ʳ₂_ _∷ʳ₁_ : ∀ {xs ys zs : List A} {τ : xs ⊆ ys} {σ : xs ⊆ zs} → (y : A) → RawPushout τ σ → RawPushout (y ∷ʳ τ) σ y ∷ʳ₁ rpo = record { leg₁ = refl ∷ leg₁ rpo ; leg₂ = y ∷ʳ leg₂ rpo } -- Extending the left lower corner. _∷ʳ₂_ : ∀ {xs ys zs : List A} {τ : xs ⊆ ys} {σ : xs ⊆ zs} → (z : A) → RawPushout τ σ → RawPushout τ (z ∷ʳ σ) z ∷ʳ₂ rpo = record { leg₁ = z ∷ʳ leg₁ rpo ; leg₂ = refl ∷ leg₂ rpo } -- Extending both of these corners with equal elements. ∷-rpo : ∀ {x y z : A} {xs ys zs : List A} {τ : xs ⊆ ys} {σ : xs ⊆ zs} → (x≈y : x ≈ y) (x≈z : x ≈ z) → RawPushout τ σ → RawPushout (x≈y ∷ τ) (x≈z ∷ σ) ∷-rpo x≈y x≈z rpo = record { leg₁ = sym x≈y ∷ leg₁ rpo ; leg₂ = sym x≈z ∷ leg₂ rpo } ------------------------------------------------------------------------ -- Left-biased pushout: add elements of left extension first. ⊆-pushoutˡ : ∀ {xs ys zs : List A} → (τ : xs ⊆ ys) (σ : xs ⊆ zs) → RawPushout τ σ ⊆-pushoutˡ [] σ = record { leg₁ = σ ; leg₂ = ⊆-refl } ⊆-pushoutˡ (y ∷ʳ τ) σ = y ∷ʳ₁ ⊆-pushoutˡ τ σ ⊆-pushoutˡ τ@(_ ∷ _) (z ∷ʳ σ) = z ∷ʳ₂ ⊆-pushoutˡ τ σ ⊆-pushoutˡ (x≈y ∷ τ) (x≈z ∷ σ) = ∷-rpo x≈y x≈z (⊆-pushoutˡ τ σ) -- Join two extensions, returning the upper bound and the diagonal -- of the pushout square. ⊆-joinˡ : ∀ {xs ys zs : List A} → (τ : xs ⊆ ys) (σ : xs ⊆ zs) → ∃ λ us → xs ⊆ us ⊆-joinˡ τ σ = upperBound rpo , ⊆-trans τ (leg₁ rpo) where rpo = ⊆-pushoutˡ τ σ ------------------------------------------------------------------------ -- Upper bound of two sublists xs,ys ⊆ zs record UpperBound {xs ys zs} (τ : xs ⊆ zs) (σ : ys ⊆ zs) : Set (c ⊔ ℓ) where field {theUpperBound} : List A sub : theUpperBound ⊆ zs inj₁ : xs ⊆ theUpperBound inj₂ : ys ⊆ theUpperBound open UpperBound infixr 5 _∷ₗ-ub_ _∷ᵣ-ub_ ∷ₙ-ub : ∀ {xs ys zs} {τ : xs ⊆ zs} {σ : ys ⊆ zs} {x} → UpperBound τ σ → UpperBound (x ∷ʳ τ) (x ∷ʳ σ) ∷ₙ-ub u = record { sub = _ ∷ʳ u .sub ; inj₁ = u .inj₁ ; inj₂ = u .inj₂ } _∷ₗ-ub_ : ∀ {xs ys zs} {τ : xs ⊆ zs} {σ : ys ⊆ zs} {x y} → (x≈y : x ≈ y) → UpperBound τ σ → UpperBound (x≈y ∷ τ) (y ∷ʳ σ) x≈y ∷ₗ-ub u = record { sub = refl ∷ u .sub ; inj₁ = x≈y ∷ u .inj₁ ; inj₂ = _ ∷ʳ u .inj₂ } _∷ᵣ-ub_ : ∀ {xs ys zs} {τ : xs ⊆ zs} {σ : ys ⊆ zs} {x y} → (x≈y : x ≈ y) → UpperBound τ σ → UpperBound (y ∷ʳ τ) (x≈y ∷ σ) x≈y ∷ᵣ-ub u = record { sub = refl ∷ u .sub ; inj₁ = _ ∷ʳ u .inj₁ ; inj₂ = x≈y ∷ u .inj₂ } ------------------------------------------------------------------------ -- Disjoint union -- -- Two non-overlapping sublists τ : xs ⊆ zs and σ : ys ⊆ zs -- can be joined in a unique way if τ and σ are respected. -- -- For instance, if τ : [x] ⊆ [x,y,x] and σ : [y] ⊆ [x,y,x] -- then the union will be [x,y] or [y,x], depending on whether -- τ picks the first x or the second one. -- -- NB: If the content of τ and σ were ignored then the union would not -- be unique. Expressing uniqueness would require a notion of equality -- of sublist proofs, which we do not (yet) have for the setoid case -- (however, for the propositional case). ⊆-disjoint-union : ∀ {xs ys zs} {τ : xs ⊆ zs} {σ : ys ⊆ zs} → Disjoint τ σ → UpperBound τ σ ⊆-disjoint-union [] = record { sub = [] ; inj₁ = [] ; inj₂ = [] } ⊆-disjoint-union (x ∷ₙ d) = ∷ₙ-ub (⊆-disjoint-union d) ⊆-disjoint-union (x≈y ∷ₗ d) = x≈y ∷ₗ-ub (⊆-disjoint-union d) ⊆-disjoint-union (x≈y ∷ᵣ d) = x≈y ∷ᵣ-ub (⊆-disjoint-union d) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Setoid/000077500000000000000000000000001451211343400241235ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Sublist/Setoid/Properties.agda000066400000000000000000000256651451211343400271130ustar00rootroot00000000000000----------------------------------------------------------------------- -- The Agda standard library -- -- Properties of the setoid sublist relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Setoid; _⇒_; _Preserves_⟶_) module Data.List.Relation.Binary.Sublist.Setoid.Properties {c ℓ} (S : Setoid c ℓ) where open import Level open import Data.List.Base hiding (_∷ʳ_) import Data.List.Relation.Binary.Equality.Setoid as SetoidEquality import Data.List.Relation.Binary.Sublist.Setoid as SetoidSublist import Data.List.Relation.Binary.Sublist.Heterogeneous.Properties as HeteroProperties import Data.List.Membership.Setoid as SetoidMembership open import Data.List.Relation.Unary.Any using (Any) import Data.Maybe.Relation.Unary.All as Maybe open import Data.Nat.Base using (_≤_; _≥_; z≤n; s≤s) import Data.Nat.Properties as ℕₚ open import Data.Product using (∃; _,_; proj₂) open import Function.Base open import Function.Bijection using (_⤖_) open import Function.Equivalence using (_⇔_) open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong) open import Relation.Unary using (Pred; Decidable; Irrelevant) open import Relation.Nullary using (¬_) open import Relation.Nullary.Negation using (¬?) open Setoid S using (_≈_; trans) renaming (Carrier to A; refl to ≈-refl) open SetoidEquality S using (_≋_; ≋-refl) open SetoidSublist S hiding (map) open SetoidMembership S using (_∈_) ------------------------------------------------------------------------ -- Injectivity of constructors ------------------------------------------------------------------------ module _ {xs ys : List A} where ∷-injectiveˡ : ∀ {x y} {px qx : x ≈ y} {pxs qxs : xs ⊆ ys} → ((x ∷ xs) ⊆ (y ∷ ys) ∋ px ∷ pxs) ≡ (qx ∷ qxs) → px ≡ qx ∷-injectiveˡ refl = refl ∷-injectiveʳ : ∀ {x y} {px qx : x ≈ y} {pxs qxs : xs ⊆ ys} → ((x ∷ xs) ⊆ (y ∷ ys) ∋ px ∷ pxs) ≡ (qx ∷ qxs) → pxs ≡ qxs ∷-injectiveʳ refl = refl ∷ʳ-injective : ∀ {y} {pxs qxs : xs ⊆ ys} → y ∷ʳ pxs ≡ y ∷ʳ qxs → pxs ≡ qxs ∷ʳ-injective refl = refl ------------------------------------------------------------------------ -- Various functions' outputs are sublists ------------------------------------------------------------------------ tail-⊆ : ∀ xs → Maybe.All (_⊆ xs) (tail xs) tail-⊆ xs = HeteroProperties.tail-Sublist ⊆-refl take-⊆ : ∀ n xs → take n xs ⊆ xs take-⊆ n xs = HeteroProperties.take-Sublist n ⊆-refl drop-⊆ : ∀ n xs → drop n xs ⊆ xs drop-⊆ n xs = HeteroProperties.drop-Sublist n ⊆-refl module _ {p} {P : Pred A p} (P? : Decidable P) where takeWhile-⊆ : ∀ xs → takeWhile P? xs ⊆ xs takeWhile-⊆ xs = HeteroProperties.takeWhile-Sublist P? ⊆-refl dropWhile-⊆ : ∀ xs → dropWhile P? xs ⊆ xs dropWhile-⊆ xs = HeteroProperties.dropWhile-Sublist P? ⊆-refl filter-⊆ : ∀ xs → filter P? xs ⊆ xs filter-⊆ xs = HeteroProperties.filter-Sublist P? ⊆-refl module _ {p} {P : Pred A p} (P? : Decidable P) where takeWhile⊆filter : ∀ xs → takeWhile P? xs ⊆ filter P? xs takeWhile⊆filter xs = HeteroProperties.takeWhile-filter P? {xs} ≋-refl filter⊆dropWhile : ∀ xs → filter P? xs ⊆ dropWhile (¬? ∘ P?) xs filter⊆dropWhile xs = HeteroProperties.filter-dropWhile P? {xs} ≋-refl ------------------------------------------------------------------------ -- Various list functions are increasing wrt _⊆_ ------------------------------------------------------------------------ -- We write f⁺ for the proof that `xs ⊆ ys → f xs ⊆ f ys` -- and f⁻ for the one that `f xs ⊆ f ys → xs ⊆ ys`. module _ {as bs : List A} where ∷ˡ⁻ : ∀ {a} → a ∷ as ⊆ bs → as ⊆ bs ∷ˡ⁻ = HeteroProperties.∷ˡ⁻ ∷ʳ⁻ : ∀ {a b} → ¬ (a ≈ b) → a ∷ as ⊆ b ∷ bs → a ∷ as ⊆ bs ∷ʳ⁻ = HeteroProperties.∷ʳ⁻ ∷⁻ : ∀ {a b} → a ∷ as ⊆ b ∷ bs → as ⊆ bs ∷⁻ = HeteroProperties.∷⁻ ------------------------------------------------------------------------ -- map module _ {b ℓ} (R : Setoid b ℓ) where open Setoid R using () renaming (Carrier to B; _≈_ to _≈′_) open SetoidSublist R using () renaming (_⊆_ to _⊆′_) map⁺ : ∀ {as bs} {f : A → B} → f Preserves _≈_ ⟶ _≈′_ → as ⊆ bs → map f as ⊆′ map f bs map⁺ {f = f} f-resp as⊆bs = HeteroProperties.map⁺ f f (SetoidSublist.map S f-resp as⊆bs) ------------------------------------------------------------------------ -- _++_ module _ {as bs : List A} where ++⁺ˡ : ∀ cs → as ⊆ bs → as ⊆ cs ++ bs ++⁺ˡ = HeteroProperties.++ˡ ++⁺ʳ : ∀ cs → as ⊆ bs → as ⊆ bs ++ cs ++⁺ʳ = HeteroProperties.++ʳ ++⁺ : ∀ {cs ds} → as ⊆ bs → cs ⊆ ds → as ++ cs ⊆ bs ++ ds ++⁺ = HeteroProperties.++⁺ ++⁻ : ∀ {cs ds} → length as ≡ length bs → as ++ cs ⊆ bs ++ ds → cs ⊆ ds ++⁻ = HeteroProperties.++⁻ ------------------------------------------------------------------------ -- take module _ {m n} {xs} where take⁺ : m ≤ n → take m xs ⊆ take n xs take⁺ m≤n = HeteroProperties.take⁺ m≤n ≋-refl ------------------------------------------------------------------------ -- drop module _ {m n} {xs ys : List A} where drop⁺ : m ≥ n → xs ⊆ ys → drop m xs ⊆ drop n ys drop⁺ = HeteroProperties.drop⁺ module _ {m n} {xs : List A} where drop⁺-≥ : m ≥ n → drop m xs ⊆ drop n xs drop⁺-≥ m≥n = drop⁺ m≥n ⊆-refl module _ {xs ys : List A} where drop⁺-⊆ : ∀ n → xs ⊆ ys → drop n xs ⊆ drop n ys drop⁺-⊆ n xs⊆ys = drop⁺ {n} ℕₚ.≤-refl xs⊆ys ------------------------------------------------------------------------ -- takeWhile / dropWhile module _ {p q} {P : Pred A p} {Q : Pred A q} (P? : Decidable P) (Q? : Decidable Q) where takeWhile⁺ : ∀ {xs} → (∀ {a b} → a ≈ b → P a → Q b) → takeWhile P? xs ⊆ takeWhile Q? xs takeWhile⁺ {xs} P⇒Q = HeteroProperties.⊆-takeWhile-Sublist P? Q? {xs} P⇒Q ≋-refl dropWhile⁺ : ∀ {xs} → (∀ {a b} → a ≈ b → Q b → P a) → dropWhile P? xs ⊆ dropWhile Q? xs dropWhile⁺ {xs} P⇒Q = HeteroProperties.⊇-dropWhile-Sublist P? Q? {xs} P⇒Q ≋-refl ------------------------------------------------------------------------ -- filter module _ {p q} {P : Pred A p} {Q : Pred A q} (P? : Decidable P) (Q? : Decidable Q) where filter⁺ : ∀ {as bs} → (∀ {a b} → a ≈ b → P a → Q b) → as ⊆ bs → filter P? as ⊆ filter Q? bs filter⁺ = HeteroProperties.⊆-filter-Sublist P? Q? ------------------------------------------------------------------------ -- reverse module _ {as bs : List A} where reverseAcc⁺ : ∀ {cs ds} → as ⊆ bs → cs ⊆ ds → reverseAcc cs as ⊆ reverseAcc ds bs reverseAcc⁺ = HeteroProperties.reverseAcc⁺ ʳ++⁺ : ∀ {cs ds} → as ⊆ bs → cs ⊆ ds → as ʳ++ cs ⊆ bs ʳ++ ds ʳ++⁺ = reverseAcc⁺ reverse⁺ : as ⊆ bs → reverse as ⊆ reverse bs reverse⁺ = HeteroProperties.reverse⁺ reverse⁻ : reverse as ⊆ reverse bs → as ⊆ bs reverse⁻ = HeteroProperties.reverse⁻ ------------------------------------------------------------------------ -- Inversion lemmas ------------------------------------------------------------------------ module _ {a as b bs} where ∷⁻¹ : a ≈ b → as ⊆ bs ⇔ a ∷ as ⊆ b ∷ bs ∷⁻¹ = HeteroProperties.∷⁻¹ ∷ʳ⁻¹ : ¬ (a ≈ b) → a ∷ as ⊆ bs ⇔ a ∷ as ⊆ b ∷ bs ∷ʳ⁻¹ = HeteroProperties.∷ʳ⁻¹ ------------------------------------------------------------------------ -- Other ------------------------------------------------------------------------ module _ where length-mono-≤ : ∀ {as bs} → as ⊆ bs → length as ≤ length bs length-mono-≤ = HeteroProperties.length-mono-≤ ------------------------------------------------------------------------ -- Conversion to and from list equality to-≋ : ∀ {as bs} → length as ≡ length bs → as ⊆ bs → as ≋ bs to-≋ = HeteroProperties.toPointwise ------------------------------------------------------------------------ -- Irrelevant special case []⊆-irrelevant : Irrelevant ([] ⊆_) []⊆-irrelevant = HeteroProperties.Sublist-[]-irrelevant ------------------------------------------------------------------------ -- (to/from)∈ is a bijection module _ {x xs} where to∈-injective : ∀ {p q : [ x ] ⊆ xs} → to∈ p ≡ to∈ q → p ≡ q to∈-injective = HeteroProperties.toAny-injective from∈-injective : ∀ {p q : x ∈ xs} → from∈ p ≡ from∈ q → p ≡ q from∈-injective = HeteroProperties.fromAny-injective to∈∘from∈≗id : ∀ (p : x ∈ xs) → to∈ (from∈ p) ≡ p to∈∘from∈≗id = HeteroProperties.toAny∘fromAny≗id [x]⊆xs⤖x∈xs : ([ x ] ⊆ xs) ⤖ (x ∈ xs) [x]⊆xs⤖x∈xs = HeteroProperties.Sublist-[x]-bijection ------------------------------------------------------------------------ -- Properties of Disjoint(ness) and DisjointUnion open HeteroProperties.Disjointness {R = _≈_} public open HeteroProperties.DisjointnessMonotonicity {R = _≈_} {S = _≈_} {T = _≈_} trans public -- Shrinking one of two disjoint lists preserves disjointness. -- We would have liked to define shrinkDisjointˡ σ = shrinkDisjoint σ ⊆-refl -- but alas, this is only possible for groupoids, not setoids in general. shrinkDisjointˡ : ∀ {xs ys zs us} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} (σ : us ⊆ xs) → Disjoint τ₁ τ₂ → Disjoint (⊆-trans σ τ₁) τ₂ -- Not affected by σ: shrinkDisjointˡ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointˡ σ d shrinkDisjointˡ σ (y≈z ∷ᵣ d) = y≈z ∷ᵣ shrinkDisjointˡ σ d -- In σ: keep x. shrinkDisjointˡ (u≈x ∷ σ) (x≈z ∷ₗ d) = trans u≈x x≈z ∷ₗ shrinkDisjointˡ σ d -- Not in σ: drop x. shrinkDisjointˡ (x ∷ʳ σ) (x≈z ∷ₗ d) = _ ∷ₙ shrinkDisjointˡ σ d shrinkDisjointˡ [] [] = [] shrinkDisjointʳ : ∀ {xs ys zs vs} {τ₁ : xs ⊆ zs} {τ₂ : ys ⊆ zs} (σ : vs ⊆ ys) → Disjoint τ₁ τ₂ → Disjoint τ₁ (⊆-trans σ τ₂) -- Not affected by σ: shrinkDisjointʳ σ (y ∷ₙ d) = y ∷ₙ shrinkDisjointʳ σ d shrinkDisjointʳ σ (x≈z ∷ₗ d) = x≈z ∷ₗ shrinkDisjointʳ σ d -- In σ: keep y. shrinkDisjointʳ (v≈y ∷ σ) (y≈z ∷ᵣ d) = trans v≈y y≈z ∷ᵣ shrinkDisjointʳ σ d -- Not in σ: drop y. shrinkDisjointʳ (y ∷ʳ σ) (y≈z ∷ᵣ d) = _ ∷ₙ shrinkDisjointʳ σ d shrinkDisjointʳ [] [] = [] agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/000077500000000000000000000000001451211343400225145ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Propositional.agda000066400000000000000000000012171451211343400261750ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The sublist relation over propositional equality. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Subset.Propositional {a} {A : Set a} where import Data.List.Relation.Binary.Subset.Setoid as SetoidSubset open import Relation.Binary.PropositionalEquality using (setoid) ------------------------------------------------------------------------ -- Re-export parameterised definitions from setoid sublists open SetoidSubset (setoid A) public agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Propositional/000077500000000000000000000000001451211343400253565ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Propositional/Properties.agda000066400000000000000000000255551451211343400303440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the sublist relation over setoid equality. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary hiding (Decidable) module Data.List.Relation.Binary.Subset.Propositional.Properties where open import Category.Monad open import Data.Bool.Base using (Bool; true; false; T) open import Data.List.Base open import Data.List.Relation.Unary.Any using (Any; here; there) open import Data.List.Relation.Unary.All using (All) import Data.List.Relation.Unary.Any.Properties as Any hiding (filter⁺) open import Data.List.Categorical open import Data.List.Relation.Unary.Any using (Any) open import Data.List.Membership.Propositional open import Data.List.Membership.Propositional.Properties import Data.List.Relation.Binary.Subset.Setoid.Properties as Setoidₚ open import Data.List.Relation.Binary.Subset.Propositional open import Data.List.Relation.Binary.Permutation.Propositional import Data.List.Relation.Binary.Permutation.Propositional.Properties as Permutation open import Data.Nat using (ℕ; _≤_; s≤s) import Data.Product as Prod import Data.Sum.Base as Sum open import Function.Base using (_∘_; _∘′_; id; _$_) open import Function.Equality using (_⟨$⟩_) open import Function.Inverse as Inv using (_↔_; module Inverse) open import Function.Equivalence using (module Equivalence) open import Level using (Level) open import Relation.Nullary using (¬_; yes; no) open import Relation.Unary using (Decidable; Pred) renaming (_⊆_ to _⋐_) open import Relation.Binary using (_⇒_; _Respects_) open import Relation.Binary.PropositionalEquality using (_≡_; _≗_; isEquivalence; subst; resp; refl; setoid; module ≡-Reasoning) import Relation.Binary.Reasoning.Preorder as PreorderReasoning private open module ListMonad {ℓ} = RawMonad (monad {ℓ = ℓ}) variable a b p q : Level A : Set a B : Set b ws xs ys zs : List A ------------------------------------------------------------------------ -- Relational properties with _≋_ (pointwise equality) ------------------------------------------------------------------------ ⊆-reflexive : _≡_ {A = List A} ⇒ _⊆_ ⊆-reflexive refl = id ⊆-refl : Reflexive {A = List A} _⊆_ ⊆-refl x∈xs = x∈xs ⊆-trans : Transitive {A = List A} _⊆_ ⊆-trans xs⊆ys ys⊆zs = ys⊆zs ∘ xs⊆ys module _ (A : Set a) where ⊆-isPreorder : IsPreorder {A = List A} _≡_ _⊆_ ⊆-isPreorder = record { isEquivalence = isEquivalence ; reflexive = ⊆-reflexive ; trans = ⊆-trans } ⊆-preorder : Preorder _ _ _ ⊆-preorder = record { isPreorder = ⊆-isPreorder } ------------------------------------------------------------------------ -- Relational properties with _↭_ (permutation) ------------------------------------------------------------------------ -- See issue #1354 for why these proofs can't be taken from `Setoidₚ` ⊆-reflexive-↭ : _↭_ {A = A} ⇒ _⊆_ ⊆-reflexive-↭ xs↭ys = Permutation.∈-resp-↭ xs↭ys ⊆-respʳ-↭ : _⊆_ {A = A} Respectsʳ _↭_ ⊆-respʳ-↭ xs↭ys = Permutation.∈-resp-↭ xs↭ys ∘_ ⊆-respˡ-↭ : _⊆_ {A = A} Respectsˡ _↭_ ⊆-respˡ-↭ xs↭ys = _∘ Permutation.∈-resp-↭ (↭-sym xs↭ys) module _ (A : Set a) where ⊆-↭-isPreorder : IsPreorder {A = List A} _↭_ _⊆_ ⊆-↭-isPreorder = record { isEquivalence = ↭-isEquivalence ; reflexive = ⊆-reflexive-↭ ; trans = ⊆-trans } ⊆-↭-preorder : Preorder _ _ _ ⊆-↭-preorder = record { isPreorder = ⊆-↭-isPreorder } ------------------------------------------------------------------------ -- Reasoning over subsets ------------------------------------------------------------------------ module ⊆-Reasoning (A : Set a) where open Setoidₚ.⊆-Reasoning (setoid A) public hiding (step-≋; step-≋˘; _≋⟨⟩_) ------------------------------------------------------------------------ -- Properties of _⊆_ and various list predicates ------------------------------------------------------------------------ Any-resp-⊆ : ∀ {P : Pred A p} → (Any P) Respects _⊆_ Any-resp-⊆ = Setoidₚ.Any-resp-⊆ (setoid _) (subst _) All-resp-⊇ : ∀ {P : Pred A p} → (All P) Respects _⊇_ All-resp-⊇ = Setoidₚ.All-resp-⊇ (setoid _) (subst _) ------------------------------------------------------------------------ -- Properties relating _⊆_ to various list functions ------------------------------------------------------------------------ -- map map⁺ : ∀ (f : A → B) → xs ⊆ ys → map f xs ⊆ map f ys map⁺ f xs⊆ys = _⟨$⟩_ (Inverse.to (map-∈↔ f)) ∘ Prod.map₂ (Prod.map₁ xs⊆ys) ∘ _⟨$⟩_ (Inverse.from (map-∈↔ f)) ------------------------------------------------------------------------ -- ∷ xs⊆x∷xs : ∀ (xs : List A) x → xs ⊆ x ∷ xs xs⊆x∷xs = Setoidₚ.xs⊆x∷xs (setoid _) ∷⁺ʳ : ∀ x → xs ⊆ ys → x ∷ xs ⊆ x ∷ ys ∷⁺ʳ = Setoidₚ.∷⁺ʳ (setoid _) ∈-∷⁺ʳ : ∀ {x} → x ∈ ys → xs ⊆ ys → x ∷ xs ⊆ ys ∈-∷⁺ʳ = Setoidₚ.∈-∷⁺ʳ (setoid _) ------------------------------------------------------------------------ -- _++_ xs⊆xs++ys : ∀ (xs ys : List A) → xs ⊆ xs ++ ys xs⊆xs++ys = Setoidₚ.xs⊆xs++ys (setoid _) xs⊆ys++xs : ∀ (xs ys : List A) → xs ⊆ ys ++ xs xs⊆ys++xs = Setoidₚ.xs⊆ys++xs (setoid _) ++⁺ʳ : ∀ zs → xs ⊆ ys → zs ++ xs ⊆ zs ++ ys ++⁺ʳ = Setoidₚ.++⁺ʳ (setoid _) ++⁺ˡ : ∀ zs → xs ⊆ ys → xs ++ zs ⊆ ys ++ zs ++⁺ˡ = Setoidₚ.++⁺ˡ (setoid _) ++⁺ : ws ⊆ xs → ys ⊆ zs → ws ++ ys ⊆ xs ++ zs ++⁺ = Setoidₚ.++⁺ (setoid _) ------------------------------------------------------------------------ -- concat module _ {xss yss : List (List A)} where concat⁺ : xss ⊆ yss → concat xss ⊆ concat yss concat⁺ xss⊆yss = _⟨$⟩_ (Inverse.to concat-∈↔) ∘ Prod.map₂ (Prod.map₂ xss⊆yss) ∘ _⟨$⟩_ (Inverse.from concat-∈↔) ------------------------------------------------------------------------ -- applyUpTo applyUpTo⁺ : ∀ (f : ℕ → A) {m n} → m ≤ n → applyUpTo f m ⊆ applyUpTo f n applyUpTo⁺ = Setoidₚ.applyUpTo⁺ (setoid _) ------------------------------------------------------------------------ -- _>>=_ module _ {A B : Set a} (f g : A → List B) where >>=⁺ : xs ⊆ ys → (∀ {x} → f x ⊆ g x) → (xs >>= f) ⊆ (ys >>= g) >>=⁺ xs⊆ys f⊆g = _⟨$⟩_ (Inverse.to >>=-∈↔) ∘ Prod.map₂ (Prod.map xs⊆ys f⊆g) ∘ _⟨$⟩_ (Inverse.from >>=-∈↔) ------------------------------------------------------------------------ -- _⊛_ module _ {A B : Set a} {fs gs : List (A → B)} where ⊛⁺ : fs ⊆ gs → xs ⊆ ys → (fs ⊛ xs) ⊆ (gs ⊛ ys) ⊛⁺ fs⊆gs xs⊆ys = _⟨$⟩_ (Inverse.to $ ⊛-∈↔ gs) ∘ Prod.map₂ (Prod.map₂ (Prod.map fs⊆gs (Prod.map₁ xs⊆ys))) ∘ _⟨$⟩_ (Inverse.from $ ⊛-∈↔ fs) ------------------------------------------------------------------------ -- _⊗_ module _ {A B : Set a} {ws xs : List A} {ys zs : List B} where ⊗⁺ : ws ⊆ xs → ys ⊆ zs → (ws ⊗ ys) ⊆ (xs ⊗ zs) ⊗⁺ ws⊆xs ys⊆zs = _⟨$⟩_ (Inverse.to ⊗-∈↔) ∘ Prod.map ws⊆xs ys⊆zs ∘ _⟨$⟩_ (Inverse.from ⊗-∈↔) ------------------------------------------------------------------------ -- any module _ (p : A → Bool) {xs ys} where any⁺ : xs ⊆ ys → T (any p xs) → T (any p ys) any⁺ xs⊆ys = _⟨$⟩_ (Equivalence.to Any.any⇔) ∘ Any-resp-⊆ xs⊆ys ∘ _⟨$⟩_ (Equivalence.from Any.any⇔) ------------------------------------------------------------------------ -- map-with-∈ module _ {xs : List A} {f : ∀ {x} → x ∈ xs → B} {ys : List A} {g : ∀ {x} → x ∈ ys → B} where map-with-∈⁺ : (xs⊆ys : xs ⊆ ys) → (∀ {x} → f {x} ≗ g ∘ xs⊆ys) → map-with-∈ xs f ⊆ map-with-∈ ys g map-with-∈⁺ xs⊆ys f≈g {x} = _⟨$⟩_ (Inverse.to Any.map-with-∈↔) ∘ Prod.map₂ (Prod.map xs⊆ys (λ {x∈xs} x≡fx∈xs → begin x ≡⟨ x≡fx∈xs ⟩ f x∈xs ≡⟨ f≈g x∈xs ⟩ g (xs⊆ys x∈xs) ∎)) ∘ _⟨$⟩_ (Inverse.from Any.map-with-∈↔) where open ≡-Reasoning ------------------------------------------------------------------------ -- filter module _ {P : Pred A p} (P? : Decidable P) where filter-⊆ : ∀ xs → filter P? xs ⊆ xs filter-⊆ = Setoidₚ.filter-⊆ (setoid A) P? module _ {Q : Pred A q} (Q? : Decidable Q) where filter⁺′ : P ⋐ Q → ∀ {xs ys} → xs ⊆ ys → filter P? xs ⊆ filter Q? ys filter⁺′ = Setoidₚ.filter⁺′ (setoid A) P? (resp P) Q? (resp Q) ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Version 0.16 boolFilter-⊆ : ∀ (p : A → Bool) → (xs : List A) → boolFilter p xs ⊆ xs boolFilter-⊆ p (x ∷ xs) with p x | boolFilter-⊆ p xs ... | false | hyp = there ∘ hyp ... | true | hyp = λ { (here eq) → here eq ; (there ∈boolFilter) → there (hyp ∈boolFilter) } {-# WARNING_ON_USAGE boolFilter-⊆ "Warning: boolFilter was deprecated in v0.16. Please use filter instead." #-} -- Version 1.5 mono = Any-resp-⊆ {-# WARNING_ON_USAGE mono "Warning: mono was deprecated in v1.5. Please use Any-resp-⊆ instead." #-} map-mono = map⁺ {-# WARNING_ON_USAGE map-mono "Warning: map-mono was deprecated in v1.5. Please use map⁺ instead." #-} infix 4 _++-mono_ _++-mono_ = ++⁺ {-# WARNING_ON_USAGE _++-mono_ "Warning: _++-mono_ was deprecated in v1.5. Please use ++⁺ instead." #-} concat-mono = concat⁺ {-# WARNING_ON_USAGE concat-mono "Warning: concat-mono was deprecated in v1.5. Please use concat⁺ instead." #-} >>=-mono = >>=⁺ {-# WARNING_ON_USAGE >>=-mono "Warning: >>=-mono was deprecated in v1.5. Please use >>=⁺ instead." #-} infix 4 _⊛-mono_ _⊛-mono_ = ⊛⁺ {-# WARNING_ON_USAGE _⊛-mono_ "Warning: _⊛-mono_ was deprecated in v1.5. Please use ⊛⁺ instead." #-} infix 4 _⊗-mono_ _⊗-mono_ = ⊗⁺ {-# WARNING_ON_USAGE _⊗-mono_ "Warning: _⊗-mono_ was deprecated in v1.5. Please use ⊗⁺ instead." #-} any-mono = any⁺ {-# WARNING_ON_USAGE any-mono "Warning: any-mono was deprecated in v1.5. Please use any⁺ instead." #-} map-with-∈-mono = map-with-∈⁺ {-# WARNING_ON_USAGE map-with-∈-mono "Warning: map-with-∈-mono was deprecated in v1.5. Please use map-with-∈⁺ instead." #-} filter⁺ = filter-⊆ {-# WARNING_ON_USAGE filter⁺ "Warning: filter⁺ was deprecated in v1.5. Please use filter-⊆ instead." #-} agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Setoid.agda000066400000000000000000000017661451211343400245730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The extensional sublist relation over setoid equality. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary module Data.List.Relation.Binary.Subset.Setoid {c ℓ} (S : Setoid c ℓ) where open import Data.List.Base using (List) open import Data.List.Membership.Setoid S using (_∈_) open import Function.Base using (flip) open import Level using (_⊔_) open import Relation.Nullary using (¬_) open Setoid S renaming (Carrier to A) ------------------------------------------------------------------------ -- Definitions infix 4 _⊆_ _⊇_ _⊈_ _⊉_ _⊆_ : Rel (List A) (c ⊔ ℓ) xs ⊆ ys = ∀ {x} → x ∈ xs → x ∈ ys _⊇_ : Rel (List A) (c ⊔ ℓ) _⊇_ = flip _⊆_ _⊈_ : Rel (List A) (c ⊔ ℓ) xs ⊈ ys = ¬ xs ⊆ ys _⊉_ : Rel (List A) (c ⊔ ℓ) xs ⊉ ys = ¬ xs ⊇ ys agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Setoid/000077500000000000000000000000001451211343400237435ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Subset/Setoid/Properties.agda000066400000000000000000000223521451211343400267210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the extensional sublist relation over setoid equality. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary hiding (Decidable) module Data.List.Relation.Binary.Subset.Setoid.Properties where open import Data.Bool.Base using (Bool; true; false) open import Data.List.Base hiding (_∷ʳ_) open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.List.Relation.Unary.All as All using (All) import Data.List.Membership.Setoid as Membership open import Data.List.Membership.Setoid.Properties open import Data.Nat.Base using (ℕ; s≤s; _≤_) import Data.List.Relation.Binary.Subset.Setoid as Subset import Data.List.Relation.Binary.Sublist.Setoid as Sublist import Data.List.Relation.Binary.Equality.Setoid as Equality import Data.List.Relation.Binary.Permutation.Setoid as Permutation import Data.List.Relation.Binary.Permutation.Setoid.Properties as Permutationₚ open import Data.Product using (_,_) open import Function.Base using (_∘_; _∘₂_) open import Level using (Level) open import Relation.Nullary using (¬_; does; yes; no) open import Relation.Nullary.Negation using (contradiction) open import Relation.Unary using (Pred; Decidable) renaming (_⊆_ to _⋐_) import Relation.Binary.Reasoning.Preorder as PreorderReasoning open Setoid using (Carrier) private variable a p q ℓ : Level ------------------------------------------------------------------------ -- Relational properties with _≋_ (pointwise equality) ------------------------------------------------------------------------ module _ (S : Setoid a ℓ) where open Subset S open Equality S open Membership S ⊆-reflexive : _≋_ ⇒ _⊆_ ⊆-reflexive xs≋ys = ∈-resp-≋ S xs≋ys ⊆-refl : Reflexive _⊆_ ⊆-refl x∈xs = x∈xs ⊆-trans : Transitive _⊆_ ⊆-trans xs⊆ys ys⊆zs x∈xs = ys⊆zs (xs⊆ys x∈xs) ⊆-respʳ-≋ : _⊆_ Respectsʳ _≋_ ⊆-respʳ-≋ xs≋ys = ∈-resp-≋ S xs≋ys ∘_ ⊆-respˡ-≋ : _⊆_ Respectsˡ _≋_ ⊆-respˡ-≋ xs≋ys = _∘ ∈-resp-≋ S (≋-sym xs≋ys) ⊆-isPreorder : IsPreorder _≋_ _⊆_ ⊆-isPreorder = record { isEquivalence = ≋-isEquivalence ; reflexive = ⊆-reflexive ; trans = ⊆-trans } ⊆-preorder : Preorder _ _ _ ⊆-preorder = record { isPreorder = ⊆-isPreorder } ------------------------------------------------------------------------ -- Relational properties with _↭_ (permutations) ------------------------------------------------------------------------ module _ (S : Setoid a ℓ) where open Subset S open Permutation S open Membership S ⊆-reflexive-↭ : _↭_ ⇒ _⊆_ ⊆-reflexive-↭ xs↭ys = Permutationₚ.∈-resp-↭ S xs↭ys ⊆-respʳ-↭ : _⊆_ Respectsʳ _↭_ ⊆-respʳ-↭ xs↭ys = Permutationₚ.∈-resp-↭ S xs↭ys ∘_ ⊆-respˡ-↭ : _⊆_ Respectsˡ _↭_ ⊆-respˡ-↭ xs↭ys = _∘ Permutationₚ.∈-resp-↭ S (↭-sym xs↭ys) ⊆-↭-isPreorder : IsPreorder _↭_ _⊆_ ⊆-↭-isPreorder = record { isEquivalence = ↭-isEquivalence ; reflexive = ⊆-reflexive-↭ ; trans = ⊆-trans S } ⊆-↭-preorder : Preorder _ _ _ ⊆-↭-preorder = record { isPreorder = ⊆-↭-isPreorder } ------------------------------------------------------------------------ -- Reasoning over subsets ------------------------------------------------------------------------ module ⊆-Reasoning (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open Subset S open Membership S private module Base = PreorderReasoning (⊆-preorder S) open Base public hiding (step-∼; step-≈; step-≈˘) renaming (_≈⟨⟩_ to _≋⟨⟩_) infixr 2 step-⊆ step-≋ step-≋˘ infix 1 step-∈ step-∈ : ∀ x {xs ys} → xs IsRelatedTo ys → x ∈ xs → x ∈ ys step-∈ x xs⊆ys x∈xs = (begin xs⊆ys) x∈xs step-⊆ = Base.step-∼ step-≋ = Base.step-≈ step-≋˘ = Base.step-≈˘ syntax step-∈ x xs⊆ys x∈xs = x ∈⟨ x∈xs ⟩ xs⊆ys syntax step-⊆ xs ys⊆zs xs⊆ys = xs ⊆⟨ xs⊆ys ⟩ ys⊆zs syntax step-≋ xs ys⊆zs xs≋ys = xs ≋⟨ xs≋ys ⟩ ys⊆zs syntax step-≋˘ xs ys⊆zs xs≋ys = xs ≋˘⟨ xs≋ys ⟩ ys⊆zs ------------------------------------------------------------------------ -- Relationship with other binary relations ------------------------------------------------------------------------ module _ (S : Setoid a ℓ) where open Setoid S open Subset S open Sublist S renaming (_⊆_ to _⊑_) Sublist⇒Subset : ∀ {xs ys} → xs ⊑ ys → xs ⊆ ys Sublist⇒Subset (x≈y ∷ xs⊑ys) (here v≈x) = here (trans v≈x x≈y) Sublist⇒Subset (x≈y ∷ xs⊑ys) (there v∈xs) = there (Sublist⇒Subset xs⊑ys v∈xs) Sublist⇒Subset (y ∷ʳ xs⊑ys) v∈xs = there (Sublist⇒Subset xs⊑ys v∈xs) ------------------------------------------------------------------------ -- Relationship with predicates ------------------------------------------------------------------------ module _ (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open Subset S open Membership S Any-resp-⊆ : ∀ {P : Pred A p} → P Respects _≈_ → (Any P) Respects _⊆_ Any-resp-⊆ resp ⊆ pxs with find pxs ... | (x , x∈xs , px) = lose resp (⊆ x∈xs) px All-resp-⊇ : ∀ {P : Pred A p} → P Respects _≈_ → (All P) Respects _⊇_ All-resp-⊇ resp ⊇ pxs = All.tabulateₛ S (All.lookupₛ S resp pxs ∘ ⊇) ------------------------------------------------------------------------ -- Properties of list functions ------------------------------------------------------------------------ -- ∷ module _ (S : Setoid a ℓ) where open Setoid S open Subset S open Membership S xs⊆x∷xs : ∀ xs x → xs ⊆ x ∷ xs xs⊆x∷xs xs x = there ∷⁺ʳ : ∀ {xs ys} x → xs ⊆ ys → x ∷ xs ⊆ x ∷ ys ∷⁺ʳ x xs⊆ys (here p) = here p ∷⁺ʳ x xs⊆ys (there p) = there (xs⊆ys p) ∈-∷⁺ʳ : ∀ {xs ys x} → x ∈ ys → xs ⊆ ys → x ∷ xs ⊆ ys ∈-∷⁺ʳ x∈ys _ (here v≈x) = ∈-resp-≈ S (sym v≈x) x∈ys ∈-∷⁺ʳ _ xs⊆ys (there x∈xs) = xs⊆ys x∈xs ------------------------------------------------------------------------ -- ++ module _ (S : Setoid a ℓ) where open Subset S open Membership S xs⊆xs++ys : ∀ xs ys → xs ⊆ xs ++ ys xs⊆xs++ys xs ys = ∈-++⁺ˡ S xs⊆ys++xs : ∀ xs ys → xs ⊆ ys ++ xs xs⊆ys++xs xs ys = ∈-++⁺ʳ S _ ++⁺ʳ : ∀ {xs ys} zs → xs ⊆ ys → zs ++ xs ⊆ zs ++ ys ++⁺ʳ [] xs⊆ys = xs⊆ys ++⁺ʳ (x ∷ zs) xs⊆ys (here p) = here p ++⁺ʳ (x ∷ zs) xs⊆ys (there p) = there (++⁺ʳ zs xs⊆ys p) ++⁺ˡ : ∀ {xs ys} zs → xs ⊆ ys → xs ++ zs ⊆ ys ++ zs ++⁺ˡ {[]} {ys} zs xs⊆ys = xs⊆ys++xs zs ys ++⁺ˡ {x ∷ xs} {ys} zs xs⊆ys (here p) = xs⊆xs++ys ys zs (xs⊆ys (here p)) ++⁺ˡ {x ∷ xs} {ys} zs xs⊆ys (there p) = ++⁺ˡ zs (xs⊆ys ∘ there) p ++⁺ : ∀ {ws xs ys zs} → ws ⊆ xs → ys ⊆ zs → ws ++ ys ⊆ xs ++ zs ++⁺ ws⊆xs ys⊆zs = ⊆-trans S (++⁺ˡ _ ws⊆xs) (++⁺ʳ _ ys⊆zs) ------------------------------------------------------------------------ -- filter module _ (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open Subset S filter-⊆ : ∀ {P : Pred A p} (P? : Decidable P) → ∀ xs → filter P? xs ⊆ xs filter-⊆ P? (x ∷ xs) y∈f[x∷xs] with does (P? x) ... | false = there (filter-⊆ P? xs y∈f[x∷xs]) ... | true with y∈f[x∷xs] ... | here y≈x = here y≈x ... | there y∈f[xs] = there (filter-⊆ P? xs y∈f[xs]) -- Should be known as `filter⁺` (no prime) but `filter-⊆` used -- to be called this so for backwards compatability reasons, the -- correct name will have to wait until the deprecated name is -- removed. filter⁺′ : ∀ {P : Pred A p} (P? : Decidable P) → P Respects _≈_ → ∀ {Q : Pred A q} (Q? : Decidable Q) → Q Respects _≈_ → P ⋐ Q → ∀ {xs ys} → xs ⊆ ys → filter P? xs ⊆ filter Q? ys filter⁺′ P? P-resp Q? Q-resp P⋐Q xs⊆ys v∈fxs with ∈-filter⁻ S P? P-resp v∈fxs ... | v∈xs , Pv = ∈-filter⁺ S Q? Q-resp (xs⊆ys v∈xs) (P⋐Q Pv) ------------------------------------------------------------------------ -- applyUpTo module _ (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open Subset S applyUpTo⁺ : ∀ (f : ℕ → A) {m n} → m ≤ n → applyUpTo f m ⊆ applyUpTo f n applyUpTo⁺ _ (s≤s m≤n) (here f≡f[0]) = here f≡f[0] applyUpTo⁺ _ (s≤s m≤n) (there v∈xs) = there (applyUpTo⁺ _ m≤n v∈xs) ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Version 1.5 filter⁺ = filter-⊆ {-# WARNING_ON_USAGE filter⁺ "Warning: filter⁺ was deprecated in v1.5. Please use filter-⊆ instead." #-} agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Suffix/000077500000000000000000000000001451211343400225135ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Suffix/Heterogeneous.agda000066400000000000000000000036721451211343400261550ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An inductive definition of the heterogeneous suffix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Suffix.Heterogeneous where open import Level open import Relation.Binary using (REL; _⇒_) open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Relation.Binary.Pointwise as Pointwise using (Pointwise; []; _∷_) module _ {a b r} {A : Set a} {B : Set b} (R : REL A B r) where infixr 5 _++_ data Suffix : REL (List A) (List B) (a ⊔ b ⊔ r) where here : ∀ {as bs} → Pointwise R as bs → Suffix as bs there : ∀ {b as bs} → Suffix as bs → Suffix as (b ∷ bs) data SuffixView (as : List A) : List B → Set (a ⊔ b ⊔ r) where _++_ : ∀ cs {ds} → Pointwise R as ds → SuffixView as (cs List.++ ds) module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where tail : ∀ {a as bs} → Suffix R (a ∷ as) bs → Suffix R as bs tail (here (_ ∷ rs)) = there (here rs) tail (there x) = there (tail x) _++ˢ_ : ∀ pre {as bs} → Suffix R as bs → Suffix R as (pre List.++ bs) [] ++ˢ rs = rs (x ∷ xs) ++ˢ rs = there (xs ++ˢ rs) module _ {a b r s} {A : Set a} {B : Set b} {R : REL A B r} {S : REL A B s} where map : R ⇒ S → Suffix R ⇒ Suffix S map R⇒S (here rs) = here (Pointwise.map R⇒S rs) map R⇒S (there suf) = there (map R⇒S suf) module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where toView : ∀ {as bs} → Suffix R as bs → SuffixView R as bs toView (here rs) = [] ++ rs toView (there {c} suf) with toView suf ... | cs ++ rs = (c ∷ cs) ++ rs fromView : ∀ {as bs} → SuffixView R as bs → Suffix R as bs fromView ([] ++ rs) = here rs fromView ((c ∷ cs) ++ rs) = there (fromView (cs ++ rs)) agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Suffix/Heterogeneous/000077500000000000000000000000001451211343400253275ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Binary/Suffix/Heterogeneous/Properties.agda000066400000000000000000000211521451211343400303020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of the heterogeneous suffix relation ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Binary.Suffix.Heterogeneous.Properties where open import Data.Bool.Base using (true; false) open import Data.List.Base as List using (List; []; _∷_; _++_; length; filter; replicate; reverse; reverseAcc) open import Data.List.Relation.Binary.Pointwise as Pw using (Pointwise; []; _∷_; Pointwise-length) open import Data.List.Relation.Binary.Suffix.Heterogeneous as Suffix using (Suffix; here; there; tail) open import Data.List.Relation.Binary.Prefix.Heterogeneous as Prefix using (Prefix) open import Data.Nat.Base open import Data.Nat.Properties open import Function.Base using (_$_; flip) open import Relation.Nullary using (Dec; does; ¬_) import Relation.Nullary.Decidable as Dec open import Relation.Unary as U using (Pred) open import Relation.Nullary.Negation using (contradiction) open import Relation.Binary as B using (REL; Rel; Trans; Antisym; Irrelevant; _⇒_) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl; sym; subst; subst₂) import Data.List.Properties as Listₚ import Data.List.Relation.Binary.Prefix.Heterogeneous.Properties as Prefixₚ ------------------------------------------------------------------------ -- Suffix and Prefix are linked via reverse module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where fromPrefix : ∀ {as bs} → Prefix R as bs → Suffix R (reverse as) (reverse bs) fromPrefix {as} {bs} p with Prefix.toView p ... | Prefix._++_ {cs} rs ds = subst (Suffix R (reverse as)) (sym (Listₚ.reverse-++-commute cs ds)) (Suffix.fromView (reverse ds Suffix.++ Pw.reverse⁺ rs)) fromPrefix-rev : ∀ {as bs} → Prefix R (reverse as) (reverse bs) → Suffix R as bs fromPrefix-rev pre = subst₂ (Suffix R) (Listₚ.reverse-involutive _) (Listₚ.reverse-involutive _) (fromPrefix pre) toPrefix-rev : ∀ {as bs} → Suffix R as bs → Prefix R (reverse as) (reverse bs) toPrefix-rev {as} {bs} s with Suffix.toView s ... | Suffix._++_ cs {ds} rs = subst (Prefix R (reverse as)) (sym (Listₚ.reverse-++-commute cs ds)) (Prefix.fromView (Pw.reverse⁺ rs Prefix.++ reverse cs)) toPrefix : ∀ {as bs} → Suffix R (reverse as) (reverse bs) → Prefix R as bs toPrefix suf = subst₂ (Prefix R) (Listₚ.reverse-involutive _) (Listₚ.reverse-involutive _) (toPrefix-rev suf) ------------------------------------------------------------------------ -- length module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where length-mono : ∀ {as bs} → Suffix R as bs → length as ≤ length bs length-mono (here rs) = ≤-reflexive (Pointwise-length rs) length-mono (there suf) = ≤-step (length-mono suf) S[as][bs]⇒∣as∣≢1+∣bs∣ : ∀ {as bs} → Suffix R as bs → length as ≢ suc (length bs) S[as][bs]⇒∣as∣≢1+∣bs∣ suf eq = <⇒≱ (≤-reflexive (sym eq)) (length-mono suf) ------------------------------------------------------------------------ -- Pointwise conversion module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where fromPointwise : Pointwise R ⇒ Suffix R fromPointwise = here toPointwise : ∀ {as bs} → length as ≡ length bs → Suffix R as bs → Pointwise R as bs toPointwise eq (here rs) = rs toPointwise eq (there suf) = contradiction eq (S[as][bs]⇒∣as∣≢1+∣bs∣ suf) ------------------------------------------------------------------------ -- Suffix as a partial order module _ {a b c r s t} {A : Set a} {B : Set b} {C : Set c} {R : REL A B r} {S : REL B C s} {T : REL A C t} where trans : Trans R S T → Trans (Suffix R) (Suffix S) (Suffix T) trans rs⇒t (here rs) (here ss) = here (Pw.transitive rs⇒t rs ss) trans rs⇒t (here rs) (there ssuf) = there (trans rs⇒t (here rs) ssuf) trans rs⇒t (there rsuf) ssuf = trans rs⇒t rsuf (tail ssuf) module _ {a b e r s} {A : Set a} {B : Set b} {R : REL A B r} {S : REL B A s} {E : REL A B e} where antisym : Antisym R S E → Antisym (Suffix R) (Suffix S) (Pointwise E) antisym rs⇒e rsuf ssuf = Pw.antisymmetric rs⇒e (toPointwise eq rsuf) (toPointwise (sym eq) ssuf) where eq = ≤-antisym (length-mono rsuf) (length-mono ssuf) ------------------------------------------------------------------------ -- _++_ module _ {a b r} {A : Set a} {B : Set b} {R : REL A B r} where ++⁺ : ∀ {as bs cs ds} → Suffix R as bs → Pointwise R cs ds → Suffix R (as ++ cs) (bs ++ ds) ++⁺ (here rs) rs′ = here (Pw.++⁺ rs rs′) ++⁺ (there suf) rs′ = there (++⁺ suf rs′) ++⁻ : ∀ {as bs cs ds} → length cs ≡ length ds → Suffix R (as ++ cs) (bs ++ ds) → Pointwise R cs ds ++⁻ {_ ∷ _} {_} {_} {_} eq suf = ++⁻ eq (tail suf) ++⁻ {[]} {[]} {_} {_} eq suf = toPointwise eq suf ++⁻ {[]} {b ∷ bs} {_} {_} eq (there suf) = ++⁻ eq suf ++⁻ {[]} {b ∷ bs} {cs} {ds} eq (here rs) = contradiction (sym eq) (<⇒≢ ds x ⊛ sequenceA xs mapA : ∀ {Q : Pred A q} → (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) mapA f = sequenceA ∘′ map f forA : ∀ {Q : Pred A q} → All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) forA qxs f = mapA f qxs module _ (p : Level) {A : Set a} {P : Pred A (a ⊔ p)} {M : Set (a ⊔ p) → Set (a ⊔ p)} (Mon : RawMonad M) where private App = RawMonad.rawIApplicative Mon sequenceM : All (M ∘′ P) ⊆ M ∘′ All P sequenceM = sequenceA p App mapM : ∀ {Q : Pred A q} → (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) mapM = mapA p App forM : ∀ {Q : Pred A q} → All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) forM = forA p App ------------------------------------------------------------------------ -- Generalised lookup based on a proof of Any lookupAny : All P xs → (i : Any Q xs) → (P ∩ Q) (Any.lookup i) lookupAny (px ∷ pxs) (here qx) = px , qx lookupAny (px ∷ pxs) (there i) = lookupAny pxs i lookupWith : ∀[ P ⇒ Q ⇒ R ] → All P xs → (i : Any Q xs) → R (Any.lookup i) lookupWith f pxs i = Prod.uncurry f (lookupAny pxs i) lookup : All P xs → (∀ {x} → x ∈ₚ xs → P x) lookup pxs = lookupWith (λ { px refl → px }) pxs module _(S : Setoid a ℓ) {P : Pred (Setoid.Carrier S) p} where open Setoid S renaming (sym to sym₁) open SetoidMembership S lookupₛ : P Respects _≈_ → All P xs → (∀ {x} → x ∈ xs → P x) lookupₛ resp pxs = lookupWith (λ py x=y → resp (sym₁ x=y) py) pxs ------------------------------------------------------------------------ -- Properties of predicates preserved by All all? : Decidable P → Decidable (All P) all? p [] = yes [] all? p (x ∷ xs) = Dec.map′ (uncurry _∷_) uncons (p x ×-dec all? p xs) universal : Universal P → Universal (All P) universal u [] = [] universal u (x ∷ xs) = u x ∷ universal u xs irrelevant : Irrelevant P → Irrelevant (All P) irrelevant irr [] [] = P.refl irrelevant irr (px₁ ∷ pxs₁) (px₂ ∷ pxs₂) = P.cong₂ _∷_ (irr px₁ px₂) (irrelevant irr pxs₁ pxs₂) satisfiable : Satisfiable (All P) satisfiable = [] , [] ------------------------------------------------------------------------ -- DEPRECATED ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.4 all = all? {-# WARNING_ON_USAGE all "Warning: all was deprecated in v1.4. Please use all? instead." #-} agda-stdlib-1.7.3/src/Data/List/Relation/Unary/All/000077500000000000000000000000001451211343400216315ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/All/Properties.agda000066400000000000000000000751161451211343400246150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to All ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.All.Properties where open import Axiom.Extensionality.Propositional using (Extensionality) open import Data.Bool.Base using (Bool; T; true; false) open import Data.Bool.Properties using (T-∧) open import Data.Empty open import Data.Fin.Base using (Fin) renaming (zero to fzero; suc to fsuc) open import Data.List.Base as List hiding (lookup) open import Data.List.Properties as Listₚ using (partition-defn) open import Data.List.Membership.Propositional open import Data.List.Membership.Propositional.Properties import Data.List.Membership.Setoid as SetoidMembership open import Data.List.Relation.Unary.All as All using ( All; []; _∷_; lookup; updateAt ; _[_]=_; here; there ; Null ) open import Data.List.Relation.Unary.Any as Any using (Any; here; there) import Data.List.Relation.Binary.Equality.Setoid as ListEq using (_≋_; []; _∷_) open import Data.List.Relation.Binary.Pointwise using (Pointwise; []; _∷_) open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) open import Data.Maybe.Base as Maybe using (Maybe; just; nothing) open import Data.Maybe.Relation.Unary.All as Maybe using (just; nothing) open import Data.Nat.Base using (zero; suc; z≤n; s≤s; _<_) open import Data.Nat.Properties using (≤-refl; ≤-step) open import Data.Product as Prod using (_×_; _,_; uncurry; uncurry′) open import Function.Base open import Function.Equality using (_⟨$⟩_) open import Function.Equivalence using (_⇔_; equivalence; Equivalence) open import Function.Inverse using (_↔_; inverse) open import Function.Surjection using (_↠_; surjection) open import Level using (Level) open import Relation.Binary as B using (REL; Setoid; _Respects_) open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong; cong₂; _≗_) open import Relation.Nullary.Reflects using (invert) open import Relation.Nullary open import Relation.Nullary.Negation using (¬?; contradiction; decidable-stable) open import Relation.Unary using (Decidable; Pred; Universal; ∁; _∩_; _⟨×⟩_) renaming (_⊆_ to _⋐_) open import Relation.Unary.Properties using (∁?) private variable a b c p q r ℓ ℓ₁ ℓ₂ : Level A : Set a B : Set b C : Set c P : Pred A p Q : Pred B q R : Pred C r x y : A xs ys : List A ------------------------------------------------------------------------ -- Properties regarding Null Null⇒null : Null xs → T (null xs) Null⇒null [] = _ null⇒Null : T (null xs) → Null xs null⇒Null {xs = [] } _ = [] null⇒Null {xs = _ ∷ _} () ------------------------------------------------------------------------ -- Properties of the "points-to" relation _[_]=_ -- Relation _[_]=_ is deterministic: each index points to a single value. []=-injective : ∀ {px qx : P x} {pxs : All P xs} {i : x ∈ xs} → pxs [ i ]= px → pxs [ i ]= qx → px ≡ qx []=-injective here here = refl []=-injective (there x↦px) (there x↦qx) = []=-injective x↦px x↦qx -- See also Data.List.Relation.Unary.All.Properties.WithK.[]=-irrelevant. ------------------------------------------------------------------------ -- Lemmas relating Any, All and negation. ¬Any⇒All¬ : ∀ xs → ¬ Any P xs → All (¬_ ∘ P) xs ¬Any⇒All¬ [] ¬p = [] ¬Any⇒All¬ (x ∷ xs) ¬p = ¬p ∘ here ∷ ¬Any⇒All¬ xs (¬p ∘ there) All¬⇒¬Any : ∀ {xs} → All (¬_ ∘ P) xs → ¬ Any P xs All¬⇒¬Any (¬p ∷ _) (here p) = ¬p p All¬⇒¬Any (_ ∷ ¬p) (there p) = All¬⇒¬Any ¬p p ¬All⇒Any¬ : Decidable P → ∀ xs → ¬ All P xs → Any (¬_ ∘ P) xs ¬All⇒Any¬ dec [] ¬∀ = ⊥-elim (¬∀ []) ¬All⇒Any¬ dec (x ∷ xs) ¬∀ with dec x ... | true because [p] = there (¬All⇒Any¬ dec xs (¬∀ ∘ _∷_ (invert [p]))) ... | false because [¬p] = here (invert [¬p]) Any¬⇒¬All : ∀ {xs} → Any (¬_ ∘ P) xs → ¬ All P xs Any¬⇒¬All (here ¬p) = ¬p ∘ All.head Any¬⇒¬All (there ¬p) = Any¬⇒¬All ¬p ∘ All.tail ¬Any↠All¬ : ∀ {xs} → (¬ Any P xs) ↠ All (¬_ ∘ P) xs ¬Any↠All¬ = surjection (¬Any⇒All¬ _) All¬⇒¬Any to∘from where to∘from : ∀ {xs} (¬p : All (¬_ ∘ P) xs) → ¬Any⇒All¬ xs (All¬⇒¬Any ¬p) ≡ ¬p to∘from [] = refl to∘from (¬p ∷ ¬ps) = cong₂ _∷_ refl (to∘from ¬ps) -- If equality of functions were extensional, then the surjection -- could be strengthened to a bijection. from∘to : Extensionality _ _ → ∀ xs → (¬p : ¬ Any P xs) → All¬⇒¬Any (¬Any⇒All¬ xs ¬p) ≡ ¬p from∘to ext [] ¬p = ext λ () from∘to ext (x ∷ xs) ¬p = ext λ { (here p) → refl ; (there p) → cong (λ f → f p) $ from∘to ext xs (¬p ∘ there) } Any¬⇔¬All : ∀ {xs} → Decidable P → Any (¬_ ∘ P) xs ⇔ (¬ All P xs) Any¬⇔¬All dec = equivalence Any¬⇒¬All (¬All⇒Any¬ dec _) private -- If equality of functions were extensional, then the logical -- equivalence could be strengthened to a surjection. to∘from : Extensionality _ _ → (dec : Decidable P) → (¬∀ : ¬ All P xs) → Any¬⇒¬All (¬All⇒Any¬ dec xs ¬∀) ≡ ¬∀ to∘from ext P ¬∀ = ext (⊥-elim ∘ ¬∀) module _ {_~_ : REL A B ℓ} where All-swap : ∀ {xs ys} → All (λ x → All (x ~_) ys) xs → All (λ y → All (_~ y) xs) ys All-swap {ys = []} _ = [] All-swap {ys = y ∷ ys} [] = All.universal (λ _ → []) (y ∷ ys) All-swap {ys = y ∷ ys} ((x~y ∷ x~ys) ∷ pxs) = (x~y ∷ (All.map All.head pxs)) ∷ All-swap (x~ys ∷ (All.map All.tail pxs)) ------------------------------------------------------------------------ -- Defining properties of lookup and _[_]=_ -- -- pxs [ i ]= px if and only if lookup pxs i = px. -- `i` points to `lookup pxs i` in `pxs`. []=lookup : (pxs : All P xs) (i : x ∈ xs) → pxs [ i ]= lookup pxs i []=lookup (px ∷ pxs) (here refl) = here []=lookup (px ∷ pxs) (there i) = there ([]=lookup pxs i) -- If `i` points to `px` in `pxs`, then `lookup pxs i ≡ px`. []=⇒lookup : ∀ {px : P x} {pxs : All P xs} {i : x ∈ xs} → pxs [ i ]= px → lookup pxs i ≡ px []=⇒lookup x↦px = []=-injective ([]=lookup _ _) x↦px -- If `lookup pxs i ≡ px`, then `i` points to `px` in `pxs`. lookup⇒[]= : ∀ {px : P x} (pxs : All P xs) (i : x ∈ xs) → lookup pxs i ≡ px → pxs [ i ]= px lookup⇒[]= pxs i refl = []=lookup pxs i ------------------------------------------------------------------------ -- Properties of operations over `All` ------------------------------------------------------------------------ -- map map-id : ∀ (pxs : All P xs) → All.map id pxs ≡ pxs map-id [] = refl map-id (px ∷ pxs) = cong (px ∷_) (map-id pxs) map-cong : ∀ {f : P ⋐ Q} {g : P ⋐ Q} (pxs : All P xs) → (∀ {x} → f {x} ≗ g) → All.map f pxs ≡ All.map g pxs map-cong [] _ = refl map-cong (px ∷ pxs) feq = cong₂ _∷_ (feq px) (map-cong pxs feq) map-compose : ∀ {f : P ⋐ Q} {g : Q ⋐ R} (pxs : All P xs) → All.map g (All.map f pxs) ≡ All.map (g ∘ f) pxs map-compose [] = refl map-compose (px ∷ pxs) = cong (_ ∷_) (map-compose pxs) lookup-map : ∀ {f : P ⋐ Q} (pxs : All P xs) (i : x ∈ xs) → lookup (All.map f pxs) i ≡ f (lookup pxs i) lookup-map (px ∷ pxs) (here refl) = refl lookup-map (px ∷ pxs) (there i) = lookup-map pxs i ------------------------------------------------------------------------ -- _[_]%=_ / updateAt -- Defining properties of updateAt: -- (+) updateAt actually updates the element at the given index. updateAt-updates : ∀ (i : x ∈ xs) {f : P x → P x} {px : P x} (pxs : All P xs) → pxs [ i ]= px → updateAt i f pxs [ i ]= f px updateAt-updates (here refl) (px ∷ pxs) here = here updateAt-updates (there i) (px ∷ pxs) (there x↦px) = there (updateAt-updates i pxs x↦px) -- (-) updateAt i does not touch the elements at other indices. updateAt-minimal : ∀ (i : x ∈ xs) (j : y ∈ xs) → ∀ {f : P y → P y} {px : P x} (pxs : All P xs) → i ≢∈ j → pxs [ i ]= px → updateAt j f pxs [ i ]= px updateAt-minimal (here .refl) (here refl) (px ∷ pxs) i≢j here = ⊥-elim (i≢j refl refl) updateAt-minimal (here .refl) (there j) (px ∷ pxs) i≢j here = here updateAt-minimal (there i) (here refl) (px ∷ pxs) i≢j (there val) = there val updateAt-minimal (there i) (there j) (px ∷ pxs) i≢j (there val) = there (updateAt-minimal i j pxs (there-injective-≢∈ i≢j) val) -- lookup after updateAt reduces. -- For same index this is an easy consequence of updateAt-updates -- using []=↔lookup. lookup∘updateAt : ∀ (pxs : All P xs) (i : x ∈ xs) {f : P x → P x} → lookup (updateAt i f pxs) i ≡ f (lookup pxs i) lookup∘updateAt pxs i = []=⇒lookup (updateAt-updates i pxs (lookup⇒[]= pxs i refl)) -- For different indices it easily follows from updateAt-minimal. lookup∘updateAt′ : ∀ (i : x ∈ xs) (j : y ∈ xs) → ∀ {f : P y → P y} {px : P x} (pxs : All P xs) → i ≢∈ j → lookup (updateAt j f pxs) i ≡ lookup pxs i lookup∘updateAt′ i j pxs i≢j = []=⇒lookup (updateAt-minimal i j pxs i≢j (lookup⇒[]= pxs i refl)) -- The other properties are consequences of (+) and (-). -- We spell the most natural properties out. -- Direct inductive proofs are in most cases easier than just using -- the defining properties. -- In the explanations, we make use of shorthand f = g ↾ x -- meaning that f and g agree at point x, i.e. f x ≡ g x. -- updateAt (i : x ∈ xs) is a morphism -- from the monoid of endofunctions P x → P x -- to the monoid of endofunctions All P xs → All P xs. -- 1a. relative identity: f = id ↾ (lookup pxs i) -- implies updateAt i f = id ↾ pxs updateAt-id-relative : ∀ (i : x ∈ xs) {f : P x → P x} (pxs : All P xs) → f (lookup pxs i) ≡ lookup pxs i → updateAt i f pxs ≡ pxs updateAt-id-relative (here refl)(px ∷ pxs) eq = cong (_∷ pxs) eq updateAt-id-relative (there i) (px ∷ pxs) eq = cong (px ∷_) (updateAt-id-relative i pxs eq) -- 1b. identity: updateAt i id ≗ id updateAt-id : ∀ (i : x ∈ xs) (pxs : All P xs) → updateAt i id pxs ≡ pxs updateAt-id i pxs = updateAt-id-relative i pxs refl -- 2a. relative composition: f ∘ g = h ↾ (lookup i pxs) -- implies updateAt i f ∘ updateAt i g = updateAt i h ↾ pxs updateAt-compose-relative : ∀ (i : x ∈ xs) {f g h : P x → P x} (pxs : All P xs) → f (g (lookup pxs i)) ≡ h (lookup pxs i) → updateAt i f (updateAt i g pxs) ≡ updateAt i h pxs updateAt-compose-relative (here refl) (px ∷ pxs) fg=h = cong (_∷ pxs) fg=h updateAt-compose-relative (there i) (px ∷ pxs) fg=h = cong (px ∷_) (updateAt-compose-relative i pxs fg=h) -- 2b. composition: updateAt i f ∘ updateAt i g ≗ updateAt i (f ∘ g) updateAt-compose : ∀ (i : x ∈ xs) {f g : P x → P x} → updateAt {P = P} i f ∘ updateAt i g ≗ updateAt i (f ∘ g) updateAt-compose (here refl) (px ∷ pxs) = refl updateAt-compose (there i) (px ∷ pxs) = cong (px ∷_) (updateAt-compose i pxs) -- 3. congruence: updateAt i is a congruence wrt. extensional equality. -- 3a. If f = g ↾ (lookup pxs i) -- then updateAt i f = updateAt i g ↾ pxs updateAt-cong-relative : ∀ (i : x ∈ xs) {f g : P x → P x} (pxs : All P xs) → f (lookup pxs i) ≡ g (lookup pxs i) → updateAt i f pxs ≡ updateAt i g pxs updateAt-cong-relative (here refl) (px ∷ pxs) f=g = cong (_∷ pxs) f=g updateAt-cong-relative (there i) (px ∷ pxs) f=g = cong (px ∷_) (updateAt-cong-relative i pxs f=g) -- 3b. congruence: f ≗ g → updateAt i f ≗ updateAt i g updateAt-cong : ∀ (i : x ∈ xs) {f g : P x → P x} → f ≗ g → updateAt {P = P} i f ≗ updateAt i g updateAt-cong i f≗g pxs = updateAt-cong-relative i pxs (f≗g (lookup pxs i)) -- The order of updates at different indices i ≢ j does not matter. -- This a consequence of updateAt-updates and updateAt-minimal -- but easier to prove inductively. updateAt-commutes : ∀ (i : x ∈ xs) (j : y ∈ xs) → ∀ {f : P x → P x} {g : P y → P y} → i ≢∈ j → updateAt {P = P} i f ∘ updateAt j g ≗ updateAt j g ∘ updateAt i f updateAt-commutes (here refl) (here refl) i≢j (px ∷ pxs) = ⊥-elim (i≢j refl refl) updateAt-commutes (here refl) (there j) i≢j (px ∷ pxs) = refl updateAt-commutes (there i) (here refl) i≢j (px ∷ pxs) = refl updateAt-commutes (there i) (there j) i≢j (px ∷ pxs) = cong (px ∷_) (updateAt-commutes i j (there-injective-≢∈ i≢j) pxs) map-updateAt : ∀ {f : P ⋐ Q} {g : P x → P x} {h : Q x → Q x} (pxs : All P xs) (i : x ∈ xs) → f (g (lookup pxs i)) ≡ h (f (lookup pxs i)) → All.map f (pxs All.[ i ]%= g) ≡ (All.map f pxs) All.[ i ]%= h map-updateAt (px ∷ pxs) (here refl) = cong (_∷ _) map-updateAt (px ∷ pxs) (there i) feq = cong (_ ∷_) (map-updateAt pxs i feq) ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- singleton singleton⁻ : All P [ x ] → P x singleton⁻ (px ∷ []) = px -- head head⁺ : All P xs → Maybe.All P (head xs) head⁺ [] = nothing head⁺ (px ∷ _) = just px -- tail tail⁺ : All P xs → Maybe.All (All P) (tail xs) tail⁺ [] = nothing tail⁺ (_ ∷ pxs) = just pxs -- last last⁺ : All P xs → Maybe.All P (last xs) last⁺ [] = nothing last⁺ (px ∷ []) = just px last⁺ (px ∷ pxs@(_ ∷ _)) = last⁺ pxs -- uncons uncons⁺ : All P xs → Maybe.All (P ⟨×⟩ All P) (uncons xs) uncons⁺ [] = nothing uncons⁺ (px ∷ pxs) = just (px , pxs) uncons⁻ : Maybe.All (P ⟨×⟩ All P) (uncons xs) → All P xs uncons⁻ {xs = []} nothing = [] uncons⁻ {xs = x ∷ xs} (just (px , pxs)) = px ∷ pxs -- map map⁺ : ∀ {f : A → B} → All (P ∘ f) xs → All P (map f xs) map⁺ [] = [] map⁺ (p ∷ ps) = p ∷ map⁺ ps map⁻ : ∀ {f : A → B} → All P (map f xs) → All (P ∘ f) xs map⁻ {xs = []} [] = [] map⁻ {xs = _ ∷ _} (p ∷ ps) = p ∷ map⁻ ps -- A variant of All.map. gmap : ∀ {f : A → B} → P ⋐ Q ∘ f → All P ⋐ All Q ∘ map f gmap g = map⁺ ∘ All.map g ------------------------------------------------------------------------ -- mapMaybe mapMaybe⁺ : ∀ {f : A → Maybe B} → All (Maybe.All P) (map f xs) → All P (mapMaybe f xs) mapMaybe⁺ {xs = []} {f = f} [] = [] mapMaybe⁺ {xs = x ∷ xs} {f = f} (px ∷ pxs) with f x ... | nothing = mapMaybe⁺ pxs ... | just v with px ... | just pv = pv ∷ mapMaybe⁺ pxs ------------------------------------------------------------------------ -- _++_ ++⁺ : All P xs → All P ys → All P (xs ++ ys) ++⁺ [] pys = pys ++⁺ (px ∷ pxs) pys = px ∷ ++⁺ pxs pys ++⁻ˡ : ∀ xs {ys} → All P (xs ++ ys) → All P xs ++⁻ˡ [] p = [] ++⁻ˡ (x ∷ xs) (px ∷ pxs) = px ∷ (++⁻ˡ _ pxs) ++⁻ʳ : ∀ xs {ys} → All P (xs ++ ys) → All P ys ++⁻ʳ [] p = p ++⁻ʳ (x ∷ xs) (px ∷ pxs) = ++⁻ʳ xs pxs ++⁻ : ∀ xs {ys} → All P (xs ++ ys) → All P xs × All P ys ++⁻ [] p = [] , p ++⁻ (x ∷ xs) (px ∷ pxs) = Prod.map (px ∷_) id (++⁻ _ pxs) ++↔ : (All P xs × All P ys) ↔ All P (xs ++ ys) ++↔ {xs = zs} = inverse (uncurry ++⁺) (++⁻ zs) ++⁻∘++⁺ (++⁺∘++⁻ zs) where ++⁺∘++⁻ : ∀ xs (p : All P (xs ++ ys)) → uncurry′ ++⁺ (++⁻ xs p) ≡ p ++⁺∘++⁻ [] p = refl ++⁺∘++⁻ (x ∷ xs) (px ∷ pxs) = cong (_∷_ px) $ ++⁺∘++⁻ xs pxs ++⁻∘++⁺ : ∀ (p : All P xs × All P ys) → ++⁻ xs (uncurry ++⁺ p) ≡ p ++⁻∘++⁺ ([] , pys) = refl ++⁻∘++⁺ (px ∷ pxs , pys) rewrite ++⁻∘++⁺ (pxs , pys) = refl ------------------------------------------------------------------------ -- concat concat⁺ : ∀ {xss} → All (All P) xss → All P (concat xss) concat⁺ [] = [] concat⁺ (pxs ∷ pxss) = ++⁺ pxs (concat⁺ pxss) concat⁻ : ∀ {xss} → All P (concat xss) → All (All P) xss concat⁻ {xss = []} [] = [] concat⁻ {xss = xs ∷ xss} pxs = ++⁻ˡ xs pxs ∷ concat⁻ (++⁻ʳ xs pxs) ------------------------------------------------------------------------ -- snoc ∷ʳ⁺ : All P xs → P x → All P (xs ∷ʳ x) ∷ʳ⁺ pxs px = ++⁺ pxs (px ∷ []) ∷ʳ⁻ : All P (xs ∷ʳ x) → All P xs × P x ∷ʳ⁻ pxs = Prod.map₂ singleton⁻ $ ++⁻ _ pxs -- unsnoc unsnoc⁺ : All P xs → Maybe.All (All P ⟨×⟩ P) (unsnoc xs) unsnoc⁺ {xs = xs} pxs with initLast xs unsnoc⁺ {xs = .[]} pxs | [] = nothing unsnoc⁺ {xs = .(xs ∷ʳ x)} pxs | xs ∷ʳ′ x = just (∷ʳ⁻ pxs) unsnoc⁻ : Maybe.All (All P ⟨×⟩ P) (unsnoc xs) → All P xs unsnoc⁻ {xs = xs} pxs with initLast xs unsnoc⁻ {xs = .[]} nothing | [] = [] unsnoc⁻ {xs = .(xs ∷ʳ x)} (just (pxs , px)) | xs ∷ʳ′ x = ∷ʳ⁺ pxs px ------------------------------------------------------------------------ -- cartesianProductWith and cartesianProduct module _ (S₁ : Setoid a ℓ₁) (S₂ : Setoid b ℓ₂) where open SetoidMembership S₁ using () renaming (_∈_ to _∈₁_) open SetoidMembership S₂ using () renaming (_∈_ to _∈₂_) cartesianProductWith⁺ : ∀ f xs ys → (∀ {x y} → x ∈₁ xs → y ∈₂ ys → P (f x y)) → All P (cartesianProductWith f xs ys) cartesianProductWith⁺ f [] ys pres = [] cartesianProductWith⁺ f (x ∷ xs) ys pres = ++⁺ (map⁺ (All.tabulateₛ S₂ (pres (here (Setoid.refl S₁))))) (cartesianProductWith⁺ f xs ys (pres ∘ there)) cartesianProduct⁺ : ∀ xs ys → (∀ {x y} → x ∈₁ xs → y ∈₂ ys → P (x , y)) → All P (cartesianProduct xs ys) cartesianProduct⁺ = cartesianProductWith⁺ _,_ ------------------------------------------------------------------------ -- take and drop drop⁺ : ∀ n → All P xs → All P (drop n xs) drop⁺ zero pxs = pxs drop⁺ (suc n) [] = [] drop⁺ (suc n) (px ∷ pxs) = drop⁺ n pxs dropWhile⁺ : (Q? : Decidable Q) → All P xs → All P (dropWhile Q? xs) dropWhile⁺ Q? [] = [] dropWhile⁺ {xs = x ∷ xs} Q? (px ∷ pxs) with does (Q? x) ... | true = dropWhile⁺ Q? pxs ... | false = px ∷ pxs dropWhile⁻ : (P? : Decidable P) → dropWhile P? xs ≡ [] → All P xs dropWhile⁻ {xs = []} P? eq = [] dropWhile⁻ {xs = x ∷ xs} P? eq with P? x ... | yes px = px ∷ (dropWhile⁻ P? eq) ... | no ¬px = case eq of λ () all-head-dropWhile : (P? : Decidable P) → ∀ xs → Maybe.All (∁ P) (head (dropWhile P? xs)) all-head-dropWhile P? [] = nothing all-head-dropWhile P? (x ∷ xs) with P? x ... | yes px = all-head-dropWhile P? xs ... | no ¬px = just ¬px take⁺ : ∀ n → All P xs → All P (take n xs) take⁺ zero pxs = [] take⁺ (suc n) [] = [] take⁺ (suc n) (px ∷ pxs) = px ∷ take⁺ n pxs takeWhile⁺ : (Q? : Decidable Q) → All P xs → All P (takeWhile Q? xs) takeWhile⁺ Q? [] = [] takeWhile⁺ {xs = x ∷ xs} Q? (px ∷ pxs) with does (Q? x) ... | true = px ∷ takeWhile⁺ Q? pxs ... | false = [] takeWhile⁻ : (P? : Decidable P) → takeWhile P? xs ≡ xs → All P xs takeWhile⁻ {xs = []} P? eq = [] takeWhile⁻ {xs = x ∷ xs} P? eq with P? x ... | yes px = px ∷ takeWhile⁻ P? (Listₚ.∷-injectiveʳ eq) ... | no ¬px = case eq of λ () all-takeWhile : (P? : Decidable P) → ∀ xs → All P (takeWhile P? xs) all-takeWhile P? [] = [] all-takeWhile P? (x ∷ xs) with P? x ... | yes px = px ∷ all-takeWhile P? xs ... | no ¬px = [] ------------------------------------------------------------------------ -- applyUpTo applyUpTo⁺₁ : ∀ f n → (∀ {i} → i < n → P (f i)) → All P (applyUpTo f n) applyUpTo⁺₁ f zero Pf = [] applyUpTo⁺₁ f (suc n) Pf = Pf (s≤s z≤n) ∷ applyUpTo⁺₁ (f ∘ suc) n (Pf ∘ s≤s) applyUpTo⁺₂ : ∀ f n → (∀ i → P (f i)) → All P (applyUpTo f n) applyUpTo⁺₂ f n Pf = applyUpTo⁺₁ f n (λ _ → Pf _) applyUpTo⁻ : ∀ f n → All P (applyUpTo f n) → ∀ {i} → i < n → P (f i) applyUpTo⁻ f (suc n) (px ∷ _) (s≤s z≤n) = px applyUpTo⁻ f (suc n) (_ ∷ pxs) (s≤s (s≤s i) open import Function.Base using (id; _∘_) open import Level using (_⊔_) open import Relation.Binary as B using (Rel; _⇒_) open import Relation.Binary.Construct.Intersection renaming (_∩_ to _∩ᵇ_) open import Relation.Binary.PropositionalEquality open import Relation.Unary as U renaming (_∩_ to _∩ᵘ_) hiding (_⇒_) open import Relation.Nullary using (yes; no) import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Product using (_×-dec_) ------------------------------------------------------------------------ -- Definition open import Data.List.Relation.Unary.AllPairs.Core public ------------------------------------------------------------------------ -- Operations head : ∀ {x xs} → AllPairs R (x ∷ xs) → All (R x) xs head (px ∷ pxs) = px tail : ∀ {x xs} → AllPairs R (x ∷ xs) → AllPairs R xs tail (px ∷ pxs) = pxs uncons : ∀ {x xs} → AllPairs R (x ∷ xs) → All (R x) xs × AllPairs R xs uncons = < head , tail > module _ {q} {S : Rel A q} where map : R ⇒ S → AllPairs R ⊆ AllPairs S map ~₁⇒~₂ [] = [] map ~₁⇒~₂ (x~xs ∷ pxs) = All.map ~₁⇒~₂ x~xs ∷ (map ~₁⇒~₂ pxs) module _ {s t} {S : Rel A s} {T : Rel A t} where zipWith : R ∩ᵇ S ⇒ T → AllPairs R ∩ᵘ AllPairs S ⊆ AllPairs T zipWith f ([] , []) = [] zipWith f (px ∷ pxs , qx ∷ qxs) = All.zipWith f (px , qx) ∷ zipWith f (pxs , qxs) unzipWith : T ⇒ R ∩ᵇ S → AllPairs T ⊆ AllPairs R ∩ᵘ AllPairs S unzipWith f [] = [] , [] unzipWith f (rx ∷ rxs) = Prod.zip _∷_ _∷_ (All.unzipWith f rx) (unzipWith f rxs) module _ {s} {S : Rel A s} where zip : AllPairs R ∩ᵘ AllPairs S ⊆ AllPairs (R ∩ᵇ S) zip = zipWith id unzip : AllPairs (R ∩ᵇ S) ⊆ AllPairs R ∩ᵘ AllPairs S unzip = unzipWith id ------------------------------------------------------------------------ -- Properties of predicates preserved by AllPairs allPairs? : B.Decidable R → U.Decidable (AllPairs R) allPairs? R? [] = yes [] allPairs? R? (x ∷ xs) = Dec.map′ (uncurry _∷_) uncons (All.all? (R? x) xs ×-dec allPairs? R? xs) irrelevant : B.Irrelevant R → U.Irrelevant (AllPairs R) irrelevant irr [] [] = refl irrelevant irr (px₁ ∷ pxs₁) (px₂ ∷ pxs₂) = cong₂ _∷_ (All.irrelevant irr px₁ px₂) (irrelevant irr pxs₁ pxs₂) satisfiable : U.Satisfiable (AllPairs R) satisfiable = [] , [] agda-stdlib-1.7.3/src/Data/List/Relation/Unary/AllPairs/000077500000000000000000000000001451211343400226305ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/AllPairs/Core.agda000066400000000000000000000021111451211343400243310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists where every pair of elements are related (symmetrically) ------------------------------------------------------------------------ -- Core modules are not meant to be used directly outside of the -- standard library. -- This module should be removable if and when Agda issue -- https://github.com/agda/agda/issues/3210 is fixed {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (Rel) module Data.List.Relation.Unary.AllPairs.Core {a ℓ} {A : Set a} (R : Rel A ℓ) where open import Level open import Data.List.Base open import Data.List.Relation.Unary.All ------------------------------------------------------------------------ -- Definition -- AllPairs R xs means that every pair of elements (x , y) in xs is a -- member of relation R (as long as x comes before y in the list). infixr 5 _∷_ data AllPairs : List A → Set (a ⊔ ℓ) where [] : AllPairs [] _∷_ : ∀ {x xs} → All (R x) xs → AllPairs xs → AllPairs (x ∷ xs) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/AllPairs/Properties.agda000066400000000000000000000116741451211343400256130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to AllPairs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.AllPairs.Properties where open import Data.List hiding (any) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) open import Data.Bool.Base using (true; false) open import Data.Fin.Base using (Fin) open import Data.Fin.Properties using (suc-injective) open import Data.Nat.Base using (zero; suc; _<_; z≤n; s≤s) open import Data.Nat.Properties using (≤-refl; ≤-step) open import Function.Base using (_∘_; flip) open import Level using (Level) open import Relation.Binary using (Rel; DecSetoid) open import Relation.Binary.PropositionalEquality using (_≢_) open import Relation.Unary using (Pred; Decidable) open import Relation.Nullary using (does) private variable a b c p ℓ : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- map module _ {R : Rel A ℓ} {f : B → A} where map⁺ : ∀ {xs} → AllPairs (λ x y → R (f x) (f y)) xs → AllPairs R (map f xs) map⁺ [] = [] map⁺ (x∉xs ∷ xs!) = All.map⁺ x∉xs ∷ map⁺ xs! ------------------------------------------------------------------------ -- ++ module _ {R : Rel A ℓ} where ++⁺ : ∀ {xs ys} → AllPairs R xs → AllPairs R ys → All (λ x → All (R x) ys) xs → AllPairs R (xs ++ ys) ++⁺ [] Rys _ = Rys ++⁺ (px ∷ Rxs) Rys (Rxys ∷ Rxsys) = All.++⁺ px Rxys ∷ ++⁺ Rxs Rys Rxsys ------------------------------------------------------------------------ -- concat module _ {R : Rel A ℓ} where concat⁺ : ∀ {xss} → All (AllPairs R) xss → AllPairs (λ xs ys → All (λ x → All (R x) ys) xs) xss → AllPairs R (concat xss) concat⁺ [] [] = [] concat⁺ (pxs ∷ pxss) (Rxsxss ∷ Rxss) = ++⁺ pxs (concat⁺ pxss Rxss) (All.map All.concat⁺ (All.All-swap Rxsxss)) ------------------------------------------------------------------------ -- take and drop module _ {R : Rel A ℓ} where take⁺ : ∀ {xs} n → AllPairs R xs → AllPairs R (take n xs) take⁺ zero pxs = [] take⁺ (suc n) [] = [] take⁺ (suc n) (px ∷ pxs) = All.take⁺ n px ∷ take⁺ n pxs drop⁺ : ∀ {xs} n → AllPairs R xs → AllPairs R (drop n xs) drop⁺ zero pxs = pxs drop⁺ (suc n) [] = [] drop⁺ (suc n) (_ ∷ pxs) = drop⁺ n pxs ------------------------------------------------------------------------ -- applyUpTo module _ {R : Rel A ℓ} where applyUpTo⁺₁ : ∀ f n → (∀ {i j} → i < j → j < n → R (f i) (f j)) → AllPairs R (applyUpTo f n) applyUpTo⁺₁ f zero Rf = [] applyUpTo⁺₁ f (suc n) Rf = All.applyUpTo⁺₁ _ n (Rf (s≤s z≤n) ∘ s≤s) ∷ applyUpTo⁺₁ _ n (λ i≤j j>=_ module _ {A B : Set ℓ} {P : B → Set p} {f : A → List B} where >>=↔ : Any (Any P ∘ f) xs ↔ Any P (xs >>= f) >>=↔ {xs = xs} = Any (Any P ∘ f) xs ↔⟨ map↔ ⟩ Any (Any P) (List.map f xs) ↔⟨ concat↔ ⟩ Any P (xs >>= f) ∎ where open Related.EquationalReasoning ------------------------------------------------------------------------ -- _⊛_ ⊛↔ : ∀ {P : B → Set ℓ} {fs : List (A → B)} {xs : List A} → Any (λ f → Any (P ∘ f) xs) fs ↔ Any P (fs ⊛ xs) ⊛↔ {P = P} {fs} {xs} = Any (λ f → Any (P ∘ f) xs) fs ↔⟨ Any-cong (λ _ → Any-cong (λ _ → return↔) (_ ∎)) (_ ∎) ⟩ Any (λ f → Any (Any P ∘ return ∘ f) xs) fs ↔⟨ Any-cong (λ _ → >>=↔ ) (_ ∎) ⟩ Any (λ f → Any P (xs >>= return ∘ f)) fs ↔⟨ >>=↔ ⟩ Any P (fs ⊛ xs) ∎ where open Related.EquationalReasoning -- An alternative introduction rule for _⊛_ ⊛⁺′ : ∀ {P : A → Set ℓ} {Q : B → Set ℓ} {fs : List (A → B)} {xs} → Any (P ⟨→⟩ Q) fs → Any P xs → Any Q (fs ⊛ xs) ⊛⁺′ pq p = Inverse.to ⊛↔ ⟨$⟩ Any.map (λ pq → Any.map (λ {x} → pq {x}) p) pq ------------------------------------------------------------------------ -- _⊗_ ⊗↔ : {P : A × B → Set ℓ} {xs : List A} {ys : List B} → Any (λ x → Any (λ y → P (x , y)) ys) xs ↔ Any P (xs ⊗ ys) ⊗↔ {P = P} {xs} {ys} = Any (λ x → Any (λ y → P (x , y)) ys) xs ↔⟨ return↔ ⟩ Any (λ _,_ → Any (λ x → Any (λ y → P (x , y)) ys) xs) (return _,_) ↔⟨ ⊛↔ ⟩ Any (λ x, → Any (P ∘ x,) ys) (_,_ <$> xs) ↔⟨ ⊛↔ ⟩ Any P (xs ⊗ ys) ∎ where open Related.EquationalReasoning ⊗↔′ : {P : A → Set ℓ} {Q : B → Set ℓ} {xs : List A} {ys : List B} → (Any P xs × Any Q ys) ↔ Any (P ⟨×⟩ Q) (xs ⊗ ys) ⊗↔′ {P = P} {Q} {xs} {ys} = (Any P xs × Any Q ys) ↔⟨ ×↔ ⟩ Any (λ x → Any (λ y → P x × Q y) ys) xs ↔⟨ ⊗↔ ⟩ Any (P ⟨×⟩ Q) (xs ⊗ ys) ∎ where open Related.EquationalReasoning agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Enumerates/000077500000000000000000000000001451211343400232315ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Enumerates/Setoid.agda000066400000000000000000000012521451211343400252760ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists which contain every element of a given type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.List open import Level open import Relation.Binary module Data.List.Relation.Unary.Enumerates.Setoid {a ℓ} (S : Setoid a ℓ) where open Setoid S renaming (Carrier to A) open import Data.List.Membership.Setoid S ------------------------------------------------------------------------ -- Definition IsEnumeration : List A → Set (a ⊔ ℓ) IsEnumeration xs = ∀ x → x ∈ xs agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Enumerates/Setoid/000077500000000000000000000000001451211343400244605ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Enumerates/Setoid/Properties.agda000066400000000000000000000066231451211343400274410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of lists which contain every element of a given type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.Fin hiding (_≟_) open import Data.List.Base open import Data.List.Membership.Setoid.Properties as Membership open import Data.List.Relation.Unary.Any using (index) open import Data.List.Relation.Unary.Any.Properties using (lookup-index) open import Data.List.Relation.Unary.Enumerates.Setoid open import Data.Sum using (inj₁; inj₂) open import Data.Sum.Relation.Binary.Pointwise using (_⊎ₛ_; inj₁; inj₂) open import Data.Product using (_,_; proj₁; proj₂) open import Data.Product.Relation.Binary.Pointwise.NonDependent using (_×ₛ_) open import Function open import Level open import Relation.Binary open import Relation.Binary.PropositionalEquality using (_≡_) open import Relation.Binary.Properties.Setoid using (respʳ-flip) module Data.List.Relation.Unary.Enumerates.Setoid.Properties where open Setoid private variable a b ℓ₁ ℓ₂ : Level ------------------------------------------------------------------------ -- map module _ (S : Setoid a ℓ₁) (T : Setoid b ℓ₂) (surj : Surjection S T) where open Surjection surj map⁺ : ∀ {xs} → IsEnumeration S xs → IsEnumeration T (map f xs) map⁺ _∈xs y with surjective y ... | (x , fx≈y) = ∈-resp-≈ T fx≈y (∈-map⁺ S T cong (x ∈xs)) ------------------------------------------------------------------------ -- _++_ module _ (S : Setoid a ℓ₁) where ++⁺ˡ : ∀ {xs} ys → IsEnumeration S xs → IsEnumeration S (xs ++ ys) ++⁺ˡ _ _∈xs v = Membership.∈-++⁺ˡ S (v ∈xs) ++⁺ʳ : ∀ xs {ys} → IsEnumeration S ys → IsEnumeration S (xs ++ ys) ++⁺ʳ _ _∈ys v = Membership.∈-++⁺ʳ S _ (v ∈ys) module _ (S : Setoid a ℓ₁) (T : Setoid b ℓ₂) where ++⁺ : ∀ {xs ys} → IsEnumeration S xs → IsEnumeration T ys → IsEnumeration (S ⊎ₛ T) (map inj₁ xs ++ map inj₂ ys) ++⁺ _∈xs _ (inj₁ x) = ∈-++⁺ˡ (S ⊎ₛ T) (∈-map⁺ S (S ⊎ₛ T) inj₁ (x ∈xs)) ++⁺ _ _∈ys (inj₂ y) = ∈-++⁺ʳ (S ⊎ₛ T) _ (∈-map⁺ T (S ⊎ₛ T) inj₂ (y ∈ys)) ------------------------------------------------------------------------ -- cartesianProduct module _ (S : Setoid a ℓ₁) (T : Setoid b ℓ₂) where cartesianProduct⁺ : ∀ {xs ys} → IsEnumeration S xs → IsEnumeration T ys → IsEnumeration (S ×ₛ T) (cartesianProduct xs ys) cartesianProduct⁺ _∈xs _∈ys (x , y) = ∈-cartesianProduct⁺ S T (x ∈xs) (y ∈ys) ------------------------------------------------------------------------ -- deduplicate module _ (S? : DecSetoid a ℓ₁) where open DecSetoid S? renaming (setoid to S) deduplicate⁺ : ∀ {xs} → IsEnumeration S xs → IsEnumeration S (deduplicate _≟_ xs) deduplicate⁺ = ∈-deduplicate⁺ S _≟_ (respʳ-flip S) ∘_ ------------------------------------------------------------------------ -- lookup module _ (S : Setoid a ℓ₁) where lookup-surjective : ∀ {xs} → IsEnumeration S xs → Surjective {A = Fin (length xs)} _≡_ (_≈_ S) (lookup xs) lookup-surjective _∈xs y = index (y ∈xs) , sym S (lookup-index (y ∈xs)) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/First.agda000066400000000000000000000071001451211343400230240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- First generalizes the idea that an element is the first in a list to -- satisfy a predicate. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.First {a} {A : Set a} where open import Level using (_⊔_) open import Data.Empty open import Data.Fin.Base as Fin using (Fin; zero; suc) open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) open import Data.List.Relation.Unary.Any as Any using (Any; here; there) open import Data.Product as Prod using (∃; -,_; _,_) open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Function open import Relation.Unary open import Relation.Nullary ----------------------------------------------------------------------- -- Basic type. module _ {p q} (P : Pred A p) (Q : Pred A q) where infix 1 _++_∷_ infixr 5 _∷_ data First : Pred (List A) (a ⊔ p ⊔ q) where [_] : ∀ {x xs} → Q x → First (x ∷ xs) _∷_ : ∀ {x xs} → P x → First xs → First (x ∷ xs) data FirstView : Pred (List A) (a ⊔ p ⊔ q) where _++_∷_ : ∀ {xs y} → All P xs → Q y → ∀ ys → FirstView (xs List.++ y ∷ ys) ------------------------------------------------------------------------ -- map module _ {p q r s} {P : Pred A p} {Q : Pred A q} {R : Pred A r} {S : Pred A s} where map : P ⊆ R → Q ⊆ S → First P Q ⊆ First R S map p⇒r q⇒r [ qx ] = [ q⇒r qx ] map p⇒r q⇒r (px ∷ pqxs) = p⇒r px ∷ map p⇒r q⇒r pqxs module _ {p q r} {P : Pred A p} {Q : Pred A q} {R : Pred A r} where map₁ : P ⊆ R → First P Q ⊆ First R Q map₁ p⇒r = map p⇒r id map₂ : Q ⊆ R → First P Q ⊆ First P R map₂ = map id refine : P ⊆ Q ∪ R → First P Q ⊆ First R Q refine f [ qx ] = [ qx ] refine f (px ∷ pqxs) with f px ... | inj₁ qx = [ qx ] ... | inj₂ rx = rx ∷ refine f pqxs module _ {p q} {P : Pred A p} {Q : Pred A q} where ------------------------------------------------------------------------ -- Operations empty : ¬ First P Q [] empty () tail : ∀ {x xs} → ¬ Q x → First P Q (x ∷ xs) → First P Q xs tail ¬qx [ qx ] = ⊥-elim (¬qx qx) tail ¬qx (px ∷ pqxs) = pqxs index : First P Q ⊆ (Fin ∘′ List.length) index [ qx ] = zero index (_ ∷ pqxs) = suc (index pqxs) index-satisfied : ∀ {xs} (pqxs : First P Q xs) → Q (List.lookup xs (index pqxs)) index-satisfied [ qx ] = qx index-satisfied (_ ∷ pqxs) = index-satisfied pqxs satisfied : ∀ {xs} → First P Q xs → ∃ Q satisfied pqxs = -, index-satisfied pqxs satisfiable : Satisfiable Q → Satisfiable (First P Q) satisfiable (x , qx) = List.[ x ] , [ qx ] ------------------------------------------------------------------------ -- Decidability results first : Π[ P ∪ Q ] → Π[ First P Q ∪ All P ] first p⊎q [] = inj₂ [] first p⊎q (x ∷ xs) with p⊎q x ... | inj₁ px = Sum.map (px ∷_) (px ∷_) (first p⊎q xs) ... | inj₂ qx = inj₁ [ qx ] ------------------------------------------------------------------------ -- Relationship with Any module _ {q} {Q : Pred A q} where fromAny : Any Q ⊆ First U Q fromAny (here qx) = [ qx ] fromAny (there any) = _ ∷ fromAny any toAny : ∀ {p} {P : Pred A p} → First P Q ⊆ Any Q toAny [ qx ] = here qx toAny (_ ∷ pqxs) = there (toAny pqxs) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/First/000077500000000000000000000000001451211343400222105ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/First/Properties.agda000066400000000000000000000115541451211343400251700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of First ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.First.Properties where open import Data.Empty open import Data.Fin.Base using (suc) open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) open import Data.List.Relation.Unary.Any as Any using (here; there) open import Data.List.Relation.Unary.First import Data.Sum.Base as Sum open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; refl; _≗_) open import Relation.Unary open import Relation.Nullary.Negation ------------------------------------------------------------------------ -- map module _ {a b p q} {A : Set a} {B : Set b} {P : Pred B p} {Q : Pred B q} where map⁺ : {f : A → B} → First (P ∘′ f) (Q ∘′ f) ⊆ First P Q ∘′ List.map f map⁺ [ qfx ] = [ qfx ] map⁺ (pfxs ∷ pqfxs) = pfxs ∷ map⁺ pqfxs map⁻ : {f : A → B} → First P Q ∘′ List.map f ⊆ First (P ∘′ f) (Q ∘′ f) map⁻ {f} {x ∷ xs} [ qfx ] = [ qfx ] map⁻ {f} {x ∷ xs} (pfx ∷ pqfxs) = pfx ∷ map⁻ pqfxs ------------------------------------------------------------------------ -- (++) module _ {a p q} {A : Set a} {P : Pred A p} {Q : Pred A q} where ++⁺ : ∀ {xs ys} → All P xs → First P Q ys → First P Q (xs List.++ ys) ++⁺ [] pqys = pqys ++⁺ (px ∷ pxs) pqys = px ∷ ++⁺ pxs pqys ⁺++ : ∀ {xs} → First P Q xs → ∀ ys → First P Q (xs List.++ ys) ⁺++ [ qx ] ys = [ qx ] ⁺++ (px ∷ pqxs) ys = px ∷ ⁺++ pqxs ys ------------------------------------------------------------------------ -- Relationship to All module _ {a p q} {A : Set a} {P : Pred A p} {Q : Pred A q} where All⇒¬First : P ⊆ ∁ Q → All P ⊆ ∁ (First P Q) All⇒¬First p⇒¬q (px ∷ pxs) [ qx ] = ⊥-elim (p⇒¬q px qx) All⇒¬First p⇒¬q (_ ∷ pxs) (_ ∷ hf) = All⇒¬First p⇒¬q pxs hf First⇒¬All : Q ⊆ ∁ P → First P Q ⊆ ∁ (All P) First⇒¬All q⇒¬p [ qx ] (px ∷ pxs) = q⇒¬p qx px First⇒¬All q⇒¬p (_ ∷ pqxs) (_ ∷ pxs) = First⇒¬All q⇒¬p pqxs pxs ------------------------------------------------------------------------ -- Irrelevance unique-index : ∀ {xs} → P ⊆ ∁ Q → (f₁ f₂ : First P Q xs) → index f₁ ≡ index f₂ unique-index p⇒¬q [ _ ] [ _ ] = refl unique-index p⇒¬q [ qx ] (px ∷ _) = ⊥-elim (p⇒¬q px qx) unique-index p⇒¬q (px ∷ _) [ qx ] = ⊥-elim (p⇒¬q px qx) unique-index p⇒¬q (_ ∷ f₁) (_ ∷ f₂) = P.cong suc (unique-index p⇒¬q f₁ f₂) irrelevant : P ⊆ ∁ Q → Irrelevant P → Irrelevant Q → Irrelevant (First P Q) irrelevant p⇒¬q p-irr q-irr [ qx₁ ] [ qx₂ ] = P.cong [_] (q-irr qx₁ qx₂) irrelevant p⇒¬q p-irr q-irr [ qx₁ ] (px₂ ∷ f₂) = ⊥-elim (p⇒¬q px₂ qx₁) irrelevant p⇒¬q p-irr q-irr (px₁ ∷ f₁) [ qx₂ ] = ⊥-elim (p⇒¬q px₁ qx₂) irrelevant p⇒¬q p-irr q-irr (px₁ ∷ f₁) (px₂ ∷ f₂) = P.cong₂ _∷_ (p-irr px₁ px₂) (irrelevant p⇒¬q p-irr q-irr f₁ f₂) ------------------------------------------------------------------------ -- Decidability module _ {a p} {A : Set a} {P : Pred A p} where first? : Decidable P → Decidable (First P (∁ P)) first? P? xs = Sum.toDec $ Sum.map₂ (All⇒¬First contradiction) $ first (Sum.fromDec ∘ P?) xs cofirst? : Decidable P → Decidable (First (∁ P) P) cofirst? P? xs = Sum.toDec $ Sum.map₂ (All⇒¬First id) $ first (Sum.swap ∘ Sum.fromDec ∘ P?) xs ------------------------------------------------------------------------ -- Conversion to Any module _ {a p} {A : Set a} {P : Pred A p} where fromAny∘toAny≗id : ∀ {xs} → fromAny {Q = P} {x = xs} ∘′ toAny ≗ id fromAny∘toAny≗id [ qx ] = refl fromAny∘toAny≗id (px ∷ pqxs) = P.cong (_ ∷_) (fromAny∘toAny≗id pqxs) toAny∘fromAny≗id : ∀ {xs} → toAny {Q = P} ∘′ fromAny {x = xs} ≗ id toAny∘fromAny≗id (here px) = refl toAny∘fromAny≗id (there v) = P.cong there (toAny∘fromAny≗id v) ------------------------------------------------------------------------ -- Equivalence between the inductive definition and the view module _ {a p q} {A : Set a} {P : Pred A p} {Q : Pred A q} where toView : ∀ {as} → First P Q as → FirstView P Q as toView [ qx ] = [] ++ qx ∷ _ toView (px ∷ pqxs) with toView pqxs ... | pxs ++ qy ∷ ys = (px ∷ pxs) ++ qy ∷ ys fromView : ∀ {as} → FirstView P Q as → First P Q as fromView (pxs ++ qy ∷ ys) = ++⁺ pxs [ qy ] agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Grouped.agda000066400000000000000000000042551451211343400233520ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Property that elements are grouped ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Grouped where open import Data.List using (List; []; _∷_; map) open import Data.List.Relation.Unary.All as All using (All; []; _∷_; all?) open import Data.Sum using (_⊎_; inj₁; inj₂) open import Data.Product using (_×_; _,_) open import Relation.Binary as B using (REL; Rel) open import Relation.Unary as U using (Pred) open import Relation.Nullary using (¬_; yes) open import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Sum using (_⊎-dec_) open import Relation.Nullary.Product using (_×-dec_) open import Relation.Nullary.Negation using (¬?) open import Level using (_⊔_) infixr 5 _∷≉_ _∷≈_ data Grouped {a ℓ} {A : Set a} (_≈_ : Rel A ℓ) : Pred (List A) (a ⊔ ℓ) where [] : Grouped _≈_ [] _∷≉_ : ∀ {x xs} → All (λ y → ¬ (x ≈ y)) xs → Grouped _≈_ xs → Grouped _≈_ (x ∷ xs) _∷≈_ : ∀ {x y xs} → x ≈ y → Grouped _≈_ (y ∷ xs) → Grouped _≈_ (x ∷ y ∷ xs) module _ {a ℓ} {A : Set a} {_≈_ : Rel A ℓ} where grouped? : B.Decidable _≈_ → U.Decidable (Grouped _≈_) grouped? _≟_ [] = yes [] grouped? _≟_ (x ∷ []) = yes ([] ∷≉ []) grouped? _≟_ (x ∷ y ∷ xs) = map′ from to ((x ≟ y ⊎-dec all? (λ z → ¬? (x ≟ z)) (y ∷ xs)) ×-dec (grouped? _≟_ (y ∷ xs))) where from : ((x ≈ y) ⊎ All (λ z → ¬ (x ≈ z)) (y ∷ xs)) × Grouped _≈_ (y ∷ xs) → Grouped _≈_ (x ∷ y ∷ xs) from (inj₁ x≈y , grouped[y∷xs]) = x≈y ∷≈ grouped[y∷xs] from (inj₂ all[x≉,y∷xs] , grouped[y∷xs]) = all[x≉,y∷xs] ∷≉ grouped[y∷xs] to : Grouped _≈_ (x ∷ y ∷ xs) → ((x ≈ y) ⊎ All (λ z → ¬ (x ≈ z)) (y ∷ xs)) × Grouped _≈_ (y ∷ xs) to (all[x≉,y∷xs] ∷≉ grouped[y∷xs]) = inj₂ all[x≉,y∷xs] , grouped[y∷xs] to (x≈y ∷≈ grouped[y∷xs]) = inj₁ x≈y , grouped[y∷xs] agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Grouped/000077500000000000000000000000001451211343400225265ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Grouped/Properties.agda000066400000000000000000000064231451211343400255050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Property related to Grouped ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Grouped.Properties where open import Data.Bool using (true; false) open import Data.List open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) open import Data.List.Relation.Unary.Grouped open import Function using (_∘_; _⇔_; Equivalence) open import Function.Equality using (_⟨$⟩_) open import Relation.Binary as B using (REL; Rel) open import Relation.Unary as U using (Pred) open import Relation.Nullary using (¬_; does; yes; no) open import Relation.Nullary.Negation using (contradiction) open import Level private variable a b c p q : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- map module _ (P : Rel A p) (Q : Rel B q) where map⁺ : ∀ {f xs} → (∀ {x y} → P x y ⇔ Q (f x) (f y)) → Grouped P xs → Grouped Q (map f xs) map⁺ {f} {[]} P⇔Q [] = [] map⁺ {f} {x ∷ xs} P⇔Q (all[¬Px,xs] ∷≉ g) = aux all[¬Px,xs] ∷≉ map⁺ P⇔Q g where aux : ∀ {ys} → All (λ y → ¬ P x y) ys → All (λ y → ¬ Q (f x) y) (map f ys) aux [] = [] aux (py ∷ pys) = py ∘ Equivalence.g P⇔Q ∷ aux pys map⁺ {f} {x₁ ∷ x₂ ∷ xs} P⇔Q (Px₁x₂ ∷≈ g) = Equivalence.f P⇔Q Px₁x₂ ∷≈ map⁺ P⇔Q g map⁻ : ∀ {f xs} → (∀ {x y} → P x y ⇔ Q (f x) (f y)) → Grouped Q (map f xs) → Grouped P xs map⁻ {f} {[]} P⇔Q [] = [] map⁻ {f} {x ∷ []} P⇔Q ([] ∷≉ []) = [] ∷≉ [] map⁻ {f} {x₁ ∷ x₂ ∷ xs} P⇔Q (all[¬Qx,xs] ∷≉ g) = aux all[¬Qx,xs] ∷≉ map⁻ P⇔Q g where aux : ∀ {ys} → All (λ y → ¬ Q (f x₁) y) (map f ys) → All (λ y → ¬ P x₁ y) ys aux {[]} [] = [] aux {y ∷ ys} (py ∷ pys) = py ∘ Equivalence.f P⇔Q ∷ aux pys map⁻ {f} {x₁ ∷ x₂ ∷ xs} P⇔Q (Qx₁x₂ ∷≈ g) = Equivalence.g P⇔Q Qx₁x₂ ∷≈ map⁻ P⇔Q g ------------------------------------------------------------------------ -- [_] module _ (P : Rel A p) where [_]⁺ : ∀ x → Grouped P [ x ] [_]⁺ x = [] ∷≉ [] ------------------------------------------------------------------------ -- derun module _ {P : Rel A p} (P? : B.Decidable P) where grouped[xs]⇒unique[derun[xs]] : ∀ xs → Grouped P xs → AllPairs (λ x y → ¬ P x y) (derun P? xs) grouped[xs]⇒unique[derun[xs]] [] [] = [] grouped[xs]⇒unique[derun[xs]] (x ∷ []) ([] ∷≉ []) = [] ∷ [] grouped[xs]⇒unique[derun[xs]] (x ∷ y ∷ xs) (all[¬Px,y∷xs]@(¬Pxy ∷ _) ∷≉ grouped[y∷xs]) with P? x y ... | yes Pxy = contradiction Pxy ¬Pxy ... | no _ = All.derun⁺ P? all[¬Px,y∷xs] ∷ grouped[xs]⇒unique[derun[xs]] (y ∷ xs) grouped[y∷xs] grouped[xs]⇒unique[derun[xs]] (x ∷ y ∷ xs) (Pxy ∷≈ grouped[xs]) with P? x y ... | yes _ = grouped[xs]⇒unique[derun[xs]] (y ∷ xs) grouped[xs] ... | no ¬Pxy = contradiction Pxy ¬Pxy agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Linked.agda000066400000000000000000000076721451211343400231610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists where every consecutative pair of elements is related. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Linked {a} {A : Set a} where open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) open import Data.Product as Prod using (_,_; _×_; uncurry; <_,_>) open import Data.Maybe.Base using (just) open import Data.Maybe.Relation.Binary.Connected using (Connected; just; just-nothing) open import Function.Base using (id; _∘_) open import Level using (Level; _⊔_) open import Relation.Binary as B using (Rel; _⇒_) open import Relation.Binary.Construct.Intersection renaming (_∩_ to _∩ᵇ_) open import Relation.Binary.PropositionalEquality open import Relation.Unary as U renaming (_∩_ to _∩ᵘ_) hiding (_⇒_) open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable as Dec using (map′) open import Relation.Nullary.Product using (_×-dec_) private variable p q r ℓ : Level ------------------------------------------------------------------------ -- Definition -- Linked R xs means that every consecutative pair of elements in xs is -- a member of relation R. infixr 5 _∷_ data Linked (R : Rel A ℓ) : List A → Set (a ⊔ ℓ) where [] : Linked R [] [-] : ∀ {x} → Linked R (x ∷ []) _∷_ : ∀ {x y xs} → R x y → Linked R (y ∷ xs) → Linked R (x ∷ y ∷ xs) ------------------------------------------------------------------------ -- Operations module _ {R : Rel A p} where head : ∀ {x y xs} → Linked R (x ∷ y ∷ xs) → R x y head (Rxy ∷ Rxs) = Rxy tail : ∀ {x xs} → Linked R (x ∷ xs) → Linked R xs tail [-] = [] tail (_ ∷ Rxs) = Rxs head′ : ∀ {x xs} → Linked R (x ∷ xs) → Connected R (just x) (List.head xs) head′ [-] = just-nothing head′ (Rxy ∷ _) = just Rxy infixr 5 _∷′_ _∷′_ : ∀ {x xs} → Connected R (just x) (List.head xs) → Linked R xs → Linked R (x ∷ xs) _∷′_ {xs = []} _ _ = [-] _∷′_ {xs = y ∷ xs} (just Rxy) Ryxs = Rxy ∷ Ryxs module _ {R : Rel A p} {S : Rel A q} where map : R ⇒ S → Linked R ⊆ Linked S map R⇒S [] = [] map R⇒S [-] = [-] map R⇒S (x~xs ∷ pxs) = R⇒S x~xs ∷ map R⇒S pxs module _ {P : Rel A p} {Q : Rel A q} {R : Rel A r} where zipWith : P ∩ᵇ Q ⇒ R → Linked P ∩ᵘ Linked Q ⊆ Linked R zipWith f ([] , []) = [] zipWith f ([-] , [-]) = [-] zipWith f (px ∷ pxs , qx ∷ qxs) = f (px , qx) ∷ zipWith f (pxs , qxs) unzipWith : R ⇒ P ∩ᵇ Q → Linked R ⊆ Linked P ∩ᵘ Linked Q unzipWith f [] = [] , [] unzipWith f [-] = [-] , [-] unzipWith f (rx ∷ rxs) = Prod.zip _∷_ _∷_ (f rx) (unzipWith f rxs) module _ {P : Rel A p} {Q : Rel A q} where zip : Linked P ∩ᵘ Linked Q ⊆ Linked (P ∩ᵇ Q) zip = zipWith id unzip : Linked (P ∩ᵇ Q) ⊆ Linked P ∩ᵘ Linked Q unzip = unzipWith id ------------------------------------------------------------------------ -- Properties of predicates preserved by Linked module _ {R : Rel A ℓ} where linked? : B.Decidable R → U.Decidable (Linked R) linked? R? [] = yes [] linked? R? (x ∷ []) = yes [-] linked? R? (x ∷ y ∷ xs) = map′ (uncurry _∷_) < head , tail > (R? x y ×-dec linked? R? (y ∷ xs)) irrelevant : B.Irrelevant R → U.Irrelevant (Linked R) irrelevant irr [] [] = refl irrelevant irr [-] [-] = refl irrelevant irr (px₁ ∷ pxs₁) (px₂ ∷ pxs₂) = cong₂ _∷_ (irr px₁ px₂) (irrelevant irr pxs₁ pxs₂) satisfiable : U.Satisfiable (Linked R) satisfiable = [] , [] agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Linked/000077500000000000000000000000001451211343400223275ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Linked/Properties.agda000066400000000000000000000133221451211343400253020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to Linked ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Linked.Properties where open import Data.Bool.Base using (true; false) open import Data.List.Base hiding (any) open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) import Data.List.Relation.Unary.AllPairs.Properties as AllPairs open import Data.List.Relation.Unary.All using (All; []; _∷_) open import Data.List.Relation.Unary.Linked as Linked using (Linked; []; [-]; _∷_) open import Data.Fin.Base using (Fin) open import Data.Fin.Properties using (suc-injective) open import Data.Nat.Base using (zero; suc; _<_; z≤n; s≤s) open import Data.Nat.Properties using (≤-refl; ≤-pred; ≤-step) open import Data.Maybe.Relation.Binary.Connected using (Connected; just; nothing; just-nothing; nothing-just) open import Level using (Level) open import Function.Base using (_∘_; flip; _on_) open import Relation.Binary using (Rel; Transitive; DecSetoid) open import Relation.Binary.PropositionalEquality using (_≢_) open import Relation.Unary using (Pred; Decidable) open import Relation.Nullary using (yes; no; does) private variable a b p ℓ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Relationship to other predicates ------------------------------------------------------------------------ module _ {R : Rel A ℓ} where AllPairs⇒Linked : ∀ {xs} → AllPairs R xs → Linked R xs AllPairs⇒Linked [] = [] AllPairs⇒Linked (px ∷ []) = [-] AllPairs⇒Linked ((px ∷ _) ∷ py ∷ pxs) = px ∷ (AllPairs⇒Linked (py ∷ pxs)) module _ {R : Rel A ℓ} (trans : Transitive R) where Linked⇒All : ∀ {v x xs} → R v x → Linked R (x ∷ xs) → All (R v) (x ∷ xs) Linked⇒All Rvx [-] = Rvx ∷ [] Linked⇒All Rvx (Rxy ∷ Rxs) = Rvx ∷ Linked⇒All (trans Rvx Rxy) Rxs Linked⇒AllPairs : ∀ {xs} → Linked R xs → AllPairs R xs Linked⇒AllPairs [] = [] Linked⇒AllPairs [-] = [] ∷ [] Linked⇒AllPairs (Rxy ∷ Rxs) = Linked⇒All Rxy Rxs ∷ Linked⇒AllPairs Rxs ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- map module _ {R : Rel A ℓ} {f : B → A} where map⁺ : ∀ {xs} → Linked (R on f) xs → Linked R (map f xs) map⁺ [] = [] map⁺ [-] = [-] map⁺ (Rxy ∷ Rxs) = Rxy ∷ map⁺ Rxs map⁻ : ∀ {xs} → Linked R (map f xs) → Linked (R on f) xs map⁻ {[]} [] = [] map⁻ {x ∷ []} [-] = [-] map⁻ {x ∷ y ∷ xs} (Rxy ∷ Rxs) = Rxy ∷ map⁻ Rxs ------------------------------------------------------------------------ -- _++_ module _ {R : Rel A ℓ} where ++⁺ : ∀ {xs ys} → Linked R xs → Connected R (last xs) (head ys) → Linked R ys → Linked R (xs ++ ys) ++⁺ [] _ Rys = Rys ++⁺ [-] _ [] = [-] ++⁺ [-] (just Rxy) [-] = Rxy ∷ [-] ++⁺ [-] (just Rxy) (Ryz ∷ Rys) = Rxy ∷ Ryz ∷ Rys ++⁺ (Rxy ∷ Rxs) Rxsys Rys = Rxy ∷ ++⁺ Rxs Rxsys Rys ------------------------------------------------------------------------ -- applyUpTo module _ {R : Rel A ℓ} where applyUpTo⁺₁ : ∀ f n → (∀ {i} → suc i < n → R (f i) (f (suc i))) → Linked R (applyUpTo f n) applyUpTo⁺₁ f zero Rf = [] applyUpTo⁺₁ f (suc zero) Rf = [-] applyUpTo⁺₁ f (suc (suc n)) Rf = Rf (s≤s (s≤s z≤n)) ∷ (applyUpTo⁺₁ (f ∘ suc) (suc n) (Rf ∘ s≤s)) applyUpTo⁺₂ : ∀ f n → (∀ i → R (f i) (f (suc i))) → Linked R (applyUpTo f n) applyUpTo⁺₂ f n Rf = applyUpTo⁺₁ f n (λ _ → Rf _) ------------------------------------------------------------------------ -- applyDownFrom module _ {R : Rel A ℓ} where applyDownFrom⁺₁ : ∀ f n → (∀ {i} → suc i < n → R (f (suc i)) (f i)) → Linked R (applyDownFrom f n) applyDownFrom⁺₁ f zero Rf = [] applyDownFrom⁺₁ f (suc zero) Rf = [-] applyDownFrom⁺₁ f (suc (suc n)) Rf = Rf ≤-refl ∷ applyDownFrom⁺₁ f (suc n) (Rf ∘ ≤-step) applyDownFrom⁺₂ : ∀ f n → (∀ i → R (f (suc i)) (f i)) → Linked R (applyDownFrom f n) applyDownFrom⁺₂ f n Rf = applyDownFrom⁺₁ f n (λ _ → Rf _) ------------------------------------------------------------------------ -- filter module _ {P : Pred A p} (P? : Decidable P) {R : Rel A ℓ} (trans : Transitive R) where ∷-filter⁺ : ∀ {x xs} → Linked R (x ∷ xs) → Linked R (x ∷ filter P? xs) ∷-filter⁺ [-] = [-] ∷-filter⁺ {xs = y ∷ _} (r ∷ [-]) with does (P? y) ... | false = [-] ... | true = r ∷ [-] ∷-filter⁺ {x = x} {xs = y ∷ ys} (r ∷ r′ ∷ rs) with does (P? y) | ∷-filter⁺ {xs = ys} | ∷-filter⁺ (r′ ∷ rs) ... | false | ihf | _ = ihf (trans r r′ ∷ rs) ... | true | _ | iht = r ∷ iht filter⁺ : ∀ {xs} → Linked R xs → Linked R (filter P? xs) filter⁺ [] = [] filter⁺ {xs = x ∷ []} [-] with does (P? x) ... | false = [] ... | true = [-] filter⁺ {xs = x ∷ _} (r ∷ rs) with does (P? x) ... | false = filter⁺ rs ... | true = ∷-filter⁺ (r ∷ rs) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Sorted/000077500000000000000000000000001451211343400223615ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Sorted/TotalOrder.agda000066400000000000000000000026521451211343400252630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sorted lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (TotalOrder) module Data.List.Relation.Unary.Sorted.TotalOrder {a ℓ₁ ℓ₂} (totalOrder : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder totalOrder renaming (Carrier to A) open import Data.List.Base using (List; []; _∷_) open import Data.List.Relation.Unary.Linked as Linked using (Linked) open import Level using (_⊔_) open import Relation.Unary as U using (Pred; _⊆_) open import Relation.Binary as B ----------------------------------------------------------------------- -- Definition Sorted : Pred (List A) (a ⊔ ℓ₂) Sorted xs = Linked _≤_ xs ------------------------------------------------------------------------ -- Operations module _ {x y xs} where head : Sorted (x ∷ y ∷ xs) → x ≤ y head = Linked.head tail : Sorted (x ∷ xs) → Sorted xs tail = Linked.tail ------------------------------------------------------------------------ -- Properties of predicates preserved by Sorted sorted? : B.Decidable _≤_ → U.Decidable Sorted sorted? = Linked.linked? irrelevant : B.Irrelevant _≤_ → U.Irrelevant Sorted irrelevant = Linked.irrelevant satisfiable : U.Satisfiable Sorted satisfiable = Linked.satisfiable agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Sorted/TotalOrder/000077500000000000000000000000001451211343400244405ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Sorted/TotalOrder/Properties.agda000066400000000000000000000122571451211343400274210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sorted lists ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Sorted.TotalOrder.Properties where open import Data.List.Base open import Data.List.Relation.Unary.All using (All) open import Data.List.Relation.Unary.AllPairs using (AllPairs) open import Data.List.Relation.Unary.Linked as Linked using (Linked; []; [-]; _∷_; _∷′_; head′; tail) import Data.List.Relation.Unary.Linked.Properties as Linked open import Data.List.Relation.Unary.Sorted.TotalOrder hiding (head) open import Data.Maybe.Base using (just; nothing) open import Data.Maybe.Relation.Binary.Connected using (Connected; just) open import Data.Nat.Base using (ℕ; zero; suc; _<_; z≤n; s≤s) open import Level using (Level) open import Relation.Binary hiding (Decidable) import Relation.Binary.Properties.TotalOrder as TotalOrderProperties open import Relation.Unary using (Pred; Decidable) open import Relation.Nullary using (yes; no) private variable a b p ℓ₁ ℓ₂ ℓ₃ ℓ₄ : Level ------------------------------------------------------------------------ -- Relationship to other predicates ------------------------------------------------------------------------ module _ (O : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder O AllPairs⇒Sorted : ∀ {xs} → AllPairs _≤_ xs → Sorted O xs AllPairs⇒Sorted = Linked.AllPairs⇒Linked Sorted⇒AllPairs : ∀ {xs} → Sorted O xs → AllPairs _≤_ xs Sorted⇒AllPairs = Linked.Linked⇒AllPairs trans ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- map module _ (O₁ : TotalOrder a ℓ₁ ℓ₂) (O₂ : TotalOrder a ℓ₁ ℓ₂) where private module O₁ = TotalOrder O₁ module O₂ = TotalOrder O₂ map⁺ : ∀ {f xs} → f Preserves O₁._≤_ ⟶ O₂._≤_ → Sorted O₁ xs → Sorted O₂ (map f xs) map⁺ pres xs↗ = Linked.map⁺ (Linked.map pres xs↗) map⁻ : ∀ {f xs} → (∀ {x y} → f x O₂.≤ f y → x O₁.≤ y) → Sorted O₂ (map f xs) → Sorted O₁ xs map⁻ pres fxs↗ = Linked.map pres (Linked.map⁻ fxs↗) ------------------------------------------------------------------------ -- _++_ module _ (O : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder O ++⁺ : ∀ {xs ys} → Sorted O xs → Connected _≤_ (last xs) (head ys) → Sorted O ys → Sorted O (xs ++ ys) ++⁺ = Linked.++⁺ ------------------------------------------------------------------------ -- applyUpTo module _ (O : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder O applyUpTo⁺₁ : ∀ f n → (∀ {i} → suc i < n → f i ≤ f (suc i)) → Sorted O (applyUpTo f n) applyUpTo⁺₁ = Linked.applyUpTo⁺₁ applyUpTo⁺₂ : ∀ f n → (∀ i → f i ≤ f (suc i)) → Sorted O (applyUpTo f n) applyUpTo⁺₂ = Linked.applyUpTo⁺₂ ------------------------------------------------------------------------ -- applyDownFrom module _ (O : TotalOrder a ℓ₁ ℓ₂) where open TotalOrder O applyDownFrom⁺₁ : ∀ f n → (∀ {i} → suc i < n → f (suc i) ≤ f i) → Sorted O (applyDownFrom f n) applyDownFrom⁺₁ = Linked.applyDownFrom⁺₁ applyDownFrom⁺₂ : ∀ f n → (∀ i → f (suc i) ≤ f i) → Sorted O (applyDownFrom f n) applyDownFrom⁺₂ = Linked.applyDownFrom⁺₂ ------------------------------------------------------------------------ -- merge module _ (DO : DecTotalOrder a ℓ₁ ℓ₂) where open DecTotalOrder DO renaming (totalOrder to O) open TotalOrderProperties O using (≰⇒≥) private merge-con : ∀ {v xs ys} → Connected _≤_ (just v) (head xs) → Connected _≤_ (just v) (head ys) → Connected _≤_ (just v) (head (merge _≤?_ xs ys)) merge-con {xs = []} {[]} cxs cys = cys merge-con {xs = []} {y ∷ ys} cxs cys = cys merge-con {xs = x ∷ xs} {[]} cxs cys = cxs merge-con {xs = x ∷ xs} {y ∷ ys} cxs cys with x ≤? y ... | yes x≤y = cxs ... | no x≰y = cys merge⁺ : ∀ {xs ys} → Sorted O xs → Sorted O ys → Sorted O (merge _≤?_ xs ys) merge⁺ {[]} {[]} rxs rys = [] merge⁺ {[]} {x ∷ ys} rxs rys = rys merge⁺ {x ∷ xs} {[]} rxs rys = rxs merge⁺ {x ∷ xs} {y ∷ ys} rxs rys with x ≤? y | merge⁺ (Linked.tail rxs) rys | merge⁺ rxs (Linked.tail rys) ... | yes x≤y | rec | _ = merge-con (head′ rxs) (just x≤y) ∷′ rec ... | no x≰y | _ | rec = merge-con (just (≰⇒≥ x≰y)) (head′ rys) ∷′ rec ------------------------------------------------------------------------ -- filter module _ (O : TotalOrder a ℓ₁ ℓ₂) {P : Pred _ p} (P? : Decidable P) where open TotalOrder O filter⁺ : ∀ {xs} → Sorted O xs → Sorted O (filter P? xs) filter⁺ = Linked.filter⁺ P? trans agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/000077500000000000000000000000001451211343400223675ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecPropositional.agda000066400000000000000000000015401451211343400264630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists made up entirely of unique elements (setoid equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (DecSetoid; DecidableEquality) open import Relation.Binary.PropositionalEquality using (decSetoid) import Data.List.Relation.Unary.AllPairs as AllPairs open import Relation.Unary using (Decidable) open import Relation.Nullary.Negation using (¬?) module Data.List.Relation.Unary.Unique.DecPropositional {a} {A : Set a} (_≟_ : DecidableEquality A) where ------------------------------------------------------------------------ -- Re-export setoid definition open import Data.List.Relation.Unary.Unique.DecSetoid (decSetoid _≟_) public agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecPropositional/000077500000000000000000000000001451211343400256455ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecPropositional/Properties.agda000066400000000000000000000022311451211343400306150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of lists made up entirely of decidably unique elements ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.List import Data.List.Relation.Unary.Unique.DecSetoid.Properties as Setoid open import Data.List.Relation.Unary.All.Properties using (all-filter) open import Level open import Relation.Binary using (DecidableEquality) open import Relation.Binary.PropositionalEquality using (decSetoid) module Data.List.Relation.Unary.Unique.DecPropositional.Properties {a} {A : Set a} (_≟_ : DecidableEquality A) where open import Data.List.Relation.Unary.Unique.DecPropositional _≟_ ------------------------------------------------------------------------ -- Re-export propositional properties open import Data.List.Relation.Unary.Unique.Propositional.Properties public ------------------------------------------------------------------------ -- deduplicate deduplicate-! : ∀ xs → Unique (deduplicate _≟_ xs) deduplicate-! = Setoid.deduplicate-! (decSetoid _≟_) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecSetoid.agda000066400000000000000000000017011451211343400250470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists made up entirely of unique elements (setoid equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (DecSetoid) import Data.List.Relation.Unary.AllPairs as AllPairs open import Relation.Unary using (Decidable) open import Relation.Nullary.Negation using (¬?) module Data.List.Relation.Unary.Unique.DecSetoid {a ℓ} (DS : DecSetoid a ℓ) where open DecSetoid DS renaming (setoid to S) ------------------------------------------------------------------------ -- Re-export setoid definition open import Data.List.Relation.Unary.Unique.Setoid S public ------------------------------------------------------------------------ -- Additional properties unique? : Decidable Unique unique? = AllPairs.allPairs? (λ x y → ¬? (x ≟ y)) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecSetoid/000077500000000000000000000000001451211343400242325ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/DecSetoid/Properties.agda000066400000000000000000000020351451211343400272040ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of lists made up entirely of decidably unique elements ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.List import Data.List.Relation.Unary.Unique.DecSetoid as Unique open import Data.List.Relation.Unary.All.Properties using (all-filter) open import Data.List.Relation.Unary.Unique.Setoid.Properties open import Level open import Relation.Binary using (DecSetoid) module Data.List.Relation.Unary.Unique.DecSetoid.Properties where private variable a ℓ : Level ------------------------------------------------------------------------ -- deduplicate module _ (DS : DecSetoid a ℓ) where open DecSetoid DS renaming (setoid to S) open Unique DS deduplicate-! : ∀ xs → Unique (deduplicate _≟_ xs) deduplicate-! [] = [] deduplicate-! (x ∷ xs) = all-filter _ (deduplicate _ xs) ∷ filter⁺ S _ (deduplicate-! xs) agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/Propositional.agda000066400000000000000000000012251451211343400260470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists made up entirely of unique elements (propositional equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Unique.Propositional {a} {A : Set a} where open import Relation.Binary.PropositionalEquality using (setoid) open import Data.List.Relation.Unary.Unique.Setoid as SetoidUnique ------------------------------------------------------------------------ -- Re-export the contents of setoid uniqueness open SetoidUnique (setoid A) public agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/Propositional/000077500000000000000000000000001451211343400252315ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Relation/Unary/Unique/Propositional/Properties.agda000066400000000000000000000124151451211343400302060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of unique lists (setoid equality) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Relation.Unary.Unique.Propositional.Properties where open import Data.Fin.Base using (Fin) open import Data.List.Base open import Data.List.Relation.Binary.Disjoint.Propositional open import Data.List.Relation.Unary.All as All using (All; []; _∷_) open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs) open import Data.List.Relation.Unary.Unique.Propositional import Data.List.Relation.Unary.Unique.Setoid.Properties as Setoid open import Data.Nat.Base open import Data.Nat.Properties using (<⇒≢) open import Data.Product using (_×_; _,_) open import Data.Product.Relation.Binary.Pointwise.NonDependent using (≡⇒≡×≡) open import Function.Base using (id; _∘_) open import Level using (Level) open import Relation.Binary using (Rel; Setoid) open import Relation.Binary.PropositionalEquality using (refl; _≡_; _≢_; sym; setoid) open import Relation.Unary using (Pred; Decidable) open import Relation.Nullary using (¬_) private variable a b c p : Level ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for list operations ------------------------------------------------------------------------ -- map module _ {A : Set a} {B : Set b} where map⁺ : ∀ {f} → (∀ {x y} → f x ≡ f y → x ≡ y) → ∀ {xs} → Unique xs → Unique (map f xs) map⁺ = Setoid.map⁺ (setoid A) (setoid B) ------------------------------------------------------------------------ -- ++ module _ {A : Set a} {xs ys} where ++⁺ : Unique xs → Unique ys → Disjoint xs ys → Unique (xs ++ ys) ++⁺ = Setoid.++⁺ (setoid A) ------------------------------------------------------------------------ -- concat module _ {A : Set a} {xss} where concat⁺ : All Unique xss → AllPairs Disjoint xss → Unique (concat xss) concat⁺ = Setoid.concat⁺ (setoid A) ------------------------------------------------------------------------ -- cartesianProductWith module _ {A : Set a} {B : Set b} {C : Set c} {xs ys} where cartesianProductWith⁺ : ∀ f → (∀ {w x y z} → f w y ≡ f x z → w ≡ x × y ≡ z) → Unique xs → Unique ys → Unique (cartesianProductWith f xs ys) cartesianProductWith⁺ = Setoid.cartesianProductWith⁺ (setoid A) (setoid B) (setoid C) ------------------------------------------------------------------------ -- cartesianProduct module _ {A : Set a} {B : Set b} where cartesianProduct⁺ : ∀ {xs ys} → Unique xs → Unique ys → Unique (cartesianProduct xs ys) cartesianProduct⁺ xs ys = AllPairs.map (_∘ ≡⇒≡×≡) (Setoid.cartesianProduct⁺ (setoid A) (setoid B) xs ys) ------------------------------------------------------------------------ -- take & drop module _ {A : Set a} where drop⁺ : ∀ {xs} n → Unique xs → Unique (drop n xs) drop⁺ = Setoid.drop⁺ (setoid A) take⁺ : ∀ {xs} n → Unique xs → Unique (take n xs) take⁺ = Setoid.take⁺ (setoid A) ------------------------------------------------------------------------ -- applyUpTo & upTo module _ {A : Set a} where applyUpTo⁺₁ : ∀ f n → (∀ {i j} → i < j → j < n → f i ≢ f j) → Unique (applyUpTo f n) applyUpTo⁺₁ = Setoid.applyUpTo⁺₁ (setoid A) applyUpTo⁺₂ : ∀ f n → (∀ i j → f i ≢ f j) → Unique (applyUpTo f n) applyUpTo⁺₂ = Setoid.applyUpTo⁺₂ (setoid A) ------------------------------------------------------------------------ -- upTo upTo⁺ : ∀ n → Unique (upTo n) upTo⁺ n = applyUpTo⁺₁ id n (λ i_; z≤n; s≤s) open import Data.Nat.Induction open import Data.Nat.Properties using (≤-step) open import Data.Product as Prod using (_,_) open import Function.Base using (_∘_) open import Relation.Binary using (DecTotalOrder) open import Relation.Nullary using (¬_) module Data.List.Sort.MergeSort {a ℓ₁ ℓ₂} (O : DecTotalOrder a ℓ₁ ℓ₂) where open DecTotalOrder O renaming (Carrier to A) open import Data.List.Sort.Base totalOrder open import Data.List.Relation.Unary.Sorted.TotalOrder totalOrder hiding (head) open import Relation.Binary.Properties.DecTotalOrder O using (_≰_; ≰⇒≥; ≰-respˡ-≈) open PermutationReasoning ------------------------------------------------------------------------ -- Definition mergePairs : List (List A) → List (List A) mergePairs (xs ∷ ys ∷ xss) = merge _≤?_ xs ys ∷ mergePairs xss mergePairs xss = xss private length-mergePairs : ∀ xs ys xss → length (mergePairs (xs ∷ ys ∷ xss)) < length (xs ∷ ys ∷ xss) length-mergePairs _ _ [] = s≤s (s≤s z≤n) length-mergePairs _ _ (xss ∷ []) = s≤s (s≤s (s≤s z≤n)) length-mergePairs _ _ (xs ∷ ys ∷ xss) = s≤s (≤-step (length-mergePairs xs ys xss)) mergeAll : (xss : List (List A)) → Acc _<_ (length xss) → List A mergeAll [] _ = [] mergeAll (xs ∷ []) _ = xs mergeAll (xs ∷ ys ∷ xss) (acc rec) = mergeAll (mergePairs (xs ∷ ys ∷ xss)) (rec _ (length-mergePairs xs ys xss)) sort : List A → List A sort xs = mergeAll (map [_] xs) (<-wellFounded-fast _) ------------------------------------------------------------------------ -- Permutation property mergePairs-↭ : ∀ xss → concat (mergePairs xss) ↭ concat xss mergePairs-↭ [] = ↭-refl mergePairs-↭ (xs ∷ []) = ↭-refl mergePairs-↭ (xs ∷ ys ∷ xss) = begin merge _ xs ys ++ concat (mergePairs xss) ↭⟨ Perm.++⁺ (Perm.merge-↭ _ xs ys) (mergePairs-↭ xss) ⟩ (xs ++ ys) ++ concat xss ≡⟨ ++-assoc xs ys (concat xss) ⟩ xs ++ ys ++ concat xss ∎ mergeAll-↭ : ∀ xss (rec : Acc _<_ (length xss)) → mergeAll xss rec ↭ concat xss mergeAll-↭ [] _ = ↭-refl mergeAll-↭ (xs ∷ []) _ = ↭-sym (Perm.++-identityʳ xs) mergeAll-↭ (xs ∷ ys ∷ xss) (acc rec) = begin mergeAll (mergePairs (xs ∷ ys ∷ xss)) _ ↭⟨ mergeAll-↭ (mergePairs (xs ∷ ys ∷ xss)) _ ⟩ concat (mergePairs (xs ∷ ys ∷ xss)) ↭⟨ mergePairs-↭ (xs ∷ ys ∷ xss) ⟩ concat (xs ∷ ys ∷ xss) ∎ sort-↭ : ∀ xs → sort xs ↭ xs sort-↭ xs = begin mergeAll (map [_] xs) _ ↭⟨ mergeAll-↭ (map [_] xs) _ ⟩ concat (map [_] xs) ≡⟨ concat-[-] xs ⟩ xs ∎ ------------------------------------------------------------------------ -- Sorted property mergePairs-↗ : ∀ {xss} → All Sorted xss → All Sorted (mergePairs xss) mergePairs-↗ [] = [] mergePairs-↗ (xs↗ ∷ []) = xs↗ ∷ [] mergePairs-↗ (xs↗ ∷ ys↗ ∷ xss↗) = Sorted.merge⁺ O xs↗ ys↗ ∷ mergePairs-↗ xss↗ mergeAll-↗ : ∀ {xss} (rec : Acc _<_ (length xss)) → All Sorted xss → Sorted (mergeAll xss rec) mergeAll-↗ rec [] = [] mergeAll-↗ rec (xs↗ ∷ []) = xs↗ mergeAll-↗ (acc rec) (xs↗ ∷ ys↗ ∷ xss↗) = mergeAll-↗ _ (mergePairs-↗ (xs↗ ∷ ys↗ ∷ xss↗)) sort-↗ : ∀ xs → Sorted (sort xs) sort-↗ xs = mergeAll-↗ _ (All.map⁺ (All.universal (λ _ → [-]) xs)) ------------------------------------------------------------------------ -- Algorithm mergeSort : SortingAlgorithm mergeSort = record { sort = sort ; sort-↭ = sort-↭ ; sort-↗ = sort-↗ } agda-stdlib-1.7.3/src/Data/List/Zipper.agda000066400000000000000000000074331451211343400203440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- List Zippers, basic types and operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Zipper where open import Data.Nat.Base open import Data.Maybe.Base as Maybe using (Maybe ; just ; nothing) open import Data.List.Base as List using (List ; [] ; _∷_) open import Function -- Definition ------------------------------------------------------------------------ -- A List Zipper represents a List together with a particular sub-List -- in focus. The user can attempt to move the focus left or right, with -- a risk of failure if one has already reached the corresponding end. -- To make these operations efficient, the `context` the sub List in -- focus lives in is stored *backwards*. This is made formal by `toList` -- which returns the List a Zipper represents. record Zipper {a} (A : Set a) : Set a where constructor mkZipper field context : List A value : List A toList : List A toList = List.reverse context List.++ value open Zipper public -- Embedding Lists as Zippers without any context fromList : ∀ {a} {A : Set a} → List A → Zipper A fromList = mkZipper [] -- Fundamental operations of a Zipper: Moving around ------------------------------------------------------------------------ module _ {a} {A : Set a} where left : Zipper A → Maybe (Zipper A) left (mkZipper [] val) = nothing left (mkZipper (x ∷ ctx) val) = just (mkZipper ctx (x ∷ val)) right : Zipper A → Maybe (Zipper A) right (mkZipper ctx []) = nothing right (mkZipper ctx (x ∷ val)) = just (mkZipper (x ∷ ctx) val) -- Focus-respecting operations ------------------------------------------------------------------------ module _ {a} {A : Set a} where reverse : Zipper A → Zipper A reverse (mkZipper ctx val) = mkZipper val ctx -- If we think of a List [x₁⋯xₘ] split into a List [xₙ₊₁⋯xₘ] in focus -- of another list [x₁⋯xₙ] then there are 4 places (marked {k} here) in -- which we can insert new values: [{1}x₁⋯xₙ{2}][{3}xₙ₊₁⋯xₘ{4}] -- The following 4 functions implement these 4 insertions. -- `xs ˢ++ zp` inserts `xs` on the `s` side of the context of the Zipper `zp` -- `zp ++ˢ xs` insert `xs` on the `s` side of the value in focus of the Zipper `zp` infixr 5 _ˡ++_ _ʳ++_ infixl 5 _++ˡ_ _++ʳ_ -- {1} _ˡ++_ : List A → Zipper A → Zipper A xs ˡ++ mkZipper ctx val = mkZipper (ctx List.++ List.reverse xs) val -- {2} _ʳ++_ : List A → Zipper A → Zipper A xs ʳ++ mkZipper ctx val = mkZipper (List.reverse xs List.++ ctx) val -- {3} _++ˡ_ : Zipper A → List A → Zipper A mkZipper ctx val ++ˡ xs = mkZipper ctx (xs List.++ val) -- {4} _++ʳ_ : Zipper A → List A → Zipper A mkZipper ctx val ++ʳ xs = mkZipper ctx (val List.++ xs) -- List-like operations ------------------------------------------------------------------------ module _ {a} {A : Set a} where length : Zipper A → ℕ length (mkZipper ctx val) = List.length ctx + List.length val module _ {a b} {A : Set a} {B : Set b} where map : (A → B) → Zipper A → Zipper B map f (mkZipper ctx val) = (mkZipper on List.map f) ctx val foldr : (A → B → B) → B → Zipper A → B foldr c n (mkZipper ctx val) = List.foldl (flip c) (List.foldr c n val) ctx -- Generating all the possible foci of a list ------------------------------------------------------------------------ module _ {a} {A : Set a} where allFociIn : List A → List A → List (Zipper A) allFociIn ctx [] = List.[ mkZipper ctx [] ] allFociIn ctx xxs@(x ∷ xs) = mkZipper ctx xxs ∷ allFociIn (x ∷ ctx) xs allFoci : List A → List (Zipper A) allFoci = allFociIn [] agda-stdlib-1.7.3/src/Data/List/Zipper/000077500000000000000000000000001451211343400175175ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/List/Zipper/Properties.agda000066400000000000000000000131701451211343400224730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- List Zipper-related properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.List.Zipper.Properties where open import Data.List.Base as List using (List ; [] ; _∷_) open import Data.List.Properties open import Data.List.Zipper open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Maybe.Relation.Unary.All using (All; just; nothing) open import Relation.Binary.PropositionalEquality open ≡-Reasoning open import Function -- Invariant: Zipper represents a given list ------------------------------------------------------------------------ module _ {a} {A : Set a} where -- Stability under moving left or right toList-left-identity : (zp : Zipper A) → All ((_≡_ on toList) zp) (left zp) toList-left-identity (mkZipper [] val) = nothing toList-left-identity (mkZipper (x ∷ ctx) val) = just $′ begin List.reverse (x ∷ ctx) List.++ val ≡⟨ cong (List._++ val) (unfold-reverse x ctx) ⟩ (List.reverse ctx List.++ List.[ x ]) List.++ val ≡⟨ ++-assoc (List.reverse ctx) List.[ x ] val ⟩ toList (mkZipper ctx (x ∷ val)) ∎ toList-right-identity : (zp : Zipper A) → All ((_≡_ on toList) zp) (right zp) toList-right-identity (mkZipper ctx []) = nothing toList-right-identity (mkZipper ctx (x ∷ val)) = just $′ begin List.reverse ctx List.++ x ∷ val ≡⟨ sym (++-assoc (List.reverse ctx) List.[ x ] val) ⟩ (List.reverse ctx List.++ List.[ x ]) List.++ val ≡⟨ cong (List._++ val) (sym (unfold-reverse x ctx)) ⟩ List.reverse (x ∷ ctx) List.++ val ∎ -- Applying reverse does correspond to reversing the represented list toList-reverse-commute : (zp : Zipper A) → toList (reverse zp) ≡ List.reverse (toList zp) toList-reverse-commute (mkZipper ctx val) = begin List.reverse val List.++ ctx ≡⟨ cong (List.reverse val List.++_) (sym (reverse-involutive ctx)) ⟩ List.reverse val List.++ List.reverse (List.reverse ctx) ≡⟨ sym (reverse-++-commute (List.reverse ctx) val) ⟩ List.reverse (List.reverse ctx List.++ val) ∎ -- Properties of the insertion functions ------------------------------------------------------------------------ -- _ˡ++_ properties toList-ˡ++-commute : ∀ xs (zp : Zipper A) → toList (xs ˡ++ zp) ≡ xs List.++ toList zp toList-ˡ++-commute xs (mkZipper ctx val) = begin List.reverse (ctx List.++ List.reverse xs) List.++ val ≡⟨ cong (List._++ _) (reverse-++-commute ctx (List.reverse xs)) ⟩ (List.reverse (List.reverse xs) List.++ List.reverse ctx) List.++ val ≡⟨ ++-assoc (List.reverse (List.reverse xs)) (List.reverse ctx) val ⟩ List.reverse (List.reverse xs) List.++ List.reverse ctx List.++ val ≡⟨ cong (List._++ _) (reverse-involutive xs) ⟩ xs List.++ List.reverse ctx List.++ val ∎ ˡ++-assoc : ∀ xs ys (zp : Zipper A) → xs ˡ++ (ys ˡ++ zp) ≡ (xs List.++ ys) ˡ++ zp ˡ++-assoc xs ys (mkZipper ctx val) = cong (λ ctx → mkZipper ctx val) $ begin (ctx List.++ List.reverse ys) List.++ List.reverse xs ≡⟨ ++-assoc ctx _ _ ⟩ ctx List.++ List.reverse ys List.++ List.reverse xs ≡⟨ cong (ctx List.++_) (sym (reverse-++-commute xs ys)) ⟩ ctx List.++ List.reverse (xs List.++ ys) ∎ -- _ʳ++_ properties ʳ++-assoc : ∀ xs ys (zp : Zipper A) → xs ʳ++ (ys ʳ++ zp) ≡ (ys List.++ xs) ʳ++ zp ʳ++-assoc xs ys (mkZipper ctx val) = cong (λ ctx → mkZipper ctx val) $ begin List.reverse xs List.++ List.reverse ys List.++ ctx ≡⟨ sym (++-assoc (List.reverse xs) (List.reverse ys) ctx) ⟩ (List.reverse xs List.++ List.reverse ys) List.++ ctx ≡⟨ cong (List._++ ctx) (sym (reverse-++-commute ys xs)) ⟩ List.reverse (ys List.++ xs) List.++ ctx ∎ -- _++ˡ_ properties ++ˡ-assoc : ∀ xs ys (zp : Zipper A) → zp ++ˡ xs ++ˡ ys ≡ zp ++ˡ (ys List.++ xs) ++ˡ-assoc xs ys (mkZipper ctx val) = cong (mkZipper ctx) $ sym $ ++-assoc ys xs val -- _++ʳ_ properties toList-++ʳ-commute : ∀ (zp : Zipper A) xs → toList (zp ++ʳ xs) ≡ toList zp List.++ xs toList-++ʳ-commute (mkZipper ctx val) xs = begin List.reverse ctx List.++ val List.++ xs ≡⟨ sym (++-assoc (List.reverse ctx) val xs) ⟩ (List.reverse ctx List.++ val) List.++ xs ∎ ++ʳ-assoc : ∀ xs ys (zp : Zipper A) → zp ++ʳ xs ++ʳ ys ≡ zp ++ʳ (xs List.++ ys) ++ʳ-assoc xs ys (mkZipper ctx val) = cong (mkZipper ctx) $ ++-assoc val xs ys -- List-like operations indeed correspond to their counterparts ------------------------------------------------------------------------ module _ {a b} {A : Set a} {B : Set b} where toList-map-commute : ∀ (f : A → B) zp → toList (map f zp) ≡ List.map f (toList zp) toList-map-commute f zp@(mkZipper ctx val) = begin List.reverse (List.map f ctx) List.++ List.map f val ≡⟨ cong (List._++ _) (sym (reverse-map-commute f ctx)) ⟩ List.map f (List.reverse ctx) List.++ List.map f val ≡⟨ sym (map-++-commute f (List.reverse ctx) val) ⟩ List.map f (List.reverse ctx List.++ val) ∎ toList-foldr-commute : ∀ (c : A → B → B) n zp → foldr c n zp ≡ List.foldr c n (toList zp) toList-foldr-commute c n (mkZipper ctx val) = begin List.foldl (flip c) (List.foldr c n val) ctx ≡⟨ sym (reverse-foldr c (List.foldr c n val) ctx) ⟩ List.foldr c (List.foldr c n val) (List.reverse ctx) ≡⟨ sym (foldr-++ c n (List.reverse ctx) val) ⟩ List.foldr c n (List.reverse ctx List.++ val) ∎ agda-stdlib-1.7.3/src/Data/Maybe.agda000066400000000000000000000021211451211343400172020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Maybe type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe where open import Data.Empty using (⊥) open import Data.Unit using (⊤) open import Data.Bool.Base using (T) open import Data.Maybe.Relation.Unary.All open import Data.Maybe.Relation.Unary.Any open import Level using (Level) private variable a : Level A : Set a ------------------------------------------------------------------------ -- The base type and some operations open import Data.Maybe.Base public ------------------------------------------------------------------------ -- Using Any and All to define Is-just and Is-nothing Is-just : Maybe A → Set _ Is-just = Any (λ _ → ⊤) Is-nothing : Maybe A → Set _ Is-nothing = All (λ _ → ⊥) to-witness : ∀ {m : Maybe A} → Is-just m → A to-witness (just {x = p} _) = p to-witness-T : ∀ (m : Maybe A) → T (is-just m) → A to-witness-T (just p) _ = p agda-stdlib-1.7.3/src/Data/Maybe/000077500000000000000000000000001451211343400163705ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Maybe/Base.agda000066400000000000000000000066311451211343400200660ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- The Maybe type and some operations ------------------------------------------------------------------------ -- The definitions in this file are reexported by Data.Maybe. {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Base where open import Level open import Data.Bool.Base using (Bool; true; false; not) open import Data.Unit.Base using (⊤) open import Data.These.Base using (These; this; that; these) open import Data.Product as Prod using (_×_; _,_) open import Function.Base open import Relation.Nullary.Reflects open import Relation.Nullary private variable a b c : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Definition open import Agda.Builtin.Maybe public using (Maybe; just; nothing) ------------------------------------------------------------------------ -- Some operations boolToMaybe : Bool → Maybe ⊤ boolToMaybe true = just _ boolToMaybe false = nothing is-just : Maybe A → Bool is-just (just _) = true is-just nothing = false is-nothing : Maybe A → Bool is-nothing = not ∘ is-just decToMaybe : Dec A → Maybe A decToMaybe ( true because [a]) = just (invert [a]) decToMaybe (false because _ ) = nothing -- A dependent eliminator. maybe : ∀ {A : Set a} {B : Maybe A → Set b} → ((x : A) → B (just x)) → B nothing → (x : Maybe A) → B x maybe j n (just x) = j x maybe j n nothing = n -- A non-dependent eliminator. maybe′ : (A → B) → B → Maybe A → B maybe′ = maybe -- A defaulting mechanism fromMaybe : A → Maybe A → A fromMaybe = maybe′ id -- A safe variant of "fromJust". If the value is nothing, then the -- return type is the unit type. module _ {a} {A : Set a} where From-just : Maybe A → Set a From-just (just _) = A From-just nothing = Lift a ⊤ from-just : (x : Maybe A) → From-just x from-just (just x) = x from-just nothing = _ -- Functoriality: map map : (A → B) → Maybe A → Maybe B map f = maybe (just ∘ f) nothing -- Applicative: ap ap : Maybe (A → B) → Maybe A → Maybe B ap nothing = const nothing ap (just f) = map f -- Monad: bind infixl 1 _>>=_ _>>=_ : Maybe A → (A → Maybe B) → Maybe B nothing >>= f = nothing just a >>= f = f a -- Alternative: <∣> _<∣>_ : Maybe A → Maybe A → Maybe A just x <∣> my = just x nothing <∣> my = my -- Just when the boolean is true when : Bool → A → Maybe A when b c = map (const c) (boolToMaybe b) ------------------------------------------------------------------------ -- Aligning and zipping alignWith : (These A B → C) → Maybe A → Maybe B → Maybe C alignWith f (just a) (just b) = just (f (these a b)) alignWith f (just a) nothing = just (f (this a)) alignWith f nothing (just b) = just (f (that b)) alignWith f nothing nothing = nothing zipWith : (A → B → C) → Maybe A → Maybe B → Maybe C zipWith f (just a) (just b) = just (f a b) zipWith _ _ _ = nothing align : Maybe A → Maybe B → Maybe (These A B) align = alignWith id zip : Maybe A → Maybe B → Maybe (A × B) zip = zipWith _,_ ------------------------------------------------------------------------ -- Injections. thisM : A → Maybe B → These A B thisM a = maybe′ (these a) (this a) thatM : Maybe A → B → These A B thatM = maybe′ these that agda-stdlib-1.7.3/src/Data/Maybe/Categorical.agda000066400000000000000000000047651451211343400214370ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A categorical view of Maybe ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Categorical where open import Data.Maybe.Base open import Category.Functor open import Category.Applicative open import Category.Monad import Function.Identity.Categorical as Id open import Function ------------------------------------------------------------------------ -- Maybe applicative functor functor : ∀ {f} → RawFunctor {f} Maybe functor = record { _<$>_ = map } applicative : ∀ {f} → RawApplicative {f} Maybe applicative = record { pure = just ; _⊛_ = maybe map (const nothing) } applicativeZero : ∀ {f} → RawApplicativeZero {f} Maybe applicativeZero = record { applicative = applicative ; ∅ = nothing } alternative : ∀ {f} → RawAlternative {f} Maybe alternative = record { applicativeZero = applicativeZero ; _∣_ = _<∣>_ } ------------------------------------------------------------------------ -- Maybe monad transformer monadT : ∀ {f} → RawMonadT {f} (_∘′ Maybe) monadT M = record { return = M.return ∘ just ; _>>=_ = λ m f → m M.>>= maybe f (M.return nothing) } where module M = RawMonad M ------------------------------------------------------------------------ -- Maybe monad monad : ∀ {f} → RawMonad {f} Maybe monad = monadT Id.monad monadZero : ∀ {f} → RawMonadZero {f} Maybe monadZero = record { monad = monad ; applicativeZero = applicativeZero } monadPlus : ∀ {f} → RawMonadPlus {f} Maybe monadPlus {f} = record { monad = monad ; alternative = alternative } ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {f F} (App : RawApplicative {f} F) where open RawApplicative App sequenceA : ∀ {A} → Maybe (F A) → F (Maybe A) sequenceA nothing = pure nothing sequenceA (just x) = just <$> x mapA : ∀ {a} {A : Set a} {B} → (A → F B) → Maybe A → F (Maybe B) mapA f = sequenceA ∘ map f forA : ∀ {a} {A : Set a} {B} → Maybe A → (A → F B) → F (Maybe B) forA = flip mapA module TraversableM {m M} (Mon : RawMonad {m} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) agda-stdlib-1.7.3/src/Data/Maybe/Instances.agda000066400000000000000000000011441451211343400211350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for Maybe ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Instances where open import Data.Maybe.Categorical instance maybeFunctor = functor maybeApplicative = applicative maybeApplicativeZero = applicativeZero maybeAlternative = alternative maybeMonad = monad maybeMonadZero = monadZero maybeMonadPlus = monadPlus maybeMonadT = λ {ℓ} {M} {{inst}} → monadT {ℓ} {M} inst agda-stdlib-1.7.3/src/Data/Maybe/Properties.agda000066400000000000000000000105671451211343400213530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Maybe-related properties ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Properties where open import Algebra.Bundles import Algebra.Structures as Structures import Algebra.Definitions as Definitions open import Data.Maybe.Base open import Data.Maybe.Relation.Unary.All using (All; just; nothing) open import Data.Product using (_,_) open import Function open import Level using (Level) open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (map′) private variable a b c : Level A : Set a B : Set b C : Set c ------------------------------------------------------------------------ -- Equality just-injective : ∀ {x y} → (Maybe A ∋ just x) ≡ just y → x ≡ y just-injective refl = refl ≡-dec : Decidable _≡_ → Decidable {A = Maybe A} _≡_ ≡-dec _≟_ nothing nothing = yes refl ≡-dec _≟_ (just x) nothing = no λ() ≡-dec _≟_ nothing (just y) = no λ() ≡-dec _≟_ (just x) (just y) = map′ (cong just) just-injective (x ≟ y) ------------------------------------------------------------------------ -- map map-id : map id ≗ id {A = Maybe A} map-id (just x) = refl map-id nothing = refl map-id₂ : ∀ {f : A → A} {mx} → All (λ x → f x ≡ x) mx → map f mx ≡ mx map-id₂ (just eq) = cong just eq map-id₂ nothing = refl map-<∣>-commute : ∀ (f : A → B) mx my → map f (mx <∣> my) ≡ map f mx <∣> map f my map-<∣>-commute f (just x) my = refl map-<∣>-commute f nothing my = refl map-cong : {f g : A → B} → f ≗ g → map f ≗ map g map-cong f≗g (just x) = cong just (f≗g x) map-cong f≗g nothing = refl map-cong₂ : ∀ {f g : A → B} {mx} → All (λ x → f x ≡ g x) mx → map f mx ≡ map g mx map-cong₂ (just eq) = cong just eq map-cong₂ nothing = refl map-injective : ∀ {f : A → B} → Injective _≡_ _≡_ f → Injective _≡_ _≡_ (map f) map-injective f-inj {nothing} {nothing} p = refl map-injective f-inj {just x} {just y} p = cong just (f-inj (just-injective p)) map-compose : {g : B → C} {f : A → B} → map (g ∘ f) ≗ map g ∘ map f map-compose (just x) = refl map-compose nothing = refl map-nothing : ∀ {f : A → B} {ma} → ma ≡ nothing → map f ma ≡ nothing map-nothing refl = refl map-just : ∀ {f : A → B} {ma a} → ma ≡ just a → map f ma ≡ just (f a) map-just refl = refl ------------------------------------------------------------------------ -- maybe maybe-map : ∀ {C : Maybe B → Set c} (j : (x : B) → C (just x)) (n : C nothing) (f : A → B) ma → maybe {B = C} j n (map f ma) ≡ maybe {B = C ∘ map f} (j ∘ f) n ma maybe-map j n f (just x) = refl maybe-map j n f nothing = refl maybe′-map : ∀ j (n : C) (f : A → B) ma → maybe′ j n (map f ma) ≡ maybe′ (j ∘′ f) n ma maybe′-map = maybe-map ------------------------------------------------------------------------ -- _<∣>_ module _ {A : Set a} where open Definitions {A = Maybe A} _≡_ <∣>-assoc : Associative _<∣>_ <∣>-assoc (just x) y z = refl <∣>-assoc nothing y z = refl <∣>-identityˡ : LeftIdentity nothing _<∣>_ <∣>-identityˡ (just x) = refl <∣>-identityˡ nothing = refl <∣>-identityʳ : RightIdentity nothing _<∣>_ <∣>-identityʳ (just x) = refl <∣>-identityʳ nothing = refl <∣>-identity : Identity nothing _<∣>_ <∣>-identity = <∣>-identityˡ , <∣>-identityʳ module _ (A : Set a) where open Structures {A = Maybe A} _≡_ <∣>-isMagma : IsMagma _<∣>_ <∣>-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = cong₂ _<∣>_ } <∣>-isSemigroup : IsSemigroup _<∣>_ <∣>-isSemigroup = record { isMagma = <∣>-isMagma ; assoc = <∣>-assoc } <∣>-isMonoid : IsMonoid _<∣>_ nothing <∣>-isMonoid = record { isSemigroup = <∣>-isSemigroup ; identity = <∣>-identity } <∣>-semigroup : Semigroup a a <∣>-semigroup = record { isSemigroup = <∣>-isSemigroup } <∣>-monoid : Monoid a a <∣>-monoid = record { isMonoid = <∣>-isMonoid } agda-stdlib-1.7.3/src/Data/Maybe/Relation/000077500000000000000000000000001451211343400201455ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Maybe/Relation/Binary/000077500000000000000000000000001451211343400213715ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Maybe/Relation/Binary/Connected.agda000066400000000000000000000043151451211343400241140ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lifting a relation such that `nothing` is also related to `just` ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Relation.Binary.Connected where open import Level open import Data.Product open import Data.Maybe.Base using (Maybe; just; nothing) open import Function.Equivalence using (_⇔_; equivalence) open import Relation.Binary hiding (_⇔_) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary import Relation.Nullary.Decidable as Dec private variable a b ℓ : Level A : Set a B : Set b R S T : REL A B ℓ x y : A ------------------------------------------------------------------------ -- Definition data Connected {A : Set a} {B : Set b} (R : REL A B ℓ) : REL (Maybe A) (Maybe B) (a ⊔ b ⊔ ℓ) where just : R x y → Connected R (just x) (just y) just-nothing : Connected R (just x) nothing nothing-just : Connected R nothing (just y) nothing : Connected R nothing nothing ------------------------------------------------------------------------ -- Properties drop-just : Connected R (just x) (just y) → R x y drop-just (just p) = p just-equivalence : R x y ⇔ Connected R (just x) (just y) just-equivalence = equivalence just drop-just ------------------------------------------------------------------------ -- Relational properties refl : Reflexive R → Reflexive (Connected R) refl R-refl {just _} = just R-refl refl R-refl {nothing} = nothing reflexive : _≡_ ⇒ R → _≡_ ⇒ Connected R reflexive reflexive P.refl = refl (reflexive P.refl) sym : Sym R S → Sym (Connected R) (Connected S) sym R-sym (just p) = just (R-sym p) sym R-sym nothing-just = just-nothing sym R-sym just-nothing = nothing-just sym R-sym nothing = nothing connected? : Decidable R → Decidable (Connected R) connected? R? (just x) (just y) = Dec.map just-equivalence (R? x y) connected? R? (just x) nothing = yes just-nothing connected? R? nothing (just y) = yes nothing-just connected? R? nothing nothing = yes nothing agda-stdlib-1.7.3/src/Data/Maybe/Relation/Binary/Pointwise.agda000066400000000000000000000071211451211343400241710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise lifting of relations to maybes ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Relation.Binary.Pointwise where open import Level open import Data.Product open import Data.Maybe.Base using (Maybe; just; nothing) open import Function.Equivalence using (_⇔_; equivalence) open import Relation.Binary hiding (_⇔_) open import Relation.Binary.PropositionalEquality as P using (_≡_) open import Relation.Nullary import Relation.Nullary.Decidable as Dec ------------------------------------------------------------------------ -- Definition data Pointwise {a b ℓ} {A : Set a} {B : Set b} (R : REL A B ℓ) : REL (Maybe A) (Maybe B) (a ⊔ b ⊔ ℓ) where just : ∀ {x y} → R x y → Pointwise R (just x) (just y) nothing : Pointwise R nothing nothing ------------------------------------------------------------------------ -- Properties module _ {a b ℓ} {A : Set a} {B : Set b} {R : REL A B ℓ} where drop-just : ∀ {x y} → Pointwise R (just x) (just y) → R x y drop-just (just p) = p just-equivalence : ∀ {x y} → R x y ⇔ Pointwise R (just x) (just y) just-equivalence = equivalence just drop-just nothing-inv : ∀ {x} → Pointwise R nothing x → x ≡ nothing nothing-inv nothing = P.refl just-inv : ∀ {x y} → Pointwise R (just x) y → ∃ λ z → y ≡ just z × R x z just-inv (just r) = -, P.refl , r ------------------------------------------------------------------------ -- Relational properties module _ {a r} {A : Set a} {R : Rel A r} where refl : Reflexive R → Reflexive (Pointwise R) refl R-refl {just _} = just R-refl refl R-refl {nothing} = nothing reflexive : _≡_ ⇒ R → _≡_ ⇒ Pointwise R reflexive reflexive P.refl = refl (reflexive P.refl) module _ {a b r₁ r₂} {A : Set a} {B : Set b} {R : REL A B r₁} {S : REL B A r₂} where sym : Sym R S → Sym (Pointwise R) (Pointwise S) sym R-sym (just p) = just (R-sym p) sym R-sym nothing = nothing module _ {a b c r₁ r₂ r₃} {A : Set a} {B : Set b} {C : Set c} {R : REL A B r₁} {S : REL B C r₂} {T : REL A C r₃} where trans : Trans R S T → Trans (Pointwise R) (Pointwise S) (Pointwise T) trans R-trans (just p) (just q) = just (R-trans p q) trans R-trans nothing nothing = nothing module _ {a r} {A : Set a} {R : Rel A r} where dec : Decidable R → Decidable (Pointwise R) dec R-dec (just x) (just y) = Dec.map just-equivalence (R-dec x y) dec R-dec (just x) nothing = no (λ ()) dec R-dec nothing (just y) = no (λ ()) dec R-dec nothing nothing = yes nothing isEquivalence : IsEquivalence R → IsEquivalence (Pointwise R) isEquivalence R-isEquivalence = record { refl = refl R.refl ; sym = sym R.sym ; trans = trans R.trans } where module R = IsEquivalence R-isEquivalence isDecEquivalence : IsDecEquivalence R → IsDecEquivalence (Pointwise R) isDecEquivalence R-isDecEquivalence = record { isEquivalence = isEquivalence R.isEquivalence ; _≟_ = dec R._≟_ } where module R = IsDecEquivalence R-isDecEquivalence module _ {c ℓ} where setoid : Setoid c ℓ → Setoid c (c ⊔ ℓ) setoid S = record { isEquivalence = isEquivalence S.isEquivalence } where module S = Setoid S decSetoid : DecSetoid c ℓ → DecSetoid c (c ⊔ ℓ) decSetoid S = record { isDecEquivalence = isDecEquivalence S.isDecEquivalence } where module S = DecSetoid S agda-stdlib-1.7.3/src/Data/Maybe/Relation/Unary/000077500000000000000000000000001451211343400212435ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Maybe/Relation/Unary/All.agda000066400000000000000000000076761451211343400226110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Maybes where all the elements satisfy a given property ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Relation.Unary.All where open import Category.Applicative open import Category.Monad open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Maybe.Relation.Unary.Any using (Any; just) open import Data.Product as Prod using (_,_) open import Function.Base using (id; _∘′_) open import Function.Equivalence using (_⇔_; equivalence) open import Level open import Relation.Binary.PropositionalEquality as P using (_≡_; cong) open import Relation.Unary open import Relation.Nullary hiding (Irrelevant) import Relation.Nullary.Decidable as Dec ------------------------------------------------------------------------ -- Definition data All {a p} {A : Set a} (P : Pred A p) : Pred (Maybe A) (a ⊔ p) where just : ∀ {x} → P x → All P (just x) nothing : All P nothing ------------------------------------------------------------------------ -- Basic operations module _ {a p} {A : Set a} {P : Pred A p} where drop-just : ∀ {x} → All P (just x) → P x drop-just (just px) = px just-equivalence : ∀ {x} → P x ⇔ All P (just x) just-equivalence = equivalence just drop-just map : ∀ {q} {Q : Pred A q} → P ⊆ Q → All P ⊆ All Q map f (just px) = just (f px) map f nothing = nothing fromAny : Any P ⊆ All P fromAny (just px) = just px ------------------------------------------------------------------------ -- (un/)zip(/With) module _ {a p q r} {A : Set a} {P : Pred A p} {Q : Pred A q} {R : Pred A r} where zipWith : P ∩ Q ⊆ R → All P ∩ All Q ⊆ All R zipWith f (just px , just qx) = just (f (px , qx)) zipWith f (nothing , nothing) = nothing unzipWith : P ⊆ Q ∩ R → All P ⊆ All Q ∩ All R unzipWith f (just px) = Prod.map just just (f px) unzipWith f nothing = nothing , nothing module _ {a p q} {A : Set a} {P : Pred A p} {Q : Pred A q} where zip : All P ∩ All Q ⊆ All (P ∩ Q) zip = zipWith id unzip : All (P ∩ Q) ⊆ All P ∩ All Q unzip = unzipWith id ------------------------------------------------------------------------ -- Traversable-like functions module _ {a} p {A : Set a} {P : Pred A (a ⊔ p)} {F} (App : RawApplicative {a ⊔ p} F) where open RawApplicative App sequenceA : All (F ∘′ P) ⊆ F ∘′ All P sequenceA nothing = pure nothing sequenceA (just px) = just <$> px mapA : ∀ {q} {Q : Pred A q} → (Q ⊆ F ∘′ P) → All Q ⊆ (F ∘′ All P) mapA f = sequenceA ∘′ map f forA : ∀ {q} {Q : Pred A q} {xs} → All Q xs → (Q ⊆ F ∘′ P) → F (All P xs) forA qxs f = mapA f qxs module _ {a} p {A : Set a} {P : Pred A (a ⊔ p)} {M} (Mon : RawMonad {a ⊔ p} M) where private App = RawMonad.rawIApplicative Mon sequenceM : All (M ∘′ P) ⊆ M ∘′ All P sequenceM = sequenceA p App mapM : ∀ {q} {Q : Pred A q} → (Q ⊆ M ∘′ P) → All Q ⊆ (M ∘′ All P) mapM = mapA p App forM : ∀ {q} {Q : Pred A q} {xs} → All Q xs → (Q ⊆ M ∘′ P) → M (All P xs) forM = forA p App ------------------------------------------------------------------------ -- Seeing All as a predicate transformer module _ {a p} {A : Set a} {P : Pred A p} where dec : Decidable P → Decidable (All P) dec P-dec nothing = yes nothing dec P-dec (just x) = Dec.map just-equivalence (P-dec x) universal : Universal P → Universal (All P) universal P-universal (just x) = just (P-universal x) universal P-universal nothing = nothing irrelevant : Irrelevant P → Irrelevant (All P) irrelevant P-irrelevant (just p) (just q) = cong just (P-irrelevant p q) irrelevant P-irrelevant nothing nothing = P.refl satisfiable : Satisfiable (All P) satisfiable = nothing , nothing agda-stdlib-1.7.3/src/Data/Maybe/Relation/Unary/All/000077500000000000000000000000001451211343400217535ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Maybe/Relation/Unary/All/Properties.agda000066400000000000000000000043271451211343400247330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties related to All ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Relation.Unary.All.Properties where open import Data.Maybe.Base open import Data.Maybe.Relation.Unary.All as All using (All; nothing; just) open import Data.Maybe.Relation.Binary.Connected open import Data.Product using (_×_; _,_) open import Function open import Level open import Relation.Unary open import Relation.Binary.Core private variable a b p q ℓ : Level A : Set a B : Set b P : Pred A p Q : Pred B q ------------------------------------------------------------------------ -- Relationship with other combinators ------------------------------------------------------------------------ All⇒Connectedˡ : ∀ {R : Rel A ℓ} {x y} → All (R x) y → Connected R (just x) y All⇒Connectedˡ (just x) = just x All⇒Connectedˡ nothing = just-nothing All⇒Connectedʳ : ∀ {R : Rel A ℓ} {x y} → All (λ v → R v y) x → Connected R x (just y) All⇒Connectedʳ (just x) = just x All⇒Connectedʳ nothing = nothing-just ------------------------------------------------------------------------ -- Introduction (⁺) and elimination (⁻) rules for maybe operations ------------------------------------------------------------------------ -- map map⁺ : ∀ {f : A → B} {mx} → All (P ∘ f) mx → All P (map f mx) map⁺ (just p) = just p map⁺ nothing = nothing map⁻ : ∀ {f : A → B} {mx} → All P (map f mx) → All (P ∘ f) mx map⁻ {mx = just x} (just px) = just px map⁻ {mx = nothing} nothing = nothing -- A variant of All.map. gmap : ∀ {f : A → B} → P ⊆ Q ∘ f → All P ⊆ All Q ∘ map f gmap g = map⁺ ∘ All.map g ------------------------------------------------------------------------ -- _<∣>_ <∣>⁺ : ∀ {mx my} → All P mx → All P my → All P (mx <∣> my) <∣>⁺ (just px) pmy = just px <∣>⁺ nothing pmy = pmy <∣>⁻ : ∀ mx {my} → All P (mx <∣> my) → All P mx <∣>⁻ (just x) pmxy = pmxy <∣>⁻ nothing pmxy = nothing agda-stdlib-1.7.3/src/Data/Maybe/Relation/Unary/Any.agda000066400000000000000000000050331451211343400226110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Maybes where one of the elements satisfies a given property ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Maybe.Relation.Unary.Any where open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Product as Prod using (∃; _,_; -,_) open import Function.Base using (id) open import Function.Equivalence using (_⇔_; equivalence) open import Level open import Relation.Binary.PropositionalEquality as P using (_≡_; cong) open import Relation.Unary open import Relation.Nullary hiding (Irrelevant) import Relation.Nullary.Decidable as Dec ------------------------------------------------------------------------ -- Definition data Any {a p} {A : Set a} (P : Pred A p) : Pred (Maybe A) (a ⊔ p) where just : ∀ {x} → P x → Any P (just x) ------------------------------------------------------------------------ -- Basic operations module _ {a p} {A : Set a} {P : Pred A p} where drop-just : ∀ {x} → Any P (just x) → P x drop-just (just px) = px just-equivalence : ∀ {x} → P x ⇔ Any P (just x) just-equivalence = equivalence just drop-just map : ∀ {q} {Q : Pred A q} → P ⊆ Q → Any P ⊆ Any Q map f (just px) = just (f px) satisfied : ∀ {x} → Any P x → ∃ P satisfied (just p) = -, p ------------------------------------------------------------------------ -- (un/)zip(/With) module _ {a p q r} {A : Set a} {P : Pred A p} {Q : Pred A q} {R : Pred A r} where zipWith : P ∩ Q ⊆ R → Any P ∩ Any Q ⊆ Any R zipWith f (just px , just qx) = just (f (px , qx)) unzipWith : P ⊆ Q ∩ R → Any P ⊆ Any Q ∩ Any R unzipWith f (just px) = Prod.map just just (f px) module _ {a p q} {A : Set a} {P : Pred A p} {Q : Pred A q} where zip : Any P ∩ Any Q ⊆ Any (P ∩ Q) zip = zipWith id unzip : Any (P ∩ Q) ⊆ Any P ∩ Any Q unzip = unzipWith id ------------------------------------------------------------------------ -- Seeing Any as a predicate transformer module _ {a p} {A : Set a} {P : Pred A p} where dec : Decidable P → Decidable (Any P) dec P-dec nothing = no λ () dec P-dec (just x) = Dec.map just-equivalence (P-dec x) irrelevant : Irrelevant P → Irrelevant (Any P) irrelevant P-irrelevant (just p) (just q) = cong just (P-irrelevant p q) satisfiable : Satisfiable P → Satisfiable (Any P) satisfiable P-satisfiable = Prod.map just just P-satisfiable agda-stdlib-1.7.3/src/Data/Nat.agda000066400000000000000000000017511451211343400166770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural numbers ------------------------------------------------------------------------ -- See README.Data.Nat for examples of how to use and reason about -- naturals. {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat where ------------------------------------------------------------------------ -- Publicly re-export the contents of the base module open import Data.Nat.Base public ------------------------------------------------------------------------ -- Publicly re-export queries open import Data.Nat.Properties public using ( _≟_ ; _≤?_ ; _≥?_ ; _?_ ; _≤′?_; _≥′?_; _<′?_; _>′?_ ; _≤″?_; _<″?_; _≥″?_; _>″?_ ; _<‴?_; _≤‴?_; _≥‴?_; _>‴?_ ) ------------------------------------------------------------------------ -- Deprecated -- Version 0.17 open import Data.Nat.Properties public using (≤-pred) agda-stdlib-1.7.3/src/Data/Nat/000077500000000000000000000000001451211343400160555ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/Base.agda000066400000000000000000000137261451211343400175560ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural numbers, basic types and operations ------------------------------------------------------------------------ -- See README.Data.Nat for examples of how to use and reason about -- naturals. {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Base where open import Data.Bool.Base using (Bool; true; false) open import Data.Empty using (⊥) open import Data.Unit.Base using (⊤; tt) open import Level using (0ℓ) open import Relation.Binary.Core using (Rel) open import Relation.Binary.PropositionalEquality.Core using (_≡_; _≢_; refl) open import Relation.Nullary using (¬_) open import Relation.Nullary.Negation.Core using (contradiction) open import Relation.Unary using (Pred) ------------------------------------------------------------------------ -- Types open import Agda.Builtin.Nat public using (zero; suc) renaming (Nat to ℕ) ------------------------------------------------------------------------ -- Boolean equality relation open import Agda.Builtin.Nat public using () renaming (_==_ to _≡ᵇ_) ------------------------------------------------------------------------ -- Boolean ordering relation open import Agda.Builtin.Nat public using () renaming (_<_ to _<ᵇ_) infix 4 _≤ᵇ_ _≤ᵇ_ : (m n : ℕ) → Bool zero ≤ᵇ n = true suc m ≤ᵇ n = m <ᵇ n ------------------------------------------------------------------------ -- Standard ordering relations infix 4 _≤_ _<_ _≥_ _>_ _≰_ _≮_ _≱_ _≯_ data _≤_ : Rel ℕ 0ℓ where z≤n : ∀ {n} → zero ≤ n s≤s : ∀ {m n} (m≤n : m ≤ n) → suc m ≤ suc n _<_ : Rel ℕ 0ℓ m < n = suc m ≤ n _≥_ : Rel ℕ 0ℓ m ≥ n = n ≤ m _>_ : Rel ℕ 0ℓ m > n = n < m _≰_ : Rel ℕ 0ℓ a ≰ b = ¬ a ≤ b _≮_ : Rel ℕ 0ℓ a ≮ b = ¬ a < b _≱_ : Rel ℕ 0ℓ a ≱ b = ¬ a ≥ b _≯_ : Rel ℕ 0ℓ a ≯ b = ¬ a > b ------------------------------------------------------------------------ -- Simple predicates -- Defining `NonZero` in terms of `⊤` and `⊥` allows Agda to -- automatically infer nonZero-ness for any natural of the form -- `suc n`. Consequently in many circumstances this eliminates the need -- to explicitly pass a proof when the NonZero argument is either an -- implicit or an instance argument. -- -- It could alternatively be defined using a datatype with an instance -- constructor but then it would not be inferrable when passed as an -- implicit argument. -- -- See `Data.Nat.DivMod` for an example. NonZero : ℕ → Set NonZero zero = ⊥ NonZero (suc x) = ⊤ -- Constructors ≢-nonZero : ∀ {n} → n ≢ 0 → NonZero n ≢-nonZero {zero} 0≢0 = 0≢0 refl ≢-nonZero {suc n} n≢0 = tt >-nonZero : ∀ {n} → n > 0 → NonZero n >-nonZero (s≤s 0′_ data _≤′_ (m : ℕ) : ℕ → Set where ≤′-refl : m ≤′ m ≤′-step : ∀ {n} (m≤′n : m ≤′ n) → m ≤′ suc n _<′_ : Rel ℕ 0ℓ m <′ n = suc m ≤′ n _≥′_ : Rel ℕ 0ℓ m ≥′ n = n ≤′ m _>′_ : Rel ℕ 0ℓ m >′ n = n <′ m ------------------------------------------------------------------------ -- Another alternative definition of _≤_ record _≤″_ (m n : ℕ) : Set where constructor less-than-or-equal field {k} : ℕ proof : m + k ≡ n infix 4 _≤″_ _<″_ _≥″_ _>″_ _<″_ : Rel ℕ 0ℓ m <″ n = suc m ≤″ n _≥″_ : Rel ℕ 0ℓ m ≥″ n = n ≤″ m _>″_ : Rel ℕ 0ℓ m >″ n = n <″ m ------------------------------------------------------------------------ -- Another alternative definition of _≤_ -- Useful for induction when you have an upper bound. data _≤‴_ : ℕ → ℕ → Set where ≤‴-refl : ∀{m} → m ≤‴ m ≤‴-step : ∀{m n} → suc m ≤‴ n → m ≤‴ n infix 4 _≤‴_ _<‴_ _≥‴_ _>‴_ _<‴_ : Rel ℕ 0ℓ m <‴ n = suc m ≤‴ n _≥‴_ : Rel ℕ 0ℓ m ≥‴ n = n ≤‴ m _>‴_ : Rel ℕ 0ℓ m >‴ n = n <‴ m ------------------------------------------------------------------------ -- A comparison view. Taken from "View from the left" -- (McBride/McKinna); details may differ. data Ordering : Rel ℕ 0ℓ where less : ∀ m k → Ordering m (suc (m + k)) equal : ∀ m → Ordering m m greater : ∀ m k → Ordering (suc (m + k)) m compare : ∀ m n → Ordering m n compare zero zero = equal zero compare (suc m) zero = greater zero m compare zero (suc n) = less zero n compare (suc m) (suc n) with compare m n ... | less m k = less (suc m) k ... | equal m = equal (suc m) ... | greater n k = greater (suc n) k agda-stdlib-1.7.3/src/Data/Nat/Binary.agda000066400000000000000000000006361451211343400201240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural numbers represented in binary natively in Agda. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Binary where open import Data.Nat.Binary.Base public open import Data.Nat.Binary.Properties public using (_≟_) agda-stdlib-1.7.3/src/Data/Nat/Binary/000077500000000000000000000000001451211343400173015ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/Binary/Base.agda000066400000000000000000000104701451211343400207730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural numbers represented in binary. ------------------------------------------------------------------------ -- This module contains an alternative formulation of ℕ that is -- still reasonably computationally efficient without having to use -- built-in functions. {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Binary.Base where open import Algebra.Core using (Op₂) open import Data.Bool.Base using (if_then_else_) open import Data.Nat.Base as ℕ using (ℕ) open import Data.Nat.DivMod using (_%_ ; _/_) open import Data.Sum.Base using (_⊎_) open import Function.Base using (_on_) open import Level using (0ℓ) open import Relation.Binary.Core using (Rel) open import Relation.Binary.PropositionalEquality using (_≡_) open import Relation.Nullary using (¬_) ------------------------------------------------------------------------ -- Definition data ℕᵇ : Set where zero : ℕᵇ 2[1+_] : ℕᵇ → ℕᵇ -- n → 2*(1+n) = nonzero even numbers 1+[2_] : ℕᵇ → ℕᵇ -- n → 1 + 2*n = odd numbers ------------------------------------------------------------------------ -- Ordering relations infix 4 _<_ _>_ _≤_ _≥_ _≮_ _≯_ _≰_ _≱_ data _<_ : Rel ℕᵇ 0ℓ where 0_ : Rel ℕᵇ 0ℓ x > y = y < x _≤_ : Rel ℕᵇ 0ℓ x ≤ y = x < y ⊎ x ≡ y _≥_ : Rel ℕᵇ 0ℓ x ≥ y = y ≤ x _≮_ : Rel ℕᵇ 0ℓ x ≮ y = ¬ (x < y) _≯_ : Rel ℕᵇ 0ℓ x ≯ y = ¬ (x > y) _≰_ : Rel ℕᵇ 0ℓ x ≰ y = ¬ (x ≤ y) _≱_ : Rel ℕᵇ 0ℓ x ≱ y = ¬ (x ≥ y) ------------------------------------------------------------------------ -- Basic operations double : ℕᵇ → ℕᵇ double zero = zero double 2[1+ x ] = 2[1+ 1+[2 x ] ] double 1+[2 x ] = 2[1+ (double x) ] suc : ℕᵇ → ℕᵇ suc zero = 1+[2 zero ] suc 2[1+ x ] = 1+[2 (suc x) ] suc 1+[2 x ] = 2[1+ x ] pred : ℕᵇ → ℕᵇ pred zero = zero pred 2[1+ x ] = 1+[2 x ] pred 1+[2 x ] = double x ------------------------------------------------------------------------ -- Addition, multiplication and certain related functions infixl 6 _+_ infixl 7 _*_ _+_ : Op₂ ℕᵇ zero + y = y x + zero = x 2[1+ x ] + 2[1+ y ] = 2[1+ suc (x + y) ] 2[1+ x ] + 1+[2 y ] = suc 2[1+ (x + y) ] 1+[2 x ] + 2[1+ y ] = suc 2[1+ (x + y) ] 1+[2 x ] + 1+[2 y ] = suc 1+[2 (x + y) ] _*_ : Op₂ ℕᵇ zero * _ = zero _ * zero = zero 2[1+ x ] * 2[1+ y ] = double 2[1+ x + (y + x * y) ] 2[1+ x ] * 1+[2 y ] = 2[1+ x + y * 2[1+ x ] ] 1+[2 x ] * 2[1+ y ] = 2[1+ y + x * 2[1+ y ] ] 1+[2 x ] * 1+[2 y ] = 1+[2 x + y * 1+[2 x ] ] ------------------------------------------------------------------------ -- Conversion between ℕᵇ and ℕ toℕ : ℕᵇ → ℕ toℕ zero = 0 toℕ 2[1+ x ] = 2 ℕ.* (ℕ.suc (toℕ x)) toℕ 1+[2 x ] = ℕ.suc (2 ℕ.* (toℕ x)) fromℕ : ℕ → ℕᵇ fromℕ n = helper n n module fromℕ where helper : ℕ → ℕ → ℕᵇ helper 0 _ = zero helper (ℕ.suc n) (ℕ.suc w) = if (n % 2 ℕ.≡ᵇ 0) then 1+[2 helper (n / 2) w ] else 2[1+ helper (n / 2) w ] -- Impossible case helper _ 0 = zero -- An alternative slower definition fromℕ' : ℕ → ℕᵇ fromℕ' 0 = zero fromℕ' (ℕ.suc n) = suc (fromℕ' n) -- An alternative ordering lifted from ℕ infix 4 _<ℕ_ _<ℕ_ : Rel ℕᵇ 0ℓ _<ℕ_ = ℕ._<_ on toℕ ------------------------------------------------------------------------ -- Other functions -- Useful in some termination proofs. size : ℕᵇ → ℕ size zero = 0 size 2[1+ x ] = ℕ.suc (size x) size 1+[2 x ] = ℕ.suc (size x) ------------------------------------------------------------------------ -- Constants 0ᵇ = zero 1ᵇ = suc 0ᵇ 2ᵇ = suc 1ᵇ 3ᵇ = suc 2ᵇ 4ᵇ = suc 3ᵇ 5ᵇ = suc 4ᵇ 6ᵇ = suc 5ᵇ 7ᵇ = suc 6ᵇ 8ᵇ = suc 7ᵇ 9ᵇ = suc 8ᵇ agda-stdlib-1.7.3/src/Data/Nat/Binary/Induction.agda000066400000000000000000000015651451211343400220620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Induction over _<_ for ℕᵇ. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Binary.Induction where open import Data.Nat.Binary.Base open import Data.Nat.Binary.Properties open import Data.Nat.Base as ℕ using (ℕ) import Data.Nat.Induction as ℕ open import Induction.WellFounded as WFI import Relation.Binary.Construct.On as On ------------------------------------------------------------------------ -- Re-export Acc and acc open WFI public using (Acc; acc) ------------------------------------------------------------------------ -- _<_ is wellFounded <-wellFounded : WellFounded _<_ <-wellFounded = Subrelation.wellFounded <⇒<ℕ (On.wellFounded toℕ ℕ.<-wellFounded) agda-stdlib-1.7.3/src/Data/Nat/Binary/Instances.agda000066400000000000000000000007601451211343400220510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances for binary natural numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Binary.Instances where open import Data.Nat.Binary.Properties open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) instance ℕᵇ-≡-isDecEquivalence = isDecEquivalence _≟_ agda-stdlib-1.7.3/src/Data/Nat/Binary/Properties.agda000066400000000000000000001665351451211343400222730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Basic properties of ℕᵇ ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Binary.Properties where open import Algebra.Bundles open import Algebra.Morphism.Structures import Algebra.Morphism.MonoidMonomorphism as MonoidMonomorphism open import Algebra.Consequences.Propositional open import Data.Bool.Base using (if_then_else_; Bool; true; false) open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.Nat.Binary.Base open import Data.Nat as ℕ using (ℕ; z≤n; s≤s) open import Data.Nat.DivMod using (_%_; _/_; m/n≤m; +-distrib-/-∣ˡ) open import Data.Nat.Divisibility using (∣-refl) import Data.Nat.Properties as ℕₚ open import Data.Nat.Solver open import Data.Product using (_×_; _,_; proj₁; proj₂; ∃) open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Function.Base using (_∘_; _$_; id) open import Function.Definitions using (Injective) open import Function.Definitions.Core2 using (Surjective) open import Level using (0ℓ) open import Relation.Binary open import Relation.Binary.Consequences open import Relation.Binary.Morphism import Relation.Binary.Morphism.OrderMonomorphism as OrderMonomorphism open import Relation.Binary.PropositionalEquality import Relation.Binary.Reasoning.Base.Triple as InequalityReasoning open import Relation.Nullary using (¬_; yes; no) import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Negation using (contradiction) open import Algebra.Definitions {A = ℕᵇ} _≡_ open import Algebra.Structures {A = ℕᵇ} _≡_ import Algebra.Properties.CommutativeSemigroup as CommSemigProp import Algebra.Properties.CommutativeSemigroup ℕₚ.+-commutativeSemigroup as ℕ-+-semigroupProperties import Relation.Binary.Construct.StrictToNonStrict _≡_ _<_ as StrictToNonStrict open +-*-Solver infix 4 _0 : ∀ {x} → x ≢ zero → x > zero x≢0⇒x>0 {zero} 0≢0 = contradiction refl 0≢0 x≢0⇒x>0 {2[1+ _ ]} _ = 00 {1+[2 _ ]} _ = 0⇒≢ : _>_ ⇒ _≢_ >⇒≢ yy = >⇒≢ x>y x≡y <⇒≯ : _<_ ⇒ _≯_ <⇒≯ (even⇒≮ : _>_ ⇒ _≮_ >⇒≮ y (λ()) (λ()) 0 _ _ x>y = tri> (>⇒≮ gt) (>⇒≢ gt) gt where gt = eveny <-cmp 2[1+ x ] 1+[2 y ] with <-cmp x y ... | tri< x (>⇒≮ gt) (>⇒≢ gt) gt where gt = subst (_< 2[1+ x ]) refl (1+[2x]<2[1+x] x) ... | tri> _ _ y (>⇒≮ gt) (>⇒≢ gt) gt where gt = odd (>⇒≮ gt) (>⇒≢ gt) gt where gt = 0 _ _ x>y = tri> (>⇒≮ gt) (>⇒≢ gt) gt where gt = eveny <-cmp 1+[2 x ] 1+[2 y ] with <-cmp x y ... | tri< x _ _ x>y = tri> (>⇒≮ gt) (>⇒≢ gt) gt where gt = oddy _y = <⇒≱ x>y x≤y ≮⇒≥ : _≮_ ⇒ _≥_ ≮⇒≥ {x} {y} x≮y with <-cmp x y ... | tri< lt _ _ = contradiction lt x≮y ... | tri≈ _ eq _ = inj₂ (sym eq) ... | tri> _ _ y : _≰_ ⇒ _>_ ≰⇒> {x} {y} x≰y with <-cmp x y ... | tri< lt _ _ = contradiction (<⇒≤ lt) x≰y ... | tri≈ _ eq _ = contradiction (inj₂ eq) x≰y ... | tri> _ _ x>y = x>y ≤∧≢⇒< : ∀ {x y} → x ≤ y → x ≢ y → x < y ≤∧≢⇒< (inj₁ x _ _ y _ _ y 0ᵇ → x < x + y x0 = begin-strict x ≡⟨ sym (fromℕ-toℕ x) ⟩ fromℕ (toℕ x) <⟨ fromℕ-mono-< (ℕₚ.m0)) ⟩ fromℕ (toℕ x ℕ.+ toℕ y) ≡⟨ fromℕ-homo-+ (toℕ x) (toℕ y) ⟩ fromℕ (toℕ x) + fromℕ (toℕ y) ≡⟨ cong₂ _+_ (fromℕ-toℕ x) (fromℕ-toℕ y) ⟩ x + y ∎ where open ≤-Reasoning x _ _ x>y = contradiction 2x≤2y (<⇒≱ (double-mono-< x>y)) double-cancel-< : ∀ {x y} → double x < double y → x < y double-cancel-< {x} {y} 2x<2y with <-cmp x y ... | tri< x _ _ x>y = contradiction (double-mono-< x>y) (<⇒≯ 2x<2y) x0 x≢0) ⟩ x + x ≡⟨ sym (double[x]≡x+x x) ⟩ double x ∎ where open ≤-Reasoning x≤double[x] : ∀ x → x ≤ double x x≤double[x] x = begin x ≤⟨ x≤x+y x x ⟩ x + x ≡⟨ sym (double[x]≡x+x x) ⟩ double x ∎ where open ≤-Reasoning double-suc : ∀ x → double (suc x) ≡ 2ᵇ + double x double-suc x = begin double (suc x) ≡⟨ cong double (suc≗1+ x) ⟩ double (1ᵇ + x) ≡⟨ double-distrib-+ 1ᵇ x ⟩ 2ᵇ + double x ∎ where open ≡-Reasoning ------------------------------------------------------------------------ -- Properties of suc ------------------------------------------------------------------------ 2[1+_]-double-suc : 2[1+_] ≗ double ∘ suc 2[1+_]-double-suc zero = refl 2[1+_]-double-suc 2[1+ x ] = cong 2[1+_] (2[1+_]-double-suc x) 2[1+_]-double-suc 1+[2 x ] = refl 1+[2_]-suc-double : 1+[2_] ≗ suc ∘ double 1+[2_]-suc-double zero = refl 1+[2_]-suc-double 2[1+ x ] = refl 1+[2_]-suc-double 1+[2 x ] = begin 1+[2 1+[2 x ] ] ≡⟨ cong 1+[2_] (1+[2_]-suc-double x) ⟩ 1+[2 (suc 2x) ] ≡⟨⟩ suc 2[1+ 2x ] ≡⟨ cong suc (2[1+_]-double-suc 2x) ⟩ suc (double (suc 2x)) ≡⟨ cong (suc ∘ double) (sym (1+[2_]-suc-double x)) ⟩ suc (double 1+[2 x ]) ∎ where open ≡-Reasoning; 2x = double x suc≢0 : ∀ {x} → suc x ≢ zero suc≢0 {zero} () suc≢0 {2[1+ _ ]} () suc≢0 {1+[2 _ ]} () x+suc[y]≡suc[x]+y : ∀ x y → x + suc y ≡ suc x + y x+suc[y]≡suc[x]+y x y = begin x + suc y ≡⟨ +-comm x _ ⟩ suc y + x ≡⟨ suc-+ y x ⟩ suc (y + x) ≡⟨ cong suc (+-comm y x) ⟩ suc (x + y) ≡⟨ sym (suc-+ x y) ⟩ suc x + y ∎ where open ≡-Reasoning 00 (suc≢0 {x}) x; _Preserves_⟶_; _Preserves₂_⟶_⟶_) open import Relation.Binary.PropositionalEquality open import Relation.Nullary using (Dec; yes; no; does) open import Relation.Nullary.Negation using (contradiction) open import Algebra.Definitions {A = ℕᵇ} _≡_ open import Algebra.Properties.CommutativeSemigroup +-commutativeSemigroup using (xy∙z≈y∙xz; x∙yz≈y∙xz) open import Algebra.Solver.CommutativeMonoid +-0-commutativeMonoid ------------------------------------------------------------------------ -- Definition infixl 6 _∸_ _∸_ : Op₂ ℕᵇ zero ∸ _ = 0ᵇ x ∸ zero = x 2[1+ x ] ∸ 2[1+ y ] = double (x ∸ y) 1+[2 x ] ∸ 1+[2 y ] = double (x ∸ y) 2[1+ x ] ∸ 1+[2 y ] with does (x : ∀ {x y} → x > y → 1+[2 x ] ∸ 2[1+ y ] ≡ pred (double (x ∸ y)) odd∸even-for> {x} {y} x>y with x ≤? y ... | no _ = refl ... | yes x≤y = contradiction x>y (≤⇒≯ x≤y) x≤y⇒x∸y≡0 : ∀ {x y} → x ≤ y → x ∸ y ≡ 0ᵇ x≤y⇒x∸y≡0 {x} {y} = toℕ-injective ∘ trans (toℕ-homo-∸ x y) ∘ ℕₚ.m≤n⇒m∸n≡0 ∘ toℕ-mono-≤ x∸y≡0⇒x≤y : ∀ {x y} → x ∸ y ≡ 0ᵇ → x ≤ y x∸y≡0⇒x≤y {x} {y} = toℕ-cancel-≤ ∘ ℕₚ.m∸n≡0⇒m≤n ∘ trans (sym (toℕ-homo-∸ x y)) ∘ cong toℕ x0 : ∀ {x y} → x < y → y ∸ x > 0ᵇ x0 {x} {y} = toℕ-cancel-< ∘ subst (ℕ._> 0) (sym (toℕ-homo-∸ y x)) ∘ ℕₚ.m0 : ∀ {m n n≢0} → m ≥ n → (m / n) {n≢0} > 0 m≥n⇒m/n>0 {m@(suc m-1)} {n@(suc n-1)} m≥n = begin 1 ≡⟨ sym (n/n≡1 m) ⟩ m / m ≤⟨ /-monoʳ-≤ m m≥n ⟩ m / n ∎ +-distrib-/ : ∀ m n {d} {≢0} → (m % d) {≢0} + (n % d) {≢0} < d → ((m + n) / d) {≢0} ≡ (m / d) {≢0} + (n / d) {≢0} +-distrib-/ m n {suc d-1} leq = +-distrib-divₕ 0 0 m n d-1 leq +-distrib-/-∣ˡ : ∀ {m} n {d} {≢0} → d ∣ m → ((m + n) / d) {≢0} ≡ (m / d) {≢0} + (n / d) {≢0} +-distrib-/-∣ˡ {m} n {d@(suc d-1)} (divides p refl) = +-distrib-/ m n (begin-strict p * d % d + n % d ≡⟨ cong (_+ n % d) (m*n%n≡0 p d-1) ⟩ n % d <⟨ m%n0 (toWitnessFalse o≢0)) (≮⇒≥ n≮o) *-/-assoc : ∀ m {n d} {≢0} → d ∣ n → (m * n / d) {≢0} ≡ m * ((n / d) {≢0}) *-/-assoc zero {_} {d@(suc _)} d∣n = 0/n≡0 (suc d) *-/-assoc (suc m) {n} {d@(suc _)} d∣n = begin-equality (n + m * n) / d ≡⟨ +-distrib-/-∣ˡ _ d∣n ⟩ n / d + (m * n) / d ≡⟨ cong (n / d +_) (*-/-assoc m d∣n) ⟩ n / d + m * (n / d) ∎ /-*-interchange : ∀ {m n o p op≢0 o≢0 p≢0} → o ∣ m → p ∣ n → ((m * n) / (o * p)) {op≢0} ≡ (m / o) {o≢0} * (n / p) {p≢0} /-*-interchange {m} {n} {o@(suc _)} {p@(suc _)} o∣m p∣n = *-cancelˡ-≡ (pred (o * p)) (begin-equality (o * p) * ((m * n) / (o * p)) ≡⟨ m*[n/m]≡n (*-pres-∣ o∣m p∣n) ⟩ m * n ≡˘⟨ cong₂ _*_ (m*[n/m]≡n o∣m) (m*[n/m]≡n p∣n) ⟩ (o * (m / o)) * (p * (n / p)) ≡⟨ [m*n]*[o*p]≡[m*o]*[n*p] o (m / o) p (n / p) ⟩ (o * p) * ((m / o) * (n / p)) ∎) ------------------------------------------------------------------------ -- A specification of integer division. record DivMod (dividend divisor : ℕ) : Set where constructor result field quotient : ℕ remainder : Fin divisor property : dividend ≡ toℕ remainder + quotient * divisor infixl 7 _div_ _mod_ _divMod_ _div_ : (dividend divisor : ℕ) {≢0 : False (divisor ≟ 0)} → ℕ _div_ = _/_ _mod_ : (dividend divisor : ℕ) {≢0 : False (divisor ≟ 0)} → Fin divisor m mod (suc n) = fromℕ< (m%n0 mod≢0) mod≤1+j , j≤k)) divₕ-offsetEq d (suc n) (suc j) (suc k) j≤d k≤d (inj₃ (eq , k⇒∤ : ∀ {m n} → m > suc n → m ∤ suc n >⇒∤ (s≤s m>n) m∣n = contradiction (∣⇒≤ m∣n) (≤⇒≯ m>n) ------------------------------------------------------------------------ -- _∣_ is a partial order ∣-reflexive : _≡_ ⇒ _∣_ ∣-reflexive {n} refl = divides 1 (sym (*-identityˡ n)) ∣-refl : Reflexive _∣_ ∣-refl = ∣-reflexive refl ∣-trans : Transitive _∣_ ∣-trans (divides p refl) (divides q refl) = divides (q * p) (sym (*-assoc q p _)) ∣-antisym : Antisymmetric _≡_ _∣_ ∣-antisym {m} {zero} _ (divides q refl) = *-zeroʳ q ∣-antisym {zero} {n} (divides p eq) _ = sym (trans eq (*-comm p 0)) ∣-antisym {suc m} {suc n} p∣q q∣p = ≤-antisym (∣⇒≤ p∣q) (∣⇒≤ q∣p) infix 4 _∣?_ _∣?_ : Decidable _∣_ zero ∣? zero = yes (divides 0 refl) zero ∣? suc m = no ((λ()) ∘′ ∣-antisym (divides 0 refl)) suc n ∣? m = Dec.map (m%n≡0⇔n∣m m n) (m % suc n ≟ 0) ∣-isPreorder : IsPreorder _≡_ _∣_ ∣-isPreorder = record { isEquivalence = PropEq.isEquivalence ; reflexive = ∣-reflexive ; trans = ∣-trans } ∣-isPartialOrder : IsPartialOrder _≡_ _∣_ ∣-isPartialOrder = record { isPreorder = ∣-isPreorder ; antisym = ∣-antisym } ∣-preorder : Preorder 0ℓ 0ℓ 0ℓ ∣-preorder = record { isPreorder = ∣-isPreorder } ∣-poset : Poset 0ℓ 0ℓ 0ℓ ∣-poset = record { isPartialOrder = ∣-isPartialOrder } ------------------------------------------------------------------------ -- A reasoning module for the _∣_ relation module ∣-Reasoning where private module Base = PreorderReasoning ∣-preorder open Base public hiding (step-≈; step-≈˘; step-∼) infixr 2 step-∣ step-∣ = Base.step-∼ syntax step-∣ x y∣z x∣y = x ∣⟨ x∣y ⟩ y∣z ------------------------------------------------------------------------ -- Simple properties of _∣_ infix 10 1∣_ _∣0 1∣_ : ∀ n → 1 ∣ n 1∣ n = divides n (sym (*-identityʳ n)) _∣0 : ∀ n → n ∣ 0 n ∣0 = divides 0 refl 0∣⇒≡0 : ∀ {n} → 0 ∣ n → n ≡ 0 0∣⇒≡0 {n} 0∣n = ∣-antisym (n ∣0) 0∣n ∣1⇒≡1 : ∀ {n} → n ∣ 1 → n ≡ 1 ∣1⇒≡1 {n} n∣1 = ∣-antisym n∣1 (1∣ n) n∣n : ∀ {n} → n ∣ n n∣n {n} = ∣-refl ------------------------------------------------------------------------ -- Properties of _∣_ and _+_ ∣m∣n⇒∣m+n : ∀ {i m n} → i ∣ m → i ∣ n → i ∣ m + n ∣m∣n⇒∣m+n (divides p refl) (divides q refl) = divides (p + q) (sym (*-distribʳ-+ _ p q)) ∣m+n∣m⇒∣n : ∀ {i m n} → i ∣ m + n → i ∣ m → i ∣ n ∣m+n∣m⇒∣n {i} {m} {n} (divides p m+n≡p*i) (divides q m≡q*i) = divides (p ∸ q) $ begin-equality n ≡⟨ sym (m+n∸n≡m n m) ⟩ n + m ∸ m ≡⟨ cong (_∸ m) (+-comm n m) ⟩ m + n ∸ m ≡⟨ cong₂ _∸_ m+n≡p*i m≡q*i ⟩ p * i ∸ q * i ≡⟨ sym (*-distribʳ-∸ i p q) ⟩ (p ∸ q) * i ∎ where open ∣-Reasoning ------------------------------------------------------------------------ -- Properties of _∣_ and _*_ n∣m*n : ∀ m {n} → n ∣ m * n n∣m*n m = divides m refl m∣m*n : ∀ {m} n → m ∣ m * n m∣m*n n = divides n (*-comm _ n) ∣m⇒∣m*n : ∀ {i m} n → i ∣ m → i ∣ m * n ∣m⇒∣m*n {i} {m} n (divides q refl) = ∣-trans (n∣m*n q) (m∣m*n n) ∣n⇒∣m*n : ∀ {i} m {n} → i ∣ n → i ∣ m * n ∣n⇒∣m*n {i} m {n} i∣n = subst (i ∣_) (*-comm n m) (∣m⇒∣m*n m i∣n) *-monoʳ-∣ : ∀ {i j} k → i ∣ j → k * i ∣ k * j *-monoʳ-∣ {i} {j} k (divides q refl) = divides q $ begin-equality k * (q * i) ≡⟨ sym (*-assoc k q i) ⟩ (k * q) * i ≡⟨ cong (_* i) (*-comm k q) ⟩ (q * k) * i ≡⟨ *-assoc q k i ⟩ q * (k * i) ∎ where open ≤-Reasoning *-monoˡ-∣ : ∀ {i j} k → i ∣ j → i * k ∣ j * k *-monoˡ-∣ {i} {j} k rewrite *-comm i k | *-comm j k = *-monoʳ-∣ k *-cancelˡ-∣ : ∀ {i j} k → suc k * i ∣ suc k * j → i ∣ j *-cancelˡ-∣ {i} {j} k (divides q eq) = divides q $ *-cancelʳ-≡ j (q * i) $ begin-equality j * (suc k) ≡⟨ *-comm j (suc k) ⟩ suc k * j ≡⟨ eq ⟩ q * (suc k * i) ≡⟨ cong (q *_) (*-comm (suc k) i) ⟩ q * (i * suc k) ≡⟨ sym (*-assoc q i (suc k)) ⟩ (q * i) * suc k ∎ where open ≤-Reasoning *-cancelʳ-∣ : ∀ {i j} k {k≢0 : False (k ≟ 0)} → i * k ∣ j * k → i ∣ j *-cancelʳ-∣ {i} {j} k@(suc k-1) rewrite *-comm i k | *-comm j k = *-cancelˡ-∣ k-1 ------------------------------------------------------------------------ -- Properties of _∣_ and _∸_ ∣m∸n∣n⇒∣m : ∀ i {m n} → n ≤ m → i ∣ m ∸ n → i ∣ n → i ∣ m ∣m∸n∣n⇒∣m i {m} {n} n≤m (divides p m∸n≡p*i) (divides q n≡q*o) = divides (p + q) $ begin-equality m ≡⟨ sym (m+[n∸m]≡n n≤m) ⟩ n + (m ∸ n) ≡⟨ +-comm n (m ∸ n) ⟩ m ∸ n + n ≡⟨ cong₂ _+_ m∸n≡p*i n≡q*o ⟩ p * i + q * i ≡⟨ sym (*-distribʳ-+ i p q) ⟩ (p + q) * i ∎ where open ≤-Reasoning ------------------------------------------------------------------------ -- Properties of _∣_ and _/_ m/n∣m : ∀ {m n n≢0} → n ∣ m → (m / n) {n≢0} ∣ m m/n∣m {m} {n} (divides p refl) = begin p * n / n ≡⟨ m*n/n≡m p n ⟩ p ∣⟨ m∣m*n n ⟩ p * n ∎ where open ∣-Reasoning m*n∣o⇒m∣o/n : ∀ m n {o n≢0} → m * n ∣ o → m ∣ (o / n) {n≢0} m*n∣o⇒m∣o/n m n {_} {≢0} (divides p refl) = begin m ∣⟨ n∣m*n p ⟩ p * m ≡⟨ sym (*-identityʳ (p * m)) ⟩ p * m * 1 ≡⟨ sym (cong (p * m *_) (n/n≡1 n)) ⟩ p * m * (n / n) ≡⟨ sym (*-/-assoc (p * m) {≢0 = ≢0} (n∣n {n})) ⟩ p * m * n / n ≡⟨ cong (λ v → (v / n) {≢0}) (*-assoc p m n) ⟩ p * (m * n) / n ∎ where open ∣-Reasoning m*n∣o⇒n∣o/m : ∀ m n {o n≢0} → m * n ∣ o → n ∣ (o / m) {n≢0} m*n∣o⇒n∣o/m m n {o} {≢0} rewrite *-comm m n = m*n∣o⇒m∣o/n n m {o} {≢0} m∣n/o⇒m*o∣n : ∀ {m n o n≢0} → o ∣ n → m ∣ (n / o) {n≢0} → m * o ∣ n m∣n/o⇒m*o∣n {m} {n} {o} (divides p refl) m∣p*o/o = begin m * o ∣⟨ *-monoˡ-∣ o (subst (m ∣_) (m*n/n≡m p o) m∣p*o/o) ⟩ p * o ∎ where open ∣-Reasoning m∣n/o⇒o*m∣n : ∀ {m n o o≢0} → o ∣ n → m ∣ (n / o) {o≢0} → o * m ∣ n m∣n/o⇒o*m∣n {m} {_} {o} {≢0} rewrite *-comm o m = m∣n/o⇒m*o∣n {n≢0 = ≢0} m/n∣o⇒m∣o*n : ∀ {m n o n≢0} → n ∣ m → (m / n) {n≢0} ∣ o → m ∣ o * n m/n∣o⇒m∣o*n {_} {n} {o} (divides p refl) p*n/n∣o = begin p * n ∣⟨ *-monoˡ-∣ n (subst (_∣ o) (m*n/n≡m p n) p*n/n∣o) ⟩ o * n ∎ where open ∣-Reasoning m∣n*o⇒m/n∣o : ∀ {m n o n≢0} → n ∣ m → m ∣ o * n → (m / n) {n≢0} ∣ o m∣n*o⇒m/n∣o {_} {n@(suc _)} {o} (divides p refl) pn∣on = begin p * n / n ≡⟨ m*n/n≡m p n ⟩ p ∣⟨ *-cancelʳ-∣ n pn∣on ⟩ o ∎ where open ∣-Reasoning ------------------------------------------------------------------------ -- Properties of _∣_ and _%_ ∣n∣m%n⇒∣m : ∀ {m n d ≢0} → d ∣ n → d ∣ (m % n) {≢0} → d ∣ m ∣n∣m%n⇒∣m {m} {n@(suc n-1)} {d} (divides a n≡ad) (divides b m%n≡bd) = divides (b + (m / n) * a) (begin-equality m ≡⟨ m≡m%n+[m/n]*n m n-1 ⟩ m % n + (m / n) * n ≡⟨ cong₂ _+_ m%n≡bd (cong (m / n *_) n≡ad) ⟩ b * d + (m / n) * (a * d) ≡⟨ sym (cong (b * d +_) (*-assoc (m / n) a d)) ⟩ b * d + ((m / n) * a) * d ≡⟨ sym (*-distribʳ-+ d b _) ⟩ (b + (m / n) * a) * d ∎) where open ≤-Reasoning %-presˡ-∣ : ∀ {m n d ≢0} → d ∣ m → d ∣ n → d ∣ (m % n) {≢0} %-presˡ-∣ {m} {n@(suc n-1)} {d} (divides a refl) (divides b 1+n≡bd) = divides (a ∸ ad/n * b) $ begin-equality a * d % n ≡⟨ m%n≡m∸m/n*n (a * d) n-1 ⟩ a * d ∸ ad/n * n ≡⟨ cong (λ v → a * d ∸ ad/n * v) 1+n≡bd ⟩ a * d ∸ ad/n * (b * d) ≡⟨ sym (cong (a * d ∸_) (*-assoc ad/n b d)) ⟩ a * d ∸ (ad/n * b) * d ≡⟨ sym (*-distribʳ-∸ d a (ad/n * b)) ⟩ (a ∸ ad/n * b) * d ∎ where open ≤-Reasoning; ad/n = a * d / n ------------------------------------------------------------------------ -- DEPRECATED - please use new names as continuing support for the old -- names is not guaranteed. -- Version 0.14 ∣-+ = ∣m∣n⇒∣m+n {-# WARNING_ON_USAGE ∣-+ "Warning: ∣-+ was deprecated in v0.14. Please use ∣m∣n⇒∣m+n instead." #-} ∣-∸ = ∣m+n∣m⇒∣n {-# WARNING_ON_USAGE ∣-∸ "Warning: ∣-∸ was deprecated in v0.14. Please use ∣m+n∣m⇒∣n instead." #-} ∣-* = n∣m*n {-# WARNING_ON_USAGE ∣-* "Warning: ∣-* was deprecated in v0.14. Please use n∣m*n instead." #-} -- Version 0.17 open import Data.Fin.Base using (Fin; zero; suc; toℕ) import Data.Fin.Properties as FP open import Data.Nat.Solver open +-*-Solver nonZeroDivisor-lemma : ∀ m q (r : Fin (1 + m)) → toℕ r ≢ 0 → 1 + m ∤ toℕ r + q * (1 + m) nonZeroDivisor-lemma m zero r r≢zero (divides zero eq) = r≢zero $ begin-equality toℕ r ≡⟨ sym (*-identityˡ (toℕ r)) ⟩ 1 * toℕ r ≡⟨ eq ⟩ 0 ∎ where open ≤-Reasoning nonZeroDivisor-lemma m zero r r≢zero (divides (suc q) eq) = m+1+n≰m m $ begin m + suc (q * suc m) ≡⟨ +-suc m (q * suc m) ⟩ suc (m + q * suc m) ≡⟨ sym eq ⟩ 1 * toℕ r ≡⟨ *-identityˡ (toℕ r) ⟩ toℕ r ≤⟨ FP.toℕ≤pred[n] r ⟩ m ∎ where open ≤-Reasoning nonZeroDivisor-lemma m (suc q) r r≢zero d = nonZeroDivisor-lemma m q r r≢zero (∣m+n∣m⇒∣n d′ ∣-refl) where lem = solve 3 (λ m r q → r :+ (m :+ q) := m :+ (r :+ q)) refl (suc m) (toℕ r) (q * suc m) d′ = subst (1 + m ∣_) lem d {-# WARNING_ON_USAGE nonZeroDivisor-lemma "Warning: nonZeroDivisor-lemma was deprecated in v0.17." #-} -- Version 1.1 poset = ∣-poset {-# WARNING_ON_USAGE poset "Warning: poset was deprecated in v1.1. Please use ∣-poset instead." #-} *-cong = *-monoʳ-∣ {-# WARNING_ON_USAGE *-cong "Warning: *-cong was deprecated in v1.1. Please use *-monoʳ-∣ instead." #-} /-cong = *-cancelˡ-∣ {-# WARNING_ON_USAGE /-cong "Warning: /-cong was deprecated in v1.1. Please use *-cancelˡ-∣ instead." #-} agda-stdlib-1.7.3/src/Data/Nat/Divisibility/000077500000000000000000000000001451211343400205215ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/Divisibility/Core.agda000066400000000000000000000034101451211343400222250ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Core definition of divisibility ------------------------------------------------------------------------ -- The definition of divisibility is split out from -- `Data.Nat.Divisibility` to avoid a dependency cycle with -- `Data.Nat.DivMod`. {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Divisibility.Core where open import Data.Nat.Base using (ℕ; _*_) open import Data.Nat.Properties open import Level using (0ℓ) open import Relation.Nullary using (¬_) open import Relation.Binary using (Rel) open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; cong₂; module ≡-Reasoning) ------------------------------------------------------------------------ -- Definition -- -- m ∣ n is inhabited iff m divides n. Some sources, like Hardy and -- Wright's "An Introduction to the Theory of Numbers", require m to -- be non-zero. However, some things become a bit nicer if m is -- allowed to be zero. For instance, _∣_ becomes a partial order, and -- the gcd of 0 and 0 becomes defined. infix 4 _∣_ _∤_ record _∣_ (m n : ℕ) : Set where constructor divides field quotient : ℕ equality : n ≡ quotient * m open _∣_ using (quotient) public _∤_ : Rel ℕ 0ℓ m ∤ n = ¬ (m ∣ n) ------------------------------------------------------------------------ -- Basic properties *-pres-∣ : ∀ {m n o p} → o ∣ m → p ∣ n → o * p ∣ m * n *-pres-∣ {m} {n} {o} {p} (divides c m≡c*o) (divides d n≡d*p) = divides (c * d) (begin m * n ≡⟨ cong₂ _*_ m≡c*o n≡d*p ⟩ (c * o) * (d * p) ≡⟨ [m*n]*[o*p]≡[m*o]*[n*p] c o d p ⟩ (c * d) * (o * p) ∎) where open ≡-Reasoning agda-stdlib-1.7.3/src/Data/Nat/GCD.agda000066400000000000000000000322041451211343400172710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Greatest common divisor ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.GCD where open import Data.Nat.Base open import Data.Nat.Divisibility open import Data.Nat.DivMod open import Data.Nat.GCD.Lemmas open import Data.Nat.Properties open import Data.Nat.Induction using (Acc; acc; <′-Rec; <′-recBuilder; <-wellFounded-fast) open import Data.Product open import Data.Sum.Base as Sum using (_⊎_; inj₁; inj₂) open import Function open import Induction using (build) open import Induction.Lexicographic using (_⊗_; [_⊗_]) open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; subst; cong) open import Relation.Nullary using (Dec) open import Relation.Nullary.Negation using (contradiction) import Relation.Nullary.Decidable as Dec ------------------------------------------------------------------------ -- Definition -- Calculated via Euclid's algorithm. In order to show progress, -- avoiding the initial step where the first argument may increase, it -- is necessary to first define a version `gcd′` which assumes that the -- second argument is strictly smaller than the first. The full `gcd` -- function then compares the two arguments and applies `gcd′` -- accordingly. gcd′ : ∀ m n → Acc _<_ m → n < m → ℕ gcd′ m zero _ _ = m gcd′ m n@(suc n-1) (acc rec) n _ _ n _ _ m _ _ m _ _ m0 {n} {gcd m n} {gcd≢0} (gcd[m,n]≤n m n-1)) m/gcd[m,n]≢0 : ∀ m n {m≢0 : Dec.False (m ≟ 0)} {gcd≢0} → (m / gcd m n) {gcd≢0} ≢ 0 m/gcd[m,n]≢0 m@(suc _) n rewrite gcd-comm m n = n/gcd[m,n]≢0 n m ------------------------------------------------------------------------ -- A formal specification of GCD module GCD where -- Specification of the greatest common divisor (gcd) of two natural -- numbers. record GCD (m n gcd : ℕ) : Set where constructor is field -- The gcd is a common divisor. commonDivisor : gcd ∣ m × gcd ∣ n -- All common divisors divide the gcd, i.e. the gcd is the -- greatest common divisor according to the partial order _∣_. greatest : ∀ {d} → d ∣ m × d ∣ n → d ∣ gcd open GCD public -- The gcd is unique. unique : ∀ {d₁ d₂ m n} → GCD m n d₁ → GCD m n d₂ → d₁ ≡ d₂ unique d₁ d₂ = ∣-antisym (GCD.greatest d₂ (GCD.commonDivisor d₁)) (GCD.greatest d₁ (GCD.commonDivisor d₂)) -- The gcd relation is "symmetric". sym : ∀ {d m n} → GCD m n d → GCD n m d sym g = is (swap $ GCD.commonDivisor g) (GCD.greatest g ∘ swap) -- The gcd relation is "reflexive". refl : ∀ {n} → GCD n n n refl = is (∣-refl , ∣-refl) proj₁ -- The GCD of 0 and n is n. base : ∀ {n} → GCD 0 n n base {n} = is (n ∣0 , ∣-refl) proj₂ -- If d is the gcd of n and k, then it is also the gcd of n and -- n + k. step : ∀ {n k d} → GCD n k d → GCD n (n + k) d step g with GCD.commonDivisor g step {n} {k} {d} g | (d₁ , d₂) = is (d₁ , ∣m∣n⇒∣m+n d₁ d₂) greatest′ where greatest′ : ∀ {d′} → d′ ∣ n × d′ ∣ n + k → d′ ∣ d greatest′ (d₁ , d₂) = GCD.greatest g (d₁ , ∣m+n∣m⇒∣n d₂ d₁) open GCD public using (GCD) hiding (module GCD) -- The function gcd fulfils the conditions required of GCD gcd-GCD : ∀ m n → GCD m n (gcd m n) gcd-GCD m n = record { commonDivisor = gcd[m,n]∣m m n , gcd[m,n]∣n m n ; greatest = uncurry′ gcd-greatest } -- Calculates the gcd of the arguments. mkGCD : ∀ m n → ∃ λ d → GCD m n d mkGCD m n = gcd m n , gcd-GCD m n -- gcd as a proposition is decidable gcd? : (m n d : ℕ) → Dec (GCD m n d) gcd? m n d = Dec.map′ (λ { P.refl → gcd-GCD m n }) (GCD.unique (gcd-GCD m n)) (gcd m n ≟ d) GCD-* : ∀ {m n d c} → GCD (m * suc c) (n * suc c) (d * suc c) → GCD m n d GCD-* (GCD.is (dc∣nc , dc∣mc) dc-greatest) = GCD.is (*-cancelʳ-∣ _ dc∣nc , *-cancelʳ-∣ _ dc∣mc) λ {_} → *-cancelʳ-∣ _ ∘ dc-greatest ∘ map (*-monoˡ-∣ _) (*-monoˡ-∣ _) GCD-/ : ∀ {m n d c} {≢0} → c ∣ m → c ∣ n → c ∣ d → GCD m n d → GCD ((m / c) {≢0}) ((n / c) {≢0}) ((d / c) {≢0}) GCD-/ {m} {n} {d} {c@(suc c-1)} (divides p P.refl) (divides q P.refl) (divides r P.refl) gcd rewrite m*n/n≡m p c {_} | m*n/n≡m q c {_} | m*n/n≡m r c {_} = GCD-* gcd GCD-/gcd : ∀ m n {≢0} → GCD ((m / gcd m n) {≢0}) ((n / gcd m n) {≢0}) 1 GCD-/gcd m n {≢0} rewrite P.sym (n/n≡1 (gcd m n) {≢0}) = GCD-/ {≢0 = ≢0} (gcd[m,n]∣m m n) (gcd[m,n]∣n m n) ∣-refl (gcd-GCD m n) ------------------------------------------------------------------------ -- Calculating the gcd -- The calculation also proves Bézout's lemma. module Bézout where module Identity where -- If m and n have greatest common divisor d, then one of the -- following two equations is satisfied, for some numbers x and y. -- The proof is "lemma" below (Bézout's lemma). -- -- (If this identity was stated using integers instead of natural -- numbers, then it would not be necessary to have two equations.) data Identity (d m n : ℕ) : Set where +- : (x y : ℕ) (eq : d + y * n ≡ x * m) → Identity d m n -+ : (x y : ℕ) (eq : d + x * m ≡ y * n) → Identity d m n -- Various properties about Identity. sym : ∀ {d} → Symmetric (Identity d) sym (+- x y eq) = -+ y x eq sym (-+ x y eq) = +- y x eq refl : ∀ {d} → Identity d d d refl = -+ 0 1 P.refl base : ∀ {d} → Identity d 0 d base = -+ 0 1 P.refl private infixl 7 _⊕_ _⊕_ : ℕ → ℕ → ℕ m ⊕ n = 1 + m + n step : ∀ {d n k} → Identity d n k → Identity d n (n + k) step {d} {n} (+- x y eq) with compare x y ... | equal x = +- (2 * x) x (lem₂ d x eq) ... | less x i = +- (2 * x ⊕ i) (x ⊕ i) (lem₃ d x eq) ... | greater y i = +- (2 * y ⊕ i) y (lem₄ d y n eq) step {d} {n} (-+ x y eq) with compare x y ... | equal x = -+ (2 * x) x (lem₅ d x eq) ... | less x i = -+ (2 * x ⊕ i) (x ⊕ i) (lem₆ d x eq) ... | greater y i = -+ (2 * y ⊕ i) y (lem₇ d y n eq) open Identity public using (Identity; +-; -+) hiding (module Identity) module Lemma where -- This type packs up the gcd, the proof that it is a gcd, and the -- proof that it satisfies Bézout's identity. data Lemma (m n : ℕ) : Set where result : (d : ℕ) (g : GCD m n d) (b : Identity d m n) → Lemma m n -- Various properties about Lemma. sym : Symmetric Lemma sym (result d g b) = result d (GCD.sym g) (Identity.sym b) base : ∀ d → Lemma 0 d base d = result d GCD.base Identity.base refl : ∀ d → Lemma d d refl d = result d GCD.refl Identity.refl stepˡ : ∀ {n k} → Lemma n (suc k) → Lemma n (suc (n + k)) stepˡ {n} {k} (result d g b) = subst (Lemma n) (+-suc n k) $ result d (GCD.step g) (Identity.step b) stepʳ : ∀ {n k} → Lemma (suc k) n → Lemma (suc (n + k)) n stepʳ = sym ∘ stepˡ ∘ sym open Lemma public using (Lemma; result) hiding (module Lemma) -- Bézout's lemma proved using some variant of the extended -- Euclidean algorithm. lemma : (m n : ℕ) → Lemma m n lemma m n = build [ <′-recBuilder ⊗ <′-recBuilder ] P gcd″ (m , n) where P : ℕ × ℕ → Set P (m , n) = Lemma m n gcd″ : ∀ p → (<′-Rec ⊗ <′-Rec) P p → P p gcd″ (zero , n ) rec = Lemma.base n gcd″ (suc m , zero ) rec = Lemma.sym (Lemma.base (suc m)) gcd″ (suc m , suc n ) rec with compare m n ... | equal .m = Lemma.refl (suc m) ... | less .m k = Lemma.stepˡ $ proj₁ rec (suc k) (lem₁ k m) -- "gcd (suc m) (suc k)" ... | greater .n k = Lemma.stepʳ $ proj₂ rec (suc k) (lem₁ k n) (suc n) -- "gcd (suc k) (suc n)" -- Bézout's identity can be recovered from the GCD. identity : ∀ {m n d} → GCD m n d → Identity d m n identity {m} {n} g with lemma m n ... | result d g′ b with GCD.unique g g′ ... | P.refl = b agda-stdlib-1.7.3/src/Data/Nat/GCD/000077500000000000000000000000001451211343400164525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/GCD/Lemmas.agda000066400000000000000000000171031451211343400205100ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Boring lemmas used in Data.Nat.GCD and Data.Nat.Coprimality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.GCD.Lemmas where open import Data.Nat.Base open import Data.Nat.Properties open import Data.Nat.Solver open import Function open import Relation.Binary.PropositionalEquality open +-*-Solver open ≡-Reasoning private distrib-comm : ∀ x k n → x * k + x * n ≡ x * (n + k) distrib-comm = solve 3 (λ x k n → x :* k :+ x :* n := x :* (n :+ k)) refl distrib-comm₂ : ∀ d x k n → d + x * (n + k) ≡ d + x * k + x * n distrib-comm₂ = solve 4 (λ d x k n → d :+ x :* (n :+ k) := d :+ x :* k :+ x :* n) refl -- Other properties -- TODO: Can this proof be simplified? An automatic solver which can -- handle ∸ would be nice... lem₀ : ∀ i j m n → i * m ≡ j * m + n → (i ∸ j) * m ≡ n lem₀ i j m n eq = begin (i ∸ j) * m ≡⟨ *-distribʳ-∸ m i j ⟩ (i * m) ∸ (j * m) ≡⟨ cong (_∸ j * m) eq ⟩ (j * m + n) ∸ (j * m) ≡⟨ cong (_∸ j * m) (+-comm (j * m) n) ⟩ (n + j * m) ∸ (j * m) ≡⟨ m+n∸n≡m n (j * m) ⟩ n ∎ lem₁ : ∀ i j → 2 + i ≤′ 2 + j + i lem₁ i j = ≤⇒≤′ $ s≤s $ s≤s $ m≤n+m i j lem₂ : ∀ d x {k n} → d + x * k ≡ x * n → d + x * (n + k) ≡ 2 * x * n lem₂ d x {k} {n} eq = begin d + x * (n + k) ≡⟨ distrib-comm₂ d x k n ⟩ d + x * k + x * n ≡⟨ cong₂ _+_ eq refl ⟩ x * n + x * n ≡⟨ solve 3 (λ x n k → x :* n :+ x :* n := con 2 :* x :* n) refl x n k ⟩ 2 * x * n ∎ lem₃ : ∀ d x {i k n} → d + (1 + x + i) * k ≡ x * n → d + (1 + x + i) * (n + k) ≡ (1 + 2 * x + i) * n lem₃ d x {i} {k} {n} eq = begin d + y * (n + k) ≡⟨ distrib-comm₂ d y k n ⟩ d + y * k + y * n ≡⟨ cong₂ _+_ eq refl ⟩ x * n + y * n ≡⟨ solve 3 (λ x n i → x :* n :+ (con 1 :+ x :+ i) :* n := (con 1 :+ con 2 :* x :+ i) :* n) refl x n i ⟩ (1 + 2 * x + i) * n ∎ where y = 1 + x + i lem₄ : ∀ d y {k i} n → d + y * k ≡ (1 + y + i) * n → d + y * (n + k) ≡ (1 + 2 * y + i) * n lem₄ d y {k} {i} n eq = begin d + y * (n + k) ≡⟨ distrib-comm₂ d y k n ⟩ d + y * k + y * n ≡⟨ cong₂ _+_ eq refl ⟩ (1 + y + i) * n + y * n ≡⟨ solve 3 (λ y i n → (con 1 :+ y :+ i) :* n :+ y :* n := (con 1 :+ con 2 :* y :+ i) :* n) refl y i n ⟩ (1 + 2 * y + i) * n ∎ lem₅ : ∀ d x {n k} → d + x * n ≡ x * k → d + 2 * x * n ≡ x * (n + k) lem₅ d x {n} {k} eq = begin d + 2 * x * n ≡⟨ solve 3 (λ d x n → d :+ con 2 :* x :* n := d :+ x :* n :+ x :* n) refl d x n ⟩ d + x * n + x * n ≡⟨ cong₂ _+_ eq refl ⟩ x * k + x * n ≡⟨ distrib-comm x k n ⟩ x * (n + k) ∎ lem₆ : ∀ d x {n i k} → d + x * n ≡ (1 + x + i) * k → d + (1 + 2 * x + i) * n ≡ (1 + x + i) * (n + k) lem₆ d x {n} {i} {k} eq = begin d + (1 + 2 * x + i) * n ≡⟨ solve 4 (λ d x i n → d :+ (con 1 :+ con 2 :* x :+ i) :* n := d :+ x :* n :+ (con 1 :+ x :+ i) :* n) refl d x i n ⟩ d + x * n + y * n ≡⟨ cong₂ _+_ eq refl ⟩ y * k + y * n ≡⟨ distrib-comm y k n ⟩ y * (n + k) ∎ where y = 1 + x + i lem₇ : ∀ d y {i} n {k} → d + (1 + y + i) * n ≡ y * k → d + (1 + 2 * y + i) * n ≡ y * (n + k) lem₇ d y {i} n {k} eq = begin d + (1 + 2 * y + i) * n ≡⟨ solve 4 (λ d y i n → d :+ (con 1 :+ con 2 :* y :+ i) :* n := d :+ (con 1 :+ y :+ i) :* n :+ y :* n) refl d y i n ⟩ d + (1 + y + i) * n + y * n ≡⟨ cong₂ _+_ eq refl ⟩ y * k + y * n ≡⟨ distrib-comm y k n ⟩ y * (n + k) ∎ lem₈ : ∀ {i j k q} x y → 1 + y * j ≡ x * i → j * k ≡ q * i → k ≡ (x * k ∸ y * q) * i lem₈ {i} {j} {k} {q} x y eq eq′ = sym (lem₀ (x * k) (y * q) i k lemma) where lemma = begin x * k * i ≡⟨ solve 3 (λ x k i → x :* k :* i := x :* i :* k) refl x k i ⟩ x * i * k ≡⟨ cong (_* k) (sym eq) ⟩ (1 + y * j) * k ≡⟨ solve 3 (λ y j k → (con 1 :+ y :* j) :* k := y :* (j :* k) :+ k) refl y j k ⟩ y * (j * k) + k ≡⟨ cong (λ n → y * n + k) eq′ ⟩ y * (q * i) + k ≡⟨ solve 4 (λ y q i k → y :* (q :* i) :+ k := y :* q :* i :+ k) refl y q i k ⟩ y * q * i + k ∎ lem₉ : ∀ {i j k q} x y → 1 + x * i ≡ y * j → j * k ≡ q * i → k ≡ (y * q ∸ x * k) * i lem₉ {i} {j} {k} {q} x y eq eq′ = sym (lem₀ (y * q) (x * k) i k lemma) where lem = solve 3 (λ a b c → a :* b :* c := b :* c :* a) refl lemma = begin y * q * i ≡⟨ lem y q i ⟩ q * i * y ≡⟨ cong (λ n → n * y) (sym eq′) ⟩ j * k * y ≡⟨ sym (lem y j k) ⟩ y * j * k ≡⟨ cong (λ n → n * k) (sym eq) ⟩ (1 + x * i) * k ≡⟨ solve 3 (λ x i k → (con 1 :+ x :* i) :* k := x :* k :* i :+ k) refl x i k ⟩ x * k * i + k ∎ lem₁₀ : ∀ {a′} b c {d} e f → let a = suc a′ in a + b * (c * d * a) ≡ e * (f * d * a) → d ≡ 1 lem₁₀ {a′} b c {d} e f eq = m*n≡1⇒n≡1 (e * f ∸ b * c) d (lem₀ (e * f) (b * c) d 1 (*-cancelʳ-≡ (e * f * d) (b * c * d + 1) (begin e * f * d * a ≡⟨ solve 4 (λ e f d a → e :* f :* d :* a := e :* (f :* d :* a)) refl e f d a ⟩ e * (f * d * a) ≡⟨ sym eq ⟩ a + b * (c * d * a) ≡⟨ solve 4 (λ a b c d → a :+ b :* (c :* d :* a) := (b :* c :* d :+ con 1) :* a) refl a b c d ⟩ (b * c * d + 1) * a ∎))) where a = suc a′ lem₁₁ : ∀ {i j m n k d} x y → 1 + y * j ≡ x * i → i * k ≡ m * d → j * k ≡ n * d → k ≡ (x * m ∸ y * n) * d lem₁₁ {i} {j} {m} {n} {k} {d} x y eq eq₁ eq₂ = sym (lem₀ (x * m) (y * n) d k (begin x * m * d ≡⟨ *-assoc x m d ⟩ x * (m * d) ≡⟨ cong (x *_) (sym eq₁) ⟩ x * (i * k) ≡⟨ sym (*-assoc x i k) ⟩ x * i * k ≡⟨ cong₂ _*_ (sym eq) refl ⟩ (1 + y * j) * k ≡⟨ solve 3 (λ y j k → (con 1 :+ y :* j) :* k := y :* (j :* k) :+ k) refl y j k ⟩ y * (j * k) + k ≡⟨ cong (λ p → y * p + k) eq₂ ⟩ y * (n * d) + k ≡⟨ cong₂ _+_ (sym $ *-assoc y n d) refl ⟩ y * n * d + k ∎)) agda-stdlib-1.7.3/src/Data/Nat/GeneralisedArithmetic.agda000066400000000000000000000062261451211343400231350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A generalisation of the arithmetic operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.GeneralisedArithmetic where open import Data.Nat.Base open import Data.Nat.Properties open import Function.Base using (_∘′_; _∘_; id) open import Relation.Binary.PropositionalEquality open ≡-Reasoning module _ {a} {A : Set a} where fold : A → (A → A) → ℕ → A fold z s zero = z fold z s (suc n) = s (fold z s n) add : (0# : A) (1+ : A → A) → ℕ → A → A add 0# 1+ n z = fold z 1+ n mul : (0# : A) (1+ : A → A) → (+ : A → A → A) → (ℕ → A → A) mul 0# 1+ _+_ n x = fold 0# (λ s → x + s) n -- Properties module _ {a} {A : Set a} where fold-+ : ∀ {s : A → A} {z : A} → ∀ m {n} → fold z s (m + n) ≡ fold (fold z s n) s m fold-+ zero = refl fold-+ {s = s} (suc m) = cong s (fold-+ m) fold-k : ∀ {s : A → A} {z : A} {k} m → fold k (s ∘′_) m z ≡ fold (k z) s m fold-k zero = refl fold-k {s = s} (suc m) = cong s (fold-k m) fold-* : ∀ {s : A → A} {z : A} m {n} → fold z s (m * n) ≡ fold z (fold id (s ∘_) n) m fold-* zero = refl fold-* {s = s} {z} (suc m) {n} = let +n = fold id (s ∘′_) n in begin fold z s (n + m * n) ≡⟨ fold-+ n ⟩ fold (fold z s (m * n)) s n ≡⟨ cong (λ z → fold z s n) (fold-* m) ⟩ fold (fold z +n m) s n ≡⟨ sym (fold-k n) ⟩ fold z +n (suc m) ∎ fold-pull : ∀ {s : A → A} {z : A} (g : A → A → A) (p : A) (eqz : g z p ≡ p) (eqs : ∀ l → s (g l p) ≡ g (s l) p) → ∀ m → fold p s m ≡ g (fold z s m) p fold-pull _ _ eqz _ zero = sym eqz fold-pull {s = s} {z} g p eqz eqs (suc m) = begin s (fold p s m) ≡⟨ cong s (fold-pull g p eqz eqs m) ⟩ s (g (fold z s m) p) ≡⟨ eqs (fold z s m) ⟩ g (s (fold z s m)) p ∎ id-is-fold : ∀ m → fold zero suc m ≡ m id-is-fold zero = refl id-is-fold (suc m) = cong suc (id-is-fold m) +-is-fold : ∀ m {n} → fold n suc m ≡ m + n +-is-fold zero = refl +-is-fold (suc m) = cong suc (+-is-fold m) *-is-fold : ∀ m {n} → fold zero (n +_) m ≡ m * n *-is-fold zero = refl *-is-fold (suc m) {n} = cong (n +_) (*-is-fold m) ^-is-fold : ∀ {m} n → fold 1 (m *_) n ≡ m ^ n ^-is-fold zero = refl ^-is-fold {m} (suc n) = cong (m *_) (^-is-fold n) *+-is-fold : ∀ m n {p} → fold p (n +_) m ≡ m * n + p *+-is-fold m n {p} = begin fold p (n +_) m ≡⟨ fold-pull _+_ p refl (λ l → sym (+-assoc n l p)) m ⟩ fold 0 (n +_) m + p ≡⟨ cong (_+ p) (*-is-fold m) ⟩ m * n + p ∎ ^*-is-fold : ∀ m n {p} → fold p (m *_) n ≡ m ^ n * p ^*-is-fold m n {p} = begin fold p (m *_) n ≡⟨ fold-pull _*_ p (*-identityˡ p) (λ l → sym (*-assoc m l p)) n ⟩ fold 1 (m *_) n * p ≡⟨ cong (_* p) (^-is-fold n) ⟩ m ^ n * p ∎ agda-stdlib-1.7.3/src/Data/Nat/Induction.agda000066400000000000000000000115411451211343400206310ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Various forms of induction for natural numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Induction where open import Function open import Data.Nat.Base open import Data.Nat.Properties using (≤⇒≤′; n<1+n) open import Data.Product open import Data.Unit.Polymorphic open import Induction open import Induction.WellFounded as WF open import Level using (Level) open import Relation.Binary.PropositionalEquality open import Relation.Unary private variable ℓ : Level ------------------------------------------------------------------------ -- Re-export accessability open WF public using (Acc; acc) ------------------------------------------------------------------------ -- Ordinary induction Rec : ∀ ℓ → RecStruct ℕ ℓ ℓ Rec ℓ P zero = ⊤ Rec ℓ P (suc n) = P n recBuilder : ∀ {ℓ} → RecursorBuilder (Rec ℓ) recBuilder P f zero = _ recBuilder P f (suc n) = f n (recBuilder P f n) rec : ∀ {ℓ} → Recursor (Rec ℓ) rec = build recBuilder ------------------------------------------------------------------------ -- Complete induction CRec : ∀ ℓ → RecStruct ℕ ℓ ℓ CRec ℓ P zero = ⊤ CRec ℓ P (suc n) = P n × CRec ℓ P n cRecBuilder : ∀ {ℓ} → RecursorBuilder (CRec ℓ) cRecBuilder P f zero = _ cRecBuilder P f (suc n) = f n ih , ih where ih = cRecBuilder P f n cRec : ∀ {ℓ} → Recursor (CRec ℓ) cRec = build cRecBuilder ------------------------------------------------------------------------ -- Complete induction based on _<′_ <′-Rec : ∀ {ℓ} → RecStruct ℕ ℓ ℓ <′-Rec = WfRec _<′_ mutual <′-wellFounded : WellFounded _<′_ <′-wellFounded n = acc (<′-wellFounded′ n) <′-wellFounded′ : ∀ n → <′-Rec (Acc _<′_) n <′-wellFounded′ (suc n) .n ≤′-refl = <′-wellFounded n <′-wellFounded′ (suc n) m (≤′-step m ¬[p⊎q] ∘ inj₁ ⊛ ¬[p⊎q] ∘ inj₂ -- Inf is functorial. map : ∀ {ℓp ℓq P Q} → P ⊆ Q → Inf {ℓp} P → Inf {ℓq} Q map P⊆Q ¬fin = ¬fin ∘ Prod.map id (λ fin j i≤j → fin j i≤j ∘ P⊆Q) -- Inf is upwards closed. up : ∀ {ℓ P} n → Inf {ℓ} P → Inf (P ∘ _+_ n) up zero = id up {P = P} (suc n) = up n ∘ up₁ where up₁ : Inf P → Inf (P ∘ suc) up₁ ¬fin (i , fin) = ¬fin (suc i , helper) where helper : ∀ j → 1 + i ≤ j → ¬ P j helper ._ (s≤s i≤j) = fin _ i≤j -- A witness. witness : ∀ {ℓ P} → Inf {ℓ} P → ¬ ¬ ∃ P witness ¬fin ¬p = ¬fin (0 , λ i _ Pi → ¬p (i , Pi)) -- Two different witnesses. twoDifferentWitnesses : ∀ {P} → Inf P → ¬ ¬ ∃₂ λ m n → m ≢ n × P m × P n twoDifferentWitnesses inf = witness inf >>= λ w₁ → witness (up (1 + proj₁ w₁) inf) >>= λ w₂ → return (_ , _ , m≢1+m+n (proj₁ w₁) , proj₂ w₁ , proj₂ w₂) agda-stdlib-1.7.3/src/Data/Nat/Instances.agda000066400000000000000000000010101451211343400206120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances for natural numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Instances where open import Data.Nat.Properties open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) instance ℕ-≡-isDecEquivalence = isDecEquivalence _≟_ ℕ-≤-isDecTotalOrder = ≤-isDecTotalOrder agda-stdlib-1.7.3/src/Data/Nat/LCM.agda000066400000000000000000000120461451211343400173110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Least common multiple ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.LCM where open import Algebra open import Data.Nat.Base open import Data.Nat.Coprimality using (Coprime) open import Data.Nat.Divisibility open import Data.Nat.DivMod open import Data.Nat.Properties open import Data.Nat.Solver open import Data.Nat.GCD open import Data.Product open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Function open import Relation.Binary.PropositionalEquality as P using (_≡_; refl; sym; trans; cong; cong₂; module ≡-Reasoning) open import Relation.Binary open import Relation.Nullary.Decidable using (False; fromWitnessFalse) open +-*-Solver private gcd≢0′ : ∀ m n → False (gcd (suc m) n ≟ 0) gcd≢0′ m n = fromWitnessFalse (gcd[m,n]≢0 (suc m) n (inj₁ (λ()))) ------------------------------------------------------------------------ -- Definition lcm : ℕ → ℕ → ℕ lcm zero n = zero lcm m@(suc m-1) n = m * (n / gcd m n) {gcd≢0′ m-1 n} ------------------------------------------------------------------------ -- Core properties private rearrange : ∀ m-1 n → lcm (suc m-1) n ≡ ((suc m-1) * n / gcd (suc m-1) n) {gcd≢0′ m-1 n} rearrange m-1 n = sym (*-/-assoc m {n} {gcd m n} {gcd≢0′ m-1 n} (gcd[m,n]∣n m n)) where m = suc m-1 m∣lcm[m,n] : ∀ m n → m ∣ lcm m n m∣lcm[m,n] zero n = 0 ∣0 m∣lcm[m,n] m@(suc _) n = m∣m*n (n / gcd m n) n∣lcm[m,n] : ∀ m n → n ∣ lcm m n n∣lcm[m,n] zero n = n ∣0 n∣lcm[m,n] m@(suc m-1) n = begin n ∣⟨ m∣m*n (m / gcd m n) ⟩ n * (m / gcd m n) ≡⟨ sym (*-/-assoc n {≢0 = gcd≢0′ m-1 n} (gcd[m,n]∣m m n)) ⟩ n * m / gcd m n ≡⟨ cong (λ v → (v / gcd m n) {gcd≢0′ m-1 n}) (*-comm n m) ⟩ m * n / gcd m n ≡⟨ sym (rearrange m-1 n) ⟩ m * (n / gcd m n) ∎ where open ∣-Reasoning lcm-least : ∀ {m n c} → m ∣ c → n ∣ c → lcm m n ∣ c lcm-least {zero} {n} {c} 0∣c _ = 0∣c lcm-least {m@(suc m-1)} {n} {c} m∣c n∣c = P.subst (_∣ c) (sym (rearrange m-1 n)) (m∣n*o⇒m/n∣o {n≢0 = gcd≢0′ m-1 n} gcd[m,n]∣m*n mn∣c*gcd) where open ∣-Reasoning gcd[m,n]∣m*n : gcd m n ∣ m * n gcd[m,n]∣m*n = ∣-trans (gcd[m,n]∣m m n) (m∣m*n n) mn∣c*gcd : m * n ∣ c * gcd m n mn∣c*gcd = begin m * n ∣⟨ gcd-greatest (P.subst (_∣ c * m) (*-comm n m) (*-monoˡ-∣ m n∣c)) (*-monoˡ-∣ n m∣c) ⟩ gcd (c * m) (c * n) ≡⟨ sym (c*gcd[m,n]≡gcd[cm,cn] c m n) ⟩ c * gcd m n ∎ ------------------------------------------------------------------------ -- Other properties -- Note that all other properties of `gcd` should be inferable from the -- 3 core properties above. gcd*lcm : ∀ m n → gcd m n * lcm m n ≡ m * n gcd*lcm zero n = *-zeroʳ (gcd 0 n) gcd*lcm m@(suc m-1) n = trans (cong (gcd m n *_) (rearrange m-1 n)) (m*[n/m]≡n {gcd m n} (begin gcd m n ∣⟨ gcd[m,n]∣m m n ⟩ m ∣⟨ m∣m*n n ⟩ m * n ∎)) where open ∣-Reasoning lcm[0,n]≡0 : ∀ n → lcm 0 n ≡ 0 lcm[0,n]≡0 n = 0∣⇒≡0 (m∣lcm[m,n] 0 n) lcm[n,0]≡0 : ∀ n → lcm n 0 ≡ 0 lcm[n,0]≡0 n = 0∣⇒≡0 (n∣lcm[m,n] n 0) lcm-comm : ∀ m n → lcm m n ≡ lcm n m lcm-comm m n = ∣-antisym (lcm-least (n∣lcm[m,n] n m) (m∣lcm[m,n] n m)) (lcm-least (n∣lcm[m,n] m n) (m∣lcm[m,n] m n)) ------------------------------------------------------------------------ -- Least common multiple (lcm). module LCM where -- Specification of the least common multiple (lcm) of two natural -- numbers. record LCM (i j lcm : ℕ) : Set where field -- The lcm is a common multiple. commonMultiple : i ∣ lcm × j ∣ lcm -- The lcm divides all common multiples, i.e. the lcm is the least -- common multiple according to the partial order _∣_. least : ∀ {m} → i ∣ m × j ∣ m → lcm ∣ m open LCM public -- The lcm is unique. unique : ∀ {d₁ d₂ m n} → LCM m n d₁ → LCM m n d₂ → d₁ ≡ d₂ unique d₁ d₂ = ∣-antisym (LCM.least d₁ (LCM.commonMultiple d₂)) (LCM.least d₂ (LCM.commonMultiple d₁)) open LCM public using (LCM) hiding (module LCM) ------------------------------------------------------------------------ -- Calculating the LCM lcm-LCM : ∀ m n → LCM m n (lcm m n) lcm-LCM m n = record { commonMultiple = m∣lcm[m,n] m n , n∣lcm[m,n] m n ; least = uncurry′ lcm-least } mkLCM : ∀ m n → ∃ λ d → LCM m n d mkLCM m n = lcm m n , lcm-LCM m n GCD*LCM : ∀ {m n g l} → GCD m n g → LCM m n l → m * n ≡ g * l GCD*LCM {m} {n} {g} {l} gc lc = sym (begin g * l ≡⟨ cong₂ _*_ (GCD.unique gc (gcd-GCD m n)) (LCM.unique lc (lcm-LCM m n)) ⟩ gcd m n * lcm m n ≡⟨ gcd*lcm m n ⟩ m * n ∎) where open ≡-Reasoning agda-stdlib-1.7.3/src/Data/Nat/Literals.agda000066400000000000000000000007131451211343400204530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Literals where open import Agda.Builtin.FromNat open import Agda.Builtin.Nat open import Data.Unit number : Number Nat number = record { Constraint = λ _ → ⊤ ; fromNat = λ n → n } agda-stdlib-1.7.3/src/Data/Nat/Primality.agda000066400000000000000000000021541451211343400206470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Primality ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Primality where open import Data.Empty using (⊥) open import Data.Fin.Base using (Fin; toℕ) open import Data.Fin.Properties using (all?) open import Data.Nat.Base using (ℕ; suc; _+_) open import Data.Nat.Divisibility using (_∤_; _∣?_) open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (from-yes) open import Relation.Nullary.Negation using (¬?) open import Relation.Unary using (Decidable) -- Definition of primality. Prime : ℕ → Set Prime 0 = ⊥ Prime 1 = ⊥ Prime (suc (suc n)) = (i : Fin n) → 2 + toℕ i ∤ 2 + n -- Decision procedure for primality. prime? : Decidable Prime prime? 0 = no λ() prime? 1 = no λ() prime? (suc (suc n)) = all? (λ _ → ¬? (_ ∣? _)) private -- Example: 2 is prime. 2-is-prime : Prime 2 2-is-prime = from-yes (prime? 2) agda-stdlib-1.7.3/src/Data/Nat/Properties.agda000066400000000000000000002502501451211343400210330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A bunch of properties about natural number operations ------------------------------------------------------------------------ -- See README.Data.Nat for some examples showing how this module can be -- used. {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Properties where open import Axiom.UniquenessOfIdentityProofs open import Algebra.Bundles open import Algebra.Morphism open import Algebra.Consequences.Propositional open import Algebra.Construct.NaturalChoice.Base import Algebra.Construct.NaturalChoice.MinMaxOp as MinMaxOp import Algebra.Properties.CommutativeSemigroup as CommSemigroupProperties open import Data.Bool.Base using (Bool; false; true; T) open import Data.Bool.Properties using (T?) open import Data.Empty using (⊥) open import Data.Nat.Base open import Data.Product using (_×_; _,_) open import Data.Sum.Base as Sum open import Data.Unit using (tt) open import Function.Base open import Function.Injection using (_↣_) open import Function.Metric.Nat open import Level using (0ℓ) open import Relation.Binary open import Relation.Binary.Consequences using (flip-Connex) open import Relation.Binary.PropositionalEquality open import Relation.Nullary hiding (Irrelevant) open import Relation.Nullary.Decidable using (True; via-injection; map′) open import Relation.Nullary.Negation using (contradiction) open import Relation.Nullary.Reflects using (fromEquivalence) open import Algebra.Definitions {A = ℕ} _≡_ hiding (LeftCancellative; RightCancellative; Cancellative) open import Algebra.Definitions using (LeftCancellative; RightCancellative; Cancellative) open import Algebra.Structures {A = ℕ} _≡_ ------------------------------------------------------------------------ -- Properties of _≡_ ------------------------------------------------------------------------ suc-injective : ∀ {m n} → suc m ≡ suc n → m ≡ n suc-injective refl = refl ≡ᵇ⇒≡ : ∀ m n → T (m ≡ᵇ n) → m ≡ n ≡ᵇ⇒≡ zero zero _ = refl ≡ᵇ⇒≡ (suc m) (suc n) eq = cong suc (≡ᵇ⇒≡ m n eq) ≡⇒≡ᵇ : ∀ m n → m ≡ n → T (m ≡ᵇ n) ≡⇒≡ᵇ zero zero eq = _ ≡⇒≡ᵇ (suc m) (suc n) eq = ≡⇒≡ᵇ m n (suc-injective eq) -- NB: we use the builtin function `_≡ᵇ_` here so that the function -- quickly decides whether to return `yes` or `no`. It still takes -- a linear amount of time to generate the proof if it is inspected. -- We expect the main benefit to be visible in compiled code as the -- backend erases proofs. infix 4 _≟_ _≟_ : Decidable {A = ℕ} _≡_ m ≟ n = map′ (≡ᵇ⇒≡ m n) (≡⇒≡ᵇ m n) (T? (m ≡ᵇ n)) ≡-irrelevant : Irrelevant {A = ℕ} _≡_ ≡-irrelevant = Decidable⇒UIP.≡-irrelevant _≟_ ≟-diag : ∀ {m n} (eq : m ≡ n) → (m ≟ n) ≡ yes eq ≟-diag = ≡-≟-identity _≟_ ≡-isDecEquivalence : IsDecEquivalence (_≡_ {A = ℕ}) ≡-isDecEquivalence = record { isEquivalence = isEquivalence ; _≟_ = _≟_ } ≡-decSetoid : DecSetoid 0ℓ 0ℓ ≡-decSetoid = record { Carrier = ℕ ; _≈_ = _≡_ ; isDecEquivalence = ≡-isDecEquivalence } 0≢1+n : ∀ {n} → 0 ≢ suc n 0≢1+n () 1+n≢0 : ∀ {n} → suc n ≢ 0 1+n≢0 () 1+n≢n : ∀ {n} → suc n ≢ n 1+n≢n {suc n} = 1+n≢n ∘ suc-injective ------------------------------------------------------------------------ -- Properties of _<ᵇ_ ------------------------------------------------------------------------ <ᵇ⇒< : ∀ m n → T (m <ᵇ n) → m < n <ᵇ⇒< zero (suc n) m⇒≢ : _>_ ⇒ _≢_ >⇒≢ = ≢-sym ∘ <⇒≢ ≤⇒≯ : _≤_ ⇒ _≯_ ≤⇒≯ (s≤s m≤n) (s≤s n≤m) = ≤⇒≯ m≤n n≤m <⇒≱ : _<_ ⇒ _≱_ <⇒≱ (s≤s m+1≤n) (s≤s n≤m) = <⇒≱ m+1≤n n≤m <⇒≯ : _<_ ⇒ _≯_ <⇒≯ (s≤s m : _≰_ ⇒ _>_ ≰⇒> {zero} z≰n = contradiction z≤n z≰n ≰⇒> {suc m} {zero} _ = s≤s z≤n ≰⇒> {suc m} {suc n} m≰n = s≤s (≰⇒> (m≰n ∘ s≤s)) ≰⇒≥ : _≰_ ⇒ _≥_ ≰⇒≥ = <⇒≤ ∘ ≰⇒> ≮⇒≥ : _≮_ ⇒ _≥_ ≮⇒≥ {_} {zero} _ = z≤n ≮⇒≥ {zero} {suc j} 1≮j+1 = contradiction (s≤s z≤n) 1≮j+1 ≮⇒≥ {suc i} {suc j} i+1≮j+1 = s≤s (≮⇒≥ (i+1≮j+1 ∘ s≤s)) ≤∧≢⇒< : ∀ {m n} → m ≤ n → m ≢ n → m < n ≤∧≢⇒< {_} {zero} z≤n m≢n = contradiction refl m≢n ≤∧≢⇒< {_} {suc n} z≤n m≢n = s≤s z≤n ≤∧≢⇒< {_} {suc n} (s≤s m≤n) 1+m≢1+n = s≤s (≤∧≢⇒< m≤n (1+m≢1+n ∘ cong suc)) ≤∧≮⇒≡ : ∀ {m n} → m ≤ n → m ≮ n → m ≡ n ≤∧≮⇒≡ m≤n m≮n = ≤-antisym m≤n (≮⇒≥ m≮n) ≤-<-connex : Connex _≤_ _<_ ≤-<-connex m n with m ≤? n ... | yes m≤n = inj₁ m≤n ... | no ¬m≤n = inj₂ (≰⇒> ¬m≤n) ≥->-connex : Connex _≥_ _>_ ≥->-connex = flip ≤-<-connex <-≤-connex : Connex _<_ _≤_ <-≤-connex = flip-Connex ≤-<-connex >-≥-connex : Connex _>_ _≥_ >-≥-connex = flip-Connex ≥->-connex ------------------------------------------------------------------------ -- Relational properties of _<_ <-irrefl : Irreflexive _≡_ _<_ <-irrefl refl (s≤s n (m≮n ∘ <⇒<ᵇ) m≢n (≤∧≢⇒< (≮⇒≥ (m≮n ∘ <⇒<ᵇ)) (m≢n ∘ sym)) infix 4 _?_ _?_ : Decidable _>_ _>?_ = flip _0 : ∀ {n} → n ≢ 0 → n > 0 n≢0⇒n>0 {zero} 0≢0 = contradiction refl 0≢0 n≢0⇒n>0 {suc n} _ = 0<1+n m 0 → m < m + n m0 = n>0 m0 = s≤s (m0) m 0 → m < n + m m0 rewrite +-comm n m = m0 m+n≮n : ∀ m n → m + n ≮ n m+n≮n zero n = n≮n n m+n≮n (suc m) (suc n) (s≤s m+nn⇒m∸n≢0 : ∀ {m n} → m > n → m ∸ n ≢ 0 m>n⇒m∸n≢0 {n = suc n} (s≤s m>n) = m>n⇒m∸n≢0 m>n --------------------------------------------------------------- -- Properties of _∸_ and _+_ +-∸-comm : ∀ {m} n {o} → o ≤ m → (m + n) ∸ o ≡ (m ∸ o) + n +-∸-comm {zero} _ {zero} _ = refl +-∸-comm {suc m} _ {zero} _ = refl +-∸-comm {suc m} n {suc o} (s≤s o≤m) = +-∸-comm n o≤m ∸-+-assoc : ∀ m n o → (m ∸ n) ∸ o ≡ m ∸ (n + o) ∸-+-assoc zero zero o = refl ∸-+-assoc zero (suc n) o = 0∸n≡0 o ∸-+-assoc (suc m) zero o = refl ∸-+-assoc (suc m) (suc n) o = ∸-+-assoc m n o +-∸-assoc : ∀ m {n o} → o ≤ n → (m + n) ∸ o ≡ m + (n ∸ o) +-∸-assoc m (z≤n {n = n}) = begin-equality m + n ∎ +-∸-assoc m (s≤s {m = o} {n = n} o≤n) = begin-equality (m + suc n) ∸ suc o ≡⟨ cong (_∸ suc o) (+-suc m n) ⟩ suc (m + n) ∸ suc o ≡⟨⟩ (m + n) ∸ o ≡⟨ +-∸-assoc m o≤n ⟩ m + (n ∸ o) ∎ m≤n+m∸n : ∀ m n → m ≤ n + (m ∸ n) m≤n+m∸n zero n = z≤n m≤n+m∸n (suc m) zero = ≤-refl m≤n+m∸n (suc m) (suc n) = s≤s (m≤n+m∸n m n) m+n∸n≡m : ∀ m n → m + n ∸ n ≡ m m+n∸n≡m m n = begin-equality (m + n) ∸ n ≡⟨ +-∸-assoc m (≤-refl {x = n}) ⟩ m + (n ∸ n) ≡⟨ cong (m +_) (n∸n≡0 n) ⟩ m + 0 ≡⟨ +-identityʳ m ⟩ m ∎ m+n∸m≡n : ∀ m n → m + n ∸ m ≡ n m+n∸m≡n m n = trans (cong (_∸ m) (+-comm m n)) (m+n∸n≡m n m) m+[n∸m]≡n : ∀ {m n} → m ≤ n → m + (n ∸ m) ≡ n m+[n∸m]≡n {m} {n} m≤n = begin-equality m + (n ∸ m) ≡⟨ sym $ +-∸-assoc m m≤n ⟩ (m + n) ∸ m ≡⟨ cong (_∸ m) (+-comm m n) ⟩ (n + m) ∸ m ≡⟨ m+n∸n≡m n m ⟩ n ∎ m∸n+n≡m : ∀ {m n} → n ≤ m → (m ∸ n) + n ≡ m m∸n+n≡m {m} {n} n≤m = begin-equality (m ∸ n) + n ≡⟨ sym (+-∸-comm n n≤m) ⟩ (m + n) ∸ n ≡⟨ m+n∸n≡m m n ⟩ m ∎ m∸[m∸n]≡n : ∀ {m n} → n ≤ m → m ∸ (m ∸ n) ≡ n m∸[m∸n]≡n {m} {_} z≤n = n∸n≡0 m m∸[m∸n]≡n {suc m} {suc n} (s≤s n≤m) = begin-equality suc m ∸ (m ∸ n) ≡⟨ +-∸-assoc 1 (m∸n≤m m n) ⟩ suc (m ∸ (m ∸ n)) ≡⟨ cong suc (m∸[m∸n]≡n n≤m) ⟩ suc n ∎ [m+n]∸[m+o]≡n∸o : ∀ m n o → (m + n) ∸ (m + o) ≡ n ∸ o [m+n]∸[m+o]≡n∸o zero n o = refl [m+n]∸[m+o]≡n∸o (suc m) n o = [m+n]∸[m+o]≡n∸o m n o ------------------------------------------------------------------------ -- Properties of _∸_ and _*_ *-distribʳ-∸ : _*_ DistributesOverʳ _∸_ *-distribʳ-∸ m zero zero = refl *-distribʳ-∸ zero zero (suc o) = sym (0∸n≡0 (o * zero)) *-distribʳ-∸ (suc m) zero (suc o) = refl *-distribʳ-∸ m (suc n) zero = refl *-distribʳ-∸ m (suc n) (suc o) = begin-equality (n ∸ o) * m ≡⟨ *-distribʳ-∸ m n o ⟩ n * m ∸ o * m ≡⟨ sym $ [m+n]∸[m+o]≡n∸o m _ _ ⟩ m + n * m ∸ (m + o * m) ∎ *-distribˡ-∸ : _*_ DistributesOverˡ _∸_ *-distribˡ-∸ = comm+distrʳ⇒distrˡ *-comm *-distribʳ-∸ *-distrib-∸ : _*_ DistributesOver _∸_ *-distrib-∸ = *-distribˡ-∸ , *-distribʳ-∸ even≢odd : ∀ m n → 2 * m ≢ suc (2 * n) even≢odd (suc m) zero eq = contradiction (suc-injective eq) (m+1+n≢0 m) even≢odd (suc m) (suc n) eq = even≢odd m n (suc-injective (begin-equality suc (2 * m) ≡⟨ sym (+-suc m _) ⟩ m + suc (m + 0) ≡⟨ suc-injective eq ⟩ suc n + suc (n + 0) ≡⟨ cong suc (+-suc n _) ⟩ suc (suc (2 * n)) ∎)) ------------------------------------------------------------------------ -- Properties of _∸_ and _⊓_ and _⊔_ m⊓n+n∸m≡n : ∀ m n → (m ⊓ n) + (n ∸ m) ≡ n m⊓n+n∸m≡n zero n = refl m⊓n+n∸m≡n (suc m) zero = refl m⊓n+n∸m≡n (suc m) (suc n) = cong suc $ m⊓n+n∸m≡n m n [m∸n]⊓[n∸m]≡0 : ∀ m n → (m ∸ n) ⊓ (n ∸ m) ≡ 0 [m∸n]⊓[n∸m]≡0 zero zero = refl [m∸n]⊓[n∸m]≡0 zero (suc n) = refl [m∸n]⊓[n∸m]≡0 (suc m) zero = refl [m∸n]⊓[n∸m]≡0 (suc m) (suc n) = [m∸n]⊓[n∸m]≡0 m n ∸-distribˡ-⊓-⊔ : ∀ m n o → m ∸ (n ⊓ o) ≡ (m ∸ n) ⊔ (m ∸ o) ∸-distribˡ-⊓-⊔ m n o = antimono-≤-distrib-⊓ (∸-monoʳ-≤ m) n o ∸-distribʳ-⊓ : _∸_ DistributesOverʳ _⊓_ ∸-distribʳ-⊓ m n o = mono-≤-distrib-⊓ (∸-monoˡ-≤ m) n o ∸-distribˡ-⊔-⊓ : ∀ m n o → m ∸ (n ⊔ o) ≡ (m ∸ n) ⊓ (m ∸ o) ∸-distribˡ-⊔-⊓ m n o = antimono-≤-distrib-⊔ (∸-monoʳ-≤ m) n o ∸-distribʳ-⊔ : _∸_ DistributesOverʳ _⊔_ ∸-distribʳ-⊔ m n o = mono-≤-distrib-⊔ (∸-monoˡ-≤ m) n o ------------------------------------------------------------------------ -- Properties of pred ------------------------------------------------------------------------ pred-mono : pred Preserves _≤_ ⟶ _≤_ pred-mono m≤n = ∸-mono m≤n (≤-refl {1}) pred[n]≤n : ∀ {n} → pred n ≤ n pred[n]≤n {zero} = z≤n pred[n]≤n {suc n} = n≤1+n n ≤pred⇒≤ : ∀ {m n} → m ≤ pred n → m ≤ n ≤pred⇒≤ {m} {zero} le = le ≤pred⇒≤ {m} {suc n} le = ≤-step le ≤⇒pred≤ : ∀ {m n} → m ≤ n → pred m ≤ n ≤⇒pred≤ {zero} le = le ≤⇒pred≤ {suc m} le = ≤-trans (n≤1+n m) le <⇒≤pred : ∀ {m n} → m < n → m ≤ pred n <⇒≤pred (s≤s le) = le suc[pred[n]]≡n : ∀ {n} → n ≢ 0 → suc (pred n) ≡ n suc[pred[n]]≡n {zero} n≢0 = contradiction refl n≢0 suc[pred[n]]≡n {suc n} n≢0 = refl ------------------------------------------------------------------------ -- Properties of ∣_-_∣ ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- Basic m≡n⇒∣m-n∣≡0 : ∀ {m n} → m ≡ n → ∣ m - n ∣ ≡ 0 m≡n⇒∣m-n∣≡0 {zero} refl = refl m≡n⇒∣m-n∣≡0 {suc m} refl = m≡n⇒∣m-n∣≡0 {m} refl ∣m-n∣≡0⇒m≡n : ∀ {m n} → ∣ m - n ∣ ≡ 0 → m ≡ n ∣m-n∣≡0⇒m≡n {zero} {zero} eq = refl ∣m-n∣≡0⇒m≡n {suc m} {suc n} eq = cong suc (∣m-n∣≡0⇒m≡n eq) m≤n⇒∣n-m∣≡n∸m : ∀ {m n} → m ≤ n → ∣ n - m ∣ ≡ n ∸ m m≤n⇒∣n-m∣≡n∸m {_} {zero} z≤n = refl m≤n⇒∣n-m∣≡n∸m {_} {suc m} z≤n = refl m≤n⇒∣n-m∣≡n∸m {_} {_} (s≤s m≤n) = m≤n⇒∣n-m∣≡n∸m m≤n ∣m-n∣≡m∸n⇒n≤m : ∀ {m n} → ∣ m - n ∣ ≡ m ∸ n → n ≤ m ∣m-n∣≡m∸n⇒n≤m {zero} {zero} eq = z≤n ∣m-n∣≡m∸n⇒n≤m {suc m} {zero} eq = z≤n ∣m-n∣≡m∸n⇒n≤m {suc m} {suc n} eq = s≤s (∣m-n∣≡m∸n⇒n≤m eq) ∣n-n∣≡0 : ∀ n → ∣ n - n ∣ ≡ 0 ∣n-n∣≡0 n = m≡n⇒∣m-n∣≡0 {n} refl ∣m-m+n∣≡n : ∀ m n → ∣ m - m + n ∣ ≡ n ∣m-m+n∣≡n zero n = refl ∣m-m+n∣≡n (suc m) n = ∣m-m+n∣≡n m n ∣m+n-m+o∣≡∣n-o∣ : ∀ m n o → ∣ m + n - m + o ∣ ≡ ∣ n - o ∣ ∣m+n-m+o∣≡∣n-o∣ zero n o = refl ∣m+n-m+o∣≡∣n-o∣ (suc m) n o = ∣m+n-m+o∣≡∣n-o∣ m n o m∸n≤∣m-n∣ : ∀ m n → m ∸ n ≤ ∣ m - n ∣ m∸n≤∣m-n∣ m n with ≤-total m n ... | inj₁ m≤n = subst (_≤ ∣ m - n ∣) (sym (m≤n⇒m∸n≡0 m≤n)) z≤n ... | inj₂ n≤m = subst (m ∸ n ≤_) (sym (m≤n⇒∣n-m∣≡n∸m n≤m)) ≤-refl ∣m-n∣≤m⊔n : ∀ m n → ∣ m - n ∣ ≤ m ⊔ n ∣m-n∣≤m⊔n zero m = ≤-refl ∣m-n∣≤m⊔n (suc m) zero = ≤-refl ∣m-n∣≤m⊔n (suc m) (suc n) = ≤-step (∣m-n∣≤m⊔n m n) ∣-∣-identityˡ : LeftIdentity 0 ∣_-_∣ ∣-∣-identityˡ x = refl ∣-∣-identityʳ : RightIdentity 0 ∣_-_∣ ∣-∣-identityʳ zero = refl ∣-∣-identityʳ (suc x) = refl ∣-∣-identity : Identity 0 ∣_-_∣ ∣-∣-identity = ∣-∣-identityˡ , ∣-∣-identityʳ ∣-∣-comm : Commutative ∣_-_∣ ∣-∣-comm zero zero = refl ∣-∣-comm zero (suc n) = refl ∣-∣-comm (suc m) zero = refl ∣-∣-comm (suc m) (suc n) = ∣-∣-comm m n ∣m-n∣≡[m∸n]∨[n∸m] : ∀ m n → (∣ m - n ∣ ≡ m ∸ n) ⊎ (∣ m - n ∣ ≡ n ∸ m) ∣m-n∣≡[m∸n]∨[n∸m] m n with ≤-total m n ... | inj₂ n≤m = inj₁ $ m≤n⇒∣n-m∣≡n∸m n≤m ... | inj₁ m≤n = inj₂ $ begin-equality ∣ m - n ∣ ≡⟨ ∣-∣-comm m n ⟩ ∣ n - m ∣ ≡⟨ m≤n⇒∣n-m∣≡n∸m m≤n ⟩ n ∸ m ∎ private *-distribˡ-∣-∣-aux : ∀ a m n → m ≤ n → a * ∣ n - m ∣ ≡ ∣ a * n - a * m ∣ *-distribˡ-∣-∣-aux a m n m≤n = begin-equality a * ∣ n - m ∣ ≡⟨ cong (a *_) (m≤n⇒∣n-m∣≡n∸m m≤n) ⟩ a * (n ∸ m) ≡⟨ *-distribˡ-∸ a n m ⟩ a * n ∸ a * m ≡⟨ sym $′ m≤n⇒∣n-m∣≡n∸m (*-monoʳ-≤ a m≤n) ⟩ ∣ a * n - a * m ∣ ∎ *-distribˡ-∣-∣ : _*_ DistributesOverˡ ∣_-_∣ *-distribˡ-∣-∣ a m n with ≤-total m n ... | inj₂ n≤m = *-distribˡ-∣-∣-aux a n m n≤m ... | inj₁ m≤n = begin-equality a * ∣ m - n ∣ ≡⟨ cong (a *_) (∣-∣-comm m n) ⟩ a * ∣ n - m ∣ ≡⟨ *-distribˡ-∣-∣-aux a m n m≤n ⟩ ∣ a * n - a * m ∣ ≡⟨ ∣-∣-comm (a * n) (a * m) ⟩ ∣ a * m - a * n ∣ ∎ *-distribʳ-∣-∣ : _*_ DistributesOverʳ ∣_-_∣ *-distribʳ-∣-∣ = comm+distrˡ⇒distrʳ *-comm *-distribˡ-∣-∣ *-distrib-∣-∣ : _*_ DistributesOver ∣_-_∣ *-distrib-∣-∣ = *-distribˡ-∣-∣ , *-distribʳ-∣-∣ m≤n+∣n-m∣ : ∀ m n → m ≤ n + ∣ n - m ∣ m≤n+∣n-m∣ zero n = z≤n m≤n+∣n-m∣ (suc m) zero = ≤-refl m≤n+∣n-m∣ (suc m) (suc n) = s≤s (m≤n+∣n-m∣ m n) m≤n+∣m-n∣ : ∀ m n → m ≤ n + ∣ m - n ∣ m≤n+∣m-n∣ m n = subst (m ≤_) (cong (n +_) (∣-∣-comm n m)) (m≤n+∣n-m∣ m n) m≤∣m-n∣+n : ∀ m n → m ≤ ∣ m - n ∣ + n m≤∣m-n∣+n m n = subst (m ≤_) (+-comm n _) (m≤n+∣m-n∣ m n) ∣-∣-triangle : TriangleInequality ∣_-_∣ ∣-∣-triangle zero y z = m≤n+∣n-m∣ z y ∣-∣-triangle x zero z = begin ∣ x - z ∣ ≤⟨ ∣m-n∣≤m⊔n x z ⟩ x ⊔ z ≤⟨ m⊔n≤m+n x z ⟩ x + z ≡⟨ cong₂ _+_ (sym (∣-∣-identityʳ x)) refl ⟩ ∣ x - 0 ∣ + z ∎ where open ≤-Reasoning ∣-∣-triangle x y zero = begin ∣ x - 0 ∣ ≡⟨ ∣-∣-identityʳ x ⟩ x ≤⟨ m≤∣m-n∣+n x y ⟩ ∣ x - y ∣ + y ≡⟨ cong₂ _+_ refl (sym (∣-∣-identityʳ y)) ⟩ ∣ x - y ∣ + ∣ y - 0 ∣ ∎ where open ≤-Reasoning ∣-∣-triangle (suc x) (suc y) (suc z) = ∣-∣-triangle x y z ------------------------------------------------------------------------ -- Metric structures ∣-∣-isProtoMetric : IsProtoMetric _≡_ ∣_-_∣ ∣-∣-isProtoMetric = record { isPartialOrder = ≤-isPartialOrder ; ≈-isEquivalence = isEquivalence ; cong = cong₂ ∣_-_∣ ; nonNegative = z≤n } ∣-∣-isPreMetric : IsPreMetric _≡_ ∣_-_∣ ∣-∣-isPreMetric = record { isProtoMetric = ∣-∣-isProtoMetric ; ≈⇒0 = m≡n⇒∣m-n∣≡0 } ∣-∣-isQuasiSemiMetric : IsQuasiSemiMetric _≡_ ∣_-_∣ ∣-∣-isQuasiSemiMetric = record { isPreMetric = ∣-∣-isPreMetric ; 0⇒≈ = ∣m-n∣≡0⇒m≡n } ∣-∣-isSemiMetric : IsSemiMetric _≡_ ∣_-_∣ ∣-∣-isSemiMetric = record { isQuasiSemiMetric = ∣-∣-isQuasiSemiMetric ; sym = ∣-∣-comm } ∣-∣-isMetric : IsMetric _≡_ ∣_-_∣ ∣-∣-isMetric = record { isSemiMetric = ∣-∣-isSemiMetric ; triangle = ∣-∣-triangle } ------------------------------------------------------------------------ -- Metric bundles ∣-∣-quasiSemiMetric : QuasiSemiMetric 0ℓ 0ℓ ∣-∣-quasiSemiMetric = record { isQuasiSemiMetric = ∣-∣-isQuasiSemiMetric } ∣-∣-semiMetric : SemiMetric 0ℓ 0ℓ ∣-∣-semiMetric = record { isSemiMetric = ∣-∣-isSemiMetric } ∣-∣-preMetric : PreMetric 0ℓ 0ℓ ∣-∣-preMetric = record { isPreMetric = ∣-∣-isPreMetric } ∣-∣-metric : Metric 0ℓ 0ℓ ∣-∣-metric = record { isMetric = ∣-∣-isMetric } ------------------------------------------------------------------------ -- Properties of ⌊_/2⌋ and ⌈_/2⌉ ------------------------------------------------------------------------ ⌊n/2⌋-mono : ⌊_/2⌋ Preserves _≤_ ⟶ _≤_ ⌊n/2⌋-mono z≤n = z≤n ⌊n/2⌋-mono (s≤s z≤n) = z≤n ⌊n/2⌋-mono (s≤s (s≤s m≤n)) = s≤s (⌊n/2⌋-mono m≤n) ⌈n/2⌉-mono : ⌈_/2⌉ Preserves _≤_ ⟶ _≤_ ⌈n/2⌉-mono m≤n = ⌊n/2⌋-mono (s≤s m≤n) ⌊n/2⌋≤⌈n/2⌉ : ∀ n → ⌊ n /2⌋ ≤ ⌈ n /2⌉ ⌊n/2⌋≤⌈n/2⌉ zero = z≤n ⌊n/2⌋≤⌈n/2⌉ (suc zero) = z≤n ⌊n/2⌋≤⌈n/2⌉ (suc (suc n)) = s≤s (⌊n/2⌋≤⌈n/2⌉ n) ⌊n/2⌋+⌈n/2⌉≡n : ∀ n → ⌊ n /2⌋ + ⌈ n /2⌉ ≡ n ⌊n/2⌋+⌈n/2⌉≡n zero = refl ⌊n/2⌋+⌈n/2⌉≡n (suc n) = begin-equality ⌊ suc n /2⌋ + suc ⌊ n /2⌋ ≡⟨ +-comm ⌊ suc n /2⌋ (suc ⌊ n /2⌋) ⟩ suc ⌊ n /2⌋ + ⌊ suc n /2⌋ ≡⟨⟩ suc (⌊ n /2⌋ + ⌊ suc n /2⌋) ≡⟨ cong suc (⌊n/2⌋+⌈n/2⌉≡n n) ⟩ suc n ∎ ⌊n/2⌋≤n : ∀ n → ⌊ n /2⌋ ≤ n ⌊n/2⌋≤n zero = z≤n ⌊n/2⌋≤n (suc zero) = z≤n ⌊n/2⌋≤n (suc (suc n)) = s≤s (≤-step (⌊n/2⌋≤n n)) ⌊n/2⌋′?_ _≤′?_ : Decidable _≤′_ m ≤′? n = map′ ≤⇒≤′ ≤′⇒≤ (m ≤? n) _<′?_ : Decidable _<′_ m <′? n = suc m ≤′? n _≥′?_ : Decidable _≥′_ _≥′?_ = flip _≤′?_ _>′?_ : Decidable _>′_ _>′?_ = flip _<′?_ m≤′m+n : ∀ m n → m ≤′ m + n m≤′m+n m n = ≤⇒≤′ (m≤m+n m n) n≤′m+n : ∀ m n → n ≤′ m + n n≤′m+n zero n = ≤′-refl n≤′m+n (suc m) n = ≤′-step (n≤′m+n m n) ⌈n/2⌉≤′n : ∀ n → ⌈ n /2⌉ ≤′ n ⌈n/2⌉≤′n zero = ≤′-refl ⌈n/2⌉≤′n (suc zero) = ≤′-refl ⌈n/2⌉≤′n (suc (suc n)) = s≤′s (≤′-step (⌈n/2⌉≤′n n)) ⌊n/2⌋≤′n : ∀ n → ⌊ n /2⌋ ≤′ n ⌊n/2⌋≤′n zero = ≤′-refl ⌊n/2⌋≤′n (suc n) = ≤′-step (⌈n/2⌉≤′n n) ------------------------------------------------------------------------ -- Properties of _≤″_ and _<″_ ------------------------------------------------------------------------ m<ᵇn⇒1+m+[n-1+m]≡n : ∀ m n → T (m <ᵇ n) → suc m + (n ∸ suc m) ≡ n m<ᵇn⇒1+m+[n-1+m]≡n m n lt = m+[n∸m]≡n (<ᵇ⇒< m n lt) m<ᵇ1+m+n : ∀ m {n} → T (m <ᵇ suc (m + n)) m<ᵇ1+m+n m = <⇒<ᵇ (m≤m+n (suc m) _) <ᵇ⇒<″ : ∀ {m n} → T (m <ᵇ n) → m <″ n <ᵇ⇒<″ {m} {n} leq = less-than-or-equal (m+[n∸m]≡n (<ᵇ⇒< m n leq)) <″⇒<ᵇ : ∀ {m n} → m <″ n → T (m <ᵇ n) <″⇒<ᵇ {m} (less-than-or-equal refl) = <⇒<ᵇ (m≤m+n (suc m) _) -- equivalence to _≤_ ≤″⇒≤ : _≤″_ ⇒ _≤_ ≤″⇒≤ {zero} (less-than-or-equal refl) = z≤n ≤″⇒≤ {suc m} (less-than-or-equal refl) = s≤s (≤″⇒≤ (less-than-or-equal refl)) ≤⇒≤″ : _≤_ ⇒ _≤″_ ≤⇒≤″ = less-than-or-equal ∘ m+[n∸m]≡n -- NB: we use the builtin function `_<ᵇ_ : (m n : ℕ) → Bool` here so -- that the function quickly decides whether to return `yes` or `no`. -- It still takes a linear amount of time to generate the proof if it -- is inspected. We expect the main benefit to be visible for compiled -- code: the backend erases proofs. infix 4 _<″?_ _≤″?_ _≥″?_ _>″?_ _<″?_ : Decidable _<″_ m <″? n = map′ <ᵇ⇒<″ <″⇒<ᵇ (T? (m <ᵇ n)) _≤″?_ : Decidable _≤″_ zero ≤″? n = yes (less-than-or-equal refl) suc m ≤″? n = m <″? n _≥″?_ : Decidable _≥″_ _≥″?_ = flip _≤″?_ _>″?_ : Decidable _>″_ _>″?_ = flip _<″?_ ≤″-irrelevant : Irrelevant _≤″_ ≤″-irrelevant {m} (less-than-or-equal eq₁) (less-than-or-equal eq₂) with +-cancelˡ-≡ m (trans eq₁ (sym eq₂)) ... | refl = cong less-than-or-equal (≡-irrelevant eq₁ eq₂) <″-irrelevant : Irrelevant _<″_ <″-irrelevant = ≤″-irrelevant >″-irrelevant : Irrelevant _>″_ >″-irrelevant = ≤″-irrelevant ≥″-irrelevant : Irrelevant _≥″_ ≥″-irrelevant = ≤″-irrelevant ------------------------------------------------------------------------ -- Properties of _≤‴_ ------------------------------------------------------------------------ ≤‴⇒≤″ : ∀{m n} → m ≤‴ n → m ≤″ n ≤‴⇒≤″ {m = m} ≤‴-refl = less-than-or-equal {k = 0} (+-identityʳ m) ≤‴⇒≤″ {m = m} (≤‴-step x) = less-than-or-equal (trans (+-suc m _) (_≤″_.proof ind)) where ind = ≤‴⇒≤″ x m≤‴m+k : ∀{m n k} → m + k ≡ n → m ≤‴ n m≤‴m+k {m} {k = zero} refl = subst (λ z → m ≤‴ z) (sym (+-identityʳ m)) (≤‴-refl {m}) m≤‴m+k {m} {k = suc k} proof = ≤‴-step (m≤‴m+k {k = k} (trans (sym (+-suc m _)) proof)) ≤″⇒≤‴ : ∀{m n} → m ≤″ n → m ≤‴ n ≤″⇒≤‴ (less-than-or-equal {k} proof) = m≤‴m+k proof 0≤‴n : ∀{n} → 0 ≤‴ n 0≤‴n {n} = m≤‴m+k refl <ᵇ⇒<‴ : ∀ {m n} → T (m <ᵇ n) → m <‴ n <ᵇ⇒<‴ {m} {n} leq = ≤″⇒≤‴ (<ᵇ⇒<″ leq) <‴⇒<ᵇ : ∀ {m n} → m <‴ n → T (m <ᵇ n) <‴⇒<ᵇ leq = <″⇒<ᵇ (≤‴⇒≤″ leq) infix 4 _<‴?_ _≤‴?_ _≥‴?_ _>‴?_ _<‴?_ : Decidable _<‴_ m <‴? n = map′ <ᵇ⇒<‴ <‴⇒<ᵇ (T? (m <ᵇ n)) _≤‴?_ : Decidable _≤‴_ zero ≤‴? n = yes 0≤‴n suc m ≤‴? n = m <‴? n _≥‴?_ : Decidable _≥‴_ _≥‴?_ = flip _≤‴?_ _>‴?_ : Decidable _>‴_ _>‴?_ = flip _<‴?_ ≤⇒≤‴ : _≤_ ⇒ _≤‴_ ≤⇒≤‴ = ≤″⇒≤‴ ∘ ≤⇒≤″ ≤‴⇒≤ : _≤‴_ ⇒ _≤_ ≤‴⇒≤ = ≤″⇒≤ ∘ ≤‴⇒≤″ ------------------------------------------------------------------------ -- Other properties ------------------------------------------------------------------------ -- If there is an injection from a type to ℕ, then the type has -- decidable equality. eq? : ∀ {a} {A : Set a} → A ↣ ℕ → Decidable {A = A} _≡_ eq? inj = via-injection inj _≟_ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.14 _*-mono_ = *-mono-≤ {-# WARNING_ON_USAGE _*-mono_ "Warning: _*-mono_ was deprecated in v0.14. Please use *-mono-≤ instead." #-} _+-mono_ = +-mono-≤ {-# WARNING_ON_USAGE _+-mono_ "Warning: _+-mono_ was deprecated in v0.14. Please use +-mono-≤ instead." #-} +-right-identity = +-identityʳ {-# WARNING_ON_USAGE +-right-identity "Warning: +-right-identity was deprecated in v0.14. Please use +-identityʳ instead." #-} *-right-zero = *-zeroʳ {-# WARNING_ON_USAGE *-right-zero "Warning: *-right-zero was deprecated in v0.14. Please use *-zeroʳ instead." #-} distribʳ-*-+ = *-distribʳ-+ {-# WARNING_ON_USAGE distribʳ-*-+ "Warning: distribʳ-*-+ was deprecated in v0.14. Please use *-distribʳ-+ instead." #-} *-distrib-∸ʳ = *-distribʳ-∸ {-# WARNING_ON_USAGE *-distrib-∸ʳ "Warning: *-distrib-∸ʳ was deprecated in v0.14. Please use *-distribʳ-∸ instead." #-} cancel-+-left = +-cancelˡ-≡ {-# WARNING_ON_USAGE cancel-+-left "Warning: cancel-+-left was deprecated in v0.14. Please use +-cancelˡ-≡ instead." #-} cancel-+-left-≤ = +-cancelˡ-≤ {-# WARNING_ON_USAGE cancel-+-left-≤ "Warning: cancel-+-left-≤ was deprecated in v0.14. Please use +-cancelˡ-≤ instead." #-} cancel-*-right = *-cancelʳ-≡ {-# WARNING_ON_USAGE cancel-*-right "Warning: cancel-*-right was deprecated in v0.14. Please use *-cancelʳ-≡ instead." #-} cancel-*-right-≤ = *-cancelʳ-≤ {-# WARNING_ON_USAGE cancel-*-right-≤ "Warning: cancel-*-right-≤ was deprecated in v0.14. Please use *-cancelʳ-≤ instead." #-} strictTotalOrder = <-strictTotalOrder {-# WARNING_ON_USAGE strictTotalOrder "Warning: strictTotalOrder was deprecated in v0.14. Please use <-strictTotalOrder instead." #-} isCommutativeSemiring = +-*-isCommutativeSemiring {-# WARNING_ON_USAGE isCommutativeSemiring "Warning: isCommutativeSemiring was deprecated in v0.14. Please use *-+-isCommutativeSemiring instead." #-} commutativeSemiring = +-*-commutativeSemiring {-# WARNING_ON_USAGE commutativeSemiring "Warning: commutativeSemiring was deprecated in v0.14. Please use *-+-commutativeSemiring instead." #-} isDistributiveLattice = ⊓-⊔-isDistributiveLattice {-# WARNING_ON_USAGE isDistributiveLattice "Warning: isDistributiveLattice was deprecated in v0.14. Please use ⊓-⊔-isDistributiveLattice instead." #-} distributiveLattice = ⊓-⊔-distributiveLattice {-# WARNING_ON_USAGE distributiveLattice "Warning: distributiveLattice was deprecated in v0.14. Please use ⊓-⊔-distributiveLattice instead." #-} ⊔-⊓-0-isSemiringWithoutOne = ⊔-⊓-isSemiringWithoutOne {-# WARNING_ON_USAGE ⊔-⊓-0-isSemiringWithoutOne "Warning: ⊔-⊓-0-isSemiringWithoutOne was deprecated in v0.14. Please use ⊔-⊓-isSemiringWithoutOne instead." #-} ⊔-⊓-0-isCommutativeSemiringWithoutOne = ⊔-⊓-isCommutativeSemiringWithoutOne {-# WARNING_ON_USAGE ⊔-⊓-0-isCommutativeSemiringWithoutOne "Warning: ⊔-⊓-0-isCommutativeSemiringWithoutOne was deprecated in v0.14. Please use ⊔-⊓-isCommutativeSemiringWithoutOne instead." #-} ⊔-⊓-0-commutativeSemiringWithoutOne = ⊔-⊓-commutativeSemiringWithoutOne {-# WARNING_ON_USAGE ⊔-⊓-0-commutativeSemiringWithoutOne "Warning: ⊔-⊓-0-commutativeSemiringWithoutOne was deprecated in v0.14. Please use ⊔-⊓-commutativeSemiringWithoutOne instead." #-} -- Version 0.15 ¬i+1+j≤i = m+1+n≰m {-# WARNING_ON_USAGE ¬i+1+j≤i "Warning: ¬i+1+j≤i was deprecated in v0.15. Please use m+1+n≰m instead." #-} ≤-steps = ≤-stepsˡ {-# WARNING_ON_USAGE ≤-steps "Warning: ≤-steps was deprecated in v0.15. Please use ≤-stepsˡ instead." #-} -- Version 0.17 i∸k∸j+j∸k≡i+j∸k : ∀ i j k → i ∸ (k ∸ j) + (j ∸ k) ≡ i + j ∸ k i∸k∸j+j∸k≡i+j∸k zero j k = cong (_+ (j ∸ k)) (0∸n≡0 (k ∸ j)) i∸k∸j+j∸k≡i+j∸k (suc i) j zero = cong (λ x → suc i ∸ x + j) (0∸n≡0 j) i∸k∸j+j∸k≡i+j∸k (suc i) zero (suc k) = begin-equality i ∸ k + 0 ≡⟨ +-identityʳ _ ⟩ i ∸ k ≡⟨ cong (_∸ k) (sym (+-identityʳ _)) ⟩ i + 0 ∸ k ∎ i∸k∸j+j∸k≡i+j∸k (suc i) (suc j) (suc k) = begin-equality suc i ∸ (k ∸ j) + (j ∸ k) ≡⟨ i∸k∸j+j∸k≡i+j∸k (suc i) j k ⟩ suc i + j ∸ k ≡⟨ cong (_∸ k) (sym (+-suc i j)) ⟩ i + suc j ∸ k ∎ {-# WARNING_ON_USAGE i∸k∸j+j∸k≡i+j∸k "Warning: i∸k∸j+j∸k≡i+j∸k was deprecated in v0.17." #-} im≡jm+n⇒[i∸j]m≡n : ∀ i j m n → i * m ≡ j * m + n → (i ∸ j) * m ≡ n im≡jm+n⇒[i∸j]m≡n i j m n eq = begin-equality (i ∸ j) * m ≡⟨ *-distribʳ-∸ m i j ⟩ (i * m) ∸ (j * m) ≡⟨ cong (_∸ j * m) eq ⟩ (j * m + n) ∸ (j * m) ≡⟨ cong (_∸ j * m) (+-comm (j * m) n) ⟩ (n + j * m) ∸ (j * m) ≡⟨ m+n∸n≡m n (j * m) ⟩ n ∎ {-# WARNING_ON_USAGE im≡jm+n⇒[i∸j]m≡n "Warning: im≡jm+n⇒[i∸j]m≡n was deprecated in v0.17." #-} ≤+≢⇒< = ≤∧≢⇒< {-# WARNING_ON_USAGE ≤+≢⇒< "Warning: ≤+≢⇒< was deprecated in v0.17. Please use ≤∧≢⇒< instead." #-} -- Version 1.0 ≤-irrelevance = ≤-irrelevant {-# WARNING_ON_USAGE ≤-irrelevance "Warning: ≤-irrelevance was deprecated in v1.0. Please use ≤-irrelevant instead." #-} <-irrelevance = <-irrelevant {-# WARNING_ON_USAGE <-irrelevance "Warning: <-irrelevance was deprecated in v1.0. Please use <-irrelevant instead." #-} -- Version 1.1 i+1+j≢i = m+1+n≢m {-# WARNING_ON_USAGE i+1+j≢i "Warning: i+1+j≢i was deprecated in v1.1. Please use m+1+n≢m instead." #-} i+j≡0⇒i≡0 = m+n≡0⇒m≡0 {-# WARNING_ON_USAGE i+j≡0⇒i≡0 "Warning: i+j≡0⇒i≡0 was deprecated in v1.1. Please use m+n≡0⇒m≡0 instead." #-} i+j≡0⇒j≡0 = m+n≡0⇒n≡0 {-# WARNING_ON_USAGE i+j≡0⇒j≡0 "Warning: i+j≡0⇒j≡0 was deprecated in v1.1. Please use m+n≡0⇒n≡0 instead." #-} i+1+j≰i = m+1+n≰m {-# WARNING_ON_USAGE i+1+j≰i "Warning: i+1+j≰i was deprecated in v1.1. Please use m+1+n≰m instead." #-} i*j≡0⇒i≡0∨j≡0 = m*n≡0⇒m≡0∨n≡0 {-# WARNING_ON_USAGE i*j≡0⇒i≡0∨j≡0 "Warning: i*j≡0⇒i≡0∨j≡0 was deprecated in v1.1. Please use m*n≡0⇒m≡0∨n≡0 instead." #-} i*j≡1⇒i≡1 = m*n≡1⇒m≡1 {-# WARNING_ON_USAGE i*j≡1⇒i≡1 "Warning: i*j≡1⇒i≡1 was deprecated in v1.1. Please use m*n≡1⇒m≡1 instead." #-} i*j≡1⇒j≡1 = m*n≡1⇒n≡1 {-# WARNING_ON_USAGE i*j≡1⇒j≡1 "Warning: i*j≡1⇒j≡1 was deprecated in v1.1. Please use m*n≡1⇒n≡1 instead." #-} i^j≡0⇒i≡0 = m^n≡0⇒m≡0 {-# WARNING_ON_USAGE i^j≡0⇒i≡0 "Warning: i^j≡0⇒i≡0 was deprecated in v1.1. Please use m^n≡0⇒m≡0 instead." #-} i^j≡1⇒j≡0∨i≡1 = m^n≡1⇒n≡0∨m≡1 {-# WARNING_ON_USAGE i^j≡1⇒j≡0∨i≡1 "Warning: i^j≡1⇒j≡0∨i≡1 was deprecated in v1.1. Please use m^n≡1⇒n≡0∨m≡1 instead." #-} [i+j]∸[i+k]≡j∸k = [m+n]∸[m+o]≡n∸o {-# WARNING_ON_USAGE [i+j]∸[i+k]≡j∸k "Warning: [i+j]∸[i+k]≡j∸k was deprecated in v1.1. Please use [m+n]∸[m+o]≡n∸o instead." #-} m≢0⇒suc[pred[m]]≡m = suc[pred[n]]≡n {-# WARNING_ON_USAGE m≢0⇒suc[pred[m]]≡m "Warning: m≢0⇒suc[pred[m]]≡m was deprecated in v1.1. Please use suc[pred[n]]≡n instead." #-} n≡m⇒∣n-m∣≡0 = m≡n⇒∣m-n∣≡0 {-# WARNING_ON_USAGE n≡m⇒∣n-m∣≡0 "Warning: n≡m⇒∣n-m∣≡0 was deprecated in v1.1. Please use m≡n⇒∣m-n∣≡0 instead." #-} ∣n-m∣≡0⇒n≡m = ∣m-n∣≡0⇒m≡n {-# WARNING_ON_USAGE ∣n-m∣≡0⇒n≡m "Warning: ∣n-m∣≡0⇒n≡m was deprecated in v1.1. Please use ∣m-n∣≡0⇒m≡n instead." #-} ∣n-m∣≡n∸m⇒m≤n = ∣m-n∣≡m∸n⇒n≤m {-# WARNING_ON_USAGE ∣n-m∣≡n∸m⇒m≤n "Warning: ∣n-m∣≡n∸m⇒m≤n was deprecated in v1.1. Please use ∣m-n∣≡m∸n⇒n≤m instead." #-} ∣n-n+m∣≡m = ∣m-m+n∣≡n {-# WARNING_ON_USAGE ∣n-n+m∣≡m "Warning: ∣n-n+m∣≡m was deprecated in v1.1. Please use ∣m-m+n∣≡n instead." #-} ∣n+m-n+o∣≡∣m-o| = ∣m+n-m+o∣≡∣n-o∣ {-# WARNING_ON_USAGE ∣n+m-n+o∣≡∣m-o| "Warning: ∣n+m-n+o∣≡∣m-o| was deprecated in v1.1. Please use ∣m+n-m+o∣≡∣n-o∣ instead." #-} ∣m+n-m+o∣≡∣n-o| = ∣m+n-m+o∣≡∣n-o∣ {-# WARNING_ON_USAGE ∣m+n-m+o∣≡∣n-o| "Warning: ∣m+n-m+o∣≡∣n-o| was deprecated in v1.6. Please use ∣m+n-m+o∣≡∣n-o∣ instead. Note the final is a \\| rather than a |" #-} n∸m≤∣n-m∣ = m∸n≤∣m-n∣ {-# WARNING_ON_USAGE n∸m≤∣n-m∣ "Warning: n∸m≤∣n-m∣ was deprecated in v1.1. Please use m∸n≤∣m-n∣ instead." #-} ∣n-m∣≤n⊔m = ∣m-n∣≤m⊔n {-# WARNING_ON_USAGE ∣n-m∣≤n⊔m "Warning: ∣n-m∣≤n⊔m was deprecated in v1.1. Please use ∣m-n∣≤m⊔n instead." #-} n≤m+n : ∀ m n → n ≤ m + n n≤m+n m n = subst (n ≤_) (+-comm n m) (m≤m+n n m) {-# WARNING_ON_USAGE n≤m+n "Warning: n≤m+n was deprecated in v1.1. Please use m≤n+m instead (note, you will need to switch the argument order)." #-} n≤m+n∸m : ∀ m n → n ≤ m + (n ∸ m) n≤m+n∸m m zero = z≤n n≤m+n∸m zero (suc n) = ≤-refl n≤m+n∸m (suc m) (suc n) = s≤s (n≤m+n∸m m n) {-# WARNING_ON_USAGE n≤m+n∸m "Warning: n≤m+n∸m was deprecated in v1.1. Please use m≤n+m∸n instead (note, you will need to switch the argument order)." #-} ∣n-m∣≡[n∸m]∨[m∸n] : ∀ m n → (∣ n - m ∣ ≡ n ∸ m) ⊎ (∣ n - m ∣ ≡ m ∸ n) ∣n-m∣≡[n∸m]∨[m∸n] m n with ≤-total m n ... | inj₁ m≤n = inj₁ $ m≤n⇒∣n-m∣≡n∸m m≤n ... | inj₂ n≤m = inj₂ $ begin-equality ∣ n - m ∣ ≡⟨ ∣-∣-comm n m ⟩ ∣ m - n ∣ ≡⟨ m≤n⇒∣n-m∣≡n∸m n≤m ⟩ m ∸ n ∎ {-# WARNING_ON_USAGE ∣n-m∣≡[n∸m]∨[m∸n] "Warning: ∣n-m∣≡[n∸m]∨[m∸n] was deprecated in v1.1. Please use ∣m-n∣≡[m∸n]∨[n∸m] instead (note, you will need to switch the argument order)." #-} -- Version 1.2 +-*-suc = *-suc {-# WARNING_ON_USAGE +-*-suc "Warning: +-*-suc was deprecated in v1.2. Please use *-suc instead." #-} n∸m≤n : ∀ m n → n ∸ m ≤ n n∸m≤n m n = m∸n≤m n m {-# WARNING_ON_USAGE n∸m≤n "Warning: n∸m≤n was deprecated in v1.2. Please use m∸n≤m instead (note, you will need to switch the argument order)." #-} -- Version 1.3 ∀[m≤n⇒m≢o]⇒o) open import Function.Base using (id) module Data.Nat.PseudoRandom.LCG.Unsafe where ------------------------------------------------------------------------ -- An infinite stream of random numbers stream : Generator → ℕ → Stream ℕ _ stream gen = unfold < step gen , id > agda-stdlib-1.7.3/src/Data/Nat/Reflection.agda000066400000000000000000000015001451211343400207610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Reflection utilities for ℕ ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Reflection where open import Data.Nat.Base as ℕ open import Data.Fin.Base as Fin open import Data.List.Base using ([]) open import Reflection.Term open import Reflection.Argument ------------------------------------------------------------------------ -- Term toTerm : ℕ → Term toTerm zero = con (quote ℕ.zero) [] toTerm (suc i) = con (quote ℕ.suc) (toTerm i ⟨∷⟩ []) toFinTerm : ℕ → Term toFinTerm zero = con (quote Fin.zero) (1 ⋯⟅∷⟆ []) toFinTerm (suc i) = con (quote Fin.suc) (1 ⋯⟅∷⟆ toFinTerm i ⟨∷⟩ []) agda-stdlib-1.7.3/src/Data/Nat/Show.agda000066400000000000000000000056151451211343400176220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Showing natural numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Show where open import Data.Bool.Base using (_∧_) open import Data.Char.Base as Char using (Char) open import Data.Digit using (showDigit; toDigits; toNatDigits) open import Data.List.Base as List using (List; []; _∷_) open import Data.List.Categorical using (module TraversableA) open import Data.Maybe.Base as Maybe using (Maybe; nothing; _<∣>_; when) import Data.Maybe.Categorical as Maybe open import Data.Nat open import Data.Product using (proj₁) open import Data.String as String using (String) open import Function.Base open import Relation.Nullary.Decidable using (True) ------------------------------------------------------------------------ -- Read readMaybe : ∀ base {base≤16 : True (base ≤? 16)} → String → Maybe ℕ readMaybe _ "" = nothing readMaybe base = Maybe.map convert ∘′ TraversableA.mapA Maybe.applicative readDigit ∘′ String.toList where convert : List ℕ → ℕ convert = List.foldl (λ acc d → base * acc + d) 0 char0 = Char.toℕ '0' char9 = Char.toℕ '9' chara = Char.toℕ 'a' charf = Char.toℕ 'f' readDigit : Char → Maybe ℕ readDigit c = digit Maybe.>>= λ n → when (n <ᵇ base) n where charc = Char.toℕ c dec = when ((char0 ≤ᵇ charc) ∧ (charc ≤ᵇ char9)) (charc ∸ char0) hex = when ((chara ≤ᵇ charc) ∧ (charc ≤ᵇ charf)) (10 + charc ∸ chara) digit = dec <∣> hex ------------------------------------------------------------------------ -- Show -- Decimal notation -- Time complexity is O(log₁₀(n)) toDigitChar : ℕ → Char toDigitChar n = Char.fromℕ (n + Char.toℕ '0') toDecimalChars : ℕ → List Char toDecimalChars = List.map toDigitChar ∘′ toNatDigits 10 show : ℕ → String show = String.fromList ∘ toDecimalChars -- Arbitrary base betwen 2 & 16. -- Warning: when compiled the time complexity of `showInBase b n` is -- O(n) instead of the expected O(log(n)). charsInBase : (base : ℕ) {base≥2 : True (2 ≤? base)} {base≤16 : True (base ≤? 16)} → ℕ → List Char charsInBase base {base≥2} {base≤16} = List.map (showDigit {base≤16 = base≤16}) ∘ List.reverse ∘ proj₁ ∘ toDigits base {base≥2 = base≥2} showInBase : (base : ℕ) {base≥2 : True (2 ≤? base)} {base≤16 : True (base ≤? 16)} → ℕ → String showInBase base {base≥2} {base≤16} = String.fromList ∘ charsInBase base {base≥2} {base≤16} agda-stdlib-1.7.3/src/Data/Nat/Show/000077500000000000000000000000001451211343400167755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/Show/Properties.agda000066400000000000000000000022611451211343400217500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of showing natural numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Data.Digit using (showDigit; toDigits) open import Data.Digit.Properties using (toDigits-injective; showDigit-injective) open import Function using (_∘_) import Data.List.Properties as Listₚ open import Data.Nat.Base using (ℕ) open import Data.Nat.Properties using (_≤?_) open import Relation.Nullary.Decidable using (True) open import Relation.Binary.PropositionalEquality using (_≡_) open import Data.Nat.Show using (charsInBase) module Data.Nat.Show.Properties where module _ (base : ℕ) {base≥2 : True (2 ≤? base)} {base≤16 : True (base ≤? 16)} where charsInBase-injective : ∀ n m → charsInBase base {base≥2} {base≤16} n ≡ charsInBase base {base≥2} {base≤16} m → n ≡ m charsInBase-injective n m = toDigits-injective base {base≥2} _ _ ∘ Listₚ.reverse-injective ∘ Listₚ.map-injective (showDigit-injective _ _ _) agda-stdlib-1.7.3/src/Data/Nat/Solver.agda000066400000000000000000000013541451211343400201500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over naturals ------------------------------------------------------------------------ -- See README.Nat for examples of how to use this solver {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Solver where import Algebra.Solver.Ring.Simple as Solver import Algebra.Solver.Ring.AlmostCommutativeRing as ACR open import Data.Nat.Properties ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ module +-*-Solver = Solver (ACR.fromCommutativeSemiring +-*-commutativeSemiring) _≟_ agda-stdlib-1.7.3/src/Data/Nat/Tactic/000077500000000000000000000000001451211343400172645ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Nat/Tactic/RingSolver.agda000066400000000000000000000023171451211343400221770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over naturals ------------------------------------------------------------------------ -- See README.Nat for examples of how to use this solver {-# OPTIONS --cubical-compatible --safe #-} module Data.Nat.Tactic.RingSolver where open import Agda.Builtin.Reflection open import Data.Maybe.Base using (just; nothing) open import Data.Nat.Base using (zero; suc) open import Data.Nat.Properties open import Level using (0ℓ) open import Data.Unit using (⊤) open import Relation.Binary.PropositionalEquality import Tactic.RingSolver as Solver import Tactic.RingSolver.Core.AlmostCommutativeRing as ACR ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ ring : ACR.AlmostCommutativeRing 0ℓ 0ℓ ring = ACR.fromCommutativeSemiring +-*-commutativeSemiring λ { zero → just refl; _ → nothing } macro solve-∀ : Term → TC ⊤ solve-∀ = Solver.solve-∀-macro (quote ring) macro solve : Term → Term → TC ⊤ solve n = Solver.solve-macro n (quote ring) agda-stdlib-1.7.3/src/Data/Nat/WithK.agda000066400000000000000000000016241451211343400177240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural number types and operations requiring the axiom K. ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Nat.WithK where open import Data.Nat.Base open import Relation.Binary.PropositionalEquality.WithK ≤″-erase : ∀ {m n} → m ≤″ n → m ≤″ n ≤″-erase (less-than-or-equal eq) = less-than-or-equal (≡-erase eq) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.18 erase = ≤″-erase {-# WARNING_ON_USAGE erase "Warning: erase was deprecated in v0.18. Please use ≤″-erase instead." #-} agda-stdlib-1.7.3/src/Data/Plus.agda000066400000000000000000000010401451211343400170670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use the -- Relation.Binary.Construct.Closure.Transitive module directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Plus where open import Relation.Binary.Construct.Closure.Transitive public {-# WARNING_ON_IMPORT "Data.Plus was deprecated in v0.16. Use Relation.Binary.Construct.Closure.Transitive instead." #-} agda-stdlib-1.7.3/src/Data/Product.agda000066400000000000000000000143451451211343400176000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Products ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product where open import Function.Base open import Level open import Relation.Nullary open import Agda.Builtin.Equality private variable a b c d e f ℓ p q r : Level A : Set a B : Set b C : Set c D : Set d E : Set e F : Set f ------------------------------------------------------------------------ -- Definition of dependent products open import Agda.Builtin.Sigma public renaming (fst to proj₁; snd to proj₂) hiding (module Σ) module Σ = Agda.Builtin.Sigma.Σ renaming (fst to proj₁; snd to proj₂) -- The syntax declaration below is attached to Σ-syntax, to make it -- easy to import Σ without the special syntax. infix 2 Σ-syntax Σ-syntax : (A : Set a) → (A → Set b) → Set (a ⊔ b) Σ-syntax = Σ syntax Σ-syntax A (λ x → B) = Σ[ x ∈ A ] B ------------------------------------------------------------------------ -- Definition of non-dependent products infixr 4 _,′_ infixr 2 _×_ _×_ : ∀ (A : Set a) (B : Set b) → Set (a ⊔ b) A × B = Σ[ x ∈ A ] B _,′_ : A → B → A × B _,′_ = _,_ ------------------------------------------------------------------------ -- Existential quantifiers ∃ : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) ∃ = Σ _ ∄ : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) ∄ P = ¬ ∃ P ∃₂ : ∀ {A : Set a} {B : A → Set b} (C : (x : A) → B x → Set c) → Set (a ⊔ b ⊔ c) ∃₂ C = ∃ λ a → ∃ λ b → C a b -- Unique existence (parametrised by an underlying equality). ∃! : {A : Set a} → (A → A → Set ℓ) → (A → Set b) → Set (a ⊔ b ⊔ ℓ) ∃! _≈_ B = ∃ λ x → B x × (∀ {y} → B y → x ≈ y) -- Syntax infix 2 ∃-syntax ∃-syntax : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) ∃-syntax = ∃ syntax ∃-syntax (λ x → B) = ∃[ x ] B infix 2 ∄-syntax ∄-syntax : ∀ {A : Set a} → (A → Set b) → Set (a ⊔ b) ∄-syntax = ∄ syntax ∄-syntax (λ x → B) = ∄[ x ] B ------------------------------------------------------------------------ -- Operations over dependent products infix 4 -,_ infixr 2 _-×-_ _-,-_ infixl 2 _<*>_ -- Sometimes the first component can be inferred. -,_ : ∀ {A : Set a} {B : A → Set b} {x} → B x → ∃ B -, y = _ , y <_,_> : ∀ {A : Set a} {B : A → Set b} {C : ∀ {x} → B x → Set c} (f : (x : A) → B x) → ((x : A) → C (f x)) → ((x : A) → Σ (B x) C) < f , g > x = (f x , g x) map : ∀ {P : A → Set p} {Q : B → Set q} → (f : A → B) → (∀ {x} → P x → Q (f x)) → Σ A P → Σ B Q map f g (x , y) = (f x , g y) map₁ : (A → B) → A × C → B × C map₁ f = map f id map₂ : ∀ {A : Set a} {B : A → Set b} {C : A → Set c} → (∀ {x} → B x → C x) → Σ A B → Σ A C map₂ f = map id f -- A version of map where the output can depend on the input dmap : ∀ {B : A → Set b} {P : A → Set p} {Q : ∀ {a} → P a → B a → Set q} → (f : (a : A) → B a) → (∀ {a} (b : P a) → Q b (f a)) → ((a , b) : Σ A P) → Σ (B a) (Q b) dmap f g (x , y) = f x , g y zip : ∀ {P : A → Set p} {Q : B → Set q} {R : C → Set r} → (_∙_ : A → B → C) → (∀ {x y} → P x → Q y → R (x ∙ y)) → Σ A P → Σ B Q → Σ C R zip _∙_ _∘_ (a , p) (b , q) = ((a ∙ b) , (p ∘ q)) curry : ∀ {A : Set a} {B : A → Set b} {C : Σ A B → Set c} → ((p : Σ A B) → C p) → ((x : A) → (y : B x) → C (x , y)) curry f x y = f (x , y) uncurry : ∀ {A : Set a} {B : A → Set b} {C : Σ A B → Set c} → ((x : A) → (y : B x) → C (x , y)) → ((p : Σ A B) → C p) uncurry f (x , y) = f x y -- Rewriting dependent products assocʳ : {B : A → Set b} {C : (a : A) → B a → Set c} → Σ (Σ A B) (uncurry C) → Σ A (λ a → Σ (B a) (C a)) assocʳ ((a , b) , c) = (a , (b , c)) assocˡ : {B : A → Set b} {C : (a : A) → B a → Set c} → Σ A (λ a → Σ (B a) (C a)) → Σ (Σ A B) (uncurry C) assocˡ (a , (b , c)) = ((a , b) , c) -- Alternate form of associativity for dependent products -- where the C parameter is uncurried. assocʳ-curried : {B : A → Set b} {C : Σ A B → Set c} → Σ (Σ A B) C → Σ A (λ a → Σ (B a) (curry C a)) assocʳ-curried ((a , b) , c) = (a , (b , c)) assocˡ-curried : {B : A → Set b} {C : Σ A B → Set c} → Σ A (λ a → Σ (B a) (curry C a)) → Σ (Σ A B) C assocˡ-curried (a , (b , c)) = ((a , b) , c) ------------------------------------------------------------------------ -- Operations for non-dependent products -- Any of the above operations for dependent products will also work for -- non-dependent products but sometimes Agda has difficulty inferring -- the non-dependency. Primed (′ = \prime) versions of the operations -- are therefore provided below that sometimes have better inference -- properties. zip′ : (A → B → C) → (D → E → F) → A × D → B × E → C × F zip′ f g = zip f g curry′ : (A × B → C) → (A → B → C) curry′ = curry uncurry′ : (A → B → C) → (A × B → C) uncurry′ = uncurry dmap′ : ∀ {x y} {X : A → Set x} {Y : B → Set y} → ((a : A) → X a) → ((b : B) → Y b) → ((a , b) : A × B) → X a × Y b dmap′ f g = dmap f g _<*>_ : ∀ {x y} {X : A → Set x} {Y : B → Set y} → ((a : A) → X a) × ((b : B) → Y b) → ((a , b) : A × B) → X a × Y b _<*>_ = uncurry dmap′ -- Operations that can only be defined for non-dependent products swap : A × B → B × A swap (x , y) = (y , x) _-×-_ : (A → B → Set p) → (A → B → Set q) → (A → B → Set _) f -×- g = f -⟪ _×_ ⟫- g _-,-_ : (A → B → C) → (A → B → D) → (A → B → C × D) f -,- g = f -⟪ _,_ ⟫- g -- Rewriting non-dependent products assocʳ′ : (A × B) × C → A × (B × C) assocʳ′ ((a , b) , c) = (a , (b , c)) assocˡ′ : A × (B × C) → (A × B) × C assocˡ′ (a , (b , c)) = ((a , b) , c) agda-stdlib-1.7.3/src/Data/Product/000077500000000000000000000000001451211343400167535ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Algebra.agda000066400000000000000000000136571451211343400211420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Algebraic properties of products ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Algebra where open import Algebra open import Data.Bool.Base using (true; false) open import Data.Empty.Polymorphic using (⊥; ⊥-elim) open import Data.Product open import Data.Product.Properties open import Data.Sum as Sum using (_⊎_; inj₁; inj₂; [_,_]′) open import Data.Sum.Algebra open import Data.Unit.Polymorphic using (⊤; tt) open import Function.Base using (_∘′_) open import Function.Bundles using (_↔_; Inverse; mk↔′) open import Function.Properties.Inverse using (↔-isEquivalence) open import Level using (Level; suc) open import Relation.Binary.PropositionalEquality.Core import Function.Definitions as FuncDef ------------------------------------------------------------------------ private variable a b c d p : Level A : Set a B : Set b C : Set c D : Set d module _ {A : Set a} {B : Set b} where open FuncDef {A = A} {B} _≡_ _≡_ ------------------------------------------------------------------------ -- Properties of Σ -- Σ is associative Σ-assoc : {B : A → Set b} {C : (a : A) → B a → Set c} → Σ (Σ A B) (uncurry C) ↔ Σ A (λ a → Σ (B a) (C a)) Σ-assoc = mk↔′ assocʳ assocˡ cong′ cong′ -- Σ is associative, alternate formulation Σ-assoc-alt : {B : A → Set b} {C : Σ A B → Set c} → Σ (Σ A B) C ↔ Σ A (λ a → Σ (B a) (curry C a)) Σ-assoc-alt = mk↔′ assocʳ-curried assocˡ-curried cong′ cong′ ------------------------------------------------------------------------ -- Algebraic properties -- × is a congruence ×-cong : A ↔ B → C ↔ D → (A × C) ↔ (B × D) ×-cong i j = mk↔′ (map I.f J.f) (map I.f⁻¹ J.f⁻¹) (λ {(a , b) → cong₂ _,_ (I.inverseˡ a) (J.inverseˡ b)}) (λ {(a , b) → cong₂ _,_ (I.inverseʳ a) (J.inverseʳ b)}) where module I = Inverse i; module J = Inverse j -- × is commutative. -- (we don't use Commutative because it isn't polymorphic enough) ×-comm : (A : Set a) (B : Set b) → (A × B) ↔ (B × A) ×-comm _ _ = mk↔′ swap swap swap-involutive swap-involutive module _ (ℓ : Level) where -- × is associative ×-assoc : Associative {ℓ = ℓ} _↔_ _×_ ×-assoc _ _ _ = mk↔′ assocʳ′ assocˡ′ cong′ cong′ -- ⊤ is the identity for × ×-identityˡ : LeftIdentity {ℓ = ℓ} _↔_ ⊤ _×_ ×-identityˡ _ = mk↔′ proj₂ (tt ,_) cong′ cong′ ×-identityʳ : RightIdentity {ℓ = ℓ} _↔_ ⊤ _×_ ×-identityʳ _ = mk↔′ proj₁ (_, tt) cong′ cong′ ×-identity : Identity _↔_ ⊤ _×_ ×-identity = ×-identityˡ , ×-identityʳ -- ⊥ is the zero for × ×-zeroˡ : LeftZero {ℓ = ℓ} _↔_ ⊥ _×_ ×-zeroˡ A = mk↔′ proj₁ ⊥-elim ⊥-elim λ () ×-zeroʳ : RightZero {ℓ = ℓ} _↔_ ⊥ _×_ ×-zeroʳ A = mk↔′ proj₂ ⊥-elim ⊥-elim λ () ×-zero : Zero _↔_ ⊥ _×_ ×-zero = ×-zeroˡ , ×-zeroʳ -- × distributes over ⊎ ×-distribˡ-⊎ : _DistributesOverˡ_ {ℓ = ℓ} _↔_ _×_ _⊎_ ×-distribˡ-⊎ _ _ _ = mk↔′ (uncurry λ x → [ inj₁ ∘′ (x ,_) , inj₂ ∘′ (x ,_) ]′) [ map₂ inj₁ , map₂ inj₂ ]′ Sum.[ cong′ , cong′ ] (uncurry λ _ → Sum.[ cong′ , cong′ ]) ×-distribʳ-⊎ : _DistributesOverʳ_ {ℓ = ℓ} _↔_ _×_ _⊎_ ×-distribʳ-⊎ _ _ _ = mk↔′ (uncurry [ curry inj₁ , curry inj₂ ]′) [ map₁ inj₁ , map₁ inj₂ ]′ Sum.[ cong′ , cong′ ] (uncurry Sum.[ (λ _ → cong′) , (λ _ → cong′) ]) ×-distrib-⊎ : _DistributesOver_ {ℓ = ℓ} _↔_ _×_ _⊎_ ×-distrib-⊎ = ×-distribˡ-⊎ , ×-distribʳ-⊎ ------------------------------------------------------------------------ -- Algebraic structures ×-isMagma : IsMagma {ℓ = ℓ} _↔_ _×_ ×-isMagma = record { isEquivalence = ↔-isEquivalence ; ∙-cong = ×-cong } ×-isSemigroup : IsSemigroup _↔_ _×_ ×-isSemigroup = record { isMagma = ×-isMagma ; assoc = λ _ _ _ → Σ-assoc } ×-isMonoid : IsMonoid _↔_ _×_ ⊤ ×-isMonoid = record { isSemigroup = ×-isSemigroup ; identity = ×-identityˡ , ×-identityʳ } ×-isCommutativeMonoid : IsCommutativeMonoid _↔_ _×_ ⊤ ×-isCommutativeMonoid = record { isMonoid = ×-isMonoid ; comm = ×-comm } ⊎-×-isSemiringWithoutAnnihilatingZero : IsSemiringWithoutAnnihilatingZero _↔_ _⊎_ _×_ ⊥ ⊤ ⊎-×-isSemiringWithoutAnnihilatingZero = record { +-isCommutativeMonoid = ⊎-isCommutativeMonoid ℓ ; *-isMonoid = ×-isMonoid ; distrib = ×-distrib-⊎ } ⊎-×-isSemiring : IsSemiring _↔_ _⊎_ _×_ ⊥ ⊤ ⊎-×-isSemiring = record { isSemiringWithoutAnnihilatingZero = ⊎-×-isSemiringWithoutAnnihilatingZero ; zero = ×-zero } ⊎-×-isCommutativeSemiring : IsCommutativeSemiring _↔_ _⊎_ _×_ ⊥ ⊤ ⊎-×-isCommutativeSemiring = record { isSemiring = ⊎-×-isSemiring ; *-comm = ×-comm } ------------------------------------------------------------------------ -- Algebraic bundles ×-magma : Magma (suc ℓ) ℓ ×-magma = record { isMagma = ×-isMagma } ×-semigroup : Semigroup (suc ℓ) ℓ ×-semigroup = record { isSemigroup = ×-isSemigroup } ×-monoid : Monoid (suc ℓ) ℓ ×-monoid = record { isMonoid = ×-isMonoid } ×-commutativeMonoid : CommutativeMonoid (suc ℓ) ℓ ×-commutativeMonoid = record { isCommutativeMonoid = ×-isCommutativeMonoid } ×-⊎-commutativeSemiring : CommutativeSemiring (suc ℓ) ℓ ×-⊎-commutativeSemiring = record { isCommutativeSemiring = ⊎-×-isCommutativeSemiring } agda-stdlib-1.7.3/src/Data/Product/Categorical/000077500000000000000000000000001451211343400211705ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Categorical/Examples.agda000066400000000000000000000041711451211343400235670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Universe-sensitive functor and monad instances for the Product type. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra module Data.Product.Categorical.Examples {a e b} {A : Monoid a e} {B : Set b} where open import Level using (Lift; lift; _⊔_) open import Category.Functor using (RawFunctor) open import Category.Monad using (RawMonad) open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Function import Function.Identity.Categorical as Id open import Relation.Binary using (Rel) open import Relation.Binary.PropositionalEquality using (_≡_; refl) ------------------------------------------------------------------------ -- Examples -- Note that these examples are simple unit tests, because the type -- checker verifies them. private module A = Monoid A open import Data.Product.Categorical.Left A.rawMonoid b _≈_ : Rel (A.Carrier × Lift a B) (e ⊔ a ⊔ b) _≈_ = Pointwise A._≈_ _≡_ open RawFunctor functor -- This type to the right of × needs to be a "lifted" version of (B : Set b) -- that lives in the universe (Set (a ⊔ b)). fmapIdₗ : (x : A.Carrier × Lift a B) → (id <$> x) ≈ x fmapIdₗ x = A.refl , refl open RawMonad monad -- Now, let's show that "return" is a unit for >>=. We use Lift in exactly -- the same way as above. The data (x : B) then needs to be "lifted" to -- this new type (Lift B). returnUnitL : ∀ {x : B} {f : Lift a B → A.Carrier × Lift a B} → ((return (lift x)) >>= f) ≈ f (lift x) returnUnitL = A.identityˡ _ , refl returnUnitR : {x : A.Carrier × Lift a B} → (x >>= return) ≈ x returnUnitR = A.identityʳ _ , refl -- And another (limited version of a) monad law... bindCompose : ∀ {f g : Lift a B → A.Carrier × Lift a B} → {x : A.Carrier × Lift a B} → ((x >>= f) >>= g) ≈ (x >>= (λ y → (f y >>= g))) bindCompose = A.assoc _ _ _ , refl agda-stdlib-1.7.3/src/Data/Product/Categorical/Left.agda000066400000000000000000000044751451211343400227120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Left-biased universe-sensitive functor and monad instances for the -- Product type. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). See the Data.Product.Categorical.Examples for how this is -- done. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Level module Data.Product.Categorical.Left {a e} (A : RawMonoid a e) (b : Level) where open import Data.Product import Data.Product.Categorical.Left.Base as Base open import Category.Applicative using (RawApplicative) open import Category.Monad using (RawMonad; RawMonadT) open import Function.Base using (id; flip; _∘_; _∘′_) import Function.Identity.Categorical as Id open RawMonoid A ------------------------------------------------------------------------ -- Re-export the base contents publically open Base Carrier b public ------------------------------------------------------------------------ -- Basic records applicative : RawApplicative Productₗ applicative = record { pure = ε ,_ ; _⊛_ = zip _∙_ id } -- The monad instance also requires some mucking about with universe levels. monadT : RawMonadT (_∘′ Productₗ) monadT M = record { return = pure ∘′ (ε ,_) ; _>>=_ = λ ma f → ma >>= uncurry λ a x → map₁ (a ∙_) <$> f x } where open RawMonad M monad : RawMonad Productₗ monad = monadT Id.monad ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Productₗ (F A) → F (Productₗ A) sequenceA (x , fa) = (x ,_) <$> fa mapA : ∀ {A B} → (A → F B) → Productₗ A → F (Productₗ B) mapA f = sequenceA ∘ map₂ f forA : ∀ {A B} → Productₗ A → (A → F B) → F (Productₗ B) forA = flip mapA module TraversableM {M} (Mon : RawMonad {a ⊔ b} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) agda-stdlib-1.7.3/src/Data/Product/Categorical/Left/000077500000000000000000000000001451211343400220625ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Categorical/Left/Base.agda000066400000000000000000000022171451211343400235540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Base definitions for the left-biased universe-sensitive functor and -- monad instances for the Product type. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). See the Data.Product.Categorical.Examples for how this is -- done. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.Product.Categorical.Left.Base {a} (A : Set a) (b : Level) where open import Data.Product using (_×_; map₂; proj₁; proj₂; <_,_>) open import Category.Functor using (RawFunctor) open import Category.Comonad using (RawComonad) ------------------------------------------------------------------------ -- Definitions Productₗ : Set (a ⊔ b) → Set (a ⊔ b) Productₗ B = A × B functor : RawFunctor Productₗ functor = record { _<$>_ = λ f → map₂ f } comonad : RawComonad Productₗ comonad = record { extract = proj₂ ; extend = < proj₁ ,_> } agda-stdlib-1.7.3/src/Data/Product/Categorical/Right.agda000066400000000000000000000043631451211343400230710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Right-biased universe-sensitive functor and monad instances for the -- Product type. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). See the Data.Product.Categorical.Examples for how this is -- done. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Algebra open import Level module Data.Product.Categorical.Right (a : Level) {b e} (B : RawMonoid b e) where open import Data.Product import Data.Product.Categorical.Right.Base as Base open import Category.Applicative using (RawApplicative) open import Category.Monad using (RawMonad; RawMonadT) open import Function.Base using (id; flip; _∘_; _∘′_) import Function.Identity.Categorical as Id open RawMonoid B ------------------------------------------------------------------------ -- Re-export the base contents publically open Base Carrier a public ------------------------------------------------------------------------ -- Basic records applicative : RawApplicative Productᵣ applicative = record { pure = _, ε ; _⊛_ = zip id _∙_ } monadT : RawMonadT (_∘′ Productᵣ) monadT M = record { return = pure ∘′ (_, ε) ; _>>=_ = λ ma f → ma >>= uncurry λ x b → map₂ (b ∙_) <$> f x } where open RawMonad M monad : RawMonad Productᵣ monad = monadT Id.monad ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Productᵣ (F A) → F (Productᵣ A) sequenceA (fa , y) = (_, y) <$> fa mapA : ∀ {A B} → (A → F B) → Productᵣ A → F (Productᵣ B) mapA f = sequenceA ∘ map₁ f forA : ∀ {A B} → Productᵣ A → (A → F B) → F (Productᵣ B) forA = flip mapA module TraversableM {M} (Mon : RawMonad {a ⊔ b} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) agda-stdlib-1.7.3/src/Data/Product/Categorical/Right/000077500000000000000000000000001451211343400222455ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Categorical/Right/Base.agda000066400000000000000000000022061451211343400237350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Base definitions for the right-biased universe-sensitive functor -- and monad instances for the Product type. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). See the Data.Product.Categorical.Examples for how this is -- done. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.Product.Categorical.Right.Base {b} (B : Set b) (a : Level) where open import Data.Product using (_×_; map₁; proj₁; proj₂; <_,_>) open import Category.Functor using (RawFunctor) open import Category.Comonad using (RawComonad) ------------------------------------------------------------------------ -- Definitions Productᵣ : Set (a ⊔ b) → Set (a ⊔ b) Productᵣ A = A × B functor : RawFunctor Productᵣ functor = record { _<$>_ = map₁ } comonad : RawComonad Productᵣ comonad = record { extract = proj₁ ; extend = <_, proj₂ > } agda-stdlib-1.7.3/src/Data/Product/Function/000077500000000000000000000000001451211343400205405ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/000077500000000000000000000000001451211343400224465ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Propositional.agda000066400000000000000000000422271451211343400261350ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Dependent product combinators for propositional equality -- preserving functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Function.Dependent.Propositional where open import Data.Product open import Data.Product.Function.NonDependent.Setoid open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Relation.Binary hiding (_⇔_) open import Function.Base open import Function.Equality using (_⟶_; _⟨$⟩_) open import Function.Equivalence as Equiv using (_⇔_; module Equivalence) open import Function.HalfAdjointEquivalence using (↔→≃; _≃_) open import Function.Injection as Inj using (Injective; _↣_; module Injection) open import Function.Inverse as Inv using (_↔_; module Inverse) open import Function.LeftInverse as LeftInv using (_↞_; _LeftInverseOf_; module LeftInverse) open import Function.Related open import Function.Related.TypeIsomorphisms open import Function.Surjection as Surj using (_↠_; module Surjection) open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Combinators for various function types module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {b₁ b₂} {B₁ : A₁ → Set b₁} {B₂ : A₂ → Set b₂} where ⇔ : (A₁⇔A₂ : A₁ ⇔ A₂) → (∀ {x} → B₁ x → B₂ (Equivalence.to A₁⇔A₂ ⟨$⟩ x)) → (∀ {y} → B₂ y → B₁ (Equivalence.from A₁⇔A₂ ⟨$⟩ y)) → Σ A₁ B₁ ⇔ Σ A₂ B₂ ⇔ A₁⇔A₂ B-to B-from = Equiv.equivalence (map (Equivalence.to A₁⇔A₂ ⟨$⟩_) B-to) (map (Equivalence.from A₁⇔A₂ ⟨$⟩_) B-from) ⇔-↠ : ∀ (A₁↠A₂ : A₁ ↠ A₂) → (∀ {x} → _⇔_ (B₁ x) (B₂ (Surjection.to A₁↠A₂ ⟨$⟩ x))) → _⇔_ (Σ A₁ B₁) (Σ A₂ B₂) ⇔-↠ A₁↠A₂ B₁⇔B₂ = Equiv.equivalence (map (Surjection.to A₁↠A₂ ⟨$⟩_) (Equivalence.to B₁⇔B₂ ⟨$⟩_)) (map (Surjection.from A₁↠A₂ ⟨$⟩_) ((Equivalence.from B₁⇔B₂ ⟨$⟩_) ∘ P.subst B₂ (P.sym $ Surjection.right-inverse-of A₁↠A₂ _))) -- See also Data.Product.Relation.Binary.Pointwise.Dependent.WithK.↣. ↣ : ∀ (A₁↔A₂ : A₁ ↔ A₂) → (∀ {x} → B₁ x ↣ B₂ (Inverse.to A₁↔A₂ ⟨$⟩ x)) → Σ A₁ B₁ ↣ Σ A₂ B₂ ↣ A₁↔A₂ B₁↣B₂ = Inj.injection to to-injective where open P.≡-Reasoning A₁≃A₂ = ↔→≃ A₁↔A₂ subst-application′ : let open _≃_ A₁≃A₂ in {x₁ x₂ : A₁} {y : B₁ (from (to x₁))} (g : ∀ x → B₁ (from (to x)) → B₂ (to x)) (eq : to x₁ ≡ to x₂) → P.subst B₂ eq (g x₁ y) ≡ g x₂ (P.subst B₁ (P.cong from eq) y) subst-application′ {x₁} {x₂} {y} g eq = P.subst B₂ eq (g x₁ y) ≡⟨ P.cong (P.subst B₂ eq) (P.sym (g′-lemma _ _)) ⟩ P.subst B₂ eq (g′ (to x₁) y) ≡⟨ P.subst-application B₁ g′ eq ⟩ g′ (to x₂) (P.subst B₁ (P.cong from eq) y) ≡⟨ g′-lemma _ _ ⟩ g x₂ (P.subst B₁ (P.cong from eq) y) ∎ where open _≃_ A₁≃A₂ g′ : ∀ x → B₁ (from x) → B₂ x g′ x = P.subst B₂ (right-inverse-of x) ∘ g (from x) ∘ P.subst B₁ (P.sym (P.cong from (right-inverse-of x))) g′-lemma : ∀ x y → g′ (to x) y ≡ g x y g′-lemma x y = P.subst B₂ (right-inverse-of (to x)) (g (from (to x)) $ P.subst B₁ (P.sym (P.cong from (right-inverse-of (to x)))) y) ≡⟨ P.cong (λ p → P.subst B₂ p (g (from (to x)) (P.subst B₁ (P.sym (P.cong from p)) y))) (P.sym (left-right x)) ⟩ P.subst B₂ (P.cong to (left-inverse-of x)) (g (from (to x)) $ P.subst B₁ (P.sym (P.cong from (P.cong to (left-inverse-of x)))) y) ≡⟨ lemma _ ⟩ g x y ∎ where lemma : ∀ {x′} eq {y : B₁ (from (to x′))} → P.subst B₂ (P.cong to eq) (g (from (to x)) (P.subst B₁ (P.sym (P.cong from (P.cong to eq))) y)) ≡ g x′ y lemma P.refl = P.refl to = map (_≃_.to A₁≃A₂) (Injection.to B₁↣B₂ ⟨$⟩_) to-injective : Injective (P.→-to-⟶ {B = P.setoid _} to) to-injective {(x₁ , x₂)} {(y₁ , y₂)} = (Inverse.to Σ-≡,≡↔≡ ⟨$⟩_) ∘′ map (_≃_.injective A₁≃A₂) (λ {eq₁} eq₂ → let lemma = Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (_≃_.injective A₁≃A₂ eq₁) x₂ ≡⟨⟩ Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (P.trans (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) (P.trans (P.cong (_≃_.from A₁≃A₂) eq₁) (P.trans (_≃_.left-inverse-of A₁≃A₂ y₁) P.refl))) x₂ ≡⟨ P.cong (λ p → Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (P.trans (P.sym (_≃_.left-inverse-of A₁≃A₂ _)) (P.trans (P.cong (_≃_.from A₁≃A₂) eq₁) p)) x₂) (P.trans-reflʳ _) ⟩ Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (P.trans (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) (P.trans (P.cong (_≃_.from A₁≃A₂) eq₁) (_≃_.left-inverse-of A₁≃A₂ y₁))) x₂ ≡⟨ P.cong (Injection.to B₁↣B₂ ⟨$⟩_) (P.sym (P.subst-subst (P.sym (_≃_.left-inverse-of A₁≃A₂ _)))) ⟩ Injection.to B₁↣B₂ ⟨$⟩ (P.subst B₁ (P.trans (P.cong (_≃_.from A₁≃A₂) eq₁) (_≃_.left-inverse-of A₁≃A₂ y₁)) $ P.subst B₁ (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) x₂) ≡⟨ P.cong (Injection.to B₁↣B₂ ⟨$⟩_) (P.sym (P.subst-subst (P.cong (_≃_.from A₁≃A₂) eq₁))) ⟩ Injection.to B₁↣B₂ ⟨$⟩ (P.subst B₁ (_≃_.left-inverse-of A₁≃A₂ y₁) $ P.subst B₁ (P.cong (_≃_.from A₁≃A₂) eq₁) $ P.subst B₁ (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) x₂) ≡⟨ P.sym (subst-application′ (λ x y → Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (_≃_.left-inverse-of A₁≃A₂ x) y) eq₁) ⟩ P.subst B₂ eq₁ (Injection.to B₁↣B₂ ⟨$⟩ (P.subst B₁ (_≃_.left-inverse-of A₁≃A₂ x₁) $ P.subst B₁ (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) x₂)) ≡⟨ P.cong (P.subst B₂ eq₁ ∘ (Injection.to B₁↣B₂ ⟨$⟩_)) (P.subst-subst (P.sym (_≃_.left-inverse-of A₁≃A₂ _))) ⟩ P.subst B₂ eq₁ (Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ (P.trans (P.sym (_≃_.left-inverse-of A₁≃A₂ x₁)) (_≃_.left-inverse-of A₁≃A₂ x₁)) x₂) ≡⟨ P.cong (λ p → P.subst B₂ eq₁ (Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ p x₂)) (P.trans-symˡ (_≃_.left-inverse-of A₁≃A₂ _)) ⟩ P.subst B₂ eq₁ (Injection.to B₁↣B₂ ⟨$⟩ P.subst B₁ P.refl x₂) ≡⟨⟩ P.subst B₂ eq₁ (Injection.to B₁↣B₂ ⟨$⟩ x₂) ≡⟨ eq₂ ⟩ Injection.to B₁↣B₂ ⟨$⟩ y₂ ∎ in P.subst B₁ (_≃_.injective A₁≃A₂ eq₁) x₂ ≡⟨ Injection.injective B₁↣B₂ lemma ⟩ y₂ ∎) ∘ (Inverse.from Σ-≡,≡↔≡ ⟨$⟩_) ↞ : (A₁↞A₂ : A₁ ↞ A₂) → (∀ {x} → B₁ (LeftInverse.from A₁↞A₂ ⟨$⟩ x) ↞ B₂ x) → Σ A₁ B₁ ↞ Σ A₂ B₂ ↞ A₁↞A₂ B₁↞B₂ = record { to = P.→-to-⟶ to ; from = P.→-to-⟶ from ; left-inverse-of = left-inverse-of } where open P.≡-Reasoning from = map (LeftInverse.from A₁↞A₂ ⟨$⟩_) (LeftInverse.from B₁↞B₂ ⟨$⟩_) to = map (LeftInverse.to A₁↞A₂ ⟨$⟩_) (λ {x} y → LeftInverse.to B₁↞B₂ ⟨$⟩ P.subst B₁ (P.sym (LeftInverse.left-inverse-of A₁↞A₂ x)) y) left-inverse-of : ∀ p → from (to p) ≡ p left-inverse-of (x , y) = Inverse.to Σ-≡,≡↔≡ ⟨$⟩ ( LeftInverse.left-inverse-of A₁↞A₂ x , (P.subst B₁ (LeftInverse.left-inverse-of A₁↞A₂ x) (LeftInverse.from B₁↞B₂ ⟨$⟩ (LeftInverse.to B₁↞B₂ ⟨$⟩ (P.subst B₁ (P.sym (LeftInverse.left-inverse-of A₁↞A₂ x)) y))) ≡⟨ P.cong (P.subst B₁ _) (LeftInverse.left-inverse-of B₁↞B₂ _) ⟩ P.subst B₁ (LeftInverse.left-inverse-of A₁↞A₂ x) (P.subst B₁ (P.sym (LeftInverse.left-inverse-of A₁↞A₂ x)) y) ≡⟨ P.subst-subst-sym (LeftInverse.left-inverse-of A₁↞A₂ x) ⟩ y ∎) ) ↠ : (A₁↠A₂ : A₁ ↠ A₂) → (∀ {x} → B₁ x ↠ B₂ (Surjection.to A₁↠A₂ ⟨$⟩ x)) → Σ A₁ B₁ ↠ Σ A₂ B₂ ↠ A₁↠A₂ B₁↠B₂ = record { to = P.→-to-⟶ to ; surjective = record { from = P.→-to-⟶ from ; right-inverse-of = right-inverse-of } } where open P.≡-Reasoning to = map (Surjection.to A₁↠A₂ ⟨$⟩_) (Surjection.to B₁↠B₂ ⟨$⟩_) from = map (Surjection.from A₁↠A₂ ⟨$⟩_) (λ {x} y → Surjection.from B₁↠B₂ ⟨$⟩ P.subst B₂ (P.sym (Surjection.right-inverse-of A₁↠A₂ x)) y) right-inverse-of : ∀ p → to (from p) ≡ p right-inverse-of (x , y) = Inverse.to Σ-≡,≡↔≡ ⟨$⟩ ( Surjection.right-inverse-of A₁↠A₂ x , (P.subst B₂ (Surjection.right-inverse-of A₁↠A₂ x) (Surjection.to B₁↠B₂ ⟨$⟩ (Surjection.from B₁↠B₂ ⟨$⟩ (P.subst B₂ (P.sym (Surjection.right-inverse-of A₁↠A₂ x)) y))) ≡⟨ P.cong (P.subst B₂ _) (Surjection.right-inverse-of B₁↠B₂ _) ⟩ P.subst B₂ (Surjection.right-inverse-of A₁↠A₂ x) (P.subst B₂ (P.sym (Surjection.right-inverse-of A₁↠A₂ x)) y) ≡⟨ P.subst-subst-sym (Surjection.right-inverse-of A₁↠A₂ x) ⟩ y ∎) ) ↔ : (A₁↔A₂ : A₁ ↔ A₂) → (∀ {x} → B₁ x ↔ B₂ (Inverse.to A₁↔A₂ ⟨$⟩ x)) → Σ A₁ B₁ ↔ Σ A₂ B₂ ↔ A₁↔A₂ B₁↔B₂ = Inv.inverse (Surjection.to surjection′ ⟨$⟩_) (Surjection.from surjection′ ⟨$⟩_) left-inverse-of (Surjection.right-inverse-of surjection′) where open P.≡-Reasoning A₁≃A₂ = ↔→≃ A₁↔A₂ surjection′ : _↠_ (Σ A₁ B₁) (Σ A₂ B₂) surjection′ = ↠ (Inverse.surjection (_≃_.inverse A₁≃A₂)) (Inverse.surjection B₁↔B₂) left-inverse-of : ∀ p → Surjection.from surjection′ ⟨$⟩ (Surjection.to surjection′ ⟨$⟩ p) ≡ p left-inverse-of (x , y) = Inverse.to Σ-≡,≡↔≡ ⟨$⟩ ( _≃_.left-inverse-of A₁≃A₂ x , (P.subst B₁ (_≃_.left-inverse-of A₁≃A₂ x) (Inverse.from B₁↔B₂ ⟨$⟩ (P.subst B₂ (P.sym (_≃_.right-inverse-of A₁≃A₂ (_≃_.to A₁≃A₂ x))) (Inverse.to B₁↔B₂ ⟨$⟩ y))) ≡⟨ P.subst-application B₂ (λ _ → Inverse.from B₁↔B₂ ⟨$⟩_) _ ⟩ Inverse.from B₁↔B₂ ⟨$⟩ (P.subst B₂ (P.cong (_≃_.to A₁≃A₂) (_≃_.left-inverse-of A₁≃A₂ x)) (P.subst B₂ (P.sym (_≃_.right-inverse-of A₁≃A₂ (_≃_.to A₁≃A₂ x))) (Inverse.to B₁↔B₂ ⟨$⟩ y))) ≡⟨ P.cong (λ eq → Inverse.from B₁↔B₂ ⟨$⟩ P.subst B₂ eq (P.subst B₂ (P.sym (_≃_.right-inverse-of A₁≃A₂ _)) _)) (_≃_.left-right A₁≃A₂ _) ⟩ Inverse.from B₁↔B₂ ⟨$⟩ (P.subst B₂ (_≃_.right-inverse-of A₁≃A₂ (_≃_.to A₁≃A₂ x)) (P.subst B₂ (P.sym (_≃_.right-inverse-of A₁≃A₂ (_≃_.to A₁≃A₂ x))) (Inverse.to B₁↔B₂ ⟨$⟩ y))) ≡⟨ P.cong (Inverse.from B₁↔B₂ ⟨$⟩_) (P.subst-subst-sym (_≃_.right-inverse-of A₁≃A₂ _)) ⟩ Inverse.from B₁↔B₂ ⟨$⟩ (Inverse.to B₁↔B₂ ⟨$⟩ y) ≡⟨ Inverse.left-inverse-of B₁↔B₂ _ ⟩ y ∎) ) private swap-coercions : ∀ {k a₁ a₂ b₁ b₂} {A₁ : Set a₁} {A₂ : Set a₂} {B₁ : A₁ → Set b₁} (B₂ : A₂ → Set b₂) (A₁↔A₂ : _↔_ A₁ A₂) → (∀ {x} → B₁ x ∼[ k ] B₂ (Inverse.to A₁↔A₂ ⟨$⟩ x)) → ∀ {x} → B₁ (Inverse.from A₁↔A₂ ⟨$⟩ x) ∼[ k ] B₂ x swap-coercions {k} {B₁ = B₁} B₂ A₁↔A₂ eq {x} = B₁ (Inverse.from A₁↔A₂ ⟨$⟩ x) ∼⟨ eq ⟩ B₂ (Inverse.to A₁↔A₂ ⟨$⟩ (Inverse.from A₁↔A₂ ⟨$⟩ x)) ↔⟨ K-reflexive (P.cong B₂ $ Inverse.right-inverse-of A₁↔A₂ x) ⟩ B₂ x ∎ where open EquationalReasoning cong : ∀ {k a₁ a₂ b₁ b₂} {A₁ : Set a₁} {A₂ : Set a₂} {B₁ : A₁ → Set b₁} {B₂ : A₂ → Set b₂} (A₁↔A₂ : _↔_ A₁ A₂) → (∀ {x} → B₁ x ∼[ k ] B₂ (Inverse.to A₁↔A₂ ⟨$⟩ x)) → Σ A₁ B₁ ∼[ k ] Σ A₂ B₂ cong {implication} = λ A₁↔A₂ → map (_⟨$⟩_ (Inverse.to A₁↔A₂)) cong {reverse-implication} {B₂ = B₂} = λ A₁↔A₂ B₁←B₂ → lam (map (_⟨$⟩_ (Inverse.from A₁↔A₂)) (app-← (swap-coercions B₂ A₁↔A₂ B₁←B₂))) cong {equivalence} = ⇔-↠ ∘ Inverse.surjection cong {injection} = ↣ cong {reverse-injection} {B₂ = B₂} = λ A₁↔A₂ B₁↢B₂ → lam (↣ (Inv.sym A₁↔A₂) (app-↢ (swap-coercions B₂ A₁↔A₂ B₁↢B₂))) cong {left-inverse} = λ A₁↔A₂ → ↞ (Inverse.left-inverse A₁↔A₂) ∘ swap-coercions _ A₁↔A₂ cong {surjection} = ↠ ∘ Inverse.surjection cong {bijection} = ↔ agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Propositional/000077500000000000000000000000001451211343400253105ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Propositional/WithK.agda000066400000000000000000000031031451211343400271510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Dependent product combinators for propositional equality -- preserving functions ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Product.Function.Dependent.Propositional.WithK where open import Data.Product open import Data.Product.Function.Dependent.Setoid open import Data.Product.Relation.Binary.Pointwise.Dependent open import Data.Product.Relation.Binary.Pointwise.Dependent.WithK open import Function.Equality using (_⟨$⟩_) open import Function.Injection as Inj using (_↣_; module Injection) open import Function.Inverse as Inv using (_↔_; module Inverse) import Relation.Binary.HeterogeneousEquality as H ------------------------------------------------------------------------ -- Combinator for Injection module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {b₁ b₂} {B₁ : A₁ → Set b₁} {B₂ : A₂ → Set b₂} where ↣ : ∀ (A₁↣A₂ : A₁ ↣ A₂) → (∀ {x} → B₁ x ↣ B₂ (Injection.to A₁↣A₂ ⟨$⟩ x)) → Σ A₁ B₁ ↣ Σ A₂ B₂ ↣ A₁↣A₂ B₁↣B₂ = Inverse.injection Pointwise-≡↔≡ ⟨∘⟩ injection (H.indexedSetoid B₂) A₁↣A₂ (Inverse.injection (H.≡↔≅ B₂) ⟨∘⟩ B₁↣B₂ ⟨∘⟩ Inverse.injection (Inv.sym (H.≡↔≅ B₁))) ⟨∘⟩ Inverse.injection (Inv.sym Pointwise-≡↔≡) where open Inj using () renaming (_∘_ to _⟨∘⟩_) agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Setoid.agda000066400000000000000000000212051451211343400245130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Dependent product combinators for setoid equality preserving -- functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Function.Dependent.Setoid where open import Data.Product open import Data.Product.Relation.Binary.Pointwise.Dependent open import Function.Base open import Function.Equality as F using (_⟶_; _⟨$⟩_) open import Function.Equivalence as Eq using (Equivalence; _⇔_; module Equivalence) open import Function.Injection as Inj using (Injection; Injective; _↣_; module Injection) open import Function.Inverse as Inv using (Inverse; _↔_; module Inverse) open import Function.LeftInverse as LeftInv using (LeftInverse; _↞_; _LeftInverseOf_; _RightInverseOf_; module LeftInverse) open import Function.Surjection as Surj using (Surjection; _↠_; module Surjection) open import Relation.Binary as B hiding (_⇔_) open import Relation.Binary.Indexed.Heterogeneous using (IndexedSetoid) open import Relation.Binary.Indexed.Heterogeneous.Construct.At using (_atₛ_) open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Properties related to "relatedness" ------------------------------------------------------------------------ private subst-cong : ∀ {i a p} {I : Set i} {A : I → Set a} (P : ∀ {i} → A i → A i → Set p) {i i′} {x y : A i} (i≡i′ : i ≡ i′) → P x y → P (P.subst A i≡i′ x) (P.subst A i≡i′ y) subst-cong P P.refl p = p ⟶ : ∀ {a₁ a₂ b₁ b₁′ b₂ b₂′} {A₁ : Set a₁} {A₂ : Set a₂} {B₁ : IndexedSetoid A₁ b₁ b₁′} (B₂ : IndexedSetoid A₂ b₂ b₂′) (f : A₁ → A₂) → (∀ {x} → (B₁ atₛ x) ⟶ (B₂ atₛ (f x))) → setoid (P.setoid A₁) B₁ ⟶ setoid (P.setoid A₂) B₂ ⟶ {A₁ = A₁} {A₂} {B₁} B₂ f g = record { _⟨$⟩_ = fg ; cong = fg-cong } where open B.Setoid (setoid (P.setoid A₁) B₁) using () renaming (_≈_ to _≈₁_) open B.Setoid (setoid (P.setoid A₂) B₂) using () renaming (_≈_ to _≈₂_) open B using (_=[_]⇒_) fg = map f (_⟨$⟩_ g) fg-cong : _≈₁_ =[ fg ]⇒ _≈₂_ fg-cong (P.refl , ∼) = (P.refl , F.cong g ∼) module _ {a₁ a₂ b₁ b₁′ b₂ b₂′} {A₁ : Set a₁} {A₂ : Set a₂} where equivalence : {B₁ : IndexedSetoid A₁ b₁ b₁′} {B₂ : IndexedSetoid A₂ b₂ b₂′} (A₁⇔A₂ : A₁ ⇔ A₂) → (∀ {x} → _⟶_ (B₁ atₛ x) (B₂ atₛ (Equivalence.to A₁⇔A₂ ⟨$⟩ x))) → (∀ {y} → _⟶_ (B₂ atₛ y) (B₁ atₛ (Equivalence.from A₁⇔A₂ ⟨$⟩ y))) → Equivalence (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) equivalence {B₁} {B₂} A₁⇔A₂ B-to B-from = record { to = ⟶ B₂ (_⟨$⟩_ (to A₁⇔A₂)) B-to ; from = ⟶ B₁ (_⟨$⟩_ (from A₁⇔A₂)) B-from } where open Equivalence equivalence-↞ : (B₁ : IndexedSetoid A₁ b₁ b₁′) {B₂ : IndexedSetoid A₂ b₂ b₂′} (A₁↞A₂ : A₁ ↞ A₂) → (∀ {x} → Equivalence (B₁ atₛ (LeftInverse.from A₁↞A₂ ⟨$⟩ x)) (B₂ atₛ x)) → Equivalence (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) equivalence-↞ B₁ {B₂} A₁↞A₂ B₁⇔B₂ = equivalence (LeftInverse.equivalence A₁↞A₂) B-to B-from where B-to : ∀ {x} → _⟶_ (B₁ atₛ x) (B₂ atₛ (LeftInverse.to A₁↞A₂ ⟨$⟩ x)) B-to = record { _⟨$⟩_ = λ x → Equivalence.to B₁⇔B₂ ⟨$⟩ P.subst (IndexedSetoid.Carrier B₁) (P.sym $ LeftInverse.left-inverse-of A₁↞A₂ _) x ; cong = F.cong (Equivalence.to B₁⇔B₂) ∘ subst-cong (λ {x} → IndexedSetoid._≈_ B₁ {x} {x}) (P.sym (LeftInverse.left-inverse-of A₁↞A₂ _)) } B-from : ∀ {y} → _⟶_ (B₂ atₛ y) (B₁ atₛ (LeftInverse.from A₁↞A₂ ⟨$⟩ y)) B-from = Equivalence.from B₁⇔B₂ equivalence-↠ : {B₁ : IndexedSetoid A₁ b₁ b₁′} (B₂ : IndexedSetoid A₂ b₂ b₂′) (A₁↠A₂ : A₁ ↠ A₂) → (∀ {x} → Equivalence (B₁ atₛ x) (B₂ atₛ (Surjection.to A₁↠A₂ ⟨$⟩ x))) → Equivalence (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) equivalence-↠ {B₁ = B₁} B₂ A₁↠A₂ B₁⇔B₂ = equivalence (Surjection.equivalence A₁↠A₂) B-to B-from where B-to : ∀ {x} → _⟶_ (B₁ atₛ x) (B₂ atₛ (Surjection.to A₁↠A₂ ⟨$⟩ x)) B-to = Equivalence.to B₁⇔B₂ B-from : ∀ {y} → _⟶_ (B₂ atₛ y) (B₁ atₛ (Surjection.from A₁↠A₂ ⟨$⟩ y)) B-from = record { _⟨$⟩_ = λ x → Equivalence.from B₁⇔B₂ ⟨$⟩ P.subst (IndexedSetoid.Carrier B₂) (P.sym $ Surjection.right-inverse-of A₁↠A₂ _) x ; cong = F.cong (Equivalence.from B₁⇔B₂) ∘ subst-cong (λ {x} → IndexedSetoid._≈_ B₂ {x} {x}) (P.sym (Surjection.right-inverse-of A₁↠A₂ _)) } injection : {B₁ : IndexedSetoid A₁ b₁ b₁′} (B₂ : IndexedSetoid A₂ b₂ b₂′) → (A₁↣A₂ : A₁ ↣ A₂) → (∀ {x} → Injection (B₁ atₛ x) (B₂ atₛ (Injection.to A₁↣A₂ ⟨$⟩ x))) → Injection (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) injection {B₁ = B₁} B₂ A₁↣A₂ B₁↣B₂ = record { to = to ; injective = inj } where to = ⟶ B₂ (Injection.to A₁↣A₂ ⟨$⟩_) (Injection.to B₁↣B₂) inj : Injective to inj (x , y) = Injection.injective A₁↣A₂ x , lemma (Injection.injective A₁↣A₂ x) y where lemma : ∀ {x x′} {y : IndexedSetoid.Carrier B₁ x} {y′ : IndexedSetoid.Carrier B₁ x′} → x ≡ x′ → (eq : IndexedSetoid._≈_ B₂ (Injection.to B₁↣B₂ ⟨$⟩ y) (Injection.to B₁↣B₂ ⟨$⟩ y′)) → IndexedSetoid._≈_ B₁ y y′ lemma P.refl = Injection.injective B₁↣B₂ left-inverse : (B₁ : IndexedSetoid A₁ b₁ b₁′) {B₂ : IndexedSetoid A₂ b₂ b₂′} → (A₁↞A₂ : A₁ ↞ A₂) → (∀ {x} → LeftInverse (B₁ atₛ (LeftInverse.from A₁↞A₂ ⟨$⟩ x)) (B₂ atₛ x)) → LeftInverse (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) left-inverse B₁ {B₂} A₁↞A₂ B₁↞B₂ = record { to = Equivalence.to eq ; from = Equivalence.from eq ; left-inverse-of = left } where eq = equivalence-↞ B₁ A₁↞A₂ (LeftInverse.equivalence B₁↞B₂) left : Equivalence.from eq LeftInverseOf Equivalence.to eq left (x , y) = LeftInverse.left-inverse-of A₁↞A₂ x , IndexedSetoid.trans B₁ (LeftInverse.left-inverse-of B₁↞B₂ _) (lemma (P.sym (LeftInverse.left-inverse-of A₁↞A₂ x))) where lemma : ∀ {x x′ y} (eq : x ≡ x′) → IndexedSetoid._≈_ B₁ (P.subst (IndexedSetoid.Carrier B₁) eq y) y lemma P.refl = IndexedSetoid.refl B₁ surjection : {B₁ : IndexedSetoid A₁ b₁ b₁′} (B₂ : IndexedSetoid A₂ b₂ b₂′) → (A₁↠A₂ : A₁ ↠ A₂) → (∀ {x} → Surjection (B₁ atₛ x) (B₂ atₛ (Surjection.to A₁↠A₂ ⟨$⟩ x))) → Surjection (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) surjection B₂ A₁↠A₂ B₁↠B₂ = record { to = Equivalence.to eq ; surjective = record { from = Equivalence.from eq ; right-inverse-of = right } } where eq = equivalence-↠ B₂ A₁↠A₂ (Surjection.equivalence B₁↠B₂) right : Equivalence.from eq RightInverseOf Equivalence.to eq right (x , y) = Surjection.right-inverse-of A₁↠A₂ x , IndexedSetoid.trans B₂ (Surjection.right-inverse-of B₁↠B₂ _) (lemma (P.sym $ Surjection.right-inverse-of A₁↠A₂ x)) where lemma : ∀ {x x′ y} (eq : x ≡ x′) → IndexedSetoid._≈_ B₂ (P.subst (IndexedSetoid.Carrier B₂) eq y) y lemma P.refl = IndexedSetoid.refl B₂ -- See also Data.Product.Function.Dependent.Setoid.WithK.inverse. agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Setoid/000077500000000000000000000000001451211343400236755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Function/Dependent/Setoid/WithK.agda000066400000000000000000000057051451211343400255500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Dependent product combinators for setoid equality preserving -- functions ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Product.Function.Dependent.Setoid.WithK where open import Data.Product open import Data.Product.Function.Dependent.Setoid using (surjection) open import Data.Product.Relation.Binary.Pointwise.Dependent open import Relation.Binary open import Function.Base open import Function.Equality as F using (_⟶_; _⟨$⟩_) open import Function.Equivalence as Eq using (Equivalence; _⇔_; module Equivalence) open import Function.Injection as Inj using (Injection; Injective; _↣_; module Injection) open import Function.Inverse as Inv using (Inverse; _↔_; module Inverse) open import Function.LeftInverse as LeftInv using (LeftInverse; _↞_; _LeftInverseOf_; _RightInverseOf_; module LeftInverse) open import Function.Surjection as Surj using (Surjection; _↠_; module Surjection) open import Relation.Binary as B open import Relation.Binary.Indexed.Heterogeneous using (IndexedSetoid) open import Relation.Binary.Indexed.Heterogeneous.Construct.At using (_atₛ_) open import Relation.Binary.PropositionalEquality as P using (_≡_) ------------------------------------------------------------------------ -- Combinator for Inverse module _ {a₁ a₂ b₁ b₁′ b₂ b₂′} {A₁ : Set a₁} {A₂ : Set a₂} where inverse : {B₁ : IndexedSetoid A₁ b₁ b₁′} (B₂ : IndexedSetoid A₂ b₂ b₂′) → (A₁↔A₂ : A₁ ↔ A₂) → (∀ {x} → Inverse (B₁ atₛ x) (B₂ atₛ (Inverse.to A₁↔A₂ ⟨$⟩ x))) → Inverse (setoid (P.setoid A₁) B₁) (setoid (P.setoid A₂) B₂) inverse {B₁} B₂ A₁↔A₂ B₁↔B₂ = record { to = Surjection.to surj ; from = Surjection.from surj ; inverse-of = record { left-inverse-of = left ; right-inverse-of = Surjection.right-inverse-of surj } } where surj = surjection B₂ (Inverse.surjection A₁↔A₂) (Inverse.surjection B₁↔B₂) left : Surjection.from surj LeftInverseOf Surjection.to surj left (x , y) = Inverse.left-inverse-of A₁↔A₂ x , IndexedSetoid.trans B₁ (lemma (P.sym (Inverse.left-inverse-of A₁↔A₂ x)) (P.sym (Inverse.right-inverse-of A₁↔A₂ (Inverse.to A₁↔A₂ ⟨$⟩ x)))) (Inverse.left-inverse-of B₁↔B₂ y) where lemma : ∀ {x x′ y} → x ≡ x′ → (eq : (Inverse.to A₁↔A₂ ⟨$⟩ x) ≡ (Inverse.to A₁↔A₂ ⟨$⟩ x′)) → IndexedSetoid._≈_ B₁ (Inverse.from B₁↔B₂ ⟨$⟩ P.subst (IndexedSetoid.Carrier B₂) eq y) (Inverse.from B₁↔B₂ ⟨$⟩ y) lemma P.refl P.refl = IndexedSetoid.refl B₁ agda-stdlib-1.7.3/src/Data/Product/Function/NonDependent/000077500000000000000000000000001451211343400231215ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Function/NonDependent/Propositional.agda000066400000000000000000000064751451211343400266150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Non-dependent product combinators for propositional equality -- preserving functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Function.NonDependent.Propositional where open import Data.Product open import Data.Product.Function.NonDependent.Setoid open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Relation.Binary hiding (_⇔_) open import Function.Equality using (_⟶_) open import Function.Equivalence as Eq using (_⇔_; module Equivalence) open import Function.Injection as Inj using (_↣_; module Injection) open import Function.Inverse as Inv using (_↔_; module Inverse) open import Function.LeftInverse as LeftInv using (_↞_; _LeftInverseOf_; module LeftInverse) open import Function.Related open import Function.Surjection as Surj using (_↠_; module Surjection) ------------------------------------------------------------------------ -- Combinators for various function types module _ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} where _×-⇔_ : A ⇔ B → C ⇔ D → (A × C) ⇔ (B × D) _×-⇔_ A⇔B C⇔D = Inverse.equivalence Pointwise-≡↔≡ ⟨∘⟩ (A⇔B ×-equivalence C⇔D) ⟨∘⟩ Eq.sym (Inverse.equivalence Pointwise-≡↔≡) where open Eq using () renaming (_∘_ to _⟨∘⟩_) _×-↣_ : A ↣ B → C ↣ D → (A × C) ↣ (B × D) _×-↣_ A↣B C↣D = Inverse.injection Pointwise-≡↔≡ ⟨∘⟩ (A↣B ×-injection C↣D) ⟨∘⟩ Inverse.injection (Inv.sym Pointwise-≡↔≡) where open Inj using () renaming (_∘_ to _⟨∘⟩_) _×-↞_ : A ↞ B → C ↞ D → (A × C) ↞ (B × D) _×-↞_ A↞B C↞D = Inverse.left-inverse Pointwise-≡↔≡ ⟨∘⟩ (A↞B ×-left-inverse C↞D) ⟨∘⟩ Inverse.left-inverse (Inv.sym Pointwise-≡↔≡) where open LeftInv using () renaming (_∘_ to _⟨∘⟩_) _×-↠_ : A ↠ B → C ↠ D → (A × C) ↠ (B × D) _×-↠_ A↠B C↠D = Inverse.surjection Pointwise-≡↔≡ ⟨∘⟩ (A↠B ×-surjection C↠D) ⟨∘⟩ Inverse.surjection (Inv.sym Pointwise-≡↔≡) where open Surj using () renaming (_∘_ to _⟨∘⟩_) _×-↔_ : A ↔ B → C ↔ D → (A × C) ↔ (B × D) _×-↔_ A↔B C↔D = Pointwise-≡↔≡ ⟨∘⟩ (A↔B ×-inverse C↔D) ⟨∘⟩ Inv.sym Pointwise-≡↔≡ where open Inv using () renaming (_∘_ to _⟨∘⟩_) module _ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} where _×-cong_ : ∀ {k} → A ∼[ k ] B → C ∼[ k ] D → (A × C) ∼[ k ] (B × D) _×-cong_ {implication} = λ f g → map f g _×-cong_ {reverse-implication} = λ f g → lam (map (app-← f) (app-← g)) _×-cong_ {equivalence} = _×-⇔_ _×-cong_ {injection} = _×-↣_ _×-cong_ {reverse-injection} = λ f g → lam (app-↢ f ×-↣ app-↢ g) _×-cong_ {left-inverse} = _×-↞_ _×-cong_ {surjection} = _×-↠_ _×-cong_ {bijection} = _×-↔_ agda-stdlib-1.7.3/src/Data/Product/Function/NonDependent/Setoid.agda000066400000000000000000000115621451211343400251730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Non-dependent product combinators for setoid equality preserving -- functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Function.NonDependent.Setoid where open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent open import Relation.Binary open import Function.Equality as F using (_⟶_; _⟨$⟩_) open import Function.Equivalence as Eq using (Equivalence; _⇔_; module Equivalence) open import Function.Injection as Inj using (Injection; _↣_; module Injection) open import Function.Inverse as Inv using (Inverse; _↔_; module Inverse) open import Function.LeftInverse as LeftInv using (LeftInverse; _↞_; _LeftInverseOf_; module LeftInverse) open import Function.Related open import Function.Surjection as Surj using (Surjection; _↠_; module Surjection) ------------------------------------------------------------------------ -- Combinators for equality preserving functions module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _×-⟶_ : (A ⟶ B) → (C ⟶ D) → (A ×ₛ C) ⟶ (B ×ₛ D) _×-⟶_ f g = record { _⟨$⟩_ = fg ; cong = fg-cong } where open Setoid (A ×ₛ C) using () renaming (_≈_ to _≈AC_) open Setoid (B ×ₛ D) using () renaming (_≈_ to _≈BD_) fg = map (f ⟨$⟩_) (g ⟨$⟩_) fg-cong : _≈AC_ =[ fg ]⇒ _≈BD_ fg-cong (_∼₁_ , _∼₂_) = (F.cong f _∼₁_ , F.cong g _∼₂_) module _ {a₁ a₂ b₁ b₂ c₁ c₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} where <_,_>ₛ : (A ⟶ B) → (A ⟶ C) → A ⟶ (B ×ₛ C) < f , g >ₛ = record { _⟨$⟩_ = < f ⟨$⟩_ , g ⟨$⟩_ > ; cong = < F.cong f , F.cong g > } module _ {a₁ a₂ b₁ b₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} where proj₁ₛ : (A ×ₛ B) ⟶ A proj₁ₛ = record { _⟨$⟩_ = proj₁ ; cong = proj₁ } proj₂ₛ : (A ×ₛ B) ⟶ B proj₂ₛ = record { _⟨$⟩_ = proj₂ ; cong = proj₂ } swapₛ : (A ×ₛ B) ⟶ (B ×ₛ A) swapₛ = < proj₂ₛ , proj₁ₛ >ₛ ------------------------------------------------------------------------ -- Combinators for more complex function types module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _×-equivalence_ : Equivalence A B → Equivalence C D → Equivalence (A ×ₛ C) (B ×ₛ D) _×-equivalence_ A⇔B C⇔D = record { to = to A⇔B ×-⟶ to C⇔D ; from = from A⇔B ×-⟶ from C⇔D } where open Equivalence _×-injection_ : Injection A B → Injection C D → Injection (A ×ₛ C) (B ×ₛ D) A↣B ×-injection C↣D = record { to = to A↣B ×-⟶ to C↣D ; injective = map (injective A↣B) (injective C↣D) } where open Injection _×-left-inverse_ : LeftInverse A B → LeftInverse C D → LeftInverse (A ×ₛ C) (B ×ₛ D) A↞B ×-left-inverse C↞D = record { to = Equivalence.to eq ; from = Equivalence.from eq ; left-inverse-of = left } where open LeftInverse eq = LeftInverse.equivalence A↞B ×-equivalence LeftInverse.equivalence C↞D left : Equivalence.from eq LeftInverseOf Equivalence.to eq left (x , y) = (left-inverse-of A↞B x , left-inverse-of C↞D y) module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _×-surjection_ : Surjection A B → Surjection C D → Surjection (A ×ₛ C) (B ×ₛ D) A↠B ×-surjection C↠D = record { to = LeftInverse.from inv ; surjective = record { from = LeftInverse.to inv ; right-inverse-of = LeftInverse.left-inverse-of inv } } where open Surjection inv = right-inverse A↠B ×-left-inverse right-inverse C↠D _×-inverse_ : Inverse A B → Inverse C D → Inverse (A ×ₛ C) (B ×ₛ D) A↔B ×-inverse C↔D = record { to = Surjection.to surj ; from = Surjection.from surj ; inverse-of = record { left-inverse-of = LeftInverse.left-inverse-of inv ; right-inverse-of = Surjection.right-inverse-of surj } } where open Inverse surj = Inverse.surjection A↔B ×-surjection Inverse.surjection C↔D inv = Inverse.left-inverse A↔B ×-left-inverse Inverse.left-inverse C↔D agda-stdlib-1.7.3/src/Data/Product/Instances.agda000066400000000000000000000017031451211343400215210ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for products ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Instances where open import Data.Product using (Σ) open import Data.Product.Properties open import Level open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) open import Relation.Binary.PropositionalEquality.Core using (_≡_) open import Relation.Binary.Structures using (IsDecEquivalence) open import Relation.Binary.TypeClasses private variable a b : Level A : Set a instance Σ-≡-isDecEquivalence : ∀ {B : A → Set b} {{_ : IsDecEquivalence {A = A} _≡_}} {{_ : ∀ {a} → IsDecEquivalence {A = B a} _≡_}} → IsDecEquivalence {A = Σ A B} _≡_ Σ-≡-isDecEquivalence = isDecEquivalence (≡-dec _≟_ _≟_) agda-stdlib-1.7.3/src/Data/Product/N-ary.agda000066400000000000000000000007241451211343400205620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use Data.Vec.Recursive instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.N-ary where {-# WARNING_ON_IMPORT "Data.Product.N-ary was deprecated in v1.1. Use Data.Vec.Recursive instead." #-} open import Data.Vec.Recursive public agda-stdlib-1.7.3/src/Data/Product/N-ary/000077500000000000000000000000001451211343400177415ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/N-ary/Categorical.agda000066400000000000000000000010231451211343400227700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use Data.Vec.Recursive.Categorical -- instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.N-ary.Categorical where {-# WARNING_ON_IMPORT "Data.Product.N-ary.Categorical was deprecated in v1.1. Use Data.Vec.Recursive.Categorical instead." #-} open import Data.Vec.Recursive.Categorical public agda-stdlib-1.7.3/src/Data/Product/N-ary/Properties.agda000066400000000000000000000010161451211343400227110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use Data.Vec.Recursive.Properties -- instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.N-ary.Properties where {-# WARNING_ON_IMPORT "Data.Product.N-ary.Properties was deprecated in v1.1. Use Data.Vec.Recursive.Properties instead." #-} open import Data.Vec.Recursive.Properties public agda-stdlib-1.7.3/src/Data/Product/Nary/000077500000000000000000000000001451211343400176645ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Nary/NonDependent.agda000066400000000000000000000234501451211343400230670ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Nondependent heterogeneous N-ary products ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Nary.NonDependent where ------------------------------------------------------------------------ -- Concrete examples can be found in README.Nary. This file's comments -- are more focused on the implementation details and the motivations -- behind the design decisions. ------------------------------------------------------------------------ open import Level as L using (Level; _⊔_; Lift; 0ℓ) open import Agda.Builtin.Unit open import Data.Product as Prod import Data.Product.Properties as Prodₚ open import Data.Sum.Base using (_⊎_) open import Data.Nat.Base using (ℕ; zero; suc; pred) open import Data.Fin.Base using (Fin; zero; suc) open import Function open import Relation.Nullary open import Relation.Nullary.Product using (_×-dec_) open import Relation.Binary using (Rel) open import Relation.Binary.PropositionalEquality using (_≡_; refl; cong₂) open import Function.Nary.NonDependent.Base -- Provided n Levels and a corresponding "vector" of `n` Sets, we can build a big -- right-nested product type packing a value for each one of these Sets. -- We have two distinct but equivalent definitions: -- the first which is always ⊤-terminated -- the other which has a special case for n = 1 because we want our `(un)curryₙ` -- functions to work for user-written functions and products and they rarely are -- ⊤-terminated. Product⊤ : ∀ n {ls} → Sets n ls → Set (⨆ n ls) Product⊤ zero as = ⊤ Product⊤ (suc n) (a , as) = a × Product⊤ n as Product : ∀ n {ls} → Sets n ls → Set (⨆ n ls) Product 0 _ = ⊤ Product 1 (a , _) = a Product (suc n) (a , as) = a × Product n as -- Pointwise lifting of a relation on products Allₙ : (∀ {a} {A : Set a} → Rel A a) → ∀ n {ls} {as : Sets n ls} (l r : Product n as) → Sets n ls Allₙ R 0 l r = _ Allₙ R 1 a b = R a b , _ Allₙ R (suc n@(suc _)) (a , l) (b , r) = R a b , Allₙ R n l r Equalₙ : ∀ n {ls} {as : Sets n ls} (l r : Product n as) → Sets n ls Equalₙ = Allₙ _≡_ ------------------------------------------------------------------------ -- Generic Programs -- Once we have these type definitions, we can write generic programs -- over them. They will typically be split into two or three definitions: -- 1. action on the vector of n levels (if any) -- 2. action on the corresponding vector of n Sets -- 3. actual program, typed thank to the function defined in step 2. ------------------------------------------------------------------------ -- see Relation.Binary.PropositionalEquality for congₙ and substₙ, two -- equality-related generic programs. ------------------------------------------------------------------------ -- equivalence of Product and Product⊤ toProduct : ∀ n {ls} {as : Sets n ls} → Product⊤ n as → Product n as toProduct 0 _ = _ toProduct 1 (v , _) = v toProduct (suc (suc n)) (v , vs) = v , toProduct _ vs toProduct⊤ : ∀ n {ls} {as : Sets n ls} → Product n as → Product⊤ n as toProduct⊤ 0 _ = _ toProduct⊤ 1 v = v , _ toProduct⊤ (suc (suc n)) (v , vs) = v , toProduct⊤ _ vs ------------------------------------------------------------------------ -- (un)curry -- We start by defining `curryₙ` and `uncurryₙ` converting back and forth -- between `A₁ → ⋯ → Aₙ → B` and `(A₁ × ⋯ × Aₙ) → B` by induction on `n`. curryₙ : ∀ n {ls} {as : Sets n ls} {r} {b : Set r} → (Product n as → b) → as ⇉ b curryₙ 0 f = f _ curryₙ 1 f = f curryₙ (suc n@(suc _)) f = curryₙ n ∘′ curry f uncurryₙ : ∀ n {ls} {as : Sets n ls} {r} {b : Set r} → as ⇉ b → (Product n as → b) uncurryₙ 0 f = const f uncurryₙ 1 f = f uncurryₙ (suc n@(suc _)) f = uncurry (uncurryₙ n ∘′ f) -- Variants for Product⊤ curry⊤ₙ : ∀ n {ls} {as : Sets n ls} {r} {b : Set r} → (Product⊤ n as → b) → as ⇉ b curry⊤ₙ zero f = f _ curry⊤ₙ (suc n) f = curry⊤ₙ n ∘′ curry f uncurry⊤ₙ : ∀ n {ls} {as : Sets n ls} {r} {b : Set r} → as ⇉ b → (Product⊤ n as → b) uncurry⊤ₙ zero f = const f uncurry⊤ₙ (suc n) f = uncurry (uncurry⊤ₙ n ∘′ f) ------------------------------------------------------------------------ -- decidability Product⊤-dec : ∀ n {ls} {as : Sets n ls} → Product⊤ n (Dec <$> as) → Dec (Product⊤ n as) Product⊤-dec zero _ = yes _ Product⊤-dec (suc n) (p? , ps?) = p? ×-dec Product⊤-dec n ps? Product-dec : ∀ n {ls} {as : Sets n ls} → Product n (Dec <$> as) → Dec (Product n as) Product-dec 0 _ = yes _ Product-dec 1 p? = p? Product-dec (suc n@(suc _)) (p? , ps?) = p? ×-dec Product-dec n ps? ------------------------------------------------------------------------ -- pointwise liftings toEqualₙ : ∀ n {ls} {as : Sets n ls} {l r : Product n as} → l ≡ r → Product n (Equalₙ n l r) toEqualₙ 0 eq = _ toEqualₙ 1 eq = eq toEqualₙ (suc n@(suc _)) eq = Prod.map₂ (toEqualₙ n) (Prodₚ.,-injective eq) fromEqualₙ : ∀ n {ls} {as : Sets n ls} {l r : Product n as} → Product n (Equalₙ n l r) → l ≡ r fromEqualₙ 0 eq = refl fromEqualₙ 1 eq = eq fromEqualₙ (suc n@(suc _)) eq = uncurry (cong₂ _,_) (Prod.map₂ (fromEqualₙ n) eq) ------------------------------------------------------------------------ -- projection of the k-th component -- To know at which Set level the k-th projection out of an n-ary product -- lives, we need to extract said level, by induction on k. Levelₙ : ∀ {n} → Levels n → Fin n → Level Levelₙ (l , _) zero = l Levelₙ (_ , ls) (suc k) = Levelₙ ls k -- Once we have the Sets used in the product, we can extract the one we -- are interested in, once more by induction on k. Projₙ : ∀ {n ls} → Sets n ls → ∀ k → Set (Levelₙ ls k) Projₙ (a , _) zero = a Projₙ (_ , as) (suc k) = Projₙ as k -- Finally, provided a Product of these sets, we can extract the k-th value. -- `projₙ` takes both `n` and `k` explicitly because we expect the user will -- be using a concrete `k` (potentially manufactured using `Data.Fin`'s `#_`) -- and it will not be possible to infer `n` from it. projₙ : ∀ n {ls} {as : Sets n ls} k → Product n as → Projₙ as k projₙ 1 zero v = v projₙ (suc n@(suc _)) zero (v , _) = v projₙ (suc n@(suc _)) (suc k) (_ , vs) = projₙ n k vs projₙ 1 (suc ()) v ------------------------------------------------------------------------ -- removal of the k-th component Levelₙ⁻ : ∀ {n} → Levels n → Fin n → Levels (pred n) Levelₙ⁻ (_ , ls) zero = ls Levelₙ⁻ {suc (suc _)} (l , ls) (suc k) = l , Levelₙ⁻ ls k Levelₙ⁻ {1} _ (suc ()) Removeₙ : ∀ {n ls} → Sets n ls → ∀ k → Sets (pred n) (Levelₙ⁻ ls k) Removeₙ (_ , as) zero = as Removeₙ {suc (suc _)} (a , as) (suc k) = a , Removeₙ as k Removeₙ {1} _ (suc ()) removeₙ : ∀ n {ls} {as : Sets n ls} k → Product n as → Product (pred n) (Removeₙ as k) removeₙ (suc zero) zero _ = _ removeₙ (suc (suc _)) zero (_ , vs) = vs removeₙ (suc (suc zero)) (suc k) (v , _) = v removeₙ (suc (suc (suc _))) (suc k) (v , vs) = v , removeₙ _ k vs removeₙ (suc zero) (suc ()) _ ------------------------------------------------------------------------ -- insertion of a k-th component Levelₙ⁺ : ∀ {n} → Levels n → Fin (suc n) → Level → Levels (suc n) Levelₙ⁺ ls zero l⁺ = l⁺ , ls Levelₙ⁺ {suc _} (l , ls) (suc k) l⁺ = l , Levelₙ⁺ ls k l⁺ Levelₙ⁺ {0} _ (suc ()) Insertₙ : ∀ {n ls l⁺} → Sets n ls → ∀ k (a⁺ : Set l⁺) → Sets (suc n) (Levelₙ⁺ ls k l⁺) Insertₙ as zero a⁺ = a⁺ , as Insertₙ {suc _} (a , as) (suc k) a⁺ = a , Insertₙ as k a⁺ Insertₙ {zero} _ (suc ()) _ insertₙ : ∀ n {ls l⁺} {as : Sets n ls} {a⁺ : Set l⁺} k (v⁺ : a⁺) → Product n as → Product (suc n) (Insertₙ as k a⁺) insertₙ 0 zero v⁺ vs = v⁺ insertₙ (suc n) zero v⁺ vs = v⁺ , vs insertₙ 1 (suc k) v⁺ vs = vs , insertₙ 0 k v⁺ _ insertₙ (suc (suc n)) (suc k) v⁺ (v , vs) = v , insertₙ _ k v⁺ vs insertₙ 0 (suc ()) _ _ ------------------------------------------------------------------------ -- update of a k-th component Levelₙᵘ : ∀ {n} → Levels n → Fin n → Level → Levels n Levelₙᵘ (_ , ls) zero lᵘ = lᵘ , ls Levelₙᵘ (l , ls) (suc k) lᵘ = l , Levelₙᵘ ls k lᵘ Updateₙ : ∀ {n ls lᵘ} (as : Sets n ls) k (aᵘ : Set lᵘ) → Sets n (Levelₙᵘ ls k lᵘ) Updateₙ (_ , as) zero aᵘ = aᵘ , as Updateₙ (a , as) (suc k) aᵘ = a , Updateₙ as k aᵘ updateₙ : ∀ n {ls lᵘ} {as : Sets n ls} k {aᵘ : _ → Set lᵘ} (f : ∀ v → aᵘ v) (vs : Product n as) → Product n (Updateₙ as k (aᵘ (projₙ n k vs))) updateₙ 1 zero f v = f v updateₙ (suc (suc _)) zero f (v , vs) = f v , vs updateₙ (suc (suc _)) (suc k) f (v , vs) = v , updateₙ _ k f vs updateₙ 1 (suc ()) _ _ updateₙ′ : ∀ n {ls lᵘ} {as : Sets n ls} k {aᵘ : Set lᵘ} (f : Projₙ as k → aᵘ) → Product n as → Product n (Updateₙ as k aᵘ) updateₙ′ n k = updateₙ n k agda-stdlib-1.7.3/src/Data/Product/Properties.agda000066400000000000000000000100621451211343400217240ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of products ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Properties where open import Axiom.UniquenessOfIdentityProofs open import Data.Product open import Function open import Level using (Level) open import Relation.Binary using (DecidableEquality) open import Relation.Binary.PropositionalEquality open import Relation.Nullary.Product import Relation.Nullary.Decidable as Dec open import Relation.Nullary using (Dec; yes; no) private variable a b ℓ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Equality (dependent) module _ {B : A → Set b} where ,-injectiveˡ : ∀ {a c} {b : B a} {d : B c} → (a , b) ≡ (c , d) → a ≡ c ,-injectiveˡ refl = refl ,-injectiveʳ-≡ : ∀ {a b} {c : B a} {d : B b} → UIP A → (a , c) ≡ (b , d) → (q : a ≡ b) → subst B q c ≡ d ,-injectiveʳ-≡ {c = c} u refl q = cong (λ x → subst B x c) (u q refl) ,-injectiveʳ-UIP : ∀ {a} {b c : B a} → UIP A → (Σ A B ∋ (a , b)) ≡ (a , c) → b ≡ c ,-injectiveʳ-UIP u p = ,-injectiveʳ-≡ u p refl ≡-dec : DecidableEquality A → (∀ {a} → DecidableEquality (B a)) → DecidableEquality (Σ A B) ≡-dec dec₁ dec₂ (a , x) (b , y) with dec₁ a b ... | no [a≢b] = no ([a≢b] ∘ ,-injectiveˡ) ... | yes refl = Dec.map′ (cong (a ,_)) (,-injectiveʳ-UIP (Decidable⇒UIP.≡-irrelevant dec₁)) (dec₂ x y) ------------------------------------------------------------------------ -- Equality (non-dependent) ,-injectiveʳ : ∀ {a c : A} {b d : B} → (a , b) ≡ (c , d) → b ≡ d ,-injectiveʳ refl = refl ,-injective : ∀ {a c : A} {b d : B} → (a , b) ≡ (c , d) → a ≡ c × b ≡ d ,-injective refl = refl , refl -- The following properties are definitionally true (because of η) -- but for symmetry with ⊎ it is convenient to define and name them. swap-involutive : swap {A = A} {B = B} ∘ swap ≗ id swap-involutive _ = refl ------------------------------------------------------------------------ -- Equality between pairs can be expressed as a pair of equalities Σ-≡,≡↔≡ : {A : Set a} {B : A → Set b} {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : Σ A B} → (∃ λ (p : a₁ ≡ a₂) → subst B p b₁ ≡ b₂) ↔ (p₁ ≡ p₂) Σ-≡,≡↔≡ {A = A} {B = B} = mk↔ {f = to} (right-inverse-of , left-inverse-of) where to : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : Σ A B} → Σ (a₁ ≡ a₂) (λ p → subst B p b₁ ≡ b₂) → p₁ ≡ p₂ to (refl , refl) = refl from : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : Σ A B} → p₁ ≡ p₂ → Σ (a₁ ≡ a₂) (λ p → subst B p b₁ ≡ b₂) from refl = refl , refl left-inverse-of : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : Σ A B} → (p : Σ (a₁ ≡ a₂) (λ x → subst B x b₁ ≡ b₂)) → from (to p) ≡ p left-inverse-of (refl , refl) = refl right-inverse-of : {p₁ p₂ : Σ A B} (p : p₁ ≡ p₂) → to (from p) ≡ p right-inverse-of refl = refl -- the non-dependent case. Proofs are exactly as above, and straightforward. ×-≡,≡↔≡ : {p₁@(a₁ , b₁) p₂@(a₂ , b₂) : A × B} → (a₁ ≡ a₂ × b₁ ≡ b₂) ↔ p₁ ≡ p₂ ×-≡,≡↔≡ = mk↔′ (λ {(refl , refl) → refl}) (λ { refl → refl , refl}) (λ {refl → refl}) (λ {(refl , refl) → refl}) ------------------------------------------------------------------------ -- The order of ∃₂ can be swapped ∃∃↔∃∃ : (R : A → B → Set ℓ) → (∃₂ λ x y → R x y) ↔ (∃₂ λ y x → R x y) ∃∃↔∃∃ R = mk↔′ to from cong′ cong′ where to : (∃₂ λ x y → R x y) → (∃₂ λ y x → R x y) to (x , y , Rxy) = (y , x , Rxy) from : (∃₂ λ y x → R x y) → (∃₂ λ x y → R x y) from (y , x , Rxy) = (x , y , Rxy) agda-stdlib-1.7.3/src/Data/Product/Properties/000077500000000000000000000000001451211343400211075ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Properties/WithK.agda000066400000000000000000000014151451211343400227540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties, related to products, that rely on the K rule ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Product.Properties.WithK where open import Data.Product open import Function open import Relation.Binary.PropositionalEquality ------------------------------------------------------------------------ -- Equality -- These exports are deprecated from v1.4 open import Data.Product.Properties using (,-injective; ≡-dec) public module _ {a b} {A : Set a} {B : A → Set b} where ,-injectiveʳ : ∀ {a} {b c : B a} → (Σ A B ∋ (a , b)) ≡ (a , c) → b ≡ c ,-injectiveʳ refl = refl agda-stdlib-1.7.3/src/Data/Product/Relation/000077500000000000000000000000001451211343400205305ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Relation/Binary/000077500000000000000000000000001451211343400217545ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Relation/Binary/Lex/000077500000000000000000000000001451211343400225045ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Product/Relation/Binary/Lex/NonStrict.agda000066400000000000000000000212631451211343400252510ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lexicographic products of binary relations ------------------------------------------------------------------------ -- The definition of lexicographic product used here is suitable if -- the left-hand relation is a (non-strict) partial order. {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Relation.Binary.Lex.NonStrict where open import Data.Product using (_×_; _,_; proj₁; proj₂) open import Data.Sum.Base using (inj₁; inj₂) open import Level using (Level) open import Relation.Binary open import Relation.Binary.Consequences import Relation.Binary.Construct.NonStrictToStrict as Conv open import Data.Product.Relation.Binary.Pointwise.NonDependent as Pointwise using (Pointwise) import Data.Product.Relation.Binary.Lex.Strict as Strict private variable a b ℓ₁ ℓ₂ ℓ₃ ℓ₄ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Definition ×-Lex : (_≈₁_ : Rel A ℓ₁) (_≤₁_ : Rel A ℓ₂) (_≤₂_ : Rel B ℓ₃) → Rel (A × B) _ ×-Lex _≈₁_ _≤₁_ _≤₂_ = Strict.×-Lex _≈₁_ (Conv._<_ _≈₁_ _≤₁_) _≤₂_ ------------------------------------------------------------------------ -- Properties ×-reflexive : (_≈₁_ : Rel A ℓ₁) (_≤₁_ : Rel A ℓ₂) {_≈₂_ : Rel B ℓ₃} (_≤₂_ : Rel B ℓ₄) → _≈₂_ ⇒ _≤₂_ → (Pointwise _≈₁_ _≈₂_) ⇒ (×-Lex _≈₁_ _≤₁_ _≤₂_) ×-reflexive _≈₁_ _≤₁_ _≤₂_ refl₂ = Strict.×-reflexive _≈₁_ (Conv._<_ _≈₁_ _≤₁_) _≤₂_ refl₂ module _ {_≈₁_ : Rel A ℓ₁} {_≤₁_ : Rel A ℓ₂} {_≤₂_ : Rel B ℓ₃} where private _≤ₗₑₓ_ = ×-Lex _≈₁_ _≤₁_ _≤₂_ ×-transitive : IsPartialOrder _≈₁_ _≤₁_ → Transitive _≤₂_ → Transitive _≤ₗₑₓ_ ×-transitive po₁ trans₂ = Strict.×-transitive {_≈₁_ = _≈₁_} {_<₂_ = _≤₂_} isEquivalence (Conv.<-resp-≈ _ _ isEquivalence ≤-resp-≈) (Conv.<-trans _ _ po₁) trans₂ where open IsPartialOrder po₁ ×-total : Symmetric _≈₁_ → Decidable _≈₁_ → Antisymmetric _≈₁_ _≤₁_ → Total _≤₁_ → Total _≤₂_ → Total _≤ₗₑₓ_ ×-total sym₁ dec₁ antisym₁ total₁ total₂ = total where tri₁ : Trichotomous _≈₁_ (Conv._<_ _≈₁_ _≤₁_) tri₁ = Conv.<-trichotomous _ _ sym₁ dec₁ antisym₁ total₁ total : Total _≤ₗₑₓ_ total x y with tri₁ (proj₁ x) (proj₁ y) ... | tri< x₁ x₁≮y₁ x₁≉y₁ x₁>y₁ = inj₂ (inj₁ x₁>y₁) ... | tri≈ x₁≮y₁ x₁≈y₁ x₁≯y₁ with total₂ (proj₂ x) (proj₂ y) ... | inj₁ x₂≤y₂ = inj₁ (inj₂ (x₁≈y₁ , x₂≤y₂)) ... | inj₂ x₂≥y₂ = inj₂ (inj₂ (sym₁ x₁≈y₁ , x₂≥y₂)) ×-decidable : Decidable _≈₁_ → Decidable _≤₁_ → Decidable _≤₂_ → Decidable _≤ₗₑₓ_ ×-decidable dec-≈₁ dec-≤₁ dec-≤₂ = Strict.×-decidable dec-≈₁ (Conv.<-decidable _ _ dec-≈₁ dec-≤₁) dec-≤₂ module _ {_≈₁_ : Rel A ℓ₁} {_≤₁_ : Rel A ℓ₂} {_≈₂_ : Rel B ℓ₃} {_≤₂_ : Rel B ℓ₄} where private _≤ₗₑₓ_ = ×-Lex _≈₁_ _≤₁_ _≤₂_ _≋_ = Pointwise _≈₁_ _≈₂_ ×-antisymmetric : IsPartialOrder _≈₁_ _≤₁_ → Antisymmetric _≈₂_ _≤₂_ → Antisymmetric _≋_ _≤ₗₑₓ_ ×-antisymmetric po₁ antisym₂ = Strict.×-antisymmetric {_≈₁_ = _≈₁_} {_<₂_ = _≤₂_} ≈-sym₁ irrefl₁ asym₁ antisym₂ where open IsPartialOrder po₁ open Eq renaming (refl to ≈-refl₁; sym to ≈-sym₁) irrefl₁ : Irreflexive _≈₁_ (Conv._<_ _≈₁_ _≤₁_) irrefl₁ = Conv.<-irrefl _≈₁_ _≤₁_ asym₁ : Asymmetric (Conv._<_ _≈₁_ _≤₁_) asym₁ = trans∧irr⇒asym {_≈_ = _≈₁_} ≈-refl₁ (Conv.<-trans _ _ po₁) irrefl₁ ×-respects₂ : IsEquivalence _≈₁_ → _≤₁_ Respects₂ _≈₁_ → _≤₂_ Respects₂ _≈₂_ → _≤ₗₑₓ_ Respects₂ _≋_ ×-respects₂ eq₁ resp₁ resp₂ = Strict.×-respects₂ eq₁ (Conv.<-resp-≈ _ _ eq₁ resp₁) resp₂ ------------------------------------------------------------------------ -- Structures ×-isPartialOrder : IsPartialOrder _≈₁_ _≤₁_ → IsPartialOrder _≈₂_ _≤₂_ → IsPartialOrder _≋_ _≤ₗₑₓ_ ×-isPartialOrder po₁ po₂ = record { isPreorder = record { isEquivalence = Pointwise.×-isEquivalence (isEquivalence po₁) (isEquivalence po₂) ; reflexive = ×-reflexive _≈₁_ _≤₁_ _≤₂_ (reflexive po₂) ; trans = ×-transitive {_≤₂_ = _≤₂_} po₁ (trans po₂) } ; antisym = ×-antisymmetric po₁ (antisym po₂) } where open IsPartialOrder ×-isTotalOrder : Decidable _≈₁_ → IsTotalOrder _≈₁_ _≤₁_ → IsTotalOrder _≈₂_ _≤₂_ → IsTotalOrder _≋_ _≤ₗₑₓ_ ×-isTotalOrder ≈₁-dec to₁ to₂ = record { isPartialOrder = ×-isPartialOrder (isPartialOrder to₁) (isPartialOrder to₂) ; total = ×-total (Eq.sym to₁) ≈₁-dec (antisym to₁) (total to₁) (total to₂) } where open IsTotalOrder ×-isDecTotalOrder : IsDecTotalOrder _≈₁_ _≤₁_ → IsDecTotalOrder _≈₂_ _≤₂_ → IsDecTotalOrder _≋_ _≤ₗₑₓ_ ×-isDecTotalOrder to₁ to₂ = record { isTotalOrder = ×-isTotalOrder (_≟_ to₁) (isTotalOrder to₁) (isTotalOrder to₂) ; _≟_ = Pointwise.×-decidable (_≟_ to₁) (_≟_ to₂) ; _≤?_ = ×-decidable (_≟_ to₁) (_≤?_ to₁) (_≤?_ to₂) } where open IsDecTotalOrder ------------------------------------------------------------------------ -- Bundles ×-poset : Poset a ℓ₁ ℓ₂ → Poset b ℓ₃ ℓ₄ → Poset _ _ _ ×-poset p₁ p₂ = record { isPartialOrder = ×-isPartialOrder O₁.isPartialOrder O₂.isPartialOrder } where module O₁ = Poset p₁; module O₂ = Poset p₂ ×-totalOrder : DecTotalOrder a ℓ₁ ℓ₂ → TotalOrder b ℓ₃ ℓ₄ → TotalOrder _ _ _ ×-totalOrder t₁ t₂ = record { isTotalOrder = ×-isTotalOrder T₁._≟_ T₁.isTotalOrder T₂.isTotalOrder } where module T₁ = DecTotalOrder t₁; module T₂ = TotalOrder t₂ ×-decTotalOrder : DecTotalOrder a ℓ₁ ℓ₂ → DecTotalOrder b ℓ₃ ℓ₄ → DecTotalOrder _ _ _ ×-decTotalOrder t₁ t₂ = record { isDecTotalOrder = ×-isDecTotalOrder O₁.isDecTotalOrder O₂.isDecTotalOrder } where module O₁ = DecTotalOrder t₁; module O₂ = DecTotalOrder t₂ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 0.15 _×-isPartialOrder_ = ×-isPartialOrder {-# WARNING_ON_USAGE _×-isPartialOrder_ "Warning: _×-isPartialOrder_ was deprecated in v0.15. Please use ×-isPartialOrder instead." #-} _×-isDecTotalOrder_ = ×-isDecTotalOrder {-# WARNING_ON_USAGE _×-isDecTotalOrder_ "Warning: _×-isDecTotalOrder_ was deprecated in v0.15. Please use ×-isDecTotalOrder instead." #-} _×-poset_ = ×-poset {-# WARNING_ON_USAGE _×-poset_ "Warning: _×-poset_ was deprecated in v0.15. Please use ×-poset instead." #-} _×-totalOrder_ = ×-totalOrder {-# WARNING_ON_USAGE _×-totalOrder_ "Warning: _×-totalOrder_ was deprecated in v0.15. Please use ×-totalOrder instead." #-} _×-decTotalOrder_ = ×-decTotalOrder {-# WARNING_ON_USAGE _×-decTotalOrder_ "Warning: _×-decTotalOrder_ was deprecated in v0.15. Please use ×-decTotalOrder instead." #-} ×-≈-respects₂ = ×-respects₂ {-# WARNING_ON_USAGE ×-≈-respects₂ "Warning: ×-≈-respects₂ was deprecated in v0.15. Please use ×-respects₂ instead." #-} agda-stdlib-1.7.3/src/Data/Product/Relation/Binary/Lex/Strict.agda000066400000000000000000000341071451211343400245770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lexicographic products of binary relations ------------------------------------------------------------------------ -- The definition of lexicographic product used here is suitable if -- the left-hand relation is a strict partial order. {-# OPTIONS --cubical-compatible --safe #-} module Data.Product.Relation.Binary.Lex.Strict where open import Data.Product open import Data.Product.Relation.Binary.Pointwise.NonDependent as Pointwise using (Pointwise) open import Data.Sum.Base using (inj₁; inj₂; _-⊎-_; [_,_]) open import Data.Empty open import Function.Base open import Induction.WellFounded open import Level open import Relation.Nullary open import Relation.Nullary.Product open import Relation.Nullary.Sum open import Relation.Binary open import Relation.Binary.Consequences open import Relation.Binary.PropositionalEquality using (_≡_; refl) private variable a b ℓ₁ ℓ₂ ℓ₃ ℓ₄ : Level A : Set a B : Set b ------------------------------------------------------------------------ -- A lexicographic ordering over products ×-Lex : (_≈₁_ : Rel A ℓ₁) (_<₁_ : Rel A ℓ₂) (_≤₂_ : Rel B ℓ₃) → Rel (A × B) _ ×-Lex _≈₁_ _<₁_ _≤₂_ = (_<₁_ on proj₁) -⊎- (_≈₁_ on proj₁) -×- (_≤₂_ on proj₂) ------------------------------------------------------------------------ -- Some properties which are preserved by ×-Lex (under certain -- assumptions). ×-reflexive : (_≈₁_ : Rel A ℓ₁) (_∼₁_ : Rel A ℓ₂) {_≈₂_ : Rel B ℓ₃} (_≤₂_ : Rel B ℓ₄) → _≈₂_ ⇒ _≤₂_ → (Pointwise _≈₁_ _≈₂_) ⇒ (×-Lex _≈₁_ _∼₁_ _≤₂_) ×-reflexive _ _ _ refl₂ = λ x≈y → inj₂ (proj₁ x≈y , refl₂ (proj₂ x≈y)) module _ {_≈₁_ : Rel A ℓ₁} {_<₁_ : Rel A ℓ₂} {_<₂_ : Rel B ℓ₃} where private _<ₗₑₓ_ = ×-Lex _≈₁_ _<₁_ _<₂_ ×-transitive : IsEquivalence _≈₁_ → _<₁_ Respects₂ _≈₁_ → Transitive _<₁_ → Transitive _<₂_ → Transitive _<ₗₑₓ_ ×-transitive eq₁ resp₁ trans₁ trans₂ = trans where module Eq₁ = IsEquivalence eq₁ trans : Transitive _<ₗₑₓ_ trans (inj₁ x₁y₁ = inj₂ (inj₁ x₁>y₁) ×-total₂ : Symmetric _≈₁_ → Trichotomous _≈₁_ _<₁_ → Total _<₂_ → Total _<ₗₑₓ_ ×-total₂ sym tri₁ total₂ x y with tri₁ (proj₁ x) (proj₁ y) ... | tri< x₁ _ _ y₁ x₁≮y₁ x₁≉y₁ x₁>y₁) = tri> [ x₁≮y₁ , x₁≉y₁ ∘ proj₁ ] (x₁≉y₁ ∘ proj₁) (inj₁ x₁>y₁) ... | (tri≈ x₁≮y₁ x₁≈y₁ x₁≯y₁) with cmp₂ x₂ y₂ ... | (tri< x₂ x₂≮y₂ x₂≉y₂ x₂>y₂) = tri> [ x₁≮y₁ , x₂≮y₂ ∘ proj₂ ] (x₂≉y₂ ∘ proj₂) (inj₂ (sym₁ x₁≈y₁ , x₂>y₂)) ... | (tri≈ x₂≮y₂ x₂≈y₂ x₂≯y₂) = tri≈ [ x₁≮y₁ , x₂≮y₂ ∘ proj₂ ] (x₁≈y₁ , x₂≈y₂) [ x₁≯y₁ , x₂≯y₂ ∘ proj₂ ] module _ {_<₁_ : Rel A ℓ₁} {_<₂_ : Rel B ℓ₂} where -- Currently only proven for propositional equality -- (unsure how to satisfy the termination checker for arbitrary equalities) private _<ₗₑₓ_ = ×-Lex _≡_ _<₁_ _<₂_ ×-wellFounded : WellFounded _<₁_ → WellFounded _<₂_ → WellFounded _<ₗₑₓ_ ×-wellFounded wf₁ wf₂ (x , y) = acc (×-acc (wf₁ x) (wf₂ y)) where ×-acc : ∀ {x y} → Acc _<₁_ x → Acc _<₂_ y → WfRec _<ₗₑₓ_ (Acc _<ₗₑₓ_) (x , y) ×-acc (acc rec₁) acc₂ (u , v) (inj₁ u_ _≰_ _≱_ _≮_ _≯_ data _≤_ : Rel ℚ 0ℓ where *≤* : ∀ {p q} → (↥ p ℤ.* ↧ q) ℤ.≤ (↥ q ℤ.* ↧ p) → p ≤ q data _<_ : Rel ℚ 0ℓ where *<* : ∀ {p q} → (↥ p ℤ.* ↧ q) ℤ.< (↥ q ℤ.* ↧ p) → p < q _≥_ : Rel ℚ 0ℓ x ≥ y = y ≤ x _>_ : Rel ℚ 0ℓ x > y = y < x _≰_ : Rel ℚ 0ℓ x ≰ y = ¬ (x ≤ y) _≱_ : Rel ℚ 0ℓ x ≱ y = ¬ (x ≥ y) _≮_ : Rel ℚ 0ℓ x ≮ y = ¬ (x < y) _≯_ : Rel ℚ 0ℓ x ≯ y = ¬ (x > y) ------------------------------------------------------------------------ -- Boolean ordering infix 4 _≤ᵇ_ _≤ᵇ_ : ℚ → ℚ → Bool p ≤ᵇ q = (↥ p ℤ.* ↧ q) ℤ.≤ᵇ (↥ q ℤ.* ↧ p) ------------------------------------------------------------------------ -- Negation -_ : ℚ → ℚ - mkℚ -[1+ n ] d prf = mkℚ +[1+ n ] d prf - mkℚ +0 d prf = mkℚ +0 d prf - mkℚ +[1+ n ] d prf = mkℚ -[1+ n ] d prf ------------------------------------------------------------------------ -- Constructing rationals -- A constructor for ℚ that takes two natural numbers, say 6 and 21, -- and returns them in a normalized form, e.g. say 2 and 7 normalize : ∀ (m n : ℕ) {n≢0 : n ≢0} → ℚ normalize m n {n≢0} = mkℚ+ (m ℕ./ gcd m n) (n ℕ./ gcd m n) {n/g≢0} (coprime-/gcd m n {g≢0}) where g≢0 = fromWitnessFalse (gcd[m,n]≢0 m n (inj₂ (toWitnessFalse n≢0))) n/g≢0 = fromWitnessFalse (n/gcd[m,n]≢0 m n {n≢0} {g≢0}) -- A constructor for ℚ that (unlike mkℚ) automatically normalises it's -- arguments. See the constants section below for how to use this operator. infixl 7 _/_ _/_ : (n : ℤ) (d : ℕ) → {d≢0 : d ≢0} → ℚ (+ n / d) {d≢0} = normalize n d {d≢0} (-[1+ n ] / d) {d≢0} = - normalize (suc n) d {d≢0} ------------------------------------------------------------------------ -- Conversion to and from unnormalized rationals toℚᵘ : ℚ → ℚᵘ toℚᵘ (mkℚ n d-1 _) = mkℚᵘ n d-1 fromℚᵘ : ℚᵘ → ℚ fromℚᵘ (mkℚᵘ n d-1) = n / suc d-1 ------------------------------------------------------------------------------ -- Some constants 0ℚ : ℚ 0ℚ = + 0 / 1 1ℚ : ℚ 1ℚ = + 1 / 1 ½ : ℚ ½ = + 1 / 2 -½ : ℚ -½ = - ½ ------------------------------------------------------------------------ -- Simple predicates NonZero : Pred ℚ 0ℓ NonZero p = ℚᵘ.NonZero (toℚᵘ p) Positive : Pred ℚ 0ℓ Positive p = ℚᵘ.Positive (toℚᵘ p) Negative : Pred ℚ 0ℓ Negative p = ℚᵘ.Negative (toℚᵘ p) NonPositive : Pred ℚ 0ℓ NonPositive p = ℚᵘ.NonPositive (toℚᵘ p) NonNegative : Pred ℚ 0ℓ NonNegative p = ℚᵘ.NonNegative (toℚᵘ p) -- Constructors ≢-nonZero : ∀ {p} → p ≢ 0ℚ → NonZero p ≢-nonZero {mkℚ -[1+ _ ] _ _} _ = _ ≢-nonZero {mkℚ +[1+ _ ] _ _} _ = _ ≢-nonZero {mkℚ +0 zero _} p≢0 = p≢0 refl ≢-nonZero {mkℚ +0 (suc d) c} p≢0 = ¬0-coprimeTo-2+ (C.recompute c) >-nonZero : ∀ {p} → p > 0ℚ → NonZero p >-nonZero {p} (*<* p-nonZero {toℚᵘ p} (ℚᵘ.*<* p 0ℚ → Positive p positive {p} (*<* p : _≰_ ⇒ _>_ ≰⇒> {p} {q} p≰q = *<* (ℤ.≰⇒> (p≰q ∘ *≤*)) <⇒≢ : _<_ ⇒ _≢_ <⇒≢ {p} {q} (*<* p ≮ ≢ > = tri> (≮ ∘ drop-*<*) (≢ ∘ ≡⇒≃) (*<* >) <-irrelevant : Irrelevant _<_ <-irrelevant (*<* p 0ℚ positive⁻¹ p>0 = toℚᵘ-cancel-< (ℚᵘ.positive⁻¹ p>0) nonNegative⁻¹ : NonNegative p → p ≥ 0ℚ nonNegative⁻¹ p≥0 = toℚᵘ-cancel-≤ (ℚᵘ.nonNegative⁻¹ p≥0) negative⁻¹ : Negative p → p < 0ℚ negative⁻¹ p<0 = toℚᵘ-cancel-< (ℚᵘ.negative⁻¹ p<0) nonPositive⁻¹ : NonPositive p → p ≤ 0ℚ nonPositive⁻¹ p≤0 = toℚᵘ-cancel-≤ (ℚᵘ.nonPositive⁻¹ p≤0) negative0 = toℚᵘ-cancel-< (ℚᵘ.negative0) ------------------------------------------------------------------------ -- Properties of -_ and _≤_/_<_ neg-antimono-< : -_ Preserves _<_ ⟶ _>_ neg-antimono-< {mkℚ -[1+ _ ] _ _} {mkℚ -[1+ _ ] _ _} (*<* (ℤ.-<- n0 {p} {q} pr≤qr = toℚᵘ-cancel-≤ (ℚᵘ.*-cancelʳ-≤-pos {toℚᵘ r} r>0 (begin toℚᵘ p ℚᵘ.* toℚᵘ r ≈˘⟨ toℚᵘ-homo-* p r ⟩ toℚᵘ (p * r) ≤⟨ toℚᵘ-mono-≤ pr≤qr ⟩ toℚᵘ (q * r) ≈⟨ toℚᵘ-homo-* q r ⟩ toℚᵘ q ℚᵘ.* toℚᵘ r ∎)) where open ℚᵘ.≤-Reasoning *-cancelˡ-≤-pos : ∀ r → Positive r → ∀ {p q} → r * p ≤ r * q → p ≤ q *-cancelˡ-≤-pos r r>0 {p} {q} rp≤rq = toℚᵘ-cancel-≤ (ℚᵘ.*-cancelˡ-≤-pos {toℚᵘ r} r>0 (begin toℚᵘ r ℚᵘ.* toℚᵘ p ≈˘⟨ toℚᵘ-homo-* r p ⟩ toℚᵘ (r * p) ≤⟨ toℚᵘ-mono-≤ rp≤rq ⟩ toℚᵘ (r * q) ≈⟨ toℚᵘ-homo-* r q ⟩ toℚᵘ r ℚᵘ.* toℚᵘ q ∎)) where open ℚᵘ.≤-Reasoning *-monoʳ-≤-nonNeg : ∀ r → NonNegative r → (_* r) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-nonNeg r r≥0 {p} {q} p≤q = toℚᵘ-cancel-≤ (begin toℚᵘ (p * r) ≈⟨ toℚᵘ-homo-* p r ⟩ toℚᵘ p ℚᵘ.* toℚᵘ r ≤⟨ ℚᵘ.*-monoˡ-≤-nonNeg r≥0 (toℚᵘ-mono-≤ p≤q) ⟩ toℚᵘ q ℚᵘ.* toℚᵘ r ≈˘⟨ toℚᵘ-homo-* q r ⟩ toℚᵘ (q * r) ∎) where open ℚᵘ.≤-Reasoning *-monoˡ-≤-nonNeg : ∀ r → NonNegative r → (r *_) Preserves _≤_ ⟶ _≤_ *-monoˡ-≤-nonNeg r r≥0 {p} {q} p≤q = toℚᵘ-cancel-≤ (begin toℚᵘ (r * p) ≈⟨ toℚᵘ-homo-* r p ⟩ toℚᵘ r ℚᵘ.* toℚᵘ p ≤⟨ ℚᵘ.*-monoʳ-≤-nonNeg {toℚᵘ r} r≥0 (toℚᵘ-mono-≤ p≤q) ⟩ toℚᵘ r ℚᵘ.* toℚᵘ q ≈˘⟨ toℚᵘ-homo-* r q ⟩ toℚᵘ (r * q) ∎) where open ℚᵘ.≤-Reasoning *-monoʳ-≤-pos : ∀ r → Positive r → (_* r) Preserves _≤_ ⟶ _≤_ *-monoʳ-≤-pos r = *-monoʳ-≤-nonNeg r ∘ pos⇒nonNeg r *-monoˡ-≤-pos : ∀ r → Positive r → (r *_) Preserves _≤_ ⟶ _≤_ *-monoˡ-≤-pos r = *-monoˡ-≤-nonNeg r ∘ pos⇒nonNeg r *-monoʳ-≤-nonPos : ∀ r → NonPositive r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-nonPos r r≤0 {p} {q} p≤q = toℚᵘ-cancel-≤ (begin toℚᵘ (q * r) ≈⟨ toℚᵘ-homo-* q r ⟩ toℚᵘ q ℚᵘ.* toℚᵘ r ≤⟨ ℚᵘ.*-monoˡ-≤-nonPos (toℚᵘ r) r≤0 (toℚᵘ-mono-≤ p≤q) ⟩ toℚᵘ p ℚᵘ.* toℚᵘ r ≈˘⟨ toℚᵘ-homo-* p r ⟩ toℚᵘ (p * r) ∎) where open ℚᵘ.≤-Reasoning *-monoˡ-≤-nonPos : ∀ r → NonPositive r → (r *_) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-nonPos r r≤0 {p} {q} p≤q = toℚᵘ-cancel-≤ (begin toℚᵘ (r * q) ≈⟨ toℚᵘ-homo-* r q ⟩ toℚᵘ r ℚᵘ.* toℚᵘ q ≤⟨ ℚᵘ.*-monoʳ-≤-nonPos (toℚᵘ r) r≤0 (toℚᵘ-mono-≤ p≤q) ⟩ toℚᵘ r ℚᵘ.* toℚᵘ p ≈˘⟨ toℚᵘ-homo-* r p ⟩ toℚᵘ (r * p) ∎) where open ℚᵘ.≤-Reasoning *-monoʳ-≤-neg : ∀ r → Negative r → (_* r) Preserves _≤_ ⟶ _≥_ *-monoʳ-≤-neg r = *-monoʳ-≤-nonPos r ∘ ℚᵘ.negative⇒nonPositive {toℚᵘ r} *-monoˡ-≤-neg : ∀ r → Negative r → (r *_) Preserves _≤_ ⟶ _≥_ *-monoˡ-≤-neg r = *-monoˡ-≤-nonPos r ∘ ℚᵘ.negative⇒nonPositive {toℚᵘ r} *-cancelʳ-≤-neg : ∀ r → Negative r → ∀ {p q} → p * r ≤ q * r → p ≥ q *-cancelʳ-≤-neg r r≤0 {p} {q} pr≤qr = toℚᵘ-cancel-≤ (ℚᵘ.*-cancelʳ-≤-neg _ r≤0 (begin toℚᵘ p ℚᵘ.* toℚᵘ r ≈˘⟨ toℚᵘ-homo-* p r ⟩ toℚᵘ (p * r) ≤⟨ toℚᵘ-mono-≤ pr≤qr ⟩ toℚᵘ (q * r) ≈⟨ toℚᵘ-homo-* q r ⟩ toℚᵘ q ℚᵘ.* toℚᵘ r ∎)) where open ℚᵘ.≤-Reasoning *-cancelˡ-≤-neg : ∀ r → Negative r → ∀ {p q} → r * p ≤ r * q → p ≥ q *-cancelˡ-≤-neg r r≤0 {p} {q} rp≤rq = toℚᵘ-cancel-≤ (ℚᵘ.*-cancelˡ-≤-neg (toℚᵘ r) r≤0 (begin toℚᵘ r ℚᵘ.* toℚᵘ p ≈˘⟨ toℚᵘ-homo-* r p ⟩ toℚᵘ (r * p) ≤⟨ toℚᵘ-mono-≤ rp≤rq ⟩ toℚᵘ (r * q) ≈⟨ toℚᵘ-homo-* r q ⟩ toℚᵘ r ℚᵘ.* toℚᵘ q ∎)) where open ℚᵘ.≤-Reasoning ------------------------------------------------------------------------ -- Properties of _*_ and _<_ *-monoˡ-<-pos : ∀ r → Positive r → (_* r) Preserves _<_ ⟶ _<_ *-monoˡ-<-pos r r>0 {p} {q} p0 (toℚᵘ-mono-< p0 {p} {q} p0 (toℚᵘ-mono-< p_ *-monoˡ-<-neg r r<0 {p} {q} p_ *-monoʳ-<-neg r r<0 {p} {q} p q *-cancelˡ-<-nonPos r r≤0 {p} {q} rp q *-cancelʳ-<-nonPos r r≤0 {p} {q} pr q *-cancelˡ-<-neg r = *-cancelˡ-<-nonPos r ∘ neg⇒nonPos r *-cancelʳ-<-neg : ∀ r → Negative r → ∀ {p q} → p * r < q * r → p > q *-cancelʳ-<-neg r = *-cancelʳ-<-nonPos r ∘ neg⇒nonPos r ------------------------------------------------------------------------ -- Properties of _⊓_ ------------------------------------------------------------------------ p≤q⇒p⊔q≡q : p ≤ q → p ⊔ q ≡ q p≤q⇒p⊔q≡q {p} {q} p≤q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | _ = refl ... | false | [ p≰q ] = contradiction (≤⇒≤ᵇ p≤q) (subst (¬_ ∘ T) (sym p≰q) λ()) p≥q⇒p⊔q≡p : p ≥ q → p ⊔ q ≡ p p≥q⇒p⊔q≡p {p} {q} p≥q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | [ p≤q ] = ≤-antisym p≥q (≤ᵇ⇒≤ (subst T (sym p≤q) _)) ... | false | [ p≤q ] = refl p≤q⇒p⊓q≡p : p ≤ q → p ⊓ q ≡ p p≤q⇒p⊓q≡p {p} {q} p≤q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | _ = refl ... | false | [ p≰q ] = contradiction (≤⇒≤ᵇ p≤q) (subst (¬_ ∘ T) (sym p≰q) λ()) p≥q⇒p⊓q≡q : p ≥ q → p ⊓ q ≡ q p≥q⇒p⊓q≡q {p} {q} p≥q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | [ p≤q ] = ≤-antisym (≤ᵇ⇒≤ (subst T (sym p≤q) _)) p≥q ... | false | [ p≤q ] = refl ⊓-operator : MinOperator ≤-totalPreorder ⊓-operator = record { x≤y⇒x⊓y≈x = p≤q⇒p⊓q≡p ; x≥y⇒x⊓y≈y = p≥q⇒p⊓q≡q } ⊔-operator : MaxOperator ≤-totalPreorder ⊔-operator = record { x≤y⇒x⊔y≈y = p≤q⇒p⊔q≡q ; x≥y⇒x⊔y≈x = p≥q⇒p⊔q≡p } ------------------------------------------------------------------------ -- Automatically derived properties of _⊓_ and _⊔_ private module ⊓-⊔-properties = MinMaxOp ⊓-operator ⊔-operator open ⊓-⊔-properties public using ( ⊓-idem -- : Idempotent _⊓_ ; ⊓-sel -- : Selective _⊓_ ; ⊓-assoc -- : Associative _⊓_ ; ⊓-comm -- : Commutative _⊓_ ; ⊔-idem -- : Idempotent _⊔_ ; ⊔-sel -- : Selective _⊔_ ; ⊔-assoc -- : Associative _⊔_ ; ⊔-comm -- : Commutative _⊔_ ; ⊓-distribˡ-⊔ -- : _⊓_ DistributesOverˡ _⊔_ ; ⊓-distribʳ-⊔ -- : _⊓_ DistributesOverʳ _⊔_ ; ⊓-distrib-⊔ -- : _⊓_ DistributesOver _⊔_ ; ⊔-distribˡ-⊓ -- : _⊔_ DistributesOverˡ _⊓_ ; ⊔-distribʳ-⊓ -- : _⊔_ DistributesOverʳ _⊓_ ; ⊔-distrib-⊓ -- : _⊔_ DistributesOver _⊓_ ; ⊓-absorbs-⊔ -- : _⊓_ Absorbs _⊔_ ; ⊔-absorbs-⊓ -- : _⊔_ Absorbs _⊓_ ; ⊔-⊓-absorptive -- : Absorptive _⊔_ _⊓_ ; ⊓-⊔-absorptive -- : Absorptive _⊓_ _⊔_ ; ⊓-isMagma -- : IsMagma _⊓_ ; ⊓-isSemigroup -- : IsSemigroup _⊓_ ; ⊓-isCommutativeSemigroup -- : IsCommutativeSemigroup _⊓_ ; ⊓-isBand -- : IsBand _⊓_ ; ⊓-isSemilattice -- : IsSemilattice _⊓_ ; ⊓-isSelectiveMagma -- : IsSelectiveMagma _⊓_ ; ⊔-isMagma -- : IsMagma _⊔_ ; ⊔-isSemigroup -- : IsSemigroup _⊔_ ; ⊔-isCommutativeSemigroup -- : IsCommutativeSemigroup _⊔_ ; ⊔-isBand -- : IsBand _⊔_ ; ⊔-isSemilattice -- : IsSemilattice _⊔_ ; ⊔-isSelectiveMagma -- : IsSelectiveMagma _⊔_ ; ⊔-⊓-isLattice -- : IsLattice _⊔_ _⊓_ ; ⊓-⊔-isLattice -- : IsLattice _⊓_ _⊔_ ; ⊔-⊓-isDistributiveLattice -- : IsDistributiveLattice _⊔_ _⊓_ ; ⊓-⊔-isDistributiveLattice -- : IsDistributiveLattice _⊓_ _⊔_ ; ⊓-magma -- : Magma _ _ ; ⊓-semigroup -- : Semigroup _ _ ; ⊓-band -- : Band _ _ ; ⊓-commutativeSemigroup -- : CommutativeSemigroup _ _ ; ⊓-semilattice -- : Semilattice _ _ ; ⊓-selectiveMagma -- : SelectiveMagma _ _ ; ⊔-magma -- : Magma _ _ ; ⊔-semigroup -- : Semigroup _ _ ; ⊔-band -- : Band _ _ ; ⊔-commutativeSemigroup -- : CommutativeSemigroup _ _ ; ⊔-semilattice -- : Semilattice _ _ ; ⊔-selectiveMagma -- : SelectiveMagma _ _ ; ⊔-⊓-lattice -- : Lattice _ _ ; ⊓-⊔-lattice -- : Lattice _ _ ; ⊔-⊓-distributiveLattice -- : DistributiveLattice _ _ ; ⊓-⊔-distributiveLattice -- : DistributiveLattice _ _ ; ⊓-glb -- : ∀ {p q r} → p ≥ r → q ≥ r → p ⊓ q ≥ r ; ⊓-triangulate -- : ∀ p q r → p ⊓ q ⊓ r ≡ (p ⊓ q) ⊓ (q ⊓ r) ; ⊓-mono-≤ -- : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ; ⊓-monoˡ-≤ -- : ∀ p → (_⊓ p) Preserves _≤_ ⟶ _≤_ ; ⊓-monoʳ-≤ -- : ∀ p → (p ⊓_) Preserves _≤_ ⟶ _≤_ ; ⊔-lub -- : ∀ {p q r} → p ≤ r → q ≤ r → p ⊔ q ≤ r ; ⊔-triangulate -- : ∀ p q r → p ⊔ q ⊔ r ≡ (p ⊔ q) ⊔ (q ⊔ r) ; ⊔-mono-≤ -- : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ; ⊔-monoˡ-≤ -- : ∀ p → (_⊔ p) Preserves _≤_ ⟶ _≤_ ; ⊔-monoʳ-≤ -- : ∀ p → (p ⊔_) Preserves _≤_ ⟶ _≤_ ) renaming ( x⊓y≈y⇒y≤x to p⊓q≡q⇒q≤p -- : ∀ {p q} → p ⊓ q ≡ q → q ≤ p ; x⊓y≈x⇒x≤y to p⊓q≡p⇒p≤q -- : ∀ {p q} → p ⊓ q ≡ p → p ≤ q ; x⊓y≤x to p⊓q≤p -- : ∀ p q → p ⊓ q ≤ p ; x⊓y≤y to p⊓q≤q -- : ∀ p q → p ⊓ q ≤ q ; x≤y⇒x⊓z≤y to p≤q⇒p⊓r≤q -- : ∀ {p q} r → p ≤ q → p ⊓ r ≤ q ; x≤y⇒z⊓x≤y to p≤q⇒r⊓p≤q -- : ∀ {p q} r → p ≤ q → r ⊓ p ≤ q ; x≤y⊓z⇒x≤y to p≤q⊓r⇒p≤q -- : ∀ {p} q r → p ≤ q ⊓ r → p ≤ q ; x≤y⊓z⇒x≤z to p≤q⊓r⇒p≤r -- : ∀ {p} q r → p ≤ q ⊓ r → p ≤ r ; x⊔y≈y⇒x≤y to p⊔q≡q⇒p≤q -- : ∀ {p q} → p ⊔ q ≡ q → p ≤ q ; x⊔y≈x⇒y≤x to p⊔q≡p⇒q≤p -- : ∀ {p q} → p ⊔ q ≡ p → q ≤ p ; x≤x⊔y to p≤p⊔q -- : ∀ p q → p ≤ p ⊔ q ; x≤y⊔x to p≤q⊔p -- : ∀ p q → p ≤ q ⊔ p ; x≤y⇒x≤y⊔z to p≤q⇒p≤q⊔r -- : ∀ {p q} r → p ≤ q → p ≤ q ⊔ r ; x≤y⇒x≤z⊔y to p≤q⇒p≤r⊔q -- : ∀ {p q} r → p ≤ q → p ≤ r ⊔ q ; x⊔y≤z⇒x≤z to p⊔q≤r⇒p≤r -- : ∀ p q {r} → p ⊔ q ≤ r → p ≤ r ; x⊔y≤z⇒y≤z to p⊔q≤r⇒q≤r -- : ∀ p q {r} → p ⊔ q ≤ r → q ≤ r ; x⊓y≤x⊔y to p⊓q≤p⊔q -- : ∀ p q → p ⊓ q ≤ p ⊔ q ) ------------------------------------------------------------------------ -- Other properties of _⊓_ and _⊔_ mono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → ∀ p q → f (p ⊔ q) ≡ f p ⊔ f q mono-≤-distrib-⊔ {f} = ⊓-⊔-properties.mono-≤-distrib-⊔ (cong f) mono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → ∀ p q → f (p ⊓ q) ≡ f p ⊓ f q mono-≤-distrib-⊓ {f} = ⊓-⊔-properties.mono-≤-distrib-⊓ (cong f) mono-<-distrib-⊓ : ∀ {f} → f Preserves _<_ ⟶ _<_ → ∀ p q → f (p ⊓ q) ≡ f p ⊓ f q mono-<-distrib-⊓ {f} f-mono-< p q with <-cmp p q ... | tri< p p≮q p≡r p>q = begin f (p ⊓ q) ≡⟨ cong f (p≥q⇒p⊓q≡q (<⇒≤ p>q)) ⟩ f q ≡˘⟨ p≥q⇒p⊓q≡q (<⇒≤ (f-mono-< p>q)) ⟩ f p ⊓ f q ∎ where open ≡-Reasoning mono-<-distrib-⊔ : ∀ {f} → f Preserves _<_ ⟶ _<_ → ∀ p q → f (p ⊔ q) ≡ f p ⊔ f q mono-<-distrib-⊔ {f} f-mono-< p q with <-cmp p q ... | tri< p p≮q p≡r p>q = begin f (p ⊔ q) ≡⟨ cong f (p≥q⇒p⊔q≡p (<⇒≤ p>q)) ⟩ f p ≡˘⟨ p≥q⇒p⊔q≡p (<⇒≤ (f-mono-< p>q)) ⟩ f p ⊔ f q ∎ where open ≡-Reasoning antimono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → ∀ p q → f (p ⊓ q) ≡ f p ⊔ f q antimono-≤-distrib-⊓ {f} = ⊓-⊔-properties.antimono-≤-distrib-⊓ (cong f) antimono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → ∀ p q → f (p ⊔ q) ≡ f p ⊓ f q antimono-≤-distrib-⊔ {f} = ⊓-⊔-properties.antimono-≤-distrib-⊔ (cong f) ------------------------------------------------------------------------ -- Properties of _⊓_ and _*_ *-distribˡ-⊓-nonNeg : ∀ p → NonNegative p → ∀ q r → p * (q ⊓ r) ≡ (p * q) ⊓ (p * r) *-distribˡ-⊓-nonNeg p p≥0 = mono-≤-distrib-⊓ (*-monoˡ-≤-nonNeg p p≥0) *-distribʳ-⊓-nonNeg : ∀ p → NonNegative p → ∀ q r → (q ⊓ r) * p ≡ (q * p) ⊓ (r * p) *-distribʳ-⊓-nonNeg p p≥0 = mono-≤-distrib-⊓ (*-monoʳ-≤-nonNeg p p≥0) *-distribˡ-⊔-nonNeg : ∀ p → NonNegative p → ∀ q r → p * (q ⊔ r) ≡ (p * q) ⊔ (p * r) *-distribˡ-⊔-nonNeg p p≥0 = mono-≤-distrib-⊔ (*-monoˡ-≤-nonNeg p p≥0) *-distribʳ-⊔-nonNeg : ∀ p → NonNegative p → ∀ q r → (q ⊔ r) * p ≡ (q * p) ⊔ (r * p) *-distribʳ-⊔-nonNeg p p≥0 = mono-≤-distrib-⊔ (*-monoʳ-≤-nonNeg p p≥0) ------------------------------------------------------------------------ -- Properties of _⊓_, _⊔_ and _*_ *-distribˡ-⊔-nonPos : ∀ p → NonPositive p → ∀ q r → p * (q ⊔ r) ≡ (p * q) ⊓ (p * r) *-distribˡ-⊔-nonPos p p≤0 = antimono-≤-distrib-⊔ (*-monoˡ-≤-nonPos p p≤0) *-distribʳ-⊔-nonPos : ∀ p → NonPositive p → ∀ q r → (q ⊔ r) * p ≡ (q * p) ⊓ (r * p) *-distribʳ-⊔-nonPos p p≤0 = antimono-≤-distrib-⊔ (*-monoʳ-≤-nonPos p p≤0) *-distribˡ-⊓-nonPos : ∀ p → NonPositive p → ∀ q r → p * (q ⊓ r) ≡ (p * q) ⊔ (p * r) *-distribˡ-⊓-nonPos p p≤0 = antimono-≤-distrib-⊓ (*-monoˡ-≤-nonPos p p≤0) *-distribʳ-⊓-nonPos : ∀ p → NonPositive p → ∀ q r → (q ⊓ r) * p ≡ (q * p) ⊔ (r * p) *-distribʳ-⊓-nonPos p p≤0 = antimono-≤-distrib-⊓ (*-monoʳ-≤-nonPos p p≤0) ------------------------------------------------------------------------ -- Properties of 1/_ ------------------------------------------------------------------------ private pos⇒≢0 : ∀ p → Positive p → ℤ.∣ ↥ p ∣ ≢0 pos⇒≢0 p p>0 = Dec.fromWitnessFalse (contraposition ℤ.∣n∣≡0⇒n≡0 (≢-sym (ℤ.<⇒≢ (ℤ.positive⁻¹ p>0)))) neg⇒≢0 : ∀ p → Negative p → ℤ.∣ ↥ p ∣ ≢0 neg⇒≢0 p p<0 = Dec.fromWitnessFalse (contraposition ℤ.∣n∣≡0⇒n≡0 (ℤ.<⇒≢ (ℤ.negative⁻¹ p<0))) 1/p≢0 : ∀ p {p≢0} → ℤ.∣ ↥ ((1/ p) {p≢0}) ∣ ≢0 1/p≢0 (mkℚ +[1+ _ ] _ _) = _ 1/p≢0 (mkℚ -[1+ _ ] _ _) = _ 1/-involutive : ∀ p {p≢0} → (1/ (1/ p) {p≢0}) {1/p≢0 p {p≢0}} ≡ p 1/-involutive (mkℚ +[1+ n ] d-1 _) = refl 1/-involutive (mkℚ -[1+ n ] d-1 _) = refl pos⇒1/pos : ∀ p (p>0 : Positive p) → Positive ((1/ p) {pos⇒≢0 p p>0}) pos⇒1/pos (mkℚ +[1+ n ] d-1 _) _ = tt neg⇒1/neg : ∀ p (p<0 : Negative p) → Negative ((1/ p) {neg⇒≢0 p p<0}) neg⇒1/neg (mkℚ -[1+ n ] d-1 _) _ = _ 1/pos⇒pos : ∀ p {p≢0} → (1/p : Positive ((1/ p) {p≢0})) → Positive p 1/pos⇒pos p {p≢0} 1/p>0 = subst Positive (1/-involutive p {p≢0}) (pos⇒1/pos (1/ p) 1/p>0) 1/neg⇒neg : ∀ p {p≢0} → (1/p : Negative ((1/ p) {p≢0})) → Negative p 1/neg⇒neg p {p≢0} 1/p>0 = subst Negative (1/-involutive p {p≢0}) (neg⇒1/neg (1/ p) 1/p>0) ------------------------------------------------------------------------ -- Properties of ∣_∣ ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- Monomorphic to unnormalised -_ toℚᵘ-homo-∣-∣ : Homomorphic₁ toℚᵘ ∣_∣ ℚᵘ.∣_∣ toℚᵘ-homo-∣-∣ (mkℚ +[1+ _ ] _ _) = *≡* refl toℚᵘ-homo-∣-∣ (mkℚ +0 _ _) = *≡* refl toℚᵘ-homo-∣-∣ (mkℚ -[1+ _ ] _ _) = *≡* refl ------------------------------------------------------------------------ -- Properties ∣p∣≡0⇒p≡0 : ∀ p → ∣ p ∣ ≡ 0ℚ → p ≡ 0ℚ ∣p∣≡0⇒p≡0 (mkℚ +0 zero _) ∣p∣≡0 = refl 0≤∣p∣ : ∀ p → 0ℚ ≤ ∣ p ∣ 0≤∣p∣ p = *≤* (begin (↥ 0ℚ) ℤ.* (↧ ∣ p ∣) ≡⟨ ℤ.*-zeroˡ (↧ ∣ p ∣) ⟩ 0ℤ ≤⟨ ℤ.+≤+ ℕ.z≤n ⟩ ↥ ∣ p ∣ ≡˘⟨ ℤ.*-identityʳ (↥ ∣ p ∣) ⟩ ↥ ∣ p ∣ ℤ.* 1ℤ ∎) where open ℤ.≤-Reasoning 0≤p⇒∣p∣≡p : 0ℚ ≤ p → ∣ p ∣ ≡ p 0≤p⇒∣p∣≡p {p} 0≤p = toℚᵘ-injective (ℚᵘ.0≤p⇒∣p∣≃p (toℚᵘ-mono-≤ 0≤p)) ∣-p∣≡∣p∣ : ∀ p → ∣ - p ∣ ≡ ∣ p ∣ ∣-p∣≡∣p∣ (mkℚ +[1+ n ] d-1 _) = refl ∣-p∣≡∣p∣ (mkℚ (+ zero) d-1 _) = refl ∣-p∣≡∣p∣ (mkℚ -[1+ n ] d-1 _) = refl ∣p∣≡p⇒0≤p : ∀ {p} → ∣ p ∣ ≡ p → 0ℚ ≤ p ∣p∣≡p⇒0≤p {p} ∣p∣≡p = toℚᵘ-cancel-≤ (ℚᵘ.∣p∣≃p⇒0≤p (begin-equality ℚᵘ.∣ toℚᵘ p ∣ ≈⟨ ℚᵘ.≃-sym (toℚᵘ-homo-∣-∣ p) ⟩ toℚᵘ ∣ p ∣ ≡⟨ cong toℚᵘ ∣p∣≡p ⟩ toℚᵘ p ∎)) where open ℚᵘ.≤-Reasoning ∣p∣≡p∨∣p∣≡-p : ∀ p → ∣ p ∣ ≡ p ⊎ ∣ p ∣ ≡ - p ∣p∣≡p∨∣p∣≡-p (mkℚ (+ n) d-1 _) = inj₁ refl ∣p∣≡p∨∣p∣≡-p (mkℚ (-[1+ n ]) d-1 _) = inj₂ refl ∣p+q∣≤∣p∣+∣q∣ : ∀ p q → ∣ p + q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p+q∣≤∣p∣+∣q∣ p q = toℚᵘ-cancel-≤ (begin toℚᵘ ∣ p + q ∣ ≈⟨ toℚᵘ-homo-∣-∣ (p + q) ⟩ ℚᵘ.∣ toℚᵘ (p + q) ∣ ≈⟨ ℚᵘ.∣-∣-cong (toℚᵘ-homo-+ p q) ⟩ ℚᵘ.∣ toℚᵘ p ℚᵘ.+ toℚᵘ q ∣ ≤⟨ ℚᵘ.∣p+q∣≤∣p∣+∣q∣ (toℚᵘ p) (toℚᵘ q) ⟩ ℚᵘ.∣ toℚᵘ p ∣ ℚᵘ.+ ℚᵘ.∣ toℚᵘ q ∣ ≈˘⟨ ℚᵘ.+-cong (toℚᵘ-homo-∣-∣ p) (toℚᵘ-homo-∣-∣ q) ⟩ toℚᵘ ∣ p ∣ ℚᵘ.+ toℚᵘ ∣ q ∣ ≈˘⟨ toℚᵘ-homo-+ ∣ p ∣ ∣ q ∣ ⟩ toℚᵘ (∣ p ∣ + ∣ q ∣) ∎) where open ℚᵘ.≤-Reasoning ∣p-q∣≤∣p∣+∣q∣ : ∀ p q → ∣ p - q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p-q∣≤∣p∣+∣q∣ p q = begin ∣ p - q ∣ ≤⟨ ∣p+q∣≤∣p∣+∣q∣ p (- q) ⟩ ∣ p ∣ + ∣ - q ∣ ≡⟨ cong (λ h → ∣ p ∣ + h) (∣-p∣≡∣p∣ q) ⟩ ∣ p ∣ + ∣ q ∣ ∎ where open ≤-Reasoning ∣p*q∣≡∣p∣*∣q∣ : ∀ p q → ∣ p * q ∣ ≡ ∣ p ∣ * ∣ q ∣ ∣p*q∣≡∣p∣*∣q∣ p q = toℚᵘ-injective (begin-equality toℚᵘ ∣ p * q ∣ ≈⟨ toℚᵘ-homo-∣-∣ (p * q) ⟩ ℚᵘ.∣ toℚᵘ (p * q) ∣ ≈⟨ ℚᵘ.∣-∣-cong (toℚᵘ-homo-* p q) ⟩ ℚᵘ.∣ toℚᵘ p ℚᵘ.* toℚᵘ q ∣ ≈⟨ ℚᵘ.∣p*q∣≃∣p∣*∣q∣ (toℚᵘ p) (toℚᵘ q) ⟩ ℚᵘ.∣ toℚᵘ p ∣ ℚᵘ.* ℚᵘ.∣ toℚᵘ q ∣ ≈˘⟨ ℚᵘ.*-cong (toℚᵘ-homo-∣-∣ p) (toℚᵘ-homo-∣-∣ q) ⟩ toℚᵘ ∣ p ∣ ℚᵘ.* toℚᵘ ∣ q ∣ ≈˘⟨ toℚᵘ-homo-* ∣ p ∣ ∣ q ∣ ⟩ toℚᵘ (∣ p ∣ * ∣ q ∣) ∎) where open ℚᵘ.≤-Reasoning ∣-∣-nonNeg : ∀ p → NonNegative ∣ p ∣ ∣-∣-nonNeg (mkℚ +[1+ _ ] _ _) = _ ∣-∣-nonNeg (mkℚ +0 _ _) = _ ∣-∣-nonNeg (mkℚ -[1+ _ ] _ _) = _ ∣∣p∣∣≡∣p∣ : ∀ p → ∣ ∣ p ∣ ∣ ≡ ∣ p ∣ ∣∣p∣∣≡∣p∣ p = 0≤p⇒∣p∣≡p (0≤∣p∣ p) ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.0 ≤-irrelevance = ≤-irrelevant {-# WARNING_ON_USAGE ≤-irrelevance "Warning: ≤-irrelevance was deprecated in v1.0. Please use ≤-irrelevant instead." #-} agda-stdlib-1.7.3/src/Data/Rational/Show.agda000066400000000000000000000007321451211343400206440ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Showing rational numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Show where import Data.Integer.Show as ℤ open import Data.Rational.Base open import Data.String.Base using (String; _++_) show : ℚ → String show p = ℤ.show (↥ p) ++ "/" ++ ℤ.show (↧ p) agda-stdlib-1.7.3/src/Data/Rational/Solver.agda000066400000000000000000000013301451211343400211710ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over rationals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Solver where import Algebra.Solver.Ring.Simple as Solver import Algebra.Solver.Ring.AlmostCommutativeRing as ACR open import Data.Rational.Properties using (_≟_; +-*-commutativeRing) ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ module +-*-Solver = Solver (ACR.fromCommutativeRing +-*-commutativeRing) _≟_ agda-stdlib-1.7.3/src/Data/Rational/Unnormalised.agda000066400000000000000000000007561451211343400223720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Rational numbers in non-reduced form. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Unnormalised where -- Re-export basic definition, operations and queries open import Data.Rational.Unnormalised.Base public open import Data.Rational.Unnormalised.Properties public using (_≃?_; _≤?_) agda-stdlib-1.7.3/src/Data/Rational/Unnormalised/000077500000000000000000000000001451211343400215445ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Rational/Unnormalised/Base.agda000066400000000000000000000147711451211343400232460ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Rational numbers in non-reduced form. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Unnormalised.Base where open import Data.Bool.Base using (Bool; if_then_else_) open import Data.Integer.Base as ℤ using (ℤ; +_; +0; +[1+_]; -[1+_]; +<+; +≤+) open import Data.Nat as ℕ using (ℕ; zero; suc) open import Level using (0ℓ) open import Relation.Nullary using (¬_) open import Relation.Nullary.Decidable using (False) open import Relation.Unary using (Pred) open import Relation.Binary using (Rel) open import Relation.Binary.PropositionalEquality.Core using (_≡_; _≢_; refl) ------------------------------------------------------------------------ -- Definition -- Here we define rationals that are not necessarily in reduced form. -- Consequently there are multiple ways of representing a given rational -- number, and the performance of the arithmetic operations may suffer -- due to blowup of the numerator and denominator. -- Nonetheless they are much easier to reason about. In general proofs -- are first proved for these unnormalised rationals and then translated -- into the normalised rationals. record ℚᵘ : Set where constructor mkℚᵘ field numerator : ℤ denominator-1 : ℕ denominatorℕ : ℕ denominatorℕ = suc denominator-1 denominator : ℤ denominator = + denominatorℕ open ℚᵘ public using () renaming ( numerator to ↥_ ; denominator to ↧_ ; denominatorℕ to ↧ₙ_ ) ------------------------------------------------------------------------ -- Equality of rational numbers (does not coincide with _≡_) infix 4 _≃_ _≠_ data _≃_ : Rel ℚᵘ 0ℓ where *≡* : ∀ {p q} → (↥ p ℤ.* ↧ q) ≡ (↥ q ℤ.* ↧ p) → p ≃ q _≠_ : Rel ℚᵘ 0ℓ p ≠ q = ¬ (p ≃ q) ------------------------------------------------------------------------ -- Ordering of rationals infix 4 _≤_ _<_ _≥_ _>_ _≰_ _≱_ _≮_ _≯_ data _≤_ : Rel ℚᵘ 0ℓ where *≤* : ∀ {p q} → (↥ p ℤ.* ↧ q) ℤ.≤ (↥ q ℤ.* ↧ p) → p ≤ q data _<_ : Rel ℚᵘ 0ℓ where *<* : ∀ {p q} → (↥ p ℤ.* ↧ q) ℤ.< (↥ q ℤ.* ↧ p) → p < q _≥_ : Rel ℚᵘ 0ℓ x ≥ y = y ≤ x _>_ : Rel ℚᵘ 0ℓ x > y = y < x _≰_ : Rel ℚᵘ 0ℓ x ≰ y = ¬ (x ≤ y) _≱_ : Rel ℚᵘ 0ℓ x ≱ y = ¬ (x ≥ y) _≮_ : Rel ℚᵘ 0ℓ x ≮ y = ¬ (x < y) _≯_ : Rel ℚᵘ 0ℓ x ≯ y = ¬ (x > y) ------------------------------------------------------------------------ -- Boolean ordering infix 4 _≤ᵇ_ _≤ᵇ_ : ℚᵘ → ℚᵘ → Bool p ≤ᵇ q = (↥ p ℤ.* ↧ q) ℤ.≤ᵇ (↥ q ℤ.* ↧ p) ------------------------------------------------------------------------ -- Constructing rationals infix 4 _≢0 _≢0 : ℕ → Set n ≢0 = False (n ℕ.≟ 0) -- An alternative constructor for ℚᵘ. See the constants section below -- for examples of how to use this operator. infixl 7 _/_ _/_ : (n : ℤ) (d : ℕ) .{d≢0 : d ≢0} → ℚᵘ n / suc d = mkℚᵘ n d ------------------------------------------------------------------------------ -- Operations on rationals infix 8 -_ 1/_ infixl 7 _*_ _÷_ _⊓_ infixl 6 _-_ _+_ _⊔_ -- negation -_ : ℚᵘ → ℚᵘ - mkℚᵘ n d = mkℚᵘ (ℤ.- n) d -- addition _+_ : ℚᵘ → ℚᵘ → ℚᵘ p + q = (↥ p ℤ.* ↧ q ℤ.+ ↥ q ℤ.* ↧ p) / (↧ₙ p ℕ.* ↧ₙ q) -- multiplication _*_ : ℚᵘ → ℚᵘ → ℚᵘ p * q = (↥ p ℤ.* ↥ q) / (↧ₙ p ℕ.* ↧ₙ q) -- subtraction _-_ : ℚᵘ → ℚᵘ → ℚᵘ p - q = p + (- q) -- reciprocal: requires a proof that the numerator is not zero 1/_ : (p : ℚᵘ) → .{n≢0 : ℤ.∣ ↥ p ∣ ≢0} → ℚᵘ 1/ mkℚᵘ +[1+ n ] d = mkℚᵘ +[1+ d ] n 1/ mkℚᵘ -[1+ n ] d = mkℚᵘ -[1+ d ] n -- division: requires a proof that the denominator is not zero _÷_ : (p q : ℚᵘ) → .{n≢0 : ℤ.∣ ↥ q ∣ ≢0} → ℚᵘ (p ÷ q) {n≢0} = p * (1/_ q {n≢0}) -- max _⊔_ : (p q : ℚᵘ) → ℚᵘ p ⊔ q = if p ≤ᵇ q then q else p -- min _⊓_ : (p q : ℚᵘ) → ℚᵘ p ⊓ q = if p ≤ᵇ q then p else q -- absolute value ∣_∣ : ℚᵘ → ℚᵘ ∣ mkℚᵘ p q ∣ = mkℚᵘ (+ ℤ.∣ p ∣) q ------------------------------------------------------------------------------ -- Some constants 0ℚᵘ : ℚᵘ 0ℚᵘ = + 0 / 1 1ℚᵘ : ℚᵘ 1ℚᵘ = + 1 / 1 ½ : ℚᵘ ½ = + 1 / 2 -½ : ℚᵘ -½ = - ½ ------------------------------------------------------------------------ -- Simple predicates NonZero : Pred ℚᵘ 0ℓ NonZero p = ℤ.NonZero (↥ p) Positive : Pred ℚᵘ 0ℓ Positive p = ℤ.Positive (↥ p) Negative : Pred ℚᵘ 0ℓ Negative p = ℤ.Negative (↥ p) NonPositive : Pred ℚᵘ 0ℓ NonPositive p = ℤ.NonPositive (↥ p) NonNegative : Pred ℚᵘ 0ℓ NonNegative p = ℤ.NonNegative (↥ p) -- Constructors -- Note: these could be proved more elegantly using the constructors -- from ℤ but it requires importing `Data.Integer.Properties` which -- we would like to avoid doing. ≢-nonZero : ∀ {p} → p ≠ 0ℚᵘ → NonZero p ≢-nonZero {mkℚᵘ -[1+ _ ] _ } _ = _ ≢-nonZero {mkℚᵘ +[1+ _ ] _ } _ = _ ≢-nonZero {mkℚᵘ +0 zero } p≢0 = p≢0 (*≡* refl) ≢-nonZero {mkℚᵘ +0 (suc d)} p≢0 = p≢0 (*≡* refl) >-nonZero : ∀ {p} → p > 0ℚᵘ → NonZero p >-nonZero {mkℚᵘ +0 _} (*<* (+<+ ())) >-nonZero {mkℚᵘ +[1+ n ] _} (*<* _) = _ <-nonZero : ∀ {p} → p < 0ℚᵘ → NonZero p <-nonZero {mkℚᵘ +[1+ n ] _} (*<* _) = _ <-nonZero {mkℚᵘ +0 _} (*<* (+<+ ())) <-nonZero {mkℚᵘ -[1+ n ] _} (*<* _) = _ positive : ∀ {p} → p > 0ℚᵘ → Positive p positive {mkℚᵘ +[1+ n ] _} (*<* _) = _ positive {mkℚᵘ +0 _} (*<* (+<+ ())) positive {mkℚᵘ (-[1+_] n) _} (*<* ()) negative : ∀ {p} → p < 0ℚᵘ → Negative p negative {mkℚᵘ +[1+ n ] _} (*<* (+<+ ())) negative {mkℚᵘ +0 _} (*<* (+<+ ())) negative {mkℚᵘ (-[1+_] n) _} (*<* _ ) = _ nonPositive : ∀ {p} → p ≤ 0ℚᵘ → NonPositive p nonPositive {mkℚᵘ +[1+ n ] _} (*≤* (+≤+ ())) nonPositive {mkℚᵘ +0 _} (*≤* _) = _ nonPositive {mkℚᵘ -[1+ n ] _} (*≤* _) = _ nonNegative : ∀ {p} → p ≥ 0ℚᵘ → NonNegative p nonNegative {mkℚᵘ +0 _} (*≤* _) = _ nonNegative {mkℚᵘ +[1+ n ] _} (*≤* _) = _ agda-stdlib-1.7.3/src/Data/Rational/Unnormalised/Properties.agda000066400000000000000000002323461451211343400245300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of unnormalized Rational numbers ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Unnormalised.Properties where open import Algebra import Algebra.Consequences.Setoid as FC open import Algebra.Consequences.Propositional open import Algebra.Construct.NaturalChoice.Base import Algebra.Construct.NaturalChoice.MinMaxOp as MinMaxOp open import Data.Bool.Base using (T; true; false) open import Data.Nat.Base as ℕ using (suc; pred) import Data.Nat.Properties as ℕ open import Data.Nat.Solver renaming (module +-*-Solver to ℕ-solver) open import Data.Unit using (tt) open import Data.Integer.Base as ℤ using (ℤ; +0; +[1+_]; -[1+_]; 0ℤ; 1ℤ; -1ℤ) open import Data.Integer.Solver renaming (module +-*-Solver to ℤ-solver) import Data.Integer.Properties as ℤ open import Data.Rational.Unnormalised.Base open import Data.Product using (_,_) open import Data.Sum.Base using (_⊎_; [_,_]′; inj₁; inj₂) open import Function.Base using (_on_; _$_; _∘_) open import Level using (0ℓ) open import Relation.Nullary using (¬_; yes; no) import Relation.Nullary.Decidable as Dec open import Relation.Nullary.Negation using (contradiction; contraposition) open import Relation.Binary import Relation.Binary.Consequences as BC open import Relation.Binary.PropositionalEquality import Relation.Binary.Properties.Poset as PosetProperties open import Algebra.Properties.CommutativeSemigroup ℤ.*-commutativeSemigroup ------------------------------------------------------------------------ -- Properties of ↥_ and ↧_ ------------------------------------------------------------------------ ↥↧≡⇒≡ : ∀ {p q} → ↥ p ≡ ↥ q → ↧ₙ p ≡ ↧ₙ q → p ≡ q ↥↧≡⇒≡ refl refl = refl ------------------------------------------------------------------------ -- Properties of _/_ ------------------------------------------------------------------------ /-cong : ∀ {p₁ q₁ p₂ q₂} → p₁ ≡ p₂ → q₁ ≡ q₂ → ∀ q₁≢0 q₂≢0 → (p₁ / q₁) {q₁≢0} ≡ (p₂ / q₂) {q₂≢0} /-cong {p} {suc q} {.p} {.(suc q)} refl refl q₁≢0 q₂≢0 = refl ↥[p/q]≡p : ∀ p q {q≢0} → ↥ (p / q) {q≢0} ≡ p ↥[p/q]≡p p (suc q) {q≢0} = refl ↧[p/q]≡q : ∀ p q {q≢0} → ↧ (p / q) {q≢0} ≡ ℤ.+ q ↧[p/q]≡q p (suc q) {q≢0} = refl ------------------------------------------------------------------------ -- Properties of Positive/Negative/NonPositive/NonNegative predicates ------------------------------------------------------------------------ positive⇒nonNegative : ∀ {q} → Positive q → NonNegative q positive⇒nonNegative {mkℚᵘ +0 _} _ = _ positive⇒nonNegative {mkℚᵘ +[1+ n ] _} _ = _ negative⇒nonPositive : ∀ {q} → Negative q → NonPositive q negative⇒nonPositive {mkℚᵘ +0 _} _ = _ negative⇒nonPositive {mkℚᵘ -[1+ n ] _} _ = _ ------------------------------------------------------------------------ -- Properties of _≃_ ------------------------------------------------------------------------ drop-*≡* : ∀ {p q} → p ≃ q → ↥ p ℤ.* ↧ q ≡ ↥ q ℤ.* ↧ p drop-*≡* (*≡* eq) = eq ≃-refl : Reflexive _≃_ ≃-refl = *≡* refl ≃-reflexive : _≡_ ⇒ _≃_ ≃-reflexive refl = *≡* refl ≃-sym : Symmetric _≃_ ≃-sym (*≡* eq) = *≡* (sym eq) ≃-trans : Transitive _≃_ ≃-trans {x} {y} {z} (*≡* ad≡cb) (*≡* cf≡ed) = *≡* (ℤ.*-cancelʳ-≡ (↥ x ℤ.* ↧ z) (↥ z ℤ.* ↧ x) (↧ y) (λ()) (begin ↥ x ℤ.* ↧ z ℤ.* ↧ y ≡⟨ xy∙z≈xz∙y (↥ x) _ _ ⟩ ↥ x ℤ.* ↧ y ℤ.* ↧ z ≡⟨ cong (ℤ._* ↧ z) ad≡cb ⟩ ↥ y ℤ.* ↧ x ℤ.* ↧ z ≡⟨ xy∙z≈xz∙y (↥ y) _ _ ⟩ ↥ y ℤ.* ↧ z ℤ.* ↧ x ≡⟨ cong (ℤ._* ↧ x) cf≡ed ⟩ ↥ z ℤ.* ↧ y ℤ.* ↧ x ≡⟨ xy∙z≈xz∙y (↥ z) _ _ ⟩ ↥ z ℤ.* ↧ x ℤ.* ↧ y ∎)) where open ≡-Reasoning _≃?_ : Decidable _≃_ p ≃? q = Dec.map′ *≡* drop-*≡* (↥ p ℤ.* ↧ q ℤ.≟ ↥ q ℤ.* ↧ p) ≃-isEquivalence : IsEquivalence _≃_ ≃-isEquivalence = record { refl = ≃-refl ; sym = ≃-sym ; trans = ≃-trans } ≃-isDecEquivalence : IsDecEquivalence _≃_ ≃-isDecEquivalence = record { isEquivalence = ≃-isEquivalence ; _≟_ = _≃?_ } ≃-setoid : Setoid 0ℓ 0ℓ ≃-setoid = record { isEquivalence = ≃-isEquivalence } ≃-decSetoid : DecSetoid 0ℓ 0ℓ ≃-decSetoid = record { isDecEquivalence = ≃-isDecEquivalence } ------------------------------------------------------------------------ -- Properties of -_ ------------------------------------------------------------------------ neg-involutive-≡ : Involutive _≡_ (-_) neg-involutive-≡ (mkℚᵘ n d) = cong (λ n → mkℚᵘ n d) (ℤ.neg-involutive n) neg-involutive : Involutive _≃_ (-_) neg-involutive p rewrite neg-involutive-≡ p = ≃-refl -‿cong : Congruent₁ _≃_ (-_) -‿cong {p} {q} (*≡* p≡q) = *≡* $ begin ↥(- p) ℤ.* ↧ q ≡˘⟨ ℤ.*-identityˡ (ℤ.-(↥ p) ℤ.* ↧ q) ⟩ 1ℤ ℤ.* (↥(- p) ℤ.* ↧ q) ≡˘⟨ ℤ.*-assoc 1ℤ (↥(- p)) (↧ q) ⟩ (1ℤ ℤ.* ℤ.-(↥ p)) ℤ.* ↧ q ≡˘⟨ cong (ℤ._* ↧ q) (ℤ.neg-distribʳ-* 1ℤ (↥ p)) ⟩ ℤ.-(1ℤ ℤ.* ↥ p) ℤ.* ↧ q ≡⟨ cong (ℤ._* ↧ q) (ℤ.neg-distribˡ-* 1ℤ (↥ p)) ⟩ (-1ℤ ℤ.* ↥ p) ℤ.* ↧ q ≡⟨ ℤ.*-assoc (ℤ.- 1ℤ) (↥ p) (↧ q) ⟩ -1ℤ ℤ.* (↥ p ℤ.* ↧ q) ≡⟨ cong (λ r → ℤ.- 1ℤ ℤ.* r) p≡q ⟩ -1ℤ ℤ.* (↥ q ℤ.* ↧ p) ≡˘⟨ ℤ.*-assoc (ℤ.- 1ℤ) (↥ q) (↧ p) ⟩ (-1ℤ ℤ.* ↥ q) ℤ.* ↧ p ≡˘⟨ cong (ℤ._* ↧ p) (ℤ.neg-distribˡ-* 1ℤ (↥ q)) ⟩ ℤ.-(1ℤ ℤ.* ↥ q) ℤ.* ↧ p ≡⟨ cong (ℤ._* ↧ p) (ℤ.neg-distribʳ-* 1ℤ (↥ q)) ⟩ (1ℤ ℤ.* ↥(- q)) ℤ.* ↧ p ≡⟨ ℤ.*-assoc 1ℤ (ℤ.-(↥ q)) (↧ p) ⟩ 1ℤ ℤ.* (↥(- q) ℤ.* ↧ p) ≡⟨ ℤ.*-identityˡ (↥(- q) ℤ.* ↧ p) ⟩ ↥(- q) ℤ.* ↧ p ∎ where open ≡-Reasoning neg-mono-< : -_ Preserves _<_ ⟶ _>_ neg-mono-< {p} {q} (*<* p : _≰_ ⇒ _>_ ≰⇒> p≰q = *<* (ℤ.≰⇒> (p≰q ∘ *≤*)) ≮⇒≥ : _≮_ ⇒ _≥_ ≮⇒≥ p≮q = *≤* (ℤ.≮⇒≥ (p≮q ∘ *<*)) p≄0⇒∣↥p∣≢0 : ∀ p → p ≠ 0ℚᵘ → ℤ.∣ (↥ p) ∣ ≢0 p≄0⇒∣↥p∣≢0 p = Dec.fromWitnessFalse ∘ contraposition (lemma₁ p) where open ≡-Reasoning lemma₁ : ∀ p → ℤ.∣ (↥ p) ∣ ≡ 0 → p ≃ 0ℚᵘ lemma₁ (mkℚᵘ (ℤ.+ ℕ.zero) d-1) ∣↥p∣≡0 = *≡* refl ∣↥p∣≢0⇒p≄0 : ∀ p → ℤ.∣ (↥ p) ∣ ≢0 → p ≠ 0ℚᵘ ∣↥p∣≢0⇒p≄0 p = contraposition (lemma₁ p) ∘ Dec.toWitnessFalse where open ≡-Reasoning lemma₁ : ∀ p → p ≃ 0ℚᵘ → ℤ.∣ (↥ p) ∣ ≡ 0 lemma₁ (mkℚᵘ (ℤ.+ ℕ.zero) d-1) (*≡* ↥p1≡0↧p) = refl ------------------------------------------------------------------------ -- Relational properties <-irrefl-≡ : Irreflexive _≡_ _<_ <-irrefl-≡ refl (*<* x x≮y x≉y x>y = tri> (x≮y ∘ drop-*<*) (x≉y ∘ drop-*≡*) (*<* x>y) infix 4 _0⇒↥>0 : ∀ {n dm} → mkℚᵘ n dm > 0ℚᵘ → n ℤ.> 0ℤ >0⇒↥>0 {n} {dm} r>0 = ℤ.<-≤-trans (drop-*<* r>0) (ℤ.≤-reflexive $ ℤ.*-identityʳ n) ------------------------------------------------------------------------ -- Properties of sign predicates positive⁻¹ : ∀ {q} → Positive q → q > 0ℚᵘ positive⁻¹ {mkℚᵘ +[1+ n ] _} _ = *<* (ℤ.+<+ (ℕ.s≤s ℕ.z≤n)) nonNegative⁻¹ : ∀ {q} → NonNegative q → q ≥ 0ℚᵘ nonNegative⁻¹ {mkℚᵘ +0 _} _ = *≤* (ℤ.+≤+ ℕ.z≤n) nonNegative⁻¹ {mkℚᵘ +[1+ n ] _} _ = *≤* (ℤ.+≤+ ℕ.z≤n) negative⁻¹ : ∀ {q} → Negative q → q < 0ℚᵘ negative⁻¹ {mkℚᵘ -[1+ n ] _} _ = *<* ℤ.-<+ nonPositive⁻¹ : ∀ {q} → NonPositive q → q ≤ 0ℚᵘ nonPositive⁻¹ {mkℚᵘ +0 _} _ = *≤* (ℤ.+≤+ ℕ.z≤n) nonPositive⁻¹ {mkℚᵘ -[1+ n ] _} _ = *≤* ℤ.-≤+ negative0 = <-trans (negative⁻¹ p<0) (positive⁻¹ q>0) nonNeg∧nonPos⇒0 : ∀ {p} → NonNegative p → NonPositive p → p ≃ 0ℚᵘ nonNeg∧nonPos⇒0 {mkℚᵘ +0 _} _ _ = *≡* refl ------------------------------------------------------------------------ -- Properties of _+_ ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- Raw bundles +-rawMagma : RawMagma 0ℓ 0ℓ +-rawMagma = record { _≈_ = _≃_ ; _∙_ = _+_ } +-rawMonoid : RawMonoid 0ℓ 0ℓ +-rawMonoid = record { _≈_ = _≃_ ; _∙_ = _+_ ; ε = 0ℚᵘ } +-0-rawGroup : RawGroup 0ℓ 0ℓ +-0-rawGroup = record { Carrier = ℚᵘ ; _≈_ = _≃_ ; _∙_ = _+_ ; ε = 0ℚᵘ ; _⁻¹ = -_ } +-*-rawRing : RawRing 0ℓ 0ℓ +-*-rawRing = record { Carrier = ℚᵘ ; _≈_ = _≃_ ; _+_ = _+_ ; _*_ = _*_ ; -_ = -_ ; 0# = 0ℚᵘ ; 1# = 1ℚᵘ } ------------------------------------------------------------------------ -- Algebraic properties -- Congruence +-cong : Congruent₂ _≃_ _+_ +-cong {x} {y} {u} {v} (*≡* ab′∼a′b) (*≡* cd′∼c′d) = *≡* (begin (↥x ℤ.* ↧u ℤ.+ ↥u ℤ.* ↧x) ℤ.* (↧y ℤ.* ↧v) ≡⟨ solve 6 (λ ↥x ↧x ↧y ↥u ↧u ↧v → (↥x :* ↧u :+ ↥u :* ↧x) :* (↧y :* ↧v) := (↥x :* ↧y :* (↧u :* ↧v)) :+ ↥u :* ↧v :* (↧x :* ↧y)) refl (↥ x) (↧ x) (↧ y) (↥ u) (↧ u) (↧ v) ⟩ ↥x ℤ.* ↧y ℤ.* (↧u ℤ.* ↧v) ℤ.+ ↥u ℤ.* ↧v ℤ.* (↧x ℤ.* ↧y) ≡⟨ cong₂ ℤ._+_ (cong (ℤ._* (↧u ℤ.* ↧v)) ab′∼a′b) (cong (ℤ._* (↧x ℤ.* ↧y)) cd′∼c′d) ⟩ ↥y ℤ.* ↧x ℤ.* (↧u ℤ.* ↧v) ℤ.+ ↥v ℤ.* ↧u ℤ.* (↧x ℤ.* ↧y) ≡⟨ solve 6 (λ ↧x ↥y ↧y ↧u ↥v ↧v → (↥y :* ↧x :* (↧u :* ↧v)) :+ ↥v :* ↧u :* (↧x :* ↧y) := (↥y :* ↧v :+ ↥v :* ↧y) :* (↧x :* ↧u)) refl (↧ x) (↥ y) (↧ y) (↧ u) (↥ v) (↧ v) ⟩ (↥y ℤ.* ↧v ℤ.+ ↥v ℤ.* ↧y) ℤ.* (↧x ℤ.* ↧u) ∎) where ↥x = ↥ x; ↧x = ↧ x; ↥y = ↥ y; ↧y = ↧ y; ↥u = ↥ u; ↧u = ↧ u; ↥v = ↥ v; ↧v = ↧ v open ≡-Reasoning open ℤ-solver +-congʳ : ∀ p {q r} → q ≃ r → p + q ≃ p + r +-congʳ p q≃r = +-cong (≃-refl {p}) q≃r +-congˡ : ∀ p {q r} → q ≃ r → q + p ≃ r + p +-congˡ p q≃r = +-cong q≃r (≃-refl {p}) -- Associativity +-assoc-↥ : Associative (_≡_ on ↥_) _+_ +-assoc-↥ p q r = solve 6 (λ ↥p ↧p ↥q ↧q ↥r ↧r → (↥p :* ↧q :+ ↥q :* ↧p) :* ↧r :+ ↥r :* (↧p :* ↧q) := ↥p :* (↧q :* ↧r) :+ (↥q :* ↧r :+ ↥r :* ↧q) :* ↧p) refl (↥ p) (↧ p) (↥ q) (↧ q) (↥ r) (↧ r) where open ℤ-solver +-assoc-↧ : Associative (_≡_ on ↧ₙ_) _+_ +-assoc-↧ p q r = ℕ.*-assoc (↧ₙ p) (↧ₙ q) (↧ₙ r) +-assoc-≡ : Associative _≡_ _+_ +-assoc-≡ p q r = ↥↧≡⇒≡ (+-assoc-↥ p q r) (+-assoc-↧ p q r) +-assoc : Associative _≃_ _+_ +-assoc p q r = ≃-reflexive (+-assoc-≡ p q r) -- Commutativity +-comm-↥ : Commutative (_≡_ on ↥_) _+_ +-comm-↥ p q = ℤ.+-comm (↥ p ℤ.* ↧ q) (↥ q ℤ.* ↧ p) +-comm-↧ : Commutative (_≡_ on ↧ₙ_) _+_ +-comm-↧ p q = ℕ.*-comm (↧ₙ p) (↧ₙ q) +-comm-≡ : Commutative _≡_ _+_ +-comm-≡ p q = ↥↧≡⇒≡ (+-comm-↥ p q) (+-comm-↧ p q) +-comm : Commutative _≃_ _+_ +-comm p q = ≃-reflexive (+-comm-≡ p q) -- Identities +-identityˡ-↥ : LeftIdentity (_≡_ on ↥_) 0ℚᵘ _+_ +-identityˡ-↥ p = begin 0ℤ ℤ.* ↧ p ℤ.+ ↥ p ℤ.* 1ℤ ≡⟨ cong₂ ℤ._+_ (ℤ.*-zeroˡ (↧ p)) (ℤ.*-identityʳ (↥ p)) ⟩ 0ℤ ℤ.+ ↥ p ≡⟨ ℤ.+-identityˡ (↥ p) ⟩ ↥ p ∎ where open ≡-Reasoning +-identityˡ-↧ : LeftIdentity (_≡_ on ↧ₙ_) 0ℚᵘ _+_ +-identityˡ-↧ p = ℕ.+-identityʳ (↧ₙ p) +-identityˡ-≡ : LeftIdentity _≡_ 0ℚᵘ _+_ +-identityˡ-≡ p = ↥↧≡⇒≡ (+-identityˡ-↥ p) (+-identityˡ-↧ p) +-identityˡ : LeftIdentity _≃_ 0ℚᵘ _+_ +-identityˡ p = ≃-reflexive (+-identityˡ-≡ p) +-identityʳ-≡ : RightIdentity _≡_ 0ℚᵘ _+_ +-identityʳ-≡ = comm+idˡ⇒idʳ +-comm-≡ {e = 0ℚᵘ} +-identityˡ-≡ +-identityʳ : RightIdentity _≃_ 0ℚᵘ _+_ +-identityʳ p = ≃-reflexive (+-identityʳ-≡ p) +-identity-≡ : Identity _≡_ 0ℚᵘ _+_ +-identity-≡ = +-identityˡ-≡ , +-identityʳ-≡ +-identity : Identity _≃_ 0ℚᵘ _+_ +-identity = +-identityˡ , +-identityʳ +-inverseˡ : LeftInverse _≃_ 0ℚᵘ -_ _+_ +-inverseˡ p = *≡* let n = ↥ p; d = ↧ p in ((ℤ.- n) ℤ.* d ℤ.+ n ℤ.* d) ℤ.* 1ℤ ≡⟨ ℤ.*-identityʳ ((ℤ.- n) ℤ.* d ℤ.+ n ℤ.* d) ⟩ (ℤ.- n) ℤ.* d ℤ.+ n ℤ.* d ≡˘⟨ cong (ℤ._+ (n ℤ.* d)) (ℤ.neg-distribˡ-* n d) ⟩ ℤ.- (n ℤ.* d) ℤ.+ n ℤ.* d ≡⟨ ℤ.+-inverseˡ (n ℤ.* d) ⟩ 0ℤ ∎ where open ≡-Reasoning +-inverseʳ : RightInverse _≃_ 0ℚᵘ -_ _+_ +-inverseʳ p = *≡* let n = ↥ p; d = ↧ p in (n ℤ.* d ℤ.+ (ℤ.- n) ℤ.* d) ℤ.* 1ℤ ≡⟨ ℤ.*-identityʳ (n ℤ.* d ℤ.+ (ℤ.- n) ℤ.* d) ⟩ n ℤ.* d ℤ.+ (ℤ.- n) ℤ.* d ≡˘⟨ cong (λ n+d → n ℤ.* d ℤ.+ n+d) (ℤ.neg-distribˡ-* n d) ⟩ n ℤ.* d ℤ.+ ℤ.- (n ℤ.* d) ≡⟨ ℤ.+-inverseʳ (n ℤ.* d) ⟩ 0ℤ ∎ where open ≡-Reasoning +-inverse : Inverse _≃_ 0ℚᵘ -_ _+_ +-inverse = +-inverseˡ , +-inverseʳ +-cancelˡ : ∀ {r p q} → r + p ≃ r + q → p ≃ q +-cancelˡ {r} {p} {q} r+p≃r+q = begin-equality p ≈˘⟨ +-identityʳ p ⟩ p + 0ℚᵘ ≈⟨ +-congʳ p (≃-sym (+-inverseʳ r)) ⟩ p + (r - r) ≈˘⟨ +-assoc p r (- r) ⟩ (p + r) - r ≈⟨ +-congˡ (- r) (+-comm p r) ⟩ (r + p) - r ≈⟨ +-congˡ (- r) r+p≃r+q ⟩ (r + q) - r ≈⟨ +-congˡ (- r) (+-comm r q) ⟩ (q + r) - r ≈⟨ +-assoc q r (- r) ⟩ q + (r - r) ≈⟨ +-congʳ q (+-inverseʳ r) ⟩ q + 0ℚᵘ ≈⟨ +-identityʳ q ⟩ q ∎ where open ≤-Reasoning +-cancelʳ : ∀ {r p q} → p + r ≃ q + r → p ≃ q +-cancelʳ {r} {p} {q} p+r≃q+r = +-cancelˡ {r} $ begin-equality r + p ≈⟨ +-comm r p ⟩ p + r ≈⟨ p+r≃q+r ⟩ q + r ≈⟨ +-comm q r ⟩ r + q ∎ where open ≤-Reasoning p+p≃0⇒p≃0 : ∀ p → p + p ≃ 0ℚᵘ → p ≃ 0ℚᵘ p+p≃0⇒p≃0 (mkℚᵘ (ℤ.+ ℕ.zero) _) (*≡* _) = *≡* refl ------------------------------------------------------------------------ -- Properties of _+_ and -_ neg-distrib-+ : ∀ p q → - (p + q) ≡ (- p) + (- q) neg-distrib-+ p q = ↥↧≡⇒≡ (begin ℤ.- (↥ p ℤ.* ↧ q ℤ.+ ↥ q ℤ.* ↧ p) ≡⟨ ℤ.neg-distrib-+ (↥ p ℤ.* ↧ q) _ ⟩ ℤ.- (↥ p ℤ.* ↧ q) ℤ.+ ℤ.- (↥ q ℤ.* ↧ p) ≡⟨ cong₂ ℤ._+_ (ℤ.neg-distribˡ-* (↥ p) _) (ℤ.neg-distribˡ-* (↥ q) _) ⟩ (ℤ.- ↥ p) ℤ.* ↧ q ℤ.+ (ℤ.- ↥ q) ℤ.* ↧ p ∎ ) refl where open ≡-Reasoning p≃-p⇒p≃0 : ∀ p → p ≃ - p → p ≃ 0ℚᵘ p≃-p⇒p≃0 p p≃-p = p+p≃0⇒p≃0 p (begin-equality p + p ≈⟨ +-congʳ p p≃-p ⟩ p - p ≈⟨ +-inverseʳ p ⟩ 0ℚᵘ ∎) where open ≤-Reasoning ------------------------------------------------------------------------ -- Properties of _+_ and _≤_ private lemma : ∀ r p q → (↥ r ℤ.* ↧ p ℤ.+ ↥ p ℤ.* ↧ r) ℤ.* (↧ r ℤ.* ↧ q) ≡ (↥ r ℤ.* ↧ r) ℤ.* (↧ p ℤ.* ↧ q) ℤ.+ (↧ r ℤ.* ↧ r) ℤ.* (↥ p ℤ.* ↧ q) lemma r p q = solve 5 (λ ↥r ↧r ↧p ↥p ↧q → (↥r :* ↧p :+ ↥p :* ↧r) :* (↧r :* ↧q) := (↥r :* ↧r) :* (↧p :* ↧q) :+ (↧r :* ↧r) :* (↥p :* ↧q)) refl (↥ r) (↧ r) (↧ p) (↥ p) (↧ q) where open ℤ-solver +-monoʳ-≤ : ∀ r → (r +_) Preserves _≤_ ⟶ _≤_ +-monoʳ-≤ r {p} {q} (*≤* x≤y) = *≤* $ begin ↥ (r + p) ℤ.* (↧ (r + q)) ≡⟨ lemma r p q ⟩ r₂ ℤ.* (↧ p ℤ.* ↧ q) ℤ.+ (↧ r ℤ.* ↧ r) ℤ.* (↥ p ℤ.* ↧ q) ≤⟨ ℤ.+-mono-≤ (ℤ.≤-reflexive $ cong (r₂ ℤ.*_) (ℤ.*-comm (↧ p) (↧ q))) (ℤ.*-monoˡ-≤-nonNeg (↧ₙ r ℕ.* ↧ₙ r) x≤y) ⟩ r₂ ℤ.* (↧ q ℤ.* ↧ p) ℤ.+ (↧ r ℤ.* ↧ r) ℤ.* (↥ q ℤ.* ↧ p) ≡⟨ sym $ lemma r q p ⟩ ↥ (r + q) ℤ.* (↧ (r + p)) ∎ where open ℤ.≤-Reasoning; r₂ = ↥ r ℤ.* ↧ r +-monoˡ-≤ : ∀ r → (_+ r) Preserves _≤_ ⟶ _≤_ +-monoˡ-≤ r {p} {q} rewrite +-comm-≡ p r | +-comm-≡ q r = +-monoʳ-≤ r +-mono-≤ : _+_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ +-mono-≤ {p} {q} {u} {v} p≤q u≤v = ≤-trans (+-monoˡ-≤ u p≤q) (+-monoʳ-≤ q u≤v) ≤-steps : ∀ {p q r} → NonNegative r → p ≤ q → p ≤ r + q ≤-steps {p} {q} {r} r≥0 p≤q = subst (_≤ r + q) (+-identityˡ-≡ p) (+-mono-≤ (nonNegative⁻¹ r≥0) p≤q) p≤p+q : ∀ {p q} → NonNegative q → p ≤ p + q p≤p+q {p} {q} q≥0 = subst (_≤ p + q) (+-identityʳ-≡ p) (+-monoʳ-≤ p (nonNegative⁻¹ q≥0)) p≤q+p : ∀ {p} → NonNegative p → ∀ {q} → q ≤ p + q p≤q+p {p} p≥0 {q} rewrite +-comm-≡ p q = p≤p+q p≥0 ------------------------------------------------------------------------ -- Properties of _+_ and _<_ +-monoʳ-< : ∀ r → (r +_) Preserves _<_ ⟶ _<_ +-monoʳ-< r@(mkℚᵘ n dm) {p} {q} (*<* x0 {p} {q} rewrite *-comm-≡ r p | *-comm-≡ r q = *-cancelʳ-≤-pos r>0 *-cancelʳ-≤-neg : ∀ r → Negative r → ∀ {p q} → p * r ≤ q * r → q ≤ p *-cancelʳ-≤-neg r r<0 {p} {q} pr≤qr = neg-cancel-≤ (*-cancelʳ-≤-pos (positive { - r} (neg-mono-< {r} {0ℚᵘ} (negative⁻¹ r<0))) (begin - p * - r ≈˘⟨ neg-distribˡ-* p (- r) ⟩ - (p * - r) ≈˘⟨ -‿cong (neg-distribʳ-* p r) ⟩ - - (p * r) ≈⟨ neg-involutive (p * r) ⟩ p * r ≤⟨ pr≤qr ⟩ q * r ≈˘⟨ neg-involutive (q * r) ⟩ - - (q * r) ≈⟨ -‿cong (neg-distribʳ-* q r) ⟩ - (q * - r) ≈⟨ neg-distribˡ-* q (- r) ⟩ - q * - r ∎)) where open ≤-Reasoning *-cancelˡ-≤-neg : ∀ r → Negative r → ∀ {p q} → r * p ≤ r * q → q ≤ p *-cancelˡ-≤-neg r r<0 {p} {q} pr≤qr = *-cancelʳ-≤-neg r r<0 $ begin p * r ≈⟨ *-comm p r ⟩ r * p ≤⟨ pr≤qr ⟩ r * q ≈⟨ *-comm r q ⟩ q * r ∎ where open ≤-Reasoning *-monoˡ-≤-nonNeg : ∀ {r} → NonNegative r → (_* r) Preserves _≤_ ⟶ _≤_ *-monoˡ-≤-nonNeg r@{mkℚᵘ (ℤ.+ n) _} _ {p} {q} (*≤* x0 {p} {q} rewrite *-comm-≡ r p | *-comm-≡ r q = *-monoˡ-<-pos {r} r>0 *-cancelˡ-<-nonNeg : ∀ {r} → NonNegative r → ∀ {p q} → r * p < r * q → p < q *-cancelˡ-<-nonNeg {mkℚᵘ (ℤ.+ n) dm} _ {p} {q} (*<* x0 rp0) rp0 pr0) pr_ *-monoˡ-<-neg r r<0 {p} {q} p_ *-monoʳ-<-neg r r<0 {p} {q} p0 = Dec.fromWitnessFalse (contraposition ℤ.∣n∣≡0⇒n≡0 (≢-sym (ℤ.<⇒≢ (ℤ.positive⁻¹ p>0)))) neg⇒≢0 : ∀ p → Negative p → ℤ.∣ ↥ p ∣ ≢0 neg⇒≢0 p p<0 = Dec.fromWitnessFalse (contraposition ℤ.∣n∣≡0⇒n≡0 (ℤ.<⇒≢ (ℤ.negative⁻¹ p<0))) 1/p≢0 : ∀ p {p≢0} → ℤ.∣ (↥ ((1/ p) {p≢0})) ∣ ≢0 1/p≢0 (mkℚᵘ (+[1+ n ]) d-1) = tt 1/p≢0 (mkℚᵘ (-[1+ n ]) d-1) = tt p>1⇒p≢0 : ∀ {p} → p > 1ℚᵘ → ℤ.∣ ↥ p ∣ ≢0 p>1⇒p≢0 {p} (*<* 1↧p<↥p1) = Dec.fromWitnessFalse (contraposition ℤ.∣n∣≡0⇒n≡0 (≢-sym (ℤ.<⇒≢ (begin-strict +0 ≤⟨ ℤ.+≤+ ℕ.z≤n ⟩ ↧ p ≡˘⟨ ℤ.*-identityˡ _ ⟩ 1ℤ ℤ.* ↧ p <⟨ 1↧p<↥p1 ⟩ ↥ p ℤ.* 1ℤ ≡⟨ ℤ.*-identityʳ _ ⟩ ↥ p ∎)))) where open ℤ.≤-Reasoning 1/-involutive-≡ : ∀ p {p≢0} → (1/ (1/ p) {p≢0}) {1/p≢0 p {p≢0}} ≡ p 1/-involutive-≡ (mkℚᵘ +[1+ n ] d-1) = refl 1/-involutive-≡ (mkℚᵘ -[1+ n ] d-1) = refl 1/-involutive : ∀ p {p≢0} → (1/ (1/ p) {p≢0}) {1/p≢0 p {p≢0}} ≃ p 1/-involutive p {p≢0} = ≃-reflexive (1/-involutive-≡ p {p≢0}) pos⇒1/pos : ∀ p (p>0 : Positive p) → Positive ((1/ p) {pos⇒≢0 p p>0}) pos⇒1/pos (mkℚᵘ +[1+ n ] d-1) _ = tt neg⇒1/neg : ∀ p (p<0 : Negative p) → Negative ((1/ p) {neg⇒≢0 p p<0}) neg⇒1/neg (mkℚᵘ -[1+ n ] d-1) _ = tt p>1⇒1/p<1 : ∀ {p} → (p>1 : p > 1ℚᵘ) → (1/ p) {p>1⇒p≢0 p>1} < 1ℚᵘ p>1⇒1/p<1 {p} p>1 = lemma′ p (p>1⇒p≢0 p>1) p>1 where open ℤ.≤-Reasoning lemma′ : ∀ p p≢0 → p > 1ℚᵘ → (1/ p) {p≢0} < 1ℚᵘ lemma′ (mkℚᵘ n@(+[1+ _ ]) d-1) _ (*<* ↥p1>1↧p) = *<* (begin-strict ↥ (1/ mkℚᵘ n d-1) ℤ.* 1ℤ ≡⟨⟩ +[1+ d-1 ] ℤ.* 1ℤ ≡⟨ ℤ.*-comm +[1+ d-1 ] 1ℤ ⟩ 1ℤ ℤ.* +[1+ d-1 ] <⟨ ↥p1>1↧p ⟩ n ℤ.* 1ℤ ≡⟨ ℤ.*-comm n 1ℤ ⟩ 1ℤ ℤ.* n ≡⟨⟩ (↥ 1ℚᵘ) ℤ.* (↧ (1/ mkℚᵘ n d-1)) ∎) ------------------------------------------------------------------------ -- Properties of _⊓_ and _⊔_ ------------------------------------------------------------------------ -- Basic specification in terms of _≤_ p≤q⇒p⊔q≃q : ∀ {p q} → p ≤ q → p ⊔ q ≃ q p≤q⇒p⊔q≃q {p} {q} p≤q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | _ = ≃-refl ... | false | [ p≰q ] = contradiction (≤⇒≤ᵇ p≤q) (subst (¬_ ∘ T) (sym p≰q) λ()) p≥q⇒p⊔q≃p : ∀ {p q} → p ≥ q → p ⊔ q ≃ p p≥q⇒p⊔q≃p {p} {q} p≥q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | [ p≤q ] = ≤-antisym p≥q (≤ᵇ⇒≤ (subst T (sym p≤q) _)) ... | false | [ p≤q ] = ≃-refl p≤q⇒p⊓q≃p : ∀ {p q} → p ≤ q → p ⊓ q ≃ p p≤q⇒p⊓q≃p {p} {q} p≤q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | _ = ≃-refl ... | false | [ p≰q ] = contradiction (≤⇒≤ᵇ p≤q) (subst (¬_ ∘ T) (sym p≰q) λ()) p≥q⇒p⊓q≃q : ∀ {p q} → p ≥ q → p ⊓ q ≃ q p≥q⇒p⊓q≃q {p} {q} p≥q with p ≤ᵇ q | inspect (p ≤ᵇ_) q ... | true | [ p≤q ] = ≤-antisym (≤ᵇ⇒≤ (subst T (sym p≤q) _)) p≥q ... | false | [ p≤q ] = ≃-refl ⊓-operator : MinOperator ≤-totalPreorder ⊓-operator = record { x≤y⇒x⊓y≈x = p≤q⇒p⊓q≃p ; x≥y⇒x⊓y≈y = p≥q⇒p⊓q≃q } ⊔-operator : MaxOperator ≤-totalPreorder ⊔-operator = record { x≤y⇒x⊔y≈y = p≤q⇒p⊔q≃q ; x≥y⇒x⊔y≈x = p≥q⇒p⊔q≃p } ------------------------------------------------------------------------ -- Derived properties of _⊓_ and _⊔_ private module ⊓-⊔-properties = MinMaxOp ⊓-operator ⊔-operator open ⊓-⊔-properties public using ( ⊓-congˡ -- : LeftCongruent _≃_ _⊓_ ; ⊓-congʳ -- : RightCongruent _≃_ _⊓_ ; ⊓-cong -- : Congruent₂ _≃_ _⊓_ ; ⊓-idem -- : Idempotent _≃_ _⊓_ ; ⊓-sel -- : Selective _≃_ _⊓_ ; ⊓-assoc -- : Associative _≃_ _⊓_ ; ⊓-comm -- : Commutative _≃_ _⊓_ ; ⊔-congˡ -- : LeftCongruent _≃_ _⊔_ ; ⊔-congʳ -- : RightCongruent _≃_ _⊔_ ; ⊔-cong -- : Congruent₂ _≃_ _⊔_ ; ⊔-idem -- : Idempotent _≃_ _⊔_ ; ⊔-sel -- : Selective _≃_ _⊔_ ; ⊔-assoc -- : Associative _≃_ _⊔_ ; ⊔-comm -- : Commutative _≃_ _⊔_ ; ⊓-distribˡ-⊔ -- : _DistributesOverˡ_ _≃_ _⊓_ _⊔_ ; ⊓-distribʳ-⊔ -- : _DistributesOverʳ_ _≃_ _⊓_ _⊔_ ; ⊓-distrib-⊔ -- : _DistributesOver_ _≃_ _⊓_ _⊔_ ; ⊔-distribˡ-⊓ -- : _DistributesOverˡ_ _≃_ _⊔_ _⊓_ ; ⊔-distribʳ-⊓ -- : _DistributesOverʳ_ _≃_ _⊔_ _⊓_ ; ⊔-distrib-⊓ -- : _DistributesOver_ _≃_ _⊔_ _⊓_ ; ⊓-absorbs-⊔ -- : _Absorbs_ _≃_ _⊓_ _⊔_ ; ⊔-absorbs-⊓ -- : _Absorbs_ _≃_ _⊔_ _⊓_ ; ⊔-⊓-absorptive -- : Absorptive _≃_ _⊔_ _⊓_ ; ⊓-⊔-absorptive -- : Absorptive _≃_ _⊓_ _⊔_ ; ⊓-isMagma -- : IsMagma _≃_ _⊓_ ; ⊓-isSemigroup -- : IsSemigroup _≃_ _⊓_ ; ⊓-isCommutativeSemigroup -- : IsCommutativeSemigroup _≃_ _⊓_ ; ⊓-isBand -- : IsBand _≃_ _⊓_ ; ⊓-isSemilattice -- : IsSemilattice _≃_ _⊓_ ; ⊓-isSelectiveMagma -- : IsSelectiveMagma _≃_ _⊓_ ; ⊔-isMagma -- : IsMagma _≃_ _⊔_ ; ⊔-isSemigroup -- : IsSemigroup _≃_ _⊔_ ; ⊔-isCommutativeSemigroup -- : IsCommutativeSemigroup _≃_ _⊔_ ; ⊔-isBand -- : IsBand _≃_ _⊔_ ; ⊔-isSemilattice -- : IsSemilattice _≃_ _⊔_ ; ⊔-isSelectiveMagma -- : IsSelectiveMagma _≃_ _⊔_ ; ⊔-⊓-isLattice -- : IsLattice _≃_ _⊔_ _⊓_ ; ⊓-⊔-isLattice -- : IsLattice _≃_ _⊓_ _⊔_ ; ⊔-⊓-isDistributiveLattice -- : IsDistributiveLattice _≃_ _⊔_ _⊓_ ; ⊓-⊔-isDistributiveLattice -- : IsDistributiveLattice _≃_ _⊓_ _⊔_ ; ⊓-magma -- : Magma _ _ ; ⊓-semigroup -- : Semigroup _ _ ; ⊓-band -- : Band _ _ ; ⊓-commutativeSemigroup -- : CommutativeSemigroup _ _ ; ⊓-semilattice -- : Semilattice _ _ ; ⊓-selectiveMagma -- : SelectiveMagma _ _ ; ⊔-magma -- : Magma _ _ ; ⊔-semigroup -- : Semigroup _ _ ; ⊔-band -- : Band _ _ ; ⊔-commutativeSemigroup -- : CommutativeSemigroup _ _ ; ⊔-semilattice -- : Semilattice _ _ ; ⊔-selectiveMagma -- : SelectiveMagma _ _ ; ⊔-⊓-lattice -- : Lattice _ _ ; ⊓-⊔-lattice -- : Lattice _ _ ; ⊔-⊓-distributiveLattice -- : DistributiveLattice _ _ ; ⊓-⊔-distributiveLattice -- : DistributiveLattice _ _ ; ⊓-triangulate -- : ∀ p q r → p ⊓ q ⊓ r ≃ (p ⊓ q) ⊓ (q ⊓ r) ; ⊔-triangulate -- : ∀ p q r → p ⊔ q ⊔ r ≃ (p ⊔ q) ⊔ (q ⊔ r) ; ⊓-glb -- : ∀ {p q r} → p ≥ r → q ≥ r → p ⊓ q ≥ r ; ⊓-mono-≤ -- : _⊓_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ; ⊓-monoˡ-≤ -- : ∀ p → (_⊓ p) Preserves _≤_ ⟶ _≤_ ; ⊓-monoʳ-≤ -- : ∀ p → (p ⊓_) Preserves _≤_ ⟶ _≤_ ; ⊔-lub -- : ∀ {p q r} → p ≤ r → q ≤ r → p ⊔ q ≤ r ; ⊔-mono-≤ -- : _⊔_ Preserves₂ _≤_ ⟶ _≤_ ⟶ _≤_ ; ⊔-monoˡ-≤ -- : ∀ p → (_⊔ p) Preserves _≤_ ⟶ _≤_ ; ⊔-monoʳ-≤ -- : ∀ p → (p ⊔_) Preserves _≤_ ⟶ _≤_ ) renaming ( x⊓y≈y⇒y≤x to p⊓q≃q⇒q≤p -- : ∀ {p q} → p ⊓ q ≃ q → q ≤ p ; x⊓y≈x⇒x≤y to p⊓q≃p⇒p≤q -- : ∀ {p q} → p ⊓ q ≃ p → p ≤ q ; x⊔y≈y⇒x≤y to p⊔q≃q⇒p≤q -- : ∀ {p q} → p ⊔ q ≃ q → p ≤ q ; x⊔y≈x⇒y≤x to p⊔q≃p⇒q≤p -- : ∀ {p q} → p ⊔ q ≃ p → q ≤ p ; x⊓y≤x to p⊓q≤p -- : ∀ p q → p ⊓ q ≤ p ; x⊓y≤y to p⊓q≤q -- : ∀ p q → p ⊓ q ≤ q ; x≤y⇒x⊓z≤y to p≤q⇒p⊓r≤q -- : ∀ {p q} r → p ≤ q → p ⊓ r ≤ q ; x≤y⇒z⊓x≤y to p≤q⇒r⊓p≤q -- : ∀ {p q} r → p ≤ q → r ⊓ p ≤ q ; x≤y⊓z⇒x≤y to p≤q⊓r⇒p≤q -- : ∀ {p} q r → p ≤ q ⊓ r → p ≤ q ; x≤y⊓z⇒x≤z to p≤q⊓r⇒p≤r -- : ∀ {p} q r → p ≤ q ⊓ r → p ≤ r ; x≤x⊔y to p≤p⊔q -- : ∀ p q → p ≤ p ⊔ q ; x≤y⊔x to p≤q⊔p -- : ∀ p q → p ≤ q ⊔ p ; x≤y⇒x≤y⊔z to p≤q⇒p≤q⊔r -- : ∀ {p q} r → p ≤ q → p ≤ q ⊔ r ; x≤y⇒x≤z⊔y to p≤q⇒p≤r⊔q -- : ∀ {p q} r → p ≤ q → p ≤ r ⊔ q ; x⊔y≤z⇒x≤z to p⊔q≤r⇒p≤r -- : ∀ p q {r} → p ⊔ q ≤ r → p ≤ r ; x⊔y≤z⇒y≤z to p⊔q≤r⇒q≤r -- : ∀ p q {r} → p ⊔ q ≤ r → q ≤ r ; x⊓y≤x⊔y to p⊓q≤p⊔q -- : ∀ p q → p ⊓ q ≤ p ⊔ q ) ------------------------------------------------------------------------ -- Raw bundles ⊓-rawMagma : RawMagma _ _ ⊓-rawMagma = Magma.rawMagma ⊓-magma ⊔-rawMagma : RawMagma _ _ ⊔-rawMagma = Magma.rawMagma ⊔-magma ⊔-⊓-rawLattice : RawLattice _ _ ⊔-⊓-rawLattice = Lattice.rawLattice ⊔-⊓-lattice ------------------------------------------------------------------------ -- Monotonic or antimonotic functions distribute over _⊓_ and _⊔_ mono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → ∀ m n → f (m ⊔ n) ≃ f m ⊔ f n mono-≤-distrib-⊔ pres = ⊓-⊔-properties.mono-≤-distrib-⊔ (mono⇒cong pres) pres mono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≤_ → ∀ m n → f (m ⊓ n) ≃ f m ⊓ f n mono-≤-distrib-⊓ pres = ⊓-⊔-properties.mono-≤-distrib-⊓ (mono⇒cong pres) pres antimono-≤-distrib-⊓ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → ∀ m n → f (m ⊓ n) ≃ f m ⊔ f n antimono-≤-distrib-⊓ pres = ⊓-⊔-properties.antimono-≤-distrib-⊓ (antimono⇒cong pres) pres antimono-≤-distrib-⊔ : ∀ {f} → f Preserves _≤_ ⟶ _≥_ → ∀ m n → f (m ⊔ n) ≃ f m ⊓ f n antimono-≤-distrib-⊔ pres = ⊓-⊔-properties.antimono-≤-distrib-⊔ (antimono⇒cong pres) pres ------------------------------------------------------------------------ -- Properties of _⊓_, _⊔_ and -_ neg-distrib-⊔-⊓ : ∀ p q → - (p ⊔ q) ≃ - p ⊓ - q neg-distrib-⊔-⊓ = antimono-≤-distrib-⊔ neg-mono-≤ neg-distrib-⊓-⊔ : ∀ p q → - (p ⊓ q) ≃ - p ⊔ - q neg-distrib-⊓-⊔ = antimono-≤-distrib-⊓ neg-mono-≤ ------------------------------------------------------------------------ -- Properties of _⊓_ and _*_ *-distribˡ-⊓-nonNeg : ∀ p → NonNegative p → ∀ q r → p * (q ⊓ r) ≃ (p * q) ⊓ (p * r) *-distribˡ-⊓-nonNeg p p≥0 = mono-≤-distrib-⊓ (*-monoʳ-≤-nonNeg {p} p≥0) *-distribʳ-⊓-nonNeg : ∀ p → NonNegative p → ∀ q r → (q ⊓ r) * p ≃ (q * p) ⊓ (r * p) *-distribʳ-⊓-nonNeg p p≥0 = mono-≤-distrib-⊓ (*-monoˡ-≤-nonNeg {p} p≥0) *-distribˡ-⊔-nonNeg : ∀ p → NonNegative p → ∀ q r → p * (q ⊔ r) ≃ (p * q) ⊔ (p * r) *-distribˡ-⊔-nonNeg p p≥0 = mono-≤-distrib-⊔ (*-monoʳ-≤-nonNeg {p} p≥0) *-distribʳ-⊔-nonNeg : ∀ p → NonNegative p → ∀ q r → (q ⊔ r) * p ≃ (q * p) ⊔ (r * p) *-distribʳ-⊔-nonNeg p p≥0 = mono-≤-distrib-⊔ (*-monoˡ-≤-nonNeg {p} p≥0) ------------------------------------------------------------------------ -- Properties of _⊓_, _⊔_ and _*_ *-distribˡ-⊔-nonPos : ∀ p → NonPositive p → ∀ q r → p * (q ⊔ r) ≃ (p * q) ⊓ (p * r) *-distribˡ-⊔-nonPos p p≤0 = antimono-≤-distrib-⊔ (*-monoʳ-≤-nonPos p p≤0) *-distribʳ-⊔-nonPos : ∀ p → NonPositive p → ∀ q r → (q ⊔ r) * p ≃ (q * p) ⊓ (r * p) *-distribʳ-⊔-nonPos p p≤0 = antimono-≤-distrib-⊔ (*-monoˡ-≤-nonPos p p≤0) *-distribˡ-⊓-nonPos : ∀ p → NonPositive p → ∀ q r → p * (q ⊓ r) ≃ (p * q) ⊔ (p * r) *-distribˡ-⊓-nonPos p p≤0 = antimono-≤-distrib-⊓ (*-monoʳ-≤-nonPos p p≤0) *-distribʳ-⊓-nonPos : ∀ p → NonPositive p → ∀ q r → (q ⊓ r) * p ≃ (q * p) ⊔ (r * p) *-distribʳ-⊓-nonPos p p≤0 = antimono-≤-distrib-⊓ (*-monoˡ-≤-nonPos p p≤0) ------------------------------------------------------------------------ -- Properties of ∣_∣ ------------------------------------------------------------------------ ∣-∣-cong : ∀ {p q} → p ≃ q → ∣ p ∣ ≃ ∣ q ∣ ∣-∣-cong {mkℚᵘ +[1+ pn ] pd-1} {mkℚᵘ +[1+ qn ] qd-1} (*≡* ↥p↧q≡↥q↧p) = *≡* ↥p↧q≡↥q↧p ∣-∣-cong {mkℚᵘ +0 pd-1} {mkℚᵘ +0 qd-1} (*≡* ↥p↧q≡↥q↧p) = *≡* ↥p↧q≡↥q↧p ∣-∣-cong {mkℚᵘ -[1+ pn ] pd-1} {mkℚᵘ +0 qd-1} (*≡* ()) ∣-∣-cong {mkℚᵘ -[1+ pn ] pd-1} {mkℚᵘ -[1+ qn ] qd-1} (*≡* ↥p↧q≡↥q↧p) = *≡* (begin (↥ ∣ mkℚᵘ -[1+ pn ] pd-1 ∣) ℤ.* (↧ ∣ mkℚᵘ -[1+ qn ] qd-1 ∣) ≡⟨⟩ +[1+ pn ] ℤ.* ℤ.+ suc qd-1 ≡⟨ ℤ.neg-involutive _ ⟩ ℤ.- ℤ.- (+[1+ pn ] ℤ.* ℤ.+ suc qd-1) ≡⟨ cong ℤ.-_ (ℤ.neg-distribˡ-* +[1+ pn ] (ℤ.+ suc qd-1)) ⟩ ℤ.- (-[1+ pn ] ℤ.* ℤ.+ suc qd-1) ≡⟨ cong ℤ.-_ ↥p↧q≡↥q↧p ⟩ ℤ.- (-[1+ qn ] ℤ.* ℤ.+ suc pd-1) ≡⟨ cong ℤ.-_ (ℤ.neg-distribˡ-* +[1+ qn ] (ℤ.+ suc pd-1)) ⟩ ℤ.- ℤ.- (+[1+ qn ] ℤ.* ℤ.+ suc pd-1) ≡˘⟨ ℤ.neg-involutive _ ⟩ +[1+ qn ] ℤ.* ℤ.+ suc pd-1 ≡⟨⟩ (↥ ∣ mkℚᵘ -[1+ qn ] qd-1 ∣) ℤ.* (↧ ∣ mkℚᵘ -[1+ pn ] pd-1 ∣) ∎) where open ≡-Reasoning ∣p∣≃0⇒p≃0 : ∀ {p} → ∣ p ∣ ≃ 0ℚᵘ → p ≃ 0ℚᵘ ∣p∣≃0⇒p≃0 {mkℚᵘ (ℤ.+ n) d-1} p≃0ℚ = p≃0ℚ ∣p∣≃0⇒p≃0 {mkℚᵘ -[1+ n ] d-1} (*≡* ()) 0≤∣p∣ : ∀ p → 0ℚᵘ ≤ ∣ p ∣ 0≤∣p∣ (mkℚᵘ ℤ.+0 _) = *≤* (ℤ.+≤+ ℕ.z≤n) 0≤∣p∣ (mkℚᵘ ℤ.+[1+ _ ] _) = *≤* (ℤ.+≤+ ℕ.z≤n) 0≤∣p∣ (mkℚᵘ ℤ.-[1+ _ ] _) = *≤* (ℤ.+≤+ ℕ.z≤n) ∣-p∣≡∣p∣ : ∀ p → ∣ - p ∣ ≡ ∣ p ∣ ∣-p∣≡∣p∣ (mkℚᵘ +[1+ n ] d) = refl ∣-p∣≡∣p∣ (mkℚᵘ +0 d) = refl ∣-p∣≡∣p∣ (mkℚᵘ -[1+ n ] d) = refl ∣-p∣≃∣p∣ : ∀ p → ∣ - p ∣ ≃ ∣ p ∣ ∣-p∣≃∣p∣ = ≃-reflexive ∘ ∣-p∣≡∣p∣ 0≤p⇒∣p∣≡p : ∀ {p} → 0ℚᵘ ≤ p → ∣ p ∣ ≡ p 0≤p⇒∣p∣≡p {mkℚᵘ (ℤ.+ n) d-1} 0≤p = refl 0≤p⇒∣p∣≡p {mkℚᵘ -[1+ n ] d-1} 0≤p = contradiction 0≤p (<⇒≱ (*<* ℤ.-<+)) 0≤p⇒∣p∣≃p : ∀ {p} → 0ℚᵘ ≤ p → ∣ p ∣ ≃ p 0≤p⇒∣p∣≃p {p} = ≃-reflexive ∘ 0≤p⇒∣p∣≡p {p} ∣p∣≡p⇒0≤p : ∀ {p} → ∣ p ∣ ≡ p → 0ℚᵘ ≤ p ∣p∣≡p⇒0≤p {mkℚᵘ (ℤ.+ n) d-1} ∣p∣≡p = *≤* (begin 0ℤ ℤ.* +[1+ d-1 ] ≡⟨ ℤ.*-zeroˡ (ℤ.+ d-1) ⟩ 0ℤ ≤⟨ ℤ.+≤+ ℕ.z≤n ⟩ ℤ.+ n ≡˘⟨ ℤ.*-identityʳ (ℤ.+ n) ⟩ ℤ.+ n ℤ.* 1ℤ ∎) where open ℤ.≤-Reasoning ∣p∣≡p∨∣p∣≡-p : ∀ p → (∣ p ∣ ≡ p) ⊎ (∣ p ∣ ≡ - p) ∣p∣≡p∨∣p∣≡-p (mkℚᵘ (ℤ.+ n) d-1) = inj₁ refl ∣p∣≡p∨∣p∣≡-p (mkℚᵘ (-[1+ n ]) d-1) = inj₂ refl ∣p∣≃p⇒0≤p : ∀ {p} → ∣ p ∣ ≃ p → 0ℚᵘ ≤ p ∣p∣≃p⇒0≤p {p} ∣p∣≃p with ∣p∣≡p∨∣p∣≡-p p ... | inj₁ ∣p∣≡p = ∣p∣≡p⇒0≤p ∣p∣≡p ... | inj₂ ∣p∣≡-p rewrite ∣p∣≡-p = ≤-reflexive (≃-sym (p≃-p⇒p≃0 p (≃-sym ∣p∣≃p))) ∣p+q∣≤∣p∣+∣q∣ : ∀ p q → ∣ p + q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p+q∣≤∣p∣+∣q∣ p q = *≤* (begin ↥ ∣ p + q ∣ ℤ.* ↧ (∣ p ∣ + ∣ q ∣) ≡⟨⟩ ↥ ∣ (↥p↧q ℤ.+ ↥q↧p) / ↧p↧q ∣ ℤ.* ℤ.+ ↧p↧q ≡⟨⟩ ↥ (ℤ.+ ℤ.∣ ↥p↧q ℤ.+ ↥q↧p ∣ / ↧p↧q) ℤ.* ℤ.+ ↧p↧q ≡⟨ cong (λ h → h ℤ.* ℤ.+ ↧p↧q) (↥[p/q]≡p (ℤ.+ ℤ.∣ ↥p↧q ℤ.+ ↥q↧p ∣) ↧p↧q) ⟩ ℤ.+ ℤ.∣ ↥p↧q ℤ.+ ↥q↧p ∣ ℤ.* ℤ.+ ↧p↧q ≤⟨ ℤ.*-monoʳ-≤-pos ↧p↧q-1 (ℤ.+≤+ (ℤ.∣m+n∣≤∣m∣+∣n∣ ↥p↧q ↥q↧p)) ⟩ (ℤ.+ ℤ.∣ ↥p↧q ∣ ℤ.+ ℤ.+ ℤ.∣ ↥q↧p ∣) ℤ.* ℤ.+ ↧p↧q ≡˘⟨ cong₂ (λ h₁ h₂ → (h₁ ℤ.+ h₂) ℤ.* ℤ.+ ↧p↧q) ∣↥p∣↧q≡∣↥p↧q∣ ∣↥q∣↧p≡∣↥q↧p∣ ⟩ (∣↥p∣↧q ℤ.+ ∣↥q∣↧p) ℤ.* ℤ.+ ↧p↧q ≡⟨⟩ (↥∣p∣↧q ℤ.+ ↥∣q∣↧p) ℤ.* ℤ.+ ↧p↧q ≡⟨ cong (ℤ._* ℤ.+ ↧p↧q) (↥[p/q]≡p (↥∣p∣↧q ℤ.+ ↥∣q∣↧p) ↧p↧q) ⟩ ↥ ((↥∣p∣↧q ℤ.+ ↥∣q∣↧p) / ↧p↧q) ℤ.* ℤ.+ ↧p↧q ≡⟨⟩ ↥ (∣ p ∣ + ∣ q ∣) ℤ.* ↧ ∣ p + q ∣ ∎) where open ℤ.≤-Reasoning ↥p↧q = ↥ p ℤ.* ↧ q ↥q↧p = ↥ q ℤ.* ↧ p ↥∣p∣↧q = ↥ ∣ p ∣ ℤ.* ↧ q ↥∣q∣↧p = ↥ ∣ q ∣ ℤ.* ↧ p ∣↥p∣↧q = ℤ.+ ℤ.∣ ↥ p ∣ ℤ.* ↧ q ∣↥q∣↧p = ℤ.+ ℤ.∣ ↥ q ∣ ℤ.* ↧ p ↧p↧q = ↧ₙ p ℕ.* ↧ₙ q ∣m∣n≡∣mn∣ : ∀ m n → ℤ.+ ℤ.∣ m ∣ ℤ.* ℤ.+ n ≡ ℤ.+ ℤ.∣ m ℤ.* ℤ.+ n ∣ ∣m∣n≡∣mn∣ m n = begin-equality ℤ.+ ℤ.∣ m ∣ ℤ.* ℤ.+ n ≡⟨⟩ ℤ.+ ℤ.∣ m ∣ ℤ.* ℤ.+ ℤ.∣ ℤ.+ n ∣ ≡⟨ ℤ.pos-distrib-* ℤ.∣ m ∣ ℤ.∣ ℤ.+ n ∣ ⟩ ℤ.+ (ℤ.∣ m ∣ ℕ.* n) ≡⟨⟩ ℤ.+ (ℤ.∣ m ∣ ℕ.* ℤ.∣ ℤ.+ n ∣) ≡˘⟨ cong ℤ.+_ (ℤ.∣m*n∣≡∣m∣*∣n∣ m (ℤ.+ n)) ⟩ ℤ.+ (ℤ.∣ m ℤ.* ℤ.+ n ∣) ∎ ∣↥p∣↧q≡∣↥p↧q∣ : ∣↥p∣↧q ≡ ℤ.+ ℤ.∣ ↥p↧q ∣ ∣↥p∣↧q≡∣↥p↧q∣ = ∣m∣n≡∣mn∣ (↥ p) (↧ₙ q) ∣↥q∣↧p≡∣↥q↧p∣ : ∣↥q∣↧p ≡ ℤ.+ ℤ.∣ ↥q↧p ∣ ∣↥q∣↧p≡∣↥q↧p∣ = ∣m∣n≡∣mn∣ (↥ q) (↧ₙ p) ↧p↧q-1 = ℚᵘ.denominator-1 q ℕ.+ ℚᵘ.denominator-1 p ℕ.* suc (ℚᵘ.denominator-1 q) ∣p-q∣≤∣p∣+∣q∣ : ∀ p q → ∣ p - q ∣ ≤ ∣ p ∣ + ∣ q ∣ ∣p-q∣≤∣p∣+∣q∣ p q = begin ∣ p - q ∣ ≤⟨ ∣p+q∣≤∣p∣+∣q∣ p (- q) ⟩ ∣ p ∣ + ∣ - q ∣ ≡⟨ cong (∣ p ∣ +_) (∣-p∣≡∣p∣ q) ⟩ ∣ p ∣ + ∣ q ∣ ∎ where open ≤-Reasoning ∣p*q∣≡∣p∣*∣q∣ : ∀ p q → ∣ p * q ∣ ≡ ∣ p ∣ * ∣ q ∣ ∣p*q∣≡∣p∣*∣q∣ p q = begin ∣ p * q ∣ ≡⟨⟩ ∣ (↥ p ⊛ ↥ q) / (↧ₙ p ⍟ ↧ₙ q) ∣ ≡⟨⟩ ℤ.+ ℤ.∣ ↥ p ⊛ ↥ q ∣ / (↧ₙ p ⍟ ↧ₙ q) ≡⟨ cong (λ h → ℤ.+ h / ((↧ₙ p) ⍟ (↧ₙ q))) (ℤ.∣m*n∣≡∣m∣*∣n∣ (↥ p) (↥ q)) ⟩ ℤ.+ (ℤ.∣ ↥ p ∣ ⍟ ℤ.∣ ↥ q ∣) / (↧ₙ p ⍟ ↧ₙ q) ≡˘⟨ cong (_/ (↧ₙ p ⍟ ↧ₙ q)) (ℤ.pos-distrib-* ℤ.∣ ↥ p ∣ ℤ.∣ ↥ q ∣) ⟩ (ℤ.+ ℤ.∣ ↥ p ∣ ⊛ ℤ.+ ℤ.∣ ↥ q ∣) / (↧ₙ p ⍟ ↧ₙ q) ≡⟨⟩ (ℤ.+ ℤ.∣ ↥ p ∣ / ↧ₙ p) * (ℤ.+ ℤ.∣ ↥ q ∣ / ↧ₙ q) ≡⟨⟩ ∣ p ∣ * ∣ q ∣ ∎ where open ≡-Reasoning infixl 7 _⊛_ _⍟_ _⊛_ = ℤ._*_ _⍟_ = ℕ._*_ ∣p*q∣≃∣p∣*∣q∣ : ∀ p q → ∣ p * q ∣ ≃ ∣ p ∣ * ∣ q ∣ ∣p*q∣≃∣p∣*∣q∣ p q = ≃-reflexive (∣p*q∣≡∣p∣*∣q∣ p q) ∣∣p∣∣≡∣p∣ : ∀ p → ∣ ∣ p ∣ ∣ ≡ ∣ p ∣ ∣∣p∣∣≡∣p∣ p = 0≤p⇒∣p∣≡p (0≤∣p∣ p) ∣∣p∣∣≃∣p∣ : ∀ p → ∣ ∣ p ∣ ∣ ≃ ∣ p ∣ ∣∣p∣∣≃∣p∣ p = ≃-reflexive (∣∣p∣∣≡∣p∣ p) ∣-∣-nonNeg : ∀ p → NonNegative ∣ p ∣ ∣-∣-nonNeg (mkℚᵘ +[1+ _ ] _) = _ ∣-∣-nonNeg (mkℚᵘ +0 _) = _ ∣-∣-nonNeg (mkℚᵘ -[1+ _ ] _) = _ ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.5 neg-mono-<-> = neg-mono-< {-# WARNING_ON_USAGE neg-mono-<-> "Warning: neg-mono-<-> was deprecated in v1.5. Please use neg-mono-< instead." #-} agda-stdlib-1.7.3/src/Data/Rational/Unnormalised/Solver.agda000066400000000000000000000013651451211343400236410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Automatic solvers for equations over rationals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Rational.Unnormalised.Solver where import Algebra.Solver.Ring.Simple as Solver import Algebra.Solver.Ring.AlmostCommutativeRing as ACR open import Data.Rational.Unnormalised.Properties using (_≃?_; +-*-commutativeRing) ------------------------------------------------------------------------ -- A module for automatically solving propositional equivalences -- containing _+_ and _*_ module +-*-Solver = Solver (ACR.fromCommutativeRing +-*-commutativeRing) _≃?_ agda-stdlib-1.7.3/src/Data/Record.agda000066400000000000000000000146401451211343400173740ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Record types with manifest fields and "with", based on Randy -- Pollack's "Dependently Typed Records in Type Theory" ------------------------------------------------------------------------ -- For an example of how this module can be used, see README.Record. {-# OPTIONS --cubical-compatible --safe #-} open import Data.Bool.Base using (true; false; if_then_else_) open import Data.Empty open import Data.List.Base open import Data.Product hiding (proj₁; proj₂) open import Data.Unit.Polymorphic open import Function open import Level open import Relation.Binary open import Relation.Binary.PropositionalEquality open import Relation.Nullary open import Relation.Nullary.Decidable -- The module is parametrised by the type of labels, which should come -- with decidable equality. module Data.Record {ℓ} (Label : Set ℓ) (_≟_ : Decidable {A = Label} _≡_) where ------------------------------------------------------------------------ -- A Σ-type with a manifest field -- A variant of Σ where the value of the second field is "manifest" -- (given by the first). infix 4 _, record Manifest-Σ {a b} (A : Set a) {B : A → Set b} (f : (x : A) → B x) : Set a where constructor _, field proj₁ : A proj₂ : B proj₁ proj₂ = f proj₁ ------------------------------------------------------------------------ -- Signatures and records mutual infixl 5 _,_∶_ _,_≔_ data Signature s : Set (suc s ⊔ ℓ) where ∅ : Signature s _,_∶_ : (Sig : Signature s) (ℓ : Label) (A : Record Sig → Set s) → Signature s _,_≔_ : (Sig : Signature s) (ℓ : Label) {A : Record Sig → Set s} (a : (r : Record Sig) → A r) → Signature s -- Record is a record type to ensure that the signature can be -- inferred from a value of type Record Sig. record Record {s} (Sig : Signature s) : Set s where eta-equality inductive constructor rec field fun : Record-fun Sig Record-fun : ∀ {s} → Signature s → Set s Record-fun ∅ = ⊤ Record-fun (Sig , ℓ ∶ A) = Σ (Record Sig) A Record-fun (Sig , ℓ ≔ a) = Manifest-Σ (Record Sig) a ------------------------------------------------------------------------ -- Labels -- A signature's labels, starting with the last one. labels : ∀ {s} → Signature s → List Label labels ∅ = [] labels (Sig , ℓ ∶ A) = ℓ ∷ labels Sig labels (Sig , ℓ ≔ a) = ℓ ∷ labels Sig -- Inhabited if the label is part of the signature. infix 4 _∈_ _∈_ : ∀ {s} → Label → Signature s → Set ℓ ∈ Sig = foldr (λ ℓ′ → if does (ℓ ≟ ℓ′) then (λ _ → ⊤) else id) ⊥ (labels Sig) ------------------------------------------------------------------------ -- Projections -- Signature restriction and projection. (Restriction means removal of -- a given field and all subsequent fields.) Restrict : ∀ {s} (Sig : Signature s) (ℓ : Label) → ℓ ∈ Sig → Signature s Restrict ∅ ℓ () Restrict (Sig , ℓ′ ∶ A) ℓ ℓ∈ with does (ℓ ≟ ℓ′) ... | true = Sig ... | false = Restrict Sig ℓ ℓ∈ Restrict (Sig , ℓ′ ≔ a) ℓ ℓ∈ with does (ℓ ≟ ℓ′) ... | true = Sig ... | false = Restrict Sig ℓ ℓ∈ Restricted : ∀ {s} (Sig : Signature s) (ℓ : Label) → ℓ ∈ Sig → Set s Restricted Sig ℓ ℓ∈ = Record (Restrict Sig ℓ ℓ∈) Proj : ∀ {s} (Sig : Signature s) (ℓ : Label) {ℓ∈ : ℓ ∈ Sig} → Restricted Sig ℓ ℓ∈ → Set s Proj ∅ ℓ {} Proj (Sig , ℓ′ ∶ A) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = A ... | false = Proj Sig ℓ {ℓ∈} Proj (_,_≔_ Sig ℓ′ {A = A} a) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = A ... | false = Proj Sig ℓ {ℓ∈} -- Record restriction and projection. infixl 5 _∣_ _∣_ : ∀ {s} {Sig : Signature s} → Record Sig → (ℓ : Label) {ℓ∈ : ℓ ∈ Sig} → Restricted Sig ℓ ℓ∈ _∣_ {Sig = ∅} r ℓ {} _∣_ {Sig = Sig , ℓ′ ∶ A} (rec r) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = Σ.proj₁ r ... | false = _∣_ (Σ.proj₁ r) ℓ {ℓ∈} _∣_ {Sig = Sig , ℓ′ ≔ a} (rec r) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = Manifest-Σ.proj₁ r ... | false = _∣_ (Manifest-Σ.proj₁ r) ℓ {ℓ∈} infixl 5 _·_ _·_ : ∀ {s} {Sig : Signature s} (r : Record Sig) (ℓ : Label) {ℓ∈ : ℓ ∈ Sig} → Proj Sig ℓ {ℓ∈} (r ∣ ℓ) _·_ {Sig = ∅} r ℓ {} _·_ {Sig = Sig , ℓ′ ∶ A} (rec r) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = Σ.proj₂ r ... | false = _·_ (Σ.proj₁ r) ℓ {ℓ∈} _·_ {Sig = Sig , ℓ′ ≔ a} (rec r) ℓ {ℓ∈} with does (ℓ ≟ ℓ′) ... | true = Manifest-Σ.proj₂ r ... | false = _·_ (Manifest-Σ.proj₁ r) ℓ {ℓ∈} ------------------------------------------------------------------------ -- With -- Sig With ℓ ≔ a is the signature Sig, but with the ℓ field set to a. mutual infixl 5 _With_≔_ _With_≔_ : ∀ {s} (Sig : Signature s) (ℓ : Label) {ℓ∈ : ℓ ∈ Sig} → ((r : Restricted Sig ℓ ℓ∈) → Proj Sig ℓ r) → Signature s _With_≔_ ∅ ℓ {} a _With_≔_ (Sig , ℓ′ ∶ A) ℓ {ℓ∈} a with does (ℓ ≟ ℓ′) ... | true = Sig , ℓ′ ≔ a ... | false = _With_≔_ Sig ℓ {ℓ∈} a , ℓ′ ∶ A ∘ drop-With _With_≔_ (Sig , ℓ′ ≔ a′) ℓ {ℓ∈} a with does (ℓ ≟ ℓ′) ... | true = Sig , ℓ′ ≔ a ... | false = _With_≔_ Sig ℓ {ℓ∈} a , ℓ′ ≔ a′ ∘ drop-With drop-With : ∀ {s} {Sig : Signature s} {ℓ : Label} {ℓ∈ : ℓ ∈ Sig} {a : (r : Restricted Sig ℓ ℓ∈) → Proj Sig ℓ r} → Record (_With_≔_ Sig ℓ {ℓ∈} a) → Record Sig drop-With {Sig = ∅} {ℓ∈ = ()} r drop-With {Sig = Sig , ℓ′ ∶ A} {ℓ} (rec r) with does (ℓ ≟ ℓ′) ... | true = rec (Manifest-Σ.proj₁ r , Manifest-Σ.proj₂ r) ... | false = rec (drop-With (Σ.proj₁ r) , Σ.proj₂ r) drop-With {Sig = Sig , ℓ′ ≔ a} {ℓ} (rec r) with does (ℓ ≟ ℓ′) ... | true = rec (Manifest-Σ.proj₁ r ,) ... | false = rec (drop-With (Manifest-Σ.proj₁ r) ,) agda-stdlib-1.7.3/src/Data/Refinement.agda000066400000000000000000000024461451211343400202530ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Refinement type: a value together with an erased proof. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Refinement where open import Level open import Data.Erased as Erased using (Erased) open import Function.Base open import Relation.Unary private variable a b p q : Level A : Set a B : Set b record Refinement {a p} (A : Set a) (P : A → Set p) : Set (a ⊔ p) where constructor _,_ field value : A proof : Erased (P value) open Refinement public -- The syntax declaration below is meant to mimick set comprehension. -- It is attached to Refinement-syntax, to make it easy to import -- Data.Refinement without the special syntax. infix 2 Refinement-syntax Refinement-syntax = Refinement syntax Refinement-syntax A (λ x → P) = [ x ∈ A ∣ P ] module _ {P : A → Set p} {Q : B → Set q} where map : (f : A → B) → ∀[ P ⇒ f ⊢ Q ] → [ a ∈ A ∣ P a ] → [ b ∈ B ∣ Q b ] map f prf (a , p) = f a , Erased.map prf p module _ {P : A → Set p} {Q : A → Set q} where refine : ∀[ P ⇒ Q ] → [ a ∈ A ∣ P a ] → [ a ∈ A ∣ Q a ] refine = map id agda-stdlib-1.7.3/src/Data/Refinement/000077500000000000000000000000001451211343400174275ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Refinement/Relation/000077500000000000000000000000001451211343400212045ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Refinement/Relation/Unary/000077500000000000000000000000001451211343400223025ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Refinement/Relation/Unary/All.agda000066400000000000000000000011161451211343400236270ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Predicate lifting for refinement types ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Refinement.Relation.Unary.All where open import Level open import Data.Refinement open import Function.Base open import Relation.Unary private variable a b p q : Level A : Set a B : Set b module _ {P : A → Set p} where All : (A → Set q) → Refinement A P → Set q All P (a , _) = P a agda-stdlib-1.7.3/src/Data/ReflexiveClosure.agda000066400000000000000000000010651451211343400214410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use the -- Relation.Binary.Construct.Closure.Reflexive module directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.ReflexiveClosure where open import Relation.Binary.Construct.Closure.Reflexive public {-# WARNING_ON_IMPORT "Data.ReflexiveClosure was deprecated in v0.16. Use Relation.Binary.Construct.Closure.Reflexive instead." #-} agda-stdlib-1.7.3/src/Data/Sign.agda000066400000000000000000000006631451211343400170560ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Signs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sign where ------------------------------------------------------------------------ -- Definition open import Data.Sign.Base public open import Data.Sign.Properties public using (_≟_) agda-stdlib-1.7.3/src/Data/Sign/000077500000000000000000000000001451211343400162335ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Sign/Base.agda000066400000000000000000000014761451211343400177330ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Signs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sign.Base where open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality using (_≡_; refl) open import Relation.Nullary using (yes; no) ------------------------------------------------------------------------ -- Definition data Sign : Set where - : Sign + : Sign ------------------------------------------------------------------------ -- Operations -- The opposite sign. opposite : Sign → Sign opposite - = + opposite + = - -- "Multiplication". infixl 7 _*_ _*_ : Sign → Sign → Sign + * s₂ = s₂ - * s₂ = opposite s₂ agda-stdlib-1.7.3/src/Data/Sign/Instances.agda000066400000000000000000000007211451211343400210000ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances for signs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sign.Instances where open import Data.Sign.Properties open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) instance Sign-≡-isDecEquivalence = isDecEquivalence _≟_ agda-stdlib-1.7.3/src/Data/Sign/Properties.agda000066400000000000000000000102741451211343400212110ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Some properties about signs ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sign.Properties where open import Algebra.Bundles open import Data.Empty open import Data.Sign.Base open import Data.Product using (_,_) open import Function open import Level using (0ℓ) open import Relation.Binary using (Decidable; Setoid; DecSetoid) open import Relation.Binary.PropositionalEquality open import Relation.Nullary using (yes; no) open import Algebra.Structures {A = Sign} _≡_ open import Algebra.Definitions {A = Sign} _≡_ ------------------------------------------------------------------------ -- Equality infix 4 _≟_ _≟_ : Decidable {A = Sign} _≡_ - ≟ - = yes refl - ≟ + = no λ() + ≟ - = no λ() + ≟ + = yes refl ≡-setoid : Setoid 0ℓ 0ℓ ≡-setoid = setoid Sign ≡-decSetoid : DecSetoid 0ℓ 0ℓ ≡-decSetoid = decSetoid _≟_ ------------------------------------------------------------------------ -- opposite s≢opposite[s] : ∀ s → s ≢ opposite s s≢opposite[s] - () s≢opposite[s] + () opposite-injective : ∀ {s t} → opposite s ≡ opposite t → s ≡ t opposite-injective { - } { - } refl = refl opposite-injective { + } { + } refl = refl ------------------------------------------------------------------------ -- _*_ -- Algebraic properties of _*_ *-identityˡ : LeftIdentity + _*_ *-identityˡ _ = refl *-identityʳ : RightIdentity + _*_ *-identityʳ - = refl *-identityʳ + = refl *-identity : Identity + _*_ *-identity = *-identityˡ , *-identityʳ *-comm : Commutative _*_ *-comm + + = refl *-comm + - = refl *-comm - + = refl *-comm - - = refl *-assoc : Associative _*_ *-assoc + + _ = refl *-assoc + - _ = refl *-assoc - + _ = refl *-assoc - - + = refl *-assoc - - - = refl *-cancelʳ-≡ : RightCancellative _*_ *-cancelʳ-≡ - - _ = refl *-cancelʳ-≡ - + eq = ⊥-elim (s≢opposite[s] _ $ sym eq) *-cancelʳ-≡ + - eq = ⊥-elim (s≢opposite[s] _ eq) *-cancelʳ-≡ + + _ = refl *-cancelˡ-≡ : LeftCancellative _*_ *-cancelˡ-≡ - eq = opposite-injective eq *-cancelˡ-≡ + eq = eq *-cancel-≡ : Cancellative _*_ *-cancel-≡ = *-cancelˡ-≡ , *-cancelʳ-≡ *-isMagma : IsMagma _*_ *-isMagma = record { isEquivalence = isEquivalence ; ∙-cong = cong₂ _*_ } *-magma : Magma 0ℓ 0ℓ *-magma = record { isMagma = *-isMagma } *-isSemigroup : IsSemigroup _*_ *-isSemigroup = record { isMagma = *-isMagma ; assoc = *-assoc } *-semigroup : Semigroup 0ℓ 0ℓ *-semigroup = record { isSemigroup = *-isSemigroup } *-isMonoid : IsMonoid _*_ + *-isMonoid = record { isSemigroup = *-isSemigroup ; identity = *-identity } *-monoid : Monoid 0ℓ 0ℓ *-monoid = record { isMonoid = *-isMonoid } -- Other properties of _*_ s*s≡+ : ∀ s → s * s ≡ + s*s≡+ + = refl s*s≡+ - = refl s*opposite[s]≡- : ∀ s → s * opposite s ≡ - s*opposite[s]≡- + = refl s*opposite[s]≡- - = refl opposite[s]*s≡- : ∀ s → opposite s * s ≡ - opposite[s]*s≡- + = refl opposite[s]*s≡- - = refl ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. opposite-not-equal = s≢opposite[s] {-# WARNING_ON_USAGE opposite-not-equal "Warning: opposite-not-equal was deprecated in v0.15. Please use s≢opposite[s] instead." #-} opposite-cong = opposite-injective {-# WARNING_ON_USAGE opposite-cong "Warning: opposite-cong was deprecated in v0.15. Please use opposite-injective instead." #-} cancel-*-left = *-cancelˡ-≡ {-# WARNING_ON_USAGE cancel-*-left "Warning: cancel-*-left was deprecated in v0.15. Please use *-cancelˡ-≡ instead." #-} cancel-*-right = *-cancelʳ-≡ {-# WARNING_ON_USAGE cancel-*-right "Warning: cancel-*-right was deprecated in v0.15. Please use *-cancelʳ-≡ instead." #-} *-cancellative = *-cancel-≡ {-# WARNING_ON_USAGE *-cancellative "Warning: *-cancellative was deprecated in v0.15. Please use *-cancel-≡ instead." #-} agda-stdlib-1.7.3/src/Data/Star.agda000066400000000000000000000010721451211343400170620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use the -- Relation.Binary.Construct.Closure.ReflexiveTransitive module directly ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Star where open import Relation.Binary.Construct.Closure.ReflexiveTransitive public {-# WARNING_ON_IMPORT "Data.Star was deprecated in v0.16. Use Relation.Binary.Construct.Closure.ReflexiveTransitive instead." #-} agda-stdlib-1.7.3/src/Data/Star/000077500000000000000000000000001451211343400162445ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Star/BoundedVec.agda000066400000000000000000000034451451211343400211060ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Bounded vectors (inefficient implementation) ------------------------------------------------------------------------ -- Vectors of a specified maximum length. {-# OPTIONS --with-K --safe #-} module Data.Star.BoundedVec where import Data.Maybe.Base as Maybe open import Data.Star.Nat open import Data.Star.Decoration open import Data.Star.Pointer open import Data.Star.List using (List) open import Data.Unit open import Function open import Relation.Binary open import Relation.Binary.Consequences open import Relation.Binary.Construct.Closure.ReflexiveTransitive ------------------------------------------------------------------------ -- The type -- Finite sets decorated with elements (note the use of suc). BoundedVec : Set → ℕ → Set BoundedVec a n = Any (λ _ → a) (λ _ → ⊤) (suc n) [] : ∀ {a n} → BoundedVec a n [] = this tt infixr 5 _∷_ _∷_ : ∀ {a n} → a → BoundedVec a n → BoundedVec a (suc n) _∷_ = that ------------------------------------------------------------------------ -- Increasing the bound -- Note that this operation is linear in the length of the list. ↑ : ∀ {a n} → BoundedVec a n → BoundedVec a (suc n) ↑ {a} = gmap inc lift where inc = Maybe.map (map-NonEmpty suc) lift : Pointer (λ _ → a) (λ _ → ⊤) =[ inc ]⇒ Pointer (λ _ → a) (λ _ → ⊤) lift (step x) = step x lift (done _) = done _ ------------------------------------------------------------------------ -- Conversions fromList : ∀ {a} → (xs : List a) → BoundedVec a (length xs) fromList ε = [] fromList (x ◅ xs) = x ∷ fromList xs toList : ∀ {a n} → BoundedVec a n → List a toList xs = gmap (const tt) decoration (init xs) agda-stdlib-1.7.3/src/Data/Star/Decoration.agda000066400000000000000000000071031451211343400211520ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Decorated star-lists ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Star.Decoration where open import Data.Unit open import Function open import Level open import Relation.Binary open import Relation.Binary.Construct.Closure.ReflexiveTransitive -- A predicate on relation "edges" (think of the relation as a graph). EdgePred : {ℓ r : Level} (p : Level) {I : Set ℓ} → Rel I r → Set (suc p ⊔ ℓ ⊔ r) EdgePred p T = ∀ {i j} → T i j → Set p data NonEmptyEdgePred {ℓ r p : Level} {I : Set ℓ} (T : Rel I r) (P : EdgePred p T) : Set (ℓ ⊔ r ⊔ p) where nonEmptyEdgePred : ∀ {i j} {x : T i j} (p : P x) → NonEmptyEdgePred T P -- Decorating an edge with more information. data DecoratedWith {ℓ r p : Level} {I : Set ℓ} {T : Rel I r} (P : EdgePred p T) : Rel (NonEmpty (Star T)) (ℓ ⊔ r ⊔ p) where ↦ : ∀ {i j k} {x : T i j} {xs : Star T j k} (p : P x) → DecoratedWith P (nonEmpty (x ◅ xs)) (nonEmpty xs) module _ {ℓ r p : Level} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} where edge : ∀ {i j} → DecoratedWith {T = T} P i j → NonEmpty T edge (↦ {x = x} p) = nonEmpty x decoration : ∀ {i j} → (d : DecoratedWith {T = T} P i j) → P (NonEmpty.proof (edge d)) decoration (↦ p) = p -- Star-lists decorated with extra information. All P xs means that -- all edges in xs satisfy P. All : ∀ {ℓ r p} {I : Set ℓ} {T : Rel I r} → EdgePred p T → EdgePred (ℓ ⊔ (r ⊔ p)) (Star T) All P {j = j} xs = Star (DecoratedWith P) (nonEmpty xs) (nonEmpty {y = j} ε) -- We can map over decorated vectors. gmapAll : ∀ {ℓ ℓ′ r p q} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} {J : Set ℓ′} {U : Rel J r} {Q : EdgePred q U} {i j} {xs : Star T i j} (f : I → J) (g : T =[ f ]⇒ U) → (∀ {i j} {x : T i j} → P x → Q (g x)) → All P xs → All {T = U} Q (gmap f g xs) gmapAll f g h ε = ε gmapAll f g h (↦ x ◅ xs) = ↦ (h x) ◅ gmapAll f g h xs -- Since we don't automatically have gmap id id xs ≡ xs it is easier -- to implement mapAll in terms of map than in terms of gmapAll. mapAll : ∀ {ℓ r p q} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} {Q : EdgePred q T} {i j} {xs : Star T i j} → (∀ {i j} {x : T i j} → P x → Q x) → All P xs → All Q xs mapAll {P = P} {Q} f ps = map F ps where F : DecoratedWith P ⇒ DecoratedWith Q F (↦ x) = ↦ (f x) -- We can decorate star-lists with universally true predicates. decorate : ∀ {ℓ r p} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} {i j} → (∀ {i j} (x : T i j) → P x) → (xs : Star T i j) → All P xs decorate f ε = ε decorate f (x ◅ xs) = ↦ (f x) ◅ decorate f xs -- We can append Alls. Unfortunately _◅◅_ does not quite work. infixr 5 _◅◅◅_ _▻▻▻_ _◅◅◅_ : ∀ {ℓ r p} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} {i j k} {xs : Star T i j} {ys : Star T j k} → All P xs → All P ys → All P (xs ◅◅ ys) ε ◅◅◅ ys = ys (↦ x ◅ xs) ◅◅◅ ys = ↦ x ◅ xs ◅◅◅ ys _▻▻▻_ : ∀ {ℓ r p} {I : Set ℓ} {T : Rel I r} {P : EdgePred p T} {i j k} {xs : Star T j k} {ys : Star T i j} → All P xs → All P ys → All P (xs ▻▻ ys) _▻▻▻_ = flip _◅◅◅_ agda-stdlib-1.7.3/src/Data/Star/Environment.agda000066400000000000000000000024721451211343400213730ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Environments (heterogeneous collections) ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Star.Environment {ℓ} (Ty : Set ℓ) where open import Level open import Data.Star.List open import Data.Star.Decoration open import Data.Star.Pointer as Pointer hiding (lookup) open import Data.Unit open import Function hiding (_∋_) open import Relation.Binary.PropositionalEquality open import Relation.Binary.Construct.Closure.ReflexiveTransitive -- Contexts, listing the types of all the elements in an environment. Ctxt : Set ℓ Ctxt = List Ty -- Variables (de Bruijn indices); pointers into environments. infix 4 _∋_ _∋_ : Ctxt → Ty → Set ℓ Γ ∋ σ = Any (const (Lift ℓ ⊤)) (σ ≡_) Γ vz : ∀ {Γ σ} → Γ ▻ σ ∋ σ vz = this refl vs : ∀ {Γ σ τ} → Γ ∋ τ → Γ ▻ σ ∋ τ vs = that _ -- Environments. The T function maps types to element types. Env : ∀ {e} → (Ty → Set e) → (Ctxt → Set (ℓ ⊔ e)) Env T Γ = All T Γ -- A safe lookup function for environments. lookup : ∀ {Γ σ} {T : Ty → Set} → Γ ∋ σ → Env T Γ → T σ lookup i ρ with Pointer.lookup i ρ ... | result refl x = x agda-stdlib-1.7.3/src/Data/Star/Fin.agda000066400000000000000000000012211451211343400175720ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Finite sets defined using the reflexive-transitive closure, Star ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Star.Fin where open import Data.Star.Nat as ℕ using (ℕ) open import Data.Star.Pointer open import Data.Unit -- Finite sets are undecorated pointers into natural numbers. Fin : ℕ → Set Fin = Any (λ _ → ⊤) (λ _ → ⊤) -- "Constructors". zero : ∀ {n} → Fin (ℕ.suc n) zero = this tt suc : ∀ {n} → Fin n → Fin (ℕ.suc n) suc = that tt agda-stdlib-1.7.3/src/Data/Star/List.agda000066400000000000000000000016131451211343400177760ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Lists defined in terms of the reflexive-transitive closure, Star ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Star.List where open import Data.Star.Nat open import Data.Unit open import Relation.Binary.Construct.Always using (Always) open import Relation.Binary.Construct.Constant using (Const) open import Relation.Binary.Construct.Closure.ReflexiveTransitive -- Lists. List : ∀ {a} → Set a → Set a List A = Star (Const A) tt tt -- Nil and cons. [] : ∀ {a} {A : Set a} → List A [] = ε infixr 5 _∷_ _∷_ : ∀ {a} {A : Set a} → A → List A → List A _∷_ = _◅_ -- The sum of the elements in a list containing natural numbers. sum : List ℕ → ℕ sum = fold (Star Always) _+_ zero agda-stdlib-1.7.3/src/Data/Star/Nat.agda000066400000000000000000000021671451211343400176120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Natural numbers defined using the reflexive-transitive closure, Star ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Star.Nat where open import Data.Unit open import Function open import Relation.Binary open import Relation.Binary.Construct.Closure.ReflexiveTransitive open import Relation.Binary.Construct.Always using (Always) -- Natural numbers. ℕ : Set ℕ = Star Always tt tt -- Zero and successor. zero : ℕ zero = ε suc : ℕ → ℕ suc = _◅_ _ -- The length of a star-list. length : ∀ {i t} {I : Set i} {T : Rel I t} {i j} → Star T i j → ℕ length = gmap (const _) (const _) -- Arithmetic. infixl 7 _*_ infixl 6 _+_ _∸_ _+_ : ℕ → ℕ → ℕ _+_ = _◅◅_ _*_ : ℕ → ℕ → ℕ _*_ m = const m ⋆ _∸_ : ℕ → ℕ → ℕ m ∸ ε = m ε ∸ (_ ◅ n) = zero (_ ◅ m) ∸ (_ ◅ n) = m ∸ n -- Some constants. 0# = zero 1# = suc 0# 2# = suc 1# 3# = suc 2# 4# = suc 3# 5# = suc 4# agda-stdlib-1.7.3/src/Data/Star/Pointer.agda000066400000000000000000000066061451211343400205120ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointers into star-lists ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Star.Pointer {ℓ} {I : Set ℓ} where open import Data.Maybe.Base using (Maybe; nothing; just) open import Data.Star.Decoration open import Data.Unit open import Function open import Level open import Relation.Binary open import Relation.Binary.Construct.Closure.ReflexiveTransitive -- Pointers into star-lists. The edge pointed to is decorated with Q, -- while other edges are decorated with P. data Pointer {r p q} {T : Rel I r} (P : EdgePred p T) (Q : EdgePred q T) : Rel (Maybe (NonEmpty (Star T))) (ℓ ⊔ r ⊔ p ⊔ q) where step : ∀ {i j k} {x : T i j} {xs : Star T j k} (p : P x) → Pointer P Q (just (nonEmpty (x ◅ xs))) (just (nonEmpty xs)) done : ∀ {i j k} {x : T i j} {xs : Star T j k} (q : Q x) → Pointer P Q (just (nonEmpty (x ◅ xs))) nothing -- Any P Q xs means that some edge in xs satisfies Q, while all -- preceding edges satisfy P. A star-list of type Any Always Always xs -- is basically a prefix of xs; the existence of such a prefix -- guarantees that xs is non-empty. Any : ∀ {r p q} {T : Rel I r} (P : EdgePred p T) (Q : EdgePred q T) → EdgePred (ℓ ⊔ (r ⊔ (p ⊔ q))) (Star T) Any P Q xs = Star (Pointer P Q) (just (nonEmpty xs)) nothing module _ {r p q} {T : Rel I r} {P : EdgePred p T} {Q : EdgePred q T} where this : ∀ {i j k} {x : T i j} {xs : Star T j k} → Q x → Any P Q (x ◅ xs) this q = done q ◅ ε that : ∀ {i j k} {x : T i j} {xs : Star T j k} → P x → Any P Q xs → Any P Q (x ◅ xs) that p = _◅_ (step p) -- Safe lookup. data Result {r p q} (T : Rel I r) (P : EdgePred p T) (Q : EdgePred q T) : Set (ℓ ⊔ r ⊔ p ⊔ q) where result : ∀ {i j} {x : T i j} (p : P x) (q : Q x) → Result T P Q -- The first argument points out which edge to extract. The edge is -- returned, together with proofs that it satisfies Q and R. module _ {t p q} {T : Rel I t} {P : EdgePred p T} {Q : EdgePred q T} where lookup : ∀ {r} {R : EdgePred r T} {i j} {xs : Star T i j} → Any P Q xs → All R xs → Result T Q R lookup (done q ◅ ε) (↦ r ◅ _) = result q r lookup (step p ◅ ps) (↦ r ◅ rs) = lookup ps rs -- We can define something resembling init. prefixIndex : ∀ {i j} {xs : Star T i j} → Any P Q xs → I prefixIndex (done {i = i} q ◅ _) = i prefixIndex (step p ◅ ps) = prefixIndex ps prefix : ∀ {i j} {xs : Star T i j} → (ps : Any P Q xs) → Star T i (prefixIndex ps) prefix (done q ◅ _) = ε prefix (step {x = x} p ◅ ps) = x ◅ prefix ps -- Here we are taking the initial segment of ps (all elements but the -- last, i.e. all edges satisfying P). init : ∀ {i j} {xs : Star T i j} → (ps : Any P Q xs) → All P (prefix ps) init (done q ◅ _) = ε init (step p ◅ ps) = ↦ p ◅ init ps -- One can simplify the implementation by not carrying around the -- indices in the type: last : ∀ {i j} {xs : Star T i j} → Any P Q xs → NonEmptyEdgePred T Q last ps with lookup {r = p} ps (decorate (const (lift tt)) _) ... | result q _ = nonEmptyEdgePred q agda-stdlib-1.7.3/src/Data/Star/Properties.agda000066400000000000000000000011671451211343400212230ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use the -- Relation.Binary.Construct.Closure.ReflexiveTransitive.Properties -- module directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Star.Properties where open import Relation.Binary.Construct.Closure.ReflexiveTransitive.Properties public {-# WARNING_ON_IMPORT "Data.Star.Properties was deprecated in v0.16. Use Relation.Binary.Construct.Closure.ReflexiveTransitive.Properties instead." #-} agda-stdlib-1.7.3/src/Data/Star/Vec.agda000066400000000000000000000031361451211343400176020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Vectors defined in terms of the reflexive-transitive closure, Star ------------------------------------------------------------------------ {-# OPTIONS --with-K --safe #-} module Data.Star.Vec where open import Data.Star.Nat open import Data.Star.Fin using (Fin) open import Data.Star.Decoration open import Data.Star.Pointer as Pointer hiding (lookup) open import Data.Star.List using (List) open import Relation.Binary open import Relation.Binary.Construct.Closure.ReflexiveTransitive open import Function.Base open import Data.Unit -- The vector type. Vectors are natural numbers decorated with extra -- information (i.e. elements). Vec : Set → ℕ → Set Vec A = All (λ _ → A) -- Nil and cons. [] : ∀ {A} → Vec A zero [] = ε infixr 5 _∷_ _∷_ : ∀ {A n} → A → Vec A n → Vec A (suc n) x ∷ xs = ↦ x ◅ xs -- Projections. head : ∀ {A n} → Vec A (1# + n) → A head (↦ x ◅ _) = x tail : ∀ {A n} → Vec A (1# + n) → Vec A n tail (↦ _ ◅ xs) = xs -- Append. infixr 5 _++_ _++_ : ∀ {A m n} → Vec A m → Vec A n → Vec A (m + n) _++_ = _◅◅◅_ -- Safe lookup. lookup : ∀ {A n} → Fin n → Vec A n → A lookup i xs with Pointer.lookup i xs ... | result _ x = x ------------------------------------------------------------------------ -- Conversions fromList : ∀ {A} → (xs : List A) → Vec A (length xs) fromList ε = [] fromList (x ◅ xs) = x ∷ fromList xs toList : ∀ {A n} → Vec A n → List A toList = gmap (const tt) decoration agda-stdlib-1.7.3/src/Data/String.agda000066400000000000000000000070131451211343400174200ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Strings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.String where open import Data.Bool using (true; false; T?) open import Data.Char as Char using (Char) open import Function.Base open import Data.Nat.Base as ℕ using (ℕ; _∸_; ⌊_/2⌋; ⌈_/2⌉) import Data.Nat.Properties as ℕₚ open import Data.List.Base as List using (List; _∷_; []; [_]) open import Data.List.NonEmpty as NE using (List⁺) open import Data.List.Extrema ℕₚ.≤-totalOrder open import Data.List.Relation.Binary.Pointwise using (Pointwise) open import Data.List.Relation.Binary.Lex.Strict using (Lex-<; Lex-≤) open import Data.Vec.Base as Vec using (Vec) open import Data.Char.Base as Char using (Char) import Data.Char.Properties as Char using (_≟_) open import Function open import Relation.Binary using (Rel) open import Relation.Binary.PropositionalEquality using (_≡_; refl) open import Relation.Nullary using (does) open import Relation.Unary using (Pred; Decidable) open import Data.List.Membership.DecPropositional Char._≟_ ------------------------------------------------------------------------ -- Re-export contents of base, and decidability of equality open import Data.String.Base public open import Data.String.Properties using (_≈?_; _≟_; __ _<+>_ : String → String → String "" <+> b = b a <+> "" = a a <+> b = a ++ " " ++ b ------------------------------------------------------------------------ -- Padding -- Each one of the padding functions should verify the following -- invariant: -- If length str ≤ n then length (padLeft c n str) ≡ n -- and otherwise padLeft c n str ≡ str. -- Appending an empty string is expensive (append for Haskell's -- Text creates a fresh Text value in which both contents are -- copied) so we precompute `n ∸ length str` and check whether -- it is equal to 0. padLeft : Char → ℕ → String → String padLeft c n str with n ∸ length str ... | 0 = str ... | l = replicate l c ++ str padRight : Char → ℕ → String → String padRight c n str with n ∸ length str ... | 0 = str ... | l = str ++ replicate l c padBoth : Char → Char → ℕ → String → String padBoth cₗ cᵣ n str with n ∸ length str ... | 0 = str ... | l = replicate ⌊ l /2⌋ cₗ ++ str ++ replicate ⌈ l /2⌉ cᵣ ------------------------------------------------------------------------ -- Alignment -- We can align a String left, center or right in a column of a given -- width by padding it with whitespace. data Alignment : Set where Left Center Right : Alignment fromAlignment : Alignment → ℕ → String → String fromAlignment Left = padRight ' ' fromAlignment Center = padBoth ' ' ' ' fromAlignment Right = padLeft ' ' agda-stdlib-1.7.3/src/Data/String/Instances.agda000066400000000000000000000007311451211343400213470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Instances for strings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.String.Instances where open import Data.String.Properties open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) instance String-≡-isDecEquivalence = isDecEquivalence _≟_ agda-stdlib-1.7.3/src/Data/String/Literals.agda000066400000000000000000000007341451211343400212020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- String Literals ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.String.Literals where open import Agda.Builtin.FromString open import Data.Unit open import Agda.Builtin.String isString : IsString String isString = record { Constraint = λ _ → ⊤ ; fromString = λ s → s } agda-stdlib-1.7.3/src/Data/String/Properties.agda000066400000000000000000000117251451211343400215610ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of operations on strings ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.String.Properties where open import Data.Bool.Base using (Bool) import Data.Char.Properties as Charₚ import Data.List.Properties as Listₚ import Data.List.Relation.Binary.Pointwise as Pointwise import Data.List.Relation.Binary.Lex.Strict as StrictLex open import Data.String.Base open import Function.Base open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (map′; isYes) open import Relation.Binary open import Relation.Binary.PropositionalEquality.Core import Relation.Binary.Construct.On as On import Relation.Binary.PropositionalEquality as PropEq ------------------------------------------------------------------------ -- Primitive properties open import Agda.Builtin.String.Properties public renaming ( primStringToListInjective to toList-injective) ------------------------------------------------------------------------ -- Properties of _≈_ ≈⇒≡ : _≈_ ⇒ _≡_ ≈⇒≡ = toList-injective _ _ ∘ Pointwise.Pointwise-≡⇒≡ ≈-reflexive : _≡_ ⇒ _≈_ ≈-reflexive = Pointwise.≡⇒Pointwise-≡ ∘ cong toList ≈-refl : Reflexive _≈_ ≈-refl {x} = ≈-reflexive {x} {x} refl ≈-sym : Symmetric _≈_ ≈-sym = Pointwise.symmetric sym ≈-trans : Transitive _≈_ ≈-trans = Pointwise.transitive trans ≈-subst : ∀ {ℓ} → Substitutive _≈_ ℓ ≈-subst P x≈y p = subst P (≈⇒≡ x≈y) p infix 4 _≈?_ _≈?_ : Decidable _≈_ x ≈? y = Pointwise.decidable Charₚ._≟_ (toList x) (toList y) ≈-isEquivalence : IsEquivalence _≈_ ≈-isEquivalence = record { refl = λ {i} → ≈-refl {i} ; sym = λ {i j} → ≈-sym {i} {j} ; trans = λ {i j k} → ≈-trans {i} {j} {k} } ≈-setoid : Setoid _ _ ≈-setoid = record { isEquivalence = ≈-isEquivalence } ≈-isDecEquivalence : IsDecEquivalence _≈_ ≈-isDecEquivalence = record { isEquivalence = ≈-isEquivalence ; _≟_ = _≈?_ } ≈-decSetoid : DecSetoid _ _ ≈-decSetoid = record { isDecEquivalence = ≈-isDecEquivalence } ----------------------------------------------------------------------- -- Properties of _≡_ infix 4 _≟_ _≟_ : Decidable _≡_ x ≟ y = map′ ≈⇒≡ ≈-reflexive $ x ≈? y ≡-setoid : Setoid _ _ ≡-setoid = PropEq.setoid String ≡-decSetoid : DecSetoid _ _ ≡-decSetoid = PropEq.decSetoid _≟_ ------------------------------------------------------------------------ -- Properties of _<_ infix 4 _ x) ≡ x fmapId (inj₁ x) = refl fmapId (inj₂ y) = refl open RawMonad Sₗ.monad -- Now, let's show that "return" is a unit for >>=. We use Lift in exactly -- the same way as above. The data (x : B) then needs to be "lifted" to -- this new type (Lift B). returnUnitL : ∀ {x : B} {f : Lift a B → A ⊎ (Lift a B)} → ((return (lift x)) >>= f) ≡ f (lift x) returnUnitL = refl returnUnitR : (x : A ⊎ (Lift a B)) → (x >>= return) ≡ x returnUnitR (inj₁ _) = refl returnUnitR (inj₂ _) = refl -- And another (limited version of a) monad law... bindCompose : ∀ {f g : Lift a B → A ⊎ (Lift a B)} → (x : A ⊎ (Lift a B)) → ((x >>= f) >>= g) ≡ (x >>= (λ y → (f y >>= g))) bindCompose (inj₁ x) = refl bindCompose (inj₂ y) = refl agda-stdlib-1.7.3/src/Data/Sum/Categorical/Left.agda000066400000000000000000000041631451211343400220300ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A Categorical view of the Sum type (Left-biased) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.Sum.Categorical.Left {a} (A : Set a) (b : Level) where open import Data.Sum.Base open import Category.Functor open import Category.Applicative open import Category.Monad import Function.Identity.Categorical as Id open import Function -- To minimize the universe level of the RawFunctor, we require that elements of -- B are "lifted" to a copy of B at a higher universe level (a ⊔ b). See the -- examples for how this is done. ------------------------------------------------------------------------ -- Left-biased monad instance for _⊎_ Sumₗ : Set (a ⊔ b) → Set (a ⊔ b) Sumₗ B = A ⊎ B functor : RawFunctor Sumₗ functor = record { _<$>_ = map₂ } applicative : RawApplicative Sumₗ applicative = record { pure = inj₂ ; _⊛_ = [ const ∘ inj₁ , map₂ ]′ } -- The monad instance also requires some mucking about with universe levels. monadT : RawMonadT (_∘′ Sumₗ) monadT M = record { return = M.pure ∘ inj₂ ; _>>=_ = λ ma f → ma M.>>= [ M.pure ∘′ inj₁ , f ]′ } where module M = RawMonad M monad : RawMonad Sumₗ monad = monadT Id.monad ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Sumₗ (F A) → F (Sumₗ A) sequenceA (inj₁ a) = pure (inj₁ a) sequenceA (inj₂ x) = inj₂ <$> x mapA : ∀ {A B} → (A → F B) → Sumₗ A → F (Sumₗ B) mapA f = sequenceA ∘ map₂ f forA : ∀ {A B} → Sumₗ A → (A → F B) → F (Sumₗ B) forA = flip mapA module TraversableM {M} (Mon : RawMonad {a ⊔ b} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) agda-stdlib-1.7.3/src/Data/Sum/Categorical/Right.agda000066400000000000000000000033661451211343400222170ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- A Categorical view of the Sum type (Right-biased) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.Sum.Categorical.Right (a : Level) {b} (B : Set b) where open import Data.Sum.Base open import Category.Functor open import Category.Applicative open import Category.Monad open import Function import Function.Identity.Categorical as Id Sumᵣ : Set (a ⊔ b) → Set (a ⊔ b) Sumᵣ A = A ⊎ B functor : RawFunctor Sumᵣ functor = record { _<$>_ = map₁ } applicative : RawApplicative Sumᵣ applicative = record { pure = inj₁ ; _⊛_ = [ map₁ , const ∘ inj₂ ]′ } monadT : RawMonadT (_∘′ Sumᵣ) monadT M = record { return = M.pure ∘′ inj₁ ; _>>=_ = λ ma f → ma M.>>= [ f , M.pure ∘′ inj₂ ]′ } where module M = RawMonad M monad : RawMonad Sumᵣ monad = monadT Id.monad ------------------------------------------------------------------------ -- Get access to other monadic functions module TraversableA {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Sumᵣ (F A) → F (Sumᵣ A) sequenceA (inj₂ a) = pure (inj₂ a) sequenceA (inj₁ x) = inj₁ <$> x mapA : ∀ {A B} → (A → F B) → Sumᵣ A → F (Sumᵣ B) mapA f = sequenceA ∘ map₁ f forA : ∀ {A B} → Sumᵣ A → (A → F B) → F (Sumᵣ B) forA = flip mapA module TraversableM {M} (Mon : RawMonad {a ⊔ b} M) where open RawMonad Mon open TraversableA rawIApplicative public renaming ( sequenceA to sequenceM ; mapA to mapM ; forA to forM ) agda-stdlib-1.7.3/src/Data/Sum/Function/000077500000000000000000000000001451211343400176645ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Sum/Function/Propositional.agda000066400000000000000000000061701451211343400233500ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sum combinators for propositional equality preserving functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Function.Propositional where open import Data.Sum.Base open import Data.Sum.Function.Setoid open import Data.Sum.Relation.Binary.Pointwise using (Pointwise-≡↔≡) open import Function.Equivalence as Eq using (_⇔_; module Equivalence) open import Function.Injection as Inj using (_↣_; module Injection) open import Function.Inverse as Inv using (_↔_; module Inverse) open import Function.LeftInverse as LeftInv using (_↞_; _LeftInverseOf_; module LeftInverse) open import Function.Related open import Function.Surjection as Surj using (_↠_; module Surjection) ------------------------------------------------------------------------ -- Combinators for various function types module _ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} where _⊎-⇔_ : A ⇔ B → C ⇔ D → (A ⊎ C) ⇔ (B ⊎ D) _⊎-⇔_ A⇔B C⇔D = Inverse.equivalence (Pointwise-≡↔≡ B D) ⟨∘⟩ (A⇔B ⊎-equivalence C⇔D) ⟨∘⟩ Eq.sym (Inverse.equivalence (Pointwise-≡↔≡ A C)) where open Eq using () renaming (_∘_ to _⟨∘⟩_) _⊎-↣_ : A ↣ B → C ↣ D → (A ⊎ C) ↣ (B ⊎ D) _⊎-↣_ A↣B C↣D = Inverse.injection (Pointwise-≡↔≡ B D) ⟨∘⟩ (A↣B ⊎-injection C↣D) ⟨∘⟩ Inverse.injection (Inv.sym (Pointwise-≡↔≡ A C)) where open Inj using () renaming (_∘_ to _⟨∘⟩_) _⊎-↞_ : A ↞ B → C ↞ D → (A ⊎ C) ↞ (B ⊎ D) _⊎-↞_ A↞B C↞D = Inverse.left-inverse (Pointwise-≡↔≡ B D) ⟨∘⟩ (A↞B ⊎-left-inverse C↞D) ⟨∘⟩ Inverse.left-inverse (Inv.sym (Pointwise-≡↔≡ A C)) where open LeftInv using () renaming (_∘_ to _⟨∘⟩_) _⊎-↠_ : A ↠ B → C ↠ D → (A ⊎ C) ↠ (B ⊎ D) _⊎-↠_ A↠B C↠D = Inverse.surjection (Pointwise-≡↔≡ B D) ⟨∘⟩ (A↠B ⊎-surjection C↠D) ⟨∘⟩ Inverse.surjection (Inv.sym (Pointwise-≡↔≡ A C)) where open Surj using () renaming (_∘_ to _⟨∘⟩_) _⊎-↔_ : A ↔ B → C ↔ D → (A ⊎ C) ↔ (B ⊎ D) _⊎-↔_ A↔B C↔D = Pointwise-≡↔≡ B D ⟨∘⟩ (A↔B ⊎-inverse C↔D) ⟨∘⟩ Inv.sym (Pointwise-≡↔≡ A C) where open Inv using () renaming (_∘_ to _⟨∘⟩_) module _ {a b c d} {A : Set a} {B : Set b} {C : Set c} {D : Set d} where _⊎-cong_ : ∀ {k} → A ∼[ k ] B → C ∼[ k ] D → (A ⊎ C) ∼[ k ] (B ⊎ D) _⊎-cong_ {implication} = map _⊎-cong_ {reverse-implication} = λ f g → lam (map (app-← f) (app-← g)) _⊎-cong_ {equivalence} = _⊎-⇔_ _⊎-cong_ {injection} = _⊎-↣_ _⊎-cong_ {reverse-injection} = λ f g → lam (app-↢ f ⊎-↣ app-↢ g) _⊎-cong_ {left-inverse} = _⊎-↞_ _⊎-cong_ {surjection} = _⊎-↠_ _⊎-cong_ {bijection} = _⊎-↔_ agda-stdlib-1.7.3/src/Data/Sum/Function/Setoid.agda000066400000000000000000000125641451211343400217410ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sum combinators for setoid equality preserving functions ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Function.Setoid where open import Data.Sum.Base open import Data.Sum.Relation.Binary.Pointwise open import Relation.Binary open import Function.Equality as F using (_⟶_; _⟨$⟩_) open import Function.Equivalence as Eq using (Equivalence; _⇔_; module Equivalence) open import Function.Injection as Inj using (Injection; _↣_; module Injection) open import Function.Inverse as Inv using (Inverse; _↔_; module Inverse) open import Function.LeftInverse as LeftInv using (LeftInverse; _↞_; _LeftInverseOf_; module LeftInverse) open import Function.Related open import Function.Surjection as Surj using (Surjection; _↠_; module Surjection) ------------------------------------------------------------------------ -- Combinators for equality preserving functions module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _⊎-⟶_ : (A ⟶ B) → (C ⟶ D) → (A ⊎ₛ C) ⟶ (B ⊎ₛ D) _⊎-⟶_ f g = record { _⟨$⟩_ = fg ; cong = fg-cong } where open Setoid (A ⊎ₛ C) using () renaming (_≈_ to _≈AC_) open Setoid (B ⊎ₛ D) using () renaming (_≈_ to _≈BD_) fg = map (_⟨$⟩_ f) (_⟨$⟩_ g) fg-cong : _≈AC_ =[ fg ]⇒ _≈BD_ fg-cong (inj₁ x∼₁y) = inj₁ (F.cong f x∼₁y) fg-cong (inj₂ x∼₂y) = inj₂ (F.cong g x∼₂y) module _ {a₁ a₂ b₁ b₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} where inj₁ₛ : A ⟶ (A ⊎ₛ B) inj₁ₛ = record { _⟨$⟩_ = inj₁ ; cong = inj₁ } inj₂ₛ : B ⟶ (A ⊎ₛ B) inj₂ₛ = record { _⟨$⟩_ = inj₂ ; cong = inj₂ } [_,_]ₛ : ∀ {c₁ c₂} {C : Setoid c₁ c₂} → (A ⟶ C) → (B ⟶ C) → (A ⊎ₛ B) ⟶ C [ f , g ]ₛ = record { _⟨$⟩_ = [ f ⟨$⟩_ , g ⟨$⟩_ ] ; cong = λ where (inj₁ x∼₁y) → F.cong f x∼₁y (inj₂ x∼₂y) → F.cong g x∼₂y } module _ {a₁ a₂ b₁ b₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} where swapₛ : (A ⊎ₛ B) ⟶ (B ⊎ₛ A) swapₛ = [ inj₂ₛ , inj₁ₛ ]ₛ ------------------------------------------------------------------------ -- Combinators for more complex function types module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _⊎-equivalence_ : Equivalence A B → Equivalence C D → Equivalence (A ⊎ₛ C) (B ⊎ₛ D) A⇔B ⊎-equivalence C⇔D = record { to = to A⇔B ⊎-⟶ to C⇔D ; from = from A⇔B ⊎-⟶ from C⇔D } where open Equivalence _⊎-injection_ : Injection A B → Injection C D → Injection (A ⊎ₛ C) (B ⊎ₛ D) _⊎-injection_ A↣B C↣D = record { to = to A↣B ⊎-⟶ to C↣D ; injective = inj _ _ } where open Injection open Setoid (A ⊎ₛ C) using () renaming (_≈_ to _≈AC_) open Setoid (B ⊎ₛ D) using () renaming (_≈_ to _≈BD_) inj : ∀ x y → (to A↣B ⊎-⟶ to C↣D) ⟨$⟩ x ≈BD (to A↣B ⊎-⟶ to C↣D) ⟨$⟩ y → x ≈AC y inj (inj₁ x) (inj₁ y) (inj₁ x∼₁y) = inj₁ (injective A↣B x∼₁y) inj (inj₂ x) (inj₂ y) (inj₂ x∼₂y) = inj₂ (injective C↣D x∼₂y) _⊎-left-inverse_ : LeftInverse A B → LeftInverse C D → LeftInverse (A ⊎ₛ C) (B ⊎ₛ D) A↞B ⊎-left-inverse C↞D = record { to = Equivalence.to eq ; from = Equivalence.from eq ; left-inverse-of = [ (λ x → inj₁ (left-inverse-of A↞B x)) , (λ x → inj₂ (left-inverse-of C↞D x)) ] } where open LeftInverse eq = LeftInverse.equivalence A↞B ⊎-equivalence LeftInverse.equivalence C↞D module _ {a₁ a₂ b₁ b₂ c₁ c₂ d₁ d₂} {A : Setoid a₁ a₂} {B : Setoid b₁ b₂} {C : Setoid c₁ c₂} {D : Setoid d₁ d₂} where _⊎-surjection_ : Surjection A B → Surjection C D → Surjection (A ⊎ₛ C) (B ⊎ₛ D) A↠B ⊎-surjection C↠D = record { to = LeftInverse.from inv ; surjective = record { from = LeftInverse.to inv ; right-inverse-of = LeftInverse.left-inverse-of inv } } where open Surjection inv = right-inverse A↠B ⊎-left-inverse right-inverse C↠D _⊎-inverse_ : Inverse A B → Inverse C D → Inverse (A ⊎ₛ C) (B ⊎ₛ D) A↔B ⊎-inverse C↔D = record { to = Surjection.to surj ; from = Surjection.from surj ; inverse-of = record { left-inverse-of = LeftInverse.left-inverse-of inv ; right-inverse-of = Surjection.right-inverse-of surj } } where open Inverse surj = Inverse.surjection A↔B ⊎-surjection Inverse.surjection C↔D inv = Inverse.left-inverse A↔B ⊎-left-inverse Inverse.left-inverse C↔D agda-stdlib-1.7.3/src/Data/Sum/Instances.agda000066400000000000000000000015021451211343400206420ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for sums ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Instances where open import Data.Sum.Base open import Data.Sum.Properties open import Level open import Relation.Binary.PropositionalEquality.Core open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) open import Relation.Binary.TypeClasses private variable a b : Level A : Set a B : Set b instance ⊎-≡-isDecEquivalence : {{IsDecEquivalence {A = A} _≡_}} → {{IsDecEquivalence {A = B} _≡_}} → IsDecEquivalence {A = A ⊎ B} _≡_ ⊎-≡-isDecEquivalence = isDecEquivalence (≡-dec _≟_ _≟_) agda-stdlib-1.7.3/src/Data/Sum/Properties.agda000066400000000000000000000065721451211343400210630ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of sums (disjoint unions) ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Properties where open import Level open import Data.Sum.Base open import Function open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (map′) private variable a b c d e f : Level A : Set a B : Set b C : Set c D : Set d E : Set e F : Set f inj₁-injective : ∀ {x y} → (A ⊎ B ∋ inj₁ x) ≡ inj₁ y → x ≡ y inj₁-injective refl = refl inj₂-injective : ∀ {x y} → (A ⊎ B ∋ inj₂ x) ≡ inj₂ y → x ≡ y inj₂-injective refl = refl module _ (dec₁ : Decidable {A = A} {B = A} _≡_) (dec₂ : Decidable {A = B} {B = B} _≡_) where ≡-dec : Decidable {A = A ⊎ B} _≡_ ≡-dec (inj₁ x) (inj₁ y) = map′ (cong inj₁) inj₁-injective (dec₁ x y) ≡-dec (inj₁ x) (inj₂ y) = no λ() ≡-dec (inj₂ x) (inj₁ y) = no λ() ≡-dec (inj₂ x) (inj₂ y) = map′ (cong inj₂) inj₂-injective (dec₂ x y) swap-involutive : swap {A = A} {B = B} ∘ swap ≗ id swap-involutive = [ (λ _ → refl) , (λ _ → refl) ] map-id : map {A = A} {B = B} id id ≗ id map-id (inj₁ _) = refl map-id (inj₂ _) = refl [,]-∘-distr : (f : A → B) {g : C → A} {h : D → A} → f ∘ [ g , h ] ≗ [ f ∘ g , f ∘ h ] [,]-∘-distr _ (inj₁ _) = refl [,]-∘-distr _ (inj₂ _) = refl [,]-map-commute : {f : A → B} {g : C → D} {f′ : B → E} {g′ : D → E} → [ f′ , g′ ] ∘ map f g ≗ [ f′ ∘ f , g′ ∘ g ] [,]-map-commute (inj₁ _) = refl [,]-map-commute (inj₂ _) = refl map-commute : {f : A → B} {g : C → D} {f′ : B → E} {g′ : D → F} → map f′ g′ ∘ map f g ≗ map (f′ ∘ f) (g′ ∘ g) map-commute (inj₁ _) = refl map-commute (inj₂ _) = refl map₁₂-commute : {f : A → B} {g : C → D} → map₁ f ∘ map₂ g ≗ map₂ g ∘ map₁ f map₁₂-commute (inj₁ _) = refl map₁₂-commute (inj₂ _) = refl [,]-cong : {f f′ : A → B} {g g′ : C → B} → f ≗ f′ → g ≗ g′ → [ f , g ] ≗ [ f′ , g′ ] [,]-cong = [_,_] [-,]-cong : {f f′ : A → B} {g : C → B} → f ≗ f′ → [ f , g ] ≗ [ f′ , g ] [-,]-cong = [_, (λ _ → refl) ] [,-]-cong : {f : A → B} {g g′ : C → B} → g ≗ g′ → [ f , g ] ≗ [ f , g′ ] [,-]-cong = [ (λ _ → refl) ,_] map-cong : {f f′ : A → B} {g g′ : C → D} → f ≗ f′ → g ≗ g′ → map f g ≗ map f′ g′ map-cong f≗f′ g≗g′ (inj₁ x) = cong inj₁ (f≗f′ x) map-cong f≗f′ g≗g′ (inj₂ x) = cong inj₂ (g≗g′ x) map₁-cong : {f f′ : A → B} → f ≗ f′ → map₁ {B = C} f ≗ map₁ f′ map₁-cong f≗f′ = [-,]-cong ((cong inj₁) ∘ f≗f′) map₂-cong : {g g′ : C → D} → g ≗ g′ → map₂ {A = A} g ≗ map₂ g′ map₂-cong g≗g′ = [,-]-cong ((cong inj₂) ∘ g≗g′) agda-stdlib-1.7.3/src/Data/Sum/Relation/000077500000000000000000000000001451211343400176545ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Sum/Relation/Binary/000077500000000000000000000000001451211343400211005ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Sum/Relation/Binary/LeftOrder.agda000066400000000000000000000306021451211343400236050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Sums of binary relations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Relation.Binary.LeftOrder where open import Data.Sum.Base as Sum open import Data.Sum.Relation.Binary.Pointwise as PW using (Pointwise; inj₁; inj₂) open import Data.Product open import Data.Empty open import Function open import Level open import Relation.Nullary import Relation.Nullary.Decidable as Dec open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ---------------------------------------------------------------------- -- Definition infixr 1 _⊎-<_ data _⊎-<_ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} (_∼₁_ : Rel A₁ ℓ₁) (_∼₂_ : Rel A₂ ℓ₂) : Rel (A₁ ⊎ A₂) (a₁ ⊔ a₂ ⊔ ℓ₁ ⊔ ℓ₂) where ₁∼₂ : ∀ {x y} → (_∼₁_ ⊎-< _∼₂_) (inj₁ x) (inj₂ y) ₁∼₁ : ∀ {x y} (x∼₁y : x ∼₁ y) → (_∼₁_ ⊎-< _∼₂_) (inj₁ x) (inj₁ y) ₂∼₂ : ∀ {x y} (x∼₂y : x ∼₂ y) → (_∼₁_ ⊎-< _∼₂_) (inj₂ x) (inj₂ y) ---------------------------------------------------------------------- -- Some properties which are preserved by _⊎-<_ module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {∼₁ : Rel A₁ ℓ₁} {∼₂ : Rel A₂ ℓ₂} where drop-inj₁ : ∀ {x y} → (∼₁ ⊎-< ∼₂) (inj₁ x) (inj₁ y) → ∼₁ x y drop-inj₁ (₁∼₁ x∼₁y) = x∼₁y drop-inj₂ : ∀ {x y} → (∼₁ ⊎-< ∼₂) (inj₂ x) (inj₂ y) → ∼₂ x y drop-inj₂ (₂∼₂ x∼₂y) = x∼₂y ⊎-<-refl : Reflexive ∼₁ → Reflexive ∼₂ → Reflexive (∼₁ ⊎-< ∼₂) ⊎-<-refl refl₁ refl₂ {inj₁ x} = ₁∼₁ refl₁ ⊎-<-refl refl₁ refl₂ {inj₂ y} = ₂∼₂ refl₂ ⊎-<-transitive : Transitive ∼₁ → Transitive ∼₂ → Transitive (∼₁ ⊎-< ∼₂) ⊎-<-transitive trans₁ trans₂ ₁∼₂ (₂∼₂ x∼₂y) = ₁∼₂ ⊎-<-transitive trans₁ trans₂ (₁∼₁ x∼₁y) ₁∼₂ = ₁∼₂ ⊎-<-transitive trans₁ trans₂ (₁∼₁ x∼₁y) (₁∼₁ x∼₁y₁) = ₁∼₁ (trans₁ x∼₁y x∼₁y₁) ⊎-<-transitive trans₁ trans₂ (₂∼₂ x∼₂y) (₂∼₂ x∼₂y₁) = ₂∼₂ (trans₂ x∼₂y x∼₂y₁) ⊎-<-asymmetric : Asymmetric ∼₁ → Asymmetric ∼₂ → Asymmetric (∼₁ ⊎-< ∼₂) ⊎-<-asymmetric asym₁ asym₂ (₁∼₁ x∼₁y) (₁∼₁ x∼₁y₁) = asym₁ x∼₁y x∼₁y₁ ⊎-<-asymmetric asym₁ asym₂ (₂∼₂ x∼₂y) (₂∼₂ x∼₂y₁) = asym₂ x∼₂y x∼₂y₁ ⊎-<-total : Total ∼₁ → Total ∼₂ → Total (∼₁ ⊎-< ∼₂) ⊎-<-total total₁ total₂ = total where total : Total (_ ⊎-< _) total (inj₁ x) (inj₁ y) = Sum.map ₁∼₁ ₁∼₁ $ total₁ x y total (inj₁ x) (inj₂ y) = inj₁ ₁∼₂ total (inj₂ x) (inj₁ y) = inj₂ ₁∼₂ total (inj₂ x) (inj₂ y) = Sum.map ₂∼₂ ₂∼₂ $ total₂ x y ⊎-<-decidable : Decidable ∼₁ → Decidable ∼₂ → Decidable (∼₁ ⊎-< ∼₂) ⊎-<-decidable dec₁ dec₂ (inj₁ x) (inj₁ y) = Dec.map′ ₁∼₁ drop-inj₁ (dec₁ x y) ⊎-<-decidable dec₁ dec₂ (inj₁ x) (inj₂ y) = yes ₁∼₂ ⊎-<-decidable dec₁ dec₂ (inj₂ x) (inj₁ y) = no λ() ⊎-<-decidable dec₁ dec₂ (inj₂ x) (inj₂ y) = Dec.map′ ₂∼₂ drop-inj₂ (dec₂ x y) module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {∼₁ : Rel A₁ ℓ₁} {≈₁ : Rel A₁ ℓ₂} {ℓ₃ ℓ₄} {∼₂ : Rel A₂ ℓ₃} {≈₂ : Rel A₂ ℓ₄} where ⊎-<-reflexive : ≈₁ ⇒ ∼₁ → ≈₂ ⇒ ∼₂ → (Pointwise ≈₁ ≈₂) ⇒ (∼₁ ⊎-< ∼₂) ⊎-<-reflexive refl₁ refl₂ (inj₁ x) = ₁∼₁ (refl₁ x) ⊎-<-reflexive refl₁ refl₂ (inj₂ x) = ₂∼₂ (refl₂ x) ⊎-<-irreflexive : Irreflexive ≈₁ ∼₁ → Irreflexive ≈₂ ∼₂ → Irreflexive (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-irreflexive irrefl₁ irrefl₂ (inj₁ x) (₁∼₁ x∼₁y) = irrefl₁ x x∼₁y ⊎-<-irreflexive irrefl₁ irrefl₂ (inj₂ x) (₂∼₂ x∼₂y) = irrefl₂ x x∼₂y ⊎-<-antisymmetric : Antisymmetric ≈₁ ∼₁ → Antisymmetric ≈₂ ∼₂ → Antisymmetric (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-antisymmetric antisym₁ antisym₂ (₁∼₁ x∼₁y) (₁∼₁ x∼₁y₁) = inj₁ (antisym₁ x∼₁y x∼₁y₁) ⊎-<-antisymmetric antisym₁ antisym₂ (₂∼₂ x∼₂y) (₂∼₂ x∼₂y₁) = inj₂ (antisym₂ x∼₂y x∼₂y₁) ⊎-<-respectsʳ : ∼₁ Respectsʳ ≈₁ → ∼₂ Respectsʳ ≈₂ → (∼₁ ⊎-< ∼₂) Respectsʳ (Pointwise ≈₁ ≈₂) ⊎-<-respectsʳ resp₁ resp₂ (inj₁ x₁) (₁∼₁ x∼₁y) = ₁∼₁ (resp₁ x₁ x∼₁y) ⊎-<-respectsʳ resp₁ resp₂ (inj₂ x₁) ₁∼₂ = ₁∼₂ ⊎-<-respectsʳ resp₁ resp₂ (inj₂ x₁) (₂∼₂ x∼₂y) = ₂∼₂ (resp₂ x₁ x∼₂y) ⊎-<-respectsˡ : ∼₁ Respectsˡ ≈₁ → ∼₂ Respectsˡ ≈₂ → (∼₁ ⊎-< ∼₂) Respectsˡ (Pointwise ≈₁ ≈₂) ⊎-<-respectsˡ resp₁ resp₂ (inj₁ x) ₁∼₂ = ₁∼₂ ⊎-<-respectsˡ resp₁ resp₂ (inj₁ x) (₁∼₁ x∼₁y) = ₁∼₁ (resp₁ x x∼₁y) ⊎-<-respectsˡ resp₁ resp₂ (inj₂ x) (₂∼₂ x∼₂y) = ₂∼₂ (resp₂ x x∼₂y) ⊎-<-respects₂ : ∼₁ Respects₂ ≈₁ → ∼₂ Respects₂ ≈₂ → (∼₁ ⊎-< ∼₂) Respects₂ (Pointwise ≈₁ ≈₂) ⊎-<-respects₂ (r₁ , l₁) (r₂ , l₂) = ⊎-<-respectsʳ r₁ r₂ , ⊎-<-respectsˡ l₁ l₂ ⊎-<-trichotomous : Trichotomous ≈₁ ∼₁ → Trichotomous ≈₂ ∼₂ → Trichotomous (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-trichotomous tri₁ tri₂ (inj₁ x) (inj₂ y) = tri< ₁∼₂ (λ()) (λ()) ⊎-<-trichotomous tri₁ tri₂ (inj₂ x) (inj₁ y) = tri> (λ()) (λ()) ₁∼₂ ⊎-<-trichotomous tri₁ tri₂ (inj₁ x) (inj₁ y) with tri₁ x y ... | tri< x x≮y x≉y x>y = tri> (x≮y ∘ drop-inj₁) (x≉y ∘ PW.drop-inj₁) (₁∼₁ x>y) ⊎-<-trichotomous tri₁ tri₂ (inj₂ x) (inj₂ y) with tri₂ x y ... | tri< x x≮y x≉y x>y = tri> (x≮y ∘ drop-inj₂) (x≉y ∘ PW.drop-inj₂) (₂∼₂ x>y) ---------------------------------------------------------------------- -- Some collections of properties which are preserved module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {≈₁ : Rel A₁ ℓ₁} {∼₁ : Rel A₁ ℓ₂} {ℓ₃ ℓ₄} {≈₂ : Rel A₂ ℓ₃} {∼₂ : Rel A₂ ℓ₄} where ⊎-<-isPreorder : IsPreorder ≈₁ ∼₁ → IsPreorder ≈₂ ∼₂ → IsPreorder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isPreorder pre₁ pre₂ = record { isEquivalence = PW.⊎-isEquivalence (isEquivalence pre₁) (isEquivalence pre₂) ; reflexive = ⊎-<-reflexive (reflexive pre₁) (reflexive pre₂) ; trans = ⊎-<-transitive (trans pre₁) (trans pre₂) } where open IsPreorder ⊎-<-isPartialOrder : IsPartialOrder ≈₁ ∼₁ → IsPartialOrder ≈₂ ∼₂ → IsPartialOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isPartialOrder po₁ po₂ = record { isPreorder = ⊎-<-isPreorder (isPreorder po₁) (isPreorder po₂) ; antisym = ⊎-<-antisymmetric (antisym po₁) (antisym po₂) } where open IsPartialOrder ⊎-<-isStrictPartialOrder : IsStrictPartialOrder ≈₁ ∼₁ → IsStrictPartialOrder ≈₂ ∼₂ → IsStrictPartialOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isStrictPartialOrder spo₁ spo₂ = record { isEquivalence = PW.⊎-isEquivalence (isEquivalence spo₁) (isEquivalence spo₂) ; irrefl = ⊎-<-irreflexive (irrefl spo₁) (irrefl spo₂) ; trans = ⊎-<-transitive (trans spo₁) (trans spo₂) ; <-resp-≈ = ⊎-<-respects₂ (<-resp-≈ spo₁) (<-resp-≈ spo₂) } where open IsStrictPartialOrder ⊎-<-isTotalOrder : IsTotalOrder ≈₁ ∼₁ → IsTotalOrder ≈₂ ∼₂ → IsTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isTotalOrder to₁ to₂ = record { isPartialOrder = ⊎-<-isPartialOrder (isPartialOrder to₁) (isPartialOrder to₂) ; total = ⊎-<-total (total to₁) (total to₂) } where open IsTotalOrder ⊎-<-isDecTotalOrder : IsDecTotalOrder ≈₁ ∼₁ → IsDecTotalOrder ≈₂ ∼₂ → IsDecTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isDecTotalOrder to₁ to₂ = record { isTotalOrder = ⊎-<-isTotalOrder (isTotalOrder to₁) (isTotalOrder to₂) ; _≟_ = PW.⊎-decidable (_≟_ to₁) (_≟_ to₂) ; _≤?_ = ⊎-<-decidable (_≤?_ to₁) (_≤?_ to₂) } where open IsDecTotalOrder ⊎-<-isStrictTotalOrder : IsStrictTotalOrder ≈₁ ∼₁ → IsStrictTotalOrder ≈₂ ∼₂ → IsStrictTotalOrder (Pointwise ≈₁ ≈₂) (∼₁ ⊎-< ∼₂) ⊎-<-isStrictTotalOrder sto₁ sto₂ = record { isEquivalence = PW.⊎-isEquivalence (isEquivalence sto₁) (isEquivalence sto₂) ; trans = ⊎-<-transitive (trans sto₁) (trans sto₂) ; compare = ⊎-<-trichotomous (compare sto₁) (compare sto₂) } where open IsStrictTotalOrder ------------------------------------------------------------------------ -- "Bundles" can also be combined. module _ {a b c d e f} where ⊎-<-preorder : Preorder a b c → Preorder d e f → Preorder _ _ _ ⊎-<-preorder p₁ p₂ = record { isPreorder = ⊎-<-isPreorder (isPreorder p₁) (isPreorder p₂) } where open Preorder ⊎-<-poset : Poset a b c → Poset a b c → Poset _ _ _ ⊎-<-poset po₁ po₂ = record { isPartialOrder = ⊎-<-isPartialOrder (isPartialOrder po₁) (isPartialOrder po₂) } where open Poset ⊎-<-strictPartialOrder : StrictPartialOrder a b c → StrictPartialOrder d e f → StrictPartialOrder _ _ _ ⊎-<-strictPartialOrder spo₁ spo₂ = record { isStrictPartialOrder = ⊎-<-isStrictPartialOrder (isStrictPartialOrder spo₁) (isStrictPartialOrder spo₂) } where open StrictPartialOrder ⊎-<-totalOrder : TotalOrder a b c → TotalOrder d e f → TotalOrder _ _ _ ⊎-<-totalOrder to₁ to₂ = record { isTotalOrder = ⊎-<-isTotalOrder (isTotalOrder to₁) (isTotalOrder to₂) } where open TotalOrder ⊎-<-decTotalOrder : DecTotalOrder a b c → DecTotalOrder d e f → DecTotalOrder _ _ _ ⊎-<-decTotalOrder to₁ to₂ = record { isDecTotalOrder = ⊎-<-isDecTotalOrder (isDecTotalOrder to₁) (isDecTotalOrder to₂) } where open DecTotalOrder ⊎-<-strictTotalOrder : StrictTotalOrder a b c → StrictTotalOrder a b c → StrictTotalOrder _ _ _ ⊎-<-strictTotalOrder sto₁ sto₂ = record { isStrictTotalOrder = ⊎-<-isStrictTotalOrder (isStrictTotalOrder sto₁) (isStrictTotalOrder sto₂) } where open StrictTotalOrder agda-stdlib-1.7.3/src/Data/Sum/Relation/Binary/Pointwise.agda000066400000000000000000000267271451211343400237150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Pointwise sum ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Relation.Binary.Pointwise where open import Data.Product using (_,_) open import Data.Sum.Base as Sum open import Data.Sum.Properties open import Level using (_⊔_) open import Function.Base using (_∘_; id) open import Function.Inverse using (Inverse) open import Relation.Nullary import Relation.Nullary.Decidable as Dec open import Relation.Binary open import Relation.Binary.PropositionalEquality as P using (_≡_) ---------------------------------------------------------------------- -- Definition data Pointwise {a b c d r s} {A : Set a} {B : Set b} {C : Set c} {D : Set d} (R : REL A C r) (S : REL B D s) : REL (A ⊎ B) (C ⊎ D) (a ⊔ b ⊔ c ⊔ d ⊔ r ⊔ s) where inj₁ : ∀ {a c} → R a c → Pointwise R S (inj₁ a) (inj₁ c) inj₂ : ∀ {b d} → S b d → Pointwise R S (inj₂ b) (inj₂ d) ---------------------------------------------------------------------- -- Relational properties module _ {a₁ a₂ ℓ₁ ℓ₂} {A₁ : Set a₁} {A₂ : Set a₂} {∼₁ : Rel A₁ ℓ₁} {∼₂ : Rel A₂ ℓ₂} where drop-inj₁ : ∀ {x y} → Pointwise ∼₁ ∼₂ (inj₁ x) (inj₁ y) → ∼₁ x y drop-inj₁ (inj₁ x) = x drop-inj₂ : ∀ {x y} → Pointwise ∼₁ ∼₂ (inj₂ x) (inj₂ y) → ∼₂ x y drop-inj₂ (inj₂ x) = x ⊎-refl : Reflexive ∼₁ → Reflexive ∼₂ → Reflexive (Pointwise ∼₁ ∼₂) ⊎-refl refl₁ refl₂ {inj₁ x} = inj₁ refl₁ ⊎-refl refl₁ refl₂ {inj₂ y} = inj₂ refl₂ ⊎-symmetric : Symmetric ∼₁ → Symmetric ∼₂ → Symmetric (Pointwise ∼₁ ∼₂) ⊎-symmetric sym₁ sym₂ (inj₁ x) = inj₁ (sym₁ x) ⊎-symmetric sym₁ sym₂ (inj₂ x) = inj₂ (sym₂ x) ⊎-transitive : Transitive ∼₁ → Transitive ∼₂ → Transitive (Pointwise ∼₁ ∼₂) ⊎-transitive trans₁ trans₂ (inj₁ x) (inj₁ y) = inj₁ (trans₁ x y) ⊎-transitive trans₁ trans₂ (inj₂ x) (inj₂ y) = inj₂ (trans₂ x y) ⊎-asymmetric : Asymmetric ∼₁ → Asymmetric ∼₂ → Asymmetric (Pointwise ∼₁ ∼₂) ⊎-asymmetric asym₁ asym₂ (inj₁ x) = λ { (inj₁ y) → asym₁ x y } ⊎-asymmetric asym₁ asym₂ (inj₂ x) = λ { (inj₂ y) → asym₂ x y } ⊎-substitutive : ∀ {ℓ₃} → Substitutive ∼₁ ℓ₃ → Substitutive ∼₂ ℓ₃ → Substitutive (Pointwise ∼₁ ∼₂) ℓ₃ ⊎-substitutive subst₁ subst₂ P (inj₁ x) = subst₁ (P ∘ inj₁) x ⊎-substitutive subst₁ subst₂ P (inj₂ x) = subst₂ (P ∘ inj₂) x ⊎-decidable : Decidable ∼₁ → Decidable ∼₂ → Decidable (Pointwise ∼₁ ∼₂) ⊎-decidable _≟₁_ _≟₂_ (inj₁ x) (inj₁ y) = Dec.map′ inj₁ drop-inj₁ (x ≟₁ y) ⊎-decidable _≟₁_ _≟₂_ (inj₁ x) (inj₂ y) = no λ() ⊎-decidable _≟₁_ _≟₂_ (inj₂ x) (inj₁ y) = no λ() ⊎-decidable _≟₁_ _≟₂_ (inj₂ x) (inj₂ y) = Dec.map′ inj₂ drop-inj₂ (x ≟₂ y) module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {∼₁ : Rel A₁ ℓ₁} {≈₁ : Rel A₁ ℓ₂} {ℓ₃ ℓ₄} {∼₂ : Rel A₂ ℓ₃} {≈₂ : Rel A₂ ℓ₄} where ⊎-reflexive : ≈₁ ⇒ ∼₁ → ≈₂ ⇒ ∼₂ → (Pointwise ≈₁ ≈₂) ⇒ (Pointwise ∼₁ ∼₂) ⊎-reflexive refl₁ refl₂ (inj₁ x) = inj₁ (refl₁ x) ⊎-reflexive refl₁ refl₂ (inj₂ x) = inj₂ (refl₂ x) ⊎-irreflexive : Irreflexive ≈₁ ∼₁ → Irreflexive ≈₂ ∼₂ → Irreflexive (Pointwise ≈₁ ≈₂) (Pointwise ∼₁ ∼₂) ⊎-irreflexive irrefl₁ irrefl₂ (inj₁ x) (inj₁ y) = irrefl₁ x y ⊎-irreflexive irrefl₁ irrefl₂ (inj₂ x) (inj₂ y) = irrefl₂ x y ⊎-antisymmetric : Antisymmetric ≈₁ ∼₁ → Antisymmetric ≈₂ ∼₂ → Antisymmetric (Pointwise ≈₁ ≈₂) (Pointwise ∼₁ ∼₂) ⊎-antisymmetric antisym₁ antisym₂ (inj₁ x) (inj₁ y) = inj₁ (antisym₁ x y) ⊎-antisymmetric antisym₁ antisym₂ (inj₂ x) (inj₂ y) = inj₂ (antisym₂ x y) ⊎-respectsˡ : ∼₁ Respectsˡ ≈₁ → ∼₂ Respectsˡ ≈₂ → (Pointwise ∼₁ ∼₂) Respectsˡ (Pointwise ≈₁ ≈₂) ⊎-respectsˡ resp₁ resp₂ (inj₁ x) (inj₁ y) = inj₁ (resp₁ x y) ⊎-respectsˡ resp₁ resp₂ (inj₂ x) (inj₂ y) = inj₂ (resp₂ x y) ⊎-respectsʳ : ∼₁ Respectsʳ ≈₁ → ∼₂ Respectsʳ ≈₂ → (Pointwise ∼₁ ∼₂) Respectsʳ (Pointwise ≈₁ ≈₂) ⊎-respectsʳ resp₁ resp₂ (inj₁ x) (inj₁ y) = inj₁ (resp₁ x y) ⊎-respectsʳ resp₁ resp₂ (inj₂ x) (inj₂ y) = inj₂ (resp₂ x y) ⊎-respects₂ : ∼₁ Respects₂ ≈₁ → ∼₂ Respects₂ ≈₂ → (Pointwise ∼₁ ∼₂) Respects₂ (Pointwise ≈₁ ≈₂) ⊎-respects₂ (r₁ , l₁) (r₂ , l₂) = ⊎-respectsʳ r₁ r₂ , ⊎-respectsˡ l₁ l₂ ---------------------------------------------------------------------- -- Structures module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {≈₁ : Rel A₁ ℓ₁} {≈₂ : Rel A₂ ℓ₂} where ⊎-isEquivalence : IsEquivalence ≈₁ → IsEquivalence ≈₂ → IsEquivalence (Pointwise ≈₁ ≈₂) ⊎-isEquivalence eq₁ eq₂ = record { refl = ⊎-refl (refl eq₁) (refl eq₂) ; sym = ⊎-symmetric (sym eq₁) (sym eq₂) ; trans = ⊎-transitive (trans eq₁) (trans eq₂) } where open IsEquivalence ⊎-isDecEquivalence : IsDecEquivalence ≈₁ → IsDecEquivalence ≈₂ → IsDecEquivalence (Pointwise ≈₁ ≈₂) ⊎-isDecEquivalence eq₁ eq₂ = record { isEquivalence = ⊎-isEquivalence (isEquivalence eq₁) (isEquivalence eq₂) ; _≟_ = ⊎-decidable (_≟_ eq₁) (_≟_ eq₂) } where open IsDecEquivalence module _ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} {ℓ₁ ℓ₂} {≈₁ : Rel A₁ ℓ₁} {∼₁ : Rel A₁ ℓ₂} {ℓ₃ ℓ₄} {≈₂ : Rel A₂ ℓ₃} {∼₂ : Rel A₂ ℓ₄} where ⊎-isPreorder : IsPreorder ≈₁ ∼₁ → IsPreorder ≈₂ ∼₂ → IsPreorder (Pointwise ≈₁ ≈₂) (Pointwise ∼₁ ∼₂) ⊎-isPreorder pre₁ pre₂ = record { isEquivalence = ⊎-isEquivalence (isEquivalence pre₁) (isEquivalence pre₂) ; reflexive = ⊎-reflexive (reflexive pre₁) (reflexive pre₂) ; trans = ⊎-transitive (trans pre₁) (trans pre₂) } where open IsPreorder ⊎-isPartialOrder : IsPartialOrder ≈₁ ∼₁ → IsPartialOrder ≈₂ ∼₂ → IsPartialOrder (Pointwise ≈₁ ≈₂) (Pointwise ∼₁ ∼₂) ⊎-isPartialOrder po₁ po₂ = record { isPreorder = ⊎-isPreorder (isPreorder po₁) (isPreorder po₂) ; antisym = ⊎-antisymmetric (antisym po₁) (antisym po₂) } where open IsPartialOrder ⊎-isStrictPartialOrder : IsStrictPartialOrder ≈₁ ∼₁ → IsStrictPartialOrder ≈₂ ∼₂ → IsStrictPartialOrder (Pointwise ≈₁ ≈₂) (Pointwise ∼₁ ∼₂) ⊎-isStrictPartialOrder spo₁ spo₂ = record { isEquivalence = ⊎-isEquivalence (isEquivalence spo₁) (isEquivalence spo₂) ; irrefl = ⊎-irreflexive (irrefl spo₁) (irrefl spo₂) ; trans = ⊎-transitive (trans spo₁) (trans spo₂) ; <-resp-≈ = ⊎-respects₂ (<-resp-≈ spo₁) (<-resp-≈ spo₂) } where open IsStrictPartialOrder ------------------------------------------------------------------------ -- Bundles module _ {a b c d} where ⊎-setoid : Setoid a b → Setoid c d → Setoid _ _ ⊎-setoid s₁ s₂ = record { isEquivalence = ⊎-isEquivalence (isEquivalence s₁) (isEquivalence s₂) } where open Setoid ⊎-decSetoid : DecSetoid a b → DecSetoid c d → DecSetoid _ _ ⊎-decSetoid ds₁ ds₂ = record { isDecEquivalence = ⊎-isDecEquivalence (isDecEquivalence ds₁) (isDecEquivalence ds₂) } where open DecSetoid -- Some additional notation for combining setoids infix 4 _⊎ₛ_ _⊎ₛ_ : Setoid a b → Setoid c d → Setoid _ _ _⊎ₛ_ = ⊎-setoid module _ {a b c d e f} where ⊎-preorder : Preorder a b c → Preorder d e f → Preorder _ _ _ ⊎-preorder p₁ p₂ = record { isPreorder = ⊎-isPreorder (isPreorder p₁) (isPreorder p₂) } where open Preorder ⊎-poset : Poset a b c → Poset a b c → Poset _ _ _ ⊎-poset po₁ po₂ = record { isPartialOrder = ⊎-isPartialOrder (isPartialOrder po₁) (isPartialOrder po₂) } where open Poset ------------------------------------------------------------------------ -- The propositional equality setoid over products can be -- decomposed using Pointwise module _ {a b} {A : Set a} {B : Set b} where Pointwise-≡⇒≡ : (Pointwise _≡_ _≡_) ⇒ _≡_ {A = A ⊎ B} Pointwise-≡⇒≡ (inj₁ x) = P.cong inj₁ x Pointwise-≡⇒≡ (inj₂ x) = P.cong inj₂ x ≡⇒Pointwise-≡ : _≡_ {A = A ⊎ B} ⇒ (Pointwise _≡_ _≡_) ≡⇒Pointwise-≡ P.refl = ⊎-refl P.refl P.refl Pointwise-≡↔≡ : ∀ {a b} (A : Set a) (B : Set b) → Inverse (P.setoid A ⊎ₛ P.setoid B) (P.setoid (A ⊎ B)) Pointwise-≡↔≡ _ _ = record { to = record { _⟨$⟩_ = id; cong = Pointwise-≡⇒≡ } ; from = record { _⟨$⟩_ = id; cong = ≡⇒Pointwise-≡ } ; inverse-of = record { left-inverse-of = λ _ → ⊎-refl P.refl P.refl ; right-inverse-of = λ _ → P.refl } } ------------------------------------------------------------------------ -- DEPRECATED NAMES ------------------------------------------------------------------------ -- Please use the new names as continuing support for the old names is -- not guaranteed. -- Version 1.0 module _ {a b c d r s} {A : Set a} {B : Set b} {C : Set c} {D : Set d} {R : REL A C r} {S : REL B D s} where ₁∼₁ : ∀ {a c} → R a c → Pointwise R S (inj₁ a) (inj₁ c) ₁∼₁ = inj₁ {-# WARNING_ON_USAGE ₁∼₁ "Warning: ₁∼₁ was deprecated in v1.0. Please use inj₁ in `Data.Sum.Properties` instead." #-} ₂∼₂ : ∀ {b d} → S b d → Pointwise R S (inj₂ b) (inj₂ d) ₂∼₂ = inj₂ {-# WARNING_ON_USAGE ₂∼₂ "Warning: ₂∼₂ was deprecated in v1.0. Please use inj₂ in `Data.Sum.Properties` instead." #-} _⊎-≟_ : ∀ {a b} {A : Set a} {B : Set b} → Decidable {A = A} _≡_ → Decidable {A = B} _≡_ → Decidable {A = A ⊎ B} _≡_ (dec₁ ⊎-≟ dec₂) s₁ s₂ = Dec.map′ Pointwise-≡⇒≡ ≡⇒Pointwise-≡ (s₁ ≟ s₂) where open DecSetoid (⊎-decSetoid (P.decSetoid dec₁) (P.decSetoid dec₂)) {-# WARNING_ON_USAGE _⊎-≟_ "Warning: _⊎-≟_ was deprecated in v1.0. Please use ≡-dec in `Data.Sum.Properties` instead." #-} agda-stdlib-1.7.3/src/Data/Sum/Relation/LeftOrder.agda000066400000000000000000000010321451211343400223540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.Sum.Relation.Binary.LeftOrder directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Relation.LeftOrder where open import Data.Sum.Relation.Binary.LeftOrder public {-# WARNING_ON_IMPORT "Data.Sum.Relation.LeftOrder was deprecated in v1.0. Use Data.Sum.Relation.Binary.LeftOrder instead." #-} agda-stdlib-1.7.3/src/Data/Sum/Relation/Pointwise.agda000066400000000000000000000010321451211343400224470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use -- Data.Sum.Relation.Binary.Pointwise directly. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Relation.Pointwise where open import Data.Sum.Relation.Binary.Pointwise public {-# WARNING_ON_IMPORT "Data.Sum.Relation.Pointwise was deprecated in v1.0. Use Data.Sum.Relation.Binary.Pointwise instead." #-} agda-stdlib-1.7.3/src/Data/Sum/Relation/Unary/000077500000000000000000000000001451211343400207525ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Sum/Relation/Unary/All.agda000066400000000000000000000023521451211343400223020ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Heterogeneous `All` predicate for disjoint sums ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Sum.Relation.Unary.All where open import Data.Sum.Base using (_⊎_; inj₁; inj₂) open import Level using (Level; _⊔_) open import Relation.Unary using (Pred) private variable a b c p q : Level A B : Set _ P Q : Pred A p ------------------------------------------------------------------------ -- Definition data All {A : Set a} {B : Set b} (P : Pred A p) (Q : Pred B q) : Pred (A ⊎ B) (a ⊔ b ⊔ p ⊔ q) where inj₁ : ∀ {a} → P a → All P Q (inj₁ a) inj₂ : ∀ {b} → Q b → All P Q (inj₂ b) ------------------------------------------------------------------------ -- Operations -- Elimination [_,_] : ∀ {C : (x : A ⊎ B) → All P Q x → Set c} → ((x : A) (y : P x) → C (inj₁ x) (inj₁ y)) → ((x : B) (y : Q x) → C (inj₂ x) (inj₂ y)) → (x : A ⊎ B) (y : All P Q x) → C x y [ f , g ] (inj₁ x) (inj₁ y) = f x y [ f , g ] (inj₂ x) (inj₂ y) = g x y agda-stdlib-1.7.3/src/Data/Table.agda000066400000000000000000000027751451211343400172130ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Vec.Functional` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from other Table modules {-# OPTIONS --warn=noUserWarning #-} module Data.Table where {-# WARNING_ON_IMPORT "Data.Table was deprecated in v1.2. Use Data.Vec.Functional instead." #-} open import Data.Table.Base public open import Data.Bool.Base using (true; false) open import Data.Fin using (Fin; _≟_) open import Function.Equality using (_⟨$⟩_) open import Function.Inverse using (Inverse; _↔_) open import Relation.Nullary using (does) open import Relation.Nullary.Decidable using (⌊_⌋) -------------------------------------------------------------------------------- -- Combinators -------------------------------------------------------------------------------- -- Changes the order of elements in the table according to a permutation (i.e. -- an 'Inverse' object on the indices). permute : ∀ {m n a} {A : Set a} → Fin m ↔ Fin n → Table A n → Table A m permute π = rearrange (Inverse.to π ⟨$⟩_) -- The result of 'select z i t' takes the value of 'lookup t i' at index 'i', -- and 'z' everywhere else. select : ∀ {n} {a} {A : Set a} → A → Fin n → Table A n → Table A n lookup (select z i t) j with does (j ≟ i) ... | true = lookup t i ... | false = z agda-stdlib-1.7.3/src/Data/Table/000077500000000000000000000000001451211343400163625ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Table/Base.agda000066400000000000000000000054721451211343400200620ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Vec.Functional` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Table.Base where {-# WARNING_ON_IMPORT "Data.Table.Base was deprecated in v1.2. Use Data.Vec.Functional instead." #-} open import Data.Nat.Base open import Data.Fin.Base open import Data.Product using (_×_ ; _,_) open import Data.List.Base as List using (List) open import Data.Vec.Base as Vec using (Vec) open import Function.Base using (_∘_; flip) open import Level using (Level) private variable a b : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Definition record Table (A : Set a) n : Set a where constructor tabulate field lookup : Fin n → A open Table public ------------------------------------------------------------------------ -- Basic operations head : ∀ {n} → Table A (suc n) → A head t = lookup t zero tail : ∀ {n} → Table A (suc n) → Table A n tail t = tabulate (lookup t ∘ suc) uncons : ∀ {n} → Table A (suc n) → A × Table A n uncons t = head t , tail t remove : ∀ {n} → Fin (suc n) → Table A (suc n) → Table A n remove i t = tabulate (lookup t ∘ punchIn i) ------------------------------------------------------------------------ -- Operations for transforming tables rearrange : ∀ {m n} → (Fin m → Fin n) → Table A n → Table A m rearrange f t = tabulate (lookup t ∘ f) map : ∀ {n} → (A → B) → Table A n → Table B n map f t = tabulate (f ∘ lookup t) _⊛_ : ∀ {n} → Table (A → B) n → Table A n → Table B n fs ⊛ xs = tabulate λ i → lookup fs i (lookup xs i) ------------------------------------------------------------------------ -- Operations for reducing tables foldr : ∀ {n} → (A → B → B) → B → Table A n → B foldr {n = zero} f z t = z foldr {n = suc n} f z t = f (head t) (foldr f z (tail t)) foldl : ∀ {n} → (B → A → B) → B → Table A n → B foldl {n = zero} f z t = z foldl {n = suc n} f z t = foldl f (f z (head t)) (tail t) ------------------------------------------------------------------------ -- Operations for building tables replicate : ∀ {n} → A → Table A n replicate x = tabulate (λ _ → x) ------------------------------------------------------------------------ -- Operations for converting tables toList : ∀ {n} → Table A n → List A toList = List.tabulate ∘ lookup fromList : ∀ (xs : List A) → Table A (List.length xs) fromList = tabulate ∘ List.lookup fromVec : ∀ {n} → Vec A n → Table A n fromVec = tabulate ∘ Vec.lookup toVec : ∀ {n} → Table A n → Vec A n toVec = Vec.tabulate ∘ lookup agda-stdlib-1.7.3/src/Data/Table/Properties.agda000066400000000000000000000107401451211343400213360ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Vec.Functional` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from other Table modules {-# OPTIONS --warn=noUserWarning #-} module Data.Table.Properties where {-# WARNING_ON_IMPORT "Data.Table.Properties was deprecated in v1.2. Use Data.Vec.Functional.Properties instead." #-} open import Data.Table open import Data.Table.Relation.Binary.Equality open import Data.Bool.Base using (true; false; if_then_else_) open import Data.Nat.Base using (zero; suc) open import Data.Empty using (⊥-elim) open import Data.Fin using (Fin; suc; zero; _≟_; punchIn) import Data.Fin.Properties as FP open import Data.Fin.Permutation as Perm using (Permutation; _⟨$⟩ʳ_; _⟨$⟩ˡ_) open import Data.List.Base as L using (List; _∷_; []) open import Data.List.Relation.Unary.Any using (here; there; index) open import Data.List.Membership.Propositional using (_∈_) open import Data.Product as Product using (Σ; ∃; _,_; proj₁; proj₂) open import Data.Vec.Base as V using (Vec; _∷_; []) import Data.Vec.Properties as VP open import Level using (Level) open import Function.Base using (_∘_; flip) open import Function.Inverse using (Inverse) open import Relation.Binary.PropositionalEquality as P using (_≡_; _≢_; refl; sym; cong) open import Relation.Nullary using (does) open import Relation.Nullary.Decidable using (dec-true; dec-false) open import Relation.Nullary.Negation using (contradiction) private variable a : Level A : Set a ------------------------------------------------------------------------ -- select -- Selecting from any table is the same as selecting from a constant table. select-const : ∀ {n} (z : A) (i : Fin n) t → select z i t ≗ select z i (replicate (lookup t i)) select-const z i t j with does (j ≟ i) ... | true = refl ... | false = refl -- Selecting an element from a table then looking it up is the same as looking -- up the index in the original table select-lookup : ∀ {n x i} (t : Table A n) → lookup (select x i t) i ≡ lookup t i select-lookup {i = i} t rewrite dec-true (i ≟ i) refl = refl -- Selecting an element from a table then removing the same element produces a -- constant table select-remove : ∀ {n x} i (t : Table A (suc n)) → remove i (select x i t) ≗ replicate {n = n} x select-remove i t j rewrite dec-false (punchIn i j ≟ i) (FP.punchInᵢ≢i _ _) = refl ------------------------------------------------------------------------ -- permute -- Removing an index 'i' from a table permuted with 'π' is the same as -- removing the element, then permuting with 'π' minus 'i'. remove-permute : ∀ {m n} (π : Permutation (suc m) (suc n)) i (t : Table A (suc n)) → remove (π ⟨$⟩ˡ i) (permute π t) ≗ permute (Perm.remove (π ⟨$⟩ˡ i) π) (remove i t) remove-permute π i t j = P.cong (lookup t) (Perm.punchIn-permute′ π i j) ------------------------------------------------------------------------ -- fromList fromList-∈ : ∀ {xs : List A} (i : Fin (L.length xs)) → lookup (fromList xs) i ∈ xs fromList-∈ {xs = x ∷ xs} zero = here refl fromList-∈ {xs = x ∷ xs} (suc i) = there (fromList-∈ i) index-fromList-∈ : ∀ {xs : List A} {i} → index (fromList-∈ {xs = xs} i) ≡ i index-fromList-∈ {xs = x ∷ xs} {zero} = refl index-fromList-∈ {xs = x ∷ xs} {suc i} = cong suc index-fromList-∈ fromList-index : ∀ {xs} {x : A} (x∈xs : x ∈ xs) → lookup (fromList xs) (index x∈xs) ≡ x fromList-index (here px) = sym px fromList-index (there x∈xs) = fromList-index x∈xs ------------------------------------------------------------------------ -- There exists an isomorphism between tables and vectors. ↔Vec : ∀ {n} → Inverse (≡-setoid A n) (P.setoid (Vec A n)) ↔Vec = record { to = record { _⟨$⟩_ = toVec ; cong = VP.tabulate-cong } ; from = P.→-to-⟶ fromVec ; inverse-of = record { left-inverse-of = VP.lookup∘tabulate ∘ lookup ; right-inverse-of = VP.tabulate∘lookup } } ------------------------------------------------------------------------ -- Other lookup∈ : ∀ {xs : List A} (i : Fin (L.length xs)) → ∃ λ x → x ∈ xs lookup∈ i = _ , fromList-∈ i agda-stdlib-1.7.3/src/Data/Table/Relation/000077500000000000000000000000001451211343400201375ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Table/Relation/Binary/000077500000000000000000000000001451211343400213635ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Table/Relation/Binary/Equality.agda000066400000000000000000000025241451211343400240010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Vec.Functional` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from other Table modules {-# OPTIONS --warn=noUserWarning #-} module Data.Table.Relation.Binary.Equality where {-# WARNING_ON_IMPORT "Data.Table.Relation.Binary.Equality was deprecated in v1.2. Use Data.Vec.Functional.Relation.Binary.Pointwise instead." #-} open import Relation.Binary using (Setoid) open import Data.Table.Base open import Data.Nat.Base using (ℕ) open import Function.Base using (_∘_) open import Relation.Binary.PropositionalEquality as P using (_≡_; _→-setoid_) setoid : ∀ {c p} → Setoid c p → ℕ → Setoid _ _ setoid S n = record { Carrier = Table Carrier n ; _≈_ = λ t t′ → ∀ i → lookup t i ≈ lookup t′ i ; isEquivalence = record { refl = λ i → refl ; sym = λ p → sym ∘ p ; trans = λ p q i → trans (p i) (q i) } } where open Setoid S ≡-setoid : ∀ {a} → Set a → ℕ → Setoid _ _ ≡-setoid A = setoid (P.setoid A) module _ {a} {A : Set a} {n} where open Setoid (≡-setoid A n) public using () renaming (_≈_ to _≗_) agda-stdlib-1.7.3/src/Data/Table/Relation/Equality.agda000066400000000000000000000011661451211343400225560ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- This module is DEPRECATED. Please use `Data.Vec.Functional` instead. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} -- Disabled to prevent warnings from other Table modules {-# OPTIONS --warn=noUserWarning #-} module Data.Table.Relation.Equality where open import Data.Table.Relation.Binary.Equality public {-# WARNING_ON_IMPORT "Data.Table.Relation.Equality was deprecated in v1.0. Use Data.Vec.Functional.Relation.Binary.Pointwise instead." #-} agda-stdlib-1.7.3/src/Data/These.agda000066400000000000000000000026031451211343400172220ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An either-or-both data type ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.These where open import Level open import Data.Maybe.Base using (Maybe; just; nothing; maybe′) open import Data.Sum.Base using (_⊎_; [_,_]′) open import Function ------------------------------------------------------------------------ -- Re-exporting the datatype and its operations open import Data.These.Base public private variable a b : Level A : Set a B : Set b ------------------------------------------------------------------------ -- Additional operations -- projections fromThis : These A B → Maybe A fromThis = fold just (const nothing) (const ∘′ just) fromThat : These A B → Maybe B fromThat = fold (const nothing) just (const just) leftMost : These A A → A leftMost = fold id id const rightMost : These A A → A rightMost = fold id id constᵣ mergeThese : (A → A → A) → These A A → A mergeThese = fold id id -- deletions deleteThis : These A B → Maybe (These A B) deleteThis = fold (const nothing) (just ∘′ that) (const (just ∘′ that)) deleteThat : These A B → Maybe (These A B) deleteThat = fold (just ∘′ this) (const nothing) (const ∘′ just ∘′ this) agda-stdlib-1.7.3/src/Data/These/000077500000000000000000000000001451211343400164035ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/These/Base.agda000066400000000000000000000045161451211343400201010ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- An either-or-both data type, basic type and operations ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.These.Base where open import Level open import Data.Sum.Base using (_⊎_; [_,_]′) open import Function.Base private variable a b c d e f : Level A : Set a B : Set b C : Set c D : Set d E : Set e F : Set f data These {a b} (A : Set a) (B : Set b) : Set (a ⊔ b) where this : A → These A B that : B → These A B these : A → B → These A B ------------------------------------------------------------------------ -- Operations -- injection fromSum : A ⊎ B → These A B fromSum = [ this , that ]′ -- map map : (f : A → B) (g : C → D) → These A C → These B D map f g (this a) = this (f a) map f g (that b) = that (g b) map f g (these a b) = these (f a) (g b) map₁ : (f : A → B) → These A C → These B C map₁ f = map f id map₂ : (g : B → C) → These A B → These A C map₂ = map id -- fold fold : (A → C) → (B → C) → (A → B → C) → These A B → C fold l r lr (this a) = l a fold l r lr (that b) = r b fold l r lr (these a b) = lr a b foldWithDefaults : A → B → (A → B → C) → These A B → C foldWithDefaults a b lr = fold (flip lr b) (lr a) lr -- swap swap : These A B → These B A swap = fold that this (flip these) -- align alignWith : (These A C → E) → (These B D → F) → These A B → These C D → These E F alignWith f g (this a) (this c) = this (f (these a c)) alignWith f g (this a) (that d) = these (f (this a)) (g (that d)) alignWith f g (this a) (these c d) = these (f (these a c)) (g (that d)) alignWith f g (that b) (this c) = these (f (that c)) (g (this b)) alignWith f g (that b) (that d) = that (g (these b d)) alignWith f g (that b) (these c d) = these (f (that c)) (g (these b d)) alignWith f g (these a b) (this c) = these (f (these a c)) (g (this b)) alignWith f g (these a b) (that d) = these (f (this a)) (g (these b d)) alignWith f g (these a b) (these c d) = these (f (these a c)) (g (these b d)) align : These A B → These C D → These (These A C) (These B D) align = alignWith id id agda-stdlib-1.7.3/src/Data/These/Categorical/000077500000000000000000000000001451211343400206205ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/These/Categorical/Left.agda000066400000000000000000000033331451211343400223320ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Left-biased universe-sensitive functor and monad instances for These. -- ------------------------------------------------------------------------ -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). -- See the Data.Product.Categorical.Examples for how this is done in a -- Product-based similar setting. -- This functor can be understood as a notion of computation which can -- either fail (this), succeed (that) or accumulate warnings whilst -- delivering a successful computation (these). -- It is a good alternative to Data.Product.Categorical when the notion -- of warnings does not have a neutral element (e.g. List⁺). {-# OPTIONS --cubical-compatible --safe #-} open import Level open import Algebra module Data.These.Categorical.Left {c ℓ} (W : Semigroup c ℓ) (b : Level) where open Semigroup W open import Data.These.Categorical.Left.Base Carrier b public open import Data.These.Base open import Category.Applicative open import Category.Monad module _ {a b} {A : Set a} {B : Set b} where applicative : RawApplicative Theseₗ applicative = record { pure = that ; _⊛_ = ap } where ap : ∀ {A B}→ Theseₗ (A → B) → Theseₗ A → Theseₗ B ap (this w) t = this w ap (that f) t = map₂ f t ap (these w f) t = map (w ∙_) f t monad : RawMonad Theseₗ monad = record { return = that ; _>>=_ = bind } where bind : ∀ {A B} → Theseₗ A → (A → Theseₗ B) → Theseₗ B bind (this w) f = this w bind (that t) f = f t bind (these w t) f = map₁ (w ∙_) (f t) agda-stdlib-1.7.3/src/Data/These/Categorical/Left/000077500000000000000000000000001451211343400215125ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/These/Categorical/Left/Base.agda000066400000000000000000000035321451211343400232050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Base definitions for the left-biased universe-sensitive functor and -- monad instances for These. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). -- See the Data.Product.Categorical.Examples for how this is done in a -- Product-based similar setting. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.These.Categorical.Left.Base {a} (A : Set a) (b : Level) where open import Data.These.Base open import Category.Functor open import Category.Applicative open import Category.Monad open import Function Theseₗ : Set (a ⊔ b) → Set (a ⊔ b) Theseₗ B = These A B functor : RawFunctor Theseₗ functor = record { _<$>_ = map₂ } ------------------------------------------------------------------------ -- Get access to other monadic functions module _ {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Theseₗ (F A) → F (Theseₗ A) sequenceA (this a) = pure (this a) sequenceA (that b) = that <$> b sequenceA (these a b) = these a <$> b mapA : ∀ {A B} → (A → F B) → Theseₗ A → F (Theseₗ B) mapA f = sequenceA ∘ map₂ f forA : ∀ {A B} → Theseₗ A → (A → F B) → F (Theseₗ B) forA = flip mapA module _ {M} (Mon : RawMonad {a ⊔ b} M) where private App = RawMonad.rawIApplicative Mon sequenceM : ∀ {A} → Theseₗ (M A) → M (Theseₗ A) sequenceM = sequenceA App mapM : ∀ {A B} → (A → M B) → Theseₗ A → M (Theseₗ B) mapM = mapA App forM : ∀ {A B} → Theseₗ A → (A → M B) → M (Theseₗ B) forM = forA App agda-stdlib-1.7.3/src/Data/These/Categorical/Right.agda000066400000000000000000000033331451211343400225150ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Right-biased universe-sensitive functor and monad instances for These. ------------------------------------------------------------------------ -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). -- See the Data.Product.Categorical.Examples for how this is done in a -- Product-based similar setting. -- This functor can be understood as a notion of computation which can -- either fail (that), succeed (this) or accumulate warnings whilst -- delivering a successful computation (these). -- It is a good alternative to Data.Product.Categorical when the notion -- of warnings does not have a neutral element (e.g. List⁺). {-# OPTIONS --cubical-compatible --safe #-} open import Level open import Algebra module Data.These.Categorical.Right (a : Level) {c ℓ} (W : Semigroup c ℓ) where open Semigroup W open import Data.These.Categorical.Right.Base a Carrier public open import Data.These.Base open import Category.Applicative open import Category.Monad module _ {a b} {A : Set a} {B : Set b} where applicative : RawApplicative Theseᵣ applicative = record { pure = this ; _⊛_ = ap } where ap : ∀ {A B}→ Theseᵣ (A → B) → Theseᵣ A → Theseᵣ B ap (this f) t = map₁ f t ap (that w) t = that w ap (these f w) t = map f (w ∙_) t monad : RawMonad Theseᵣ monad = record { return = this ; _>>=_ = bind } where bind : ∀ {A B} → Theseᵣ A → (A → Theseᵣ B) → Theseᵣ B bind (this t) f = f t bind (that w) f = that w bind (these t w) f = map₂ (w ∙_) (f t) agda-stdlib-1.7.3/src/Data/These/Categorical/Right/000077500000000000000000000000001451211343400216755ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/These/Categorical/Right/Base.agda000066400000000000000000000035411451211343400233700ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Base definitions for the right-biased universe-sensitive functor and -- monad instances for These. -- -- To minimize the universe level of the RawFunctor, we require that -- elements of B are "lifted" to a copy of B at a higher universe level -- (a ⊔ b). -- See the Data.Product.Categorical.Examples for how this is done in a -- Product-based similar setting. ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Level module Data.These.Categorical.Right.Base (a : Level) {b} (B : Set b) where open import Data.These.Base open import Category.Functor open import Category.Applicative open import Category.Monad open import Function Theseᵣ : Set (a ⊔ b) → Set (a ⊔ b) Theseᵣ A = These A B functor : RawFunctor Theseᵣ functor = record { _<$>_ = map₁ } ------------------------------------------------------------------------ -- Get access to other monadic functions module _ {F} (App : RawApplicative {a ⊔ b} F) where open RawApplicative App sequenceA : ∀ {A} → Theseᵣ (F A) → F (Theseᵣ A) sequenceA (this a) = this <$> a sequenceA (that b) = pure (that b) sequenceA (these a b) = flip these b <$> a mapA : ∀ {A B} → (A → F B) → Theseᵣ A → F (Theseᵣ B) mapA f = sequenceA ∘ map₁ f forA : ∀ {A B} → Theseᵣ A → (A → F B) → F (Theseᵣ B) forA = flip mapA module _ {M} (Mon : RawMonad {a ⊔ b} M) where private App = RawMonad.rawIApplicative Mon sequenceM : ∀ {A} → Theseᵣ (M A) → M (Theseᵣ A) sequenceM = sequenceA App mapM : ∀ {A B} → (A → M B) → Theseᵣ A → M (Theseᵣ B) mapM = mapA App forM : ∀ {A B} → Theseᵣ A → (A → M B) → M (Theseᵣ B) forM = forA App agda-stdlib-1.7.3/src/Data/These/Instances.agda000066400000000000000000000015171451211343400211540ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Typeclass instances for These ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.These.Instances where open import Data.These.Base open import Data.These.Properties open import Level open import Relation.Binary.PropositionalEquality.Core open import Relation.Binary.PropositionalEquality.Properties using (isDecEquivalence) open import Relation.Binary.TypeClasses private variable a b : Level A : Set a B : Set b instance These-≡-isDecEquivalence : {{IsDecEquivalence {A = A} _≡_}} → {{IsDecEquivalence {A = B} _≡_}} → IsDecEquivalence {A = These A B} _≡_ These-≡-isDecEquivalence = isDecEquivalence (≡-dec _≟_ _≟_) agda-stdlib-1.7.3/src/Data/These/Properties.agda000066400000000000000000000041161451211343400213570ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Properties of These ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.These.Properties where open import Data.Product open import Data.These.Base open import Function.Base using (_∘_) open import Relation.Binary using (Decidable) open import Relation.Binary.PropositionalEquality open import Relation.Nullary using (yes; no) open import Relation.Nullary.Decidable using (map′) open import Relation.Nullary.Product using (_×-dec_) ------------------------------------------------------------------------ -- Equality module _ {a b} {A : Set a} {B : Set b} where this-injective : ∀ {x y : A} → this {B = B} x ≡ this y → x ≡ y this-injective refl = refl that-injective : ∀ {a b : B} → that {A = A} a ≡ that b → a ≡ b that-injective refl = refl these-injectiveˡ : ∀ {x y : A} {a b : B} → these x a ≡ these y b → x ≡ y these-injectiveˡ refl = refl these-injectiveʳ : ∀ {x y : A} {a b : B} → these x a ≡ these y b → a ≡ b these-injectiveʳ refl = refl these-injective : ∀ {x y : A} {a b : B} → these x a ≡ these y b → x ≡ y × a ≡ b these-injective = < these-injectiveˡ , these-injectiveʳ > ≡-dec : Decidable _≡_ → Decidable _≡_ → Decidable {A = These A B} _≡_ ≡-dec dec₁ dec₂ (this x) (this y) = map′ (cong this) this-injective (dec₁ x y) ≡-dec dec₁ dec₂ (this x) (that y) = no λ() ≡-dec dec₁ dec₂ (this x) (these y b) = no λ() ≡-dec dec₁ dec₂ (that x) (this y) = no λ() ≡-dec dec₁ dec₂ (that x) (that y) = map′ (cong that) that-injective (dec₂ x y) ≡-dec dec₁ dec₂ (that x) (these y b) = no λ() ≡-dec dec₁ dec₂ (these x a) (this y) = no λ() ≡-dec dec₁ dec₂ (these x a) (that y) = no λ() ≡-dec dec₁ dec₂ (these x a) (these y b) = map′ (uncurry (cong₂ these)) these-injective (dec₁ x y ×-dec dec₂ a b) agda-stdlib-1.7.3/src/Data/Tree/000077500000000000000000000000001451211343400162325ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Tree/AVL.agda000066400000000000000000000135151451211343400174770ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- AVL trees ------------------------------------------------------------------------ -- AVL trees are balanced binary search trees. -- The search tree invariant is specified using the technique -- described by Conor McBride in his talk "Pivotal pragmatism". -- See README.Data.Tree.AVL for examples of how to use AVL trees. {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.Tree.AVL {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where open import Data.Bool.Base using (Bool) import Data.DifferenceList as DiffList open import Data.List.Base as List using (List; []; _∷_) open import Data.Maybe.Base using (Maybe; nothing; just; is-just) open import Data.Nat.Base using (ℕ; suc) open import Data.Product hiding (map) open import Function.Base as F open import Level using (Level; _⊔_) open import Relation.Unary using (IUniversal; _⇒_) private variable l : Level A : Set l open StrictTotalOrder strictTotalOrder renaming (Carrier to Key) import Data.Tree.AVL.Indexed strictTotalOrder as Indexed open Indexed using (⊥⁺; ⊤⁺; ⊥⁺<⊤⁺; ⊥⁺<[_]<⊤⁺; ⊥⁺<[_]; [_]<⊤⁺) ------------------------------------------------------------------------ -- Re-export some core definitions publically open Indexed using (K&_;_,_; toPair; fromPair; Value; MkValue; const) public ------------------------------------------------------------------------ -- Types and functions with hidden indices data Tree {v} (V : Value v) : Set (a ⊔ v ⊔ ℓ₂) where tree : ∀ {h} → Indexed.Tree V ⊥⁺ ⊤⁺ h → Tree V module _ {v} {V : Value v} where private Val = Value.family V empty : Tree V empty = tree $′ Indexed.empty ⊥⁺<⊤⁺ singleton : (k : Key) → Val k → Tree V singleton k v = tree (Indexed.singleton k v ⊥⁺<[ k ]<⊤⁺) insert : (k : Key) → Val k → Tree V → Tree V insert k v (tree t) = tree $′ proj₂ $ Indexed.insert k v t ⊥⁺<[ k ]<⊤⁺ insertWith : (k : Key) → (Maybe (Val k) → Val k) → Tree V → Tree V insertWith k f (tree t) = tree $′ proj₂ $ Indexed.insertWith k f t ⊥⁺<[ k ]<⊤⁺ delete : Key → Tree V → Tree V delete k (tree t) = tree $′ proj₂ $ Indexed.delete k t ⊥⁺<[ k ]<⊤⁺ lookup : (k : Key) → Tree V → Maybe (Val k) lookup k (tree t) = Indexed.lookup k t ⊥⁺<[ k ]<⊤⁺ module _ {v w} {V : Value v} {W : Value w} where private Val = Value.family V Wal = Value.family W map : ∀[ Val ⇒ Wal ] → Tree V → Tree W map f (tree t) = tree $ Indexed.map f t module _ {v} {V : Value v} where private Val = Value.family V infix 4 _∈?_ _∈?_ : Key → Tree V → Bool k ∈? t = is-just (lookup k t) headTail : Tree V → Maybe (K& V × Tree V) headTail (tree (Indexed.leaf _)) = nothing headTail (tree {h = suc _} t) with Indexed.headTail t ... | (k , _ , _ , t′) = just (k , tree (Indexed.castˡ ⊥⁺<[ _ ] t′)) initLast : Tree V → Maybe (Tree V × K& V) initLast (tree (Indexed.leaf _)) = nothing initLast (tree {h = suc _} t) with Indexed.initLast t ... | (k , _ , _ , t′) = just (tree (Indexed.castʳ t′ [ _ ]<⊤⁺) , k) foldr : (∀ {k} → Val k → A → A) → A → Tree V → A foldr cons nil (tree t) = Indexed.foldr cons nil t -- The input does not need to be ordered. fromList : List (K& V) → Tree V fromList = List.foldr (uncurry insert ∘′ toPair) empty -- Returns an ordered list. toList : Tree V → List (K& V) toList (tree t) = DiffList.toList (Indexed.toDiffList t) size : Tree V → ℕ size (tree t) = Indexed.size t ------------------------------------------------------------------------ -- Naive implementation of union module _ {v w} {V : Value v} {W : Value w} where private Val = Value.family V Wal = Value.family W unionWith : (∀ {k} → Val k → Maybe (Wal k) → Wal k) → -- left → right → result. Tree V → Tree W → Tree W unionWith f t₁ t₂ = foldr (λ {k} v → insertWith k (f v)) t₂ t₁ module _ {v} {V : Value v} where private Val = Value.family V -- Left-biased. union : Tree V → Tree V → Tree V union = unionWith F.const unionsWith : (∀ {k} → Val k → Maybe (Val k) → Val k) → List (Tree V) → Tree V unionsWith f ts = List.foldr (unionWith f) empty ts -- Left-biased. unions : List (Tree V) → Tree V unions = unionsWith F.const ------------------------------------------------------------------------ -- Naive implementation of intersection module _ {v w x} {V : Value v} {W : Value w} {X : Value x} where private Val = Value.family V Wal = Value.family W Xal = Value.family X intersectionWith : (∀ {k} → Val k → Wal k → Xal k) → Tree V → Tree W → Tree X intersectionWith f t₁ t₂ = foldr cons empty t₁ where cons : ∀ {k} → Val k → Tree X → Tree X cons {k} v = case lookup k t₂ of λ where nothing → id (just w) → insert k (f v w) module _ {v} {V : Value v} where private Val = Value.family V -- Left-biased. intersection : Tree V → Tree V → Tree V intersection = intersectionWith F.const intersectionsWith : (∀ {k} → Val k → Val k → Val k) → List (Tree V) → Tree V intersectionsWith f [] = empty intersectionsWith f (t ∷ ts) = List.foldl (intersectionWith f) t ts -- We are using foldl so that we are indeed forming t₁ ∩ ⋯ ∩ tₙ for -- the input list [t₁,⋯,tₙ]. If we were to use foldr, we would form -- t₂ ∩ ⋯ ∩ tₙ ∩ t₁ instead! -- Left-biased. intersections : List (Tree V) → Tree V intersections = intersectionsWith F.const agda-stdlib-1.7.3/src/Data/Tree/AVL/000077500000000000000000000000001451211343400166545ustar00rootroot00000000000000agda-stdlib-1.7.3/src/Data/Tree/AVL/Height.agda000066400000000000000000000026501451211343400207050ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- Types and functions which are used to keep track of height -- invariants in AVL Trees ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} module Data.Tree.AVL.Height where open import Data.Nat.Base open import Data.Fin.Base using (Fin; zero; suc) ℕ₂ = Fin 2 pattern 0# = zero pattern 1# = suc zero pattern ## = suc (suc ()) -- Addition. infixl 6 _⊕_ _⊕_ : ℕ₂ → ℕ → ℕ 0# ⊕ n = n 1# ⊕ n = 1 + n -- pred[ i ⊕ n ] = pred (i ⊕ n). pred[_⊕_] : ℕ₂ → ℕ → ℕ pred[ i ⊕ zero ] = 0 pred[ i ⊕ suc n ] = i ⊕ n infix 4 _∼_⊔_ -- If i ∼ j ⊔ m, then the difference between i and j is at most 1, -- and the maximum of i and j is m. _∼_⊔_ is used to record the -- balance factor of the AVL trees, and also to ensure that the -- absolute value of the balance factor is never more than 1. data _∼_⊔_ : ℕ → ℕ → ℕ → Set where ∼+ : ∀ {n} → n ∼ 1 + n ⊔ 1 + n ∼0 : ∀ {n} → n ∼ n ⊔ n ∼- : ∀ {n} → 1 + n ∼ n ⊔ 1 + n -- Some lemmas. max∼ : ∀ {i j m} → i ∼ j ⊔ m → m ∼ i ⊔ m max∼ ∼+ = ∼- max∼ ∼0 = ∼0 max∼ ∼- = ∼0 ∼max : ∀ {i j m} → i ∼ j ⊔ m → j ∼ m ⊔ m ∼max ∼+ = ∼0 ∼max ∼0 = ∼0 ∼max ∼- = ∼+ agda-stdlib-1.7.3/src/Data/Tree/AVL/Indexed.agda000066400000000000000000000310031451211343400210470ustar00rootroot00000000000000------------------------------------------------------------------------ -- The Agda standard library -- -- AVL trees where the stored values may depend on their key ------------------------------------------------------------------------ {-# OPTIONS --cubical-compatible --safe #-} open import Relation.Binary using (StrictTotalOrder) module Data.Tree.AVL.Indexed {a ℓ₁ ℓ₂} (strictTotalOrder : StrictTotalOrder a ℓ₁ ℓ₂) where open import Level using (Level; _⊔_) open import Data.Nat.Base using (ℕ; zero; suc; _+_) open import Data.Product using (Σ; ∃; _×_; _,_; proj₁) open import Data.Maybe.Base using (Maybe; just; nothing) open import Data.List.Base as List using (List) open import Data.DifferenceList using (DiffList; []; _∷_; _++_) open import Function.Base as F hiding (const) open import Relation.Unary open import Relation.Binary using (_Respects_; Tri; tri<; tri≈; tri>) open import Relation.Binary.PropositionalEquality using (_≡_; refl) private variable l v : Level A : Set l open StrictTotalOrder strictTotalOrder renaming (Carrier to Key) ------------------------------------------------------------------------ -- Re-export core definitions publicly open import Data.Tree.AVL.Key strictTotalOrder public open import Data.Tree.AVL.Value Eq.setoid public open import Data.Tree.AVL.Height public ------------------------------------------------------------------------ -- Definitions of the tree -- The trees have three parameters/indices: a lower bound on the -- keys, an upper bound, and a height. -- -- (The bal argument is the balance factor.) data Tree {v} (V : Value v) (l u : Key⁺) : ℕ → Set (a ⊔ v ⊔ ℓ₂) where leaf : (l _ _ k′ _ _ k′>k = joinˡ⁻ _ p (delete k lp (lk ]ᴿ)) pu bal ... | tri≈ _ k′≡k _ = join lp pu bal -- Looks up a key. Logarithmic in the size of the tree (assuming -- constant-time comparisons). lookup : ∀ {l u h} (k : Key) → Tree V l u h → l < k < u → Maybe (Val k) lookup k (leaf _) l _ _ k′>k = lookup k lk′ (lk ]ᴿ) ... | tri≈ _ k′≡k _ = just (V≈ k′≡k v) -- Converts the tree to an ordered list. Linear in the size of the -- tree. foldr : ∀ {l u h} → (∀ {k} → Val k → A → A) → A → Tree V l u h → A foldr cons nil (leaf l) open import Relation.Unary using (Pred) open import Relation.Nullary using (¬_) open import Relation.Nullary.Negation using (contradiction) open import Data.Tree.AVL.Indexed sto as AVL open import Data.Tree.AVL.Indexed.Relation.Unary.Any sto as Any open StrictTotalOrder sto renaming (Carrier to Key); open Eq using (_≉_; sym; refl) import Relation.Binary.Reasoning.StrictPartialOrder as <-Reasoning private variable v p q : Level V : Value v l u : Key⁺ n : ℕ P : Pred (K& V) p ------------------------------------------------------------------------ -- Any.lookup lookup-result : {t : Tree V l u n} (p : Any P t) → P (Any.lookup p) lookup-result (here p) = p lookup-result (left p) = lookup-result p lookup-result (right p) = lookup-result p lookup-bounded : {t : Tree V l u n} (p : Any P t) → l < Any.lookup p .key < u lookup-bounded {t = node kv lk ku bal} (here p) = ordered lk , ordered ku lookup-bounded {t = node kv lk ku bal} (left p) = Prod.map₂ (flip (trans⁺ _) (ordered ku)) (lookup-bounded p) lookup-bounded {t = node kv lk ku bal} (right p) = Prod.map₁ (trans⁺ _ (ordered lk)) (lookup-bounded p) joinˡ⁺-here⁺ : ∀ {l u hˡ hʳ h} → (kv : K& V) → (l : ∃ λ i → Tree V l [ kv .key ] (i ⊕ hˡ)) → (r : Tree V [ kv .key ] u hʳ) → (bal : hˡ ∼ hʳ ⊔ h) → P kv → Any P (proj₂ (joinˡ⁺ kv l r bal)) joinˡ⁺-here⁺ k₂ (0# , t₁) t₃ bal p = here p joinˡ⁺-here⁺ k₂ (1# , t₁) t₃ ∼0 p = here p joinˡ⁺-here⁺ k₂ (1# , t₁) t₃ ∼+ p = here p joinˡ⁺-here⁺ k₄ (1# , node k₂ t₁ t₃ ∼-) t₅ ∼- p = right (here p) joinˡ⁺-here⁺ k₄ (1# , node k₂ t₁ t₃ ∼0) t₅ ∼- p = right (here p) joinˡ⁺-here⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- p = right (here p) joinˡ⁺-left⁺ : ∀ {l u hˡ hʳ h} → (k : K& V) → (l : ∃ λ i → Tree V l [ k .key ] (i ⊕ hˡ)) → (r : Tree V [ k .key ] u hʳ) → (bal : hˡ ∼ hʳ ⊔ h) → Any P (proj₂ l) → Any P (proj₂ (joinˡ⁺ k l r bal)) joinˡ⁺-left⁺ k₂ (0# , t₁) t₃ bal p = left p joinˡ⁺-left⁺ k₂ (1# , t₁) t₃ ∼0 p = left p joinˡ⁺-left⁺ k₂ (1# , t₁) t₃ ∼+ p = left p joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼-) t₅ ∼- (here p) = here p joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼-) t₅ ∼- (left p) = left p joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼-) t₅ ∼- (right p) = right (left p) joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼0) t₅ ∼- (here p) = here p joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼0) t₅ ∼- (left p) = left p joinˡ⁺-left⁺ k₄ (1# , node k₂ t₁ t₃ ∼0) t₅ ∼- (right p) = right (left p) joinˡ⁺-left⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- (here p) = left (here p) joinˡ⁺-left⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- (left p) = left (left p) joinˡ⁺-left⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- (right (here p)) = here p joinˡ⁺-left⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- (right (left p)) = left (right p) joinˡ⁺-left⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- (right (right p)) = right (left p) joinˡ⁺-right⁺ : ∀ {l u hˡ hʳ h} → (kv@(k , v) : K& V) → (l : ∃ λ i → Tree V l [ k ] (i ⊕ hˡ)) → (r : Tree V [ k ] u hʳ) → (bal : hˡ ∼ hʳ ⊔ h) → Any P r → Any P (proj₂ (joinˡ⁺ kv l r bal)) joinˡ⁺-right⁺ k₂ (0# , t₁) t₃ bal p = right p joinˡ⁺-right⁺ k₂ (1# , t₁) t₃ ∼0 p = right p joinˡ⁺-right⁺ k₂ (1# , t₁) t₃ ∼+ p = right p joinˡ⁺-right⁺ k₄ (1# , node k₂ t₁ t₃ ∼-) t₅ ∼- p = right (right p) joinˡ⁺-right⁺ k₄ (1# , node k₂ t₁ t₃ ∼0) t₅ ∼- p = right (right p) joinˡ⁺-right⁺ k₆ (1# , node⁺ k₂ t₁ k₄ t₃ t₅ bal) t₇ ∼- p = right (right p) joinʳ⁺-here⁺ : ∀ {l u hˡ hʳ h} → (kv : K& V) → (l : Tree V l [ kv .key ] hˡ) → (r : ∃ λ i → Tree V [ kv .key ] u (i ⊕ hʳ)) → (bal : hˡ ∼ hʳ ⊔ h) → P kv → Any P (proj₂ (joinʳ⁺ kv l r bal)) joinʳ⁺-here⁺ k₂ t₁ (0# , t₃) bal p = here p joinʳ⁺-here⁺ k₂ t₁ (1# , t₃) ∼0 p = here p joinʳ⁺-here⁺ k₂ t₁ (1# , t₃) ∼- p = here p joinʳ⁺-here⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼+) ∼+ p = left (here p) joinʳ⁺-here⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼0) ∼+ p = left (here p) joinʳ⁺-here⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ p = left (here p) joinʳ⁺-left⁺ : ∀ {l u hˡ hʳ h} → (kv : K& V) → (l : Tree V l [ kv .key ] hˡ) → (r : ∃ λ i → Tree V [ kv .key ] u (i ⊕ hʳ)) → (bal : hˡ ∼ hʳ ⊔ h) → Any P l → Any P (proj₂ (joinʳ⁺ kv l r bal)) joinʳ⁺-left⁺ k₂ t₁ (0# , t₃) bal p = left p joinʳ⁺-left⁺ k₂ t₁ (1# , t₃) ∼0 p = left p joinʳ⁺-left⁺ k₂ t₁ (1# , t₃) ∼- p = left p joinʳ⁺-left⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼+) ∼+ p = left (left p) joinʳ⁺-left⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼0) ∼+ p = left (left p) joinʳ⁺-left⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ p = left (left p) joinʳ⁺-right⁺ : ∀ {l u hˡ hʳ h} → (kv : K& V) → (l : Tree V l [ kv .key ] hˡ) → (r : ∃ λ i → Tree V [ kv .key ] u (i ⊕ hʳ)) → (bal : hˡ ∼ hʳ ⊔ h) → Any P (proj₂ r) → Any P (proj₂ (joinʳ⁺ kv l r bal)) joinʳ⁺-right⁺ k₂ t₁ (0# , t₃) bal p = right p joinʳ⁺-right⁺ k₂ t₁ (1# , t₃) ∼0 p = right p joinʳ⁺-right⁺ k₂ t₁ (1# , t₃) ∼- p = right p joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼+) ∼+ (here p) = here p joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼+) ∼+ (left p) = left (right p) joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼+) ∼+ (right p) = right p joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼0) ∼+ (here p) = here p joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼0) ∼+ (left p) = left (right p) joinʳ⁺-right⁺ k₂ t₁ (1# , node k₄ t₃ t₅ ∼0) ∼+ (right p) = right p joinʳ⁺-right⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ (here p) = right (here p) joinʳ⁺-right⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ (left (here p)) = here p joinʳ⁺-right⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ (left (left p)) = left (right p) joinʳ⁺-right⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ (left (right p)) = right (left p) joinʳ⁺-right⁺ k₂ t₁ (1# , node⁻ k₆ k₄ t₃ t₅ bal t₇) ∼+ (right p) = right (right p) ------------------------------------------------------------------------ -- insert module _ {V : Value v} where private Val = Value.family V Val≈ = Value.respects V module _ (k : Key) (f : Maybe (Val k) → Val k) where open <-Reasoning AVL.strictPartialOrder Any-insertWith-nothing : (t : Tree V l u n) (seg : l < k < u) → P (k , f nothing) → ¬ (Any ((k ≈_) ∘′ key) t) → Any P (proj₂ (insertWith k f t seg)) Any-insertWith-nothing (leaf l _ _ k>k′ = let seg′ = [ k>k′ ]ᴿ , k _ _ k>k′ = let seg′ = [ k>k′ ]ᴿ , k _ _ k>k′ = flip contradiction (irrefl⁺ [ k ]) $ begin-strict [ k ] ≈⟨ [ eq ]ᴱ ⟩ [ k′ ] <⟨ [ k>k′ ]ᴿ ⟩ [ k ] ∎ ... | left lp | tri≈ _ k≈k′ _ = flip contradiction (irrefl⁺ [ k ]) $ begin-strict let k″ = Any.lookup lp .key; k≈k″ = lookup-result lp; (_ , k″ _ _ k>k′ = flip contradiction (irrefl⁺ [ k ]) $ begin-strict let k″ = Any.lookup lp .key; k≈k″ = lookup-result lp; (_ , k″k′ ]ᴿ ⟩ [ k ] ∎ ... | right rp | tri< k _ _ k′ _ _ k′ _ _ k′