# Library AMM11262.ascii_format.example2

Require Import AMM11262.
Import NatSet GeneralProperties.

Section example_five_inhabitants.
Now we find the witness, in a town with 5 inhabitants; ie, n=2

Definition town_2:= 1 ++ 2 ++ 3 ++ 4 ++ 5 ++ empty.

Remark population_2 : cardinal town_2 = 2*2 +1.
Proof.
reflexivity.
Qed.

Definition familiarity_2 (m n:elt):Prop :=
match m,n with
| 1,2=> True
| 1,3 => True
| 1,4 => True
| 1,5 => True
| 2,1 => True
| 2,5 => True
| 3,1 => True
| 3,4 => True
| 3,5 => True
| 4,1 => True
| 4,3 => True
| 5,1 => True
| 5,2 => True
| 5,3 => True
| _,_ => False
end.

Remark familiarity_2_sym:forall m n : elt, familiarity_2 m n -> familiarity_2 n m.
Proof.
intros [|[|[|[|[|[|m']]]]]] [|[|[|[|[|[|n']]]]]]; trivial.
Qed.

Remark familiarity_2_extensional:forall (m : elt) (n p : E.t), E.eq n p -> familiarity_2 m n -> familiarity_2 m p.
Proof.
intros m n p H1 H2; compute in H1; rewrite <- H1; assumption.
Qed.

Remark subsets_2: forall B : t, Subset B town_2 -> cardinal B = 2 ->
{B [=] 1++2++empty}+{B[=]1++3++empty}+{B[=]1++4++empty}+{B [=] 1++5++empty}+{B[=]2++3++empty}+
{B[=]2++4++empty}+{B[=]2++5++empty}+{B[=]3++4++empty}+{B [=] 3++5++empty}+{B[=]4++5++empty}.
Proof.
intros B H_sub H_card.
destruct (In_dec 1 B) as [H1|H1].
do 6 left.
assert (H_card_rem:cardinal (remove 1 B)=1);
[ rewrite <- (remove_cardinal_1 H1) in H_card; apply eq_add_S; assumption|].
destruct (In_dec 2 (remove 1 B)) as [H12|H12].
do 3 left.
rewrite <- (add_remove H1).
rewrite <- (add_remove H12).
generalize (remove_cardinal_1 H12).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 3 (remove 1 B)) as [H13|H13].
do 2 left; right.
rewrite <- (add_remove H1).
rewrite <- (add_remove H13).
generalize (remove_cardinal_1 H13).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 4 (remove 1 B)) as [H14|H14].
left; right.
rewrite <- (add_remove H1).
rewrite <- (add_remove H14).
generalize (remove_cardinal_1 H14).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 5 (remove 1 B)) as [H15|H15].
right.
rewrite <- (add_remove H1).
rewrite <- (add_remove H15).
generalize (remove_cardinal_1 H15).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
apply False_rec.
assert (H11:=(@remove_1 B _ _ (refl_equal 1))).
destruct (cardinal_inv_2 H_card_rem) as [b Hb].
destruct (NatSet.E.eq_dec b 1) as [Hb1|Hb1].
apply H11; rewrite Hb1 in Hb; assumption.
destruct (NatSet.E.eq_dec b 2) as [Hb2|Hb2].
apply H12; rewrite <- Hb2; assumption.
destruct (NatSet.E.eq_dec b 3) as [Hb3|Hb3].
apply H13; rewrite <- Hb3; assumption.
destruct (NatSet.E.eq_dec b 4) as [Hb4|Hb4].
apply H14; rewrite <- Hb4; assumption.
destruct (NatSet.E.eq_dec b 5) as [Hb5|Hb5].
apply H15; rewrite <- Hb5; assumption.

