Skip to content

Some finmap/multiset lemmas that might be useful #4

@mituharu

Description

@mituharu

Hello,

Through an experimental formalization of well-foundedness of multiset ordering, I found the following finmap/multiset lemmas convenient. Some of them might also be useful for general use.

(Update: proofs are slightly simplified. Previously I didn't notice mset1D1.)

Section BigFSetExt.

Local Open Scope fset_scope.

Variable (R : Type) (idx : R) (op : Monoid.com_law idx).

Lemma big_fincl (T : choiceType) (A B : {fset T}) (AsubB : A `<=` B)
      (P : pred B) (F : B -> R) :
  \big[op/idx]_(a : A | P (fincl AsubB a)) F (fincl AsubB a) =
  \big[op/idx]_(b : B | P b && (val b \in A)) F b.
Proof.
  have [Aisfset0 | [d dinA]] := fset_0Vmem A.
  - rewrite !big_pred0 //= => [b | a]; first by rewrite Aisfset0 inE andbF.
    by have := valP a; rewrite [X in _ \in X]Aisfset0 inE.
  - rewrite (reindex (fincl AsubB)).
    + by apply: eq_bigl => /= a; rewrite (valP a) andbT.
    + exists (fun b : B => insubd [` dinA] (val b)) => /= [a _ | a].
      * by apply: val_inj; rewrite val_insubd (valP a).
      * rewrite inE => /andP [_ vainA]; apply: val_inj.
        by rewrite /= val_insubd vainA.
Qed.

End BigFSetExt.


Section BigMSet.
Variable (R : Type) (idx : R) (op : Monoid.law idx).

Lemma big_mset0 (T : choiceType) (P : pred _) (F : _ -> R) :
  \big[op/idx]_(i : @mset0 T | P i) F i = idx :> R.
Proof. by apply: big_pred0 => -[j hj]; have := hj; rewrite in_mset0. Qed.

End BigMSet.


Section MSetTheoryExt.

Local Open Scope fset_scope.
Local Open Scope mset_scope.
Local Open Scope nat_scope.

Context {K : choiceType}.
Implicit Types (a b c : K) (A B C : {mset K}).

Lemma msub1set A a : ([mset a] `<=` A) = (a \in A).
Proof.
  apply/msubsetP/idP; first by move/(_ a); rewrite msetnxx in_mset.
  by move=> ainA b; rewrite msetnE; case: eqP => // ->; rewrite -in_mset.
Qed.

Lemma msetDBA A B C : C `<=` B -> A `+` B `\` C = (A `+` B) `\` C.
Proof.
  by move=> /msubsetP CB; apply/msetP=> a; rewrite !msetE2 addnBA.
Qed.

Lemma mset_0Vmem A : (A = mset0) + {x : K | x \in A}.
Proof.
  have [/fsetP Aisfset0 | [a ainA]] := fset_0Vmem A; last by right; exists a.
  left; apply/msetP => a; rewrite mset0E; apply/mset_eq0P.
  by rewrite Aisfset0 inE.
Qed.

Definition msetsize A := \sum_(a : A) A (val a).

Lemma msetsize0 : msetsize mset0 = 0.
Proof. exact: big_mset0. Qed.

Lemma msetsize_eq0 A : (msetsize A == 0) = (A == mset0).
Proof.
  rewrite sum_nat_eq0.
  apply/forallP/eqP => /= [Ax | -> a]; last by have := valP a; rewrite in_msetE.
  apply/msetP => a; rewrite mset0E; apply/mset_eq0P/negP => ainA.
  by have := Ax [` ainA] => /=; rewrite mset_eq0 ainA.
Qed.

Lemma msetsize1D a A : msetsize (a +` A) = (msetsize A).+1.
Proof.
  pose ainaA := [` mset1D1 a A].
  rewrite /msetsize (bigD1 ainaA) //= mset1DE eqxx add1n addSn; congr S.
  rewrite [X in _ + X](_ : _ = \sum_(b : a +` A | (b != ainaA) && (val b \in A))
                                A (val b)); last first.
  - apply: eq_big => a0; last by rewrite -!val_eqE /= mset1DE => /negbTE ->.
    by have := valP a0; rewrite -!val_eqE /= in_msetE; case: (val a0 == a).
  - have AsubaA: (A `<=` a +` A)%fset
      by apply/fsubsetP => a0; rewrite in_msetE => ->; rewrite orbT.
    have [ainA | aninA] := boolP (a \in A).
    + rewrite (bigD1 [` ainA]) //=; congr addn.
      by rewrite -big_fincl /=; apply: eq_bigl => a0; rewrite -!val_eqE.
    + rewrite (mset_eq0P aninA) add0n -big_fincl /=; apply: eq_bigl => a0.
      by rewrite -val_eqE /=; apply: contraNneq aninA => <-; apply: valP.
Qed.

Lemma mset_ind P:
  P mset0 -> (forall a A, P A -> P (a +` A)) -> forall A, P A.
Proof.
  move=> base step A.
  elim: {A}(msetsize A) {-2}A (erefl (msetsize A)) => [|n IHn] A.
  - by move/eqP; rewrite msetsize_eq0 => /eqP ->.
  - have [-> | [a ainA]] := mset_0Vmem A; first by rewrite msetsize0.
    by rewrite -(msetB1K _ _ ainA) msetsize1D => -[] /IHn; apply: step.
Qed.

Lemma msubset_ind B P:
  P B -> (forall A a, B `<=` A -> P A -> P (a +` A)) ->
  forall A, B `<=` A -> P A.
Proof.
  move=> base step A.
  elim/mset_ind: {A}(A `\` B) {-2}A (erefl (A `\` B)) => [| a D IH] A.
  - move/eqP. rewrite msetB_eq0 => AsubB BsubA.
    by rewrite (_ : A = B) //; apply/eqP; rewrite eqEmsubset AsubB BsubA.
  - move=> AdiffB BsubA.
    have: a \in A by rewrite -(msetBDKC _ _ BsubA) AdiffB in_msetE mset1D1 orbT.
    move/msetB1K => <-.
    have BsubAa: B `<=` A `\ a.
    + rewrite -(msetBBK _ _ BsubA); apply: msetBS.
      by rewrite AdiffB msub1set mset1D1.
    + apply: step => //; apply: IH => //.
      by rewrite -(msetD1K a D) -AdiffB -!msetBDA [in LHS]msetDC.
Qed.

End MSetTheoryExt.

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type
    No fields configured for issues without a type.

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions