(** * Structures/BloomFilter/BloomFilter_Probability.v
-----------------

Proves the standard properties required to instantiate the
AMQProperties interface for a Bloom Filter - i.e proving false
negative and false positive rates of a BloomFilter using the
definitions defined in
[Structures/BloomFilter/BloomFilter_Definitions.v].  *)

From mathcomp.ssreflect Require Import
     ssreflect ssrbool ssrnat eqtype fintype
     choice ssrfun seq path bigop finfun binomial.

From mathcomp.ssreflect Require Import tuple.

From mathcomp Require Import path.

From infotheo Require Import
      fdist ssrR Reals_ext logb ssr_ext ssralg_ext bigop_ext Rbigop proba.

Require Import Coq.Logic.ProofIrrelevance.
Require Import Coq.Logic.FunctionalExtensionality.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

From ProbHash.Computation
     Require Import Comp Notationv1.

From ProbHash.Core
     Require Import Hash HashVec  FixedList  FixedMap.

From ProbHash.Utils
     Require Import InvMisc seq_ext seq_subset rsum_ext stirling tactics.

From ProbHash.BloomFilter
     Require Import BloomFilter_Definitions.

Open Scope R_scope.

Module BloomFilterProbability (Spec: HashSpec).

  Module BloomfilterCore :=  (BloomFilterAMQ Spec).
  Module BloomfilterDefinitions :=  BloomfilterCore.BloomFilterDefinitions.
  Module BasicHashVec :=  BloomfilterCore.BasicHashVec.
  Module BloomfilterAMQ :=  BloomfilterCore.AMQ.
  Module BloomfilterOperations :=  AMQ.AMQOperations (BasicHashVec)  (BloomfilterCore.AMQ).

  Export BloomfilterDefinitions.
  Export BasicHashVec.
  Export BloomfilterAMQ.
  Export BloomfilterOperations.

  Section BloomFilter.
  (**
    k - number of hashes
   *)
  Variable k: nat.
  (**
    n - maximum number of hashes supported
   *)
  Variable n: nat.
  (** k must be valid *)
  Variable Hkgt0: k >0.

  Lemma bloomfilter_add_internal_prob bf x l:
    ~~ tnth (bloomfilter_state bf) x ->
    \sum_(b in [finType of l.-tuple 'I_Hash_size.+1])
     ((tnth (bloomfilter_state (bloomfilter_add_internal b bf)) x %R) *R*
      ((Rdefinitions.Rinv (Hash_size.+1)%:R) ^R^ l)) =
    (1 -R- ((1 -R- Rdefinitions.Rinv (Hash_size.+1)%:R) ^R^ l)).
  Proof.
    elim: l x bf=> [|l IHl] x bf Hnth //=.
    - {
        by rewrite rsum_empty mulR1 subRR;
             move/Bool.negb_true_iff: Hnth => //= ->; rewrite //= mul0R add0R.
      }
    - {
        rewrite rsum_tuple_split rsum_split//=.
        rewrite (bigID (fun a => a == x)) big_pred1_eq //=.

        under eq_bigr => b _ do
        (rewrite bloomfilter_add_internal_preserve; first rewrite mul1R;
          last by rewrite /bloomfilter_set_bit/bloomfilter_state FixedList.tnth_set_nth_eq).
        rewrite bigsum_card_constE//=.
        under eq_bigr => i Hneq do under eq_bigr => ? _ do rewrite mulRA mulRC mulRA mulRC.
        under eq_bigr => i Hneq do (rewrite -rsum_Rmul_distr_l; under eq_bigr => ? _ do rewrite mulRC).
        under eq_bigr => i Hneq do ( rewrite IHl; last by rewrite (FixedList.tnth_set_nth_neq) //=  eq_sym).
        rewrite bigsum_card_constE//= card_tuple  cardC1 card_ord //=.
        have->: (((Hash_size.+1 ^ l %R) *R*
                  (Rdefinitions.Rinv (Hash_size.+1 %R) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l))) =
                 Rdefinitions.Rinv (Hash_size.+1 %R)
                ).
        {
          rewrite -{3}(mulR1 (Rdefinitions.Rinv _)) mulRA mulRC mulRA mulRC ; apply f_equal.
          rewrite -natRexp; clear; elim: l => [|l IHl] //=; rewrite ?mulR1//=.
          transitivity (
              (Rdefinitions.Rinv (Hash_size.+1 %R) *R* (Hash_size.+1 %R)) *R*
              (((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l)) *R* (((Hash_size.+1 %R) ^R^ l)))
            ).
          {
            rewrite -mulRA -mulRA mulRC mulRA mulRC; apply f_equal.
            rewrite  mulRC mulRA mulRC; apply f_equal.
              by rewrite mulRC.
          }
          rewrite !Raxioms.Rinv_l ?mul1R ?IHl //=.
            by apply RIneq.not_0_INR =>//=.
        }
        rewrite !RIneq.Rmult_minus_distr_l addRA //= mulR1.
        rewrite -{1}(mul1R (Rdefinitions.Rinv _)) -RIneq.Rmult_plus_distr_r.
        have: (Rdefinitions.IZR 1 = (1 %R)); last move=>->; first by [].
        rewrite -natRD add1n RIneq.Rinv_r //= .
        rewrite addR_opp mulRA.
        have->: (((Hash_size %R) *R* Rdefinitions.Rinv (Hash_size.+1 %R))) =
        ((1 %R) -R- Rdefinitions.Rinv (Hash_size.+1 %R)).
        {
          rewrite -{2}(mulR1 (Rdefinitions.Rinv _)) //=.
          have: (1 %R) = Rdefinitions.IZR 1; last move=>->; first by [].
          rewrite -{1}(RIneq.Rinv_r (Hash_size.+1 %R)).
          rewrite [(_.+1 %R) *R* Rdefinitions.Rinv _]mulRC.
          rewrite -(RIneq.Rmult_minus_distr_l).
          have: (Rdefinitions.IZR 1 = (1 %R)); last move=>->; first by [].
            by rewrite -natRB //= subn1 //= mulRC.
              by apply RIneq.not_0_INR =>//=.
        }
        have->: (1 %R) = Rdefinitions.IZR 1; by [].
          by apply RIneq.not_0_INR =>//=.
      }
  Qed.

  Lemma bloomfilter_addn (hashes: AMQHash (n,k.-1)) (ind: 'I_(Hash_size.+1)) (bf: AMQState I) (value: B):
    (* provided the bloom filter is not full *)
    AMQHash_hashstate_available_capacity hashes 1 ->
    (* and that the bloom filter has not set the value *)
    AMQHash_hashstate_unseen hashes value ->
    (* the bit in question is not set  *)
    ~~ bloomfilter_get_bit ind bf ->
    P[
        (
          (* bf' is the result of inserting into bf *)
          res <-$ AMQ_add  bf hashes value;
            let: (new_hashes, bf') := res in
            (* the probability of the given bit being set is *)
            ret (~~ bloomfilter_get_bit ind bf')
        )
      ] =
    ((1 -R- Rdefinitions.Rinv (Hash_size.+1)%:R) ^R^ k).
  Proof.
    rewrite /AMQ_add/AMQHash_hashstate_available_capacity
            /AMQHash_hashstate_unseen/HashVec.hash_unseen
            /hash_not_full /bloomfilter_get_bit  => /allP Hnfl /allP Husn Hunset //= .
    time comp_normalize.
    time comp_simplify.
    rewrite exchange_big //=.
    move: (Hpredkvld Hkgt0).
    move:  Hkgt0 hashes Hnfl Husn; rewrite /AMQHash //=.
    elim: k   => //=; clear k Hkgt0; case=> [ _  |k IHk] Hkgt0 hashes Hnfl Husn.
    {
      - move=> _ //=.
        rewrite mulR1.
        comp_normalize.
        rewrite /HashVec.Hash.hash/HashVec.Hash.hashstate_find.
        have Hthead: (thead hashes) \in hashes; first by clear; rewrite (tuple_eta hashes) theadE//=; apply mem_head.
        move/eqP: (Husn (thead hashes) Hthead) ->.
        rewrite exchange_big (bigID (fun values'' => values'' == ind)).
        have H x y z: y = (0 %R) -> x = z -> y +R+ x = z; first by move=> -> ->; rewrite add0R.
        apply H.
        {
          - apply prsumr_eq0P => ind' /eqP ->; first by dispatch_Rgt.
            move: (@bloomfilter_add_internal_hit bf ind (ind :: [::]) );
              rewrite/bloomfilter_state/bloomfilter_add_internal => //= ->.
            apply prsumr_eq0P => i' _; first by dispatch_Rgt.
              by rewrite mul0R.
                by apply mem_head.
        }
        transitivity (
          \sum_(i in 'I_Hash_size.+1 | i != ind)
           \sum_(i0 in hashstate_of_finType n)
           ((d[ rnd <-$ gen_random; ret (hashstate_put n value rnd (thead hashes), rnd)]) (i0, i))
        ).
        {
          - apply eq_bigr => ind' /andP [_ Hnind].
            apply eq_bigr => vl _.
            move: (@bloomfilter_add_internal_miss  bf ind (ind' :: [::])); rewrite /bloomfilter_state/bloomfilter_add_internal => //= ->.
              by rewrite eq_refl //= mul1R.
                by [].
                  by rewrite mem_seq1 eq_sym.
        }
        comp_normalize.
        comp_simplify.
        apply prsumr_sans_one => //=.
          by rewrite card_ord.
          rewrite bigsum_card_constE card_ord RIneq.Rinv_r //=.
            by apply RIneq.not_0_INR => //=.
    }
    (* Base case completed *)
    - {
        move=> Hpredkvld.
        rewrite -(IHk _ (FixedList.ntuple_tail hashes)); clear IHk; last first.
        { - by rewrite -pred_Sn. }
        {
          - destruct hashes eqn: Hhashes => ls.
            clear Hnfl; move: tval i Hhashes Husn => [//= | x [//=| y xs]] Hprf Heq Hnfl.
            rewrite FixedList.ntuple_tail_coerce => Hin; apply Hnfl => //=.
              by move: Hin; rewrite [ls \in [:: x, y & xs]]in_cons /tval => ->; rewrite Bool.orb_true_r.
        }
        {
          - destruct hashes eqn: Hhashes => ls.
            clear Husn; move: tval i Hhashes Hnfl => [//= | x [//= | y xs]] Hprf Heq Husn.
            rewrite FixedList.ntuple_tail_coerce => Hin; apply Husn => //=.
              by move: Hin; rewrite [ls \in [:: x, y & xs]]in_cons /tval => ->; rewrite Bool.orb_true_r.
        }
        { - by apply ltn0Sn. }
        {
          move=> //=.
          comp_normalize.
          move=>//=.
          comp_simplify_n 1.
          comp_simplify_n 1.
          exchange_big_outwards 3.
          apply eq_bigr => result _.
          exchange_big_outwards 2 => //=.
          rewrite rsum_Rmul_distr_l.
          apply eq_bigr => exp_hashes _.
          rewrite rsum_Rmul_distr_l.
          exchange_big_outwards 2.
          apply eq_bigr => exp_hashes' _//=.
          rewrite rsum_Rmul_distr_l.
          exchange_big_outwards 2.
          apply eq_bigr => inds _//=.
          apply Logic.eq_sym.
          comp_normalize=> //=.
          rewrite mulRA mulRC -!mulRA.
          apply Logic.eq_sym.
          under_all ltac:(rewrite  !mulRA mulRC mulRA mulRC).
          under eq_bigr do rewrite -rsum_Rmul_distr_l;  rewrite -rsum_Rmul_distr_l.
          apply f_equal => //=.
          under eq_bigr do rewrite -rsum_Rmul_distr_l;  rewrite -rsum_Rmul_distr_l.
          apply f_equal => //=.
          apply Logic.eq_sym.
          have H:(thead hashes \in hashes); first by rewrite (tuple_eta hashes) in_cons theadE eq_refl //=.
          under_all ltac:(rewrite  /HashVec.Hash.hash/HashVec.Hash.hashstate_find; move/eqP: (Husn _ H) => ->); clear H.
          comp_normalize.
          comp_simplify.
          rewrite (bigID (fun i => i == ind)) //=.
          apply Logic.eq_sym.
          have H x y z: x = (0 %R) -> y = z -> x +R+ y = z; first by move=> -> -> //=; rewrite add0R.
          apply H.
          {
            - apply prsumr_eq0P => i /eqP ->; first by do?dispatch_eq0_obligations.
              rewrite eq_sym eqb_id/AMQ_add_internal//=.
              rewrite bloomfilter_add_internal_preserve; first by rewrite //= mul0R.
              rewrite bloomfilter_set_bitC.
              rewrite/bloomfilter_state/bloomfilter_set_bit//=.
              by rewrite tnth_set_nth_eq //=.
          }
          under eq_bigr => ? ? do rewrite eq_sym eqb_id.
          apply Logic.eq_sym; rewrite  eq_sym eqb_id; apply Logic.eq_sym.
          case Hind: (ind \in result).
          {
            - rewrite !bloomfilter_add_internal_hit //= ?mulR0.
              apply prsumr_eq0P => hshs' _; first (by do ?dispatch_eq0_obligations).
                rewrite bloomfilter_add_internal_hit //= ?mul0R //=.
                by rewrite !in_cons Hind !Bool.orb_true_r.
                by rewrite !in_cons Hind !Bool.orb_true_r.
          }
          case Hres: (inds == ind).
          {
            rewrite /AMQ_add_internal //=.
            move/eqP:Hres ->; rewrite bloomfilter_add_internal_preserve;
              last by move: (bloomfilter_set_get_eq ind bf); rewrite /bloomfilter_get_bit.
            rewrite //= mulR0.
            apply prsumr_eq0P => i Hineq;  first by do?dispatch_eq0_obligations.
            rewrite bloomfilter_add_internal_preserve; first (by rewrite //= mul0R);
              last by move: (bloomfilter_set_get_eq ind (bloomfilter_set_bit i bf)); rewrite /bloomfilter_get_bit.
          }
          rewrite /AMQ_add_internal //=.
          rewrite bloomfilter_add_internal_miss; [
          | by move/Bool.negb_true_iff:
                 Hres => Hres; rewrite/bloomfilter_state/bloomfilter_set_bit tnth_set_nth_neq 1?eq_sym//=
          | by move/Bool.negb_true_iff:Hind]; rewrite mulR1.
          under eq_bigr => i Hi.
          {
            rewrite bloomfilter_add_internal_miss;
              by [ rewrite //= mul1R; over
                 | move/Bool.negb_true_iff:
                     Hres => Hres; rewrite/bloomfilter_state/bloomfilter_set_bit !tnth_set_nth_neq 1?eq_sym //=
                 |  move/Bool.negb_true_iff:Hind ].
          }
          apply prsumr_sans_one => //=.
            by rewrite card_ord.
            rewrite bigsum_card_constE card_ord RIneq.Rinv_r //=.
              by apply RIneq.not_0_INR => //=.
        }
      }
      (* DONE!!!! *)
  Qed.

  Lemma bloomfilter_add_multiple_unfold A (hshs: AMQHash (n,k.-1)) bf x xs (f: _ -> Comp A):
    d[ res <-$ AMQ_add_multiple hshs bf (x :: xs);
         f (res) ] =
    d[
        res1 <-$ AMQ_add_multiple hshs bf xs;
          let (hshs', bf') := res1 in
          res2 <-$ @AMQ_add _ I bf' hshs' x;
            f (res2)
      ].
  Proof.
    apply fdist_ext => a //=.
    rewrite FDistBindA //=.
      by rewrite !FDistBind.dE; apply eq_bigr => [[hshs' bf']] _; apply f_equal => //=.
  Qed.

  Lemma bloomfilter_add_multiple_find_preserve value  inds
        (hashes hashes': AMQHash (n,k.-1)) (bf bf': AMQState I) xs:
    AMQHash_hashstate_contains hashes  value inds ->
    ((d[ AMQ_add_multiple hashes bf xs]) (hashes', bf') != (0 %R)) ->
    hash_vec_contains_value value hashes' inds.
  Proof.
    move=> Hcontains.
    elim: xs hashes inds  Hcontains hashes' bf' => [//=| x xs IHxs] hashes inds Hcontains hashes' bf'.
    - {
        rewrite FDist1.dE xpair_eqE.
        case Hhashes: ((hashes') == _) => /eqP //= /eqP.
        case Hbf: ((bf') == _) => /eqP //= /eqP _.
          by move/eqP: Hhashes -> .
      }
    - {
        move=> //=. rewrite FDistBind.dE //= rsum_split // /AMQ_add.
        comp_possible_decompose => hashes_internal' bf_prev Heq0.
        rewrite/AMQHash_hash //.
        have H (T T1 T2:finType) (f: Comp T)
             (g: T -> Comp [finType of (T1 * T2)]) a b:
          ((d[ hash_res <-$ f; (g hash_res)])) (a,b) =
          FDistBind.d (d[ f]) (fun b0 : T => d[ g b0]) (a, b); first by [].
        rewrite H; clear H; rewrite FDistBind.dE rsum_split //.
        comp_possible_decompose => inds' inds''.
        have H: (let x0 := (inds', inds'') in
                 (d[ HashVec.hash_vec_int x hashes_internal']) x0 *R*
                 (d[ let (new_hashes, hash_vec) := x0 in
                     ret (new_hashes, AMQ_add_internal bf_prev hash_vec)])
                   (hashes', bf')) =
                ((d[ HashVec.hash_vec_int x hashes_internal'])
                   (inds',inds'') *R*
                 (d[ ret (inds', AMQ_add_internal bf_prev inds'')])
                   (hashes', bf')); first by [].
        rewrite H; clear H.
        comp_possible_decompose => Hhashes //=; rewrite FDist1.dE.
        move=>/bool_neq0_true; rewrite xpair_eqE=>/andP[/eqP -> _].
        move: Heq0 => //= /IHxs Heq0.
        move: (Heq0 _ Hcontains); clear Heq0 => Hcontains_internal.
            case Hneq: (value == x).
            - {
                move: Hcontains_internal Hhashes.
                move/eqP: Hneq <- =>Hcontains_internal.
                rewrite/HashVec.Hash.hash.
                erewrite hash_vec_find_simpl =>//=; last by exact Hcontains_internal.
                move=>/eqP; rewrite RIneq.INR_IZR_INZ; case Hand: (_ && _) => //= _.
                move/andP: Hand => [/eqP ->] //=.
              }
              move/Bool.negb_true_iff: Hneq => Hneq.
              move: Hneq Hcontains_internal Hhashes; clear.
              move: k inds inds'' hashes_internal' inds';clear k.
              rewrite /AMQHashValue/AMQHash => k.
              change ((n, k.-1).2.+1) with (k.-1.+1).
              change ((n, k.-1).1) with (n).
              elim (k.-1.+1) => [ //=| ]; clear k; last move=> k IHk.
            - {
                do 5!intro; rewrite !tuple0 //= FDist1.dE xpair_eqE => H3.
                by move=>/bool_neq0_true/andP[/eqP -> _] //=.
              }
            - {
                move=> [[//=| ind inds] Hinds] [[//=| hash hashes] Hhashes] [[//=| hash' hashes'] Hhashes'].
                move=> [[//=|ind' inds'] Hinds'] Hneq.
                comp_normalize.
                  rewrite
                  (tuple_eta (Tuple Hhashes'))
                  (tuple_eta (Tuple Hinds))
                  (tuple_eta (Tuple Hhashes))
                  (tuple_eta (Tuple Hinds')).
                rewrite !ntuple_tailE theadE//=.
                have->: ( thead (Tuple Hhashes)) = hash; first by [].
                have->: ( thead (Tuple Hhashes')) = hash'; first by [].
                have->: ( thead (Tuple Hinds)) = ind; first by [].
                have->: ( thead (Tuple Hinds')) = ind'; first by [].
                rewrite/hash_vec_contains_value //= => /andP[Hfind Hcontains].
                comp_possible_decompose.
                move=> b' b hsh_val ind_val Hint Hhash .
                rewrite !xpair_eqE !cons_tuple_eq_tuple !xcons_eqE.
                move=>/bool_neq0_true/andP [/andP [/eqP Hhsheq /eqP Htupleeq] /andP [/eqP Hindeq /eqP Hindstupleeq]].
                have Hcont':
                  hash_vec_contains_value value (behead_tuple (Tuple Hhashes')) (FixedList.ntuple_tail (Tuple Hinds));
                  first by rewrite/hash_vec_contains_value //=.
                move:
                  (IHk (FixedList.ntuple_tail (Tuple Hinds))  b (behead_tuple (Tuple Hhashes')) b' Hneq Hcont' Hint);

                  clear IHk; rewrite/hash_vec_contains_value //= -Htupleeq => ->; rewrite Bool.andb_true_r.
                move:  Hneq Hfind Hhash.
                rewrite Hhsheq /HashVec.Hash.hash; clear.
                case: ( HashVec.Hash.hashstate_find n x hash') => //=.
                - {
                    move=> ind_val' Hneq; rewrite FDist1.dE xpair_eqE=> Hfind'/eqP.
                    case Hand: (_ && _) => //= _.
                      by move/andP: Hand => [/eqP ->] //=.
                  }
                - {
                    move=> Hneq Hfind //=; comp_normalize.
                    comp_possible_decompose.
                    move=> ind1 ind2 /bool_neq0_true; rewrite xpair_eqE=>/andP[/eqP-> /eqP <-] _/bool_neq0_true/eqP ->.
                    move: Hneq Hfind; clear.
                    move=> Hvalue.
                    move: n hash';clear n; elim => [//=|n IHn] [[//=| hash hashes] Hhashes].
                    rewrite (tuple_eta (Tuple Hhashes)) //=.
                    rewrite /FixedList.ntuple_head !theadE  !ntuple_tailE.
                    have->: (thead (Tuple Hhashes)) = hash; first by [].
                    case: hash Hhashes => [[k' v']|] Hhashes //=.
                    case Heq: (k' == value)=>//=.
                    - {
                        move/eqP: Heq ->.
                        move/Bool.negb_true_iff: Hvalue -> => //=.
                          by rewrite ntuple_head_consE eq_refl.                                  }
                    - {
                        move=> Hin; move: (Hin).
                        move=>/IHn Heq'.
                        case Hkeq: (k' == x) => //=.
                        - {
                            move/eqP:Hkeq <-; rewrite Heq //=; move: Hin.
                            rewrite/FixedList.ntuple_tail/behead_tuple.
                            move: (behead_tupleP _) => //= H1.
                            move: (behead_tupleP _) => //= H2.
                              by rewrite (proof_irrelevance _ H2 H1) //=.
                          }
                        - {
                              by rewrite ntuple_head_consE Heq ntuple_tail_consE.
                          }
                      }
                    - {
                        rewrite eq_sym in Hvalue; move/Bool.negb_true_iff: (Hvalue) -> => //=.
                        rewrite/FixedList.ntuple_tail/behead_tuple.
                        move: (behead_tupleP _) => //= H1.
                        move: (behead_tupleP _) => //= H2.
                          by rewrite (proof_irrelevance _ H2 H1) //=.
                      }
                  }
              }
          }
  Qed.

  Lemma bloomfilter_add_multiple_preserve x xs l m hshs hshs' bf bf'
        (Huniq: uniq (x :: xs))
        (Hlen: length xs == l)
        (Hfree: hashes_have_free_spaces hshs  ((l+m).+1))
        (Huns:      all (hashes_value_unseen hshs) (x :: xs)):
    ((d[ @AMQ_add_multiple (n,k.-1) I hshs bf xs]) (hshs', bf') != (0 %R)) ->
    (hashes_have_free_spaces hshs' (m.+1)) && (hashes_value_unseen hshs' x).
  Proof.
    (* First clean up the proof *)
    move: hshs hshs' bf bf' Hfree Huns.
    rewrite/AMQHash/AMQState.
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    move => hshs hshs' bf bf' Hfree Huns.
    move=> //=.
    rewrite -all_predI /predI //=.
    move: m hshs Hfree Huns bf bf' hshs'.
    move/eqP: Hlen <-; clear l.
    have all_cons P y ys : all P (y :: ys) =  P y && all P ys. by [].
    move=> m hshs Hfree; rewrite all_cons => /andP []; move: x m hshs Huniq Hfree; clear all_cons.
    rewrite/hashes_have_free_spaces/hash_has_free_spaces/hashes_value_unseen/hash_unseen.
    (* proof has been cleaned up *)
    elim: xs => [//= | y ys IHy] x m hshs Huniq /allP Hfree /allP Huns Hx  bf bf' hshs'.
    - comp_normalize=>/bool_neq0_true; rewrite xpair_eqE =>/andP[/eqP -> _].
      apply /allP=> hsh Hin //=; apply/andP; split; by [apply Hfree | apply Huns].
    - move: Hx; have all_cons P z zs : all P (z :: zs) =  P z && all P zs. by [].
      rewrite all_cons => /andP [/allP Hfindy /allP Hfindys].
      have H1: uniq (x :: ys); first
        by move: Huniq => //=/andP [Hcons /andP [_ ->]]; move: Hcons; rewrite !in_cons Bool.negb_orb=>/andP[_ ->].
      have H2: all (fun hsh : HashState n => FixedList.fixlist_length hsh + (length ys + m.+1).+1 <= n) hshs;
        first by apply/allP => vec Hvec; move: (Hfree vec Hvec) => //=; rewrite addSn !addnS.
      have H3: all (fun hsh : HashState n => FixedMap.fixmap_find x hsh == None) hshs;
        first by apply /allP.
      have H4: all (fun b : B => all (fun hsh : HashState n => FixedMap.fixmap_find b hsh == None) hshs) ys;
        first by apply/allP.
      move: (IHy x m.+1 hshs H1 H2 H3 H4); clear IHy H1 H2 H3 H4 => IHy.
      move=>//=; rewrite FDistBind.dE rsum_split //.
      comp_possible_decompose => d_hshs' d_bf.

      have ->:
        (let x0 := (d_hshs', d_bf) in
         (d[ @AMQ_add_multiple (n,k.-1) I hshs bf ys]) x0 *R*
         (d[ let (hsh, bf0) := x0 in @AMQ_add (n,k.-1) I bf0 hsh y]) (hshs', bf')) =
        ((d[ @AMQ_add_multiple (n,k.-1) I hshs bf ys]) (d_hshs',d_bf) *R*
         (d[ @AMQ_add (n,k.-1) I d_bf d_hshs' y]) (hshs', bf')); first by [].
      rewrite /AMQ_add.
      have H (T T1 T2:finType) (f: Comp T)
             (g: T -> Comp [finType of (T1 * T2)]) a b:
          ((d[ hash_res <-$ f; (g hash_res)])) (a,b) =
          FDistBind.d (d[ f]) (fun b0 : T => d[ g b0]) (a, b); first by [].
      rewrite H; clear H.
      rewrite FDistBind.dE.
      rewrite mulR_neq0' => /andP[ Haddm ].
      comp_possible_decompose => [[d_hshs'' d_ind]].
      rewrite/AMQHash_hash => Hint //=.
      comp_normalize.
      move: Haddm Hint.
      move=>/(IHy).
      clear IHy all_cons bf Hfree Huns Hkgt0 Hfindys .
      move=> Hall Hint /bool_neq0_true; rewrite xpair_eqE=>/andP[/eqP -> _].
      clear hshs'.
      move: k d_hshs' d_hshs'' d_ind Hint Hall; clear hshs Hfindy k=>k.
      rewrite/AMQHash/AMQState/AMQHashValue.
      change ((n, k.-1).2.+1) with (k.-1.+1).
      change ((n, k.-1).1) with n.
      elim: (k.-1.+1); clear k.
    - by move=> hs1 hs2 vec1 //=; comp_normalize => /bool_neq0_true; rewrite xpair_eqE=>/andP[/eqP -> _] //=.
    - move=> k IHk hs1 hs2 vec1 //=; comp_normalize; comp_possible_decompose.
      move=> hs3 vec2 state1 ind1.
      move=>/IHk;clear IHk => IHk Hhash /bool_neq0_true; rewrite xpair_eqE => /andP[/eqP -> _ ] //= Hall.
      move: Hhash; rewrite/HashVec.Hash.hash/HashVec.Hash.hashstate_find.
      have Hthead: (thead hs1 \in hs1); first by rewrite (tuple_eta hs1) theadE in_cons eq_refl //=.
      case: (FixedMap.fixmap_find _ _) => [val //=|].
      - {
          comp_normalize => /bool_neq0_true; rewrite xpair_eqE => /andP[/eqP -> _]; apply/andP; split => //=.
          - by move/allP: Hall => /(_ _ Hthead) //=; rewrite !addnS => /andP [/ltnW -> ->] //=.
          -  apply IHk; apply/allP => v Hin; move/allP:Hall => Hall; apply/Hall.
             by move: Hin; rewrite (tuple_eta hs1) ntuple_tailE in_cons => ->; apply/orP; right.
      }
      - {
          comp_normalize; comp_possible_decompose
          => ind2 ind3 /bool_neq0_true;rewrite xpair_eqE=>/andP[/eqP -> Hind'] Hinv /bool_neq0_true/eqP ->.
          apply/andP;split;last first.
          - apply IHk; apply/allP => v Hv //=; move/allP:Hall => Hall; apply/Hall.
              by move: Hv; rewrite (tuple_eta hs1) ntuple_tailE in_cons => ->; apply/orP; right.
          - move/allP: Hall => /(_ _ Hthead) //= /andP[].
            rewrite !addnS -addSn addnC -ltn_subRL => Hlen Hfind; apply/andP;split.
            {
              rewrite addnC -ltn_subRL.
              apply (@leq_ltn_trans  (FixedList.fixlist_length (thead hs1)).+1) => //=.
              clear Hlen IHk Hthead hs2 hs3 state1; move: (thead _) => [ls Hls]; clear hs1 Hfind.
              elim: n ls Hls => [//=|]; clear n => n IHn [//=|l ls] Hls //=.
              have->: (FixedList.ntuple_head (Tuple Hls)) = l; first by [].
              case: l Hls => [[k' v']|] Hls; last first; last case Heq: (_ == _).
              - by move: Hls (eq_ind _ _ _ _ _) => //=.
              - by move: Hls (eq_ind _ _ _ _ _) => //= Hls Hls'.
              - {
                  rewrite /FixedList.ntuple_tail; move: (behead_tupleP _) => //= Hls'.
                  move: (IHn ls Hls') => IHn'.
                  rewrite/FixedList.fixlist_length/FixedList.ntuple_cons.
                    by case Hput: ( HashVec.Hash.hashstate_put _) => [ms Hms] //=; move: IHn';rewrite Hput.
                }
            }
            {
              rewrite /hashstate_put.
              move: Huniq => //=/andP[];rewrite in_cons Bool.negb_orb=>/andP[Hneq _ _].
                by rewrite fixmap_find_neq //=.
            }
        }
  Qed.

  Lemma bloomfilter_addn_Nuns  ind bf hashes x :
    bloomfilter_get_bit ind bf ->
    (d[ res <-$ @AMQ_add (n,k.-1) I bf hashes x;
          (let '(_, bf') := res in ret ~~ bloomfilter_get_bit ind bf')]) true = (0 %R).
  Proof.
    move: hashes bf; rewrite /AMQHash/AMQ_add/AMQHash_hash/AMQ_add_internal/AMQHashValue.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hashes bf.
    move=> Htnth; comp_normalize.
    comp_impossible_decompose.
    move=> hashes' _ bf' _ hashes'' _ hvec _ Hnbit /eqP <- /eqP Hbf; clear hashes''.
    move: Hbf Hnbit => ->; clear bf'.
    rewrite/bloomfilter_get_bit.
      by rewrite bloomfilter_add_internal_preserve //=.
  Qed.

  Lemma bloomfilter_addn_insert_multiple hashes l (ind: 'I_Hash_size.+1) (bf: BloomFilter) (values: seq B):
    length values == l ->
    hashes_have_free_spaces hashes l ->
    all (hashes_value_unseen hashes) values ->
    uniq values ->
    ~~ bloomfilter_get_bit ind bf ->
    (d[ res <-$ @AMQ_add_multiple (n,k.-1) I  hashes bf values;
          (let '(_, bf') := res in ret ~~ bloomfilter_get_bit ind bf')]) true =
    ((1 -R- Rdefinitions.Rinv (Hash_size.+1 %R)) ^R^ (k * l)).
  Proof.
    move: hashes bf bloomfilter_add_multiple_preserve bloomfilter_addn bloomfilter_addn_Nuns ;
      rewrite /AMQHash/AMQ_add/AMQHash_hash/AMQ_add_internal/AMQHashValue;
    rewrite/AMQHash_hashstate_available_capacity/AMQHash_hashstate_unseen.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    move=> hashes bf bloomfilter_add_multiple_preserve bloomfilter_addn bloomfilter_addn_Nuns .
    elim: l ind bf values hashes => [|l IHl] ind bf values hashes0 .
    {
      case: values => //= _ _ _ _ Htnth; rewrite muln0; comp_normalize.
      - by comp_simplify; rewrite eq_sym eqb_id; rewrite Htnth.
    }
    {
    - rewrite mulnS.
      case: values => [//= | x xs] Hlen Hfree Huns Huniq Hnb.
      rewrite bloomfilter_add_multiple_unfold.
      rewrite RealField.Rdef_pow_add.
      erewrite <- (IHl ind bf xs hashes0) => //=; clear IHl.
      rewrite mulRC.
      rewrite FDistBind.dE rsum_split.
      move: bloomfilter_addn_Nuns  (bloomfilter_add_multiple_preserve x xs l 0 hashes0) bloomfilter_addn; clear bloomfilter_add_multiple_preserve.
      rewrite/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash.
      change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
      change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
      change ((n, k.-1).2.+1) with (k.-1.+1).
      change ((n, k.-1).1) with n.
      move: hashes0 Hfree Huns .
      rewrite (@prednK k Hkgt0).
      move=> hashes0 Hfree Huns bloomfilter_addn_Nuns bloomfilter_add_multiple_preserve bloomfilter_addn.
      comp_normalize.
      exchange_big_outwards 2 => //=; exchange_big_outwards 3 => //=.
      comp_simplify_n 1.
      comp_simplify_n 1.
      apply eq_bigr => hshs' _; apply eq_bigr => bf' _.
      move=>//=.
      under eq_bigr do rewrite -rsum_Rmul_distr_l; rewrite -rsum_Rmul_distr_l.
      move: (@bloomfilter_add_multiple_preserve hshs' bf bf'); clear bloomfilter_add_multiple_preserve.
      set bloomfilter_add_multiple :=
        foldr
         (fun val : AMQHashKey =>
          (Bind
             (B:=[finType of k.-tuple (HashVec.Hash.HashState n) *
                             BloomfilterCore.BloomFilterDefinitions.BloomFilter]))^~
          (fun
             res_1 : k.-tuple (HashVec.Hash.HashState n) *
                     BloomfilterCore.BloomFilterDefinitions.BloomFilter =>
           let (hsh, bf0) := res_1 in
           hash_res <-$ HashVec.hash_vec_int val hsh;
           (let (new_hashes, hash_vec) := hash_res in
            ret (new_hashes,
                BloomfilterCore.BloomFilterDefinitions.bloomfilter_add_internal hash_vec bf0))))
         (ret (hashes0, bf)) xs.
      move=> bloomfilter_add_multiple_preserve.
      case Hnz: (d[ bloomfilter_add_multiple ] (hshs', bf') == (0 %R));
        first by move/eqP: Hnz ->; rewrite !mul0R mulR0.
      move/Bool.negb_true_iff: Hnz => Hnz.
      move: Hfree; rewrite -(addn0 l) => Hfree.
      move: (bloomfilter_add_multiple_preserve  Huniq Hlen Hfree Huns Hnz) => /andP [].
      rewrite /hashes_have_free_spaces/hashes_value_unseen => Hfree' Huns'.
      apply Logic.eq_sym; rewrite mulRA mulRC mulRA mulRC; apply f_equal; apply Logic.eq_sym.
      case Htnth': (~~ bloomfilter_get_bit ind bf').
    - have <-: (Rdefinitions.IZR 1) = (BinNums.Zpos BinNums.xH); first by [].
      erewrite <-  (@bloomfilter_addn hshs' ind bf' x) => //=.
      by apply Logic.eq_sym; comp_normalize; comp_simplify_n 2; apply Logic.eq_sym; comp_simplify_n 1.
    - move /Bool.negb_false_iff: Htnth' => Htnth'; rewrite FDist1.dE // mul0R.
       by move: (@bloomfilter_addn_Nuns ind bf' hshs' x Htnth'); comp_normalize; comp_simplify.
    - move/allP: Hfree => Hfree; apply/allP => cell Hcell.
    - move: (Hfree cell Hcell); rewrite /hash_has_free_spaces.
        by rewrite addnS => /ltnW.
    - move /allP: Huns => Huns; apply/allP => x' Hx'.
    - apply Huns => //=.
        by rewrite in_cons Hx' Bool.orb_true_r.
          by move: Huniq => //= /andP [].
    }
  Qed.

  Lemma bloomfilter_add_internal_indep l bf' x xs :
    tnth (bloomfilter_state bf') x ->
    uniq (x :: xs) ->
    length (x::xs) < Hash_size.+1 ->
    \sum_(inds in [finType of l.-tuple 'I_Hash_size.+1])
     (((tnth (bloomfilter_state (bloomfilter_add_internal inds bf')) x &&
             all [eta tnth (bloomfilter_state (bloomfilter_add_internal inds bf'))] xs) %R) *R*
      (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l)) =
    ((\sum_(inds in [finType of l.-tuple 'I_Hash_size.+1])
       (((tnth (bloomfilter_state (bloomfilter_add_internal inds bf')) x) %R) *R*
        (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l))) *R*
     (\sum_(inds in [finType of l.-tuple 'I_Hash_size.+1])
       ((( all [eta tnth (bloomfilter_state (bloomfilter_add_internal inds bf'))] xs) %R) *R*
        (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l)))).
  Proof.
    have H x1 y1 z1: y1 = (0 %R) -> x1 = z1 -> x1 +R+ y1 = z1. by move=> -> ->; rewrite addR0.
    elim: l bf' x xs=> [//=|l IHl] bf' x xs.
    -  move=> Htnth /andP[Hnin Huniq] Hlen.
       by comp_normalize; rewrite boolR_distr mulRC.
    - move=> Htnth Huniq Hlength.
      comp_normalize.
      rewrite rsum_tuple_split rsum_split=>//=.
      under_all ltac:(rewrite mulRC -mulRA).
      under eq_bigr => ? ? do rewrite -rsum_Rmul_distr_l.
      under eq_bigr => ? ? do under eq_bigr => ? ? do rewrite mulRC.
      under eq_bigr =>  i HI; first rewrite IHl; first over; try by [].
      {
        case Haeq: (x == i); first by
            rewrite /bloomfilter_set_bit/bloomfilter_state FixedList.tnth_set_nth_eq //=.
          by rewrite FixedList.tnth_set_nth_neq //=;  move/Bool.negb_true_iff: Haeq.
      }
      under [  \sum_(a in [finType of (l.+1).-tuple _]) _]eq_bigr => ? ? do under eq_bigr
      => ? ? do rewrite -{1}(mulR1 (Rdefinitions.Rinv _ *R* _)) mulRC bloomfilter_add_internal_preserve //= !mulR1.
      rewrite bigsum_card_constE.
      rewrite -[\sum_(i in 'I_Hash_size.+1) _]rsum_Rmul_distr_l.
      under eq_bigr => a _; first under eq_bigr => inds _.
      {
        rewrite bloomfilter_add_internal_preserve; first (rewrite mul1R; over).
        rewrite/bloomfilter_state/bloomfilter_set_bit.
        case Haeq:(x == a); first by rewrite FixedList.tnth_set_nth_eq //=.
          by move/Bool.negb_true_iff: Haeq=>Haeq; rewrite FixedList.tnth_set_nth_neq//=.
      }
        by over.
      rewrite //= bigsum_card_constE -!rsum_Rmul_distr_l [(#| [finType of (l.+1).-tuple _] | %R) *R* _]mulRC  -!mulRA;
        apply f_equal.
      rewrite mulRA [(#| [finType of l.-tuple _] | %R) *R* _]mulRC -mulRA; apply f_equal.
      under_all ltac:(rewrite mulRC).
      under eq_bigr => ? ? do rewrite -rsum_Rmul_distr_l; rewrite -rsum_Rmul_distr_l.
      rewrite mulRA [(#|[finType of l.-tuple _]| %R) *R* _ ]mulRC -mulRA.
      apply Logic.eq_sym; under eq_bigr
      => ? ? do rewrite mulRC; rewrite -rsum_Rmul_distr_l mulRC [(Rdefinitions.Rinv _) *R* _] mulRC -!mulRA;
           apply f_equal; rewrite mulRC -mulRA mulRC; apply Logic.eq_sym.
      rewrite !card_tuple //=; rewrite expnSr card_ord natRM mulRC.
      apply Logic.eq_sym; rewrite mulRC rsum_tuple_split rsum_split //=; apply Logic.eq_sym; apply f_equal; apply Logic.eq_sym.
      rewrite -mulRA mulRC mulRV ?exp1R//= ?mul1R //=.
        by rewrite RIneq.INR_IZR_INZ; apply/eqP => //=.
  Qed.

  Lemma bloomfilter_addn_insert_multiple_inv hashes l (ind: 'I_Hash_size.+1) (bf: BloomFilter) (values: seq B):
    length values == l ->
    hashes_have_free_spaces hashes l ->
    all (hashes_value_unseen hashes) values ->
    uniq values ->
    ~~ bloomfilter_get_bit ind bf ->
    (d[ res <-$ @AMQ_add_multiple (n,k.-1) I hashes bf values;
          (let '(_, bf') := res in ret bloomfilter_get_bit ind bf')]) true =
    (1 -R- ((1 -R- Rdefinitions.Rinv (Hash_size.+1 %R)) ^R^ (k * l))).
  Proof.
    move=> Hlen Hhashes Huns Huniq Hnth.
    transitivity (
        (d[ res <-$ @AMQ_add_multiple (n,k.-1) I hashes bf values;
            ret (fun res' => (let '(_, bf') := res' in bloomfilter_get_bit ind bf')) res]) true
      ).
    - by rewrite //= !FDistBind.dE; apply/eq_bigr=>[[hs' bf']] _ //=.
      rewrite -(prsumr_neg1 ).
      transitivity (
          (1 -R- (d[ res <-$ @AMQ_add_multiple (n,k.-1) I hashes bf values;
                     (let '(_, bf') := res in ret ~~ bloomfilter_get_bit ind bf')]) true)
        ).
    - by rewrite //= !FDistBind.dE; apply f_equal; apply/eq_bigr=>[[hs' bf']] _ //=.
        by rewrite (@bloomfilter_addn_insert_multiple _ l).
  Qed.

  Lemma bloomfilter_hits_preserve (xs : seq B) (l : nat_eqType) (m : nat)
        hshs hshs'
        (bf bf' : bloomfilter_finType) inds :
   length xs == l ->
   all (bloomfilter_get_bit^~ bf) inds ->
   (d[ @AMQ_add_multiple (n,k.-1) I hshs bf xs]) (hshs', bf') != (0 %R) ->
   all (bloomfilter_get_bit^~ bf') inds.
  Proof.
    move: hshs hshs'.
    rewrite/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hshs hshs'.
    elim: l xs bf inds hshs' bf' => [//= [|//=]| l IHl [//=| x xs]] bf inds hshs' bf' Hlen Hall //=.
    - by comp_normalize =>/bool_neq0_true; rewrite xpair_eqE => /andP[_/eqP->].
    - {
        comp_normalize.
        comp_possible_decompose.
        move=> hshs1 bf1 hsh2 bf2 Haddm Hint/bool_neq0_true;rewrite xpair_eqE=>/andP[_/eqP->].
        have H1: length xs == l; first by move/eqP: Hlen => [->].
        move: Haddm; move=>/(@IHl xs _ _ hshs1 bf1 H1  Hall) //=.
        move=>/allP Hget; apply/allP => ind Hind.
        apply bloomfilter_add_internal_preserve.
        move: (Hget ind Hind) => //=.
      }
  Qed.

  Theorem bloomfilter_addn_bits
          hashes b (inds: seq 'I_Hash_size.+1) (bf: BloomFilter) (value: B):
    b < k ->
    length inds == b ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes 1 ->
    (@AMQHash_hashstate_unseen (n,k.-1) hashes value)  ->
    uniq inds ->
    all (fun ind => ~~ bloomfilter_get_bit ind bf) inds ->
    (d[ res <-$ @AMQ_add (n,k.-1) I bf  hashes value;
          (let '(_, bf') := res in ret (all (bloomfilter_get_bit^~ bf') inds))]) true =
    \sum_(i in tuple_finType k (ordinal_finType Hash_size.+1))
     ((((inds \subseteq i) == true) %R) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ k)).
  Proof.
    move: hashes.
    rewrite/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash/AMQHash_hashstate_available_capacity/AMQHash_hashstate_unseen.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hashes.
    have H x1 y1 z1: y1 = (0 %R) -> x1 = z1 -> x1 +R+ y1 = z1; first by move=> -> ->; rewrite addR0.
    move =>  //= Hb Hlen Hfree Huns Huniq Hall.
    comp_normalize; comp_simplify.
    rewrite exchange_big //=.
    under eq_bigr => i0 _ do rewrite (bigID (fun i => i == Tuple (hash_vec_insert_length value hashes i0))) big_pred1_eq //=.
    rewrite addRA_rsum.
    erewrite H; last by []; last first.
    {
      do 1!(apply prsumr_eq0P; intros; first by intros; dispatch_Rgt).
      apply prsumr_eq0P => i Hneq; first by intros; dispatch_Rgt.
        by rewrite neg_hash_vecP //=; first rewrite !mulR0.
    }
    under eq_bigr => i _ do rewrite hash_vecP //=.
    have Hpred_eq i: (all (bloomfilter_get_bit^~ (bloomfilter_add_internal i bf)) inds = all (fun ind => ind \in i) inds).
    {
      apply eq_in_all => ind Hinds.
      case HinI: (ind \in i); first by rewrite /bloomfilter_get_bit bloomfilter_add_internal_hit //=.
      apply/Bool.negb_true_iff; rewrite /bloomfilter_get_bit bloomfilter_add_internal_miss //=;
                                        first by move/allP: Hall => /(_ ind Hinds) .
        by rewrite HinI.
    }
    under eq_bigr => i _ do rewrite Hpred_eq eq_sym //=.
      by [].
  Qed.

  Lemma bloomfilter_add_multiple_unwrap_internal bf
        hashes l value (values: seq B) inds:
    length values == l ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes (l.+1) ->
    all (@AMQHash_hashstate_unseen (n,k.-1) hashes) (value::values) ->
    \sum_(a in [finType of k.-1.+1.-tuple (HashState n) * BloomFilter])
     ((d[ @AMQ_add_multiple (n,k.-1) I (Tuple (hash_vec_insert_length value hashes inds)) bf
                                   values]) a *R*
      (d[ let (hashes2, bf) := a in res' <-$ bloomfilter_query value hashes2 bf; ret res'.2]) true) =
    \sum_(a in [finType of k.-1.+1.-tuple (HashState n) * BloomFilter])
     ((d[ @AMQ_add_multiple (n,k.-1) I (Tuple (hash_vec_insert_length value hashes inds)) bf
                                   values]) a *R*
      (bloomfilter_query_internal inds a.2 == true %R)).
  Proof.
    move: hashes inds bloomfilter_add_multiple_find_preserve.
    rewrite/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash/AMQHash_hashstate_available_capacity/AMQHash_hashstate_unseen/AMQHash_hashstate_contains.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hashes inds bloomfilter_add_multiple_find_preserve.

    move=>  Hlen Hfree Hall; apply eq_bigr => [[hshs' bf']] _.

    move: (@bloomfilter_add_multiple_find_preserve value inds (Tuple (hash_vec_insert_length value hashes inds)) hshs' bf bf' values  ); clear bloomfilter_add_multiple_find_preserve.
    set bloomfilter_add_multiple :=
      (d[ foldr
            (fun val : AMQHashKey =>
               (Bind
                  (B:=[finType of [finType of k.-tuple (HashVec.Hash.HashState n)] *
                       [finType of BloomfilterCore.BloomFilterDefinitions.BloomFilter]]))^~ (fun res_1 : [finType of [finType of k.-tuple (HashVec.Hash.HashState n)] *
                                 [finType of BloomfilterCore.BloomFilterDefinitions.BloomFilter]] =>
           let (hsh, bf0) := res_1 in
           hash_res <-$ HashVec.hash_vec_int val hsh;
           (let (new_hashes, hash_vec) := hash_res in
            ret (new_hashes,
                BloomfilterCore.BloomFilterDefinitions.bloomfilter_add_internal hash_vec bf0))))
         (ret (Tuple (hash_vec_insert_length value hashes inds), bf)) values]).
    move=> bloomfilter_add_multiple_find_preserve.
    case Hzro: (bloomfilter_add_multiple (hshs', bf') == 0); first by move/eqP:Hzro -> ; rewrite !mul0R.
    move/Bool.negb_true_iff: Hzro => Hzro.
    apply f_equal.
    comp_normalize; comp_simplify.
    have Hallleq: all
                    (fun hsh : FixedList.fixlist [eqType of hash_keytype * hash_valuetype] n =>
                       FixedList.fixlist_length hsh + 1 <= n) hashes.
    {
      move: Hfree;rewrite/hashes_have_free_spaces/hash_has_free_spaces=>/allP Hfree;apply/allP=>ind Hind.
      by move: (Hfree ind Hind); rewrite/HashVec.hash_has_free_spaces; rewrite addn1 addnS =>/ltn_weaken.
    }
    move: (@hash_vec_contains_value_base _ _ value hashes inds Hallleq) => Hcontains'.
    move: (@bloomfilter_add_multiple_find_preserve Hcontains' Hzro) => Hcontains''.
    under eq_bigr => a0 _ do under eq_bigr => b _ do rewrite (@hash_vec_find_simpl n k value hshs' _ inds _ Hcontains'') //=.
    by under eq_bigr => ? ? do under eq_bigr => ? ? do rewrite boolR_distr; comp_simplify; rewrite eq_sym.
  Qed.

  Lemma bloomfilter_add_multiple_unwrap_base
        hashes l (values: seq B) others inds:
    uniq values ->
    length values == l ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes l ->
    all (@AMQHash_hashstate_unseen (n,k.-1) hashes) (values) ->
    \sum_(a in [finType of (k.-1.+1.-tuple (HashState n) * BloomFilter)]%type)
     ((d[ @AMQ_add_multiple (n,k.-1) I hashes bloomfilter_new values]) a *R*
      ((all (bloomfilter_get_bit^~ (bloomfilter_add_internal others a.2)) inds == true) %R)) =
    \sum_(hits in [finType of (l * k).-tuple 'I_Hash_size.+1])
     ((inds \subseteq hits ++ others) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l * k)).
  Proof.
    move: hashes bloomfilter_add_multiple_preserve.
    rewrite/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash/AMQHash_hashstate_available_capacity/AMQHash_hashstate_unseen/AMQHash_hashstate_contains.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hashes bloomfilter_add_multiple_preserve.
    elim: l others values inds => [//=| l IHl] others [//=|//= value values] inds Huniq Hlen Hfree Hunseen.
    - {
        comp_normalize; comp_simplify; rewrite mulR1 //=.
        rewrite eqb_id RIneq.INR_IZR_INZ; do?apply f_equal.
        apply eq_in_all => ind _; clear.
        case Hin: (ind \in others) => //=.
          by apply bloomfilter_add_internal_hit => //=.
          apply/Bool.negb_true_iff; apply bloomfilter_add_internal_miss => //=.
            by apply bloomfilter_new_empty_bits.
              by move/Bool.negb_true_iff: Hin.
      }
    - {
        move=>//=.
        move: (@subseq_imd ([finType of 'I_Hash_size.+1]) l k (fun hits => inds \subseteq hits ++ others)) => //=.
        rewrite card_ord => ->.
        have Hsusp b bs:  (inds \subseteq (b ++ bs) ++ others) = (inds \subseteq bs ++ (others ++ b)); first
          by rewrite -subseq_consA subseq_consC -subseq_consA.
        under [\sum_(b in [finType of k.-tuple _]) _]eq_bigr => b _ do under eq_bigr => bs _ do rewrite Hsusp.
        under  [\sum_(b in [finType of k.-tuple _]) _]eq_bigr => b _. {
          rewrite -(IHl (others ++ b) values inds) //=.
            by over.
              by move/andP: Huniq => [].
              move: Hfree;rewrite /HashVec.hashes_have_free_spaces=>/allP Hall; apply/allP=> y Hy; move: (Hall y Hy);

              rewrite/HashVec.hash_has_free_spaces addnS => /ltnW.
                by move/andP:Hunseen => [].
                by move/andP: Hunseen => [].
        }
         comp_normalize; comp_simplify_n 2.
        apply Logic.eq_sym; under eq_bigr => ? ? do rewrite rsum_Rmul_distr_l; rewrite exchange_big //=.
        comp_normalize; apply eq_bigr => hshs' _ ; apply eq_bigr => bf' _.
        rewrite exchange_big; apply eq_bigr => inds' _; rewrite mulRC -!mulRA; apply Logic.eq_sym.
        under eq_bigr => i ? do rewrite mulRC  -!mulRA; rewrite -rsum_Rmul_distr_l.
        move: (@bloomfilter_add_multiple_preserve
                 value
                 values l 0 hashes hshs' bloomfilter_new bf' ); clear bloomfilter_add_multiple_preserve.

        set bloomfilter_add_multiple := (d[ foldr
         (fun val : AMQHashKey =>
          (Bind
             (B:=[finType of [finType of k.-tuple (HashVec.Hash.HashState n)] *
                             [finType of BloomfilterCore.BloomFilterDefinitions.BloomFilter]]))^~
          (fun
             res_1 : [finType of [finType of k.-tuple (HashVec.Hash.HashState n)] *
                                 [finType of BloomfilterCore.BloomFilterDefinitions.BloomFilter]] =>
           let (hsh, bf) := res_1 in
           hash_res <-$ HashVec.hash_vec_int val hsh;
           (let (new_hashes, hash_vec) := hash_res in
            ret (new_hashes,
                BloomfilterCore.BloomFilterDefinitions.bloomfilter_add_internal hash_vec bf))))
         (ret (hashes, bloomfilter_new)) values]).
        move=> bloomfilter_add_multiple_preserve.
        case Hzr0: (bloomfilter_add_multiple (hshs', bf') == 0);
          first by move/eqP: Hzr0 ->;rewrite ?mulR0 ?mul0R //=.
        move/Bool.negb_true_iff: Hzr0 => Hzr0.
        apply f_equal.
        clear IHl.
        have H1:   (uniq (value :: values)); first by [].
        have H2: length values == l; first by move: Hlen =>/eqP [->].
        have H3: hashes_have_free_spaces hashes (l + 0).+1; first by rewrite addn0.
        have H4: all (hashes_value_unseen hashes) (value :: values); first by [].
        move: (@bloomfilter_add_multiple_preserve
                 H1 H2 H3 H4 Hzr0
              ) => /andP [Hfree' Huns'].
        by rewrite hash_vec_simpl => //=; rewrite mulRC bloomfilter_add_multiple_cat //=.
      }
  Qed.

  (** Proves the validity of the analogy used by Bose et al, wherin
   the false positives of a bloom filter can be thought of as
   equivalent to throwing balls into urns*)
  Lemma bloomfilter_add_multiple_unwrap
        hashes l value (values: seq B) inds:
    uniq (value::values) ->
    length values == l ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes (l.+1) ->
    all (@AMQHash_hashstate_unseen (n,k.-1) hashes) (value::values) ->
    \sum_(a in [finType of k.-1.+1.-tuple (HashState n) * BloomFilter])
     ((d[ @AMQ_add_multiple (n,k.-1) I (Tuple (hash_vec_insert_length value hashes inds)) bloomfilter_new
                                   values]) a *R*
      (d[ let (hashes2, bf) := a in res' <-$ bloomfilter_query value hashes2 bf; ret res'.2]) true) =
    \sum_(hits in [finType of (l * k).-tuple 'I_Hash_size.+1])
     ((inds \subseteq hits) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l * k)).
  Proof.
    rewrite/bloomfilter_query //= => Huniq Hlen Hfree Hunseen.
    rewrite (@bloomfilter_add_multiple_unwrap_internal _ _ l) => //=.
    rewrite //= /bloomfilter_query_internal.
    move: Huniq => //=/andP[Hnin Huniq].
    move: (@bloomfilter_add_multiple_unwrap_base
             (Tuple (hash_vec_insert_length value hashes inds)) l values [::] inds Huniq Hlen
          ) => //=.
    under [   \sum_(hits in [finType of (l * k).-tuple 'I_Hash_size.+1]) _]eq_bigr => a _ do rewrite cats0.
    move=>-> //=.
    - {
        move: Hfree; rewrite/hashes_have_free_spaces/hash_has_free_spaces//=; clear.
        move=>/allP Hfree; apply/allP => [ //= hsh' /mapP [[hsh ind] /mem_zip/andP [Hhsh Hind] ->]].
        rewrite/hashstate_put/HashVec.hash_has_free_spaces //=.
        move: (Hfree hsh Hhsh); clear.
        rewrite/FixedList.fixlist_length => //=.
        move=> H; apply/ fixedlist_add_incr;move: H.
        by rewrite/HashVec.hash_has_free_spaces addnS.
      }
    - {
        move/andP: Hunseen Hnin => [Huns ]; clear.
        rewrite/hashes_value_unseen //=; move=>/allP Hfree Hnin.
        apply/allP => [//= value' Hvalue]; move: (Hfree value' Hvalue)=>/allP  Hfree'.
        apply/allP => //= [ hsh' /mapP [[hsh ind] /mem_zip/andP [Hhsh Hind] ->]].
        move: (Hfree' hsh Hhsh ).
        move/memPn: Hnin => /(_ value' Hvalue); clear; rewrite /hash_unseen/hashstate_put.
          by move=> Hnew Hfind; apply fixmap_find_neq => //=.
      }
  Qed.

  Theorem bloomfilter_collision_rsum
          hashes l value (values: seq B):
    length values == l ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes (l.+1) ->
    all (@AMQHash_hashstate_unseen (n,k.-1) hashes) (value::values) ->
    uniq (value::values) ->
    d[
        res1 <-$ @AMQ_query (n,k.-1) I  (AMQ_new I) hashes value;
          let (hashes1, init_query_res) := res1 in
          res2 <-$ @AMQ_add_multiple (n,k.-1) I hashes1 (bloomfilter_new) values;
            let (hashes2, bf) := res2 in
            res' <-$ @AMQ_query (n,k.-1) I  bf hashes2 value;
              ret (res'.2)
      ] true =
    \sum_(inds in [finType of k.-tuple ('I_Hash_size.+1)])
     ((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ k) *R*
      (\sum_(hits in [finType of (l * k).-tuple 'I_Hash_size.+1])
        ((( inds \subseteq hits) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ (l * k)))))).
  Proof.
    (* expand to simplify k.-1.+1 to normal form *)
    move: hashes bloomfilter_add_multiple_unwrap.
    rewrite/AMQ_query/AMQ_query_internal/AMQ_new/AMQ_add_multiple/AMQState/AMQ_add/AMQ_add_internal/AMQHash_hash/AMQHash_hashstate_available_capacity/AMQHash_hashstate_unseen/AMQHash_hashstate_contains.
    change  (AMQHash (n, k.-1)) with ([finType of k.-1.+1.-tuple (HashVec.Hash.HashState n)]).
    change  (AMQHashValue (n, k.-1)) with ([finType of k.-1.+1.-tuple 'I_Hash_size.+1]).
    change ((n, k.-1).2.+1) with (k.-1.+1).
    change ((n, k.-1).1) with n.
    rewrite (@prednK k Hkgt0).
    move=> hashes bloomfilter_add_multiple_unwrap.
    have H x y z: (y = (0%R)) -> x = z -> x +R+ y = z. by move => -> ->; rewrite addR0.
    move=>//= Hlen Hfree /andP[Huns Halluns]/andP[Hnin Huniq].
    comp_normalize; comp_simplify_n 2.
    exchange_big_outwards 5 => //=; comp_simplify_n 1.
    exchange_big_outwards 4 => //=; comp_simplify_n 1.
    apply Logic.eq_sym.
    under eq_bigr => inds _ do (rewrite
                                -(@bloomfilter_add_multiple_unwrap hashes l value values)
                                   1?rsum_Rmul_distr_l //=; try (by apply/andP;split => //=)).
    comp_normalize.
    exchange_big_outwards 4 => //=; comp_simplify_n 1.
    exchange_big_outwards 3 => //=; comp_simplify_n 1.
    rewrite exchange_big; apply eq_bigr => hshs' _ //=.
    rewrite exchange_big; apply eq_bigr => bf' _ //=.
    rewrite exchange_big; apply Logic.eq_sym => //=; exchange_big_outwards 2 => //=; apply eq_bigr => hshs'' _.
    exchange_big_outwards 2 => //=; apply Logic.eq_sym; rewrite exchange_big; apply eq_bigr => inds' _.
    rewrite exchange_big; apply eq_bigr => inds _; apply Logic.eq_sym=> //=.
    rewrite hash_vec_simpl //.
  Qed.

  Lemma subseq_conv l:
    \sum_(inds in [finType of k.-tuple ('I_Hash_size.+1)])
     ((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ k) *R*
      (\sum_(hits in [finType of (l * k).-tuple 'I_Hash_size.+1])
        ((( inds \subseteq hits) *R* (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ (l * k)))))) =
    ((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l.+1 * k) *R*
     \sum_(a in ordinal_finType (Hash_size.+2))
      (((((a %R) ^R^ k) *R* (Factorial.fact a %R)) *R* ('C(Hash_size.+1, a) %R)) *R* stirling_no_2 (l * k) a)).
  Proof.
    under eq_bigr => inds _ do rewrite rsum_Rmul_distr_l.
    rewrite exchange_big.
    under eq_bigr => inds _ do under eq_bigr => inds' _ do rewrite mulRA mulRC.
    under eq_bigr => inds _ do rewrite -rsum_Rmul_distr_l.
    under eq_bigr => inds _ do under eq_bigr => inds' _ do rewrite mulRC.
    have Hbool inds' inds: (inds' \subseteq inds %R) = (inds' \subseteq inds); first by rewrite RIneq.INR_IZR_INZ.
    under eq_bigr => inds _ do under eq_bigr => ps _ do rewrite -Hbool.
    under eq_bigr => inds _ do rewrite -rsum_pred_demote.
    under eq_bigr => inds _.
    rewrite rsum_subseq_mult_undup_eq rsum_subseq_mult //=.
    by over.
      by apply undup_uniq.
      move=>//=.
      move:  ( second_stirling_number_sum_normalized l k Hash_size
                                         (fun len => (((len %R) *R* Rdefinitions.Rinv (Hash_size.+1 %R)) ^R^ k))
             ) => //= ->.
      have H len: ((((len %R) *R* Rdefinitions.Rinv (Hash_size.+1 %R)) ^R^ k) *R*
                   (((('C(Hash_size.+1, len) %R) *R* (Factorial.fact len %R)) *R* stirling_no_2 (l * k) len) *R*
                    (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l * k))) = (
                    (Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ (l.+1 * k)) *R* (
                      ((len %R) ^R^ k) *R*
                      (Factorial.fact len %R) *R*
                      ('C (Hash_size.+1, len) %R) *R*
                      (stirling_no_2 (l * k) len)
                  )).
      {
        rewrite expRM -mulRA.
        apply Logic.eq_sym.
        rewrite mulRC -!mulRA; apply f_equal.
        rewrite mulRC; apply Logic.eq_sym; rewrite mulRC -!mulRA; apply f_equal.
        rewrite mulRC mulRA mulRA mulRC mulRA mulRC.
        rewrite mulRC mulRA; apply Logic.eq_sym.
        rewrite mulRA mulRA mulRC -!mulRA; do?apply f_equal.
        rewrite mulSnr //=.
          by rewrite Rfunctions.pow_add.
      }
      under eq_bigr => len _ do rewrite H.
      by rewrite -rsum_Rmul_distr_l.
  Qed.

  Theorem bloomfilter_collision_prob
          hashes l value (values: seq B):
    length values == l ->
    @AMQHash_hashstate_available_capacity (n,k.-1) hashes (l.+1) ->
    all (@AMQHash_hashstate_unseen (n,k.-1) hashes) (value::values) ->
    uniq (value::values) ->
    d[
        res1 <-$ @AMQ_query (n,k.-1) I  (AMQ_new I) hashes value;
          let (hashes1, init_query_res) := res1 in
          res2 <-$ @AMQ_add_multiple (n,k.-1) I hashes1 (bloomfilter_new) values;
            let (hashes2, bf) := res2 in
            res' <-$ @AMQ_query (n,k.-1) I  bf hashes2 value;
              ret (res'.2)
      ] true =
    ((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l.+1 * k) *R*
     \sum_(a in ordinal_finType (Hash_size.+2))
      (((((a %R) ^R^ k) *R* (Factorial.fact a %R)) *R* ('C(Hash_size.+1, a) %R)) *R* stirling_no_2 (l * k) a)).
  Proof.
    intros; rewrite (@bloomfilter_collision_rsum _ l) => //=.
      by rewrite  subseq_conv.
  Qed.
End BloomFilter.

(** Proves the standard properties of AMQs for Bloom Filters *)
Module BloomFilterProperties <:  AMQ.AMQProperties (BasicHashVec) (BloomfilterAMQ).
  Module AmqOperations :=  BloomfilterOperations.
  Export AmqOperations.

  Definition AMQ_false_positive_probability (hash:  AMQHashParams) (state: AMQStateParams) (l: nat) : Rdefinitions.R :=
((Rdefinitions.Rinv (Hash_size.+1 %R) ^R^ l.+1 * hash.2.+1) *R*
     \sum_(a in ordinal_finType (Hash_size.+2))
      (((((a %R) ^R^ hash.2.+1) *R* (Factorial.fact a %R)) *R* ('C(Hash_size.+1, a) %R)) *R* stirling_no_2 (l * hash.2.+1) a)).

  Section Properties.
    Variable h : AMQHashParams.
    Variable s: AMQStateParams.

    Variable hashes: AMQHash h.

    Section FalseNegatives.

      Variable amq: AMQState s.

      Lemma AMQ_no_false_negatives:
        forall (l:nat_eqType) (x:AMQHashKey) (xs: seq AMQHashKey),
          uniq (x :: xs) -> length xs == l ->

          AMQ_valid amq -> AMQ_available_capacity h amq l.+1 ->

          AMQHash_hashstate_valid hashes ->
          AMQHash_hashstate_available_capacity hashes l.+1 ->
          all (AMQHash_hashstate_unseen hashes) (x::xs) ->
          (d[ res1 <-$ AMQ_add amq hashes x;
                let '(hsh1, amq1) := res1 in
                res2 <-$ AMQ_add_multiple hsh1 amq1 xs;
                  let '(hsh2, amq2) := res2 in
                  res3 <-$ AMQ_query amq2 hsh2 x;
                    ret (snd res3) ] true) = (1 %R).
      Proof.
        apply AMQ_no_false_negatives.
      Qed.

    End FalseNegatives.

    Theorem AMQ_false_positives_rate: forall  l value (values: seq _),
        length values == l ->

        AMQHash_hashstate_valid hashes ->
        AMQHash_hashstate_available_capacity hashes (l.+1) ->

        AMQ_available_capacity h (AMQ_new s) l.+1 ->
        all (AMQHash_hashstate_unseen hashes) (value::values) ->
        uniq (value::values) ->
        d[
            res1 <-$ AMQ_query (AMQ_new s) hashes value;
              let (hashes1, init_query_res) := res1 in
              res2 <-$ AMQ_add_multiple hashes1 (AMQ_new s) values;
                let (hashes2, amq) := res2 in
                res' <-$ AMQ_query amq  hashes2 value;
                  ret (res'.2)
          ] true = AMQ_false_positive_probability h s l.
    Proof.
      move: h hashes => [n k]; clear hashes=> hashes.
      move=> l value values Hlen Hvalid Havail Hcap Huns Huniq.
      move: (@bloomfilter_collision_prob k.+1 n).
      Set Printing Implicit Defensive.
      change (k.+1.-1) with (k); rewrite/AMQ_false_positive_probability.
      change (n, k).2.+1 with k.+1.
      move=>H; rewrite (@H _ _ l) //=.
    Qed.
  End Properties.
End  BloomFilterProperties.

End BloomFilterProbability.

(* Local Variables: *)
(* company-coq-local-symbols: (("\\subseteq" . ?⊆)) *)
(* End: *)


Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path.
From mathcomp Require Import finfun fintype tuple finset bigop.
From mathcomp Require Import ssralg fingroup morphism perm gproduct.
From mathcomp Require Import zmodp. (* Defines the coercion nat -> 'I_n.+1 *)
From mathcomp Require Import ssralg matrix vector mxalgebra falgebra ssrnum algC.
From mathcomp Require Import presentation classfun character mxrepresentation.

From Combi Require Import tools ordcast permuted symgroup partition Greene sorted rep1 sympoly.

Require Import ssrcomp slicedbij cycles cycletype reprS2 towerSn.

Import LeqGeqOrder.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import GroupScope GRing.Theory Num.Theory.
Open Scope ring_scope.

Local Notation algCF := [fieldType of algC].

Section Defs.

Variable nvar n : nat.

Local Notation "'z_ p " := (zcoeff p) (at level 2).
Local Notation "''P_[' p ]" := (pbasis p).

Definition frob_iso (f : 'CF([set: 'S_n])) : {sympoly algC[nvar]} :=
  \sum_(l : intpartn n) (f (perm_of_partCT l) / 'z_l) *: 'p[l].

Lemma frob_iso_is_linear : linear frob_iso.
Proof using.
move=> a f g; rewrite /frob_iso scaler_sumr -big_split /=.
apply eq_bigr => l _; rewrite !cfunElock.
by rewrite scalerA mulrA -scalerDl mulrDl.
Qed.
Canonical frob_iso_linear := Linear frob_iso_is_linear.

Lemma frob_pbasis l : frob_iso 'P_[l] = 'p[l].
Proof using.
rewrite /frob_iso /pbasis (bigD1 l) //= big1 ?addr0; first last.
  move=> m /negbTE Hm /=.
  rewrite cfunElock cfuni_partE /=.
  rewrite /cycle_typeSN perm_of_partCTP.
  rewrite partn_of_partCTE /= !partCT_of_partnK Hm /=.
  by rewrite mulr0 mul0r scale0r.
rewrite cfunElock cfuni_partE /=.
rewrite /cycle_typeSN perm_of_partCTP eq_refl /=.
rewrite mulr1 divff ?scale1r //.
exact: neq0zcoeff.
Qed.

End Defs.

Lemma frob_ind_morph nvar n m (f : 'CF([set: 'S_m])) (g : 'CF([set: 'S_n])) :
  frob_iso nvar ('Ind[[set: 'S_(m + n)]] (f \o^ g)) =
  frob_iso nvar f * frob_iso nvar g.
Proof using.
rewrite (pbasis_gen f) (pbasis_gen g).
rewrite cfextprod_suml !linear_sum [RHS]mulr_suml.
apply eq_bigr => /= l _.
rewrite cfextprod_sumr !linear_sum [RHS]mulr_sumr.
apply eq_bigr => /= k _.
rewrite cfextprodZr cfextprodZl scalerA.
rewrite 3!linearZ /= Ind_pbasis frob_pbasis.
do 2 rewrite linearZ /= frob_pbasis.
by rewrite -scalerAr -scalerAl scalerA prod_genM.
Qed.


Require Import ZArith.
Require Import Coq.Lists.List coqutil.Datatypes.List coqutil.Datatypes.ZList.
Require Import coqutil.Map.Interface coqutil.Map.OfFunc.
Import Interface.map MapKeys.map OfFunc.map.

Module map.
  Section __. Local Set Default Proof Using "All".
    Context [value : Type] {map : map Z value} {ok : map.ok map}.

    (* TODO maybe use wrap-around addition on Z instead of Z.add ? *)

    Definition of_olist_Z (xs : list (option value)) : map :=
      map.of_func (List.get xs) (List.map Z.of_nat (seq O (length xs))).

    Definition of_olist_Z_at (a : Z) (xs : list (option value)) : map :=
      map_keys (Z.add a) (of_olist_Z xs).
  End __.
End map.


Module BiedaBeth.

Fixpoint Beth (n : nat) (A : Type) : Type :=
match n with
| 0 => A
| S n' => Beth n' A -> bool
end.

Compute Beth 20 nat.

Definition StrongLimit : Type :=
  {n : nat & Beth n nat}.

Definition inj {n : nat} (b : Beth n nat) : StrongLimit :=
  existT _ n b.

End BiedaBeth.

Module BethNaBogato.

Inductive Ord : Type :=
| Z   : Ord
| S   : Ord -> Ord
| Lim : (nat -> Ord) -> Ord.

Fixpoint Beth (o : Ord) : Type :=
match o with
| Z     => nat
| S o'  => Beth o' -> bool
| Lim f => {n : nat & Beth (f n)}
end.

Fixpoint nat_to_Ord (n : nat) : Ord :=
match n with
| 0 => Z
| Datatypes.S n' => S (nat_to_Ord n')
end.

Compute Beth (Lim (fun n : nat => nat_to_Ord n)).

End BethNaBogato.


Require Export euclidean__axioms.
Require Export lemma__congruencetransitive.
Require Export logic.
Definition lemma__congruenceflip : forall A B C D, (euclidean__axioms.Cong A B C D) -> ((euclidean__axioms.Cong B A D C) /\ ((euclidean__axioms.Cong B A C D) /\ (euclidean__axioms.Cong A B D C))).
Proof.
intro A.
intro B.
intro C.
intro D.
intro H.
assert (* Cut *) (euclidean__axioms.Cong B A A B) as H0.
- apply (@euclidean__axioms.cn__equalityreverse B A).
- assert (* Cut *) (euclidean__axioms.Cong C D D C) as H1.
-- apply (@euclidean__axioms.cn__equalityreverse C D).
-- assert (* Cut *) (euclidean__axioms.Cong B A C D) as H2.
--- apply (@lemma__congruencetransitive.lemma__congruencetransitive B A A B C D H0 H).
--- assert (* Cut *) (euclidean__axioms.Cong A B D C) as H3.
---- apply (@lemma__congruencetransitive.lemma__congruencetransitive A B C D D C H H1).
---- assert (* Cut *) (euclidean__axioms.Cong B A D C) as H4.
----- apply (@lemma__congruencetransitive.lemma__congruencetransitive B A C D D C H2 H1).
----- split.
------ exact H4.
------ split.
------- exact H2.
------- exact H3.
Qed.


Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros.
  unfold not.
  intros.
  destruct H0.
  apply H0.
  apply H.
Qed.


Inductive Val : Type :=
  | infinity : Val
  | finite   : nat -> Val.

Axiom V0 : Val.

Fixpoint Leq_p (a b:nat) : Prop :=
  match (a,b) with
  | (O,O) => True
  | (O,_) => True
  | (_,O) => False
  | (S a',S b') => Leq_p a' b'
  end.

Fixpoint Comp (a b:Val) : Prop :=
  match (a,b) with
  | (finite a, finite b) => Leq_p a b
  | (finite _, infinity) => True
  | (infinity, finite b) => False
  | (infinity, infinity) => True
  end.

Fixpoint getVal h : Heap v -> Val := v.

Inductive Heap : Val -> Type :=
  | stub : Heap infinity
  | node (v:Val) (l r:Heap) : Comp (getVal l) v -> Comp (getVal r) v -> Heap.

Fixpoint leftChild h : Val :=
  match h with
  | stub => HV0
  | node l v _ _ _ => l
  end.

Fixpoint

Lemma child_leq : forall H,


Require Import Mem.
Require Import List Omega Ring Word Pred PredCrash Prog Hoare SepAuto BasicProg Array ListUtils.
Require Import FunctionalExtensionality.
Require Import Permutation.

Set Implicit Arguments.

(* A general list predicate *)

Section LISTPRED.

  Set Default Proof Using "Type".

  Variable T : Type.
  Variable AT : Type.
  Variable AEQ : EqDec AT.
  Variable V : Type.
  Variable prd : T -> @pred AT AEQ V.

  Fixpoint listpred (ts : list T) :=
    match ts with
    | nil => emp
    | t :: ts' => (prd t) * listpred ts'
    end%pred.

  Lemma listpred_nil:
    listpred nil = emp.
  Proof.
    unfold listpred; intros; auto.
  Qed.

  Theorem listpred_fwd : forall l i def,
    i < length l ->
      listpred l =p=> listpred (firstn i l) * (prd (selN l i def)) * listpred (skipn (S i) l).
  Proof.
    induction l; simpl; intros; [omega |].
    destruct i; simpl; cancel.
    apply IHl; omega.
  Qed.

  Theorem listpred_bwd : forall l i def,
    i < length l ->
      listpred (firstn i l) * (prd (selN l i def)) * listpred (skipn (S i) l) =p=> listpred l.
  Proof.
    induction l; simpl; intros; [omega |].
    destruct i; [cancel | simpl].
    destruct l; simpl in H; [omega |].
    cancel.
    eapply pimpl_trans; [| apply IHl ].
    cancel.
    apply pimpl_refl.
    omega.
  Qed.

  Theorem listpred_extract : forall l i def,
    i < length l ->
    listpred l =p=> exists F, F * prd (selN l i def).
  Proof.
    intros; rewrite listpred_fwd with (def:=def) by eauto; cancel.
  Qed.

  Theorem listpred_pick : forall x l,
    In x l -> listpred l =p=> exists F, prd x * F.
  Proof.
    induction l; intro Hi.
    inversion Hi.
    simpl.
    destruct Hi.
    cancel.
    rewrite IHl by assumption.
    cancel.
  Qed.

  Theorem listpred_inj: forall l1 l2,
     l1 = l2 -> listpred l1 <=p=> listpred l2.
  Proof.
     intros; subst; auto.
  Qed.

  Definition sep_star_fold : (T -> @pred AT AEQ V -> @pred AT AEQ V) := fun x => sep_star (prd x).
  Definition listpred' := fold_right sep_star_fold emp.

  Theorem listpred_listpred': forall l,
    listpred l = listpred' l.
  Proof.
    induction l; unfold listpred, listpred', sep_star_fold, fold_right; auto.
  Qed.

  Theorem listpred'_app_fwd: forall l1 l2,
    listpred' (l1 ++ l2) =p=> listpred' l1 * listpred' l2.
  Proof.
    unfold listpred'.
    induction l1; destruct l2; unfold sep_star_fold; try cancel;
    rewrite IHl1; unfold sep_star_fold; cancel.
  Qed.

  Theorem listpred'_app_bwd: forall l1 l2,
    listpred' l1 * listpred' l2 =p=> listpred' (l1 ++ l2).
  Proof.
    unfold listpred'.
    induction l1; destruct l2; unfold sep_star_fold; try cancel;
    rewrite <- IHl1; unfold sep_star_fold; cancel.
  Qed.

  Theorem listpred_app: forall l1 l2,
    listpred (l1 ++ l2) <=p=> listpred l1 * listpred l2.
  Proof.
    intros; replace listpred with listpred'.
    unfold piff; split.
    apply listpred'_app_fwd.
    apply listpred'_app_bwd.
    apply functional_extensionality.
    apply listpred_listpred'.
  Qed.

  Theorem listpred_isolate : forall l i def,
    i < length l ->
    listpred l <=p=> listpred (removeN l i) * prd (selN l i def).
  Proof.
    intros.
    unfold removeN.
    rewrite listpred_app.
    unfold piff; split.
    rewrite listpred_fwd by eauto; cancel.
    eapply pimpl_trans2.
    apply listpred_bwd; eauto.
    cancel.
  Qed.

  Theorem listpred_split : forall l n,
    listpred l <=p=> listpred (firstn n l) * listpred (skipn n l).
  Proof.
    intros.
    setoid_rewrite <- firstn_skipn with (n := n) at 1.
    rewrite listpred_app.
    split; cancel.
  Qed.

  Theorem listpred_isolate_fwd : forall l i def,
    i < length l ->
    listpred l =p=> listpred (removeN l i) * prd (selN l i def).
  Proof.
    intros.
    apply listpred_isolate; auto.
  Qed.

  Theorem listpred_updN : forall l i v,
    i < length l ->
    listpred (updN l i v) <=p=> listpred (removeN l i) * prd v.
  Proof.
    intros; rewrite listpred_isolate with (def:=v);
       [ | rewrite length_updN; eauto].
    rewrite removeN_updN.
    rewrite selN_updN_eq; auto.
  Qed.

  Theorem listpred_updN_selN: forall l i v def,
    i < length l ->
    prd (selN l i def) =p=> prd v ->
    listpred l =p=> listpred (updN l i v).
  Proof.
    intros.
    rewrite listpred_updN by auto.
    rewrite listpred_isolate with (def:=def) at 1 by eauto.
    cancel; auto.
  Qed.

  Theorem listpred_nodup : forall l m,
    (forall x y : T, {x = y} + {x <> y}) ->
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    listpred l m -> NoDup l.
  Proof.
    induction l; intuition; constructor; simpl in H0.
    intro Hin.
    revert H0.
    erewrite listpred_pick by (apply Hin).
    (* XXX should be possible not to bash this *)
    unfold_sep_star; intuition.
    do 2 destruct H0. intuition. destruct H4. do 2 destruct H3. intuition.
    eapply H.
    unfold_sep_star.
    exists x. exists x2.
    repeat split; intuition; eauto.
    subst. apply mem_disjoint_comm. apply mem_disjoint_comm in H0. rewrite mem_union_comm in H0.
    eapply mem_disjoint_union. eauto. eauto.

    revert H0.
    unfold_sep_star.
    intuition. do 2 destruct H0. intuition.
    eapply IHl; eauto.
  Qed.

  Theorem listpred_nodup_piff : forall l,
    (forall x y : T, {x = y} + {x <> y}) ->
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    listpred l <=p=> [[ NoDup l ]] * listpred l.
  Proof.
    intros. split. apply lift_impl. intros. eapply listpred_nodup; eauto.
    cancel.
  Qed.

  Theorem listpred_nodup_F : forall l m,
    (forall x y : T, {x = y} + {x <> y}) ->
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    (exists F, F * listpred l)%pred m -> NoDup l.
  Proof.
    intros.
    destruct_lift H0.
    rewrite listpred_nodup_piff in H0 by eauto.
    destruct_lift H0.
    eauto.
  Qed.

  Lemma listpred_permutation: forall a b,
    Permutation a b ->
    listpred a <=p=> listpred b.
  Proof.
    intros.
    induction H; cbn; auto.
    rewrite IHPermutation. auto.
    split; cancel.
    rewrite IHPermutation1.
    rewrite IHPermutation2.
    auto.
  Qed.

  Theorem listpred_remove :
    forall (dec : forall x y : T, {x = y} + {x <> y}) x l,
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    In x l ->
    listpred l =p=> prd x * listpred (remove dec x l).
  Proof.
    intros.
    induction l.
    cancel.
    rewrite listpred_nodup_piff; eauto.
    simpl; destruct (dec x a).
    cancel; inversion H2; rewrite remove_not_In; eauto.
    rewrite IHl; [ cancel | destruct H0; subst; tauto ].
  Qed.

  Theorem listpred_remove' :
    forall (dec : forall x y : T, {x = y} + {x <> y}) x l,
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    NoDup l ->
    In x l ->
    prd x * listpred (remove dec x l) =p=> listpred l.
  Proof.
    intros.
    induction l.
    cancel.
    simpl; destruct (dec x a); subst.
    - inversion H0. rewrite remove_not_In; eauto.
    - simpl; cancel.
      rewrite <- IHl. cancel. inversion H0. eauto. eauto.
  Qed.

  Theorem listpred_remove_piff :
    forall (dec : forall x y : T, {x = y} + {x <> y}) x l,
    (forall (y : T) m', ~ (prd y * prd y)%pred m') ->
    NoDup l ->
    In x l ->
    listpred l <=p=> prd x * listpred (remove dec x l).
  Proof.
    split.
    eapply listpred_remove; eauto.
    eapply listpred_remove'; eauto.
  Qed.

  (**
   * For certain kinds of "complete" predicates, if two memories match
   * [listpred] over the same list, then the memories are equal.
   *)
  Theorem listpred_eq : forall l m1 m2,
    (forall x ma mb, prd x ma -> prd x mb -> ma = mb) ->
    listpred l m1 -> listpred l m2 -> m1 = m2.
  Proof.
    induction l; simpl; intros.
    - apply emp_complete; eauto.
    - unfold sep_star in *; rewrite sep_star_is in *; unfold sep_star_impl in *.
      repeat deex.
      assert (m2 = m0) by eauto; subst.
      assert (m4 = m3) by eauto; subst.
      reflexivity.
  Qed.

  Theorem listpred_emp : forall l,
    (forall x, In x l -> prd x =p=> emp) ->
    listpred l =p=> emp.
  Proof.
    induction l; intros.
    rewrite listpred_nil; auto.
    simpl.
    rewrite H; intuition.
    rewrite IHl. cancel.
    intros.
    rewrite H; intuition.
  Qed.

  Theorem listpred_emp_piff : forall l,
    (forall x, In x l -> prd x <=p=> emp) ->
    listpred l <=p=> emp.
  Proof.
    induction l; intros.
    rewrite listpred_nil; auto.
    simpl.
    rewrite H; intuition.
    rewrite IHl.
    split; cancel.
    intros.
    rewrite H; intuition.
  Qed.

  Lemma listpred_partition: forall f (l : list T),
    let p := partition f l in
    listpred l <=p=> listpred (fst p) * listpred (snd p).
  Proof.
    cbn; induction l; cbn.
    split; cancel.
    destruct partition eqn:?; cbn in *; intros.
    rewrite IHl.
    destruct f; split; cancel.
  Qed.

  Lemma listpred_rev: forall l,
    listpred l <=p=> listpred (rev l).
  Proof.
    induction l; cbn; intros.
    split; cancel.
    rewrite listpred_app.
    rewrite IHl.
    split; cancel.
  Qed.

End LISTPRED.

Theorem listpred_lift : forall T l AT AEQ V prd F G,
  (forall x, In x l -> prd x <=p=> [[ F x ]] * G x) ->
  @listpred T AT AEQ V prd l <=p=> [[ Forall F l ]] * listpred G l.
Proof.
  intros; induction l.
  split; cancel.
  simpl; rewrite H; intuition.
  rewrite IHl.
  split; cancel; inversion H1; auto.
  intros.
  apply H; intuition.
Qed.

Theorem listpred_unify : forall T l1 l2 AT AEQ V f F1 F2 m,
    (forall Fa Fb a b, In a l1 -> In b l2 -> (Fa * f a)%pred m -> (Fb * f b)%pred m -> a = b) ->
    (F1 * @listpred T AT AEQ V f l1)%pred m -> (F2 * listpred f l2)%pred m ->
    length l1 = length l2 ->
    l1 = l2.
Proof.
  induction l1; intros; destruct l2; simpl in *; auto; inversion H2.
  f_equal.
  eapply H; auto; match goal with [H : _ |- _] => solve [eapply pimpl_apply; [> | exact H]; cancel] end.
  eapply IHl1; intros;
  repeat match goal with
    | [a : T, b : T |- ?a = ?b ] => eapply H
    | [H : _ |- _] => solve [intuition | apply H | eapply pimpl_apply; [> | exact H]; cancel]
  end.
Qed.

Lemma listpred_pimpl_replace: forall T AT V M (l : list T) (F G : T -> @pred AT M V),
       (forall x, In x l -> F x =p=> G x) ->
       listpred F l =p=> listpred G l.
Proof.
  induction l; cbn; intros; auto.
  rewrite H; auto.
  cancel.
  eauto.
Qed.

Lemma listpred_piff_replace : forall A B AT M l F G,
  (forall x, In x l -> F x <=p=> G x) -> @listpred A B AT M F l <=p=> listpred G l.
Proof.
  induction l; intros; split; cancel.
  rewrite IHl, H by auto; cancel.
  rewrite IHl, H by (intuition; symmetry; auto); cancel.
Qed.

Lemma listpred_ptsto_notindomain : forall AT AEQ V (t : list AT) x (m : @Mem.mem _ AEQ V),
  listpred (fun a => (a |->?)%pred) t m ->
  ~In x t ->
  notindomain x m.
Proof.
  induction t; cbn; intros; unfold notindomain.
  cbv [emp] in *; auto.
  intuition.
  revert H.
  unfold_sep_star.
  intuition repeat deex.
  eapply mem_union_sel_none.
  unfold exis in *. deex.
  eapply ptsto_ne; eauto.
  eapply IHt; eauto.
Qed.

(* predicate over a pair of lists *)

Section LISTMATCH.

  Set Default Proof Using "Type".

  Variable A : Type.
  Variable B : Type.
  Variable AT : Type.
  Variable AEQ : EqDec AT.
  Variable V : Type.
  Variable prd : A -> B -> @pred AT AEQ V.

  Definition pprd := prod_curry prd.

  Definition listmatch (a : list A) (b : list B) :=
    ([[ length a = length b ]] *
     listpred pprd (List.combine a b))%pred.

  Lemma listmatch_length : forall a b m,
    (listmatch a b)%pred m -> length a = length b.
  Proof.
    unfold listmatch; intros.
    destruct_lift H; auto.
  Qed.

  Lemma listmatch_length_r : forall F a b m,
    (F * listmatch a b)%pred m -> length a = length b.
  Proof.
    unfold listmatch; intros.
    destruct_lift H; auto.
  Qed.

  Lemma listmatch_length_l : forall F a b m,
    (listmatch a b * F)%pred m -> length a = length b.
  Proof.
    unfold listmatch; intros.
    destruct_lift H; auto.
  Qed.

  Lemma listmatch_length_pimpl : forall a b,
    listmatch a b =p=> (listmatch a b) * [[ length a = length b ]].
  Proof.
    unfold listmatch; cancel.
  Qed.

  Lemma listmatch_cons: forall (a : list A) (b : list B) x y,
    listmatch (x :: a) (y :: b) <=p=> prd x y * listmatch a b.
  Proof.
    unfold listmatch.
    split; cancel.
  Qed.

  Theorem listmatch_isolate : forall a b i ad bd,
    i < length a -> i < length b ->
    listmatch a b <=p=>
    listmatch (removeN a i) (removeN b i) * prd (selN a i ad) (selN b i bd).
  Proof.
    intros; unfold listmatch.
    unfold piff; split.

    cancel.
    rewrite listpred_isolate with (i := i) (def := (ad, bd)) at 1.
    rewrite removeN_combine.
    rewrite selN_combine; auto.
    rewrite combine_length; rewrite <- H2; rewrite Nat.min_id; auto.
    repeat rewrite removeN_length by omega.
    omega.

    cancel.
    eapply removeN_length_eq with (a:=a) (b:=b) in H0; eauto.
    eapply pimpl_trans2.
    rewrite listpred_isolate with (i := i) (def := (ad, bd)).
    rewrite removeN_combine.
    rewrite selN_combine; auto.
    apply pimpl_refl.
    rewrite combine_length; rewrite <- H0; rewrite Nat.min_id; auto.
    repeat rewrite removeN_length by omega.
    cancel.
    eapply removeN_length_eq with (a:=a) (b:=b) in H1; eauto.
  Qed.

  Theorem listmatch_extract : forall a b i ad bd,
    i < length a ->
    listmatch a b =p=>
    [[ length a = length b ]] *
    listmatch (removeN a i) (removeN b i) * prd (selN a i ad) (selN b i bd).
  Proof.
    intros; unfold listmatch.
    cancel.
    rewrite listpred_isolate with (i := i) (def := (ad, bd)) at 1.
    rewrite removeN_combine.
    rewrite selN_combine; auto.
    rewrite combine_length; rewrite <- H1; rewrite Nat.min_id; auto.
    repeat rewrite removeN_length by omega.
    omega.
  Qed.

  Theorem listmatch_updN_removeN : forall a b i av bv,
    i < length a -> i < length b ->
    listmatch (updN a i av) (updN b i bv) <=p=>
    listmatch (removeN a i) (removeN b i) * (prd av bv).
  Proof.
    intros; unfold piff; split.
    rewrite listmatch_isolate with (ad := av) (bd := bv);
      [ | rewrite length_updN; eauto ..].
    repeat rewrite selN_updN_eq by auto.
    repeat rewrite removeN_updN; auto.

    eapply pimpl_trans2.
    rewrite listmatch_isolate with (i := i) (ad := av) (bd := bv);
      [ | rewrite length_updN; eauto ..].
    apply pimpl_refl.
    repeat rewrite selN_updN_eq by auto.
    repeat rewrite removeN_updN; auto.
  Qed.

  Theorem listmatch_updN_selN: forall a b i av bv ad bd,
    i < length a -> i < length b ->
    prd (selN a i ad) (selN b i bd) =p=> prd av bv ->
    listmatch a b =p=> listmatch (updN a i av) (updN b i bv).
  Proof.
    intros.
    rewrite listmatch_updN_removeN by auto.
    rewrite listmatch_isolate with (ad := ad) (bd := bd) by eauto.
    cancel; auto.
  Qed.

  Theorem listmatch_updN_selN_r: forall F a b i av bv ad bd,
    i < length a -> i < length b ->
    (prd (selN a i ad) (selN b i bd)) * F =p=> prd av bv ->
    (listmatch a b) * F =p=> listmatch (updN a i av) (updN b i bv).
  Proof.
    intros.
    rewrite listmatch_updN_removeN by auto.
    rewrite listmatch_isolate with (ad := ad) (bd := bd) by eauto.
    cancel; rewrite sep_star_comm; auto.
  Qed.

  Theorem listmatch_app_tail: forall F a b av bv,
    length a = length b ->
    F =p=> prd av bv ->
    (listmatch a b) * F =p=> listmatch (a ++ av :: nil) (b ++ bv :: nil).
  Proof.
    intros.
    eapply pimpl_trans2.
    eapply listmatch_isolate with (i := length a);
    try rewrite app_length; simpl; omega.
    rewrite removeN_tail.
    rewrite selN_last with (def := av); auto.
    rewrite H.
    rewrite removeN_tail.
    rewrite selN_last with (def := bv); auto.
    cancel; auto.
  Qed.

  Theorem listmatch_app : forall a1 b1 a2 b2,
    listmatch a1 b1 * listmatch a2 b2 =p=> listmatch (a1 ++ a2) (b1 ++ b2).
  Proof.
    unfold listmatch; intros; cancel.
    repeat rewrite combine_app by auto.
    rewrite listpred_app; cancel.
    repeat rewrite app_length; omega.
  Qed.

  Theorem listmatch_app_rev : forall a1 b1 a2 b2,
    length a1 = length b1 \/ length a2 = length b2 ->
    listmatch (a1 ++ a2) (b1 ++ b2) =p=> listmatch a1 b1 * listmatch a2 b2.
  Proof.
    unfold listmatch; cancel;
    repeat rewrite app_length in *;
    repeat (omega || rewrite combine_app || apply listpred_app).
  Qed.

  Theorem listmatch_split : forall a b n,
    listmatch a b <=p=> listmatch (firstn n a) (firstn n b) * listmatch (skipn n a) (skipn n b).
  Proof.
    unfold listmatch; intros.
    rewrite listpred_split with (n := n).
    rewrite firstn_combine_comm.
    split; cancel.
    rewrite skipn_combine; eauto; cancel.
    repeat rewrite firstn_length; auto.
    repeat rewrite skipn_length; auto.
    rewrite skipn_combine; auto.
    eapply skipn_firstn_length_eq; eauto.
    eapply skipn_firstn_length_eq; eauto.
  Qed.

  Theorem listmatch_emp : forall l1 l2,
    (forall x y, In x l1 -> In y l2 -> prd x y =p=> emp) ->
    listmatch l1 l2 =p=> emp.
  Proof.
    intros.
    unfold listmatch.
    rewrite listpred_emp.
    cancel.
    intros; destruct x; simpl.
    apply H; solve [eapply in_combine_l; eauto |eapply in_combine_r; eauto].
  Qed.

  Theorem listmatch_emp_piff : forall l1 l2,
    (forall x y, In x l1 -> In y l2 -> prd x y <=p=> emp) ->
    listmatch l1 l2 <=p=> [[ length l1 = length l2 ]].
  Proof.
    split.
    rewrite listmatch_length_pimpl; cancel.
    apply listmatch_emp; intuition.
    rewrite H; auto.
    unfold listmatch; rewrite listpred_emp_piff.
    cancel.
    intros; destruct x; simpl.
    apply H; solve [eapply in_combine_l; eauto |eapply in_combine_r; eauto].
  Qed.

  Theorem listmatch_repeat_l : forall v n l2,
    listmatch (repeat v n) l2 <=p=> [[ n = length l2 ]] * listpred (prd v) l2.
  Proof.
    unfold listmatch. intros.
    rewrite repeat_length.
    destruct (Nat.eq_dec n (length l2)); [> | split; cancel].
    apply piff_star_l; subst.
    induction l2; intros.
    - rewrite combine_l_nil. split; cancel.
    - simpl. rewrite IHl2. auto.
  Qed.

  Theorem listmatch_repeat_r : forall v n l1,
    listmatch l1 (repeat v n) <=p=> [[ length l1 = n]] * listpred (fun x => prd x v) l1.
  Proof.
    unfold listmatch. intros.
    rewrite repeat_length.
    destruct (Nat.eq_dec n (length l1)); [> | split; cancel].
    apply piff_star_l; subst.
    induction l1; intros.
    - rewrite combine_l_nil. split; cancel.
    - simpl. rewrite IHl1. auto.
  Qed.

  Lemma listpred_exis_listmatch: forall (a : list A),
    listpred (fun a => exists b, prd a b) a =p=> exists b, listmatch a b.
  Proof.
    induction a; cbn; intros.
    exists nil.
    unfold listmatch. pred_apply; cancel.
    rewrite IHa.
    cancel.
    rewrite listmatch_cons with (b := b0).
    cancel.
  Qed.

  Lemma listmatch_rev: forall a b,
    listmatch a b <=p=> listmatch (rev a) (rev b).
  Proof.
    unfold listmatch.
    intros.
    rewrite listpred_rev.
    repeat rewrite rev_length.
    split; cancel; rewrite ?combine_rev by auto; cancel.
  Qed.

End LISTMATCH.

Theorem listmatch_lift : forall A B AT AEQ V prd (l1 : list A) (l2 : list B) F P,
  (forall x y, In x l1 -> In y l2 -> prd x y ⇦⇨ ⟦⟦ P x y ⟧⟧ ✶ F x y) ->
  @listmatch A B AT AEQ V prd l1 l2 <=p=> [[ Forall2 P l1 l2]] * listmatch F l1 l2.
Proof.
  intros.
  unfold listmatch.
  rewrite listpred_lift.
  split; cancel.
  apply forall_forall2; eauto.
  apply forall2_forall; eauto.
  intros; simpl.
  destruct x; simpl; auto.
  apply H.
  eapply in_combine_l; eauto.
  eapply in_combine_r; eauto.
Qed.

Theorem listmatch_lift_l : forall A B AT AEQ V prd (l1 : list A) (l2 : list B) F P,
  (forall x y, In x l1 -> In y l2 -> prd x y ⇦⇨ ⟦⟦ P x ⟧⟧ ✶ F x y) ->
  @listmatch A B AT AEQ V prd l1 l2 <=p=> [[ Forall P l1 ]] * listmatch F l1 l2.
Proof.
  intros.
  rewrite listmatch_lift with (P := fun x y => P x); eauto.
  split; intros m HH; rewrite listmatch_length_pimpl in HH; pred_apply; cancel.
  - erewrite <- map_fst_combine, <- Forall_map; eauto.
    match goal with [H : Forall2 _ _ _ |- _] => apply forall2_forall in H end.
    auto.
  - apply forall_forall2; auto.
    rewrite Forall_map.
    rewrite map_fst_combine; auto.
Qed.

Lemma listmatch_pimpl_replace: forall A B AT T M la lb (F G : A -> B -> @pred AT M T),
       (forall x y, In x la -> In y lb -> F x y =p=> G x y) ->
       listmatch F la lb =p=> listmatch G la lb.
Proof.
  unfold listmatch.
  intros.
  rewrite listpred_pimpl_replace; cancel.
  eauto using in_combine_l, in_combine_r.
Qed.

Lemma listmatch_piff_replace : forall A B AT T M l1 l2 F G,
  (forall x y, In x l1 -> In y l2 -> F x y <=p=> G x y) -> @listmatch A B AT M T F l1 l2 <=p=> listmatch G l1 l2.
Proof.
  unfold listmatch; intros.
  rewrite listpred_piff_replace.
  split; cancel.
  intros a; destruct a; intros HH; simpl; auto.
  apply H; solve [eapply in_combine_l; eauto | eapply in_combine_r; eauto].
Qed.

Lemma listmatch_nodup: forall AT AEQ V (a : list AT) (b : list V) (F : @pred AT AEQ V) m,
  (F * listmatch (fun x y => x |-> y) a b)%pred m -> NoDup a.
Proof.
  induction a; cbn; intros.
  constructor.
  destruct b; cbn in *.
  unfold listmatch in *. destruct_lifts. congruence.
  rewrite listmatch_cons in H.
  constructor.
  unfold listmatch in H.
  intro H'.
  eapply in_selN_exists in H'.
  destruct H' as [? [? Hs] ].
  destruct_lifts.
  rewrite listpred_pick in H.
  unfold pprd, prod_curry in *.
  2: eapply in_selN.
  erewrite selN_combine in H by auto.
  2: rewrite combine_length_eq; eauto.
  rewrite Hs in H.
  destruct_lifts.
  eapply ptsto_conflict_F with (a := a) (m := m).
  pred_apply. cancel.
  eapply IHa with (b := b) (m := m). pred_apply. cancel.
Unshelve.
  all: eauto.
Qed.

Lemma arrayN_listpred_seq : forall V l st n,
  length l = n ->
  arrayN (@ptsto _ _ V) st l =p=> listpred (fun a => a |->?) (seq st n).
Proof.
  induction l; destruct n; simpl; intros; try omega; auto.
  rewrite IHl.
  cancel.
  omega.
Qed.

Lemma arrayN_listpred_seq_fp : forall V FP l st n,
  length l = n ->
  Forall FP l ->
  arrayN (@ptsto _ _ V) st l =p=> listpred (fun a => exists v, a |-> v * [[ FP v ]]) (seq st n).
Proof.
  induction l; destruct n; simpl; intros; try omega; auto.
  inversion H0; subst.
  rewrite IHl; auto.
  cancel.
  replace (length l) with n by omega.
  cancel.
Qed.

Lemma listmatch_sym : forall AT AEQ V A B (al : list A) (bl : list B) f,
  (@listmatch _ _ AT AEQ V) f al bl <=p=>
  listmatch (fun b a => f a b) bl al.
Proof.
  unfold listmatch; intros.
  split; cancel;
  generalize dependent bl;
  generalize dependent al;
  induction al; destruct bl; cancel; auto.
Qed.

Lemma listmatch_map_l : forall AT AEQ V A B C al bl f (g : A -> C),
  (@listmatch C B AT AEQ V) f (map g al) bl <=p=>
  (@listmatch A B _ _ _) (fun a b => f (g a) b) al bl.
Proof.
  unfold listmatch; intros.
  split; cancel; autorewrite with lists in *; auto;
  generalize dependent bl;
  generalize dependent al;
  induction al; destruct bl; cancel; auto.
Qed.

Lemma listmatch_map_r : forall AT AEQ V A B C al bl f (g : B -> C),
  (@listmatch A C AT AEQ V) f al (map g bl) <=p=>
  (@listmatch A B _ _ _) (fun a b => f a (g b)) al bl.
Proof.
  intros.
  rewrite listmatch_sym.
  rewrite listmatch_map_l.
  rewrite listmatch_sym; auto.
Qed.

Lemma listmatch_map : forall AT AEQ V A B A' B' al bl f (fa : A -> A') (fb : B -> B'),
  (@listmatch A B AT AEQ V) (fun a b => f (fa a) (fb b)) al bl <=p=>
  (@listmatch A' B' _ _ _) f (map fa al) (map fb bl).
Proof.
  intros; rewrite listmatch_map_l, listmatch_map_r; auto.
Qed.

Lemma listpred_map : forall AT AEQ V A B l f (g : A -> B),
  @listpred B AT AEQ V f (map g l) <=p=>
  @listpred A AT AEQ V (fun a => f (g a)) l.
Proof.
  induction l; simpl; intros; auto.
  split; cancel; rewrite IHl; auto.
Qed.

Lemma listmatch_ptsto_listpred : forall AT AEQ V (al : list AT) (vl : list V),
  listmatch (fun v a => a |-> v) vl al =p=>
  (@listpred _ _ AEQ _) (fun a => a |->?) al.
Proof.
  unfold listmatch; induction al; destruct vl.
  cancel. cancel.
  norml; inversion H0.
  cancel; inversion H0.
  unfold pimpl in *; intros.
  eapply IHal; eauto.
  pred_apply; cancel.
Qed.

Theorem listmatch_lift_r : forall AT AEQ V A C l1 l2 f F P,
  (forall x y, In x l1 -> In y l2 -> f x y <=p=> ([[ P y ]] * F x y)%pred) ->
  @listmatch A C AT AEQ V f l1 l2 <=p=> [[ Forall P l2 ]] * listmatch F l1 l2.
Proof.
  intros.
  rewrite listmatch_sym.
  rewrite listmatch_lift_l.
  split; cancel; eauto; try apply listmatch_sym.
  simpl; auto.
Qed.

Lemma listmatch_unify : forall A B la lb l1 l2 AT AEQ V F1 F2 (f : A -> B -> @pred AT AEQ V) m,
  (forall Fa Fb xa xb ya yb, In xa la -> In xb lb -> In ya l1 -> In yb l2 ->
  (Fa * f xa ya)%pred m -> (Fb * f xb yb)%pred m -> (xa = xb /\ ya = yb)) ->
  (F1 * listmatch f la l1)%pred m -> (F2 * listmatch f lb l2)%pred m ->
  length la = length lb ->
  la = lb /\ l1 = l2.
Proof.
  intros.
  unfold listmatch in *.
  repeat match goal with [H: context [lift_empty] |- _] => destruct_lift H end.
  split.
  1 : rewrite <- map_fst_combine with (a := la) (b := l1); auto.
  1 : rewrite <- map_fst_combine with (a := lb) (b := l2); auto.
  2 : rewrite <- map_snd_combine with (a := la) (b := l1); auto.
  2 : rewrite <- map_snd_combine with (a := lb) (b := l2); auto.
  all : f_equal; eapply listpred_unify; eauto.
  all : repeat rewrite combine_length_eq2; try omega.
  all : intros; destruct a, b; simpl in *.
  all : edestruct H;
        solve [eauto | subst; eauto |
               eapply in_combine_l; eauto |
               eapply in_combine_r; eauto ].
Qed.

Lemma listmatch_unify_r : forall A B l l1 l2 AT AEQ V F1 F2 (f : A -> B -> @pred AT AEQ V) m,
  (forall Fa Fb x ya yb, In x l -> In ya l1 -> In yb l2 ->
  (Fa * f x ya)%pred m -> (Fb * f x yb)%pred m -> (ya = yb)) ->
  (F1 * listmatch f l l1)%pred m -> (F2 * listmatch f l l2)%pred m ->
  l1 = l2.
Proof.
  induction l; intros; destruct l1, l2; auto.
  all : unfold listmatch in *;
        destruct_lift H0; destruct_lift H1;
        match goal with
        | [ H : 0 = S _ |- _] => inversion H
        | [ H : S _ = 0 |- _] => inversion H
        | [ |- _] => idtac
        end.
  f_equal; [> eapply H | eapply IHl]; intros;
    try match goal with
    | [ |- _ \/ _] => left; eauto
    | [ |- _ = _ ] => eapply H
    end; eauto.
  all : match goal with
  | [H : _ |- _] => solve [eapply pimpl_apply; [> | exact H]; cancel]
  end.
Qed.

Lemma listmatch_unify_l : forall A B l la lb AT AEQ V F1 F2 (f : A -> B -> @pred AT AEQ V) m,
  (forall Fa Fb xa xb y, In xa la -> In xb lb -> In y l ->
  (Fa * f xa y)%pred m -> (Fb * f xb y)%pred m -> (xa = xb)) ->
  (F1 * listmatch f la l)%pred m -> (F2 * listmatch f lb l)%pred m ->
  la = lb.
Proof.
  intros.
  rewrite listmatch_sym in H0.
  rewrite listmatch_sym in H1.
  eapply listmatch_unify_r; eauto.
  intros.
  eapply H; eauto.
Qed.

Theorem xform_listpred : forall V (l : list V) prd,
  crash_xform (listpred prd l) <=p=> listpred (fun x => crash_xform (prd x)) l.
Proof.
  induction l; simpl; intros; split; auto; xform_dist; auto.
  rewrite IHl; auto.
  rewrite IHl; auto.
Qed.

Lemma crash_xform_pprd : forall A B (prd : A -> B -> rawpred),
  (fun p => crash_xform (pprd prd p)) =
  (pprd (fun x y => crash_xform (prd x y))).
Proof.
  unfold pprd, prod_curry, crash_xform; intros.
  apply functional_extensionality; intros; destruct x; auto.
Qed.

Theorem xform_listmatch : forall A B (a : list A) (b : list B) prd,
  crash_xform (listmatch prd a b) <=p=> listmatch (fun x y => crash_xform (prd x y)) a b.
Proof.
  unfold listmatch; intros; split; xform_norm;
  rewrite xform_listpred; cancel;
  rewrite crash_xform_pprd; auto.
Qed.

Theorem xform_listpred_idem_l : forall V (l : list V) prd,
  (forall e, crash_xform (prd e) =p=> prd e) ->
  crash_xform (listpred prd l) =p=> listpred prd l.
Proof.
  induction l; simpl; intros; auto.
  xform_dist.
  rewrite H.
  rewrite IHl; auto.
Qed.

Theorem xform_listpred_idem_r : forall V (l : list V) prd,
  (forall e,  prd e =p=> crash_xform (prd e)) ->
  listpred prd l =p=> crash_xform (listpred prd l).
Proof.
  induction l; simpl; intros; auto.
  xform_dist; auto.
  xform_dist.
  rewrite <- H.
  rewrite <- IHl; auto.
Qed.

Theorem xform_listpred_idem : forall V (l : list V) prd,
  (forall e, crash_xform (prd e) <=p=> prd e) ->
  crash_xform (listpred prd l) <=p=> listpred prd l.
Proof.
  split.
  apply xform_listpred_idem_l; intros.
  apply H.
  apply xform_listpred_idem_r; intros.
  apply H.
Qed.

Theorem xform_listmatch_idem_l : forall A B (a : list A) (b : list B) prd,
  (forall a b, crash_xform (prd a b) =p=> prd a b) ->
  crash_xform (listmatch prd a b) =p=> listmatch prd a b.
Proof.
  unfold listmatch; intros.
  xform_norm; cancel.
  apply xform_listpred_idem_l; intros.
  destruct e; cbn; auto.
Qed.

Theorem xform_listmatch_idem_r : forall A B (a : list A) (b : list B) prd,
  (forall a b,  prd a b =p=> crash_xform (prd a b)) ->
  listmatch prd a b =p=> crash_xform (listmatch prd a b).
Proof.
  unfold listmatch; intros.
  cancel.
  xform_normr.
  rewrite <- xform_listpred_idem_r; cancel.
  auto.
Qed.

Theorem xform_listmatch_idem : forall A B (a : list A) (b : list B) prd,
  (forall a b, crash_xform (prd a b) <=p=> prd a b) ->
  crash_xform (listmatch prd a b) <=p=> listmatch prd a b.
Proof.
  split.
  apply xform_listmatch_idem_l; auto.
  apply H.
  apply xform_listmatch_idem_r; auto.
  apply H.
Qed.

Lemma xform_listpred_ptsto : forall l,
  crash_xform (listpred (fun a => a |->?) l) =p=>
               listpred (fun a => a |->?) l.
Proof.
  induction l; simpl.
  rewrite crash_invariant_emp; auto.
  xform_dist.
  rewrite crash_xform_ptsto_exis, IHl.
  auto.
Qed.

Lemma xform_listpred_ptsto_fp : forall FP,
  (forall a, crash_xform (exists v, a |-> v * [[ FP v ]]) =p=> exists v, a |-> v * [[ FP v ]]) ->
  forall l,
  crash_xform (listpred (fun a => exists v, a |-> v * [[ FP v ]]) l) =p=>
               listpred (fun a => exists v, a |-> v * [[ FP v ]]) l.
Proof.
  induction l; simpl.
  rewrite crash_invariant_emp; auto.
  xform_dist.
  rewrite H.
  rewrite IHl.
  cancel.
Qed.

Lemma xform_listmatch_ptsto : forall al vl,
  crash_xform (listmatch (fun v a => a |-> v) vl al) =p=>
    exists l, [[ possible_crash_list vl l ]] *
    listmatch (fun v a => a |-> v) (synced_list l) al.
Proof.
  unfold listmatch; induction al; destruct vl; xform_norm.
  - cancel. instantiate (1 := nil); simpl; auto.
    unfold possible_crash_list; intuition; inversion H.
    rewrite synced_list_length; auto.
  - inversion H0.
  - inversion H0.
  - rewrite crash_xform_ptsto.
    specialize (IHal vl).
    rewrite crash_xform_sep_star_dist, crash_xform_lift_empty in IHal.
    inversion H; subst.
    setoid_rewrite lift_impl with (Q := length vl = length al) at 3; intros; eauto.
    rewrite IHal; simpl.

    cancel.
    eassign (v' :: l); cancel.
    simpl; cancel.
    apply possible_crash_list_cons; simpl; auto.
    rewrite synced_list_length in *; simpl; omega.
    apply possible_crash_list_cons; simpl; auto.
    rewrite synced_list_length in *; simpl; omega.
Qed.

Theorem sync_invariant_listpred : forall T prd (l : list T),
  (forall x, sync_invariant (prd x)) ->
  sync_invariant (listpred prd l).
Proof.
  induction l; simpl; eauto.
Qed.

Hint Resolve sync_invariant_listpred.

Theorem sync_xform_listpred : forall V (l : list V) prd,
  sync_xform (listpred prd l) <=p=> listpred (fun x => sync_xform (prd x)) l.
Proof.
  induction l; simpl; intros; split; auto.
  apply sync_xform_emp.
  apply sync_xform_emp.
  rewrite sync_xform_sep_star_dist.
  rewrite IHl; auto.
  rewrite sync_xform_sep_star_dist.
  rewrite IHl; auto.
Qed.

Lemma sync_xform_listpred' : forall T (l : list T) p q,
  (forall x, sync_xform (p x) =p=> q x) ->
  sync_xform (listpred p l) =p=> listpred q l.
Proof.
  induction l; simpl; intros; auto.
  apply sync_xform_emp.
  repeat rewrite sync_xform_sep_star_dist.
  rewrite IHl by eauto.
  rewrite H; auto.
Qed.


Require Export XR_not_0_IZR.
Require Export XR_lt_IZR.

Local Open Scope R_scope.

Lemma le_0_IZR : forall n:Z, R0 <= IZR n -> (0 <= n)%Z.
Proof.
  intros n h.
  unfold "<=" in h.
  destruct h as [ h | heq ].
  {
    apply Z.lt_le_incl.
    apply lt_IZR.
    simpl.
    exact h.
  }
  {
    apply Z.eq_le_incl.
    apply eq_IZR.
    simpl.
    exact heq.
  }
Qed.