assert (H_sub':=@subset_remove_3 _ _ 1 H_sub).
assert (Hb_town:=H_sub' _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply Hb1; rewrite Hb1_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply Hb2; rewrite Hb2_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply Hb3; rewrite Hb3_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply Hb4; rewrite Hb4_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply Hb5; rewrite Hb5_town; reflexivity.
apply (proj1 (FM.empty_iff b) Hb5_town)...
destruct (In_dec 2 B) as [H2|H2].
assert (H_card_rem:cardinal (remove 2 B)=1);
[ rewrite <- (remove_cardinal_1 H2) in H_card; apply eq_add_S; assumption|].
assert (H21:=fun HH : In 1 (remove 2 B) => H1 (remove_3 HH)).
destruct (In_dec 3 (remove 2 B)) as [H23|H23].
do 5 left; right.
rewrite <- (add_remove H2).
rewrite <- (add_remove H23).
generalize (remove_cardinal_1 H23).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 4 (remove 2 B)) as [H24|H24].
do 4 left; right.
rewrite <- (add_remove H2).
rewrite <- (add_remove H24).
generalize (remove_cardinal_1 H24).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 5 (remove 2 B)) as [H25|H25].
do 3 left; right.
rewrite <- (add_remove H2).
rewrite <- (add_remove H25).
generalize (remove_cardinal_1 H25).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
apply False_rec.
assert (H22:=(@remove_1 B _ _ (refl_equal 2))).
destruct (cardinal_inv_2 H_card_rem) as [b Hb].
destruct (NatSet.E.eq_dec b 1) as [Hb1|Hb1].
apply H21; rewrite Hb1 in Hb; assumption.
destruct (NatSet.E.eq_dec b 2) as [Hb2|Hb2].
apply H22; rewrite Hb2 in Hb; assumption.
destruct (NatSet.E.eq_dec b 3) as [Hb3|Hb3].
apply H23; rewrite <- Hb3; assumption.
destruct (NatSet.E.eq_dec b 4) as [Hb4|Hb4].
apply H24; rewrite <- Hb4; assumption.
destruct (NatSet.E.eq_dec b 5) as [Hb5|Hb5].
apply H25; rewrite <- Hb5; assumption.

