https://github.com/suneel-sarswat/dsam
Tip revision: 81ed4b1c2c07db12de7e9db78fa6538ad31e01de authored by Suneel Sarswat on 23 February 2021, 12:55:22 UTC
time stamp comment added
time stamp comment added
Tip revision: 81ed4b1
Quantity.v
(*This file contains functions and their properties related to total quantities.*)
Require Import Wellfounded List Arith Lia.
Require Import ssreflect ssrbool.
Require Export Lists.List.
Require Export GenReflect SetSpecs.
Require Export DecSort MinMax.
Require Export mBidAsk.
Require Export DecList.
Section quantity.
(* Sum of total quantities of a bid and ask in fill_type and their properties *)
Fixpoint ttqb (F: list fill_type) (b:Bid) : (nat) :=
match F with
|nil => 0
|f::F'=> match (b_eqb b (bid_of f)) with
|true => (tq f)+(ttqb F' b)
|false => (ttqb F' b)
end
end.
Lemma ttqb_elim (M:list fill_type) (b:Bid) : ~In b (bids_of M) -> ttqb M b = 0.
Proof. intros. induction M. simpl. auto. simpl in H.
simpl. destruct (b_eqb b (bid_of a)) eqn: Hb. move /eqP in Hb. symmetry in Hb.
destruct H. left. auto. destruct IHM. intro. destruct H. right. exact H0.
auto. Qed.
Lemma ttqb_intro (M:list fill_type) (b:Bid)(NZT: forall m, In m M -> tq m>0):
ttqb M b = 0 -> ~In b (bids_of M).
Proof. revert b. induction M. simpl. auto.
intros. simpl in H. destruct (b_eqb b (bid_of a)) eqn: Hb.
assert (tq a >0). eapply NZT. auto. lia. simpl.
intro. destruct H0. subst b. move /eqP in Hb.
elim Hb. auto. revert H0. eapply IHM. auto. exact. Qed.
Lemma ttqb_intro1 (M:list fill_type) (b:Bid):
ttqb M b <> 0 -> In b (bids_of M).
Proof. revert b. induction M. simpl. auto.
intros. simpl in H. destruct (b_eqb b (bid_of a)) eqn: Hb. simpl.
move /eqP in Hb. subst. auto. apply IHM in H. simpl. auto. Qed.
Lemma ttqb_delete_m_ofb
(M:list fill_type) (m:fill_type) (b:Bid) :
In m M -> b=bid_of m -> ttqb M b = ttqb (delete m M) b + tq m.
Proof. intros. induction M as [|m' M']. elim H.
simpl. destruct (b_eqb b (bid_of m')) eqn: Hb.
destruct H. subst m.
replace (m_eqb m' m') with true. lia. auto.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m. lia.
simpl. rewrite Hb. rewrite IHM'.
auto. lia.
destruct H. subst m. subst b.
move /eqP in Hb. elim Hb. auto.
simpl.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m. subst b.
move /eqP in Hb. elim Hb. auto.
simpl.
rewrite Hb. rewrite IHM'.
auto. lia. Qed.
Lemma ttqb_delete_m_not_ofb
(M:list fill_type) (m:fill_type) (b:Bid) :
In m M -> b<>bid_of m -> ttqb M b = ttqb (delete m M) b.
Proof. intros. induction M as [|m' M']. elim H.
simpl. destruct (b_eqb b (bid_of m')) eqn: Hb.
destruct H. subst m.
move /eqP in Hb. subst b.
elim H0. auto.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m.
move /eqP in Hb. subst b.
elim H0. auto.
simpl. rewrite Hb. rewrite IHM'.
auto. lia.
destruct H. subst m.
replace (m_eqb m' m' ) with true.
auto. eauto.
destruct (m_eqb m m') eqn:Hmm. auto.
simpl.
rewrite Hb. rewrite IHM'.
auto. lia. Qed.
Lemma ttqb_equal_implies_subet (M1 M2:list fill_type)
(NZT:forall m : fill_type, In m M1 -> tq m > 0):
(forall b, ttqb M1 b = ttqb M2 b) -> (bids_of M1) [<=] (bids_of M2).
Proof. unfold "[<=]".
intros. assert(In a (bids_of M2)\/~In a (bids_of M2)).
eauto. destruct H1. auto.
specialize (H a).
apply ttqb_elim in H1. rewrite H1 in H.
apply ttqb_intro in H. unfold not in H.
apply H in H0. elim H0. eauto. Qed.
Lemma ttqb_of_perm (M1 M2:list fill_type)
(*(NZT:forall m : fill_type, In m M1 -> tq m > 0)*):
perm M1 M2 -> (forall b, ttqb M1 b = ttqb M2 b).
Proof. Proof. revert M2. induction M1.
intros. unfold perm in H.
move /andP in H. destruct H.
assert(M2=nil).
eauto. rewrite H1. auto.
intros. unfold perm in H.
move /andP in H. destruct H.
simpl. destruct(b_eqb b (bid_of a)) eqn:Ha.
{
move /eqP in Ha.
assert(In a M2). eauto.
eapply ttqb_delete_m_ofb with (M:=M2) in Ha.
rewrite Ha. cut(ttqb M1 b = ttqb (delete a M2) b).
lia.
apply included_elim3a with (a0:=a) in H.
simpl in H. replace (m_eqb a a) with true in H.
apply included_elim3a with (a0:=a) in H0.
simpl in H0. replace (m_eqb a a) with true in H0.
assert(perm M1 (delete a M2)).
unfold perm. apply /andP. auto.
apply IHM1 with (b:=b) in H2. lia.
eauto. eauto. eauto.
}
{ move /eqP in Ha. eapply ttqb_delete_m_not_ofb with (M:=M2) in Ha.
apply included_elim3a with (a0:=a) in H.
simpl in H. replace (m_eqb a a) with true in H.
apply included_elim3a with (a0:=a) in H0.
simpl in H0. replace (m_eqb a a) with true in H0.
assert(perm M1 (delete a M2)).
unfold perm. apply /andP. auto. rewrite Ha.
apply IHM1 with (b:=b) in H1. lia.
eauto. eauto. eauto.
} Qed.
Fixpoint ttqa (F: list fill_type) (a:Ask) : (nat) :=
match F with
|nil => 0
|f::F'=> match (a_eqb a (ask_of f)) with
|true => (tq f)+(ttqa F' a)
|false => (ttqa F' a)
end
end.
Lemma ttqa_elim (M:list fill_type) (a:Ask) : ~In a (asks_of M) -> ttqa M a = 0.
Proof. intros. induction M. simpl. auto. simpl in H.
simpl. destruct (a_eqb a (ask_of a0)) eqn: Ha. move /eqP in Ha. symmetry in Ha.
destruct H. left. auto. destruct IHM. intro. destruct H. right. exact H0.
auto. Qed.
Lemma ttqa_intro (M:list fill_type) (a:Ask)(NZT: forall m, In m M -> tq m>0):
ttqa M a = 0 -> ~In a (asks_of M).
Proof. revert a. induction M. simpl. auto.
intros. simpl in H. destruct (a_eqb a0 (ask_of a)) eqn: Hb.
assert (tq a >0). eapply NZT. auto. lia. simpl.
intro. destruct H0. subst a0. move /eqP in Hb.
elim Hb. auto. revert H0. eapply IHM. auto. exact. Qed.
Lemma ttqa_intro1 (M:list fill_type) (a:Ask):
ttqa M a <> 0 -> In a (asks_of M).
Proof. revert a. induction M. simpl. auto.
intros. simpl in H. destruct (a_eqb a0 (ask_of a)) eqn: Hb. simpl.
move /eqP in Hb. subst a0. auto. apply IHM in H. simpl. auto. Qed.
Lemma ttqa_delete_m_ofa
(M:list fill_type) (m:fill_type) (a:Ask) :
In m M -> a=ask_of m -> ttqa M a = ttqa (delete m M) a + tq m.
Proof. intros. induction M as [|m' M']. elim H.
simpl. destruct (a_eqb a (ask_of m')) eqn: Ha.
destruct H. subst m.
replace (m_eqb m' m') with true. lia. auto.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m. lia.
simpl. rewrite Ha. rewrite IHM'.
auto. lia.
destruct H. subst m. subst a.
move /eqP in Ha. elim Ha. auto.
simpl.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m. subst a.
move /eqP in Ha. elim Ha. auto.
simpl.
rewrite Ha. rewrite IHM'.
auto. lia. Qed.
Lemma ttqa_delete_m_not_ofa
(M:list fill_type) (m:fill_type) (a:Ask) :
In m M -> a<>ask_of m -> ttqa M a = ttqa (delete m M) a.
Proof. intros. induction M as [|m' M']. elim H.
simpl. destruct (a_eqb a (ask_of m')) eqn: Ha.
destruct H. subst m.
move /eqP in Ha. subst a.
elim H0. auto.
destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m.
move /eqP in Ha. subst a.
elim H0. auto.
simpl. rewrite Ha. rewrite IHM'.
auto. lia.
destruct H. subst m.
replace (m_eqb m' m' ) with true.
auto. eauto.
destruct (m_eqb m m') eqn:Hmm. auto.
simpl.
rewrite Ha. rewrite IHM'.
auto. lia. Qed.
Lemma ttqa_equal_implies_subet (M1 M2:list fill_type)
(NZT:forall m : fill_type, In m M1 -> tq m > 0):
(forall a, ttqa M1 a = ttqa M2 a) -> (asks_of M1) [<=] (asks_of M2).
Proof. unfold "[<=]".
intros. assert(In a (asks_of M2)\/~In a (asks_of M2)).
eauto. destruct H1. auto.
specialize (H a).
apply ttqa_elim in H1. rewrite H1 in H.
apply ttqa_intro in H. unfold not in H.
apply H in H0. elim H0. eauto. Qed.
Lemma ttqa_of_perm (M1 M2:list fill_type)
(*(NZT:forall m : fill_type, In m M1 -> tq m > 0)*):
perm M1 M2 -> (forall a, ttqa M1 a = ttqa M2 a).
Proof. Proof. revert M2. induction M1.
intros. unfold perm in H.
move /andP in H. destruct H.
assert(M2=nil).
eauto. rewrite H1. auto.
intros. unfold perm in H.
move /andP in H. destruct H.
simpl. destruct(a_eqb a0 (ask_of a)) eqn:Ha.
{
move /eqP in Ha.
assert(In a M2). eauto.
eapply ttqa_delete_m_ofa with (M:=M2) in Ha.
rewrite Ha. cut(ttqa M1 a0 = ttqa (delete a M2) a0).
lia.
apply included_elim3a with (a1:=a) in H.
simpl in H. replace (m_eqb a a) with true in H.
apply included_elim3a with (a1:=a) in H0.
simpl in H0. replace (m_eqb a a) with true in H0.
assert(perm M1 (delete a M2)).
unfold perm. apply /andP. auto.
apply IHM1 with (a:=a0) in H2. lia.
eauto. eauto. eauto.
}
{ move /eqP in Ha. eapply ttqa_delete_m_not_ofa with (M:=M2) in Ha.
apply included_elim3a with (a1:=a) in H.
simpl in H. replace (m_eqb a a) with true in H.
apply included_elim3a with (a1:=a) in H0.
simpl in H0. replace (m_eqb a a) with true in H0.
assert(perm M1 (delete a M2)).
unfold perm. apply /andP. auto. rewrite Ha.
apply IHM1 with (a:=a0) in H1. lia.
eauto. eauto. eauto.
} Qed.
Fixpoint ttq_ab (F: list fill_type) (b:Bid)(a:Ask) : (nat) :=
match F with
|nil => 0
|f::F'=> match ((a_eqb a (ask_of f)) && (b_eqb b (bid_of f))) with
|true => (tq f)+(ttq_ab F' b a)
|false => (ttq_ab F' b a)
end
end.
Hint Immediate ttqb_elim ttqa_elim: core.
Hint Resolve ttqb_intro ttqa_intro : core.
Hint Resolve ttqb_delete_m_not_ofb ttqb_delete_m_ofb : core.
Hint Resolve ttqa_delete_m_not_ofa ttqa_delete_m_ofa : core.
Lemma ttq_ab_elim_a (M:list fill_type)(b:Bid) (a:Ask) :
~In a (asks_of M) -> ttq_ab M b a = 0.
Proof. intros. induction M. { simpl. auto. }
{ simpl in H.
simpl. destruct (a_eqb a (ask_of a0) && b_eqb b (bid_of a0)) eqn: Hab.
{ move /andP in Hab.
destruct Hab. move /eqP in H0.
move /eqP in H1. destruct H. left. auto. }
{ apply IHM. revert H. eauto. } } Qed.
Lemma ttq_ab_elim_b (M:list fill_type)(b:Bid) (a:Ask) :
~In b (bids_of M) -> ttq_ab M b a = 0.
Proof. intros. induction M. { simpl. auto. }
{ simpl in H.
simpl. destruct (a_eqb a (ask_of a0) && b_eqb b (bid_of a0)) eqn: Hab.
{ move /andP in Hab.
destruct Hab. move /eqP in H0.
move /eqP in H1. destruct H. left. auto. }
{ apply IHM. revert H. eauto. } } Qed.
Hint Resolve ttq_ab_elim_b ttq_ab_elim_a : core.
Lemma ttqa_intro_ba (M:list fill_type) (b:Bid)(a:Ask)(NZT: forall m, In m M -> tq m>0):
ttq_ab M b a = 0 -> (forall m, In m M ->(b=bid_of m -> a<>ask_of m)).
Proof. revert a b. induction M.
{ simpl. auto. }
{
intros. simpl in H.
destruct (a_eqb a0 (ask_of a) && b_eqb b (bid_of a)) eqn: Hab.
{
assert (tq a >0). eapply NZT. auto.
lia. }
destruct H0.
subst a. move /andP in Hab. subst b. eauto.
apply IHM with (m:=m) in H. auto. auto.
auto. auto. } Qed.
Lemma ttqa_intro_ab (M:list fill_type)(b:Bid) (a:Ask)(NZT: forall m, In m M -> tq m>0):
ttq_ab M b a = 0 -> (forall m, In m M ->(a=ask_of m -> b<>bid_of m)).
Proof. revert a b. induction M.
{ simpl. auto. }
{
intros. simpl in H.
destruct (a_eqb a0 (ask_of a) && b_eqb b (bid_of a)) eqn: Hab.
{
assert (tq a >0). eapply NZT. auto.
lia. }
destruct H0.
subst a. move /andP in Hab. subst a0. eauto.
apply IHM with (m:=m) in H. auto. auto.
auto. auto. } Qed.
Hint Immediate ttqa_intro_ab ttqa_intro_ba: core.
Lemma ttq_ab_le_ttqa (M:list fill_type)(b:Bid)(a:Ask):
ttq_ab M b a <= ttqa M a.
Proof. revert a. induction M. intros. simpl. auto.
intros. simpl.
destruct (a_eqb a0 (ask_of a)) eqn:Ha0a;destruct (b_eqb b (bid_of a)) eqn: Hba.
{ simpl. cut(ttq_ab M b a0 <= ttqa M a0). lia. eapply IHM. }
{ simpl. cut(ttq_ab M b a0 <= ttqa M a0). lia. eapply IHM. }
{ simpl. eapply IHM. }
{ simpl. eapply IHM. }
Qed.
Lemma ttq_ab_le_ttqb (M:list fill_type)(b:Bid)(a:Ask):
ttq_ab M b a <= ttqb M b.
Proof. revert a. induction M. intros. simpl. auto.
intros. simpl.
destruct (a_eqb a0 (ask_of a)) eqn:Ha0a;destruct (b_eqb b (bid_of a)) eqn: Hba.
{ simpl. cut(ttq_ab M b a0 <= ttqb M b). lia. eapply IHM. }
{ simpl. eapply IHM. }
{ simpl. cut(ttq_ab M b a0 <= ttqb M b). lia. eapply IHM. }
{ simpl. eapply IHM. }
Qed.
Lemma ttq_ab_delete (M:list fill_type)(b:Bid)(a:Ask)(m:fill_type):
In m M -> (b<>bid_of m)\/(a<>ask_of m) -> ttq_ab M b a = ttq_ab (delete m M) b a.
Proof. revert a b m. induction M as [|m' M'].
{ simpl. intros. elim H. }
{ intros. destruct H0.
{ destruct H.
{ subst m'. simpl. destruct (b_eqb b (bid_of m)) eqn:Hbm.
move /eqP in Hbm. subst b. elim H0. auto.
destruct (a_eqb a (ask_of m)). simpl. replace (m_eqb m m) with true.
auto. eauto. simpl. replace (m_eqb m m) with true. auto.
eauto.
}
{ simpl.
destruct (a_eqb a (ask_of m') && b_eqb b (bid_of m')) eqn: Habm.
destruct (m_eqb m m') eqn:Hmm. move /eqP in Hmm.
subst m. move /andP in Habm. destruct Habm.
move /eqP in H2. subst b. elim H0. auto.
simpl. rewrite Habm.
eapply IHM' with (a:=a)(b:=b) in H. lia.
left. auto.
destruct (m_eqb m m') eqn:Hmm. auto. simpl.
rewrite Habm.
eapply IHM' with (a:=a)(b:=b) in H. lia.
left. auto.
}
}
{ destruct H.
{
subst m'. simpl. destruct (a_eqb a (ask_of m)) eqn:Hbm.
move /eqP in Hbm. subst a. elim H0. auto.
destruct (b_eqb b (bid_of m)). simpl. replace (m_eqb m m) with true.
auto. eauto. simpl. replace (m_eqb m m) with true. auto.
eauto.
}
{ simpl.
destruct (a_eqb a (ask_of m') && b_eqb b (bid_of m')) eqn: Habm.
destruct (m_eqb m m') eqn:Hmm. move /eqP in Hmm.
subst m. move /andP in Habm. destruct Habm.
move /eqP in H1. subst a. elim H0. auto.
simpl. rewrite Habm.
eapply IHM' with (a:=a)(b:=b) in H. lia.
right. auto.
destruct (m_eqb m m') eqn:Hmm. auto. simpl.
rewrite Habm.
eapply IHM' with (a:=a)(b:=b) in H. lia.
right. auto.
}
}
}
Qed.
Hint Resolve ttq_ab_le_ttqb ttq_ab_le_ttqa : core.
Lemma b_in_a_out_m_exists (M:list fill_type)(b:Bid)(a:Ask):
ttqa M a >= ttq_ab M b a ->
ttqb M b > ttq_ab M b a ->
exists m : fill_type,
In m M /\ bid_of m = b /\ ask_of m <> a.
Proof.
{
revert a b. induction M as [|m' M'].
simpl. intros. lia.
simpl. intros.
destruct (a_eqb a (ask_of m')) eqn: Ham;
destruct (b_eqb b (bid_of m')) eqn: Hbm.
{ simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ bid_of m = b /\ ask_of m <> a).
apply IHM' with (a:=a)(b:=b). lia. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
{
simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ bid_of m = b /\ ask_of m <> a).
apply IHM' with (a:=a)(b:=b).
assert (ttq_ab M' b a <= ttqa M' a). eauto. lia. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
{
exists m'. split. left. auto. move /eqP in Ham.
move /eqP in Hbm. auto.
}
{
simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ bid_of m = b /\ ask_of m <> a).
apply IHM' with (a:=a)(b:=b).
lia. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
} Qed.
Lemma a_in_b_out_m_exists (M:list fill_type)(b:Bid)(a:Ask):
ttqa M a > ttq_ab M b a ->
ttqb M b >= ttq_ab M b a ->
exists m : fill_type,
In m M /\ ask_of m = a /\ bid_of m <> b.
Proof.
{
revert a b. induction M as [|m' M'].
simpl. intros. lia.
simpl. intros.
destruct (a_eqb a (ask_of m')) eqn: Ham;
destruct (b_eqb b (bid_of m')) eqn: Hbm.
{ simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ ask_of m = a /\ bid_of m <> b).
apply IHM' with (a:=a)(b:=b). lia. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
{
exists m'. split. left. auto. move /eqP in Ham.
move /eqP in Hbm. auto.
}
{
simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ ask_of m = a /\ bid_of m <> b).
apply IHM' with (a:=a)(b:=b). lia.
assert (ttq_ab M' b a <= ttqb M' b). eauto. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
{
simpl in H. simpl in H0.
assert(Hm: exists m : fill_type,
(In m M') /\ ask_of m = a /\ bid_of m <> b).
apply IHM' with (a:=a)(b:=b).
lia. lia.
destruct Hm as [m0 Hm].
exists m0. split. right. apply Hm. apply Hm.
}
} Qed.
Hint Resolve a_in_b_out_m_exists b_in_a_out_m_exists :core.
(*Total traded quanities of matching (list fill_type) *)
Fixpoint QM (M:list fill_type) :nat:=
match M with
|nil => 0
|m::M => tq m + QM M
end.
Lemma QM_elim0 (M:list fill_type) (m :fill_type):
In m M -> QM(M) >= (tq m).
Proof. induction M. simpl. intros. elim H.
intros. simpl. destruct H. subst a. lia.
cut(QM M >= tq m). lia. apply IHM. auto. Qed.
Lemma QM_elim1 (M:list fill_type) (m :fill_type):
In m M -> QM(delete m M) =QM(M) - (tq m).
Proof. induction M as [| m' M']. simpl. auto.
simpl. destruct (m_eqb m m') eqn:Hmm.
move /eqP in Hmm. subst m. lia.
simpl. intros. move /eqP in Hmm.
destruct H. subst m. elim Hmm. auto.
rewrite IHM'. auto. assert(QM M' >= tq m).
apply QM_elim0. auto. lia. Qed.
Lemma QM_elim2 (M:list fill_type) (m1 m2:fill_type):
m1<>m2 -> In m1 M -> In m2 M -> QM M >= tq m1 + tq m2.
Proof.
induction M. simpl.
intros H0 H. elim H. intros.
destruct H0;destruct H1.
{
subst a. subst m1. elim H. auto.
}
{ simpl. subst a. cut(QM M >= tq m2). lia.
apply QM_elim0. auto.
}
{
simpl. subst a. cut(QM M >= tq m1). lia.
apply QM_elim0. auto.
}
{ simpl. cut(QM M >= tq m1 + tq m2). lia.
apply IHM. auto. auto. auto.
}
Qed.
Lemma QM_perm (M1 M2:list fill_type):
perm M1 M2 -> QM(M1) = QM(M2).
Proof. revert M2. induction M1.
intros. unfold perm in H.
move /andP in H. destruct H.
assert(M2=nil).
eauto. rewrite H1. auto.
intros. unfold perm in H.
move /andP in H. destruct H.
simpl. assert(In a M2). eauto.
assert(QM(delete a M2) =QM(M2) - (tq a)).
apply QM_elim1. auto.
apply included_elim3a with (a0:=a) in H.
simpl in H. replace (m_eqb a a) with true in H.
apply included_elim3a with (a0:=a) in H0.
simpl in H0. replace (m_eqb a a) with true in H0.
assert(perm M1 (delete a M2)).
unfold perm. apply /andP. auto.
apply IHM1 in H3.
apply QM_elim0 in H1. lia. eauto. eauto. Qed.
(*Sum of quantities of all the bids present in a list*)
Fixpoint QB (B:list Bid) :nat:=
match B with
|nil => 0
|b::B => bq b + QB B
end.
(*Sum of quantities of all the asks present in a list*)
Fixpoint QA (A:list Ask) :nat:=
match A with
|nil => 0
|a::A => sq a + QA A
end.
(*This function computes total traded quantity in a matching by computing total traded quantity of each ask. Note that QM and QMa are the same values and is being proved below *)
Fixpoint QMa (M:list fill_type)(A:list Ask):nat:=
match A with
|nil => 0
|a::A' => (ttqa M a) + QMa M A'
end.
(*This function computes total traded quantity in a matching by computing total traded quantity of each bid. Note that QM and QMb are the same values and is being proved below *)
Fixpoint QMb (M:list fill_type)(B:list Bid):nat:=
match B with
|nil => 0
|b::B' => (ttqb M b) + QMb M B'
end.
Lemma QMa_elim1 (M:list fill_type)(A:list Ask)(m:fill_type) (NDA:NoDup A):
~In (ask_of m) A-> QMa (m :: M) A = QMa M A.
Proof. revert m M. induction A as [|a A'].
intros. simpl. auto. intros. simpl. destruct (a_eqb a (ask_of m)) eqn: Ham.
move /eqP in Ham. subst a. elim H. auto. cut(QMa (m :: M) A' = QMa M A'). lia.
eapply IHA'. eauto. eauto. Qed.
Lemma QMa_elim2 (M:list fill_type)(A:list Ask)(m:fill_type)(NDA:NoDup A):
In (ask_of m) A -> QMa (m :: M) A = tq m + QMa M (A).
Proof. revert m M. induction A as [|a A'].
{ simpl. intros. auto. }
{ intros. destruct (a_eqb a (ask_of m)) eqn: Ham. destruct H. simpl. rewrite Ham.
rewrite QMa_elim1. eauto. rewrite <-H. eauto. lia. move /eqP in Ham. rewrite <-Ham in H.
assert(~In a A'). eauto. auto. destruct H. move /eqP in Ham. subst a. auto.
simpl. rewrite Ham. rewrite IHA'. eauto. eauto. lia. } Qed.
Lemma QMb_elim1 (M:list fill_type)(B:list Bid)(m:fill_type) (NDB:NoDup B):
~In (bid_of m) B-> QMb (m :: M) B = QMb M B.
Proof. revert m M. induction B as [|b B'].
intros. simpl. auto. intros. simpl. destruct (b_eqb b (bid_of m)) eqn: Hbm.
move /eqP in Hbm. subst b. elim H. auto. cut(QMb (m :: M) B' = QMb M B'). lia.
eapply IHB'. eauto. eauto. Qed.
Lemma QMb_elim2 (M:list fill_type)(B:list Bid)(m:fill_type)(NDB:NoDup B):
In (bid_of m) B -> QMb (m :: M) B = tq m + QMb M (B).
Proof. revert m M. induction B as [|b B'].
{ simpl. intros. auto. }
{ intros. destruct (b_eqb b (bid_of m)) eqn: Hbm. destruct H. simpl. rewrite Hbm.
rewrite QMb_elim1. eauto. rewrite <-H. eauto. lia. move /eqP in Hbm. rewrite <-Hbm in H.
assert(~In b B'). eauto. auto. destruct H. move /eqP in Hbm. subst b. auto.
simpl. rewrite Hbm. rewrite IHB'. eauto. eauto. lia. } Qed.
Hint Resolve QMb_elim1 QMb_elim2 QMa_elim1 QMb_elim2: core.
Lemma QM_equal_QMa (M:list fill_type)(A:list Ask) (NDA:NoDup A):
asks_of M [<=] A -> QMa M A = QM(M).
Proof. {
revert A NDA. induction M as [|m M'].
{ simpl. induction A. simpl. auto. simpl. intros. apply IHA.
eauto. eauto. }
{ induction A as [|a A'].
{ simpl. intros. assert(In (ask_of m) nil). eauto. inversion H0. }
{ intros. destruct (a_eqb a (ask_of m)) eqn:Ham.
{ simpl. rewrite Ham. move /eqP in Ham. assert (asks_of M' [<=] a :: A').
eauto. eapply IHM' in H0. rewrite<- H0. simpl.
cut(QMa (m :: M') A' = QMa M' A'). lia. eapply QMa_elim1. eauto.
rewrite<- Ham. eauto. eauto. }
{ (*Prove more properties of QMa for different scenerios*)
assert(In a (asks_of M')\/~In a (asks_of M')).
eauto. destruct H0.
2:{ simpl. rewrite Ham. eapply ttqa_elim in H0 as H1.
rewrite H1.
rewrite IHA'. eauto. simpl in H. eapply subset_elim3 in H.
all:auto. move /eqP in Ham;auto. }
{ cut(QMa M' (a :: A') = QM(M')).
assert(QMa (m :: M') (a::A') = tq m + QMa M' (a::A')).
eapply QMa_elim2 with (A:=(a::A'))(M:=M')(m:=m).
eauto. simpl. right;auto. simpl in H.
assert(In (ask_of m) (a::A')). eauto. destruct H1.
subst a. move /eqP in Ham. elim Ham. auto. auto.
rewrite H1. simpl. lia.
specialize (IHM' (a::A')). eapply IHM'. eauto. eauto. }}}}}
Qed.
Lemma QMa_equal_QMa (M1 M2:list fill_type)(A:list Ask):
(forall a, ttqa M1 a = ttqa M2 a) -> QMa M1 A = QMa M2 A.
Proof. induction A. simpl;auto.
simpl. intro H. specialize (H a) as Ha. rewrite Ha. rewrite IHA.
auto. auto. Qed.
Lemma QM_equal_QMb (M:list fill_type)(B:list Bid) (NDB:NoDup B):
bids_of M [<=] B -> QMb M B = QM(M).
Proof. {
revert B NDB. induction M as [|m M'].
{ simpl. induction B. simpl. auto. simpl. intros. apply IHB.
eauto. eauto. }
{ induction B as [|b B'].
{ simpl. intros. assert(In (bid_of m) nil). eauto. inversion H0. }
{ intros. destruct (b_eqb b (bid_of m)) eqn:Hbm.
{ simpl. rewrite Hbm. move /eqP in Hbm. assert (bids_of M' [<=] b :: B').
eauto. eapply IHM' in H0. rewrite<- H0. simpl.
cut(QMb (m :: M') B' = QMb M' B'). lia. eapply QMb_elim1. eauto.
rewrite<- Hbm. eauto. eauto. }
assert(In b (bids_of M')\/~In b (bids_of M')).
eauto. destruct H0.
2:{ simpl. rewrite Hbm. eapply ttqb_elim in H0 as H1.
rewrite H1.
rewrite IHB'. eauto. simpl in H. eapply subset_elim3 in H.
all:auto. move /eqP in Hbm;auto. }
{ cut(QMb M' (b :: B') = QM(M')).
assert(QMb (m :: M') (b::B') = tq m + QMb M' (b::B')).
eapply QMb_elim2 with (B:=(b::B'))(M:=M')(m:=m).
eauto. simpl. right;auto. simpl in H.
assert(In (bid_of m) (b::B')). eauto. destruct H1.
subst b. move /eqP in Hbm. elim Hbm. auto. auto.
rewrite H1. simpl. lia.
specialize (IHM' (b::B')). eapply IHM'. eauto. eauto. }}}}
Qed.
Lemma QMb_equal_QMb (M1 M2:list fill_type)(B:list Bid):
(forall b, ttqb M1 b = ttqb M2 b) -> QMb M1 B = QMb M2 B.
Proof. induction B as [| b B]. simpl;auto.
simpl. intro H. specialize (H b) as Hb. rewrite Hb. rewrite IHB.
auto. auto. Qed.
Lemma ttqb_BM_t_B (M:list fill_type)(B:list Bid)(NDB:NoDup B) :
(bids_of M [<=] B) ->
(forall b, In b (bids_of M) -> ttqb M b <= bq b) ->(forall b, In b B -> ttqb M b <= bq b).
Proof. intros. assert(Hb: In b (bids_of M) \/~In b (bids_of M)). eauto.
destruct Hb. apply H0. auto. apply ttqb_elim in H2. lia. Qed.
Lemma fill_size_vs_bid_size (M:list fill_type)(B:list Bid)(NDB:NoDup B):
(forall b, In b B -> ttqb M b <= bq b) -> QMb M B <=QB(B).
Proof. revert M. induction B as [|b B'].
{ intros. simpl. auto. }
{ intros. simpl. assert(H0: ttqb M b <= bq b). eapply H with (b0:=b). auto.
cut(QMb M B' <= QB B'). lia. eapply IHB'. eauto. auto. } Qed.
Lemma ttqaM1_equal_ttqaM2 (M1 M2:list fill_type)(A:list Ask)(NDA: NoDup A):
asks_of M1 [<=] A -> asks_of M2 [<=] A -> (forall a, ttqa M1 a = ttqa M2 a) -> QM M1 = QM M2.
Proof. intros. eapply QM_equal_QMa in H;eapply QM_equal_QMa in H0.
eapply QMa_equal_QMa with (A:=A) in H1. lia. all:exact. Qed.
Lemma ttqa_AM_t_A (M:list fill_type)(A:list Ask)(NDA:NoDup A) :
(asks_of M [<=] A) ->
(forall a, In a (asks_of M) -> ttqa M a <= sq a) ->(forall a, In a A -> ttqa M a <= sq a).
Proof. intros. assert(Ha: In a (asks_of M) \/~In a (asks_of M)). eauto.
destruct Ha. apply H0. auto. apply ttqa_elim in H2. lia. Qed.
Lemma fill_size_vs_ask_size (M:list fill_type)(A:list Ask)(NDA:NoDup A):
(forall a, In a A -> ttqa M a <= sq a) -> QMa M A <=QA(A).
Proof. revert M. induction A as [|a A'].
{ intros. simpl. auto. }
{ intros. simpl. assert(H0: ttqa M a <= sq a). eapply H with (a0:=a). auto.
cut(QMa M A' <= QA A'). lia. eapply IHA'. eauto. auto. } Qed.
Lemma ttqbM1_equal_ttqbM2 (M1 M2:list fill_type)(B:list Bid)(NDB: NoDup B):
bids_of M1 [<=] B -> bids_of M2 [<=] B -> (forall b, ttqb M1 b = ttqb M2 b) -> QM M1 = QM M2.
Proof. intros. eapply QM_equal_QMb in H;eapply QM_equal_QMb in H0.
eapply QMb_equal_QMb with (B:=B) in H1. lia. all:exact. Qed.
Hint Resolve
QM_equal_QMa QMa_equal_QMa QM_equal_QMb QMb_equal_QMb
fill_size_vs_bid_size ttqaM1_equal_ttqaM2 ttqb_BM_t_B ttqa_AM_t_A
fill_size_vs_ask_size ttqbM1_equal_ttqbM2: core.
End quantity.
Hint Immediate ttqa_intro_ab ttqa_intro_ba: core.
Hint Immediate ttqb_elim ttqa_elim: core.
Hint Resolve a_in_b_out_m_exists b_in_a_out_m_exists :core.
Hint Immediate ttqb_BM_t_B ttqa_AM_t_A : core.
Hint Resolve ttqb_intro ttqa_intro : core.
Hint Resolve QM_elim0 QM_elim1 QM_perm : core.
Hint Resolve ttq_ab_elim_b ttq_ab_elim_a : core.
Hint Resolve ttq_ab_le_ttqb ttq_ab_le_ttqa : core.
Hint Resolve QM_equal_QMa QMa_equal_QMa QM_equal_QMb QMb_equal_QMb
fill_size_vs_bid_size ttqaM1_equal_ttqaM2
fill_size_vs_ask_size ttqbM1_equal_ttqbM2: core.
Hint Resolve ttqb_delete_m_not_ofb ttqb_delete_m_ofb : core.
Hint Resolve ttqa_delete_m_not_ofa ttqa_delete_m_ofa : core.