├── CoqMakefile.local ├── .gitmodules ├── Makefile ├── _CoqProject ├── opam ├── .gitignore ├── Computation ├── Notationv1.v └── Comp.v ├── .travis.yml ├── Utils ├── seq_subset.v ├── tactics.v ├── seq_ext.v ├── InvMisc.v └── stirling.v ├── Structures ├── Core │ ├── Hash.v │ ├── FixedMap.v │ ├── AMQReduction.v │ └── AMQHash.v ├── Demo.v ├── CountingBloomFilter │ └── CountingBloomFilter_Probability.v ├── BloomFilter │ └── BloomFilter_Definitions.v └── QuotientFilter │ └── QuotientFilter_Definitions.v └── readme.md /CoqMakefile.local: -------------------------------------------------------------------------------- 1 | COQDOCEXTRAFLAGS=-l --multi-index -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "infotheo"] 2 | path = infotheo 3 | url = https://github.com/affeldt-aist/infotheo.git 4 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: default 2 | 3 | default: Makefile.coq 4 | $(MAKE) -f Makefile.coq 5 | 6 | 7 | install: Makefile.coq 8 | $(MAKE) -f Makefile.coq install 9 | 10 | doc: Makefile.coq 11 | $(MAKE) -f Makefile.coq html 12 | 13 | 14 | clean: Makefile.coq 15 | $(MAKE) -f Makefile.coq cleanall 16 | rm -f Makefile.coq Makefile.coq.conf 17 | 18 | 19 | Makefile.coq: _CoqProject 20 | coq_makefile -f _CoqProject -o Makefile.coq 21 | 22 | .PHONY: all default quick install clean 23 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q Utils ProbHash.Utils 2 | -Q Computation ProbHash.Computation 3 | -R Structures ProbHash 4 | -arg "-w -notation-overridden,-local-declaration,-redundant-canonical-projection,-projection-no-head-constant" 5 | 6 | 7 | 8 | 9 | Computation/Comp.v 10 | Computation/Notationv1.v 11 | Structures/Core/AMQHash.v 12 | Structures/Core/AMQ.v 13 | Structures/Core/AMQReduction.v 14 | Structures/BloomFilter/BloomFilter_Definitions.v 15 | Structures/BloomFilter/BloomFilter_Probability.v 16 | Structures/Core/FixedList.v 17 | Structures/Core/FixedMap.v 18 | Structures/Core/Hash.v 19 | Structures/Core/HashVec.v 20 | Structures/CountingBloomFilter/CountingBloomFilter_Definitions.v 21 | Structures/CountingBloomFilter/CountingBloomFilter_Probability.v 22 | Structures/QuotientFilter/QuotientFilter_Definitions.v 23 | Structures/QuotientFilter/QuotientFilter_Probability.v 24 | Structures/BlockedAMQ/BlockedAMQ.v 25 | Utils/InvMisc.v 26 | Utils/tactics.v 27 | Utils/rsum_ext.v 28 | Utils/seq_ext.v 29 | Utils/seq_subset.v 30 | Utils/stirling.v -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "Coq library for reasoning about probabilistic algorithms" 3 | description: """ 4 | ProbHash extends coq-infotheo to support reasoning about probabilistic algorithms, 5 | and includes a collection of lemmas on random oracle based hash functions. 6 | 7 | Provides an example implementation of a bloom filter and uses the library to prove 8 | the probability of a false positive. 9 | """ # Longer description, can span several lines 10 | 11 | homepage: "https://github.com/certichain/probhash" 12 | dev-repo: "git+https://github.com/certichain/probhash.git" 13 | bug-reports: "https://github.com/certichain/probhash/issues" 14 | maintainer: "kirang@comp.nus.edu.sg" 15 | authors: [ 16 | "Kiran Gopinathan" 17 | "Ilya Sergey" 18 | ] 19 | license: "GPLv3" # Make sure this is reflected by a LICENSE file in your sources 20 | depends: [ 21 | "coq" {>= "8.11.0" & < "8.11.1"} 22 | "coq-mathcomp-ssreflect" {>= "1.10" & < "1.11~"} 23 | "coq-mathcomp-analysis" { >= "0.2.3" & < "0.3~" } 24 | "coq-infotheo" { >= "0.1" & < "0.2~" } 25 | ] 26 | build: [ 27 | [make "-j%{jobs}%"] 28 | ] 29 | install: [ 30 | [make "install"] 31 | ] 32 | 33 | url { 34 | src: "https://github.com/certichain/ceramist/archive/1.0.1.tar.gz" 35 | checksum: "sha256=c6cd4a6e21247bc85499b80c791086a1df61ecf34ef7d96e760e073a21f28971" 36 | } 37 | 38 | tags: [ 39 | "category:Computer Science/Data Types and Data Structures" 40 | "keyword: bloomfilter" 41 | "keyword: probability" 42 | "date:2019-10-12" 43 | ] 44 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # ----------------------------------------------------------------------------- 2 | # Generic generated file patterns 3 | # ----------------------------------------------------------------------------- 4 | 5 | Thumbs.db 6 | .DS_Store 7 | .svn 8 | 9 | *~ 10 | #*# 11 | *.bak 12 | *.BAK 13 | *.orig 14 | *.prof 15 | *.rej 16 | 17 | *.hi 18 | *.hi-boot 19 | *.o-boot 20 | *.p_o 21 | *.t_o 22 | *.debug_o 23 | *.thr_o 24 | *.thr_p_o 25 | *.thr_debug_o 26 | *.o 27 | *.vo 28 | *.a 29 | *.o.cmd 30 | *.depend* 31 | .#* 32 | log 33 | tags 34 | 35 | # ----------------------------------------------------------------------------- 36 | # Haskell leftovers 37 | # ----------------------------------------------------------------------------- 38 | 39 | dist 40 | cabal-dev 41 | *.o 42 | *.hi 43 | *.chi 44 | *.chs.h 45 | *.dyn_o 46 | *.dyn_hi 47 | .virtualenv 48 | .hpc 49 | .hsenv 50 | .cabal-sandbox/ 51 | cabal.sandbox.config 52 | *.prof 53 | *.aux 54 | *.hp 55 | 56 | # ----------------------------------------------------------------------------- 57 | # Emacs-generated TeX files 58 | # ----------------------------------------------------------------------------- 59 | 60 | _region_.* 61 | cv/*.out 62 | *.rel 63 | *.log 64 | *.blg 65 | *.aux 66 | *.bbl 67 | *.synctex.gz 68 | *.out.ps 69 | .#* 70 | 71 | # ----------------------------------------------------------------------------- 72 | # Coq-generated stuff 73 | # ----------------------------------------------------------------------------- 74 | 75 | \#*\# 76 | *.vo 77 | *.v.d 78 | *.glob 79 | .coq-native 80 | Makefile.coq 81 | *.aux 82 | .coqdeps.d 83 | Makefile.coq.conf 84 | Makefile.conf 85 | 86 | *.vok 87 | *.vos 88 | .Makefile.coq.d 89 | -------------------------------------------------------------------------------- /Computation/Notationv1.v: -------------------------------------------------------------------------------- 1 | (** 2 | * Notation1.v 3 | ----------------- 4 | Defines a more natural monadic notation for the probabilistic 5 | computation monad defined in [Comp.v]. 6 | *) 7 | 8 | Set Implicit Arguments. 9 | 10 | From mathcomp.ssreflect 11 | Require Import ssreflect ssrnat seq ssrbool ssrfun fintype choice eqtype . 12 | 13 | From ProbHash.Computation 14 | Require Import Comp. 15 | 16 | 17 | Lemma size_enum_equiv: forall n: nat, size(enum (ordinal n.+1)) = n.+1 -> #|ordinal_finType n.+1| = n.+1. 18 | Proof. 19 | move=> n H. 20 | by rewrite unlock H. 21 | Qed. 22 | 23 | (** Draw a uniformly random integer value from the finite range 0 to n *) 24 | Definition random n := (@Rnd (ordinal_finType n.+1) n (size_enum_equiv (size_enum_ord n.+1))). 25 | 26 | Notation "'ret' v" := (Ret _ v) (at level 75). 27 | Notation "[0 ... n ]" := (random n). 28 | Notation "{ 0 , 1 } ^ n" := (random (2^n)) 29 | (right associativity, at level 77). 30 | Notation "{ 0 , 1 }" := (random 1) 31 | (right associativity, at level 75). 32 | Notation "x <-$ c1 ; c2" := (@Bind _ _ c1 (fun x => c2)) 33 | (right associativity, at level 81, c1 at next level). 34 | Notation "x <- e1 ; e2" := ((fun x => e2) e1) 35 | (right associativity, at level 81, e1 at next level). 36 | Notation "'P[' a '===' b ']'" := ((evalDist a) b). 37 | Notation "'P[' a ']'" := ((evalDist a) true). 38 | Notation "'E[' a ']'" := (expected_value a). 39 | Notation " a '|>' b " := (w_a <-$ a; b w_a) (at level 50). 40 | Notation " w '>>=' a '<&&>' b " := (fun w => ret (a && b )) (at level 49). 41 | Notation " w '>>=' a '<||>' b " := (fun w => ret (a || b )) (at level 49). 42 | 43 | Definition example := 44 | x <- 3; 45 | y <-$ [0 ... 3]; 46 | ret y. 47 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | opam: &OPAM 2 | language: minimal 3 | sudo: required 4 | services: docker 5 | install: | 6 | # Prepare the COQ container 7 | docker pull ${COQ_IMAGE} 8 | docker run -d -i --init --name=COQ -v ${TRAVIS_BUILD_DIR}:/home/coq/${CONTRIB_NAME} -w /home/coq/${CONTRIB_NAME} ${COQ_IMAGE} 9 | travis_wait 60 docker exec COQ /bin/bash --login -c " 10 | # This bash script is double-quoted to interpolate Travis CI env vars: 11 | echo \"Build triggered by ${TRAVIS_EVENT_TYPE}\" 12 | export PS4='+ \e[33;1m(\$0 @ line \$LINENO) \$\e[0m ' 13 | set -ex # -e = exit on failure; -x = trace for debug 14 | sudo apt-get update -y -q 15 | DEBIAN_FRONTEND=noninteractive sudo apt-get install -y -q --no-install-recommends zlib1g-dev libgmp-dev 16 | opam switch ${SWITCH} ; eval $(opam env) 17 | opam update -y 18 | opam pin add ${CONTRIB_NAME} . -y -n -k path 19 | opam install ${CONTRIB_NAME} -y -j ${NJOBS} --deps-only 20 | opam config list 21 | opam repo list 22 | opam list 23 | " 24 | script: 25 | - echo -e "${ANSI_YELLOW}Building ${CONTRIB_NAME}...${ANSI_RESET}" && echo -en 'travis_fold:start:script\\r' 26 | - | 27 | travis_wait 60 docker exec COQ /bin/bash --login -c " 28 | export PS4='+ \e[33;1m(\$0 @ line \$LINENO) \$\e[0m ' 29 | set -ex 30 | sudo chown -R coq:coq /home/coq/${CONTRIB_NAME} 31 | opam install ${CONTRIB_NAME} -v -y -j ${NJOBS} 32 | " 33 | - docker stop COQ # optional 34 | - echo -en 'travis_fold:end:script\\r' 35 | 36 | matrix: 37 | include: 38 | 39 | # Test supported versions of Coq via OPAM 40 | - env: 41 | - COQ_IMAGE=mathcomp/mathcomp:1.10.0-coq-8.11 42 | - CONTRIB_NAME=coq-ceramist 43 | - NJOBS=4 44 | - SWITCH=4.07.1+flambda 45 | <<: *OPAM 46 | 47 | -------------------------------------------------------------------------------- /Utils/seq_subset.v: -------------------------------------------------------------------------------- 1 | (** * Utils/seq_subset.v 2 | ----------------- 3 | 4 | Definition of a subset relation on lists and a number of properties 5 | about this relation.*) 6 | 7 | 8 | 9 | From mathcomp.ssreflect 10 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq . 11 | From mathcomp.ssreflect 12 | Require Import tuple. 13 | 14 | Require Import Coq.Logic.ProofIrrelevance. 15 | Require Import Coq.Logic.FunctionalExtensionality. 16 | 17 | Set Implicit Arguments. 18 | Unset Strict Implicit. 19 | 20 | Unset Printing Implicit Defensive. 21 | 22 | From ProbHash.Utils 23 | Require Import seq_ext InvMisc. 24 | From ProbHash.Core 25 | Require Import Hash. 26 | 27 | 28 | Notation "a \subseteq b" := (all (fun a' => a' \in b) a) (at level 70). 29 | 30 | Lemma subseteq_in_rem (A: eqType) (p : A) (ps: seq A) inds: 31 | p \notin ps -> 32 | (p \in inds) -> 33 | (ps \subseteq (rem p inds)) = (ps \subseteq inds). 34 | Proof. 35 | move=> Hnin IHind. 36 | elim: ps Hnin => //= q qs IHps. 37 | rewrite //= in_cons Bool.negb_orb =>/andP[Hneq Hnin]. 38 | move: (IHps Hnin) => ->. 39 | rewrite andbC [(q \in inds) && _]andbC; apply f_equal. 40 | clear IHps Hnin qs IHind. 41 | by apply rem_in_neq; rewrite eq_sym. 42 | Qed. 43 | 44 | Lemma subseq_cons_cat (A: eqType) (ps qs: seq A) (q: A): (ps \subseteq (q::qs)) = (ps \subseteq qs ++ [:: q]). 45 | Proof. 46 | elim: ps qs q => [|p ps IHps] qs q//=. 47 | by rewrite mem_cat mem_seq1 in_cons IHps orbC. 48 | Qed. 49 | 50 | Lemma subseq_consC (A: eqType) (ps qs rs: seq A) : (ps \subseteq (qs ++ rs)) = (ps \subseteq rs ++ qs). 51 | Proof. 52 | elim: ps qs rs => [|p ps IHps] qs rs//=. 53 | by rewrite !mem_cat IHps orbC. 54 | Qed. 55 | 56 | Lemma subseq_consA (A: eqType) (ps qs rs ts: seq A) : (ps \subseteq ((qs ++ rs) ++ ts)) = (ps \subseteq qs ++ (rs ++ ts)). 57 | Proof. 58 | elim: ps qs rs ts => [|p ps IHps] qs rs ts//=. 59 | by rewrite !mem_cat IHps orbA. 60 | Qed. 61 | -------------------------------------------------------------------------------- /Computation/Comp.v: -------------------------------------------------------------------------------- 1 | (** * Comp.v 2 | ----------------- 3 | Defines an data type encoding of the syntax of a probabilistic computation, 4 | and provides operations to evaluate such computations into the distribution 5 | type defined by the infotheo library. 6 | *) 7 | From mathcomp.ssreflect 8 | Require Import ssreflect ssrbool ssrnat seq ssrfun eqtype bigop fintype choice. 9 | 10 | Require Import Reals Fourier FunctionalExtensionality. 11 | 12 | From infotheo 13 | Require Import fdist proba pproba ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop . 14 | 15 | Require Import Nsatz. 16 | Require Import Bvector. 17 | 18 | 19 | Set Implicit Arguments. 20 | 21 | (** convenience wrapper around infotheo's finite distribution type *) 22 | Definition dist A := fdist A. 23 | 24 | (** Probabilistic Computation Monad - based on FCF's Computation Monad *) 25 | Section Comp. 26 | 27 | (** Data type encoding the syntax of a probabilistic computation *) 28 | Inductive Comp : finType -> Type := 29 | | Ret : forall (A : finType) (a : A), Comp A 30 | | Bind : forall (A B : finType), Comp B -> (B -> Comp A) -> Comp A 31 | | Rnd : forall (A : finType) (n : nat) (n_valid : #|A| = n.+1), Comp A. 32 | 33 | (** Deprecated function to retrieve the support of a probabilistic computation. 34 | `enum (evalDist p)` should be used instead *) 35 | Fixpoint getSupport(A : finType) (c : Comp A) : list A := 36 | match c with 37 | | Ret _ a => [:: a] 38 | | Bind _ _ c1 c2 => 39 | (flatten 40 | (map 41 | (fun b => (getSupport (c2 b))) 42 | (getSupport c1) 43 | ) 44 | ) 45 | (* | Repeat _ c P => (filter P (getSupport c)) *) 46 | | Rnd A n _ => (flatten (map (fun x => match pickle_inv x with 47 | | Some value => [:: value] 48 | | None => [::] 49 | end) (index_iota 0 n.+1))) 50 | end. 51 | 52 | (** Evaluates a syntactical encoding of a probabilistic 53 | computation into Infotheo's probability monad *) 54 | Fixpoint evalDist(A : finType) (c : Comp A) : dist A := 55 | match c with 56 | | Ret _ a => FDist1.d a (* Dist1 is a distribution of 1 or 0 if eq a*) 57 | | Bind _ _ c f => FDistBind.d (evalDist c) (fun b => evalDist (f b)) 58 | | Rnd _ n n_valid => Uniform.d n_valid 59 | end. 60 | 61 | (** Unused operations to determine the expected value of a 62 | probabilistic computation *) 63 | Section expected_value. 64 | Variable n : nat. 65 | Definition expected_value (c : Comp (ordinal_finType n)) : R:= (Ex (evalDist c) INR). 66 | End expected_value. 67 | 68 | End Comp. 69 | -------------------------------------------------------------------------------- /Structures/Core/Hash.v: -------------------------------------------------------------------------------- 1 | (** * Structures/Core/Hash.v 2 | ----------------- 3 | 4 | Definition of arbitrary hash functions, assuming perfect uniform 5 | distribution. Each hash function is represented using a random 6 | variable to simulate uniformly distributed random outputs (i.e a 7 | perfect hash function) and a map mapping of input types to output 8 | values, to ensure repeated hashes of the same value produce the same 9 | output. 10 | *) 11 | 12 | From mathcomp.ssreflect 13 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path. 14 | 15 | From mathcomp.ssreflect 16 | Require Import tuple. 17 | 18 | 19 | From ProbHash.Computation 20 | Require Import Comp Notationv1. 21 | 22 | From ProbHash.Utils 23 | Require Import seq_ext. 24 | 25 | From ProbHash.Core 26 | Require Import FixedList FixedMap. 27 | 28 | 29 | (** Parameters of a hash function *) 30 | Module Type HashSpec. 31 | (** Input type being hashed *) 32 | Parameter B: finType. 33 | (** size of hash output and bitvector output *) 34 | Parameter Hash_size: nat. 35 | End HashSpec. 36 | 37 | (** Implementation of a hash function as a random oracle. *) 38 | Module Hash (Spec : HashSpec). 39 | 40 | Export Spec. 41 | Definition hash_keytype := [eqType of B]. 42 | Definition hash_valuetype := [eqType of (ordinal Hash_size.+1)]. 43 | Definition HashState n := fixmap hash_keytype hash_valuetype n. 44 | Definition hashstate_find n k (m: HashState n) := fixmap_find k m. 45 | Definition hashstate_put n k v (m: HashState n) := fixmap_put k v m. 46 | 47 | Lemma hash_find_insert_involutive n' value x y : 48 | FixedList.fixlist_length y + 1 <= n' -> 49 | hashstate_find n' value (hashstate_put n' value x y) = Some x. 50 | Proof. 51 | rewrite /hashstate_find/hashstate_put//=. 52 | rewrite addnS addn0. 53 | elim: n' value x y => [//=|n' IHn'] value x y . 54 | rewrite (tuple_eta y) //=. 55 | rewrite/FixedList.ntuple_head/FixedList.ntuple_tail -/behead_tuple !theadE ?beheadE ?behead_tupleE //=. 56 | case: (thead y) => [[k' v']|]//=; first case Hkeq: (k' == value) => //=; rewrite ?eq_refl//=. 57 | rewrite !ntuple_cons_eq //=. 58 | rewrite !behead_tupleE Hkeq //= => Hlen. 59 | apply IHn' => //=. 60 | Qed. 61 | 62 | Canonical hashstate_of_eqType n := Eval hnf in [eqType of (HashState n)]. 63 | Canonical hashstate_of_choiceType n := Eval hnf in [choiceType of (HashState n)]. 64 | Canonical hashstate_of_countType n := Eval hnf in [countType of (HashState n)]. 65 | Canonical hashstate_of_finType n := Eval hnf in [finType of (HashState n)]. 66 | 67 | Definition gen_random : Comp [finType of (ordinal Hash_size.+1)] := 68 | y <-$ [0 ... Hash_size]; 69 | ret y. 70 | Definition hash n (value: hash_keytype) (hash_state: HashState n) : Comp [finType of ((HashState n) * hash_valuetype)] := 71 | match hashstate_find _ value hash_state with 72 | | Some(value) => ret (hash_state, value) 73 | | None => 74 | rnd <-$ gen_random; 75 | new_state <- hashstate_put _ value rnd hash_state; 76 | ret (new_state, rnd) 77 | end. 78 | 79 | End Hash. 80 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Ceramist - Verified Hash-based Approximate Membership Structures 2 | 3 | [![Build Status](https://travis-ci.org/certichain/ceramist.svg?branch=master)](https://travis-ci.org/certichain/ceramist) 4 | [![License](https://img.shields.io/badge/License-GPLv3-blue.svg)](https://raw.githubusercontent.com/certichain/ceramist/master/LICENSE) 5 | [![DOI](https://zenodo.org/badge/189386550.svg)](https://zenodo.org/badge/latestdoi/189386550) 6 | 7 | 8 | ## Installation (using Opam) 9 | Create a new switch 10 | ``` 11 | opam switch create ceramist 4.09.0 12 | eval $(opam env) 13 | ``` 14 | 15 | Add coq-released repository to opam: 16 | ``` 17 | opam repo add coq-released https://coq.inria.fr/opam/released 18 | ``` 19 | 20 | Install ceramist: 21 | ``` 22 | opam install coq-ceramist.1.0.1 23 | ``` 24 | 25 | 26 | ## Installation (from Sources) 27 | Use opam to install dependencies 28 | 29 | ``` 30 | opam install ./opam 31 | ``` 32 | 33 | Then build the project: 34 | ``` 35 | make clean && make 36 | ``` 37 | Takes around an hour to build. 38 | 39 | ## Project Structure 40 | The structure of the overall development is as follows: 41 | ``` 42 | . 43 | ├── Computation 44 | │   ├── Comp.v 45 | │   └── Notationv1.v 46 | ├── Structures 47 | │   ├── BlockedAMQ 48 | │   │   └── BlockedAMQ.v 49 | │   ├── BloomFilter 50 | │   │   ├── BloomFilter_Definitions.v 51 | │   │   └── BloomFilter_Probability.v 52 | │   ├── Core 53 | │   │   ├── AMQHash.v 54 | │   │   ├── AMQReduction.v 55 | │   │   ├── AMQ.v 56 | │   │   ├── FixedList.v 57 | │   │   ├── FixedMap.v 58 | │   │   ├── Hash.v 59 | │   │   └── HashVec.v 60 | │   ├── CountingBloomFilter 61 | │   │   ├── CountingBloomFilter_Definitions.v 62 | │   │   └── CountingBloomFilter_Probability.v 63 | │   └── QuotientFilter 64 | │   ├── QuotientFilter_Definitions.v 65 | │   └── QuotientFilter_Probability.v 66 | └── Utils 67 | ├── InvMisc.v 68 | ├── rsum_ext.v 69 | ├── seq_ext.v 70 | ├── seq_subset.v 71 | ├── stirling.v 72 | └── tactics.v 73 | 74 | 8 directories, 22 files 75 | ``` 76 | 77 | The library is split into separate logical components by directory: 78 | - *Computation* - defines a probability monad and associated notation for it on top of the 'coq-infotheo' probability library. 79 | - *Utils* - collection of utility lemmas and tactics used throughout the development 80 | - *Structures/Core* - contains definitions and properties about the core probabilistic primitives exported by the library, and defines the abstract AMQ interface satisfied by all instantiations. 81 | - *Structures/BloomFilter* - example use of the exported library to prove various probabilistic properties on bloom filters. 82 | - *Structures/CountingBloomFilter* - another exemplar use of the library to prove probabilistic properties on counting bloom filters. 83 | - *Structures/QuotientBloomFilter* - exemplar use of library to prove probabilistic properties of quotient filters 84 | - *Structures/BlockedAMQ* - exemplar use of library to prove probabilistic properties of a higher order AMQ - the blockedAMQ 85 | 86 | Check out `Structures/Demo.v` for an example instantiation of the BlockedAMQ to derive Blocked Bloom filters, Counting Blocked bloom filters and Blocked Quotient filters. 87 | 88 | ## Tactics 89 | To simplify reasoning about probabilistic computations, we provide a few helper tactics under `ProbHash.Utils`: 90 | 91 | - `comp_normalize` - is a tactic which normalizes probabilistic computations in the goal to a standard 92 | form consisting of a nested summation with a summand which is the product of each individual statement: 93 | For example, if our goal contains a term of the form: 94 | ``` 95 | d[ res <-$ hash n v hsh; 96 | x <- fst res; 97 | ret x ] value 98 | ``` 99 | applying `comp_normalize` normalizes it to: 100 | ``` 101 | \sum_(i in HashState n) 102 | \sum_(i0 in 'I_Hash_size.+1) 103 | ((d[ hash n v hsh]) (i, i0) *R* 104 | ((value == i0) %R)) 105 | ``` 106 | This tactic works by simply recursively descending the computation and expanding the 107 | definition of the distribution. 108 | 109 | - `comp_simplify` - is a tactic which effectively applies beta 110 | reduction to the normalized form, substituting any `ret x` (which 111 | have been normalized to a factor of the form `(x == ...)` by the previous tactic) 112 | statements into the rest of the computation - applying it to the previous example would result in: 113 | ``` 114 | \sum_(i in HashState n) 115 | (d[ hash n v hsh]) (i, value) 116 | ``` 117 | - `comp_simplify_n n` - is a variant of the previous one which applies 118 | the reduction a fixed number `n` of times as sometimes the previous 119 | tactic may loop. 120 | - `comp_possible_decompose` - is a tactic which converts a fact (must 121 | be first element of goal) about a possible computation 122 | `( d[ c1; c2; ....; cn] v != 0)` 123 | into a fact about the possibility of the individual statements of 124 | the computation 125 | `forall v1,v2, ..., vn, d[ c1 ] v1 != 0 -> d[ c2] v2 -> .... d[ cn] vn != 0` 126 | - `comp_possible_exists` is a tactic which converts a goal about a computation being possible 127 | `( d[ c1; c2; ....; cn] v != 0)` 128 | into a corresponding proof of existance, where one must provide 129 | possible outcomes for each statement outcome 130 | `exists v1,v2, ..., vn, d[ c1 ] v1 != 0 /\ d[ c2] v2 /\ .... /\ d[ cn] vn != 0` 131 | - `comp_impossible_decompose` - is a tactic which automatically 132 | decomposes an impossibility statement 133 | `\sum_{v1} ... \sum_{vn} P[c1 = v1] * ... * P[ cn = vn ] = 0` 134 | into properties about its component parts 135 | `forall v1,..,vn, P[c1 = v1] * ... * P[cn = vn] = 0` 136 | 137 | - `exchange_big_inwards f` - is a tactic which moves the outermost 138 | summation in a series of nested summations to the innermost 139 | position, then applies the supplied tactic `f` in this context. 140 | 141 | - `exchange_big_outwards n` - is a tactic which moves the `n`th 142 | summation in a series of nested summations to the outermost 143 | position. 144 | 145 | ## License 146 | Given its dependencies: 147 | 148 | - Coq (distributed under the LGPLv2.1 license) 149 | - MathComp (distributed under the CeCILL-B license) 150 | - Infotheo (distributed under the GPLv3 license) 151 | 152 | ProbHash is distributed under the GPLv3 license. 153 | -------------------------------------------------------------------------------- /Structures/Core/FixedMap.v: -------------------------------------------------------------------------------- 1 | (** * Structures/Core/FixedMap.v 2 | ----------------- 3 | 4 | Defines a variable-length finite map data structure, and provides a 5 | small library of helper operations and properties. *) 6 | 7 | 8 | From mathcomp.ssreflect 9 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path. 10 | 11 | From mathcomp.ssreflect 12 | Require Import tuple. 13 | 14 | From ProbHash.Core 15 | Require Import FixedList. 16 | 17 | From ProbHash.Utils 18 | Require Import seq_ext InvMisc. 19 | 20 | Set Implicit Arguments. 21 | 22 | Require Import Coq.Logic.FunctionalExtensionality. 23 | Require Import Coq.Logic.ProofIrrelevance. 24 | 25 | 26 | Section fixmap. 27 | 28 | Variable K : eqType. 29 | 30 | Variable V : eqType. 31 | 32 | Definition fixmap n := fixlist [eqType of (K * V)] n. 33 | 34 | Definition fixmap_empty n : fixmap n := 35 | (fixlist_empty _ n). 36 | 37 | Fixpoint fixmap_find (k : K) (n : nat) (map : fixmap n) {struct n} : option V := 38 | match n as n0 return (n = n0 -> fixmap n0 -> option V) with 39 | | 0 => fun (_ :n = 0) (map: fixmap 0) => None 40 | | n0.+1 => fun (H: n = n0.+1) (map: fixmap n0.+1) => 41 | match ntuple_head map with 42 | | Some (k',v') => if k' == k 43 | then Some v' 44 | else fixmap_find k (ntuple_tail map) 45 | | None => fixmap_find k (ntuple_tail map) 46 | end 47 | end (erefl n) map. 48 | 49 | Fixpoint fixmap_find_ind' (acc: nat) (k : K) (n : nat) (map : fixmap n) : option nat. 50 | case n eqn: H. 51 | exact None. 52 | case (ntuple_head map). 53 | move=> [k' v']. 54 | case (k' == k) eqn: H'. 55 | exact (Some acc). 56 | exact (fixmap_find_ind' acc.+1 k n0 (ntuple_tail map)). 57 | exact (fixmap_find_ind' acc.+1 k n0 (ntuple_tail map)). 58 | Defined. 59 | 60 | Definition fixmap_find_ind (k : K) (n : nat) (map : fixmap n) : option nat := 61 | fixmap_find_ind' 0 k map. 62 | 63 | Fixpoint fixmap_put (k : K) (v : V) (n : nat) (map : fixmap n) {struct n} : fixmap n := 64 | match n as n0 return (n = n0 -> fixmap n0 -> fixmap n0) with 65 | | 0 => fun (_ : n = 0) (map : fixmap 0) => map 66 | | n0.+1 => fun (Hn: n = n0.+1) (map: fixmap n0.+1) => 67 | match ntuple_head map with 68 | | Some (k',v') => if k' == k 69 | then ntuple_cons (Some (k,v)) (ntuple_tail map) 70 | else ntuple_cons (Some (k',v')) (fixmap_put k v (ntuple_tail map)) 71 | | None => ntuple_cons (Some (k,v)) (ntuple_tail map) 72 | end 73 | end (erefl n) map. 74 | 75 | 76 | 77 | Lemma fixmap_find_ind_pred n (fm : fixmap n) k acc ind : 78 | acc > 0 -> 79 | fixmap_find_ind' acc k fm = Some ind -> 80 | fixmap_find_ind' acc.-1 k fm = Some ind.-1. 81 | Proof. 82 | move: fm acc ind => []. 83 | elim: n. 84 | by move=> [] //=. 85 | move=> n IHn [//=|x xs] //= Heqn acc ind . 86 | case: acc => //= acc Hacc. 87 | rewrite /ntuple_head//=/thead (tnth_nth x) //=. 88 | case: x => //=. 89 | move=> [k' v'] //=. 90 | move: (erefl _). 91 | case: (_ == _) => //= _. 92 | by move => [] <- //=. 93 | rewrite /ntuple_tail //=; move: (behead_tupleP _) => //= Hxseqn /IHn H. 94 | by apply H. 95 | rewrite /ntuple_tail //=; move: (behead_tupleP _) => //= Hxseqn /IHn H. 96 | by apply H. 97 | Qed. 98 | 99 | 100 | 101 | Lemma fixmap_find_ind_empty n (fm : fixmap n) k acc : 102 | fixlist_is_empty fm -> 103 | fixmap_find_ind' acc k fm = None. 104 | Proof. 105 | move: fm k acc => []; elim: n => //= n IHn [//=| x xs] //= Heqn k acc. 106 | case: x => //=. 107 | rewrite /fixlist_is_empty//= fixlist_coerce_none => Hempty. 108 | rewrite /ntuple_tail //=; move: (behead_tupleP _) => //= prf'. 109 | rewrite (proof_irrelevance _ prf' Heqn) => //=. 110 | by apply IHn => //=. 111 | Qed. 112 | 113 | 114 | 115 | Lemma fixmap_find_neq (n : nat) (map : fixmap n) 116 | (x y : K) (v: V): 117 | (x != y) -> 118 | (fixmap_find x map == None) -> 119 | (fixmap_find x (fixmap_put y v map) == None). 120 | Proof. 121 | elim: n map x y v => [//=|n IHn] [[//=|m ms] Hmap] x y v Hneq /eqP Hz. 122 | apply/eqP; move: Hz; move=> //=. 123 | rewrite/FixedList.ntuple_head //=. 124 | have: thead (Tuple Hmap) = m. by []. move=>->. 125 | case: m Hmap => [[k' v']|] Hmap //=. 126 | case Hk': (k' == x) => //=. 127 | - case: (k' == y) => //=. 128 | - move/Bool.negb_true_iff: Hneq; rewrite (eq_sym y) => -> //=. 129 | move: Hmap (eq_ind _ _ _ _ _) => //= Hmap Hmap'. 130 | rewrite (proof_irrelevance _ Hmap' Hmap); move=> <- //=. 131 | rewrite/FixedList.ntuple_tail; move: (behead_tupleP _) (behead_tupleP _) => //= H1 H2. 132 | by rewrite (proof_irrelevance _ H1 H2). 133 | - by rewrite ntuple_head_consE Hk' ntuple_tail_consE => /eqP/(IHn _ _ _ _ Hneq)/eqP; apply. 134 | - rewrite eq_sym; move/Bool.negb_true_iff: (Hneq) ->. 135 | move: Hmap (eq_ind _ _ _ _ _) => //=Hmap Hmap'. 136 | rewrite (proof_irrelevance _ Hmap Hmap') /FixedList.ntuple_tail//=. 137 | move: (behead_tupleP _) (behead_tupleP _) => //= H H'. 138 | by rewrite (proof_irrelevance _ H H'). 139 | Qed. 140 | 141 | 142 | 143 | Lemma fixedlist_add_incr (l m n': nat) (hsh: fixmap l ) (ind: V) (value: K): 144 | length (fixlist_unwrap hsh) + m < n' -> 145 | length (fixlist_unwrap (fixmap_put value ind hsh)) + m <= n'. 146 | Proof. 147 | move=> H. 148 | move:(ltn_SnnP (length (FixedList.fixlist_unwrap hsh) + m) n') => [_ ] H'. 149 | move: (H' H); clear H' H. 150 | rewrite -addSn addnC -ltn_subRL => Hlen. 151 | rewrite -ltnS addnC -ltn_subRL. 152 | eapply leq_ltn_trans; last by exact Hlen. 153 | clear Hlen. 154 | move: hsh => [ls Hls]. 155 | elim: l ls Hls => [//=| l IHl] [//=| x xs] Hxs //=. 156 | have->: (FixedList.ntuple_head (Tuple Hxs)) = x; first by []. 157 | case: x xs Hxs => [[k' v']|] xs Hxs; last first; last case Heq: (_ == _). 158 | - by apply (@leq_ltn_trans (FixedList.fixlist_length (Tuple Hxs))) => //=. 159 | - by rewrite ltnS leq_eqVlt ltnS; apply/orP; right; rewrite leq_eqVlt; apply/orP; left=>//=. 160 | - 161 | rewrite /FixedList.ntuple_tail; move: (behead_tupleP _) => //= Hls'. 162 | move: (IHl xs Hls') => IHl'. 163 | rewrite/FixedList.fixlist_length/FixedList.ntuple_cons. 164 | by case Hput: (fixmap_put _) => [ms Hms] //=; move: IHl';rewrite Hput. 165 | Qed. 166 | 167 | 168 | Lemma fixmap_find_eq (n:nat) (map: fixmap n) (x y: K) (v v_prime: V): 169 | x != y -> fixmap_find x map == Some v -> fixmap_find x (fixmap_put y v_prime map) == Some v. 170 | Proof. 171 | elim: n map x y v => [//=| n IHn] map x y v Hxneq //=. 172 | case_eq (ntuple_head map) => [[k' v'] |//=] Heq; rewrite Heq //=. 173 | - { 174 | case Hk'eq: (k' == y) => //=. 175 | - { 176 | move/Bool.negb_true_iff: (Hxneq); rewrite eq_sym => ->. 177 | have ->: (k' == x = false); first by move/eqP:Hk'eq ->; move/Bool.negb_true_iff: Hxneq; rewrite eq_sym. 178 | rewrite/ntuple_tail; move: (behead_tupleP _) => //= H1; move:(behead_tupleP _) => //= H2. 179 | by rewrite (proof_irrelevance _ H1 H2). 180 | } 181 | rewrite /ntuple_head ntuple_head_consE ntuple_tail_consE. 182 | case: (k' == x); first by []. 183 | move =>/ (IHn (ntuple_tail map) x y v Hxneq) //=. 184 | } 185 | - { 186 | move/Bool.negb_true_iff:(Hxneq); rewrite eq_sym => -> //=. 187 | rewrite/ntuple_tail; move: (behead_tupleP _) => //= H1; move:(behead_tupleP _) => //= H2. 188 | by rewrite (proof_irrelevance _ H1 H2). 189 | } 190 | Qed. 191 | 192 | End fixmap. 193 | 194 | Section fin_fixmap. 195 | Variable K : finType. 196 | Variable V : finType. 197 | Variable n : nat. 198 | 199 | Definition finmap := fixmap K V n. 200 | 201 | Canonical finmap_of_eqType := Eval hnf in [eqType of finmap]. 202 | 203 | Canonical finmap_of_choiceType := Eval hnf in [choiceType of finmap]. 204 | 205 | Canonical finmap_of_countType := Eval hnf in [countType of finmap]. 206 | 207 | Canonical finmap_of_finType := Eval hnf in [finType of finmap]. 208 | 209 | End fin_fixmap. 210 | -------------------------------------------------------------------------------- /Structures/Demo.v: -------------------------------------------------------------------------------- 1 | (** * Structures/Demo.v 2 | ----------------- 3 | Demonstrates the use of the Blocked AMQ data structure to obtain new 4 | Blocked data structures and their associated proofs "for free". 5 | 6 | Specifically, this file contains definitions and proofs of the 7 | properties of the following data structures: 8 | - Blocked Bloom Filters 9 | - Blocked Counting Bloom Filters 10 | - Blocked Quotient Bloom Filters 11 | *) 12 | 13 | From mathcomp.ssreflect 14 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path bigop finfun binomial. 15 | 16 | From mathcomp.ssreflect 17 | Require Import tuple. 18 | 19 | From mathcomp 20 | Require Import path. 21 | 22 | From infotheo Require Import 23 | fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba. 24 | 25 | Set Implicit Arguments. 26 | Unset Strict Implicit. 27 | Unset Printing Implicit Defensive. 28 | 29 | 30 | 31 | From ProbHash.Computation 32 | Require Import Comp Notationv1. 33 | 34 | From ProbHash.Core 35 | Require Import Hash HashVec FixedList AMQ AMQHash. 36 | 37 | From ProbHash.Utils 38 | Require Import InvMisc seq_ext seq_subset rsum_ext stirling tactics. 39 | 40 | From ProbHash.BlockedAMQ 41 | Require Import BlockedAMQ. 42 | 43 | From ProbHash.BloomFilter 44 | Require Import BloomFilter_Definitions BloomFilter_Probability. 45 | 46 | From ProbHash.CountingBloomFilter 47 | Require Import CountingBloomFilter_Definitions CountingBloomFilter_Probability. 48 | 49 | From ProbHash.QuotientFilter 50 | Require Import QuotientFilter_Definitions QuotientFilter_Probability. 51 | 52 | Module BlockedBloomFilter (Spec: HashSpec) (BlockedAMQSpec: BlockedAMQSpec). 53 | Module BloomFilterCore := BloomFilterProbability Spec. 54 | Module BloomFilterAMQ := BloomFilterCore.BloomfilterAMQ. 55 | Module BloomFilterProperties := BloomFilterCore.BloomFilterProperties. 56 | Module BloomFilterHash := BloomFilterCore.BasicHashVec. 57 | Module BlockedBloomFilter := BlockedAMQ 58 | (BlockedAMQSpec) 59 | (BloomFilterHash) 60 | (BloomFilterAMQ). 61 | 62 | Module BlockedBloomFilterAMQ := BlockedBloomFilter.AMQ. 63 | Module BlockedBloomFilterProperties := BlockedBloomFilter.BlockedAMQProperties (BloomFilterProperties). 64 | 65 | Lemma BlockedBloomFilter_false_positives: 66 | forall (h : BlockedBloomFilter.MetaHash.AMQHashParams) (s : BlockedBloomFilter.AMQ.AMQStateParams) 67 | (hashes : BlockedBloomFilter.MetaHash.AMQHash h) (l : nat) 68 | (value : BlockedBloomFilter.MetaHash.AMQHashKey) 69 | (values : seq BlockedBloomFilter.MetaHash.AMQHashKey), 70 | length values == l -> 71 | BlockedBloomFilter.MetaHash.AMQHash_hashstate_valid hashes -> 72 | BlockedBloomFilter.MetaHash.AMQHash_hashstate_available_capacity hashes l.+1 -> 73 | BlockedBloomFilter.AMQ.AMQ_available_capacity h (BlockedBloomFilter.AMQ.AMQ_new s) l.+1 -> 74 | all (BlockedBloomFilter.MetaHash.AMQHash_hashstate_unseen hashes) (value :: values) -> 75 | uniq (value :: values) -> 76 | (d[ res1 <-$ 77 | BlockedBloomFilterProperties.AmqOperations.AMQ_query (BlockedBloomFilter.AMQ.AMQ_new s) hashes 78 | value; 79 | (let (hashes1, _) := res1 in 80 | res2 <-$ 81 | BlockedBloomFilterProperties.AmqOperations.AMQ_add_multiple hashes1 82 | (BlockedBloomFilter.AMQ.AMQ_new s) values; 83 | (let (hashes2, amq) := res2 in 84 | res' <-$ BlockedBloomFilterProperties.AmqOperations.AMQ_query amq hashes2 value; ret res'.2))]) 85 | true = 86 | \sum_(i < l.+1) 87 | (((('C(l, i) %R) *R* 88 | (Rdefinitions.Rinv (#|BlockedBloomFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R) ^R^ i)) *R* 89 | ((1 -R- Rdefinitions.Rinv (#|BlockedBloomFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R)) 90 | ^R^ l - i)) *R* 91 | ((Rdefinitions.Rinv (Spec.Hash_size.+1 %R) ^R^ i.+1 * h.2.2.+1) *R* 92 | \sum_(a in ordinal_finType Spec.Hash_size.+2) 93 | (((((a %R) ^R^ h.2.2.+1) *R* (Factorial.fact a %R)) *R* 94 | (binomial.binomial Spec.Hash_size.+1 a %R)) *R* stirling_no_2 (i * h.2.2.+1) a))). 95 | Proof. 96 | by apply BlockedBloomFilterProperties.AMQ_false_positives_rate. (* trivial... *) 97 | Qed. 98 | 99 | End BlockedBloomFilter. 100 | 101 | Module BlockedCountingBloomFilter (Spec: HashSpec) (BlockedAMQSpec: BlockedAMQSpec). 102 | Module CountingBloomFilterCore := CountingBloomFilter Spec. 103 | Module CountingBloomFilterAMQ := CountingBloomFilterCore.CountingBloomFilterDefinitions.AMQ. 104 | Module CountingBloomFilterProperties := CountingBloomFilterCore.CountingBloomFilterProperties. 105 | Module CountingBloomFilterHash := CountingBloomFilterCore.CountingBloomFilterDefinitions.BloomFilterProbability.BasicHashVec. 106 | Module CountingBlockedBloomFilter := BlockedAMQ 107 | (BlockedAMQSpec) 108 | (CountingBloomFilterHash) 109 | (CountingBloomFilterAMQ). 110 | 111 | Module CountingBlockedBloomFilterAMQ := CountingBlockedBloomFilter.AMQ. 112 | Module CountingBlockedBloomFilterProperties := CountingBlockedBloomFilter.BlockedAMQProperties (CountingBloomFilterProperties). 113 | 114 | Lemma CountingBlockedBloomFilter_false_positives: 115 | forall (h : CountingBlockedBloomFilter.MetaHash.AMQHashParams) 116 | (s : CountingBlockedBloomFilter.AMQ.AMQStateParams) 117 | (hashes : CountingBlockedBloomFilter.MetaHash.AMQHash h) (l : nat) 118 | (value : CountingBlockedBloomFilter.MetaHash.AMQHashKey) 119 | (values : seq CountingBlockedBloomFilter.MetaHash.AMQHashKey), 120 | length values == l -> 121 | CountingBlockedBloomFilter.MetaHash.AMQHash_hashstate_valid hashes -> 122 | CountingBlockedBloomFilter.MetaHash.AMQHash_hashstate_available_capacity hashes l.+1 -> 123 | CountingBlockedBloomFilter.AMQ.AMQ_available_capacity h (CountingBlockedBloomFilter.AMQ.AMQ_new s) 124 | l.+1 -> 125 | all (CountingBlockedBloomFilter.MetaHash.AMQHash_hashstate_unseen hashes) (value :: values) -> 126 | uniq (value :: values) -> 127 | (d[ res1 <-$ 128 | CountingBlockedBloomFilterProperties.AmqOperations.AMQ_query 129 | (CountingBlockedBloomFilter.AMQ.AMQ_new s) hashes value; 130 | (let (hashes1, _) := res1 in 131 | res2 <-$ 132 | CountingBlockedBloomFilterProperties.AmqOperations.AMQ_add_multiple hashes1 133 | (CountingBlockedBloomFilter.AMQ.AMQ_new s) values; 134 | (let (hashes2, amq) := res2 in 135 | res' <-$ CountingBlockedBloomFilterProperties.AmqOperations.AMQ_query amq hashes2 value; 136 | ret res'.2))]) true = 137 | \sum_(i < l.+1) 138 | (((('C(l, i) %R) *R* 139 | (Rdefinitions.Rinv (#|CountingBlockedBloomFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R) 140 | ^R^ i)) *R* 141 | ((1 -R- 142 | Rdefinitions.Rinv (#|CountingBlockedBloomFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R)) 143 | ^R^ l - i)) *R* 144 | ((Rdefinitions.Rinv (Spec.Hash_size.+1 %R) ^R^ i.+1 * h.2.2.+1) *R* 145 | \sum_(a in ordinal_finType Spec.Hash_size.+2) 146 | (((((a %R) ^R^ h.2.2.+1) *R* (Factorial.fact a %R)) *R* ('C(Spec.Hash_size.+1, a) %R)) *R* 147 | stirling_no_2 (i * h.2.2.+1) a))). 148 | Proof. 149 | by apply CountingBlockedBloomFilterProperties.AMQ_false_positives_rate. (* trivial... *) 150 | Qed. 151 | 152 | End BlockedCountingBloomFilter. 153 | 154 | Module BlockedQuotientFilter (Spec: QuotientFilterSpec) (BlockedAMQSpec: BlockedAMQSpec). 155 | Module QuotientFilterCore := QuotientFilterProbability Spec. 156 | Module QuotientFilterAMQ := QuotientFilterCore.QuotientFilterAMQ. 157 | Module QuotientFilterProperties := QuotientFilterCore.QuotientFilterProperties. 158 | Module QuotientFilterHash := QuotientFilterCore.BasicHash. 159 | 160 | Module BlockedQuotientFilter := BlockedAMQ 161 | (BlockedAMQSpec) 162 | (QuotientFilterHash) 163 | (QuotientFilterAMQ). 164 | 165 | Module BlockedQuotientFilterAMQ := BlockedQuotientFilter.AMQ. 166 | Module BlockedQuotientFilterProperties := BlockedQuotientFilter.BlockedAMQProperties (QuotientFilterProperties). 167 | 168 | Lemma CountingBlockedBloomFilter_false_positives: 169 | forall (h : BlockedQuotientFilter.MetaHash.AMQHashParams) 170 | (s : BlockedQuotientFilter.AMQ.AMQStateParams) (hashes : BlockedQuotientFilter.MetaHash.AMQHash h) 171 | (l : nat) (value : BlockedQuotientFilter.MetaHash.AMQHashKey) 172 | (values : seq BlockedQuotientFilter.MetaHash.AMQHashKey), 173 | length values == l -> 174 | BlockedQuotientFilter.MetaHash.AMQHash_hashstate_valid hashes -> 175 | BlockedQuotientFilter.MetaHash.AMQHash_hashstate_available_capacity hashes l.+1 -> 176 | BlockedQuotientFilter.AMQ.AMQ_available_capacity h (BlockedQuotientFilter.AMQ.AMQ_new s) l.+1 -> 177 | all (BlockedQuotientFilter.MetaHash.AMQHash_hashstate_unseen hashes) (value :: values) -> 178 | uniq (value :: values) -> 179 | (d[ res1 <-$ 180 | BlockedQuotientFilterProperties.AmqOperations.AMQ_query (BlockedQuotientFilter.AMQ.AMQ_new s) 181 | hashes value; 182 | (let (hashes1, _) := res1 in 183 | res2 <-$ 184 | BlockedQuotientFilterProperties.AmqOperations.AMQ_add_multiple hashes1 185 | (BlockedQuotientFilter.AMQ.AMQ_new s) values; 186 | (let (hashes2, amq) := res2 in 187 | res' <-$ BlockedQuotientFilterProperties.AmqOperations.AMQ_query amq hashes2 value; ret res'.2))]) 188 | true = 189 | \sum_(i < l.+1) 190 | (((('C(l, i) %R) *R* 191 | (Rdefinitions.Rinv (#|BlockedQuotientFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R) ^R^ i)) *R* 192 | ((1 -R- Rdefinitions.Rinv (#|BlockedQuotientFilter.MetaHash.BasicMetaHash.AMQHashValue h.1| %R)) 193 | ^R^ l - i)) *R* 194 | (1 -R- 195 | ((1 -R- Rdefinitions.Rinv QuotientFilterCore.QuotientFilterDefinitions.QuotientHash.Hash_size.+1) 196 | ^R^ i))). 197 | Proof. 198 | by apply BlockedQuotientFilterProperties.AMQ_false_positives_rate. (* trivial... *) 199 | Qed. 200 | 201 | Print Assumptions CountingBlockedBloomFilter_false_positives. 202 | End BlockedQuotientFilter. 203 | -------------------------------------------------------------------------------- /Utils/tactics.v: -------------------------------------------------------------------------------- 1 | (** * Utils/tactics.v 2 | ----------------- 3 | 4 | Provides the definition of a number of helper tactics used to automate 5 | common proof steps that arise when reasoning about probabilistic 6 | computations.*) 7 | 8 | 9 | From mathcomp.ssreflect Require Import 10 | ssreflect ssrbool ssrnat eqtype fintype 11 | choice ssrfun seq path bigop finfun binomial. 12 | 13 | From mathcomp.ssreflect Require Import tuple. 14 | 15 | From mathcomp Require Import path. 16 | 17 | From infotheo Require Import 18 | fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba. 19 | 20 | Require Import Coq.Logic.ProofIrrelevance. 21 | Require Import Coq.Logic.FunctionalExtensionality. 22 | 23 | Set Implicit Arguments. 24 | Unset Strict Implicit. 25 | Unset Printing Implicit Defensive. 26 | 27 | From ProbHash.Computation 28 | Require Import Comp Notationv1. 29 | 30 | From ProbHash.Core 31 | Require Import Hash HashVec FixedList FixedMap. 32 | 33 | From ProbHash.Utils 34 | Require Import InvMisc seq_ext seq_subset rsum_ext stirling. 35 | 36 | 37 | Lemma eq_rmull (f g x: Rdefinitions.R) : 38 | f = g -> (f *R* x) = (g *R* x). 39 | Proof. by move=>->. Qed. 40 | 41 | Lemma eq_rmulr (f g x: Rdefinitions.R) : 42 | f = g -> (x *R* f) = (x *R* g). 43 | Proof. by move=>->. Qed. 44 | Lemma cons_tuple_base (A:Type) (a:A) : [tuple a] = cons_tuple a [tuple]. 45 | Proof. by rewrite cons_tuple_eq_tuple //=. Qed. 46 | 47 | 48 | (** 49 | Normalizes a probabilistic computation into a standard form where the steps 50 | of the computation are multiplied together 51 | P[ c1; c2; c3; ...] => \sum ... \sum P[ c1 = x1 ] * P[c2 = x2] .... 52 | *) 53 | Ltac comp_normalize := 54 | match goal with 55 | | [ |- context [FDistBind.d _ _ ] ] => rewrite !FDistBind.dE //=; comp_normalize 56 | | [ |- context [Uniform.d _ ] ] => rewrite !Uniform.dE //=; comp_normalize 57 | | [ |- context [FDist1.d _]] => rewrite !FDist1.dE //=; comp_normalize 58 | | [ |- context [(cons_tuple _ _ )]] => rewrite -cons_tuple_eq_tuple; comp_normalize 59 | | [ |- context [(_ *R* _)]] => rewrite !(rsum_Rmul_distr_l, rsum_Rmul_distr_r, mulR1, mulR0, mul1R, mul0R) //=; comp_normalize 60 | | [ |- context [(d[ _ ])] ] => rewrite //= !FDistBind.dE //=; comp_normalize 61 | | [ |- context [\sum_(_ in _) _]] => 62 | rewrite ?( rsum_empty, rsum_split, rsum_Rmul_distr_l, rsum_Rmul_distr_r) 63 | //=; tryif under eq_bigr => ? ? do idtac then under eq_bigr => ? ? do comp_normalize else comp_normalize 64 | | [ |- context [(?X1 *R* ?X2)]] => progress (under eq_rmull do comp_normalize); 65 | progress (under eq_rmulr do comp_normalize); comp_normalize 66 | | [ |- _ ] => idtac 67 | end. 68 | 69 | (** pulls the nth (0-indexed) summation to the outermost point *) 70 | Ltac exchange_big_outwards n := 71 | match n with 72 | | ?n'.+1 => (under eq_bigr => ? ? do try exchange_big_outwards n'); rewrite exchange_big 73 | | 0 => idtac 74 | end. 75 | 76 | (** moves the outermost summation to the innermost and then executes tactic f in that context 77 | b,c 78 | ---------------------------------- ---------------------------------- 79 | \sum_{a) \sum_{b} \sum_{c} g(a,b,c) => \sum_{a) g(a,b,c) => apply f. 80 | *) 81 | Ltac exchange_big_inwards f := 82 | match goal with 83 | | [ |- context [\sum_(_ in _) _ ] ] => rewrite exchange_big //=; under eq_bigr => ? ? do exchange_big_inwards f 84 | | [ |- context [\sum_(_ in _) _ ] ] => f 85 | | [ |- _ ] => fail 86 | end. 87 | 88 | (** applies the provided tactic under all the summations *) 89 | Ltac under_all x := 90 | match goal with 91 | | [ |- context [\sum_(_ in _) _ ] ] => under eq_bigr => ? ? do (under_all x) 92 | | _ => x 93 | end. 94 | 95 | 96 | (** 97 | Given a summation index, rearranges the goal such that any equalities on the index are brought to the left. 98 | Once in this form, -big_pred_demote can be applied to raise the equality into the summation index, 99 | and big_pred1_eq can then be used to simplify the summation. 100 | *) 101 | Ltac comp_simplify_eq x := 102 | match goal with 103 | | [ |- (Under_rel _ _ ((_ (x == _) %R) *R* _)) _ ] => idtac 104 | | [ |- (((_ (x == _) %R) *R* _)) ] => idtac 105 | | [ |- context [(_ (_ == x) %R)] ] => rewrite [_ == x]eq_sym; comp_simplify_eq x 106 | | [ |- context [(((_ (x == _) %R) *R* _) *R* _)] ] => 107 | rewrite -[(((_ (x == _) %R) *R* _) *R* _)]mulRA; 108 | comp_simplify_eq x 109 | | [ |- context [(_ *R* ((_ (x == _) %R) *R* _))] ] => 110 | rewrite 111 | [(_ *R* ((_ (x == _) %R) *R* _))]mulRA 112 | [(_ *R* (_ (x == _) %R))]mulRC 113 | -[(((_ (x == _) %R) *R* _) *R* _)]mulRA; comp_simplify_eq x 114 | | [ |- context [(_ *R* (_ (x == _) %R))] ] => 115 | rewrite [(_ *R* (_ (x == _) %R))]mulRC; comp_simplify_eq x 116 | | [ |- context [(x,_) == (_,_)]] => 117 | rewrite [(x,_) == (_,_)]xpair_eqE 118 | [((x == _) && _ %R)]boolR_distr; comp_simplify_eq x 119 | | [ |- context [(_,x) == (_,_)]] => 120 | rewrite [(_,x) == (_,_)]xpair_eqE 121 | [(_ && (x == _) %R)]boolR_distr; comp_simplify_eq x 122 | | [ |- context [(_,_) == (x,_)]] => 123 | rewrite [(_,_) == (x,_)]xpair_eqE 124 | [((_ == x) && _ %R)]boolR_distr; comp_simplify_eq x 125 | | [ |- context [(_,_) == (_,x)]] => 126 | rewrite [(_,_) == (x,_)]xpair_eqE 127 | [(_ && (_ == x) %R)]boolR_distr; comp_simplify_eq x 128 | | [ |- context [(cons_tuple _ _)]] => 129 | rewrite !(xpair_eqE, xcons_eqE, cons_tuple_eq_tuple, cons_tuple_base, ntuple_cons_eq, ntuple_tailE); 130 | comp_simplify_eq x 131 | | [ |- _ ] => fail 132 | end. 133 | 134 | (** 135 | Recursively attempts to perform probabilistic beta reduction with every summation index in context 136 | *) 137 | Ltac comp_simplify_internal := 138 | match goal with 139 | | [|- context [\sum_(i in _) _]] => 140 | progress (exchange_big_inwards 141 | ltac:( 142 | (* once we've moved the summation to the inside *) 143 | (* move the equalities on the summation index to start of the summand *) 144 | under eq_bigr => i _ do comp_simplify_eq i; 145 | (* promote equality on summation index to summation and simplify 146 | i.e \sum(i in _) (i == 3 * f(i) ...) => 147 | \sum(i == 3 ) (f(i) ...) => 148 | f(3) ... *) 149 | (( 150 | rewrite -rsum_pred_demote big_pred1_eq //= 151 | 152 | ) || 153 | (* if that failed, it could be because the summation already has some predicate: 154 | \sum(i | P i) (i == 3 * f(i) ...) 155 | if so, the demote the existing predicate, and retry 156 | \sum(i) (P i * i == 3 * f(i) ...) 157 | *) 158 | ( 159 | rewrite rsum_pred_demote; 160 | under eq_bigr => i Hi do comp_simplify_eq i; rewrite -rsum_pred_demote big_pred1_eq //=)) 161 | )) || 162 | ( 163 | under eq_bigr => ? ? do progress comp_simplify_internal) 164 | end. 165 | 166 | 167 | 168 | (** 169 | Performs beta reduction until no further progress is made 170 | *) 171 | Ltac comp_simplify := 172 | do !(progress comp_simplify_internal). 173 | 174 | (** 175 | Same as comp_simplify, but only runs a fixed number of times 176 | (sometimes comp_simplify_internal can exchange the order of summands without making progress) 177 | *) 178 | Ltac comp_simplify_n n := 179 | do n!(progress comp_simplify_internal). 180 | 181 | 182 | (** dispatches 0 <= obligations that arise during proofs *) 183 | Ltac dispatch_eq0_obligations := 184 | intros; 185 | match goal with 186 | | [|- context [_ *R* _]] => apply RIneq.Rmult_le_pos 187 | | [|- context [\sum_(_ in _) _]] => apply rsumr_ge0 188 | | [|- context [#| _ |]] => rewrite card_ord 189 | | [|- context [_ -<=- _]] => apply fdist_ge0_le1 || apply leR0n || apply prob_invn 190 | | [|- context [Rdefinitions.Rinv (?x.+1 %R)]] => rewrite -add1n 191 | end. 192 | 193 | 194 | (** given that a probabilistic computation is possible (d[ c1; c2; c3] v) != 0, 195 | derives that individual statements of computation are also possible 196 | *) 197 | Ltac comp_possible_decompose := 198 | match goal with 199 | | [ |- ((?X ->- ?Y)) -> ?F ] => 200 | move=> /RIneq.Rgt_not_eq; comp_possible_decompose 201 | | [ |- (is_true (?X != ?Y)) -> ?F ] => 202 | move=>/eqP; comp_possible_decompose 203 | | [ |- ( (?X *R* ?Y <> ?Z)) -> ?F ] => 204 | move=>/RIneq.Rmult_neq_0_reg []; 205 | comp_possible_decompose 206 | | [ |- ( (?X <> ?Y)) -> ?F ] => 207 | let name := fresh "value" in 208 | (move=> /prsumr_ge0; case; first (by do?dispatch_eq0_obligations); 209 | move=> name; comp_possible_decompose; move:name) 210 | || ( move=>/eqP name; comp_possible_decompose; move: name ) | _ => idtac 211 | end. 212 | 213 | 214 | (** simplifies a impossibility statement i.e (c1 * c2 * c3 = 0) 215 | by automatically solving any cases with booleans and introducing 216 | them into the context: 217 | i.e (i == g (y)) * f = 0 -> i = g(y) -> f = 0 218 | intended to be used internally by comp impossible_decompose 219 | *) 220 | Ltac comp_impossible_simpl := 221 | move=>//=; 222 | match goal with 223 | | [ |- context [(true == _)] ] => rewrite eq_sym; comp_impossible_simpl 224 | | [ |- context [(_ == true)] ] => rewrite eqb_id; comp_impossible_simpl 225 | | [ |- context [(_ && _)]] => rewrite boolR_distr; comp_impossible_simpl 226 | | [ |- context [((_,_) == (_,_))]] => rewrite xpair_eqE; comp_impossible_simpl 227 | | [ |- context [(nat_of_bool ?X %R)]] => 228 | let tmp := fresh "tmp" in 229 | let name := fresh "P" in case tmp: X; move: tmp => name; rewrite //= ?(mulR0,mul0R,mulR1,mul1R); try (by []); 230 | comp_impossible_simpl; 231 | move: name 232 | | [ |- ?X ] => idtac 233 | end. 234 | 235 | 236 | (** 237 | automatically decomposes an impossibility statement (\sum_{v1} ... \sum_{vn} P[c1 = v1] * ... * P[ cn = vn ] = 0) 238 | into properties about its component parts (forall v1,..,vn, P[c1 = v1] * ... * P[cn = vn] = 0) 239 | *) 240 | Ltac comp_impossible_decompose := 241 | match goal with 242 | | [ |- ( ?X = _) ] => 243 | let value_name := fresh "value" in 244 | let hyp_name := fresh "P_value" in 245 | apply prsumr_eq0P => value_name hyp_name; first (by do?dispatch_eq0_obligations); 246 | comp_impossible_decompose; 247 | move: value_name hyp_name 248 | 249 | | _ => idtac 250 | end; 251 | comp_impossible_simpl. 252 | 253 | (** 254 | decomposes a possibility goal into a corresponding sequence of existence proofs - i.e 255 | (\sum_{v1} ... \sum_{vn} P[c1 = v1] * ... * P[ cn = vn ] != 0) -> 256 | (exists v1,...,vn, P[c1 = v1] * ... * P[ cn = vn ] != 0) 257 | *) 258 | Ltac comp_possible_exists := 259 | match goal with 260 | | [ |- context [((?X ->- ?Y))] ] => 261 | apply/RIneq.Rgt_not_eq; comp_possible_exists 262 | | [ |- context [ (?X <> ?Y) ] ] => 263 | apply/eqP; comp_possible_exists 264 | | [ |- context [(?X != ?Y)] ] => 265 | let value_name := fresh "value" in 266 | rewrite prsumr_neq0_eq; last (by do?dispatch_eq0_obligations); 267 | under eq_existsb => value_name do comp_possible_exists 268 | | _ => idtac 269 | end; 270 | move=>//=. 271 | 272 | -------------------------------------------------------------------------------- /Utils/seq_ext.v: -------------------------------------------------------------------------------- 1 | (** * Utils/seq_ext.v 2 | ----------------- 3 | 4 | A set of utility functions and lemmas on sequences and finite 5 | sequences.*) 6 | 7 | 8 | From mathcomp.ssreflect 9 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path. 10 | 11 | From mathcomp.ssreflect 12 | Require Import tuple. 13 | 14 | Require Import Coq.Logic.FunctionalExtensionality. 15 | Require Import Coq.Logic.ProofIrrelevance. 16 | 17 | From ProbHash.Utils Require Import InvMisc. 18 | 19 | 20 | 21 | Set Implicit Arguments. 22 | Unset Strict Implicit. 23 | Unset Printing Implicit Defensive. 24 | 25 | Lemma xcons_eqE {A: eqType} {l: nat} (h h': A) (t t': l.-tuple A): ((cons_tuple h t) == (cons_tuple h' t')) = (h == h') && (t == t'). 26 | Proof. 27 | by rewrite /cons_tuple//=. 28 | Qed. 29 | 30 | Lemma beheadE (E: eqType) (m: nat) (x: E) (xs: (m.-tuple E)): 31 | behead_tuple [tuple of x :: xs] = xs. 32 | Proof. 33 | case: xs => xs Hxs; rewrite /behead_tuple; move: (behead_tupleP _) => //= Hxs'. 34 | by rewrite (proof_irrelevance _ Hxs Hxs'). 35 | Qed. 36 | 37 | Lemma behead_tupleE n' A p (ps: n'.-tuple A) : (Tuple (behead_tupleP [tuple of p :: ps]) = ps). 38 | by case: ps (behead_tupleP _ ) => //= xs H H'; rewrite (proof_irrelevance _ H H'). 39 | Qed. 40 | 41 | Lemma tuple_eq_inj (A: eqType) l (xs ys: seq A) (Hxs: size xs == l) (Hys: size ys == l) : 42 | (Tuple Hxs == Tuple Hys) = (xs == ys). 43 | Proof. 44 | by move=> //=. 45 | Qed. 46 | 47 | Lemma size_ncons_nil (A : Type) (a : A) (n : nat): (size (ncons n a [::])) == n. 48 | Proof. 49 | rewrite size_ncons => //=. 50 | by rewrite addn0. 51 | Qed. 52 | 53 | Lemma negb_consP (A: eqType) (x y: A) (xs ys: seq A) : x :: xs != y :: ys = ((x != y) || (xs != ys)). 54 | Proof. 55 | by rewrite eqseq_cons Bool.negb_andb. 56 | Qed. 57 | 58 | Lemma nth_filter (B: eqType) (f:B) (fs ys: seq B) ind: ind < length (filter (fun f => f \notin ys) fs) -> nth f (filter (fun f => f \notin ys) fs) ind \in ys = false. 59 | Proof. { 60 | elim: fs ind => [//=| r rs IHrs //=] ind. 61 | case Hinr: (r \in ys) => //=; first by move=> /IHrs. 62 | case: ind => [|ind] /ltn_SnnP Hlen; first by []. 63 | by move=>//=; apply IHrs. 64 | } 65 | Qed. 66 | 67 | Lemma nth_mem_filter (B: eqType) (f:B) (fs: seq B) P ind: ind < length (filter P fs) -> nth f (filter P fs) ind \in fs. 68 | Proof. { 69 | elim: fs ind => [//= | r rs IHrs] ind //=; case: (P r) => //=. 70 | case: ind => [//= _ | ind ]; rewrite ?in_cons ?eq_refl ?Bool.orb_true_l //=. 71 | by move=>/ltn_SnnP/IHrs ->; rewrite Bool.orb_true_r. 72 | by rewrite in_cons =>/IHrs ->; rewrite Bool.orb_true_r. 73 | } 74 | Qed. 75 | 76 | Lemma mem_len (B: eqType) (f:B) (fs: seq B): f \notin fs -> index f fs = length fs. 77 | Proof. { 78 | elim: fs f => [//=| r rs IHrs] f. 79 | rewrite in_cons Bool.negb_orb =>/andP [Hfnr /IHrs Hind]//=. 80 | by rewrite eq_sym; move/Bool.negb_true_iff: Hfnr ->; rewrite Hind. 81 | } 82 | Qed. 83 | 84 | Lemma filter_leq_size (B: eqType) (fs: seq B) P: length (filter P fs) <= length fs. 85 | Proof. { 86 | elim: fs => [//=| f fs IHf] //=. 87 | case: (P f) => //=; by apply ltnW. 88 | } 89 | Qed. 90 | 91 | Lemma filter_size (B: eqType) (fs: seq B) P: length (filter P fs) = length fs - (length (filter (fun f => ~~ P f) fs)). 92 | Proof. { 93 | elim: fs P => [//=| f fs IHf] P //=. 94 | case: (P f) => //=. 95 | rewrite subSn; first rewrite IHf //=; last by apply filter_leq_size. 96 | by rewrite subSS IHf. 97 | } 98 | Qed. 99 | 100 | Lemma uniq_filter (B: eqType) (fs: seq B) P: uniq fs -> uniq (filter P fs). 101 | Proof. { 102 | elim: fs => [//= | f fs IHf] //= /andP [ Hnin Huniq]. 103 | case Hpf: (P f) => //=; last by apply IHf. 104 | rewrite IHf //= Bool.andb_true_r. 105 | by rewrite mem_filter Bool.negb_andb; apply/orP; right. 106 | } 107 | Qed. 108 | 109 | Lemma len_eq (B: eqType) (fs gs: seq B): uniq fs -> uniq gs -> length fs = length gs -> length (filter (fun f => f \notin gs) fs) = length (filter (fun g => g \notin fs) gs). 110 | Proof. { 111 | move=>Huniqfs Huniqgs Heqsize. 112 | rewrite filter_size [length (filter _ gs)]filter_size Heqsize; apply f_equal. 113 | transitivity (length (filter (fun f => f \in gs) fs)). 114 | by do ?apply f_equal; apply eq_in_filter => fs' Hin //=; rewrite Bool.negb_involutive. 115 | apply Logic.eq_sym; transitivity (length (filter (fun g => g \in fs) gs)). 116 | by do ?apply f_equal; apply eq_in_filter => fs' Hin //=; rewrite Bool.negb_involutive. 117 | rewrite -!length_sizeP. 118 | apply perm_size; rewrite/perm_eq. 119 | apply uniq_perm; try by apply uniq_filter. 120 | by move=> g; rewrite !mem_filter andbC //=. 121 | } 122 | Qed. 123 | 124 | Lemma cons_sizeP T l (x : T) xs : (size (x :: xs) == l.+1) -> (size xs == l). 125 | by []. 126 | Qed. 127 | 128 | Lemma mem_zip (S T : eqType) (ss : seq S) (ts: seq T) (s: S) (t: T): 129 | ((s,t) \in (zip ss ts)) -> ((s \in ss) && (t \in ts)). 130 | Proof. 131 | elim: ss ts => [|s' ss IHss] ts //=. 132 | - by case: ts =>//=. 133 | - case: ts => [//=|t' ts]. 134 | move=>//=; rewrite !in_cons //= xpair_eqE =>/orP[/andP[ -> -> //=]| ]. 135 | by move=>/IHss/andP[-> ->]; rewrite !Bool.orb_true_r. 136 | Qed. 137 | 138 | Lemma zip_empty_r (S T: eqType) (ts: seq T) : (@zip S _ [::] ts) = ([::]). 139 | Proof. 140 | by case: ts. 141 | Qed. 142 | Fixpoint swap_vec {A: finType} (m:nat) (ps qs: seq A) (list: m.-tuple A) : m.-tuple A := 143 | match m as m' return (m = m' -> m'.-tuple A -> m'.-tuple A) with 144 | | 0 => (fun (Hm: m = 0) (list: 0.-tuple A) => list) 145 | | m'.+1 => (fun (Hm: m = m'.+1) (list: (m'.+1).-tuple A) => 146 | let head := thead list in 147 | let tail := behead_tuple list in 148 | let new_head := (if (head \in ps) && (head \in qs) then 149 | head 150 | else if (head \in ps) then 151 | nth 152 | head 153 | (filter (fun p => p \notin qs) ps) 154 | (index head (filter (fun q => q \notin ps) qs)) 155 | else if (head \in qs) then 156 | nth 157 | head 158 | (filter (fun q => q \notin ps) qs) 159 | (index head (filter (fun p => p \notin qs) ps)) 160 | else head) in 161 | [tuple of new_head :: (swap_vec ps qs tail)] ) 162 | end (erefl m) list. 163 | 164 | Lemma substitute_vec_inv (A: finType) (m: nat) (ps qs: seq A) : 165 | uniq ps -> uniq qs -> length ps = length qs -> 166 | forall x : m.-tuple A, 167 | swap_vec qs ps (swap_vec ps qs x) = x. 168 | Proof. 169 | move=> Hinjp Hinjq. rewrite -!length_sizeP=> Hlength. 170 | elim: m => [//= | m IHm x] . 171 | rewrite (tuple_eta x) //=. 172 | rewrite !theadE !beheadE !IHm. 173 | case Hinp: (thead x \in ps); case Hinq: (thead x \in qs) => //=. 174 | - by rewrite Hinp Hinq //=. 175 | - rewrite mem_len. 176 | rewrite nth_default. 177 | rewrite Hinq //= Hinp mem_len. 178 | rewrite nth_default //=. 179 | by rewrite length_sizeP len_eq. 180 | by rewrite mem_filter Bool.negb_andb Hinp //=. 181 | by rewrite length_sizeP len_eq. 182 | by rewrite mem_filter Bool.negb_andb Hinp //=. 183 | - rewrite mem_len. 184 | rewrite nth_default. 185 | rewrite Hinp Hinq //=. 186 | rewrite mem_len. 187 | rewrite nth_default //=. 188 | by rewrite length_sizeP len_eq. 189 | by rewrite mem_filter Bool.negb_andb Hinp Bool.orb_true_r //=. 190 | by rewrite length_sizeP len_eq. 191 | by rewrite mem_filter Bool.negb_andb Hinp Bool.orb_true_r //=. 192 | - rewrite Hinp Hinq //=. 193 | Qed. 194 | 195 | Lemma swap_vec_bij (A: finType) (m: nat) (ps qs: seq A) : 196 | uniq ps -> uniq qs -> length ps = length qs -> 197 | bijective (@swap_vec _ m ps qs). 198 | Proof. 199 | move=> Huniqps Huniqqs Hleneq. 200 | split with (swap_vec qs ps); move=>x; by rewrite substitute_vec_inv. 201 | Qed. 202 | Definition tuple_split (A:finType) (m l: nat) (xs: (m * l + l).-tuple A) : (l.-tuple A * (m * l).-tuple A). 203 | split. 204 | move: (take_tuple l xs); rewrite minn_mult=>V; exact V. 205 | move: (drop_tuple l xs); rewrite mult_subn=>V; exact V. 206 | Defined. 207 | Definition tuple_split_mult (A:finType) (m l: nat) (xs: (m.+1 * l).-tuple A) : (l.-tuple A * (m * l).-tuple A). 208 | have H: (m.+1 * l = m * l + l); first by rewrite mulSnr. 209 | rewrite H in xs. 210 | exact (tuple_split xs). 211 | Defined. 212 | 213 | Lemma tcast_tval_eq (A: finType) (n' m : nat) (Hm: m = n') (v: m.-tuple A) (w: seq A) : 214 | w = tval v -> 215 | tval (tcast Hm v) = w. 216 | Proof. 217 | move=> -> //=. 218 | rewrite <-Hm. 219 | by rewrite tcast_id. 220 | Qed. 221 | 222 | Lemma tuple_split_valid (A: finType) (m l:nat) : bijective (fun (x: [finType of (m.-tuple A * (l * m).-tuple A)]) => let (b,a) := x in cat_tuple b a). 223 | split with (fun (xs : (m + l * m).-tuple A) => @tuple_split A l m (tcast (addnC m (l * m)) xs)) => [[p ps]| x]. 224 | apply/eqP; rewrite xpair_eqE; apply/andP; split=>//=; apply/eqP. 225 | - { 226 | rewrite/take_tuple; move: (take_tupleP _ _); rewrite/cat_tuple. 227 | erewrite (@tcast_tval_eq A (l * m + m) (m + l * m) (addnC m (muln l m)) 228 | (Tuple (cat_tupleP p ps)) (cat p ps)). 229 | rewrite take_cat //= size_tuple ltnn subnn take0 cats0 //=. 230 | move: (minn_mult _ _) => //=; rewrite minn_mult /eq_rect_r //= => Hm'. 231 | move: Hm' (Logic.eq_sym _ ) => _ H1. 232 | rewrite -(@Eq_rect_eq.eq_rect_eq nat m (fun y :nat => y.-tuple A -> m.-tuple A) id H1) //=. 233 | case: p => //= p' H4 H5; rewrite (proof_irrelevance _ H4 H5) //=. 234 | by move=>//=. 235 | } 236 | - { 237 | rewrite /drop_tuple; move: (drop_tupleP _ _); rewrite/cat_tuple. 238 | erewrite (@tcast_tval_eq A (l * m + m) (m + l * m) (addnC m (muln l m)) 239 | (Tuple (cat_tupleP p ps)) (cat p ps)). 240 | rewrite drop_cat //= size_tuple ltnn subnn drop0 //=. 241 | move: (mult_subn _ _) => //=; rewrite mult_subn /eq_rect_r //= => Hm'. 242 | move: Hm' (Logic.eq_sym _ ) => _ H1. 243 | rewrite -(@Eq_rect_eq.eq_rect_eq nat (l * m) (fun y :nat => y.-tuple A -> (l*m).-tuple A) id H1) //=. 244 | case: ps => //= p' H4 H5; rewrite (proof_irrelevance _ H4 H5) //=. 245 | by move=>//=. 246 | } 247 | - { 248 | move=> //=; rewrite /take_tuple/drop_tuple //=. 249 | rewrite/cat_tuple //=; move: (cat_tupleP _ _). 250 | move: (take_tupleP _ _) (drop_tupleP _ _) => //=. 251 | move: (minn_mult _ _) (mult_subn _ _) => //=. 252 | rewrite minn_mult mult_subn //= => H1 H2. 253 | rewrite /eq_rect_r. 254 | move: (Logic.eq_sym H1) => //=;clear H1=> H1. 255 | move: (Logic.eq_sym H2) => //=;clear H2=> H2. 256 | rewrite -(@Eq_rect_eq.eq_rect_eq nat m (fun y :nat => y.-tuple A -> m.-tuple A) id H1) //=. 257 | rewrite -(@Eq_rect_eq.eq_rect_eq nat (l * m) (fun y :nat => y.-tuple A -> (l * m).-tuple A) id H2) //=. 258 | rewrite cat_take_drop. 259 | move=> _ _; move: x (addnC _ _) . 260 | rewrite addnC => x Heq; rewrite tcast_id; case: x => //= x H3 H4 . 261 | by rewrite (proof_irrelevance _ H3 H4). 262 | } 263 | Qed. 264 | 265 | Lemma tnth_nseq_eq (A: Type) l a ind: 266 | tnth (@nseq_tuple l A a) ind = a. 267 | Proof. 268 | by rewrite/nseq_tuple/tnth; rewrite nth_nseq; case: ind => [ m Hm] //=; rewrite Hm. 269 | Qed. 270 | 271 | Lemma unzip_tupleP (n : nat) (T U : Type) (xs: seq (T * U)%type): 272 | size xs == n -> (size (unzip1 xs) == n) && (size (unzip2 xs) == n). 273 | Proof. 274 | move=>/eqP<-;clear n. 275 | by elim: xs => [//=| x xs /andP [Hl Hr]] //=. 276 | Qed. 277 | 278 | Lemma unzip_tuplePL (n : nat) (T U : Type) (xs: seq (T * U)%type): 279 | size xs == n -> size (unzip1 xs) == n. 280 | Proof. by move=>/unzip_tupleP/andP[]. Qed. 281 | 282 | Lemma unzip_tuplePR (n : nat) (T U : Type) (xs: seq (T * U)%type): 283 | size xs == n -> size (unzip2 xs) == n. 284 | Proof. by move=>/unzip_tupleP/andP[]. Qed. 285 | 286 | Definition unzip_tuple (n : nat) (T U : Type) (xs: n.-tuple (T * U)%type): 287 | (n.-tuple T * n.-tuple U)%type := 288 | let: (Tuple _ hprf) := xs in (Tuple (unzip_tuplePL hprf), Tuple (unzip_tuplePR hprf)). 289 | 290 | Lemma seq_neqP (A:eqType) (x y: seq A) : (exists (v:A), (v \in x) && (v \notin y)) -> (x != y). 291 | Proof. 292 | move=> [x'/andP[]]; move: x' y. 293 | elim: x => [| x xs IHx] x' [|y ys] //=. 294 | rewrite !in_cons Bool.negb_orb negb_consP. 295 | move=>/orP [/eqP -> | Hx']/andP[]; first by move=>-> //=. 296 | move=> Hxs' Hxs. 297 | by move: Hxs =>/IHx Hxs; move: (Hxs Hx') ->; rewrite Bool.orb_true_r. 298 | Qed. 299 | 300 | -------------------------------------------------------------------------------- /Structures/CountingBloomFilter/CountingBloomFilter_Probability.v: -------------------------------------------------------------------------------- 1 | (** * Structures/CountingBloomFilter/CountingBloomFilter_Probability.v 2 | ----------------- 3 | 4 | Proves the standard properties required to instantiate the 5 | AMQProperties interface for a Counting Bloom Filter - i.e proving 6 | false negative and false positive rates of a Counting Bloom Filter 7 | using the definitions defined in 8 | [Structures/CountingBloomFilter/CountingBloomFilter_Definitions.v] 9 | 10 | This file is a good example of how to use the AMQReduction modules to 11 | obtain properties of AMQs for free by reduction *) 12 | 13 | 14 | From mathcomp.ssreflect Require Import 15 | ssreflect ssrbool ssrnat eqtype fintype 16 | choice ssrfun seq path bigop finfun binomial. 17 | 18 | From mathcomp.ssreflect Require Import tuple. 19 | 20 | From mathcomp Require Import path. 21 | 22 | From infotheo Require Import 23 | fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba. 24 | 25 | Require Import Coq.Logic.ProofIrrelevance. 26 | Require Import Coq.Logic.FunctionalExtensionality. 27 | 28 | Set Implicit Arguments. 29 | Unset Strict Implicit. 30 | Unset Printing Implicit Defensive. 31 | 32 | From ProbHash.Computation 33 | Require Import Comp Notationv1. 34 | 35 | From ProbHash.Core 36 | Require Import Hash HashVec FixedList FixedMap AMQ AMQHash AMQReduction. 37 | 38 | From ProbHash.BloomFilter 39 | Require Import BloomFilter_Probability BloomFilter_Definitions. 40 | 41 | From ProbHash.CountingBloomFilter 42 | Require Import CountingBloomFilter_Definitions. 43 | 44 | From ProbHash.Utils 45 | Require Import InvMisc seq_ext seq_subset rsum_ext stirling tactics. 46 | 47 | Module CountingBloomFilter (Spec: HashSpec). 48 | 49 | 50 | Module CountingBloomFilterDefinitions := (CountingBloomFilterDefinitions Spec). 51 | Export CountingBloomFilterDefinitions. 52 | 53 | Module CountingBloomFilterProperties := AMQPropertyMap 54 | (BasicHashVec) 55 | (AMQ) 56 | (BloomFilterProbability.BloomfilterAMQ) 57 | (CountingBloomFilterDefinitions.BloomFilterReduction) 58 | (BloomFilterProbability.BloomFilterProperties). 59 | 60 | 61 | 62 | 63 | 64 | Section CountingBloomFilter. 65 | (* 66 | k - number of hashes 67 | *) 68 | Variable k: nat. 69 | (* 70 | n - maximum capacity of each counter 71 | *) 72 | Variable n: nat. 73 | 74 | Variable Hkgt0: k > 0. 75 | Variable Hngt0: n > 0. 76 | 77 | Lemma countingbloomfilter_preserve hashes l m (vals: seq B) hsh bf: 78 | l.+1 * k + m < n.+1 -> 79 | length vals == l -> 80 | ((d[ @countingbloomfilter_add_multiple k n hashes (countingbloomfilter_new n) vals]) 81 | (hsh, bf) != 0) -> 82 | countingbloomfilter_free_capacity bf (k + m). 83 | Proof. 84 | elim: vals l m hsh bf => [| val vals IHvals] [|l] m hsh bf Hltn Hlen //=. 85 | - { 86 | comp_normalize =>/bool_neq0_true; rewrite xpair_eqE =>/andP[_ /eqP ->]. 87 | apply countingbloomfilter_new_capacity. 88 | by move: Hltn; rewrite mul1n. 89 | } 90 | - { 91 | comp_normalize; comp_simplify; comp_possible_decompose. 92 | move=> hsh' bf' hsh2 H1 H2 /bool_neq0_true/eqP ->. 93 | have H3: (length vals) == l; first by move/eqP: Hlen => //= [->]. 94 | have H4: (l.+1 * k + (m + k) < n.+1); first by move: Hltn; rewrite mulSnr -addnA [k + m]addnC. 95 | move: (IHvals l (m + k) hsh' bf' H4 H3 H1) => Hpref; clear IHvals H4 H3 H1. 96 | eapply (@countingbloomfilter_add_capacity_change 0 _ k) => //=. 97 | - by rewrite -length_sizeP size_tuple. 98 | by rewrite [k + m]addnC. 99 | } 100 | Qed. 101 | 102 | 103 | 104 | Theorem countingbloomfilter_counter_prob 105 | hashes l (values: seq B): 106 | l * k < n.+1 -> 107 | length values == l -> 108 | d[ 109 | res1 <-$ @countingbloomfilter_add_multiple k n hashes (countingbloomfilter_new n) values; 110 | let (hashes1, bf') := res1 in 111 | ret (countingbloomfilter_bitcount bf' == l * k) 112 | ] true = 1. 113 | Proof. 114 | rewrite //= FDistBind.dE rsum_split //=. 115 | under eq_bigr => a _ do under eq_bigr => b _ do rewrite FDist1.dE eq_sym eqb_id. 116 | elim: values l => [| val vals IHval] [|l] Hltn Hval //=. 117 | - { 118 | by comp_normalize; comp_simplify; rewrite countingbloomfilter_new_empty_bitcount. 119 | } 120 | - { 121 | comp_normalize. 122 | comp_simplify_n 2. 123 | erewrite <- (IHval l) => //=. 124 | apply eq_bigr=> hsh1 _; apply eq_bigr=> bf1 _. 125 | under eq_bigr => hsh2 _ do under eq_bigr => bf2 _ do rewrite mulRC -mulRA. 126 | under eq_bigr => hsh2 _ do rewrite -rsum_Rmul_distr_l. 127 | rewrite -rsum_Rmul_distr_l. 128 | case Hzr0: ((d[ countingbloomfilter_add_multiple hashes (countingbloomfilter_new n) vals]) (hsh1, bf1) == 0). 129 | - by move/eqP: Hzr0 ->; rewrite !mul0R. 130 | - { 131 | apply f_equal. 132 | under eq_bigr => a _; first under eq_bigr => a0 _. 133 | rewrite -(@countingbloomfilter_add_internal_incr _ k); first by over. 134 | - by rewrite -length_sizeP size_tuple eq_refl. 135 | - { 136 | move/Bool.negb_true_iff: Hzr0 => Hzr0. 137 | have H2: (length vals) == l; first by move/eqP: Hval => //= [->]. 138 | move: (@countingbloomfilter_preserve hashes l 0 vals hsh1 bf1 ). 139 | by rewrite !addn0=> H1; move: (H1 Hltn H2 Hzr0). 140 | } 141 | by over. 142 | - { 143 | under_all ltac:(rewrite mulRC); 144 | under eq_bigr => ? _ do rewrite -rsum_Rmul_distr_l; rewrite -rsum_Rmul_distr_l. 145 | move: (fdist_is_fdist (d[ hash_vec_int val hsh1])) => [_ ]; rewrite rsum_split //= => ->. 146 | rewrite mulR1; apply f_equal =>//=. 147 | by rewrite mulSnr eqn_add2r. 148 | } 149 | } 150 | - by move: Hltn; rewrite mulSnr =>/addr_ltn. 151 | } 152 | Qed. 153 | 154 | 155 | Theorem countingbloomfilter_no_false_negatives l hashes amq x xs : 156 | countingbloomfilter_free_capacity amq (l.+1 * k) -> 157 | uniq (x :: xs) -> length xs == l -> hashes_have_free_spaces hashes (l.+1) -> 158 | all (hashes_value_unseen hashes) (x::xs) -> 159 | (d[ res1 <-$ CountingBloomFilterProperties.AmqOperations.AMQ_add amq hashes x; 160 | (let 161 | '(hsh1, amq1) := res1 in 162 | res2 <-$ CountingBloomFilterProperties.AmqOperations.AMQ_add_multiple hsh1 amq1 xs; 163 | (let 164 | '(hsh2, amq2) := res2 in 165 | res3 <-$ @CountingBloomFilterProperties.AmqOperations.AMQ_query (n,k.-1) 166 | (AMQ.mkStateParams Hngt0) 167 | amq2 hsh2 x; ret res3.2))]) true = (1 %R). 168 | Proof. 169 | move=> Hcap Hunq Hlen Hfree Hall. 170 | (* for free *) 171 | rewrite (@CountingBloomFilterProperties.AMQ_no_false_negatives 172 | _ _ _ _ l) //=. 173 | rewrite/AMQ.AMQ_available_capacity //=. 174 | by rewrite (prednK Hkgt0). 175 | Qed. 176 | 177 | 178 | Theorem countingbloomfilter_removal_preserve (hashes: k.-tuple (HashState n)) (cbf: CountingBloomFilter n) x x' : x != x' -> 179 | countingbloomfilter_free_capacity cbf k.*2 -> 180 | hashes_have_free_spaces hashes 2 -> 181 | all (hashes_value_unseen hashes) (x :: x' :: [::]) -> 182 | (d[ res1 <-$ countingbloomfilter_add x hashes cbf; 183 | let '(hsh1, bf1) := res1 in 184 | res2 <-$ countingbloomfilter_add x' hsh1 bf1; 185 | let '(hsh2, bf2) := res2 in 186 | res3 <-$ countingbloomfilter_remove x hsh2 bf2; 187 | let '(hsh3, bf3) := res3 in 188 | res4 <-$ countingbloomfilter_query x' hsh3 bf3; 189 | ret (snd res4) ] true) = (1 %R). 190 | Proof. 191 | move=> Hxneq Hcap Hfree Huns; comp_normalize. 192 | comp_simplify_n 4. 193 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 194 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 195 | exchange_big_outwards 5 => //=; comp_simplify_n 1. 196 | exchange_big_outwards 4 => //=; comp_simplify_n 1. 197 | move: Huns => //=/andP []; rewrite/hashes_value_unseen/hash_unseen => Hx /andP [Hx' _]. 198 | exchange_big_inwards ltac:(rewrite hash_vec_simpl //=). 199 | have Hxx' i: all (fun hsh => fixmap_find x' hsh == None) ((Tuple (hash_vec_insert_length x hashes i))). 200 | { 201 | apply/allP => v. 202 | move: (hash_vec_insert_length _ _ _) => //= Hsz. 203 | move=>/mapP [[v0 v1] ]/mem_zip/andP[Hv0 Hv1] ->; clear v. 204 | apply fixmap_find_neq; try by rewrite eq_sym //=. 205 | by move/allP: Hx' => /(_ v0 Hv0). 206 | } 207 | under_all ltac:(rewrite mulRC -!mulRA). 208 | under eq_bigr => i _. (move: (Hxx' i) => Hxx'i; exchange_big_inwards ltac:(rewrite hash_vec_simpl //=)). by over. 209 | clear Hxx'. 210 | have Hcontains i i0: 211 | hash_vec_contains_value x (Tuple (hash_vec_insert_length x' (Tuple (hash_vec_insert_length x hashes i)) i0)) i. 212 | { 213 | apply hash_vec_contains_value_preserve => //=; apply hash_vec_contains_value_base => //=. 214 | by move/allP: Hfree => Hfree; apply/allP => v Hv; move: (Hfree v Hv);rewrite/hash_has_free_spaces -ltnS addn1 addn2 -addn1=>/addr_ltn. 215 | } 216 | under eq_bigr => i _ do under eq_bigr => i0 _ do under eq_bigr => i1 _ do under eq_bigr => i2 _ do 217 | (move: (Hcontains i i0) => Hcont'; under_all ltac:(rewrite (@hash_vec_find_simpl _ _ x _ i1 i i2) //=)). 218 | 219 | under_all ltac:(rewrite boolR_distr). 220 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 221 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 222 | clear Hcontains. 223 | have Hcontains i i0: 224 | hash_vec_contains_value x' (Tuple (hash_vec_insert_length x' (Tuple (hash_vec_insert_length x hashes i)) i0)) i0. 225 | { 226 | apply hash_vec_contains_value_base => //=. 227 | apply/allP => v /mapP [[v0 v1] ]/mem_zip/andP[Hv0 Hv1] ->; clear v. 228 | apply fixedlist_add_incr; move/allP: Hfree => /(_ v0 Hv0);rewrite/hash_has_free_spaces. 229 | by rewrite -ltnS addn2 => /ltn_Snn; rewrite -addn1. 230 | } 231 | under eq_bigr => i _ do under eq_bigr => i0 _ do under eq_bigr => i1 _ do under eq_bigr => i2 _ do 232 | (move: (Hcontains i i0) => Hcont'; under_all ltac:(rewrite (@hash_vec_find_simpl _ _ x' _ i1 i0 i2) //=)). 233 | under_all ltac:(rewrite boolR_distr). 234 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 235 | exchange_big_outwards 2 => //=; comp_simplify_n 1. 236 | under_all ltac:(rewrite eq_sym eqb_id). 237 | clear Hcontains. 238 | have Hfin (i i0: k.-tuple 'I_Hash_size.+1): 239 | countingbloomfilter_query_internal 240 | i0 (countingbloomfilter_remove_internal i (countingbloomfilter_add_internal i0 (countingbloomfilter_add_internal i cbf))). 241 | { 242 | rewrite countingbloomfilter_add_exchange. 243 | rewrite -(@countingbloomfilter_add_remove_idempotent 0 n (length i)) //=; first by apply countingbloomfilter_add_base. 244 | apply (@countingbloomfilter_add_capacity_change 0 n k); first by rewrite -length_sizeP; case: i0 => //=. 245 | by rewrite -length_sizeP size_tuple addnn; apply/allP => v Hv; move/allP: Hcap => /(_ v Hv). 246 | } 247 | under eq_bigr => i _ do under eq_bigr => i0 _ do rewrite Hfin //= mul1R; rewrite -big_distrlr //=. 248 | suff ->: \sum_(i in [finType of k.-tuple 'I_Hash_size.+1]) (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ k) = 1; first by rewrite mulR1. 249 | by rewrite bigsum_card_constE card_tuple card_ord -natRexp -Rfunctions.Rinv_pow 250 | //=; first rewrite mulRV //=; 251 | first apply/eqP/Rfunctions.pow_nonzero; 252 | rewrite RIneq.INR_IZR_INZ //=. 253 | Qed. 254 | 255 | Theorem countingbloomfilter_collision_prob 256 | hashes l value (values: seq B): 257 | (l.+1 * k < n.+1) -> 258 | length values == l -> 259 | hashes_have_free_spaces hashes (l.+1) -> 260 | all (hashes_value_unseen hashes) (value::values) -> 261 | uniq (value::values) -> 262 | d[ 263 | res1 <-$ CountingBloomFilterProperties.AmqOperations.AMQ_query 264 | (AMQ.AMQ_new (AMQ.mkStateParams Hngt0)) hashes value; 265 | let (hashes1, init_query_res) := res1 in 266 | res2 <-$ CountingBloomFilterProperties.AmqOperations.AMQ_add_multiple 267 | hashes1 (AMQ.AMQ_new (AMQ.mkStateParams Hngt0)) values; 268 | let (hashes2, bf) := res2 in 269 | res' <-$ 270 | @CountingBloomFilterProperties.AmqOperations.AMQ_query (n,k.-1) _ 271 | bf hashes2 value; 272 | ret (res'.2) 273 | ] true = 274 | ((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l.+1 * k) *R* 275 | \sum_(i < (Hash_size.+2)) 276 | (((((i %R) ^R^ k) *R* (Factorial.fact i %R)) *R* ('C(Hash_size.+1, i) %R)) *R* stirling_no_2 (l * k) i)). 277 | Proof. 278 | move=> Hltn Hlen Hfree Huns Huniq. 279 | (* for free *) 280 | rewrite (@CountingBloomFilterProperties.AMQ_false_positives_rate _ _ _ l) //=. 281 | rewrite/CountingBloomFilterProperties.AMQ_false_positive_probability. 282 | rewrite/BloomFilterProperties.AMQ_false_positive_probability. 283 | change (n,k.-1).2.+1 with (k.-1.+1). 284 | rewrite (prednK Hkgt0) //=. 285 | 286 | rewrite/AMQ.AMQ_available_capacity. 287 | change (n,k.-1).2.+1 with (k.-1.+1). 288 | rewrite (prednK Hkgt0) //=. 289 | rewrite/AMQ.AMQ_new/AMQ.AMQStateParamsToNat. 290 | by apply countingbloomfilter_new_capacity. 291 | Qed. 292 | 293 | End CountingBloomFilter. 294 | End CountingBloomFilter. 295 | -------------------------------------------------------------------------------- /Structures/BloomFilter/BloomFilter_Definitions.v: -------------------------------------------------------------------------------- 1 | (** * Structures/BloomFilter/BloomFilter_Definitions.v 2 | ----------------- 3 | 4 | Provides the definitions and deterministic operations of a Bloom 5 | Filter and uses them to instantiate the AMQ interface. 6 | 7 | This file is a good example of the recommended structure to use when 8 | defining new AMQ data structures. *) 9 | 10 | From mathcomp.ssreflect 11 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path bigop finfun . 12 | From mathcomp.ssreflect 13 | Require Import tuple. 14 | From mathcomp 15 | Require Import path. 16 | Set Implicit Arguments. 17 | Unset Strict Implicit. 18 | Unset Printing Implicit Defensive. 19 | 20 | From ProbHash.Utils 21 | Require Import InvMisc. 22 | From ProbHash.Computation 23 | Require Import Comp Notationv1. 24 | From ProbHash.Core 25 | Require Import Hash HashVec FixedList AMQ AMQHash. 26 | 27 | 28 | 29 | Module BloomFilterDefinitions (Spec: HashSpec). 30 | 31 | Module HashVec := (HashVec Spec). 32 | Export HashVec. 33 | 34 | (** 35 | A fomalization of a bloom filter structure and properties 36 | *) 37 | Section BloomFilter. 38 | (** 39 | k - number of hashes 40 | *) 41 | Variable k: nat. 42 | (** 43 | n - maximum number of hashes supported 44 | *) 45 | Variable n: nat. 46 | Variable Hkgt0: k >0. 47 | 48 | Definition BitVector := (Hash_size.+1).-tuple bool. 49 | 50 | (** 51 | list of hash functions used in the bloom filter 52 | *) 53 | Record BloomFilter := mkBloomFilter { 54 | bloomfilter_state: BitVector 55 | }. 56 | 57 | Definition BloomFilter_prod (bf: BloomFilter) := 58 | (bloomfilter_state bf). 59 | 60 | Definition prod_BloomFilter pair := let: (state) := pair in @mkBloomFilter state. 61 | 62 | Lemma bloomfilter_cancel : cancel (BloomFilter_prod) (prod_BloomFilter). 63 | Proof. 64 | by case. 65 | Qed. 66 | 67 | Definition bloomfilter_eqMixin := 68 | CanEqMixin bloomfilter_cancel . 69 | 70 | Canonical bloomfilter_eqType := 71 | Eval hnf in EqType BloomFilter bloomfilter_eqMixin . 72 | 73 | Definition bloomfilter_choiceMixin := 74 | CanChoiceMixin bloomfilter_cancel. 75 | 76 | Canonical bloomfilter_choiceType := 77 | Eval hnf in ChoiceType BloomFilter bloomfilter_choiceMixin. 78 | 79 | Definition bloomfilter_countMixin := 80 | CanCountMixin bloomfilter_cancel. 81 | 82 | Canonical bloomfilter_countType := 83 | Eval hnf in CountType BloomFilter bloomfilter_countMixin. 84 | 85 | Definition bloomfilter_finMixin := 86 | CanFinMixin bloomfilter_cancel . 87 | 88 | Canonical bloomfilter_finType := 89 | Eval hnf in FinType BloomFilter bloomfilter_finMixin. 90 | 91 | Definition bloomfilter_set_bit (value: 'I_(Hash_size.+1)) bf : BloomFilter := 92 | mkBloomFilter 93 | (set_tnth (bloomfilter_state bf) true value). 94 | 95 | Definition bloomfilter_get_bit (value: 'I_(Hash_size.+1)) bf : bool := 96 | (tnth (bloomfilter_state bf) value). 97 | 98 | Fixpoint bloomfilter_add_internal (items: seq 'I_(Hash_size.+1)) bf : BloomFilter := 99 | match items with 100 | h::t => bloomfilter_add_internal t (bloomfilter_set_bit h bf) 101 | | [::] => bf 102 | end. 103 | 104 | 105 | Definition bloomfilter_query_internal (items: seq 'I_(Hash_size.+1)) bf : bool := 106 | all (fun h => bloomfilter_get_bit h bf) items. 107 | 108 | Definition bloomfilter_query (value: hash_keytype) (hashes: k.-tuple (HashState n)) (bf: BloomFilter) : Comp [finType of (k.-tuple (HashState n)) * bool ] := 109 | hash_res <-$ (HashVec.hash_vec_int value hashes); 110 | let (new_hashes, hash_vec) := hash_res in 111 | let qres := bloomfilter_query_internal (tval hash_vec) bf in 112 | ret (new_hashes, qres). 113 | 114 | 115 | Definition bloomfilter_new : BloomFilter. 116 | apply mkBloomFilter. 117 | apply Tuple with (nseq Hash_size.+1 false). 118 | by rewrite size_nseq. 119 | Defined. 120 | 121 | Lemma bloomfilter_new_empty_bits b : ~~ bloomfilter_get_bit b bloomfilter_new . 122 | Proof. 123 | clear k n Hkgt0. 124 | rewrite/bloomfilter_get_bit/bloomfilter_new //=. 125 | elim: Hash_size b => [[[|//=] Hm]|//= n IHn] //=. 126 | move=> [[| b] Hb]; rewrite /tnth //=. 127 | move: (Hb); move/ltn_SnnP: Hb => Hb' Hb;move: (IHn (Ordinal Hb'));rewrite /tnth //=. 128 | clear. 129 | move: (size_nseq n.+1 _) => Hprf. 130 | move:(tnth_default _ _) (tnth_default _ _); clear Hb => b1 b2. 131 | have ->: (false :: nseq n false) = (nseq n.+1 false); first by []. 132 | move: Hb'; rewrite -Hprf; clear Hprf. 133 | move: (n.+1); clear n; elim: b => [//= n'|]; first by case: (nseq n' _). 134 | move=> b IHb. 135 | case => [//=| n]. 136 | by move=>//=/ltn_SnnP/(IHb n) IHb' H; apply IHb'. 137 | Qed. 138 | 139 | Lemma bloomfilter_new_empty bs : length bs > 0 -> ~~ bloomfilter_query_internal bs bloomfilter_new . 140 | Proof. 141 | clear k n Hkgt0. 142 | case: bs => [//=| b1 [//=| b2 bs]] Hlen; first by rewrite Bool.andb_true_r; apply bloomfilter_new_empty_bits. 143 | rewrite Bool.negb_andb; apply/orP; left; apply bloomfilter_new_empty_bits. 144 | Qed. 145 | 146 | Lemma bloomfilter_set_bitC bf ind ind': 147 | (bloomfilter_set_bit ind (bloomfilter_set_bit ind' bf)) = 148 | (bloomfilter_set_bit ind' (bloomfilter_set_bit ind bf)). 149 | Proof. 150 | rewrite /bloomfilter_set_bit/bloomfilter_state//. 151 | apply f_equal => //. 152 | apply eq_from_tnth => pos. 153 | case Hpos: (pos == ind); case Hpos': (pos == ind'). 154 | - by rewrite !FixedList.tnth_set_nth_eq. 155 | - rewrite FixedList.tnth_set_nth_eq; last by []. 156 | rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos' ->. 157 | by rewrite FixedList.tnth_set_nth_eq; last by []. 158 | - rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos ->. 159 | rewrite FixedList.tnth_set_nth_eq; last by []. 160 | by rewrite FixedList.tnth_set_nth_eq; last by []. 161 | - rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos ->. 162 | rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos' ->. 163 | rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos' ->. 164 | by rewrite FixedList.tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hpos ->. 165 | Qed. 166 | 167 | Lemma bloomfilter_add_internal_hit bf (ind: 'I_Hash_size.+1) hshs : 168 | (ind \in hshs) -> 169 | (tnth (bloomfilter_state (bloomfilter_add_internal hshs bf)) ind). 170 | Proof. 171 | elim: hshs bf => //= hsh hshs IHs bf. 172 | rewrite in_cons => /orP [/eqP -> | H]; last by apply IHs. 173 | clear IHs ind. 174 | elim: hshs bf hsh => //. 175 | - rewrite /bloomfilter_add_internal/bloomfilter_set_bit/bloomfilter_state //. 176 | by move=> bf hsh; rewrite FixedList.tnth_set_nth_eq => //=. 177 | - move=> hsh hshs IHs bf hsh'. 178 | move=> //=. 179 | rewrite bloomfilter_set_bitC . 180 | by apply IHs. 181 | Qed. 182 | 183 | Lemma bloomfilter_add_internal_preserve bf ind hshs: 184 | tnth (bloomfilter_state bf) ind -> 185 | tnth (bloomfilter_state (bloomfilter_add_internal hshs bf)) ind. 186 | Proof. 187 | elim: hshs bf ind => //= hsh hshs IHs bf ind Htnth. 188 | apply IHs. 189 | rewrite /bloomfilter_set_bit/bloomfilter_state //. 190 | case Hhsh: (ind == hsh). 191 | - by rewrite FixedList.tnth_set_nth_eq //=. 192 | - rewrite FixedList.tnth_set_nth_neq; first by move: Htnth; rewrite/bloomfilter_state//=. 193 | by move/Bool.negb_true_iff: Hhsh. 194 | Qed. 195 | 196 | Lemma bloomfilter_add_internal_miss 197 | bf (ind: 'I_Hash_size.+1) hshs : 198 | ~~ tnth (bloomfilter_state bf) ind -> 199 | ~~ ( ind \in hshs) -> 200 | (~~ tnth (bloomfilter_state (bloomfilter_add_internal hshs bf)) ind). 201 | Proof. 202 | move=> Htnth. 203 | elim: hshs bf Htnth => //= hsh hshs IHs bf Htnth. 204 | move=> H; move: (H). 205 | rewrite in_cons. 206 | rewrite negb_or => /andP [Hneq Hnotin]. 207 | apply IHs. 208 | rewrite /bloomfilter_state/bloomfilter_set_bit. 209 | rewrite FixedList.tnth_set_nth_neq => //=. 210 | exact Hnotin. 211 | Qed. 212 | 213 | Lemma bloomfilter_add_internal_hit_infer bf (ind: 'I_Hash_size.+1) inds: 214 | ~~ bloomfilter_get_bit ind bf -> 215 | tnth (bloomfilter_state (bloomfilter_add_internal inds bf)) ind -> 216 | ind \in inds. 217 | Proof. 218 | move=> Hbit Htnth. 219 | case Hind: (ind \in inds) =>//=; move/Bool.negb_true_iff: Hind => Hind. 220 | by move/Bool.negb_true_iff: (bloomfilter_add_internal_miss Hbit Hind) Htnth ->. 221 | Qed. 222 | 223 | Lemma bloomfilter_set_get_eq hash_value bf : 224 | bloomfilter_get_bit hash_value (bloomfilter_set_bit hash_value bf). 225 | Proof. 226 | by rewrite /bloomfilter_get_bit/bloomfilter_set_bit// 227 | /bloomfilter_state FixedList.tnth_set_nth_eq //=. 228 | Qed. 229 | 230 | Lemma bloomfilter_add_insert_contains l (bf: BloomFilter) (inds: l.-tuple 'I_Hash_size.+1 ) 231 | (ps: seq 'I_Hash_size.+1) : 232 | all (fun p => p \in inds) ps -> all (bloomfilter_get_bit^~ (bloomfilter_add_internal inds bf)) ps. 233 | Proof. 234 | move=>/allP HinP; apply/allP => [p Hp]. 235 | by rewrite /bloomfilter_get_bit/bloomfilter_state bloomfilter_add_internal_hit //=; move: (HinP p Hp). 236 | Qed. 237 | 238 | Lemma bloomfilter_set_bit_conv bf b b': 239 | (bloomfilter_set_bit b (bloomfilter_set_bit b' bf)) = 240 | (bloomfilter_set_bit b' (bloomfilter_set_bit b bf)). 241 | Proof. 242 | rewrite/bloomfilter_set_bit/bloomfilter_state; apply f_equal. 243 | case: bf; rewrite/BitVector=>bf . 244 | by rewrite fixedlist_set_nthC. 245 | Qed. 246 | 247 | Lemma bloomfilter_add_multiple_cat bf b others: 248 | (bloomfilter_add_internal others (bloomfilter_add_internal b bf)) = 249 | (bloomfilter_add_internal (others ++ b) bf). 250 | Proof. 251 | elim: others bf => [//=|other others Hothers] bf //= . 252 | rewrite -Hothers; apply f_equal; clear Hothers others. 253 | elim: b bf => [//=| b bs Hbs] bf //=. 254 | rewrite bloomfilter_set_bit_conv. 255 | by rewrite Hbs. 256 | Qed. 257 | 258 | 259 | End BloomFilter. 260 | End BloomFilterDefinitions. 261 | 262 | 263 | (** instantiation of AMQ interface *) 264 | Module BloomFilterAMQ (Spec: HashSpec). 265 | Module BasicHashVec := BasicHashVec Spec. 266 | Module BloomFilterDefinitions := BloomFilterDefinitions Spec. 267 | 268 | Export BasicHashVec. 269 | Export BloomFilterDefinitions. 270 | 271 | Module AMQ <: AMQ BasicHashVec. 272 | 273 | Definition AMQStateParams := True. 274 | 275 | Definition AMQState (val:AMQStateParams) : finType := 276 | [finType of BloomFilterDefinitions.BloomFilter ]. 277 | 278 | Section AMQ. 279 | Variable p: AMQStateParams. 280 | Variable h: BasicHashVec.AMQHashParams. 281 | 282 | Definition AMQ_add_internal 283 | (amq: AMQState p) 284 | (inds: BasicHashVec.AMQHashValue h) : AMQState p := 285 | BloomFilterDefinitions.bloomfilter_add_internal 286 | inds amq. 287 | 288 | Definition AMQ_query_internal 289 | (amq: AMQState p) (inds: BasicHashVec.AMQHashValue h) : bool := 290 | 291 | BloomFilterDefinitions.bloomfilter_query_internal 292 | inds amq. 293 | Definition AMQ_available_capacity (_: BasicHashVec.AMQHashParams) (amq: AMQState p) (l:nat) : bool := true. 294 | Definition AMQ_valid (amq: AMQState p) : bool := true. 295 | 296 | Definition AMQ_new: AMQState p := 297 | BloomFilterDefinitions.bloomfilter_new. 298 | 299 | 300 | Lemma AMQ_new_nqueryE: forall vals, ~~ AMQ_query_internal AMQ_new vals. 301 | Proof. 302 | move=> //= vals. 303 | apply BloomFilterDefinitions.bloomfilter_new_empty. 304 | by rewrite -length_sizeP size_tuple => //=. 305 | Qed. 306 | 307 | Lemma AMQ_new_validT: AMQ_valid AMQ_new. 308 | Proof. 309 | by []. 310 | Qed. 311 | 312 | Section DeterministicProperties. 313 | Variable amq: AMQState p. 314 | 315 | Lemma AMQ_available_capacityW: forall n m, 316 | AMQ_valid amq -> m <= n -> AMQ_available_capacity h amq n -> AMQ_available_capacity h amq m. 317 | Proof. 318 | by []. 319 | Qed. 320 | 321 | Lemma AMQ_add_query_base: forall (amq: AMQState p) inds, 322 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> 323 | AMQ_query_internal (AMQ_add_internal amq inds) inds. 324 | Proof. 325 | move=> //= amq' inds _ _. 326 | move: inds => [inds Hinds] //=. 327 | rewrite/AMQ_query_internal/AMQ_add_internal//=; clear Hinds. 328 | elim: inds amq' => //= ind inds IHinds amq'. 329 | apply/andP;split. 330 | by apply bloomfilter_add_internal_preserve; apply tnth_set_nth_eq. 331 | apply IHinds. 332 | Qed. 333 | 334 | Lemma AMQ_add_valid_preserve: forall (amq: AMQState p) inds, 335 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> 336 | AMQ_valid (AMQ_add_internal amq inds). 337 | Proof. 338 | by []. 339 | Qed. 340 | 341 | Lemma AMQ_add_query_preserve: forall (amq: AMQState p) inds inds', 342 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> AMQ_query_internal amq inds -> 343 | AMQ_query_internal (AMQ_add_internal amq inds') inds. 344 | Proof. 345 | move=> amq' inds inds' _ _. 346 | move=>/allP Hquery; apply/allP => v Hv; move: (Hquery v Hv). 347 | apply bloomfilter_add_internal_preserve. 348 | Qed. 349 | 350 | Lemma AMQ_add_capacity_decr: forall (amq: AMQState p) inds l, 351 | AMQ_valid amq -> AMQ_available_capacity h amq l.+1 -> 352 | AMQ_available_capacity h (AMQ_add_internal amq inds) l. 353 | Proof. 354 | by []. 355 | Qed. 356 | 357 | Lemma AMQ_query_valid_preserve: forall (amq: AMQState p) inds, 358 | AMQ_valid amq -> AMQ_valid (AMQ_add_internal amq inds). 359 | Proof. 360 | by []. 361 | Qed. 362 | 363 | Lemma AMQ_query_capacity_preserve: forall (amq: AMQState p) inds l, 364 | AMQ_valid amq -> AMQ_available_capacity h amq l.+1 -> AMQ_available_capacity h (AMQ_add_internal amq inds) l. 365 | Proof. 366 | by []. 367 | Qed. 368 | 369 | End DeterministicProperties. 370 | End AMQ. 371 | End AMQ. 372 | 373 | End BloomFilterAMQ. 374 | -------------------------------------------------------------------------------- /Structures/QuotientFilter/QuotientFilter_Definitions.v: -------------------------------------------------------------------------------- 1 | (** * Structures/QuotientFilter/QuotientFilter_Definitions.v 2 | ----------------- 3 | 4 | Provides the definitions and deterministic operations of a Quotient 5 | Filter and uses them to instantiate the AMQ interface. *) 6 | 7 | 8 | From mathcomp.ssreflect 9 | Require Import ssreflect ssrbool ssrnat eqtype fintype choice ssrfun seq path bigop finfun div. 10 | 11 | From mathcomp.ssreflect 12 | Require Import tuple. 13 | 14 | From mathcomp 15 | Require Import path. 16 | 17 | Require Import Coq.Logic.ProofIrrelevance. 18 | Require Import Coq.Logic.FunctionalExtensionality. 19 | 20 | Set Implicit Arguments. 21 | Unset Strict Implicit. 22 | Unset Printing Implicit Defensive. 23 | 24 | From ProbHash.Computation 25 | Require Import Comp Notationv1. 26 | 27 | From ProbHash.Utils 28 | Require Import InvMisc seq_ext. 29 | 30 | 31 | From ProbHash.Core 32 | Require Import Hash HashVec FixedList AMQ AMQHash. 33 | 34 | 35 | Module Type QuotientFilterSpec. 36 | 37 | (** 38 | q - the number of elements in the quotient - 1 39 | *) 40 | Parameter q:nat. 41 | (** 42 | r - the number of elements in the remainder - 1 43 | *) 44 | Parameter r:nat. 45 | 46 | (** type being hashed in the quotient filter *) 47 | Parameter B:finType. 48 | 49 | End QuotientFilterSpec. 50 | 51 | Module QuotientFilterDefinitions (Spec: QuotientFilterSpec). 52 | 53 | (** 54 | A fomalization of a simplified form of the quotientfilter structure. 55 | *) 56 | 57 | Export Spec. 58 | Module QuotientHash <: HashSpec. 59 | 60 | Definition B := B. 61 | 62 | Definition Hash_size := (q.+1 * r.+1).-1. 63 | 64 | Lemma Hash_size_unwrap : Hash_size = (q.+1 * r.+1).-1. 65 | Proof. by []. Qed. 66 | 67 | End QuotientHash. 68 | 69 | Module HashVec := (HashVec QuotientHash). 70 | 71 | Export HashVec. 72 | 73 | 74 | Definition hash_value_coerce (value: hash_valuetype) : 'I_(q.+1 * r.+1). 75 | move: value; rewrite/hash_valuetype Hash_size_unwrap //=. 76 | Defined. 77 | 78 | Lemma hash_value_coerce_eq x y: (hash_value_coerce x) = (hash_value_coerce y) -> x = y. 79 | Proof. 80 | rewrite/hash_value_coerce/eq_rect_r. 81 | by rewrite -eq_rect_eq. 82 | Qed. 83 | 84 | 85 | Record QuotientFilter (n: nat) := mkQuotientFilter 86 | { 87 | quotientfilter_state: 88 | (** maps each quotient value *) 89 | (q.+1).-tuple 90 | (** to a variable length list of values *) 91 | (fixlist [eqType of 'I_r.+1] n.+1) 92 | }. 93 | 94 | Definition Quotientfilter_prod (n: nat) (bf: QuotientFilter n) := 95 | (quotientfilter_state bf). 96 | 97 | Definition prod_Quotientfilter (n:nat) pair := let: (state) := pair in @ mkQuotientFilter n state. 98 | 99 | Lemma quotientfilter_cancel n : cancel (@Quotientfilter_prod n) (@prod_Quotientfilter n). 100 | Proof. 101 | by case. 102 | Qed. 103 | 104 | Definition quotientfilter_eqMixin n := 105 | CanEqMixin (@quotientfilter_cancel n) . 106 | 107 | Canonical quotientfilter_eqType n := 108 | Eval hnf in EqType (QuotientFilter n) (quotientfilter_eqMixin n) . 109 | 110 | Definition quotientfilter_choiceMixin n:= 111 | CanChoiceMixin (@quotientfilter_cancel n). 112 | 113 | Canonical quotientfilter_choiceType n := 114 | Eval hnf in ChoiceType (QuotientFilter n) (@quotientfilter_choiceMixin n). 115 | 116 | Definition quotientfilter_countMixin n := 117 | CanCountMixin (@quotientfilter_cancel n). 118 | 119 | Canonical quotientfilter_countType n := 120 | Eval hnf in CountType (QuotientFilter n) (@quotientfilter_countMixin n). 121 | 122 | Definition quotientfilter_finMixin n := 123 | CanFinMixin (@quotientfilter_cancel n). 124 | 125 | Canonical quotientfilter_finType n := 126 | Eval hnf in FinType (QuotientFilter n) (@quotientfilter_finMixin n). 127 | 128 | 129 | Definition quotientfilter_new n : QuotientFilter n := 130 | mkQuotientFilter (nseq_tuple q.+1 (fixlist_empty [eqType of 'I_r.+1] n.+1)). 131 | 132 | Lemma quotient_num_quotient (value: 'I_(q.+1 * r.+1)) : (value %% q.+1 < q.+1). 133 | Proof. 134 | move: value => [m Hm] //=. 135 | by apply ltn_pmod. 136 | Qed. 137 | 138 | Lemma quotient_num_remainder (value: 'I_(q.+1 * r.+1)) : (value %/ q.+1 < r.+1). 139 | Proof. 140 | move: value => [m Hm] //=. 141 | by rewrite ltn_divLR //= mulnC. 142 | Qed. 143 | 144 | (** Implements the quotienting operation (note: this is slightly 145 | more general than the standard definition, which requires that q.+1 146 | and r.+1 be exact powers of 2 (as the operation is implemented using 147 | bit-level operations) ) *) 148 | Definition quotient_num (value: 'I_(q.+1 * r.+1)) : 'I_q.+1 * 'I_r.+1 := 149 | (Ordinal (quotient_num_quotient value), 150 | Ordinal (quotient_num_remainder value)). 151 | 152 | Lemma quotient_num_inj value value': 153 | quotient_num value = quotient_num value' -> value = value'. 154 | Proof. 155 | move: value value' => [value Hvalue] [value' Hvalue'] //=. 156 | move=> [Hq Hr] //=. 157 | suff H: value = value'. 158 | by move: H Hvalue Hvalue' -> => H1 H2;rewrite (proof_irrelevance _ H1 H2). 159 | rewrite (divn_eq value q.+1). 160 | rewrite Hr Hq. 161 | by rewrite -(divn_eq value' q.+1). 162 | Qed. 163 | 164 | 165 | Section Definitions. 166 | 167 | Variable n: nat. 168 | 169 | Definition quotientfilter_add_internal (value: 'I_(q.+1 * r.+1)) qf : QuotientFilter n:= 170 | let: (quotient,remainder) := quotient_num value in 171 | let quotient_list := tnth (quotientfilter_state qf) quotient in 172 | let quotient_list' := fixlist_insert quotient_list remainder in 173 | mkQuotientFilter 174 | (set_tnth (quotientfilter_state qf) quotient_list' quotient). 175 | 176 | Definition quotientfilter_query_internal (value: 'I_(q.+1 * r.+1)) qf : bool := 177 | let: (quotient,remainder) := quotient_num value in 178 | let quotient_list := tnth (@quotientfilter_state n qf) quotient in 179 | fixlist_contains remainder quotient_list. 180 | 181 | Definition quotientfilter_query (value: hash_keytype) (hashes: HashState n) (qf: QuotientFilter n) : 182 | Comp [finType of HashState n * bool ] := 183 | hash_res <-$ (@hash _ value hashes); 184 | let (new_hashes, hash_vec) := hash_res in 185 | let qres := quotientfilter_query_internal (hash_value_coerce hash_vec) qf in 186 | ret (new_hashes, qres). 187 | 188 | Definition quotientfilter_has_free_spaces l qf := 189 | all (fun ls => [length ls] + l <= n ) (@quotientfilter_state n qf). 190 | 191 | Definition quotientfilter_valid qf := 192 | all (fun ls => fixlist_is_top_heavy ls) (@quotientfilter_state n qf). 193 | 194 | Lemma fixlist_length_empty (A:eqType) k : 195 | [length (fixlist_empty A k)] = 0. 196 | Proof. 197 | rewrite/fixlist_length/fixlist_empty/fixlist_unwrap //=. 198 | elim: k => [//=|k IHk //=]. 199 | Qed. 200 | 201 | End Definitions. 202 | 203 | Section Theorems. 204 | 205 | Variable l: nat. 206 | Variable n: nat. 207 | Hypothesis Hl: l > 0. 208 | 209 | Lemma quotientfilter_new_free_spaces : 210 | quotientfilter_has_free_spaces n (quotientfilter_new n). 211 | Proof. 212 | rewrite/quotientfilter_has_free_spaces/quotientfilter_new. 213 | apply/allP => ls; move=>/nseqP [Hls1 Hls2]. 214 | by rewrite Hls1 fixlist_length_empty add0n leqnn. 215 | Qed. 216 | 217 | Lemma quotientfilter_new_valid : 218 | quotientfilter_valid (quotientfilter_new n). 219 | Proof. 220 | rewrite/quotientfilter_has_free_spaces/quotientfilter_new. 221 | apply/allP => ls; move=>/nseqP [Hls1 Hls2]. 222 | rewrite Hls1. 223 | apply fixlist_empty_is_top_heavy. 224 | Qed. 225 | 226 | 227 | 228 | Lemma quotientfilter_add_query_base qf value: 229 | quotientfilter_valid qf -> 230 | quotientfilter_has_free_spaces l qf -> 231 | @quotientfilter_query_internal n value (quotientfilter_add_internal value qf). 232 | Proof. 233 | move: qf => [qf]//=; rewrite/quotientfilter_valid/quotientfilter_has_free_spaces 234 | => /allP Hvalid /allP //= Hall. 235 | rewrite /quotientfilter_query_internal/quotientfilter_add_internal //. 236 | move: (quotient_num value) => [quotient remainder] //. 237 | rewrite tnth_set_nth_eq //. 238 | apply fixlist_insert_contains; [ apply Hvalid; apply mem_tnth| ]. 239 | move: (Hall _ (mem_tnth quotient qf)); rewrite -ltnS. 240 | move=>/InvMisc.addr_ltn //=. 241 | Qed. 242 | 243 | Lemma quotientfilter_add_preserve qf qf' value: 244 | quotientfilter_valid qf -> 245 | quotientfilter_has_free_spaces l qf -> 246 | qf' = (quotientfilter_add_internal value qf) -> 247 | quotientfilter_valid qf' && @quotientfilter_has_free_spaces n l.-1 qf'. 248 | Proof. 249 | move: qf qf' => [qf] //= [qf']//=; rewrite/quotientfilter_valid/quotientfilter_has_free_spaces 250 | => /allP Hvalid /allP Hall. 251 | rewrite/quotientfilter_add_internal; move: (quotient_num _) => [quotient remainder]. 252 | move=>/eqP; rewrite inj_eq; last by (rewrite /injective => x y Hxy; injection Hxy). 253 | move=>/eqP ->. 254 | have Hsim x: quotientfilter_state ({| quotientfilter_state := x |}) = x; first by []. 255 | rewrite !Hsim; clear Hsim. 256 | apply/andP;split; apply/all_tnthP 257 | => ind; case Heq: (ind == quotient); 258 | try (move/Bool.negb_true_iff: Heq => Heq; rewrite tnth_set_nth_neq; last by []); 259 | try (rewrite tnth_set_nth_eq; last by[]); 260 | try apply fixlist_insert_preserves_top_heavy; 261 | try (by apply Hvalid; apply mem_tnth). 262 | rewrite fixlist_insert_length_incr. 263 | rewrite matrix.mx'_cast; last by move: (Ordinal Hl). 264 | rewrite addSn //=; apply Hall; apply mem_tnth. 265 | move: (Hall _ (mem_tnth quotient qf)); rewrite -ltnS => /InvMisc.addr_ltn //=. 266 | rewrite matrix.mx'_cast; last (by move: (Ordinal Hl)); rewrite -ltnS. 267 | apply InvMisc.ltn_subl1; apply Hall; apply mem_tnth. 268 | Qed. 269 | 270 | Lemma quotientfilter_add_query_preserve qf value value' : 271 | quotientfilter_query_internal value qf -> 272 | @quotientfilter_query_internal n value (quotientfilter_add_internal value' qf). 273 | Proof. 274 | move: qf => [qf]. 275 | rewrite /quotientfilter_query_internal; move: (quotient_num value) => [quotient remainder]. 276 | rewrite /fixlist_contains; move=> /hasP [val Hval Hvaleq]. 277 | rewrite /quotientfilter_add_internal. 278 | move: (quotient_num value') => [quotient' remainder']. 279 | have Hsim x: quotientfilter_state ({| quotientfilter_state := x |}) = x; first by []. 280 | move: Hval; rewrite !Hsim; clear Hsim => Hval. 281 | case Hquoteient_eq: (quotient' == quotient); last first. 282 | - { 283 | apply/hasP; exists remainder; last by []. 284 | rewrite tnth_set_nth_neq; first by move: Hval; move/eqP: Hvaleq => -> . 285 | by move/Bool.negb_true_iff: Hquoteient_eq; rewrite eq_sym. 286 | } 287 | - { 288 | rewrite tnth_set_nth_eq; last by rewrite eq_sym. 289 | rewrite fixlist_has_eq; apply/orP; left; apply/hasP; exists remainder; last by []. 290 | by move/eqP: Hvaleq Hval => ->; move/eqP:Hquoteient_eq ->. 291 | } 292 | Qed. 293 | 294 | Lemma quotientfilter_add_query_eq qf value value' : 295 | ~~ quotientfilter_query_internal value qf -> 296 | @quotientfilter_query_internal n value (quotientfilter_add_internal value' qf) -> 297 | value = value'. 298 | Proof. 299 | rewrite /quotientfilter_query_internal. 300 | case Hvalue: (value == value'); rewrite /quotientfilter_add_internal; first by move/eqP:Hvalue <-. 301 | case_eq (quotient_num value) => [quotient remainder] Heq. 302 | move=>Hneq. 303 | have Hsim x: quotientfilter_state ({| quotientfilter_state := x |}) = x; first by []. 304 | case_eq (quotient_num value') => [quotient' remainder'] Heq'. 305 | rewrite !Hsim; clear Hsim. 306 | case Hquot: (quotient == quotient'). 307 | - { 308 | rewrite tnth_set_nth_eq; last by[]. 309 | move/eqP:Hquot => Hquot. 310 | move/Bool.negb_true_iff: Hneq . 311 | rewrite /fixlist_contains. 312 | rewrite fixlist_has_eq Hquot. 313 | move=> ->; rewrite Bool.orb_false_l =>/andP[/eqP Hrem]/andP[_ _]. 314 | apply quotient_num_inj. 315 | by rewrite Heq Heq' //= -Hquot Hrem. 316 | } 317 | - { 318 | rewrite tnth_set_nth_neq; last by move/Bool.negb_true_iff: Hquot. 319 | by move/Bool.negb_true_iff: Hneq ->. 320 | } 321 | Qed. 322 | 323 | End Theorems. 324 | 325 | 326 | 327 | End QuotientFilterDefinitions. 328 | 329 | (** Instantiation of the AMQ interface for a Quotient filter *) 330 | Module QuotientFilterAMQ (Spec: QuotientFilterSpec). 331 | 332 | Module QuotientFilterDefinitions := QuotientFilterDefinitions Spec. 333 | Module BasicHash := AMQHash.BasicHash QuotientFilterDefinitions.QuotientHash. 334 | 335 | Export BasicHash. 336 | Export QuotientFilterDefinitions. 337 | 338 | Module AMQ <: AMQ BasicHash. 339 | 340 | Definition AMQStateParams := nat. 341 | Definition AMQState (n: AMQStateParams) : finType := 342 | [finType of QuotientFilter n]. 343 | 344 | Section AMQ. 345 | Variable p: AMQStateParams. 346 | Variable h: BasicHash.AMQHashParams. 347 | 348 | Definition AMQ_add_internal 349 | (amq: AMQState p) (value: BasicHash.AMQHashValue h): 350 | AMQState p := quotientfilter_add_internal value amq. 351 | 352 | Definition AMQ_query_internal 353 | (amq: AMQState p) (key: BasicHash.AMQHashValue h) : bool := 354 | quotientfilter_query_internal key amq. 355 | 356 | Definition AMQ_available_capacity 357 | (h: BasicHash.AMQHashParams) (amq: AMQState p) (l:nat): bool:= 358 | quotientfilter_has_free_spaces (h.+1 * l) amq. 359 | 360 | Definition AMQ_valid (amq:AMQState p) : bool := 361 | quotientfilter_valid amq. 362 | 363 | Definition AMQ_new: AMQState p := quotientfilter_new p. 364 | 365 | Lemma AMQ_new_nqueryE: forall vals, ~~ AMQ_query_internal AMQ_new vals. 366 | Proof. 367 | move=> vals; rewrite/AMQ_query_internal/quotientfilter_query_internal//=. 368 | rewrite tnth_nseq_eq. 369 | rewrite/fixlist_contains //=. 370 | apply/hasPn => v. 371 | move: (@fixlist_empty_is_empty [eqType of 'I_r.+1] p.+1). 372 | rewrite/fixlist_is_empty =>/eqP -> //=. 373 | Qed. 374 | 375 | Lemma AMQ_new_validT: AMQ_valid AMQ_new. 376 | Proof. 377 | by apply quotientfilter_new_valid. 378 | Qed. 379 | 380 | Section DeterministicProperties. 381 | Variable amq: AMQState p. 382 | 383 | Lemma AMQ_available_capacityW: forall n m, 384 | AMQ_valid amq -> m <= n -> AMQ_available_capacity h amq n -> AMQ_available_capacity h amq m. 385 | Proof. 386 | move=> n m Hvalid Hnm /allP Hvv; apply/allP => v Hv; move:(Hvv v Hv) => //=. 387 | apply leq_trans; rewrite leq_add2l //=. 388 | by rewrite leq_mul2l Hnm; apply/orP; right. 389 | Qed. 390 | End DeterministicProperties. 391 | 392 | Section DeterministicProperties. 393 | Variable amq: AMQState p. 394 | 395 | Lemma AMQ_add_query_base: forall (amq: AMQState p) inds, 396 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> 397 | AMQ_query_internal (AMQ_add_internal amq inds) inds. 398 | Proof. 399 | apply quotientfilter_add_query_base. 400 | Qed. 401 | 402 | Lemma AMQ_add_valid_preserve: forall (amq: AMQState p) inds, 403 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> 404 | AMQ_valid (AMQ_add_internal amq inds). 405 | Proof. 406 | rewrite /AMQ_available_capacity muln1/AMQHashValue/AMQ_valid. 407 | rewrite/quotientfilter_valid/quotientfilter_has_free_spaces. 408 | move=> [amq'] ind /allP Hvv /allP Hspace; apply /allP => v. 409 | rewrite/AMQ_add_internal/quotientfilter_add_internal. 410 | case_eq (quotient_num ind) => quot rem Heq. 411 | 412 | have H f: quotientfilter_state {| quotientfilter_state := f |} = f; first by []. 413 | rewrite !H. 414 | move=>/tnthP [ quot' ]. 415 | case Hquot: (quot' != quot). 416 | - rewrite tnth_set_nth_neq; first move=>->; last by []. 417 | apply Hvv. 418 | by apply mem_tnth. 419 | - move/Bool.negb_true_iff: Hquot; rewrite Bool.negb_involutive => /eqP ->. 420 | rewrite tnth_set_nth_eq; first move=>->; last by []. 421 | apply fixlist_insert_preserves_top_heavy. 422 | apply Hvv. 423 | by apply mem_tnth. 424 | Qed. 425 | 426 | Lemma AMQ_add_query_preserve: forall (amq: AMQState p) inds inds', 427 | AMQ_valid amq -> AMQ_available_capacity h amq 1 -> AMQ_query_internal amq inds -> 428 | AMQ_query_internal (AMQ_add_internal amq inds') inds. 429 | Proof. 430 | move=> amq' ind inds' Hvalid Hcap. 431 | by apply quotientfilter_add_query_preserve. 432 | Qed. 433 | 434 | Lemma AMQ_add_capacity_decr: forall (amq: AMQState p) inds l, 435 | AMQ_valid amq -> AMQ_available_capacity h amq l.+1 -> 436 | AMQ_available_capacity h (AMQ_add_internal amq inds) l. 437 | Proof. 438 | move=> amq' ind l Hvalid Hcap. 439 | rewrite /AMQ_available_capacity in Hcap. 440 | have Hobv: 0 < h.+1 * l.+1; first by rewrite muln_gt0; apply/andP;split => //=. 441 | move: (@quotientfilter_add_preserve 442 | _ p Hobv amq' 443 | (quotientfilter_add_internal ind amq') 444 | ind Hvalid Hcap 445 | (Logic.eq_refl 446 | (quotientfilter_add_internal ind amq')) 447 | ) => /andP [_ ]. 448 | 449 | rewrite/AMQ_available_capacity. 450 | rewrite mulnS addnC addnS -pred_Sn. 451 | move=>/allP Hvv; apply/allP => v Hv; move: (Hvv v Hv). 452 | by rewrite addnA =>/leq_addr_weaken. 453 | Qed. 454 | 455 | End DeterministicProperties. 456 | End AMQ. 457 | End AMQ. 458 | End QuotientFilterAMQ. 459 | 460 | 461 | 462 | 463 | 464 | -------------------------------------------------------------------------------- /Structures/Core/AMQReduction.v: -------------------------------------------------------------------------------- 1 | (** * Structures/Core/AMQReduction.v 2 | ----------------- 3 | 4 | Defines a Coq Module that encapsulates a reduction argument for AMQ 5 | modules, allowing transferring properties from one AMQ to another 6 | provided a suitable mapping is defined. See 7 | Structure/CountingBloomFilter/CountingBloomFilter_Properties.v for an 8 | example use. *) 9 | 10 | 11 | From mathcomp.ssreflect Require Import 12 | ssreflect ssrbool ssrnat eqtype fintype 13 | choice ssrfun seq path bigop finfun finset binomial. 14 | 15 | From mathcomp.ssreflect 16 | Require Import tuple. 17 | 18 | From mathcomp 19 | Require Import path. 20 | 21 | From infotheo Require Import 22 | fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba. 23 | 24 | Require Import Coq.Logic.ProofIrrelevance. 25 | Require Import Coq.Logic.FunctionalExtensionality. 26 | 27 | Set Implicit Arguments. 28 | Unset Strict Implicit. 29 | Unset Printing Implicit Defensive. 30 | 31 | From ProbHash.Utils 32 | Require Import InvMisc seq_ext seq_subset rsum_ext stirling tactics. 33 | 34 | From ProbHash.Computation 35 | Require Import Comp Notationv1. 36 | 37 | From ProbHash.Core 38 | Require Import Hash HashVec FixedList FixedMap AMQHash AMQ. 39 | 40 | 41 | (** Module encapsulating the existance of a reduction from AMQ A to AMQ B. *) 42 | Module Type AMQMAP (AmqHash: AMQHASH) (A: AMQ AmqHash) (B: AMQ AmqHash). 43 | 44 | Parameter AMQ_param_map: A.AMQStateParams -> B.AMQStateParams. 45 | Parameter AMQ_state_map: forall p: A.AMQStateParams, A.AMQState p -> B.AMQState (AMQ_param_map p). 46 | 47 | Section Map. 48 | 49 | Variable p: A.AMQStateParams. 50 | Variable h: AmqHash.AMQHashParams. 51 | 52 | Axiom AMQ_map_validE: forall (a: A.AMQState p), A.AMQ_valid a -> 53 | B.AMQ_valid (AMQ_state_map a). 54 | Axiom AMQ_map_capacityE: forall (a: A.AMQState p) l, A.AMQ_available_capacity h a l -> 55 | B.AMQ_available_capacity h (AMQ_state_map a) l. 56 | 57 | Axiom AMQ_map_add_internalE: forall (a: A.AMQState p) val, A.AMQ_valid a -> A.AMQ_available_capacity h a 1 -> 58 | B.AMQ_add_internal (AMQ_state_map a) val = AMQ_state_map (@A.AMQ_add_internal _ h a val). 59 | 60 | Axiom AMQ_map_query_internalE: forall (a: A.AMQState p) val, A.AMQ_valid a -> A.AMQ_available_capacity h a 1 -> 61 | B.AMQ_query_internal (AMQ_state_map a) val = @A.AMQ_query_internal _ h a val. 62 | 63 | Axiom AMQ_map_newE: forall (a: A.AMQState p), 64 | B.AMQ_new (AMQ_param_map p) = AMQ_state_map (A.AMQ_new p). 65 | 66 | End Map. 67 | End AMQMAP. 68 | 69 | Module AMQPropertyMap (AmqHash: AMQHASH) (A: AMQ AmqHash) (B: AMQ AmqHash) (Map: AMQMAP AmqHash A B) (Properties: AMQProperties AmqHash B) <: AMQProperties AmqHash A. 70 | Module AmqOperations := AMQOperations (AmqHash) (A). 71 | Module AmqHashProperties := AMQHashProperties AmqHash. 72 | 73 | 74 | Section PropertyMap. 75 | Variable h: AmqHash.AMQHashParams. 76 | Variable s: A.AMQStateParams. 77 | 78 | Definition AMQ_false_positive_probability n := 79 | Properties.AMQ_false_positive_probability h (Map.AMQ_param_map s) n. 80 | 81 | Lemma AMQ_map_add_multipleE cbf hashes values f 82 | (Hvalid: A.AMQ_valid cbf) (Hcap: A.AMQ_available_capacity h cbf (length values)) : 83 | \sum_(hshs in [finType of AmqHash.AMQHash h]) \sum_(cbf' in [finType of A.AMQState s]) 84 | ((d[ AmqOperations.AMQ_add_multiple hashes cbf values]) (hshs,cbf') *R* 85 | (f hshs (Map.AMQ_state_map cbf'))) = 86 | \sum_(hshs in [finType of AmqHash.AMQHash h]) \sum_(bf' in [finType of B.AMQState (Map.AMQ_param_map s)]) 87 | ((d[ Properties.AmqOperations.AMQ_add_multiple hashes (Map.AMQ_state_map cbf) values]) (hshs, bf') *R* 88 | (f hshs bf')). 89 | Proof. 90 | under eq_bigr => hshs' _ do 91 | rewrite (@partition_big _ _ _ [finType of (A.AMQState s)] [finType of (B.AMQState _)] _ (@Map.AMQ_state_map s) predT) => //=. 92 | under eq_bigr => hshs' _ do 93 | under eq_bigr => bf _ do 94 | under eq_bigr => i /eqP Hbi do rewrite Hbi mulRC. 95 | rewrite exchange_big [\sum_(a in [finType of AmqHash.AMQHash h]) _]exchange_big; apply eq_bigr => bf _. 96 | elim: values Hcap bf f => [|val values IHval] Hcap bf f. 97 | - { 98 | apply eq_bigr => hshs' _. 99 | rewrite (@rsum_pred_demote [finType of A.AMQState s]); under eq_bigr => ? ? do rewrite FDist1.dE xpair_eqE mulRC [_ *R* (_ && _ %R)]mulRC andbC boolR_distr -!mulRA. 100 | rewrite -rsum_pred_demote big_pred1_eq FDist1.dE xpair_eqE boolR_distr. 101 | rewrite -mulRA; apply f_equal. 102 | rewrite [_ *R* f _ _ ]mulRC; apply f_equal. 103 | apply f_equal => //=. 104 | by rewrite -eqE eq_sym. 105 | } 106 | - { 107 | apply Logic.eq_sym => //=. 108 | under (@eq_bigr _ _ _ [finType of AmqHash.AMQHash h]) => hshs' _. 109 | { 110 | move: IHval bf f hshs' => //= IHval bf f hshs'. 111 | rewrite (@FDistBind.dE [finType of (AmqHash.AMQHash h) * (B.AMQState (Map.AMQ_param_map s))]); rewrite rsum_split. 112 | rewrite (@exchange_big _ _ _ [finType of AmqHash.AMQHash h] [finType of B.AMQState (Map.AMQ_param_map s)]) => //=. 113 | 114 | under (@eq_bigr _ _ _ [finType of B.AMQState (Map.AMQ_param_map s)]) => bf' _. { 115 | suff <-: 116 | \sum_(i in [finType of AmqHash.AMQHash h]) 117 | \sum_(i0 in [finType of _] | Map.AMQ_state_map i0 == bf') 118 | (FDistBind.d (d[ AmqHash.AMQHash_hash i val]) 119 | (fun b : AmqHash.AMQHash h * AmqHash.AMQHashValue h => 120 | d[ let (new_hashes, hash_vec) := b in 121 | ret (new_hashes, B.AMQ_add_internal bf' hash_vec)]) 122 | (hshs', bf) *R* 123 | P[ AmqOperations.AMQ_add_multiple hashes cbf values === (i, i0)]) = 124 | \sum_(i in AmqHash.AMQHash h) 125 | (P[ Properties.AmqOperations.AMQ_add_multiple hashes (Map.AMQ_state_map cbf) values === (i, bf')] *R* 126 | FDistBind.d (d[ AmqHash.AMQHash_hash i val]) 127 | (fun b : AmqHash.AMQHash h * AmqHash.AMQHashValue h => 128 | d[ let (new_hashes, hash_vec) := b in 129 | ret (new_hashes, B.AMQ_add_internal bf' hash_vec)]) 130 | (hshs', bf)); first by over. 131 | have Hcap': A.AMQ_available_capacity h cbf (length values); first by eapply A.AMQ_available_capacityW with (n:= (length values).+1) => //=. 132 | move: (@IHval Hcap' 133 | bf' (fun (i: [finType of AmqHash.AMQHash h]) (bf': [finType of B.AMQState (Map.AMQ_param_map s)]) => 134 | FDistBind.d (d[ AmqHash.AMQHash_hash i val]) 135 | (fun b : AmqHash.AMQHash h * AmqHash.AMQHashValue h => 136 | d[ let (new_hashes, hash_vec) := b in 137 | ret (new_hashes, B.AMQ_add_internal bf' hash_vec)]) (hshs',bf) )) => //=. 138 | move=>-> //=. 139 | have ->: ((index_enum (AmqHash.AMQHash h))) = (index_enum [finType of AmqHash.AMQHash h]); last by apply f_equal => //=. 140 | by rewrite index_enum_simpl. 141 | 142 | } 143 | under eq_bigr => bf' _. { 144 | rewrite exchange_big //=. 145 | by over. 146 | } 147 | by over. 148 | } 149 | move=> //=; clear IHval. 150 | apply eq_bigr => hshs' _. 151 | apply Logic.eq_sym; under eq_bigr => ? ? do rewrite mulRC. 152 | rewrite -big_distrl //= mulRC. 153 | rewrite [_ *R* f _ _]mulRC; apply f_equal. 154 | under eq_bigr => ? ? do rewrite FDistBind.dE; rewrite exchange_big //= rsum_split //=. 155 | apply Logic.eq_sym. 156 | under eq_bigr => bf' _ do (rewrite (@rsum_pred_demote [finType of _]); under eq_bigr => hshs'' _ do rewrite (@rsum_Rmul_distr_l [finType of _])). 157 | exchange_big_outwards 1 => //=. 158 | exchange_big_outwards 2 => //=. 159 | have ->: ((index_enum (AmqHash.AMQHash h))) = (index_enum [finType of AmqHash.AMQHash h]); first by clear; rewrite index_enum_simpl //=. 160 | have ->: ((index_enum (A.AMQState s))) = (index_enum [finType of A.AMQState s]); first by clear; rewrite index_enum_simpl //=. 161 | apply eq_bigr => inds' _; apply eq_bigr => cbf' _. rewrite -eqE. 162 | under eq_bigr do rewrite mulRC [_ *R* (d[ _ ]) _]mulRC -mulRA. 163 | rewrite -rsum_Rmul_distr_l; apply Logic.eq_sym. 164 | under eq_bigr do rewrite mulRC. 165 | rewrite -big_distrl //= mulRC. 166 | case Hzr0: (P[ AmqOperations.AMQ_add_multiple hashes cbf values === (inds', cbf')] == 0); first by move/eqP: Hzr0 => ->; rewrite !mul0R //=. 167 | apply f_equal. 168 | under eq_bigr do rewrite FDistBind.dE; rewrite exchange_big //=; apply Logic.eq_sym. 169 | under eq_bigr do rewrite FDistBind.dE big_distrl //=; rewrite exchange_big; apply eq_bigr => [[hshs'' inds'']] _. 170 | under eq_bigr do rewrite [(d[ _ ]) _ *R* _ ]mulRC mulRC mulRA //=; rewrite -big_distrl //= mulRC; apply Logic.eq_sym. 171 | under eq_bigr do rewrite [(d[ _ ]) _ *R* _ ]mulRC ; rewrite -big_distrl //= mulRC; apply f_equal. 172 | under eq_bigr do rewrite FDist1.dE xpair_eqE andbC boolR_distr//=; rewrite -big_distrl //= mulRC. 173 | apply Logic.eq_sym. 174 | under eq_bigr do rewrite FDist1.dE xpair_eqE andbC boolR_distr//= mulRA; 175 | rewrite -big_distrl //= mulRC; apply f_equal. 176 | apply Logic.eq_sym. 177 | rewrite (@rsum_pred_demote [finType of _]); under eq_bigr do rewrite mulRC; rewrite -rsum_pred_demote big_pred1_eq //=. 178 | rewrite -rsum_pred_demote (big_pred1 (Map.AMQ_state_map cbf')). 179 | move/Bool.negb_true_iff: Hzr0 => Hzr0; move: Hcap => //= Hcap. 180 | move: (@AmqOperations.AMQ_add_multiple_properties_preserve h s hashes cbf cbf' values inds' (length values) 1 (eq_refl (length values)) Hvalid); 181 | rewrite addn1 => Hprop; move: (Hprop Hcap Hzr0); clear Hprop => /andP[ Hvalid' Hcap']. 182 | by rewrite -eqE Map.AMQ_map_add_internalE //=; first rewrite eq_sym //=. 183 | by move=> //=. 184 | } 185 | Qed. 186 | 187 | Theorem AMQ_no_false_negatives (hashes: AmqHash.AMQHash h) (amq: A.AMQState s) l x xs: 188 | uniq (x :: xs) -> length xs == l -> 189 | A.AMQ_valid amq -> A.AMQ_available_capacity h amq l.+1 -> 190 | 191 | AmqHash.AMQHash_hashstate_valid hashes -> 192 | AmqHash.AMQHash_hashstate_available_capacity hashes l.+1 -> 193 | 194 | all (AmqHash.AMQHash_hashstate_unseen hashes) (x::xs) -> 195 | (d[ res1 <-$ AmqOperations.AMQ_add amq hashes x; 196 | let '(hsh1, amq1) := res1 in 197 | res2 <-$ AmqOperations.AMQ_add_multiple hsh1 amq1 xs; 198 | let '(hsh2, amq2) := res2 in 199 | res3 <-$ AmqOperations.AMQ_query amq2 hsh2 x; 200 | ret (snd res3) ] true) = (1 %R). 201 | Proof. 202 | by apply (AmqOperations.AMQ_no_false_negatives). 203 | Qed. 204 | 205 | Theorem AMQ_false_positives_rate 206 | (hashes: AmqHash.AMQHash h) l value (values: seq _): 207 | length values == l -> 208 | AmqHash.AMQHash_hashstate_valid hashes -> 209 | AmqHash.AMQHash_hashstate_available_capacity hashes (l.+1) -> 210 | A.AMQ_available_capacity h (A.AMQ_new s) l.+1 -> 211 | all (AmqHash.AMQHash_hashstate_unseen hashes) (value::values) -> 212 | uniq (value::values) -> 213 | d[ 214 | res1 <-$ AmqOperations.AMQ_query (A.AMQ_new s) hashes value; 215 | let (hashes1, init_query_res) := res1 in 216 | res2 <-$ AmqOperations.AMQ_add_multiple hashes1 (A.AMQ_new s) values; 217 | let (hashes2, amq) := res2 in 218 | res' <-$ AmqOperations.AMQ_query amq hashes2 value; 219 | ret (res'.2) 220 | ] true = AMQ_false_positive_probability l. 221 | Proof. 222 | (* simplify proof a bit *) 223 | move=> Hlen Hvalid Havail Hcap Hall Huniq. 224 | comp_normalize; comp_simplify_n 2. 225 | exchange_big_outwards 5 => //=; comp_simplify_n 1. 226 | exchange_big_outwards 4 => //=; comp_simplify_n 1. 227 | under_all ltac:(rewrite eq_sym eqb_id). 228 | apply Logic.eq_sym. 229 | rewrite/AMQ_false_positive_probability. 230 | rewrite -(@Properties.AMQ_false_positives_rate _ _ hashes l value values) => //=. 231 | comp_normalize; comp_simplify_n 2. 232 | exchange_big_outwards 5 => //=; comp_simplify_n 1. 233 | exchange_big_outwards 4 => //=; comp_simplify_n 1. 234 | under_all ltac:(rewrite eq_sym eqb_id). 235 | exchange_big_inwards ltac:(idtac); apply Logic.eq_sym; exchange_big_inwards ltac:(idtac). 236 | exchange_big_inwards ltac:(idtac); apply Logic.eq_sym; exchange_big_inwards ltac:(idtac). 237 | exchange_big_inwards ltac:(idtac); apply Logic.eq_sym; exchange_big_inwards ltac:(idtac). 238 | apply eq_bigr => hshs' _. 239 | 240 | move: Hall => //=/andP[Hunval Hall]. 241 | under eq_bigr do under eq_bigr do under eq_bigr do under eq_bigr do 242 | rewrite index_enum_simpl AmqHashProperties.AMQHash_hash_unseen_simplE//=. 243 | apply Logic.eq_sym. 244 | under eq_bigr do under eq_bigr do under eq_bigr do under eq_bigr do 245 | rewrite index_enum_simpl AmqHashProperties.AMQHash_hash_unseen_simplE//=. 246 | under_all ltac:(rewrite [(AmqHash.AMQHash_probability _ *R* _)]mulRC -!mulRA). 247 | under eq_bigr => inds'' _. { 248 | under eq_bigr => ind' _; first under eq_bigr 249 | => hsh'' _; first under eq_rsum_ne0 => amq' Hamq. 250 | have H1: B.AMQ_available_capacity h (B.AMQ_new (Map.AMQ_param_map s)) (l + 1). { 251 | rewrite Map.AMQ_map_newE //=. 252 | by apply Map.AMQ_map_capacityE; rewrite addn1. 253 | exact (A.AMQ_new s). 254 | } 255 | move: (@Properties.AmqOperations.AMQ_add_multiple_properties_preserve 256 | h (Map.AMQ_param_map s) (AmqHash.AMQHash_hashstate_put hashes value hshs') 257 | (B.AMQ_new (Map.AMQ_param_map s)) amq' values hsh'' l 1 258 | Hlen (B.AMQ_new_validT _) H1 Hamq 259 | ) => /andP[Hvalid' Hcap']; clear H1. 260 | 261 | have H1: AmqHash.AMQHash_hashstate_available_capacity 262 | (AmqHash.AMQHash_hashstate_put hashes value hshs') l;first 263 | by apply AmqHash.AMQHash_hashstate_available_capacity_decr =>//=. 264 | have H2: AmqHash.AMQHash_hashstate_valid 265 | (AmqHash.AMQHash_hashstate_put hashes value hshs'). { 266 | apply AmqHash.AMQHash_hashstate_add_valid_preserve => //=. 267 | by apply AmqHash.AMQHash_hashstate_available_capacityW with (n:=l.+1) => //=. 268 | } 269 | have H3: 270 | all 271 | (AmqHash.AMQHash_hashstate_unseen 272 | (AmqHash.AMQHash_hashstate_put hashes value hshs')) values. { 273 | move: Huniq Hall => //=/andP[/memPn Hneq Huniq] => /allP Huns. 274 | apply/allP => v Hv; move: (Huns v Hv) (Hneq v Hv) => Hunsv Hneqv. 275 | by apply AmqHash.AMQHash_hashstate_unseenE 276 | with (hashstate:= hashes) 277 | (key':= value) 278 | (value':=hshs') => //=. 279 | } 280 | have H4: 281 | AmqHash.AMQHash_hashstate_contains 282 | (AmqHash.AMQHash_hashstate_put hashes value hshs') value hshs'. { 283 | apply AmqHash.AMQHash_hashstate_add_contains_base => //=. 284 | by apply AmqHash.AMQHash_hashstate_available_capacityW with (n:=l.+1) => //=. 285 | } 286 | move: (@Properties.AmqOperations.AMQ_add_multiple_hash_contains_preserve 287 | h (Map.AMQ_param_map s) (AmqHash.AMQHash_hashstate_put hashes value hshs') 288 | (B.AMQ_new (Map.AMQ_param_map s)) amq' value hshs' values hsh'' l 289 | Hlen Huniq 290 | H1 H2 H3 H4 Hamq 291 | ) => Hcont'. 292 | rewrite (@AmqHash.AMQHash_hash_seen_insertE _ _ _ _ hshs') //=. 293 | by over. by over. by over. by over. 294 | } 295 | under_all ltac:(rewrite -RIneq.INR_IZR_INZ boolR_distr). 296 | comp_simplify_n 2. 297 | apply Logic.eq_sym. 298 | under_all ltac:(rewrite [(AmqHash.AMQHash_probability _ *R* _)]mulRC -!mulRA). 299 | under eq_bigr => inds'' _. { 300 | under eq_bigr => ind' _; first under eq_bigr 301 | => hsh'' _; first under eq_rsum_ne0 => amq' Hamq. 302 | have H1: A.AMQ_available_capacity h (A.AMQ_new s) (l + 1);first by rewrite addn1. 303 | move: (@AmqOperations.AMQ_add_multiple_properties_preserve 304 | h s (AmqHash.AMQHash_hashstate_put hashes value hshs') 305 | (A.AMQ_new s) amq' values hsh'' l 1 306 | Hlen (A.AMQ_new_validT _) H1 Hamq 307 | ) => /andP[Hvalid' Hcap']; clear H1. 308 | have H1: AmqHash.AMQHash_hashstate_available_capacity 309 | (AmqHash.AMQHash_hashstate_put hashes value hshs') l;first 310 | by apply AmqHash.AMQHash_hashstate_available_capacity_decr =>//=. 311 | have H2: AmqHash.AMQHash_hashstate_valid 312 | (AmqHash.AMQHash_hashstate_put hashes value hshs'). { 313 | apply AmqHash.AMQHash_hashstate_add_valid_preserve => //=. 314 | by apply AmqHash.AMQHash_hashstate_available_capacityW with (n:=l.+1) => //=. 315 | } 316 | have H3: 317 | all 318 | (AmqHash.AMQHash_hashstate_unseen 319 | (AmqHash.AMQHash_hashstate_put hashes value hshs')) values. { 320 | move: Huniq Hall => //=/andP[/memPn Hneq Huniq] => /allP Huns. 321 | apply/allP => v Hv; move: (Huns v Hv) (Hneq v Hv) => Hunsv Hneqv. 322 | by apply AmqHash.AMQHash_hashstate_unseenE 323 | with (hashstate:= hashes) 324 | (key':= value) 325 | (value':=hshs') => //=. 326 | } 327 | have H4: 328 | AmqHash.AMQHash_hashstate_contains 329 | (AmqHash.AMQHash_hashstate_put hashes value hshs') value hshs'. { 330 | apply AmqHash.AMQHash_hashstate_add_contains_base => //=. 331 | by apply AmqHash.AMQHash_hashstate_available_capacityW with (n:=l.+1) => //=. 332 | } 333 | move: (@AmqOperations.AMQ_add_multiple_hash_contains_preserve 334 | h s (AmqHash.AMQHash_hashstate_put hashes value hshs') 335 | (A.AMQ_new s) amq' value hshs' values hsh'' l 336 | Hlen Huniq 337 | H1 H2 H3 H4 Hamq 338 | ) => Hcont'. 339 | rewrite (@AmqHash.AMQHash_hash_seen_insertE _ _ _ _ hshs') //=. 340 | by over. by over. by over. by over. 341 | } 342 | under_all ltac:(rewrite -RIneq.INR_IZR_INZ boolR_distr). 343 | comp_simplify_n 2. 344 | apply Logic.eq_sym; 345 | under eq_bigr do rewrite (@Map.AMQ_map_newE _ (A.AMQ_new s)) //=; 346 | apply Logic.eq_sym. 347 | 348 | have H1: A.AMQ_available_capacity h (A.AMQ_new s) (length values). { 349 | move/eqP:Hlen ->; apply A.AMQ_available_capacityW with (n:=l.+1) => //=. 350 | by apply A.AMQ_new_validT. 351 | } 352 | under eq_bigr => hshs'' _. { 353 | under eq_rsum_ne0 => amq' Hamq. 354 | 355 | have H1': A.AMQ_available_capacity h (A.AMQ_new s) (l + 1). { 356 | by rewrite addn1. 357 | } 358 | move: (@AmqOperations.AMQ_add_multiple_properties_preserve 359 | h s (AmqHash.AMQHash_hashstate_put hashes value hshs') 360 | (A.AMQ_new s) amq' values hshs'' l 1 361 | Hlen (A.AMQ_new_validT _) H1' Hamq 362 | ) => /andP[Hvalid' Hcap']; clear H1. 363 | rewrite -Map.AMQ_map_query_internalE => //=. 364 | by over. by over. 365 | } 366 | rewrite index_enum_simpl; under eq_bigr do rewrite index_enum_simpl. 367 | rewrite (@AMQ_map_add_multipleE 368 | (A.AMQ_new s) ((AmqHash.AMQHash_hashstate_put hashes value hshs')) values 369 | (fun i i0 => 370 | ((B.AMQ_query_internal i0 hshs' %R) *R* AmqHash.AMQHash_probability h)) 371 | (A.AMQ_new_validT _) 372 | H1 373 | ) => //=. 374 | rewrite index_enum_simpl //=; apply eq_bigr => hshs _. 375 | rewrite -index_enum_simpl //=; apply eq_bigr => amq' _. 376 | by rewrite (Map.AMQ_map_newE (A.AMQ_new s)); apply Map.AMQ_map_capacityE => //=. 377 | Qed. 378 | 379 | End PropertyMap. 380 | 381 | End AMQPropertyMap. 382 | -------------------------------------------------------------------------------- /Utils/InvMisc.v: -------------------------------------------------------------------------------- 1 | (** * Utils/InvMisc.v 2 | ----------------- 3 | 4 | Provides a collection of miscellaneous facts and properties about 5 | standard data types that we could not find in ssreflect.*) 6 | 7 | 8 | From mathcomp.ssreflect 9 | Require Import ssreflect ssrbool ssrnat eqtype fintype finset choice ssrfun bigop seq path finfun tuple. 10 | 11 | 12 | Lemma ltn_Snn a b : a.+1 < b.+1 -> a < b. 13 | Proof. 14 | by rewrite -{1}(addn1 a) -{1}(addn1 b) ltn_add2r. 15 | Qed. 16 | 17 | Lemma rem_in_neq (A: eqType) (q p: A) (inds: seq A) (Hneq: q != p): 18 | (q \in rem p inds) = (q \in inds). 19 | Proof. 20 | elim: inds => //= ind inds IHind. 21 | move: Hneq. 22 | case Heqind: (ind == p). 23 | - by move/eqP: Heqind ->; rewrite in_cons eq_sym =>/Bool.negb_true_iff -> //=. 24 | - by rewrite !in_cons IHind. 25 | Qed. 26 | 27 | Lemma all_in_negP (A: eqType) (I J : seq A) : 28 | all (fun j => j \notin I) J = all (fun i => i \notin J) I. 29 | Proof. 30 | apply/allP. 31 | case Hall: all. 32 | - by move/allP: Hall => Hnin; move=> j Hj; apply/memPn => i Hi; move: (Hnin i Hi) =>/memPn/(_ j Hj); rewrite eq_sym. 33 | - by move/Bool.negb_true_iff: Hall => /allPn [i Hi]; 34 | rewrite Bool.negb_involutive => Hiinj; 35 | apply/allP;apply/allPn; exists i => //=; rewrite Bool.negb_involutive. 36 | Qed. 37 | 38 | Lemma minn_mult m l: (minn m (l * m + m) = m). Proof. by rewrite minnE //= addnC subnDA subnn subn0. Qed. 39 | 40 | Lemma mult_subn m l: ((m * l) + l - l) = (m * l). Proof. by rewrite -addnBA //= subnn addn0. Qed. 41 | 42 | (** utility function for ranges of values form (inclusive) a to b (exclusive) *) 43 | Definition itoj (m n : nat) : seq.seq nat := 44 | iota m (n - m). 45 | 46 | (** Couldn't find a remove_nth function in stdlib or ssreflect*) 47 | Fixpoint rem_nth {A:Type} (n : nat) (ls : list A) : list A := 48 | match n with 49 | | 0 => if ls is h::t then t else nil 50 | | S n' => if ls is h :: t 51 | then h :: (rem_nth n' t) 52 | else ls 53 | end. 54 | (* 55 | Example rem_nth_test_1 : rem_nth 0 [:: 1; 2; 3] = [:: 2; 3]. 56 | Proof. by []. Qed. 57 | Example rem_nth_test_2 : rem_nth 1 [:: 1; 2; 3] = [:: 1; 3]. 58 | Proof. by []. Qed. 59 | Example rem_nth_test_3 : rem_nth 2 [:: 1; 2; 3] = [:: 1; 2]. 60 | Proof. by []. Qed. 61 | *) 62 | 63 | Definition option_cons 64 | {A : Type} 65 | (self : option A) 66 | (list : seq.seq A) : seq.seq A := match self with 67 | | Some value => value :: list 68 | | None => list 69 | end. 70 | (*Example option_cons_test_1 : option_cons (Some 1) [:: 2; 3] = [:: 1; 2; 3]. 71 | Proof. by []. Qed. 72 | Example option_cons_test_2 : option_cons None [:: 2; 3] = [:: 2; 3]. 73 | Proof. by []. Qed.*) 74 | 75 | Lemma options_cons_some_eq_cons : forall (A : Type) (x : A) (xs : seq.seq A), option_cons (Some x) xs = cons x xs. 76 | Proof. 77 | by []. 78 | Qed. 79 | 80 | Lemma options_cons_none_ident : forall (A : Type) (xs : seq.seq A), option_cons None xs = xs. 81 | Proof. 82 | by []. 83 | Qed. 84 | Fixpoint prefix {A : eqType} (xs : list A) (ys : list A) := 85 | if length xs > length ys 86 | then false 87 | else 88 | match ys with 89 | | [::] => xs == [::] 90 | | y' :: ys' => if length ys == length xs 91 | then xs == ys 92 | else prefix xs ys' 93 | end. 94 | 95 | Example prefix_example_1 : prefix [:: 1; 2; 3] [:: 4; 5; 1; 2; 3]. 96 | Proof. by []. Qed. 97 | Example prefix_example_2 : @prefix _ [:: 1; 2; 3] [:: 1; 2; 3]. 98 | Proof. by []. Qed. 99 | 100 | Fixpoint all_consecutive_sequences {A} (xs : list A) (l : nat) (p : list A -> bool) := 101 | if (length xs) < l 102 | then true 103 | else 104 | match xs with 105 | | [::] => true 106 | | x' :: xs' => p (take l xs) && all_consecutive_sequences xs' l p 107 | end. 108 | 109 | Definition mod_incr (n : nat) (pf: n > 0) (m : 'I_n) : 'I_n. 110 | case_eq (m < n)=> H. 111 | exact (Ordinal H). 112 | exact (Ordinal pf). 113 | Qed. 114 | 115 | Lemma negb_eqn b: b != true -> eq_op b false. 116 | Proof. 117 | by case b. 118 | Qed. 119 | 120 | Lemma length_sizeP (T : Type) (ls : seq.seq T) : size ls = length ls. 121 | Proof. 122 | by elim ls. 123 | Qed. 124 | 125 | Lemma has_countPn (T : Type) (a : pred T) (s : seq T) : ~~ has a s -> count a s = 0. 126 | Proof. 127 | rewrite has_count. 128 | by rewrite -eqn0Ngt => /eqP . 129 | Qed. 130 | 131 | Lemma ltn_transPn n r : n < r -> r < n.+1 -> False. 132 | Proof. 133 | elim: n => //= . 134 | by elim r => //=. 135 | move=> n IHn. 136 | move=> Hltn Hltr. 137 | apply IHn. 138 | rewrite leq_eqVlt in Hltn. 139 | move/orP: Hltn => [/eqP <- //=|]. 140 | move/ltn_trans: Hltr => H /H. 141 | by rewrite ltnn. 142 | rewrite leq_eqVlt in Hltr. 143 | move/orP: Hltr => [/eqP [] Hwr|]. 144 | move: Hltn. 145 | rewrite Hwr. 146 | by rewrite ltnn. 147 | rewrite -{1}(addn1 r). 148 | rewrite -{1}(addn1 n.+1). 149 | by rewrite ltn_add2r. 150 | Qed. 151 | 152 | Lemma subn_eqP n m : n <= m -> n - m = 0. 153 | Proof. 154 | by rewrite -subn_eq0 => /eqP ->. 155 | Qed. 156 | 157 | Lemma ltn1 n : (n < 1)%nat = (n == 0%nat)%bool. 158 | Proof. 159 | by elim n. 160 | Qed. 161 | 162 | Lemma ltnSn_eq a b : (a < b.+1)%nat -> (b < a.+1)%nat -> (a == b)%bool. 163 | Proof. 164 | move: a. 165 | induction b => //= a. 166 | rewrite ltn1. 167 | by move=> /eqP -> . 168 | have H (x y : nat) : (x > 0)%nat -> (x.-1 == y)%bool = (x == y.+1)%bool. by elim x =>//=. 169 | case (0 < a)%nat eqn: Hva. 170 | rewrite -H //=. 171 | move=> Haltb Hblta. 172 | apply IHb. 173 | rewrite -ltnS. 174 | by rewrite prednK. 175 | by rewrite prednK. 176 | move/negP/negP: Hva. 177 | rewrite -leqNgt. 178 | rewrite leq_eqVlt. 179 | rewrite (ltnS b.+1). 180 | move=>/orP[/eqP ->|]. 181 | by rewrite ltn0. 182 | by rewrite ltn0. 183 | Qed. 184 | 185 | Lemma addr_ltn a b c: 186 | (a + b < c)%nat -> (a < c)%nat. 187 | Proof. 188 | by move=>/(ltn_addr b); rewrite ltn_add2r. 189 | Qed. 190 | 191 | Lemma ltn_leq_split a b c : (a + b - 1 < c.+1)%nat -> ~~ (b <= c)%nat -> ((b == c.+1)%bool && (a == 0%nat)%bool). 192 | Proof. 193 | rewrite -ltnNge. 194 | case (b) => [|b']. 195 | by rewrite ltn0. 196 | rewrite subn1 addnS. 197 | move=> Hab. move: (Hab). 198 | have Hltnadn x : (x > 0)%nat -> x.+1.-1 = x.-1.+1. by elim x => //=. 199 | move=> Habltn; move: Hab; rewrite prednK //=. 200 | move=> Hab; move: (Hab); rewrite addnC. 201 | move=> /addr_ltn Hbltc Hcltb. 202 | move: (ltnSn_eq _ _ Hbltc Hcltb) => /eqP Hbeq; move: Hab. 203 | rewrite Hbeq -(addn1 c) addnC ltn_add2l ltn1. 204 | move=>/eqP ->; apply/andP. 205 | by []. 206 | Qed. 207 | 208 | Lemma ltn_SnnP a b : (a.+1 < b.+1)%nat <-> (a < b)%nat. 209 | Proof. 210 | split. 211 | by elim: a => //=. 212 | by elim: a => //=. 213 | Qed. 214 | 215 | Lemma subn_ltn_pr a b c : (a < c)%nat -> (a - b < c)%nat. 216 | Proof. 217 | move: a b. 218 | elim: c => //= c . 219 | move=> IHn a b. 220 | case H: (a < c)%nat. 221 | move=> _. 222 | rewrite -(addn1 c). 223 | apply ltn_addr. 224 | by apply IHn. 225 | move/negP/negP: H . 226 | rewrite -leqNgt . 227 | rewrite -ltnS. 228 | move=> /ltnSn_eq H /(H) /eqP Heqa. 229 | induction a => //=. 230 | induction b => //=. 231 | by rewrite -Heqa subn0. 232 | rewrite subSS. 233 | rewrite -(addn1 c). 234 | apply ltn_addr. 235 | apply IHn. 236 | by rewrite Heqa. 237 | Qed. 238 | 239 | Lemma ltn_subn_pr a b c : (a < b - c) -> (a < b). 240 | Proof. 241 | move: a b. 242 | elim: c=>//= [ a b | c IHc a b]. 243 | by rewrite subn0. 244 | rewrite subnS -subn1 subnAC =>/IHc. 245 | rewrite ltn_subRL addnC addn1. 246 | case: b => //= b /ltn_SnnP /(ltn_addr 1). 247 | by rewrite addn1. 248 | Qed. 249 | 250 | Lemma leq_subn_pr a b c : (a <= b - c) -> (a <= b). 251 | Proof. 252 | rewrite {1}leq_eqVlt => /orP [/eqP -> | ]. 253 | by apply leq_subr. 254 | move=>/ltn_subn_pr Hlt. 255 | by apply/ltnW. 256 | Qed. 257 | 258 | Lemma ltnn_subS n : (n > 0) -> n.-1 < n. 259 | Proof. 260 | by case n . 261 | Qed. 262 | 263 | Lemma ltn_weaken a b c : a + b < c -> a < c. 264 | Proof. 265 | elim: c => //= c IHc. 266 | rewrite leq_eqVlt => /orP [/eqP [] <- |]. 267 | rewrite -addnS. 268 | by elim a => //=. 269 | rewrite -(addn1 (a + b)). 270 | rewrite -(addn1 c). 271 | rewrite ltn_add2r. 272 | move=>/IHc Hlt. 273 | by apply ltn_addr. 274 | Qed. 275 | 276 | Lemma ltn_subl1 a b : a < b -> a.-1 < b. 277 | Proof. 278 | move: b. 279 | elim:a => //= a IHa b. 280 | by rewrite -{1}(addn1 a) => /ltn_weaken. 281 | Qed. 282 | 283 | Lemma ltn_subl a b c : a < b -> a - c < b. 284 | Proof. 285 | move: a b. 286 | elim: c => //= [a b | c IHc a b]. 287 | by rewrite subn0. 288 | move=> /IHc Hlt. 289 | rewrite subnS. 290 | by apply ltn_subl1. 291 | Qed. 292 | 293 | Lemma ltn_subLR m n p : ( p > 0) -> (n < p + m) -> (n - m < p). 294 | Proof. 295 | move: n p. 296 | elim: m => [//=|m IHn]. 297 | move=> n p. 298 | by rewrite addn0 subn0. 299 | move=> n p p_vld H. 300 | rewrite subnS. 301 | rewrite -subn1. 302 | rewrite subnAC. 303 | apply IHn =>//=. 304 | rewrite addnS ltnS in H. 305 | rewrite leq_eqVlt in H. 306 | move/orP: H => [/eqP ->|]. 307 | by rewrite addnC -addnBA; [rewrite ltn_add2l subn1; apply ltnn_subS|]. 308 | move=> H. 309 | rewrite subn1. 310 | by apply ltn_subl1. 311 | Qed. 312 | 313 | 314 | Lemma leq_addr_weaken x y z : (x + y <= z)%nat -> (x <= z)%nat. 315 | Proof. 316 | move: x y. 317 | elim: z => [ | z IHz x y] //=. 318 | by move=> [|] //=. 319 | rewrite {1}leq_eqVlt => /orP [ /eqP <- | ]. 320 | by apply (leq_addr ). 321 | move=> /IHz Hltxz. 322 | rewrite -(addn1 z) -(addn0 x). 323 | by apply leq_add. 324 | Qed. 325 | 326 | Lemma subn_eqQ a b : a - b = a -> a = 0 \/ b = 0. 327 | Proof. 328 | case: a => //= [ | a]. by move=> _; left. 329 | case Hltn: (b <= a). 330 | rewrite subSn //= => [] []. 331 | move=>/(f_equal (fun x => x + b)). 332 | rewrite addnC. 333 | rewrite subnKC //=. 334 | move=>/(f_equal (fun x => x - a)). 335 | rewrite subnn. 336 | rewrite addnC. 337 | by rewrite -addnBA //= subnn addn0 => Hbeqn0; right. 338 | move/negP/negP: Hltn. 339 | by rewrite -ltnNge -subn_eq0 => /eqP ->. 340 | Qed. 341 | 342 | Lemma addr2n r : (r - 2 < r)%nat \/ (r == (r - 2%nat)%nat)%bool /\ (r == 0%nat)%bool. 343 | Proof. 344 | elim r=> //. 345 | by right; rewrite sub0n. 346 | move=> n [IHn|IHn]. 347 | case (n > 1)%nat eqn: H. 348 | by left; rewrite subSn; [rewrite -(addn1 (n - 2%nat)) -(addn1 n) ltn_add2r| ]. 349 | move/negP/negP: H. 350 | rewrite -leqNgt leq_eqVlt. 351 | by move=>/orP[/eqP -> | ]; [left; rewrite subnn | rewrite ltn1; move=>/eqP ->; left]. 352 | by destruct IHn as [_ Heq0]; move/eqP:Heq0 -> ; left. 353 | Qed. 354 | 355 | Lemma add_lt0 x y: (0 < x + y)%nat = ((0 //=. 358 | Qed. 359 | 360 | Lemma addn_lt1 x y : ((x + y)%nat <= 1)%nat -> (((x == 0)) || ((y == 0)))%nat. 361 | Proof. 362 | by case: x => //= x; case: x => //=; case: y => //=. 363 | Qed. 364 | 365 | Lemma iota_predn r s : iota r s.+1 = iota r s ++ [:: r + s]. 366 | Proof. 367 | move: r. 368 | elim: s => [//=| s IHs ] r. 369 | by rewrite addn0. 370 | rewrite -{1}(addn1 ). 371 | rewrite iota_add . 372 | have: (iota (r + s.+1) 1 = [:: r + s.+1]). by []. 373 | by move=> ->. 374 | Qed. 375 | 376 | 377 | Lemma size_iota_rcons (P : nat -> bool) r s : ~~ P (r + s.-1) -> size (filter P (iota r s)) = size (filter P (iota r s.-1)). 378 | Proof. 379 | elim: s => [//=|] s' IHs Hs'. 380 | rewrite iota_predn. 381 | rewrite -pred_Sn. 382 | rewrite -pred_Sn in Hs'. 383 | rewrite filter_cat. 384 | have: ([seq x <- [:: r + s'] | P x] = [::]). 385 | move=> //=. 386 | by apply ifN. 387 | move=> ->. 388 | by rewrite cats0. 389 | Qed. 390 | 391 | Lemma subn_eq0_eq a b : (a - b == 0) -> (b - a == 0) -> a == b. 392 | Proof. 393 | move: a; elim: b => //= [a| b IHn a]. 394 | by rewrite subn0 sub0n => /eqP ->. 395 | rewrite !subn_eq0. 396 | rewrite leq_eqVlt => /orP [/eqP -> //=| ]. 397 | elim: a => //= a Heqn. 398 | rewrite -{1}(addn1 a). 399 | move=> /ltn_weaken. 400 | by move=>/ltnSn_eq H /H /eqP ->. 401 | Qed. 402 | 403 | Lemma leq_exists a b : a <= b -> exists c, a + c = b. 404 | Proof. 405 | rewrite leq_eqVlt => /orP [/eqP -> | ]; first by exists 0; rewrite addn0. 406 | move: a. 407 | elim: b => //= b IHb a. 408 | rewrite ltnS leq_eqVlt => /orP [/eqP -> | ]. by exists 1; rewrite addn1. 409 | by move=> /IHb [c' Heqn]; exists (c'.+1); rewrite addnS Heqn. 410 | Qed. 411 | 412 | Lemma addn_ltn_eqn' a b c : a > 0 -> a + c = b -> c < b. 413 | Proof. 414 | move=> Hgt0a Heqn. 415 | rewrite -subn_eq0. 416 | rewrite -Heqn. 417 | rewrite subnDA. 418 | rewrite subnAC. 419 | rewrite subSn //= subnn. 420 | move: Hgt0a. 421 | by case a . 422 | Qed. 423 | 424 | Lemma ltn_exists a b : a > 0 -> a < b -> exists c, c < b /\ a + c = b. 425 | Proof. 426 | move: a; elim: b => //= b IHb a Hltn0. 427 | rewrite leq_eqVlt => /orP [ /eqP [] Heq0 | ]. 428 | by move: Hltn0; rewrite Heq0 => Hlnt0; exists 1; split => //=; rewrite addn1. 429 | rewrite -{1}(addn1 a) -{1}(addn1 b). rewrite ltn_add2r. 430 | move=> /IHb Hltn. 431 | move: (Hltn Hltn0) => [b' [Hb'ltb Hb'eqb]]. 432 | exists (b'.+1); split. 433 | by rewrite -{1}(addn1 b) -{1}(addn1 b'); rewrite ltn_add2r. 434 | by rewrite addnS Hb'eqb. 435 | Qed. 436 | 437 | Lemma ltn_exists_multi a b : a > 0 -> a < b -> exists c d, c + d = b /\ c < a. 438 | Proof. 439 | move: a; elim: b => //= b IHb'' a Ha0vld. 440 | move: (Ha0vld) => /IHb'' IHb' . clear IHb''. 441 | rewrite leq_eqVlt => /orP [ /eqP [] Haeqb | ]. 442 | rewrite Haeqb. 443 | rewrite Haeqb in Ha0vld. 444 | exists b.-1. 445 | exists 2. 446 | split; last first. 447 | by apply ltnn_subS; move: Ha0vld. 448 | by rewrite addn2 -addn1 prednK //= addn1. 449 | rewrite -{1}(addn1 a). 450 | rewrite -{1}(addn1 b). 451 | rewrite ltn_add2r => /IHb' [c' [d' [Heqn Hlt]]]. 452 | exists c'. 453 | exists d'.+1. 454 | by split; [rewrite addnS Heqn | ]. 455 | Qed. 456 | 457 | Lemma leqn_eq0 a b : a > 0 -> (a <= a - b) -> b == 0 . 458 | Proof. 459 | move: b. 460 | case: a => //= a b. 461 | case: b => //= b _ . 462 | rewrite subSS. 463 | move=> /ltn_subn_pr. 464 | by rewrite ltnn. 465 | Qed. 466 | 467 | Lemma nth_set_nth_ident 468 | (A : Type) (P : pred A) (ls : seq A) (a a' : A) (n : nat) : 469 | ~~ P a -> ~~ P (nth a ls n) -> ~~ P a' -> length (filter P (set_nth a ls n a')) 470 | = length (filter P ls). 471 | Proof. 472 | elim: ls n => [n H0 H1 H2| a'' ls n n'] //=. 473 | rewrite /filter. 474 | case n => [//=|n0//=]; rewrite ifN. 475 | by []. 476 | by []. 477 | by induction n0 => //=; rewrite ifN. 478 | by []. 479 | induction n' => //= H0 H1 H2. 480 | by rewrite ifN; [rewrite ifN| by []] . 481 | case_eq (P a'') => H //=. 482 | by rewrite n. 483 | by rewrite n. 484 | Qed. 485 | 486 | Lemma nth_set_nth_ident_general (A : Type) (P : pred A) (ls : seq A) (a a' : A) (n : nat) : 487 | n < length ls -> 488 | P (nth a ls n) == P a' -> 489 | length (filter P (set_nth a ls n a')) = length (filter P ls). 490 | Proof. 491 | 492 | elim: ls n => [n H0 | a'' ls n n'] //=. 493 | move=> H0 /eqP H. 494 | case_eq (P a'') => //=. 495 | move: H H0. 496 | case_eq n' => //=. 497 | move=> n0 H H1 H2. 498 | rewrite ifT. 499 | by []. 500 | by rewrite -H H2. 501 | move=> n0 n0eq H H1 H2. 502 | rewrite ifT. 503 | rewrite -(n n0) => //=. 504 | by rewrite H. 505 | by []. 506 | move=> H1. 507 | move: H. 508 | case_eq n' => //=. 509 | move=> H2 H. 510 | rewrite ifF. 511 | by []. 512 | by rewrite -H. 513 | move=> n0 H2 H. 514 | rewrite ifN. 515 | rewrite n => //=. 516 | by rewrite H2 in H0. 517 | by rewrite H. 518 | by rewrite H1. 519 | Qed. 520 | 521 | Lemma nth_set_nth_incr (A : Type) (P : pred A) (ls : seq A) (a a' : A) (n : nat): 522 | n < length ls -> 523 | P a' -> 524 | ~~ P (nth a ls n) -> 525 | length (filter P (set_nth a ls n a')) = (length (filter P ls)).+1. 526 | Proof. 527 | elim: ls n => [n H0 | a'' ls H n' ltnN Pa nPcons] //=. 528 | move: nPcons. 529 | case_eq n' => //= n0. 530 | move=> H1. 531 | rewrite ifT . 532 | by rewrite ifN. 533 | by []. 534 | move=> n_eq. 535 | move=> H1. 536 | case_eq (P a'') => //= Pa''. 537 | rewrite H. 538 | by []. 539 | rewrite n_eq in ltnN. 540 | move: ltnN => //=. 541 | by []. 542 | by []. 543 | rewrite H. 544 | by []. 545 | rewrite n_eq in ltnN. 546 | move: ltnN => //=. 547 | by []. 548 | by []. 549 | Qed. 550 | 551 | 552 | Lemma itoj_eq_0 s r : (s < r)%nat -> itoj r s = [::]. 553 | Proof. 554 | rewrite /itoj; move=> Hsltr. 555 | have H: ((s - r)%nat = 0%nat). by apply /eqP; rewrite subn_eq0 leq_eqVlt; apply /orP; right. 556 | rewrite H => //=. 557 | Qed. 558 | 559 | Lemma addn_eq0 a b : (eq_op (a + b)%nat a) -> (eq_op b 0%nat). 560 | Proof. 561 | move: b. 562 | by elim: a => //=. 563 | Qed. 564 | 565 | (* Miscellaneous Real Lemmas 566 | *) 567 | Require Import Reals Fourier FunctionalExtensionality. 568 | From infotheo 569 | Require Import fdist proba ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop . 570 | 571 | Local Open Scope real_scope. 572 | Local Open Scope R_scope. 573 | Local Open Scope reals_ext_scope. 574 | 575 | Lemma Rleq_eqVlt : forall m n : R, (m <= n)%R <-> (m = n) \/ (m < n)%R. 576 | Proof. 577 | split. 578 | move=>/Rle_lt_or_eq_dec. 579 | by case=> H; [right|left]. 580 | by case=> [/Req_le | /Rlt_le]. 581 | Qed. 582 | (* Probably not the best way to do this *) 583 | 584 | Lemma R_w_distr (A : finType) (f g : A -> R) : 585 | (forall w : A, (f w * g w) = 0) -> (forall w : A, (f w) = 0) \/ (exists w : A, (g w) = 0). 586 | move=> H. 587 | case ([forall w, f w == 0]) eqn: Hall0. 588 | by move/eqfunP: Hall0 => Hall; left. 589 | right. 590 | apply/exists_eqP. 591 | move/negP/negP: Hall0. 592 | rewrite negb_forall=>/existsP [w /eqP Hw]. 593 | by move: (H w) => /Rmult_integral [Hf0 | Hg0]; [move: (Hw Hf0) => [] | apply /exists_eqP; exists w]. 594 | Qed. 595 | (** Subtracts a value from an ordinal value returning another value in the ordinal range *) 596 | Definition ordinal_sub {max : nat} (value : 'I_max) (suband : nat) : 'I_max := 597 | ssr_have (value - suband < max)%nat 598 | match value as o return (o - suband < max)%nat with 599 | | @Ordinal _ m i => 600 | (fun Hpft => 601 | (fun Hpf : (Ordinal (n:=max) (m:=m) i < max)%nat => 602 | eq_ind_r [eta is_true] Hpft (subn_ltn_pr (Ordinal (n:=max) (m:=m) i) suband max Hpf))) 603 | is_true_true i 604 | end [eta Ordinal (n:=max) (m:=value - suband)] . 605 | 606 | Lemma Rle_big_eqP (A : finType) (f g : A -> R) (P : pred A) : 607 | (forall i : A, P i -> f i <= g i) -> 608 | \sum_(i | P i) g i = \sum_(i | P i) f i <-> 609 | (forall i : A, P i -> g i = f i). 610 | Proof. 611 | move=> hf; split => [/Rle_big_eq H//=|]. 612 | by exact (H hf). 613 | move=> H. 614 | by exact (@eq_bigr _ _ _ A _ P g f H). 615 | Qed. 616 | 617 | Lemma addRA_rsum (A : finType) f g : 618 | \sum_(i in A) (f i + g i)%R = (\sum_(i in A) f i + \sum_(i in A) g i)%R . 619 | Proof. 620 | rewrite unlock. 621 | elim index_enum => //=. 622 | have H : R0 = 0. (* there's some issues with the types 0 doesn't want to auto-coerce to R0 *) 623 | by []. 624 | move: (addR0 ). 625 | rewrite /right_id => H'. 626 | move: (H' R0). 627 | by rewrite H. 628 | move=> x xs IHn. 629 | by rewrite IHn addRA (addRC (f x) (g x)) -(addRA (g x)) (addRC (g x)) -(addRA (f x + _)). 630 | Qed. 631 | 632 | 633 | Lemma gtRP (a b : R) : reflect (a > b) (a >b b). 634 | Proof. 635 | by rewrite /gtRb /ltRb; apply: (iffP idP); [case Hrlta: (Rlt_dec b a) | case (Rlt_dec b a) ]. 636 | Qed. 637 | 638 | Lemma foldl_rcons (T R : Type) (f : R -> T -> R) (b : R) (x : T) (xs : seq.seq T) : foldl f b (rcons xs x ) = f (foldl f b xs ) x. 639 | Proof. 640 | by rewrite -cats1 foldl_cat => //=. 641 | Qed. 642 | 643 | Lemma Rmult_integralP r1 r2 : (r1 * r2)%R <> 0%R -> r1 <> 0%R /\ r2 <> 0%R . 644 | Proof. 645 | case Hr1eq0: (eq_op r1 0). 646 | by move/eqP: Hr1eq0 => ->; rewrite (Rmult_0_l r2) . 647 | case Hr2eq0: (eq_op r2 0). 648 | by move/eqP: Hr2eq0 => ->; rewrite (Rmult_0_r r1) . 649 | by move/eqP: Hr1eq0 => Hr1neq; move/eqP: Hr2eq0 => Hr2neq. 650 | Qed. 651 | 652 | Lemma index_enum_simpl y: ((index_enum y)) = (index_enum [finType of y]). 653 | Proof. 654 | by rewrite /index_enum //= /[finType of _] //=; case: y => //=. 655 | Qed. 656 | 657 | 658 | Lemma ordinal_simplP (m p: nat) (i : [finType of m.-tuple 'I_p.+1]) val: 659 | size [seq tnth i x | x in [set ind | tnth i ind != val]] = #|[set ind0 | tnth i ind0 != val]|. 660 | by rewrite size_image. 661 | Qed. 662 | 663 | Lemma index_enum_ordP (T:finType) (m:nat) 664 | (t: T) (S: {set T}) (Hs: #| S | == m): 665 | t \in S -> (index t (enum S) < m )%nat. 666 | Proof. 667 | move/eqP:Hs <- => Ht. 668 | apply seq_index_enum_card => //=. 669 | apply enum_uniq. 670 | Qed. 671 | 672 | Lemma index_enum_ordPn (T:finType) (m q:nat) 673 | (t: T) (S: {set T}) (Ht: #| T | = m) (Hs: #| S | == q): 674 | t \in S = false -> (index t (enum (~: S)) < m - q)%nat. 675 | Proof. 676 | move=>/Bool.negb_true_iff Ht'; move: Ht <-; move/eqP:Hs <-. 677 | rewrite cardsCs subKn //=. 678 | apply seq_index_enum_card => //=. 679 | by apply enum_uniq. 680 | by rewrite in_setC. 681 | by rewrite -(cardsC S); apply leq_addl. 682 | Qed. 683 | -------------------------------------------------------------------------------- /Utils/stirling.v: -------------------------------------------------------------------------------- 1 | (** * Utils/stirling.v 2 | ----------------- 3 | 4 | Proof of the closed form expression of Stirling numbers of the second 5 | kind.*) 6 | 7 | 8 | From mathcomp.ssreflect Require Import 9 | ssreflect ssrbool ssrnat fintype eqtype 10 | seq bigop binomial finset. 11 | 12 | From mathcomp.ssreflect Require Import tuple. 13 | 14 | 15 | From infotheo Require Import 16 | fdist ssrR Reals_ext ssr_ext ssralg_ext bigop_ext Rbigop proba. 17 | 18 | Require Import Coq.Logic.ProofIrrelevance. 19 | Require Import Coq.Logic.FunctionalExtensionality. 20 | 21 | 22 | Set Implicit Arguments. 23 | Unset Strict Implicit. 24 | Unset Printing Implicit Defensive. 25 | 26 | From ProbHash.Utils 27 | Require Import InvMisc seq_ext seq_subset rsum_ext. 28 | 29 | Open Scope R_scope. 30 | 31 | 32 | Lemma index_iota_incr m n: 33 | [seq x.+1 | x <- index_iota m n] = index_iota m.+1 n.+1. 34 | Proof. 35 | rewrite /index_iota subSS. 36 | by move: (iota_addl 1 m (n - m)); rewrite !add1n => <-. 37 | Qed. 38 | 39 | 40 | Section stirling_second_number. 41 | 42 | Definition stirling_no_2 (n k: nat):= 43 | Rdefinitions.Rinv (Factorial.fact k) *R* ( 44 | \sum_(i in 'I_(k.+1)) (((Rdefinitions.Ropp 1) ^R^ i) *R* 45 | ('C (k, i) %R) *R* 46 | (((k %R) -R- (i %R)) ^R^ n) 47 | ) 48 | ). 49 | 50 | 51 | Section partitions. 52 | Variables l k m : nat. 53 | 54 | Lemma vector_sum_subset: forall v: [finType of (l * k).-tuple 'I_m.+1], 55 | v \in [finType of (l * k).-tuple 'I_m.+1] -> 56 | [set x | x \in tval v] \subset [set x | nat_of_ord x < m + 1]. 57 | Proof. 58 | (* Convert to equation in terms of elements *) 59 | move=> v _; rewrite unlock; apply/pred0P => x; rewrite !inE. 60 | (* manipulate boolean expresions *) 61 | apply Bool.negb_true_iff; apply /eqP; rewrite eqb_id Bool.negb_andb Bool.negb_involutive. 62 | 63 | (* first term must be true *) 64 | by rewrite addn1 (ltn_ord x). 65 | 66 | Qed. 67 | 68 | Lemma undup_length_bound_internal: forall v: [finType of (l * k).-tuple 'I_m.+1], 69 | length (undup v) <= m + 1. 70 | Proof. 71 | move=> v. 72 | (* convert ltn to subset relation *) 73 | rewrite -length_sizeP addn1 -{4}(size_enum_ord (m.+1)). 74 | move: (enum_uniq 'I_m.+1) (undup_uniq v) => Huniq_enum Huniq_undup. 75 | move: (card_uniqP Huniq_undup ) (card_uniqP Huniq_enum ) => <- <-. 76 | apply subset_leq_card. 77 | (* convert subset to expression on elements *) 78 | rewrite unlock; apply/pred0P => x; rewrite !inE. 79 | apply Bool.negb_true_iff; apply /eqP; rewrite eqb_id Bool.negb_andb Bool.negb_involutive. 80 | (* trivial *) 81 | apply/orP; left => //=. 82 | rewrite unfold_in //=. 83 | by apply mem_enum. 84 | Qed. 85 | 86 | 87 | Lemma undup_length_bound_ord: forall v: [finType of (l * k).-tuple 'I_m.+1], 88 | length (undup v) < m + 2. 89 | Proof. 90 | move=> v; rewrite addn2 ltnS -{4}addn1. 91 | by apply undup_length_bound_internal. 92 | Qed. 93 | 94 | 95 | Lemma undup_length_bound: forall v: [finType of (l * k).-tuple 'I_m.+1], 96 | v \in [finType of (l * k).-tuple 'I_m.+1] -> 97 | length (undup v) <= m + 1. 98 | Proof. 99 | move=> v _. 100 | by apply undup_length_bound_internal. 101 | Qed. 102 | 103 | End partitions. 104 | 105 | 106 | Lemma subset_combinations m n i (I : {set 'I_m.+1}): 107 | #|pred_of_set I| == i -> 108 | \sum_(i0 in [finType of n.-tuple 'I_m.+1] | [set x in i0] \subset pred_of_set I) 109 | BinNums.Zpos BinNums.xH = ((i %R) ^R^ n). 110 | Proof. 111 | move=> HI. 112 | rewrite rsum_pred_demote. 113 | under eq_bigr => a Ha do rewrite mulR1. 114 | elim: n => [| n IHn] //=. 115 | - { 116 | rewrite rsum_pred_demote rsum_empty //=. 117 | suff ->: ([set x in [tuple]] \subset pred_of_set I) = true; first by rewrite mulR1 //=. 118 | apply/eqP; rewrite eqb_id //=. 119 | rewrite unlock; apply/pred0P => x; rewrite !inE. 120 | by apply /Bool.negb_true_iff; rewrite Bool.negb_andb Bool.negb_involutive //= Bool.orb_true_r. 121 | } 122 | - { 123 | rewrite rsum_tuple_split rsum_split //=. 124 | have H (a : 'I_m.+1) (b : n.-tuple 'I_m.+1): 125 | [set x in [tuple of a :: b]] \subset pred_of_set I = 126 | (a \in I) && ([set x in b] \subset pred_of_set I); 127 | first by rewrite set_cons subUset sub1set //=. 128 | under eq_bigr => a _ do under eq_bigr => b _ do rewrite H boolR_distr. 129 | under eq_bigr => a _ do rewrite -rsum_Rmul_distr_l mulRC. 130 | rewrite -rsum_Rmul_distr_l //= mulRC. 131 | under eq_bigr => a _ do rewrite -(mulR1 ((a \in pred_of_set I) %R)). 132 | rewrite -rsum_pred_demote //=. 133 | rewrite bigsum_card_constE; move/eqP : (HI) => ->; rewrite mulR1; apply f_equal. 134 | by apply IHn. 135 | } 136 | 137 | Qed. 138 | 139 | 140 | 141 | Lemma not_in_subseq m n (I : {set 'I_m.+1}) (v: n.-tuple 'I_m.+1): 142 | ([set x in v] \subset I) -> 143 | ([set x in v] != I ) = 144 | (Ind (\bigcup_(i < #|I|) [set x : n.-tuple 'I_m.+1 | ((@enum_val _ (pred_of_set I) i) \notin x)]) v == Rdefinitions.R1). 145 | Proof. 146 | move=> Hsub; rewrite/Ind. 147 | case Hvin: (v \in _) => //=; try rewrite eq_refl. 148 | - { 149 | move/bigcupP: Hvin => [x' _ ] //=; rewrite in_set => Hnin. 150 | rewrite eqEsubset. 151 | rewrite Bool.negb_andb Hsub //=. 152 | rewrite unlock; apply/pred0Pn; exists (enum_val x'); rewrite inE //= ; apply/andP; split. 153 | - by rewrite in_set Hnin. 154 | - by apply enum_valP. 155 | } 156 | - { 157 | have ->: (Rdefinitions.R0 == Rdefinitions.R1) = false. 158 | case Heq: (Rdefinitions.R0 == Rdefinitions.R1) => //=. 159 | by move/eqP: Heq => Heq; move: Rstruct.R1_neq_0; rewrite eq_sym =>/Bool.negb_true_iff //=; rewrite Heq //= eq_refl //=. 160 | apply Bool.negb_true_iff; rewrite Bool.negb_involutive. 161 | move/Bool.negb_true_iff: Hvin => Hvin. 162 | rewrite -in_setC in Hvin. 163 | rewrite setC_bigcup in Hvin. 164 | move/bigcapP: Hvin => Hin. 165 | apply/eqP; apply/eqP. 166 | rewrite eqEsubset Hsub //=; rewrite unlock; apply/pred0P => x; rewrite !inE. 167 | case Hin': (x \in pred_of_set I); rewrite ?Bool.andb_false_r ?Bool.andb_true_r //=. 168 | apply Bool.negb_true_iff; rewrite Bool.negb_involutive //=. 169 | move: (Hin (enum_rank_in Hin' x ) isT). 170 | by rewrite in_setC enum_rankK_in //= in_set Bool.negb_involutive. 171 | } 172 | Qed. 173 | 174 | 175 | Lemma stirling_number_combinations (n i k: nat) (M: finType) 176 | (I:{set M}) (K: {set 'I_#|pred_of_set I| }) 177 | (HpredI : #| I| == i) 178 | (HpredK : #|pred_of_set K| == k): 179 | \sum_(v : [finType of n.-tuple M] | [set x in v] \subset pred_of_set I) 180 | Ind (\bigcap_(j in K) [set x : [finType of n.-tuple M] | enum_val j \notin x]) v = 181 | (((i %R) -R- (k %R)) ^R^ n). 182 | Proof. 183 | 184 | elim: n => [| n IHn] //=. 185 | - { 186 | rewrite rsum_pred_demote rsum_empty //=. 187 | have ->: ([set x in [tuple]] \subset pred_of_set I) = true. 188 | { 189 | apply/eqP; rewrite eqb_id //=. 190 | rewrite unlock; apply/pred0P => x; rewrite !inE. 191 | by apply /Bool.negb_true_iff; rewrite Bool.negb_andb Bool.negb_involutive //= Bool.orb_true_r. 192 | } 193 | rewrite //= mul1R. 194 | suff ->: Ind 195 | (\bigcap_(j in pred_of_set K) 196 | [set x: 0.-tuple M | enum_val j \notin x]) 197 | [tuple] = true; 198 | first by []. 199 | suff H: [tuple] \in \bigcap_(j in pred_of_set K) [set x : 0.-tuple M | enum_val j \notin x] = true; 200 | first by rewrite /Ind H //=. 201 | apply/bigcapP => ind Hind //=. 202 | by rewrite in_set //=. 203 | } 204 | - { 205 | rewrite rsum_pred_demote rsum_tuple_split rsum_split //=. 206 | have H (a : M) (b : n.-tuple M): 207 | ([set x in cons_tuple a b] \subset pred_of_set I) = 208 | (a \in I) && ([set x in b] \subset pred_of_set I); 209 | first by rewrite set_cons subUset sub1set //=. 210 | 211 | under eq_bigr 212 | => a _ do under eq_bigr 213 | => b _ do rewrite H boolR_distr -mulRA; clear H. 214 | under eq_bigr => a _ do rewrite -rsum_Rmul_distr_l. 215 | rewrite -rsum_pred_demote //=. 216 | 217 | have H (N:finType) (A:{set N}) (a:N): 218 | Ind A a = (a \in A %R). 219 | { 220 | case Hpred: (a \in pred_of_set A) => //=. 221 | - by move/Ind_inP: Hpred ->. 222 | - by move/Ind_notinP: Hpred ->. 223 | } 224 | move: IHn; (under eq_bigr => v Hv do rewrite H); move=> IHn. 225 | 226 | under eq_bigr => a Ha. 227 | { 228 | rewrite -rsum_pred_demote //=. 229 | 230 | under eq_bigr => v Hv do rewrite H //=. 231 | 232 | by over. 233 | 234 | } 235 | move=> //=; clear H. 236 | 237 | have H a v: 238 | (cons_tuple a v \in \bigcap_(j in pred_of_set K) [set x : n.+1.-tuple M | enum_val j \notin x]) = 239 | (a \in \bigcap_(j in pred_of_set K) [set x | enum_val j != x]) 240 | && 241 | (v \in \bigcap_(j in pred_of_set K) [set x | enum_val j \notin tval x]). 242 | { 243 | case Hcons: (cons_tuple _ _ \in _). 244 | { 245 | move/bigcapP:Hcons => Hcons. 246 | by apply Logic.eq_sym; apply/andP; split; 247 | apply/bigcapP => y Hy; move: (Hcons y Hy); 248 | rewrite !in_set in_cons Bool.negb_orb =>/andP []. 249 | } 250 | { 251 | move/Bool.negb_true_iff: Hcons. 252 | rewrite -in_setC setC_bigcap=>/bigcupP [y Hy]. 253 | rewrite !in_set Bool.negb_involutive in_cons =>/orP Hor. 254 | apply Logic.eq_sym; apply Bool.negb_true_iff; rewrite Bool.negb_andb; apply/orP. 255 | by case: Hor => [Haeq| Hvin]; [left | right]; 256 | rewrite -in_setC setC_bigcap; apply/bigcupP; 257 | exists y => //=; rewrite !in_set Bool.negb_involutive. 258 | } 259 | } 260 | 261 | under eq_bigr => a Ha do under eq_bigr => v Hv do rewrite H boolR_distr; clear H. 262 | under eq_bigr => a Ha do rewrite rsum_pred_demote //=. 263 | under eq_bigr => a Ha do under eq_bigr => v Hv do rewrite mulRC -!mulRA. 264 | under eq_bigr => a Ha do rewrite -rsum_Rmul_distr_l. 265 | rewrite -big_distrl //= mulRC. 266 | under eq_bigr => a Ha do rewrite mulRC. 267 | rewrite -rsum_pred_demote //= IHn [(_ -R- _ ) *R* _]mulRC; apply f_equal. 268 | 269 | 270 | rewrite rsum_pred_demote. 271 | under eq_bigr => a Ha do rewrite -boolR_distr -(mulR1 (pred_of_set I a && (a \in \bigcap_(j in pred_of_set K) [set x | enum_val j != x]) %R)). 272 | rewrite -rsum_pred_demote. 273 | move: (@bigID Rdefinitions.R Rdefinitions.R0 addR_comoid M (Finite.enum M) 274 | (fun i0 => (i0 \in \bigcap_(j in pred_of_set K) [set x | enum_val j != x])) 275 | (fun i0 => i0 \in pred_of_set I) 276 | (fun _ => BinNums.Zpos BinNums.xH) 277 | ) => //= /subR_eq <-. 278 | 279 | rewrite bigsum_card_constE mulR1 //=; move/eqP: (HpredI) => {1}->. 280 | 281 | have H (j: 'I_(#|pred_of_set I|)): 282 | ~: [set x | enum_val j != x] = [set enum_val j]. 283 | { 284 | apply setP => x. 285 | by rewrite !in_set Bool.negb_involutive. 286 | } 287 | 288 | under eq_bigl => i0. 289 | { 290 | rewrite -in_setC //= setC_bigcap //=. 291 | under eq_bigr => j Hj do rewrite (H j) //=. 292 | by over. 293 | } 294 | clear H => //=. 295 | apply f_equal. 296 | 297 | clear -HpredK HpredI. 298 | 299 | have H i0: 300 | (i0 \in pred_of_set I) 301 | && (i0 \in \bigcup_(j in pred_of_set K) [set enum_val j]) = 302 | (i0 \in \bigcup_(j in pred_of_set K) [set enum_val j]). 303 | { 304 | case Hin: (i0 \in \bigcup_(_ in _) _); rewrite ?Bool.andb_false_r ?Bool.andb_true_r //=. 305 | move/bigcupP:Hin => [y Hy]; rewrite in_set => /eqP ->. 306 | by apply enum_valP. 307 | } 308 | 309 | under eq_bigl => i0 do rewrite H; clear H => //=. 310 | 311 | 312 | have H (i0: M): (i0 \in \bigcup_(j in pred_of_set K) [set enum_val j]) = 313 | (i0 \in [set (enum_val x) | x in K ]). 314 | { 315 | case Hin: (i0 \in [set (enum_val x) | x in _]). 316 | { 317 | apply/ bigcupP. 318 | move/imsetP: Hin => [im_i0 Him_i0 Hvld]. 319 | exists im_i0 => //=. 320 | by rewrite in_set1 Hvld. 321 | } 322 | { 323 | apply/Bool.negb_true_iff; rewrite -in_setC setC_bigcup. 324 | apply/bigcapP => i1 Hi1; rewrite in_setC1. 325 | case Heq: (_ == _) => //=. 326 | have: (i0 \in [set enum_val x | x in pred_of_set K]). 327 | apply/imsetP; exists i1 => //=; move/eqP:Heq -> => //=. 328 | by rewrite Hin. 329 | } 330 | } 331 | under eq_bigl => i0 do rewrite H //=; clear H. 332 | rewrite bigsum_card_constE mulR1. 333 | rewrite card_in_imset; first by move/eqP:HpredK ->. 334 | move=> x y Hx Hy. 335 | apply enum_val_inj. 336 | 337 | } 338 | 339 | Qed. 340 | 341 | Theorem second_stirling_number_sum: forall l k m (f: nat -> Rdefinitions.R), 342 | (\sum_(inds in [finType of (l * k).-tuple 'I_m.+1]) 343 | ((f (length (undup inds))))) = 344 | \sum_(i < (m + 2)) 345 | (f(i) *R* 346 | (((Factorial.fact i %R) *R* (stirling_no_2 (l * k) i))) *R* ('C ((m.+1), i) %R)). 347 | Proof. 348 | 349 | move=> l k m f. 350 | 351 | rewrite (@partition_big 352 | _ _ _ _ _ _ 353 | (fun (v: [finType of (l * k).-tuple 'I_m.+1]) => [set x | x \in tval v]) 354 | (fun s => s \subset [set x | nat_of_ord x < m + 1]) 355 | (fun inds => f (length (undup inds))) 356 | ); first move => //=; last by apply vector_sum_subset. 357 | 358 | under eq_bigr => j Hj. 359 | { 360 | rewrite (@partition_big 361 | _ _ _ _ _ _ 362 | (fun (v: [finType of (l * k).-tuple 'I_m.+1]) => 363 | Ordinal (undup_length_bound_ord v) 364 | ) 365 | (fun m => true) 366 | (fun inds => f (length (undup inds))) 367 | ) => //=; 368 | by over. 369 | } 370 | rewrite //= exchange_big //=. 371 | 372 | under eq_bigr => j Hj. { 373 | under eq_bigr => i Hi. 374 | { 375 | under eq_bigr => v /andP [Hset Hundup]. 376 | { 377 | have: (length (undup v)) == j; first by move: Hundup => //=. 378 | move=>/eqP ->; rewrite -(mul1R (f j)). 379 | by over. 380 | } 381 | rewrite //= -big_distrl//=. 382 | by over. 383 | } 384 | rewrite //= -big_distrl //= mulRC. 385 | by over. 386 | } 387 | move=>//=. 388 | apply eq_bigr => i _; rewrite -mulRA; apply f_equal. 389 | 390 | have Hpred_eq (I : {set 'I_m.+1}) (v : (l * k).-tuple 'I_m.+1) 391 | : (([set x in v] == I) && (Ordinal (undup_length_bound_ord v) == i)) = 392 | (([set x in v] == I) && (#| I | == i)). 393 | { 394 | case HIeq: (_ == I) => //=. 395 | move/eqP: HIeq => <- //=. 396 | rewrite cardsE //=; have <-: nat_of_ord (Ordinal (undup_length_bound_ord v)) = #|v|; last by move=>//=. 397 | rewrite cardE //= -length_sizeP. 398 | rewrite -(@undup_id _ (enum v)) //=; last by apply enum_uniq. 399 | apply /eqP; rewrite eq_sym -(@uniq_size_uniq _ (undup v) (undup (enum v))); try by apply undup_uniq. 400 | by move: (mem_enum (@mem _ _ v)) => Hmem v' //=; move: (Hmem v'); rewrite !mem_undup //=. 401 | } 402 | under eq_bigr => I HI do under eq_bigl => v do rewrite Hpred_eq. 403 | 404 | under eq_bigr => I Hi. { 405 | rewrite rsum_pred_demote. 406 | under eq_bigr => v Hv do rewrite andbC boolR_distr -!mulRA. 407 | rewrite -big_distrr //=. 408 | by over. 409 | } 410 | 411 | have H (I : {set 'I_m.+1}) : pred_of_set I \subset [set x | nat_of_ord x < m + 1]. 412 | { 413 | rewrite unlock; apply/pred0P => x; rewrite !inE. 414 | apply Bool.negb_true_iff; apply /eqP; rewrite eqb_id Bool.negb_andb Bool.negb_involutive. 415 | apply/orP;left; rewrite addn1. 416 | apply ltn_ord. 417 | } 418 | under eq_bigl => I do rewrite H; move=>//=; clear H. 419 | rewrite -rsum_pred_demote //=. 420 | under eq_bigr => I Hi do rewrite -rsum_pred_demote //=. 421 | 422 | apply sum_partition_combinations => I Hi. 423 | rewrite /stirling_no_2; rewrite mulRA. 424 | have->: ((Factorial.fact i %R) *R* Rdefinitions.Rinv (Factorial.fact i)) = 1; last rewrite mul1R. 425 | { 426 | by rewrite RIneq.INR_IZR_INZ mulRV //=; apply/eqP; 427 | rewrite -!RIneq.INR_IZR_INZ; apply RIneq.not_0_INR; apply (Factorial.fact_neq_0 i). 428 | } 429 | 430 | 431 | (* Stirlings number proof - step 2 *) 432 | have H (v: (l * k).-tuple 'I_m.+1): 433 | [set x in v] == I = (([set x in v] \subset I) && ([set x in v] == I)). 434 | 435 | { 436 | case Heq: (_ == _); last by rewrite Bool.andb_false_r. 437 | apply Logic.eq_sym; rewrite Bool.andb_true_r. 438 | by move/eqP:Heq ->; apply/eqP; rewrite eqb_id //=. 439 | } 440 | 441 | under eq_bigl => v do rewrite H; clear H. 442 | move: (@bigID 443 | Rdefinitions.R (Rdefinitions.R0) 444 | addR_comoid 445 | [finType of (l * k).-tuple 'I_m.+1] 446 | (index_enum [finType of (l * k).-tuple 'I_m.+1]) 447 | (fun v => [set x in v] == I) 448 | (fun v => [set x in v] \subset pred_of_set I) 449 | (fun a => BinNums.Zpos BinNums.xH )) => //=. 450 | move=>/RIneq.Rminus_diag_eq //=; rewrite addRC subRD; move=>/RIneq.Rminus_diag_uniq <- //=. 451 | rewrite (@subset_combinations m (l * k) i I Hi). 452 | 453 | have H (v: (l * k).-tuple 'I_m.+1): 454 | ([set x in v] \subset pred_of_set I) && ([set x in v] != I) = 455 | ([set x in v] \subset pred_of_set I) 456 | && 457 | (Ind (\bigcup_(i0 < #|pred_of_set I|) [set x | enum_val i0 \notin tval x]) v == Rdefinitions.R1). 458 | { 459 | case Hsubs: (_ \subset _) => //=. 460 | rewrite not_in_subseq //=. 461 | } 462 | 463 | under eq_bigl => v do rewrite H; clear H. 464 | 465 | have H p1 p2: (Ind p1 p2 == Rdefinitions.R1 %R) = Ind p1 p2. 466 | { 467 | rewrite/Ind. 468 | case: (_ \in _) => //=; rewrite ?eq_refl //=. 469 | 470 | have ->: (Rdefinitions.R0 == Rdefinitions.R1) = false. 471 | { 472 | case Heq: (Rdefinitions.R0 == Rdefinitions.R1) => //=. 473 | by move/eqP: Heq => Heq; move: Rstruct.R1_neq_0; rewrite eq_sym =>/Bool.negb_true_iff //=; rewrite Heq //= eq_refl //=. 474 | } 475 | by []. 476 | } 477 | 478 | rewrite rsum_pred_demote; under eq_bigr => v Hv do rewrite boolR_distr -mulRA mulR1; rewrite -rsum_pred_demote //=. 479 | 480 | under eq_bigr => v Hv do rewrite H; clear H. 481 | 482 | have H j: 483 | (BinNums.Zneg BinNums.xH ^R^ j - 1) = (Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ (j - 1)). 484 | { 485 | by apply f_equal => //=. 486 | } 487 | under eq_bigr => v Hv. 488 | { 489 | rewrite Ind_bigcup_incl_excl. 490 | move/eqP: Hi => Hi. 491 | rewrite {1}Hi. 492 | under eq_bigr => j Hj do rewrite H subn1. 493 | by over. 494 | } 495 | rewrite exchange_big //=. 496 | 497 | under eq_bigr => j Hj. 498 | { 499 | rewrite rsum_pred_demote. 500 | under eq_bigr => a Ha do rewrite mulRC -!mulRA. 501 | rewrite -rsum_Rmul_distr_l. 502 | under eq_bigr => a Ha do rewrite mulRC. 503 | rewrite -rsum_pred_demote //=. 504 | by over. 505 | } 506 | under eq_bigr => v Hv do rewrite exchange_big //=. 507 | rewrite -addR_opp. 508 | rewrite big_morph_oppR. 509 | under eq_bigr => v Hv do rewrite RIneq.Ropp_mult_distr_l //=. 510 | 511 | move=> //=. 512 | 513 | under eq_bigr => v Hv. 514 | { 515 | rewrite (@sum_partition_combinations _ _ _ (((i %R) -R- (v %R)) ^R^ l * k)). 516 | by over. 517 | move=> I0 HI0. 518 | by move: (@stirling_number_combinations (l * k) i v [finType of 'I_m.+1] I I0 Hi HI0). 519 | } 520 | 521 | move=> //=; clear H. 522 | 523 | have H v: v > 0 -> Rdefinitions.Ropp (Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ v.-1) = 524 | (Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ v). 525 | { 526 | clear; elim: v => [| [|v] IHv] //=; first by move=> _; rewrite mulR1. 527 | move=> Hv. 528 | rewrite RIneq.Ropp_mult_distr_l RIneq.Ropp_involutive mul1R. 529 | rewrite mulRA. 530 | by rewrite -RIneq.Ropp_mult_distr_r RIneq.Ropp_mult_distr_l RIneq.Ropp_involutive mul1R mul1R. 531 | } 532 | 533 | under eq_big_nat => v /andP [H1 H2] do rewrite (H v H1). 534 | 535 | 536 | 537 | have Hov: (1 <= i.+1); first by []. 538 | move: (@big_nat_recl 539 | Rdefinitions.R 540 | Rdefinitions.R0 541 | addR_comoid i 0 542 | (fun v => 543 | ((Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ v) *R* 544 | ((((i %R) -R- (v %R)) ^R^ l * k) *R* ('C(#|pred_of_set I|, v) %R))) 545 | ) 546 | Hov 547 | ) => //=. 548 | 549 | rewrite subR0 mul1R bin0 mulR1. 550 | have: \sum_(0 <= i0 < i) 551 | ((Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ i0.+1) *R* 552 | ((((i %R) -R- (i0.+1 %R)) ^R^ l * k) *R* ('C(#|pred_of_set I|, i0.+1) %R))) = 553 | \sum_(1 <= i0 < i.+1) 554 | ((Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ i0) *R* 555 | ((((i %R) -R- (i0 %R)) ^R^ l * k) *R* ('C(#|pred_of_set I|, i0) %R))). 556 | { 557 | 558 | rewrite -(@big_map 559 | Rdefinitions.R Rdefinitions.R0 addR_comoid 560 | _ _ (fun x => x.+1) (index_iota 0 i) (fun _ => true) 561 | (fun i0 => 562 | ((Rdefinitions.Ropp (BinNums.Zpos BinNums.xH) ^R^ i0) *R* 563 | ((((i %R) -R- (i0 %R)) ^R^ l * k) *R* ('C(#|pred_of_set I|, i0) %R))) 564 | ) 565 | ). 566 | by rewrite index_iota_incr. 567 | } 568 | move=> //= -> <-. 569 | rewrite big_mkord. 570 | by apply eq_bigr => y Hy //=; move/eqP:Hi =>->; rewrite -!mulRA; apply f_equal; rewrite mulRC. 571 | Qed. 572 | 573 | 574 | Lemma second_stirling_number_sum_normalized: forall l k m (f: nat -> Rdefinitions.R), 575 | (\sum_(inds in [finType of (l * k).-tuple 'I_m.+1]) 576 | ((Rdefinitions.Rinv (m.+1 %R) ^R^ l * k) *R* 577 | (f (length (undup inds)))) ) = 578 | \sum_(len in [finType of 'I_(m.+2)]) 579 | (f(len) *R* 580 | ( ('C ((m.+1), len) %R) *R* 581 | (Factorial.fact len %R) *R* (stirling_no_2 (l * k) len) *R* 582 | (Rdefinitions.Rinv (m.+1 %R) ^R^ (l * k)) 583 | )). 584 | Proof. 585 | move=> l k m f. 586 | rewrite -rsum_Rmul_distr_l. 587 | under [\sum_(len in [finType of 'I_m.+2]) _]eq_bigr => inds Hinds do rewrite mulRA mulRC -!mulRA. 588 | rewrite -rsum_Rmul_distr_l; apply f_equal. 589 | rewrite second_stirling_number_sum addn2. 590 | apply eq_bigr => ind Hind. 591 | by rewrite -mulRA; apply f_equal; rewrite mulRC. 592 | Qed. 593 | 594 | 595 | About second_stirling_number_sum. 596 | 597 | 598 | End stirling_second_number. 599 | -------------------------------------------------------------------------------- /Structures/Core/AMQHash.v: -------------------------------------------------------------------------------- 1 | (** * Structures/Core/AMQHash.v 2 | ----------------- 3 | 4 | Defines an abstract interface the hash functions used in AMQs, 5 | encoding both the deterministic and probabilistic behaviours of these 6 | operations. Also provides instantiations of this interface for some 7 | standard hash operations. *) 8 | 9 | From mathcomp.ssreflect Require Import 10 | ssreflect ssrbool ssrnat eqtype fintype 11 | choice ssrfun seq path bigop finfun finset binomial. 12 | 13 | From mathcomp.ssreflect 14 | Require Import tuple. 15 | 16 | From mathcomp 17 | Require Import path. 18 | 19 | From infotheo Require Import 20 | fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba. 21 | 22 | Require Import Coq.Logic.ProofIrrelevance. 23 | Require Import Coq.Logic.FunctionalExtensionality. 24 | 25 | Set Implicit Arguments. 26 | Unset Strict Implicit. 27 | Unset Printing Implicit Defensive. 28 | 29 | From ProbHash.Utils 30 | Require Import InvMisc seq_ext seq_subset rsum_ext stirling tactics. 31 | 32 | From ProbHash.Computation 33 | Require Import Comp Notationv1. 34 | 35 | From ProbHash.Core 36 | Require Import Hash HashVec FixedList FixedMap. 37 | 38 | (** Abstract interface for a hash function used in AMQs *) 39 | Module Type AMQHASH. 40 | Parameter AMQHashKey : finType. 41 | (** Allows the hash types to be parameterised - i.e see BasicHash 42 | defined later on where the parameters are the capacity of the hash 43 | function. *) 44 | Parameter AMQHashParams: Type. 45 | Parameter AMQHashValue: AMQHashParams -> finType. 46 | Parameter AMQHash : AMQHashParams -> finType. 47 | 48 | 49 | 50 | Section AMQHash. 51 | Variable p: AMQHashParams. 52 | Parameter AMQHash_probability: AMQHashParams -> Rdefinitions.R. 53 | 54 | Axiom AMQHash_hash_prob_valid: 55 | \sum_(v in AMQHashValue p) (AMQHash_probability p) = 1. 56 | 57 | 58 | Parameter AMQHash_hashstate_put : AMQHash p -> AMQHashKey -> AMQHashValue p -> AMQHash p. 59 | 60 | (** ** Boolean properties of hash states*) 61 | Parameter AMQHash_hashstate_available_capacity : AMQHash p -> nat -> bool. 62 | Parameter AMQHash_hashstate_valid: AMQHash p -> bool. 63 | Parameter AMQHash_hashstate_contains: AMQHash p -> AMQHashKey -> AMQHashValue p -> bool. 64 | Parameter AMQHash_hashstate_unseen: AMQHash p -> AMQHashKey -> bool. 65 | 66 | (** ** Probabilistic hash operation*) 67 | Parameter AMQHash_hash: AMQHash p -> AMQHashKey -> Comp [finType of (AMQHash p * AMQHashValue p)]. 68 | 69 | (** Properties of deterministic hash state operations *) 70 | Section DeterministicOperations. 71 | 72 | Variable hashstate: AMQHash p. 73 | 74 | 75 | Axiom AMQHash_hashstate_available_capacityW: forall n m, m <= n -> 76 | AMQHash_hashstate_valid hashstate -> 77 | AMQHash_hashstate_available_capacity hashstate n -> 78 | AMQHash_hashstate_available_capacity hashstate m. 79 | 80 | Axiom AMQHash_hashstate_available_capacity_decr: forall l key value, 81 | AMQHash_hashstate_valid hashstate -> 82 | AMQHash_hashstate_available_capacity hashstate l.+1 -> 83 | AMQHash_hashstate_available_capacity (AMQHash_hashstate_put hashstate key value) l. 84 | 85 | 86 | Axiom AMQHash_hashstate_add_contains_preserve: forall (key key': AMQHashKey) (value value': AMQHashValue p), 87 | AMQHash_hashstate_valid hashstate -> 88 | AMQHash_hashstate_available_capacity hashstate 1 -> 89 | key != key' -> AMQHash_hashstate_contains hashstate key value -> 90 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key' value') key value. 91 | 92 | Axiom AMQHash_hashstate_add_contains_base: forall (key: AMQHashKey) (value: AMQHashValue p), 93 | AMQHash_hashstate_valid hashstate -> 94 | AMQHash_hashstate_available_capacity hashstate 1 -> 95 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key value) key value. 96 | 97 | Axiom AMQHash_hashstate_add_valid_preserve: forall (key: AMQHashKey) (value: AMQHashValue p), 98 | AMQHash_hashstate_valid hashstate -> 99 | AMQHash_hashstate_available_capacity hashstate 1 -> 100 | AMQHash_hashstate_valid (AMQHash_hashstate_put hashstate key value). 101 | 102 | Axiom AMQHash_hashstate_unseenE: forall (hashstate': AMQHash p) (key key': AMQHashKey) (value': AMQHashValue p), 103 | key != key' -> 104 | AMQHash_hashstate_unseen hashstate key -> 105 | hashstate' = AMQHash_hashstate_put hashstate key' value' -> 106 | AMQHash_hashstate_unseen hashstate' key. 107 | 108 | End DeterministicOperations. 109 | 110 | 111 | Axiom AMQHash_hash_unseen_insert_eqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 112 | AMQHash_hashstate_unseen hashstate key -> hashstate' = AMQHash_hashstate_put hashstate key value -> 113 | d[ AMQHash_hash hashstate key ] (hashstate', value) = AMQHash_probability p. 114 | 115 | Axiom AMQHash_hash_unseen_insert_neqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 116 | AMQHash_hashstate_unseen hashstate key -> hashstate' != AMQHash_hashstate_put hashstate key value -> 117 | d[ AMQHash_hash hashstate key ] (hashstate', value) = 0. 118 | 119 | Axiom AMQHash_hash_seen_insertE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value value': AMQHashValue p), 120 | AMQHash_hashstate_contains hashstate key value -> 121 | d[ AMQHash_hash hashstate key ] (hashstate', value') = ((hashstate' == hashstate) && (value' == value)). 122 | 123 | End AMQHash. 124 | End AMQHASH. 125 | 126 | (** Abstract interface encoding the required properties of AMQ hash 127 | functions. *) 128 | Module AMQHashProperties (AMQHash: AMQHASH). 129 | 130 | Import AMQHash. 131 | Section Properties. 132 | Variable p: AMQHashParams. 133 | 134 | Lemma AMQHash_hash_unseen_simplE (hashstate: AMQHash p) key value f : 135 | AMQHash_hashstate_unseen hashstate key -> 136 | (\sum_(hashstate' in [finType of AMQHash p]) 137 | (d[ AMQHash_hash hashstate key ] (hashstate', value) *R* (f hashstate'))) = 138 | ((AMQHash_probability p) *R* 139 | (f (AMQHash_hashstate_put hashstate key value))). 140 | Proof. 141 | move=> Hall. 142 | rewrite (bigID (fun hashstate' => hashstate' == (AMQHash_hashstate_put hashstate key value))) //=. 143 | rewrite (@big_pred1_eq Rdefinitions.R _ _ 144 | [finType of AMQHash p] 145 | (AMQHash_hashstate_put hashstate key value))//=. 146 | under eq_bigr => i Hneq do rewrite AMQHash_hash_unseen_insert_neqE //= ?mul0R. 147 | rewrite AMQHash_hash_unseen_insert_eqE //=. 148 | rewrite (@bigsum_card_constE [finType of AMQHash p] ) mulR0 addR0 //=. 149 | Qed. 150 | 151 | End Properties. 152 | End AMQHashProperties. 153 | 154 | (** * Instantiation of the AMQHash interface for random-oracle based 155 | Hash functions. *) 156 | Module BasicHash (Spec:HashSpec) <: AMQHASH. 157 | 158 | Module Hash := Hash Spec. 159 | 160 | Definition AMQHashKey : finType := Spec.B. 161 | 162 | (** Parameter defines the capacity of the hash function *) 163 | Definition AMQHashParams: Type := nat. 164 | Definition AMQHashValue (params: AMQHashParams) : finType := 165 | [finType of 'I_Spec.Hash_size.+1]. 166 | Definition AMQHash (n: AMQHashParams) := [finType of Hash.HashState n]. 167 | 168 | Section AMQHash. 169 | Variable p: AMQHashParams. 170 | Definition AMQHash_probability (n: AMQHashParams) := 171 | Rdefinitions.Rinv (#|AMQHashValue n| %R). 172 | 173 | Section HashProbability. 174 | 175 | Variable h: AMQHashParams. 176 | 177 | Lemma AMQHash_hash_prob_valid: 178 | \sum_(v in AMQHashValue h) (AMQHash_probability h) = 1. 179 | Proof. 180 | rewrite/AMQHash_probability bigsum_card_constE mulRV //=. 181 | rewrite RIneq.INR_IZR_INZ card_ord; apply/eqP => //=. 182 | Qed. 183 | 184 | End HashProbability. 185 | 186 | (** ** Deterministic pure transformations of hash state *) 187 | Definition AMQHash_hashstate_find 188 | (hashstate: AMQHash p) (key: AMQHashKey) 189 | : option (AMQHashValue p) := 190 | Hash.hashstate_find p key hashstate. 191 | 192 | Definition AMQHash_hashstate_put 193 | (hashstate: AMQHash p) (key: AMQHashKey) (value: AMQHashValue p) 194 | : AMQHash p := 195 | Hash.hashstate_put p key value hashstate. 196 | 197 | (** ** Boolean properties of hash states*) 198 | Definition AMQHash_hashstate_available_capacity 199 | (hashstate:AMQHash p) (l:nat) : bool := 200 | [length hashstate] + l < p. 201 | 202 | Definition AMQHash_hashstate_valid (hashstate: AMQHash p) : bool := 203 | true. 204 | 205 | Definition AMQHash_hashstate_contains 206 | (hashstate: AMQHash p) (key: AMQHashKey) (value: AMQHashValue p) 207 | : bool := 208 | Hash.hashstate_find p key hashstate == Some value. 209 | 210 | Definition AMQHash_hashstate_unseen 211 | (hashstate: AMQHash p) (key: AMQHashKey) : bool := 212 | Hash.hashstate_find p key hashstate == None. 213 | 214 | (** ** Probabilistic hash operation*) 215 | Definition AMQHash_hash 216 | (hashstate: AMQHash p) 217 | (key: AMQHashKey) : Comp [finType of (AMQHash p * AMQHashValue p)] := 218 | Hash.hash p key hashstate. 219 | 220 | (** ** Properties of deterministic hash state operations *) 221 | Section DeterministicOperations. 222 | 223 | Variable hashstate: AMQHash p. 224 | 225 | Lemma AMQHash_hashstate_contains_findE: forall (key: AMQHashKey) (value: AMQHashValue p) , 226 | AMQHash_hashstate_valid hashstate -> 227 | AMQHash_hashstate_contains hashstate key value -> 228 | AMQHash_hashstate_find hashstate key = Some value. 229 | Proof. 230 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find //=. 231 | by move=>key value _ /eqP ->. 232 | Qed. 233 | 234 | 235 | Lemma AMQHash_hashstate_unseen_nfindE: forall (key: AMQHashKey) (value: AMQHashValue p), 236 | AMQHash_hashstate_valid hashstate -> 237 | AMQHash_hashstate_unseen hashstate key -> 238 | AMQHash_hashstate_find hashstate key = None. 239 | Proof. 240 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 241 | by move=> key value _ /eqP. 242 | Qed. 243 | 244 | Lemma AMQHash_hashstate_available_capacityW: forall n m, m <= n -> 245 | AMQHash_hashstate_valid hashstate -> 246 | AMQHash_hashstate_available_capacity hashstate n -> 247 | AMQHash_hashstate_available_capacity hashstate m. 248 | Proof. 249 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 250 | move=> n m Hnm _; rewrite/AMQHash_hashstate_available_capacity. 251 | move: Hnm; rewrite leq_eqVlt => /orP [/eqP -> //=| Hltn]. 252 | move=> Hlen; eapply ltn_trans with (n:=[length hashstate] + n) => //=. 253 | by rewrite ltn_add2l. 254 | Qed. 255 | 256 | Lemma AMQHash_hashstate_available_capacity_decr: forall l key value, 257 | AMQHash_hashstate_valid hashstate -> 258 | AMQHash_hashstate_available_capacity hashstate l.+1 -> 259 | AMQHash_hashstate_available_capacity (AMQHash_hashstate_put hashstate key value) l. 260 | Proof. 261 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 262 | rewrite /AMQHash_hashstate_available_capacity/AMQHash_hashstate_put. 263 | rewrite /Hash.hashstate_put. 264 | move=> l key value _. 265 | by move=>/fixedlist_add_incr => /(_ value key); rewrite addnS. 266 | Qed. 267 | 268 | 269 | Lemma AMQHash_hashstate_add_contains_preserve: forall (key key': AMQHashKey) (value value': AMQHashValue p), 270 | AMQHash_hashstate_valid hashstate -> 271 | AMQHash_hashstate_available_capacity hashstate 1 -> 272 | key != key' -> AMQHash_hashstate_contains hashstate key value -> 273 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key' value') key value. 274 | Proof. 275 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 276 | rewrite /AMQHash_hashstate_available_capacity/AMQHash_hashstate_put. 277 | rewrite /Hash.hashstate_find. 278 | move=> key key' value value' _ Hlen Hkeynew Hfindeq. 279 | apply fixmap_find_eq => //=. 280 | Qed. 281 | 282 | Lemma AMQHash_hashstate_add_contains_base: forall (key: AMQHashKey) (value: AMQHashValue p), 283 | AMQHash_hashstate_valid hashstate -> 284 | AMQHash_hashstate_available_capacity hashstate 1 -> 285 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key value) key value. 286 | Proof. 287 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 288 | rewrite /AMQHash_hashstate_available_capacity/AMQHash_hashstate_put. 289 | move=> key value _ Hlen. 290 | rewrite (@Hash.hash_find_insert_involutive p key value hashstate) //=. 291 | by move/ltnW: Hlen. 292 | Qed. 293 | 294 | Lemma AMQHash_hashstate_add_valid_preserve: forall (key: AMQHashKey) (value: AMQHashValue p), 295 | AMQHash_hashstate_valid hashstate -> 296 | AMQHash_hashstate_available_capacity hashstate 1 -> 297 | AMQHash_hashstate_valid (AMQHash_hashstate_put hashstate key value). 298 | Proof. 299 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 300 | Qed. 301 | 302 | Lemma AMQHash_hashstate_unseenE: forall 303 | (hashstate': AMQHash p) (key key': AMQHashKey) 304 | (value': AMQHashValue p), 305 | key != key' -> 306 | AMQHash_hashstate_unseen hashstate key -> 307 | hashstate' = AMQHash_hashstate_put hashstate key' value' -> 308 | AMQHash_hashstate_unseen hashstate' key. 309 | Proof. 310 | rewrite/AMQHashKey/AMQHashValue/AMQHash_hashstate_valid/AMQHash_hashstate_contains/AMQHash_hashstate_find/AMQHash_hashstate_unseen //=. 311 | move=> hashstate' key key' value' Hkey Hfind ->. 312 | rewrite /AMQHash_hashstate_put/ Hash.hashstate_find/ Hash.hashstate_put. 313 | apply fixmap_find_neq => //=. 314 | Qed. 315 | End DeterministicOperations. 316 | 317 | Lemma AMQHash_hash_unseen_insert_eqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 318 | AMQHash_hashstate_unseen hashstate key -> hashstate' = AMQHash_hashstate_put hashstate key value -> 319 | d[ AMQHash_hash hashstate key ] (hashstate', value) = AMQHash_probability p. 320 | Proof. 321 | rewrite/AMQHash_hash/AMQHash_hashstate_put/AMQHash_hashstate_unseen. 322 | move=> //= hsh hsh' key value //= /eqP Huns ->. 323 | rewrite/Hash.hash Huns //=; comp_normalize. 324 | comp_simplify; under eq_bigr do rewrite xpair_eqE boolR_distr. 325 | comp_simplify; rewrite eq_refl //= mul1R //=. 326 | Qed. 327 | 328 | Lemma AMQHash_hash_unseen_insert_neqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 329 | AMQHash_hashstate_unseen hashstate key -> hashstate' != AMQHash_hashstate_put hashstate key value -> 330 | d[ AMQHash_hash hashstate key ] (hashstate', value) = 0. 331 | Proof. 332 | rewrite/AMQHash_hash/AMQHash_hashstate_put/AMQHash_hashstate_unseen. 333 | move=> //= hsh hsh' key value //= /eqP Huns Hneq. 334 | rewrite/Hash.hash Huns //=; comp_normalize. 335 | comp_simplify; under eq_bigr do rewrite xpair_eqE boolR_distr. 336 | by comp_simplify; move/Bool.negb_true_iff: Hneq ->; rewrite //= mul0R. 337 | Qed. 338 | 339 | Lemma AMQHash_hash_seen_insertE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value value': AMQHashValue p), 340 | AMQHash_hashstate_contains hashstate key value -> 341 | d[ AMQHash_hash hashstate key ] (hashstate', value') = ((hashstate' == hashstate) && (value' == value)). 342 | Proof. 343 | rewrite/AMQHash_hash/AMQHash_hashstate_put/AMQHash_hashstate_unseen/AMQHash_hashstate_contains. 344 | move=> //= hsh hsh' key value value' /eqP Hcont //=. 345 | rewrite/Hash.hash Hcont //=; comp_normalize. 346 | by rewrite xpair_eqE //= RIneq.INR_IZR_INZ. 347 | Qed. 348 | 349 | End AMQHash. 350 | End BasicHash. 351 | 352 | 353 | (** Instantiation of the AMQ Hash interface for Hash vectors *) 354 | Module BasicHashVec (Spec:HashSpec) <: AMQHASH. 355 | Module HashVec := HashVec Spec. 356 | 357 | Definition AMQHashKey : finType := Spec.B. 358 | 359 | (** Parameters are the capacity of the hash functions (n) and the number of the hash functions (l). *) 360 | Definition AMQHashParams := (nat * nat)%type. 361 | 362 | Definition AMQHashValue (pair: AMQHashParams) : finType := 363 | [finType of (snd pair).+1.-tuple ('I_Spec.Hash_size.+1)]. 364 | 365 | Definition AMQHash (pair: AMQHashParams) := 366 | [finType of (snd pair).+1.-tuple (HashVec.Hash.HashState (fst pair))]. 367 | 368 | Section AMQHash. 369 | Variable p: AMQHashParams. 370 | Definition AMQHash_probability (pair: AMQHashParams) : Rdefinitions.R := 371 | ((Rdefinitions.Rinv (Spec.Hash_size.+1)%:R) ^R^ (snd pair).+1). 372 | 373 | Section HashProbability. 374 | Variable h: AMQHashParams. 375 | 376 | Lemma AMQHash_hash_prob_valid: 377 | \sum_(v in AMQHashValue h) (AMQHash_probability h) = 1. 378 | Proof. 379 | rewrite/AMQHashValue/AMQHash_probability; rewrite bigsum_card_constE. 380 | rewrite card_tuple card_ord. 381 | rewrite -natRexp -expRM mulRV //=; first by rewrite Rfunctions.pow1 mulR1. 382 | by rewrite RIneq.INR_IZR_INZ; apply/eqP => //=. 383 | Qed. 384 | End HashProbability. 385 | 386 | (** ** Deterministic pure transformations of hash state *) 387 | 388 | Definition AMQHash_hashstate_put 389 | (hashstate: AMQHash p) (key: AMQHashKey) 390 | (value: AMQHashValue p) : AMQHash p := 391 | Tuple (@HashVec.hash_vec_insert_length 392 | (fst p) (snd p).+1 key hashstate value). 393 | 394 | 395 | (** ** Boolean properties of hash states*) 396 | Definition AMQHash_hashstate_available_capacity 397 | (hashstate:AMQHash p) (l:nat) :bool := 398 | (@HashVec.hashes_have_free_spaces (snd p).+1 (fst p) hashstate l). 399 | 400 | Definition AMQHash_hashstate_valid (hashstate: AMQHash p) : bool := true. 401 | 402 | Definition AMQHash_hashstate_contains 403 | (hashstate: AMQHash p) (key: AMQHashKey) 404 | (value: AMQHashValue p) : bool := 405 | (@HashVec.hash_vec_contains_value (fst p) (snd p).+1 key hashstate value). 406 | 407 | Definition AMQHash_hashstate_unseen 408 | (hashstate: AMQHash p) (key:AMQHashKey) : bool := 409 | (@HashVec.hashes_value_unseen (snd p).+1 (fst p) hashstate key). 410 | 411 | (** ** Probabilistic hash operation*) 412 | Definition AMQHash_hash 413 | (hashstate: AMQHash p) 414 | (key: AMQHashKey) : Comp [finType of (AMQHash p * AMQHashValue p)] := 415 | (@HashVec.hash_vec_int (fst p) (snd p).+1 key hashstate). 416 | 417 | (** ** Properties of deterministic hash state operations *) 418 | Section DeterministicOperations. 419 | 420 | Variable hashstate: AMQHash p. 421 | 422 | Lemma AMQHash_hashstate_available_capacityW: forall n m, m <= n -> 423 | AMQHash_hashstate_valid hashstate -> 424 | AMQHash_hashstate_available_capacity hashstate n -> 425 | AMQHash_hashstate_available_capacity hashstate m. 426 | Proof. 427 | rewrite /AMQHash_hashstate_available_capacity/HashVec.hashes_have_free_spaces//=. 428 | rewrite /HashVec.hash_has_free_spaces//=. 429 | move=> n m Hnm _ /allP Hvv; apply/allP => v Hv; move: (Hvv v Hv). 430 | apply leq_trans. 431 | by rewrite leq_add2l. 432 | Qed. 433 | 434 | Lemma AMQHash_hashstate_available_capacity_decr: forall l key value, 435 | AMQHash_hashstate_valid hashstate -> 436 | AMQHash_hashstate_available_capacity hashstate l.+1 -> 437 | AMQHash_hashstate_available_capacity (AMQHash_hashstate_put hashstate key value) l. 438 | Proof. 439 | rewrite /AMQHash_hashstate_available_capacity/HashVec.hashes_have_free_spaces//=. 440 | rewrite /HashVec.hash_has_free_spaces//=. 441 | move=> l key value _ /allP Hvv; apply/allP=>v//=. 442 | move=>/mapP[[v' ind']] /mem_zip/andP [ Hv' Hind'] ->. 443 | rewrite /HashVec.Hash.hashstate_put. 444 | apply fixedlist_add_incr. 445 | by move: (Hvv v' Hv'); rewrite addnS. 446 | Qed. 447 | 448 | 449 | Lemma AMQHash_hashstate_add_contains_preserve: forall (key key': AMQHashKey) (value value': AMQHashValue p), 450 | AMQHash_hashstate_valid hashstate -> 451 | AMQHash_hashstate_available_capacity hashstate 1 -> 452 | key != key' -> AMQHash_hashstate_contains hashstate key value -> 453 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key' value') key value. 454 | Proof. 455 | rewrite /AMQHash_hashstate_available_capacity/HashVec.hashes_have_free_spaces//=. 456 | move=> key key' value value' _ /allP Hfree Hknew. 457 | apply HashVec.hash_vec_contains_value_preserve => //=. 458 | Qed. 459 | 460 | 461 | Lemma AMQHash_hashstate_add_contains_base: forall (key: AMQHashKey) (value: AMQHashValue p), 462 | AMQHash_hashstate_valid hashstate -> 463 | AMQHash_hashstate_available_capacity hashstate 1 -> 464 | AMQHash_hashstate_contains (AMQHash_hashstate_put hashstate key value) key value. 465 | Proof. 466 | move=> key value _ Hfree. 467 | apply HashVec.hash_vec_contains_value_base => //=. 468 | Qed. 469 | 470 | 471 | Lemma AMQHash_hashstate_add_valid_preserve: forall (key: AMQHashKey) (value: AMQHashValue p), 472 | AMQHash_hashstate_valid hashstate -> 473 | AMQHash_hashstate_available_capacity hashstate 1 -> 474 | AMQHash_hashstate_valid (AMQHash_hashstate_put hashstate key value). 475 | Proof. 476 | by []. 477 | Qed. 478 | 479 | 480 | Lemma AMQHash_hashstate_unseenE: forall (hashstate': AMQHash p) (key key': AMQHashKey) (value': AMQHashValue p), 481 | key != key' -> 482 | AMQHash_hashstate_unseen hashstate key -> 483 | hashstate' = AMQHash_hashstate_put hashstate key' value' -> 484 | AMQHash_hashstate_unseen hashstate' key. 485 | Proof. 486 | move=>hsh key key' value' Hkneq /allP Hunseen ->//=. 487 | apply/allP => v /mapP [[v' ind']]//=/mem_zip/andP[Hv' Hind']->. 488 | move: (Hunseen v' Hv'). 489 | apply fixmap_find_neq => //=. 490 | Qed. 491 | 492 | End DeterministicOperations. 493 | 494 | Lemma AMQHash_hash_unseen_insert_eqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 495 | AMQHash_hashstate_unseen hashstate key -> hashstate' = AMQHash_hashstate_put hashstate key value -> 496 | d[ AMQHash_hash hashstate key ] (hashstate', value) = AMQHash_probability p. 497 | Proof. 498 | move=>hsh hsh' key value Hunseen ->. 499 | rewrite/AMQHash_hash. 500 | rewrite HashVec.hash_vecP //=. 501 | Qed. 502 | 503 | Lemma AMQHash_hash_unseen_insert_neqE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value: AMQHashValue p), 504 | AMQHash_hashstate_unseen hashstate key -> hashstate' != AMQHash_hashstate_put hashstate key value -> 505 | d[ AMQHash_hash hashstate key ] (hashstate', value) = 0. 506 | Proof. 507 | move=>hsh hsh' key value Hunseen Hneq. 508 | rewrite HashVec.neg_hash_vecP //=. 509 | Qed. 510 | 511 | Lemma AMQHash_hash_seen_insertE: forall (hashstate hashstate': AMQHash p) (key: AMQHashKey) (value value': AMQHashValue p), 512 | AMQHash_hashstate_contains hashstate key value -> 513 | d[ AMQHash_hash hashstate key ] (hashstate', value') = ((hashstate' == hashstate) && (value' == value)). 514 | Proof. 515 | move=> hsh hsh' key value value' Hcontains. 516 | rewrite (@HashVec.hash_vec_find_simpl _ _ _ _ _ value)//=. 517 | by rewrite RIneq.INR_IZR_INZ//=. 518 | Qed. 519 | 520 | End AMQHash. 521 | End BasicHashVec. 522 | --------------------------------------------------------------------------------