assert (H_sub':=@subset_remove_3 _ _ 2 H_sub).
assert (Hb_town:=H_sub' _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply Hb1; rewrite Hb1_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply Hb2; rewrite Hb2_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply Hb3; rewrite Hb3_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply Hb4; rewrite Hb4_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply Hb5; rewrite Hb5_town; reflexivity.
apply (proj1 (FM.empty_iff b) Hb5_town)...
destruct (In_dec 3 B) as [H3|H3].
assert (H_card_rem:cardinal (remove 3 B)=1);
[ rewrite <- (remove_cardinal_1 H3) in H_card; apply eq_add_S; assumption|].
assert (H31:=fun HH : In 1 (remove 3 B) => H1 (remove_3 HH)).
assert (H32:=fun HH : In 2 (remove 3 B) => H2 (remove_3 HH)).
destruct (In_dec 4 (remove 3 B)) as [H34|H34].
do 2 left; right.
rewrite <- (add_remove H3).
rewrite <- (add_remove H34).
generalize (remove_cardinal_1 H34).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
destruct (In_dec 5 (remove 3 B)) as [H35|H35].
left; right.
rewrite <- (add_remove H3).
rewrite <- (add_remove H35).
generalize (remove_cardinal_1 H35).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
apply False_rec.
assert (H33:=(@remove_1 B _ _ (refl_equal 3))).
destruct (cardinal_inv_2 H_card_rem) as [b Hb].
destruct (NatSet.E.eq_dec b 1) as [Hb1|Hb1].
apply H31; rewrite Hb1 in Hb; assumption.
destruct (NatSet.E.eq_dec b 2) as [Hb2|Hb2].
apply H32; rewrite Hb2 in Hb; assumption.
destruct (NatSet.E.eq_dec b 3) as [Hb3|Hb3].
apply H33; rewrite Hb3 in Hb; assumption.
destruct (NatSet.E.eq_dec b 4) as [Hb4|Hb4].
apply H34; rewrite <- Hb4; assumption.
destruct (NatSet.E.eq_dec b 5) as [Hb5|Hb5].
apply H35; rewrite <- Hb5; assumption.

assert (H_sub':=@subset_remove_3 _ _ 3 H_sub).
assert (Hb_town:=H_sub' _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply Hb1; rewrite Hb1_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply Hb2; rewrite Hb2_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply Hb3; rewrite Hb3_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply Hb4; rewrite Hb4_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply Hb5; rewrite Hb5_town; reflexivity.
apply (proj1 (FM.empty_iff b) Hb5_town)...
destruct (In_dec 4 B) as [H4|H4].
assert (H_card_rem:cardinal (remove 4 B)=1);
[ rewrite <- (remove_cardinal_1 H4) in H_card; apply eq_add_S; assumption|].
assert (H41:=fun HH : In 1 (remove 4 B) => H1 (remove_3 HH)).
assert (H42:=fun HH : In 2 (remove 4 B) => H2 (remove_3 HH)).
assert (H43:=fun HH : In 3 (remove 4 B) => H3 (remove_3 HH)).
destruct (In_dec 5 (remove 4 B)) as [H45|H45].
right.
rewrite <- (add_remove H4).
rewrite <- (add_remove H45).
generalize (remove_cardinal_1 H45).
rewrite H_card_rem; intro H_eq2.
rewrite (empty_is_empty_1 (cardinal_inv_1 (eq_add_S _ _ H_eq2))); reflexivity...
apply False_rec.
assert (H44:=(@remove_1 B _ _ (refl_equal 4))).
destruct (cardinal_inv_2 H_card_rem) as [b Hb].
destruct (NatSet.E.eq_dec b 1) as [Hb1|Hb1].
apply H41; rewrite Hb1 in Hb; assumption.
destruct (NatSet.E.eq_dec b 2) as [Hb2|Hb2].
apply H42; rewrite Hb2 in Hb; assumption.
destruct (NatSet.E.eq_dec b 3) as [Hb3|Hb3].
apply H43; rewrite Hb3 in Hb; assumption.
destruct (NatSet.E.eq_dec b 4) as [Hb4|Hb4].
apply H44; rewrite Hb4 in Hb; assumption.
destruct (NatSet.E.eq_dec b 5) as [Hb5|Hb5].
apply H45; rewrite <- Hb5; assumption.

assert (H_sub':=@subset_remove_3 _ _ 4 H_sub).
assert (Hb_town:=H_sub' _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply Hb1; rewrite Hb1_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply Hb2; rewrite Hb2_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply Hb3; rewrite Hb3_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply Hb4; rewrite Hb4_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply Hb5; rewrite Hb5_town; reflexivity.
apply (proj1 (FM.empty_iff b) Hb5_town)...
apply False_rec.
destruct (In_dec 5 B) as [H5|H5].
assert (H_card_rem:cardinal (remove 5 B)=1);
[ rewrite <- (remove_cardinal_1 H5) in H_card; apply eq_add_S; assumption|].
assert (H51:=fun HH : In 1 (remove 5 B) => H1 (remove_3 HH)).
assert (H52:=fun HH : In 2 (remove 5 B) => H2 (remove_3 HH)).
assert (H53:=fun HH : In 3 (remove 5 B) => H3 (remove_3 HH)).
assert (H54:=fun HH : In 4 (remove 5 B) => H4 (remove_3 HH)).
assert (H55:=(@remove_1 B _ _ (refl_equal 5))).
destruct (cardinal_inv_2 H_card_rem) as [b Hb].
assert (H_sub':=@subset_remove_3 _ _ 5 H_sub).
assert (Hb_town:=H_sub' _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply H51; rewrite <- Hb1_town in Hb; assumption.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply H52; rewrite <- Hb2_town in Hb; assumption.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply H53; rewrite <- Hb3_town in Hb; assumption.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply H54; rewrite <- Hb4_town in Hb; assumption.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply H55; rewrite <- Hb5_town in Hb; assumption.
apply (proj1 (FM.empty_iff b) Hb5_town)...
destruct (cardinal_inv_2 H_card) as [b Hb].
destruct (NatSet.E.eq_dec b 1) as [Hb1|Hb1].
apply H1; rewrite Hb1 in Hb; assumption.
destruct (NatSet.E.eq_dec b 2) as [Hb2|Hb2].
apply H2; rewrite Hb2 in Hb; assumption.
destruct (NatSet.E.eq_dec b 3) as [Hb3|Hb3].
apply H3; rewrite Hb3 in Hb; assumption.
destruct (NatSet.E.eq_dec b 4) as [Hb4|Hb4].
apply H4; rewrite Hb4 in Hb; assumption.
destruct (NatSet.E.eq_dec b 5) as [Hb5|Hb5].
apply H5; rewrite <- Hb5; assumption.

assert (Hb_town:=H_sub _ Hb).
unfold town_2 in Hb_town.
destruct (proj1 (FM.add_iff _ _ b) Hb_town) as [Hb1_town|Hb1_town].
apply Hb1; rewrite Hb1_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb1_town) as [Hb2_town|Hb2_town].
apply Hb2; rewrite Hb2_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb2_town) as [Hb3_town|Hb3_town].
apply Hb3; rewrite Hb3_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb3_town) as [Hb4_town|Hb4_town].
apply Hb4; rewrite Hb4_town; reflexivity.
destruct (proj1 (FM.add_iff _ _ b) Hb4_town) as [Hb5_town|Hb5_town].
apply Hb5; rewrite Hb5_town; reflexivity.
apply (proj1 (FM.empty_iff b) Hb5_town)...
Qed.

Remark acquintance_2: forall B : t, Subset B town_2 -> cardinal B = 2 ->
{d : elt |In d (diff town_2 B) /\ (forall b : elt, In b B -> familiarity_2 d b)}.
Proof.
intros B H_sub H_card.
destruct (subsets_2 B H_sub H_card) as [[[[[[[[[HB12|HB13]|HB14]|HB15]|HB23]|HB24]|HB25]|HB34]|HB35]|HB45].
exists 5; split.
rewrite HB12; apply mem_2; trivial.
intro b; rewrite HB12; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 4; split.
rewrite HB13; apply mem_2; trivial.
intro b; rewrite HB13; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 3; split.
rewrite HB14; apply mem_2; trivial.
intro b; rewrite HB14; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 2; split.
rewrite HB15; apply mem_2; trivial.
intro b; rewrite HB15; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 5; split.
rewrite HB23; apply mem_2; trivial.
intro b; rewrite HB23; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 1; split.
rewrite HB24; apply mem_2; trivial.
intro b; rewrite HB24; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 1; split.
rewrite HB25; apply mem_2; trivial.
intro b; rewrite HB25; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 1; split.
rewrite HB34; apply mem_2; trivial.
intro b; rewrite HB34; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 1; split.
rewrite HB35; apply mem_2; trivial.
intro b; rewrite HB35; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
exists 3; split.
rewrite HB45; apply mem_2; trivial.
intro b; rewrite HB45; intro Hb.
destruct (proj1 (FM.add_iff _ _ b) Hb) as [H|H].
compute in H; rewrite <- H; simpl; trivial.
destruct (proj1 (FM.add_iff _ _ b) H) as [H'|H'].
compute in H'; rewrite <- H'; simpl; trivial.
apply False_ind; apply (proj1 (FM.empty_iff b) H').
Defined.

Check (AMM11262 town_2 2 population_2 familiarity_2 familiarity_2_sym familiarity_2_extensional acquintance_2).

Definition social_citizen_2:=AMM11262 town_2 2 population_2 familiarity_2
familiarity_2_sym familiarity_2_extensional acquintance_2.

End example_five_inhabitants.

Extraction "social2" social_citizen_2.