(****************************************************************************** Finite orbit-stabilizer theorem.  Based on proof from Rahbar Virk's notes from the University of Wisconsin (www.math.wisc.edu/~virk/notes/pdf/orphans/orbit-stabilizer_thm.pdf) Copyright 2008 Robert Kam  This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.  This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.  You should have received a copy of the GNU Lesser General Public License along with this program.  If not, see <http://www.gnu.org/licenses/>. ******************************************************************************)
From Algebra Require Export Group_util.
From Algebra Require Export Fpart2.
From Algebra Require Export Parts3.
From Algebra Require Export Fmap.
From LinAlg Require Export seq_set_facts.
From LinAlg Require Export has_n_elements.
From LinAlg Require Export finite_subsets.
Require Export ClassicalDescription.
Fixpoint nsum (n:Nat) {struct n} : seq n Nat -> Nat :=
match n return (seq n Nat -> Nat) with
|O => fun x:seq 0 Nat => 0
|S m => fun x:seq (S m) Nat => (head x) + (nsum m (Seqtl x)) end.
induction n. intros. simpl. auto.
intros. unfold nsum. fold nsum.
assert (HEADHEAD:head f = head f'). unfold head. apply H.
rewrite HEADHEAD.
assert (TLTL:nsum n (Seqtl f) =' nsum n (Seqtl f')). apply IHn.
change (Seqtl f =' Seqtl f' in _). apply Seqtl_comp. exact H.
rewrite TLTL. apply Refl. Qed.
intros. rewrite H. apply Refl. Qed.
intros. induction n. elimtype False; intuition.
unfold nsum in |- *. fold nsum in |- *.
elim (classic (i =' Build_finiteT (lt_O_Sn n) in _)).
intro I_ZERO.
assert (P1 : head (modify_seq v i a) =' a in _).
apply Trans with (head (modify_seq v (Build_finiteT (lt_O_Sn n)) a)).
apply head_comp. apply modify_comp. apply Refl. apply Refl. exact I_ZERO.
apply modify_hd_hd.
rewrite P1.
assert (P2 : nsum n (Seqtl (modify_seq v i a)) =' nsum n (Seqtl v) in _).
apply nsum_comp.
apply Trans with (Seqtl (modify_seq v (Build_finiteT (lt_O_Sn n)) a)).
change (Seqtl (modify_seq v i a)
=' Seqtl (modify_seq v (Build_finiteT (lt_O_Sn n)) a) in _) in |- *.
apply Seqtl_comp. apply modify_comp. apply Refl. apply Refl. exact I_ZERO.
change (Seqtl (modify_seq v (Build_finiteT (lt_O_Sn n)) a)
=' Seqtl v in _) in |- *. apply modify_hd_tl.
rewrite P2.
rewrite H.
assert (P3 : v i =' head v in _).
unfold head in |- *. apply Map_compatible_prf. exact I_ZERO.
rewrite P3.
rewrite plus_comm. rewrite plus_permute. rewrite plus_assoc. apply Refl.
intro I_NZ.
assert (P4 : head (modify_seq v i a) =' head v in _).
destruct i.
assert (H''' : S (pred index) < S n).
induction index. elimtype False; intuition. auto.
apply Trans with (head (modify_seq v (Build_finiteT H''') a)).
apply head_comp. apply modify_comp. apply Refl. apply Refl. simpl in |- *.
induction index. elimtype False; intuition. auto.
apply modify_tl_hd.
rewrite P4.
assert(P10:nsum n (Seqtl(modify_seq v i a)) =' nsum n (Seqtl v)+1 in _).
destruct i.
assert (H' : pred index < n).
induction index. elimtype False; intuition.
simpl in |- *. apply lt_S_n. exact in_range_prf.
assert (H'' : S (pred index) < S n).
apply lt_n_S. exact H'.
apply Trans with (nsum n (Seqtl (modify_seq v (Build_finiteT H'') a))).
apply nsum_comp.
change (Seqtl (modify_seq v (Build_finiteT in_range_prf) a)
=' Seqtl (modify_seq v (Build_finiteT H'') a) in _) in |- *.
apply Seqtl_comp. apply modify_comp. apply Refl. apply Refl. simpl in |- *.
induction index. elimtype False; intuition. auto.
apply Trans with (nsum n (modify_seq (Seqtl v) (Build_finiteT H') a)).
apply nsum_comp. apply modify_tl_tl with (v := v).
apply IHn.
rewrite H. apply pluscomp2. apply Trans with (v (Build_finiteT H'')).
apply Map_compatible_prf. simpl in |- *.
induction index. elimtype False; intuition. auto.
apply Sym.
change (Seqtl v (Build_finiteT H') =' v (Build_finiteT H'') in _) in |- *.
apply Seqtl_to_seq.
rewrite P10. rewrite plus_assoc. apply Refl. Qed.
induction n. intros v Z. simpl. auto.
intros v Z.
apply Trans with (nsum(S n)(v(Build_finiteT(lt_O_Sn n));;Seqtl v)).
apply nsum_comp. apply conseq_hdtl. unfold nsum. fold nsum.
apply Trans with (head v+nsum n(Seqtl(v(Build_finiteT(lt_O_Sn n));;Seqtl v))).
apply pluscomp2. simpl. unfold head. auto.
apply Trans with (0+nsum n(Seqtl(v(Build_finiteT(lt_O_Sn n));;Seqtl v))).
apply pluscomp2. unfold head. apply Z. rewrite plus_0_l.
apply Trans with (nsum n(Seqtl v)). apply nsum_comp.
change (Seqtl(v(Build_finiteT(lt_O_Sn n));;Seqtl v) =' Seqtl v).
apply Seqtl_comp. apply Sym. apply conseq_hdtl.
apply IHn. destruct i.
apply Trans with (v(Build_finiteT(lt_n_S index n in_range_prf))).
apply (Seqtl_to_seq v). apply Z. Qed.
intros. simpl. unfold Map_eq. intro j. destruct i. destruct j.
rename index into i. rename index0 into j.
rename in_range_prf into iH. rename in_range_prf0 into jH.
elim(classic(i=j)). intro H.
apply Trans with (modify_seq(modify_seq Q(Build_finiteT jH)z)
(Build_finiteT jH) (Q(Build_finiteT jH)) (Build_finiteT jH)).
apply modify_comp. apply Map_compatible_prf. auto.
apply modify_comp. apply Refl. apply Refl. auto. auto.
apply modify_seq_defprop. intro H.
apply Trans with
(modify_seq Q(Build_finiteT iH)z(Build_finiteT jH)).
apply modify_seq_modifies_one_elt. auto.
apply modify_seq_modifies_one_elt. auto. Qed.
intros. elim(classic(i_=' j)).
intro H.
assert(gH':in_part g(minus_part(V i_)(subtype_elt(head AH)))).
apply in_part_comp_r with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))j). exact gH.
apply Trans with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))i_).
apply Map_compatible_prf. apply Sym. exact H.
apply modify_seq_defprop.
simpl in gH'. elim gH'. intros gH1 gH2. exact gH2.
intro H.
assert(gH':in_part g(V j)).
apply in_part_comp_r with(modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))j). exact gH.
apply modify_seq_modifies_one_elt. unfold not. intro H1.
apply H. apply Sym. exact H1.
unfold not. intro gHEAD. apply H.
apply Vc with (g:=g)(i:=i_)(i':=j). apply (Va j). exact gH'.
apply in_part_comp_l with (subtype_elt(head AH)). exact i_H.
exact gHEAD. exact gH'. Qed.
intros. simpl. unfold eq_part. intro x. split.
intro H. assert(HYP:Pred_fun A x). auto.
set(hx:=Build_subtype(P:=A)(subtype_elt:=x)HYP).
set(M:=Map_to_equal_subsets AH' (set_to_full A)).
elim(has_index(M hx)). intros j jH. simpl. exists j.
apply Trans with (subtype_elt(seq_set AH(M hx))).
simpl. apply Refl. apply subtype_elt_comp. exact jH.
intro H. assert(HYP:Pred_fun (seq_set(Map_embed AH)) x). auto.
set(hx:=Build_subtype(P:=seq_set(Map_embed AH))(subtype_elt:=x)HYP).
elim(has_index hx). intros j jH.
apply in_part_comp_l with (Map_embed AH j).
apply Map_embed_prop.
apply Trans with(seq_set(Map_embed AH)hx). simpl. apply Refl.
exact jH. Qed.
intros. apply seq_set_head_or_tail.
2:exact(P4helpr n G A AH AH' AH'' c V Va Vb Vc V' V'a i_ i_H j g gH).
apply in_part_comp_r with A. 2:exact(P4helprr n G A AH AH' AH'').
elim(classic(i_ =' j)).
intro H.
assert(H1:in_part g(minus_part(V i_)(subtype_elt(head AH)))).
apply in_part_comp_r with
(modify_seq V i_(minus_part(V i_)(subtype_elt(head AH)))j).
exact gH. apply Trans with
(modify_seq V i_(minus_part(V i_)(subtype_elt(head AH)))i_).
apply Map_compatible_prf. apply Sym. exact H.
apply modify_seq_defprop. simpl in H1. elim H1. intros H1a H1b.
apply (Va i_). exact H1a.
intro H.
assert(H1:in_part g(V j)). apply in_part_comp_r with
(modify_seq V i_(minus_part(V i_)(subtype_elt(head AH)))j).
exact gH. apply modify_seq_modifies_one_elt. unfold not.
intro H'. apply H. apply Sym. exact H'. apply(Va j). exact H1.
Qed.
intros. assert(HYP:Pred_fun(seq_set(Seqtl(Map_embed AH)))g). auto.
set(hx:=Build_subtype(P:=seq_set(Seqtl(Map_embed AH)))
(subtype_elt:=g)HYP). elim(has_index hx).
intros j jH. apply in_part_comp_l with ((Map_embed(Seqtl AH))j).
apply Map_embed_prop. apply Trans with (Seqtl(Map_embed AH)j).
exact jH. apply Sym. apply Map_embed_Seqtl. Qed.
intros. assert(gH'':in_part g(seq_set(Map_embed(omit AH
(Build_finiteT(lt_O_Sn n)))))).
apply in_part_comp_r with(seq_set(Map_embed(Seqtl AH))).
apply in_part_comp_r with(seq_set(Seqtl(Map_embed AH))).
exact gH. apply seq_set_comp. apply Sym. apply Map_embed_Seqtl.
apply seq_set_comp. change(Map_embed(Seqtl AH) ='
Map_embed(omit AH(Build_finiteT(lt_O_Sn n)))).
apply Map_embed_comp. apply Sym.
change (omit AH(Build_finiteT(lt_O_Sn n)) =' Seqtl AH).
apply omit_head_is_seqtl. elim gH''. intros j2 j2H.
assert(DORA:~omit AH(Build_finiteT(lt_O_Sn n))j2
=' AH(Build_finiteT(lt_O_Sn n))).
apply distinct_omit_removes_all. exact AH''.
unfold not. intro H. apply DORA. Opaque omit.
simpl. unfold subtype_image_equal. apply Trans with g.
apply Sym. exact j2H. exact H. Qed.
Transparent omit.
intros. elim(Vb g(seqtlobv n G A AH g gH)). intros j jH.
elim(classic(i_ =' j)). intro H. exists i_.
apply in_part_comp_r with(minus_part(V i_)(subtype_elt(head AH))).
2:apply Sym. 2:apply modify_seq_defprop.
simpl. split. apply in_part_comp_r with(V j). exact jH.
apply Map_compatible_prf. apply Sym. exact H.
exact (seq_set_head_or_tail_inv n G A AH AH' AH'' g gH).
intro H. exists j. apply in_part_comp_r with (V j). exact jH.
apply Sym. apply modify_seq_modifies_one_elt. unfold not.
intro H'. apply H. apply Sym. exact H'. Qed.
intros n G A AH AH' AH'' c V Va Vb Vc V' V'a i_ i_H g H
i i' iH i'H.
apply Vc with (g:=g). apply seqtlobv with (AH:=AH). exact H.
elim(classic(i_=' i)). intro iH'.
assert(G1:in_part g(minus_part(V i_)(subtype_elt(head AH)))).
apply in_part_comp_r with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))i). exact iH.
apply Trans with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))i_). apply Map_compatible_prf.
apply Sym. exact iH'. apply modify_seq_defprop.
simpl in G1. elim G1. intros iH'a iH'b.
apply in_part_comp_r with (V i_). exact iH'a.
apply Map_compatible_prf. exact iH'.
intro iH'.
apply in_part_comp_r with(modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))i). exact iH.
apply modify_seq_modifies_one_elt. unfold not. intro iH''.
apply iH'. apply Sym. exact iH''.
rename i' into j. rename i'H into jH.
elim(classic(i_=' j)). intro jH2.
assert(G3:in_part g(minus_part(V i_)(subtype_elt(head AH)))).
apply in_part_comp_r with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))j). exact jH.
apply Trans with (modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))i_). apply Map_compatible_prf.
apply Sym. exact jH2. apply modify_seq_defprop.
simpl in G3. elim G3. intros jHa jHb.
apply in_part_comp_r with (V i_). exact jHa.
apply Map_compatible_prf. exact jH2.
intro jHH.
apply in_part_comp_r with(modify_seq V i_(minus_part(V i_)
(subtype_elt(head AH)))j). exact jH.
apply modify_seq_modifies_one_elt. unfold not. intro jHHH.
apply jHH. apply Sym. exact jHHH. Qed.
intros.
assert (H0:in_part a(empty G)->False). auto.
assert (H1:A =' empty G -> False).
intro H1a. simpl in H1a. unfold eq_part in H1a.
elim (H1a a). intros H1b H1c. apply H0. apply H1b. exact H.
assert (H2:n=0->False).
intro H2a. apply H1. apply has_zero_elements_then_empty.
rewrite H2a in FINA. exact FINA. apply (neq_O_lt n). auto. Qed.
intros E B k H x xH. assert(K_POS:k>0).
apply (Q8 E x B k H xH).
induction k. assert(~0<0). apply (lt_irrefl 0).
elimtype False; intuition.
apply has_n_elements_comp with (n:=k) (B:=minus_part B x)
(C:=minus_part B x). 2:apply Refl. 2:induction k.
2:simpl. 2:auto. 2:simpl. 2:auto.
elim H. intros. inversion H0.
assert (HYP:Pred_fun B x). auto.
set (hx:=Build_subtype (P:=B)(subtype_elt:=x) HYP).
set (M:=Map_to_equal_subsets H1 (set_to_full B)).
assert (HASIND:exists i:fin (S k),seq_set x0 (M hx) =' x0 i).
apply has_index.
elim HASIND. intros i iH.
assert(G1:subtype_elt(x0 i)='x).
apply Trans with (subtype_elt(seq_set x0 (M hx))).
apply subtype_elt_comp. apply Sym. exact iH. simpl. apply Refl.
assert(F1:minus_part B x =' seq_set(Map_embed(omit x0 i))).
Opaque omit. simpl. unfold eq_part. intro z. split. intro zH.
simpl in zH. elim zH. intros zHa zHb.
assert(zHYP:Pred_fun B z). auto.
set(hz:=Build_subtype(P:=B)(subtype_elt:=z)zHYP).
elim(has_index(M hz)). intros k1 k1H.
assert(F2:~i =' k1). unfold not. intro F3. apply zHb.
apply Trans with (subtype_elt(x0 k1)).
apply Trans with (subtype_elt(seq_set x0(M hz))).
simpl. apply Refl. apply subtype_elt_comp. exact k1H.
apply Trans with (subtype_elt(x0 i)). apply subtype_elt_comp.
apply Map_compatible_prf. apply Sym. exact F3. exact G1.
elim(omit_removes' x0 F2). intros k2 k2H.
exists k2. simpl.
apply Trans with (subtype_elt(x0 k1)).
apply Trans with (subtype_elt(seq_set x0(M hz))).
simpl. apply Refl. apply subtype_elt_comp. exact k1H.
apply subtype_elt_comp. exact k2H.
intro zH. simpl in zH. elim zH. intros k2 k2H.
simpl. split. apply in_part_comp_l with (subtype_elt(omit x0 i k2)).
apply in_part_subtype_elt. exact k2H.
elim(omit_removes x0 i k2). intros k1 k1H.
assert(F4:~omit x0 i k2 =' x0 i). apply distinct_omit_removes_all.
exact H2. unfold not. intro F5.
assert(F6:subtype_elt(omit x0 i k2) =' subtype_elt(x0 i)).
apply Trans with z. apply Sym. exact k2H.
apply Trans with x. exact F5. apply Sym. exact G1.
apply F4. exact F6.
Transparent omit.
assert(F2:distinct(Map_embed(omit x0 i))).
apply Map_embed_preserves_distinct. apply omit_preserves_distinct.
exact H2.
apply seq_set_n_element_subset. exists(Map_embed(omit x0 i)).
split. exact F1. exact F2. Qed.
intros. rename i into j. elim(classic(i_ =' j)). intro H.
apply has_n_elements_comp with (n:=V' i_-1)
(B:=modify_seq V i_(minus_part(V i_)(subtype_elt(head AH)))i_).
apply has_n_elements_comp with (n:=V' i_-1)
(B:=minus_part(V i_)(subtype_elt(head AH))).
apply shrink_one. exact (V'a i_). exact i_H.
apply Sym. apply modify_seq_defprop. apply Refl.
apply Map_compatible_prf. exact H.
apply Trans with (modify_seq V' i_(V' i_-1)i_).
apply Sym. apply modify_seq_defprop. apply Map_compatible_prf.
exact H.
intro H. apply has_n_elements_comp with (n:=V' j)
(B:=modify_seq V i_(minus_part(V i_)(subtype_elt(head AH)))j).
apply has_n_elements_comp with (n:=V' j) (B:=V j).
exact (V'a j). apply Sym. apply modify_seq_modifies_one_elt.
unfold not. intro H'. apply H. apply Sym. exact H'.
apply Refl. apply Refl. apply Sym.
apply modify_seq_modifies_one_elt.
unfold not. intro H'. apply H. apply Sym. exact H'. Qed.

Lemma sqtlsqtl:forall(n:Nat)(G:Setoid)(A:part_set G)
(AH:seq(S n)A)(AH':full A =' seq_set AH)(AH'':distinct AH),
full(seq_set(Seqtl(Map_embed AH)))
=' seq_set(seq_set_seq(Seqtl(Map_embed AH))).