(* $Id: CPoly_Contin.v,v 1.12 2003/03/11 13:36:15 lcf Exp $ *)

(* Tex_Prose
\chapter{Continuity of polynomials}
*)

Require Export RealFuncts.
Require Export CPolynomials.

Opaque IR.

(* Begin_Tex_Verb *)
Lemma mult_op_contin :
   (f,g,h:(CSetoid_un_op IR))(contin f)->(contin g)->
   ((x:IR)((f x)[*](g x) [=] (h x))) -> (contin h).
(* End_Tex_Verb *)
Intros f g h f_contin g_contin  f_g_h.
Unfold contin in f_contin.
Unfold continAt in f_contin.
Unfold funLim in f_contin.
Unfold contin in g_contin.
Unfold continAt in g_contin.
Unfold funLim in g_contin.
Unfold contin. Unfold continAt. Unfold funLim.
Intros.
Elim (mult_contin ? (f x) (g x) e H). Intro b. Intros H0 H1.
Elim H1. Clear H1. Intro c. Intros H1 H2.
Elim (f_contin x b H0). Clear f_contin. Intro d'. Intros H3 H4.
Elim (g_contin x c H1). Clear g_contin. Intro d''. Intros H5 H6.
Exists (Min d' d'').
Apply less_Min; Auto. Intro x'. Intros.
Stepr (f x)[*](g x)[-](f x')[*](g x').
Apply H2.
Apply H4. Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_lft.
Apply H6. Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_rht.
Qed.

(* Begin_Tex_Verb *)
Lemma plus_contin :
  (R:COrdField)(x,y,e:R)(Zero [<] e) ->
    {c:R & (Zero [<] c) & { d:R & (Zero [<] d) |
      (x',y':R)(AbsSmall c x[-]x') -> (AbsSmall d y[-]y') ->
        (AbsSmall e (x[+]y)[-](x'[+]y'))}}.
(* End_Tex_Verb *)
Intros.
Cut Zero [<] e[/]TwoNZ. Intro.
Exists e[/]TwoNZ. Auto.
Exists e[/]TwoNZ. Auto.
Intros.
Apply AbsSmall_wd_rht_unfolded with (x[-]x')[+](y[-]y').
Apply AbsSmall_eps_div_two; Auto.
Rational.
Apply div_resp_pos. Apply pos_two. Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma plus_op_contin :
   (f,g,h:(CSetoid_un_op IR))(contin f)->(contin g)->
   ((x:IR)((f x)[+](g x) [=] (h x))) -> (contin h).
(* End_Tex_Verb *)
Intros f g h f_contin g_contin  f_g_h.
Unfold contin in f_contin.
Unfold continAt in f_contin.
Unfold funLim in f_contin.
Unfold contin in g_contin.
Unfold continAt in g_contin.
Unfold funLim in g_contin.
Unfold contin. Unfold continAt. Unfold funLim.
Intros.
Elim (plus_contin ? (f x) (g x) e H). Intro b. Intros H0 H1.
Elim H1. Clear H1. Intro c. Intros H1 H2.
Elim (f_contin x b H0). Clear f_contin. Intro d'. Intros H3 H4.
Elim (g_contin x c H1). Clear g_contin. Intro d''. Intros H5 H6.
Exists (Min d' d'').
Apply less_Min; Auto. Intro x'. Intros H10.
Stepr ((f x)[+](g x))[-]((f x')[+](g x')).
Apply H2.
Apply H4. Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_lft.
Apply H6. Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_rht.
Qed.

(* Begin_Tex_Verb *)
Lemma linear_op_contin :
   (f,g:(CSetoid_un_op IR))(a:IR)(contin f)->
   ((x:IR)(x[*](f x)[+]a [=] (g x))) -> (contin g).
(* End_Tex_Verb *)
Intros f g a f_contin f_g.
Unfold contin in f_contin.
Unfold continAt in f_contin.
Unfold funLim in f_contin.
Unfold contin. Unfold continAt. Unfold funLim.
Intros.
Elim (mult_contin ? x (f x) e). Intro d'. Intros H0 H1.
Elim H1. Clear H1. Intro c. Intros H1 H2.
Elim (f_contin x c). Clear f_contin. Intro d''. Intros H3 H4.
Exists (Min d' d'').
Apply less_Min; Auto. Intro x'. Intros H8.
Stepr (x[*](f x)[+]a)[-](x'[*](f x')[+]a).
RStepr x[*](f x)[-]x'[*](f x').
Apply H2. Clear H2.
Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_lft.
Apply H4. Clear H4.
Apply AbsSmall_leEq_trans with (Min d' d''); Auto. Apply Min_leEq_rht.
Auto. Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma cpoly_op_contin : (g : (cpoly IR))(contin (cpoly_csetoid_op ? g)).
(* End_Tex_Verb *)
Intro g.
Elim g.
Unfold contin. Unfold continAt. Unfold funLim.
Intros.
Exists (One::IR). Apply pos_one.
Intros.
Simpl.
Unfold AbsSmall.
Split; Apply less_leEq.
RStepr [--](Zero::IR). Apply inv_resp_less. Auto.
Step (Zero::IR). Auto.
Intros a f. Intros.
Apply linear_op_contin with (cpoly_csetoid_op ? f) a. Auto.
Intros. Simpl. Rational.
Qed.


Require Import LTactics GenEncode.
Require Export LNat.

(** ** Encoding for L-terms *)
Run TemplateProgram (tmGenEncode "term_enc" term).
Hint Resolve term_enc_correct : Lrewrite.

(* register the non-constant constructors *)
Instance term_var : computableTime var (fun n _ => (1, tt)).
Proof.
  extract constructor. solverec.
Defined.

Instance term_app : computableTime app (fun s1 _ => (1, (fun s2 _ => (1, tt)))).
Proof.
  extract constructor. solverec.
Defined.

Instance term_lam : computableTime lam (fun s _ => (1, tt)).
Proof.
  extract constructor. solverec.
Defined.


(************************************************************************************)
(**                                                                                *)
(**                             The SQLEngines Library                              *)
(**                                                                                *)
(**            LRI, CNRS & Université Paris-Sud, Université Paris-Saclay            *)
(**                                                                                *)
(**                        Copyright 2016-2019 : FormalData                         *)
(**                                                                                *)
(**         Authors: Véronique Benzaken                                             *)
(**                  Évelyne Contejean                                              *)
(**                  Chantal Keller                                                 *)
(**                  Eunice-Raquel Martins                                          *)
(**                                                                                *)
(************************************************************************************)

Require Import List.
Require Import OrderedSet Signatures NestedLoop.

Set Implicit Arguments.

Module BlockNestedLoop.
Section Sec.
Hypotheses o1 o2 o : Type.
Hypothesis O1 : Oeset.Rcd o1.
Hypothesis O2 : Oeset.Rcd o2.
Hypothesis O : Oeset.Rcd o.

Hypothesis build_ : o1 -> o2 -> o.
Hypothesis build_eq_1  :
  forall x1 x1' x2,
    Oeset.compare O1 x1 x1' = Eq -> Oeset.compare O (build_ x1 x2) (build_ x1' x2) = Eq.
Hypothesis build_eq_2  :
  forall x1 x2 x2',
    Oeset.compare O2 x2 x2' = Eq -> Oeset.compare O (build_ x1 x2) (build_ x1 x2') = Eq.

Definition OL1 := mk_oelists O1.
Definition OL2 := mk_oelists O2.
Definition OL := mk_oelists O.

Hypothesis C1 : Cursor.Rcd OL1.
Hypothesis C2 : Cursor.Rcd OL2.

Definition build : Cursor.Rcd OL.
apply NestedLoop.build with
    (list o1) (list o2) OL1 OL2
    (fun l1 l2 => flat_map (fun e1 => map (fun e2 => build_ e1 e2) l2) l1).
- intros l1; induction l1 as [ | x1 l1]; intros [ | x1' l1'] l2 H1; try discriminate H1; trivial.
  simpl in H1; case_eq (Oeset.compare O1 x1 x1'); intro Hx1; rewrite Hx1 in H1; try discriminate H1.
  simpl.
  apply comparelA_eq_app.
  + induction l2 as [ | x2 l2]; simpl; trivial.
    rewrite (build_eq_1 _ _ _ Hx1).
    apply IHl2.
  + assert (IH := IHl1 l1' l2 H1); simpl in IH; apply IH.
- intro l1; induction l1 as [ | x1 l1]; intros x2 x2' Hx2; simpl; trivial.
  apply comparelA_eq_app.
  + revert x2' Hx2; induction x2 as [ | a2 l2]; intros [ | a2' l2'] Hl2; simpl; trivial.
    simpl in Hl2.
    case_eq (Oeset.compare O2 a2 a2'); intro Ha2; rewrite Ha2 in Hl2; try discriminate Hl2.
    rewrite (build_eq_2 _ _ _ Ha2).
    apply IHl2; trivial.
  + assert (IH := IHl1 x2 x2' Hx2); simpl in IH; apply IH.
- exact C1.
- exact C2.
Defined.

End Sec.
End BlockNestedLoop.


(*
 This is the definition of formal syntax for Dan Grossman's Thesis,
  "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".

 This defines the static semantics of typing in the heap, pg 64.

*)

Set Implicit Arguments.

Require Export Cyclone_Formal_Syntax.
Require Export Cyclone_LN_Types_In_Terms.
Require Export LibVarPathEnv.
Require Export List.
Close Scope list_scope.
Import LibEnvNotations.
Import LVPE.LibVarPathEnvNotations.

(* Bug. *)
Inductive gettype : Upsilon -> var -> Path -> Tau -> Path -> Tau -> Prop :=
  | gettype_nil:
      forall (u : Upsilon) (x : var) (p : Path) (tau : Tau),
        gettype u x p tau nil tau

  | gettype_pair_zero:
      forall (u : Upsilon) (x : var) (p p': Path) (t0 t1 tau : Tau),
        gettype u x (app p (cons (i_pe zero_pe) nil)) t0 p' tau ->
        gettype u x p (cross t0 t1) (app (cons (i_pe zero_pe) nil) p') tau

  | gettype_pair_one:
      forall (u : Upsilon) (x : var) (p p': Path) (t0 t1 tau : Tau),
        gettype u x (app p (cons (i_pe one_pe) nil)) t1 p' tau ->
        gettype u x p (cross t0 t1) (app (cons (i_pe one_pe) nil) p') tau

  | gettype_etype:
      forall (u : Upsilon) (x : var) (p p': Path) (tau tau' tau'': Tau)
             (k : Kappa),
        LVPE.binds (x,p) tau'' u ->
        (* LVPE.V.get (x,p) u = Some tau'' ->  *)
        gettype u x (app p (cons u_pe nil)) (T.open tau'' tau') p' tau ->
        gettype u x p (etype aliases k tau') (app (cons u_pe nil) p') tau.

Hint Constructors gettype.
Hint Extern 3 (gettype _ _ _ _ nil _)
=> try solve[apply gettype_nil; auto].

Hint Extern 3 (gettype _ _ _ (etype _ _ _) _ _)
=> try solve[apply gettype_etype; auto].

Hint Extern 3 (gettype _ _ _ (cross _ _) (app (cons (i_pe zero_pe) nil) _) _)
=> try solve[apply gettype_pair_zero; auto].

Hint Extern 3 (gettype _ _ _ (cross _ _) (app (cons (i_pe one_pe) nil) _) _)
=> try solve[apply gettype_pair_one; auto].

Hint Extern 3 (gettype _ _ _ (cross _ _) (cons (i_pe zero_pe) nil) _)
=> try solve[apply gettype_pair_zero; auto].

Hint Extern 3 (gettype _ _ _ (cross _ _) (cons (i_pe one_pe) nil) _)
=> try solve[apply gettype_pair_one; auto].


Set Implicit Arguments.

Add Rec LoadPath "." as Top.

Require Import Regex Automata.
Require Import List Bool Ensembles.
Import ListNotations.

Section Nae.

Variable A S: Type.

Definition word := list A.

Definition nae := nfa (option A) S.

Definition eps (nae : nae) := step nae None.

(*Cloture reflexive transitive*)
Inductive rtrancl (T: Type) (ens : Ensemble (T * T)) : Ensemble (T * T) :=
  (*Réfléxivité*)
  | rtrancl_refl : forall s, rtrancl ens (s, s)
  (*Transitivité*)
  | rtrancl_trans : forall a b c, rtrancl ens (a, b) -> ens (b, c) -> rtrancl ens (a, c).

Lemma rtrancl_base (T: Type) : forall (ens : Ensemble (T * T)) x y, ens (x, y) -> rtrancl ens (x, y).
Proof.
  intros ens x y.
  intro H.
  apply rtrancl_trans with x.
  apply rtrancl_refl.
  assumption.
Qed.

Lemma ens_trans_rtrancl (T: Type) : forall (ens : Ensemble (T * T)) a b c, ens (a, b) -> rtrancl ens (b, c) -> rtrancl ens (a, c).
Proof.
  intros ens a b c.
  intros H H'.
  inversion H'.
  rewrite <- H2.
  apply rtrancl_base; assumption.
  apply rtrancl_trans with b0.
  apply rtrancl_trans with b.
  apply rtrancl_base; assumption.
Admitted.

Lemma rtrancl_trans_rtrancl (T: Type) :
  forall (ens : Ensemble (T * T)) a b c, rtrancl ens (a, b) -> rtrancl ens (b, c) -> rtrancl ens (a, c).
Proof.
  intros ens a b c.
  intros H H'.
  inversion H.
  assumption.
  inversion H'.
  rewrite <- H6.
  assumption.
  apply rtrancl_trans with b1.
Admitted.

(*Ensemble des états atteint après list A*)
Inductive steps_nae nae : list A -> Ensemble (S * S) :=
  (*Si la liste est vide*)
  | In_steps_nil : forall p q, rtrancl (eps nae) (p, q) -> steps_nae nae [] (p, q)
  (*Si la liste à un élément*)
  | In_steps_cons :
      forall h q sa sd,
        compose (compose (rtrancl (eps nae)) (step nae (Some h))) (steps_nae nae q) (sa, sd) ->
        steps_nae nae (h::q) (sa, sd).

(*Accéptation d'un automate*)
Definition accepts_eps nae w : Prop :=
  exists k, In _ (fin nae) k /\ In _ (steps_nae nae w) (start nae, k).

Lemma steps_epsclosure : forall nae w, compose (rtrancl (eps nae)) (steps_nae nae w) = steps_nae nae w.
Proof.
  intros nae w.
  destruct w; apply Extensionality_Ensembles.
  *split; intros (x, y) H.
    +inversion_clear H.
    inversion_clear H1.
    apply In_steps_nil.
    apply rtrancl_trans_rtrancl with b; assumption.
    +inversion_clear H.
    apply In_compose with x.
    apply rtrancl_refl.
    apply In_steps_nil.
    assumption.
  *split; intros (x, y) H.
    +inversion_clear H.
    apply In_steps_cons.
    inversion_clear H1.
    rewrite compose_assoc in H.
    inversion_clear H.
    rewrite compose_assoc.
    apply In_compose with b0.
    apply rtrancl_trans_rtrancl with b; assumption.
    assumption.
    +inversion_clear H.
    inversion_clear H0.
    inversion_clear H.
    apply In_compose with b0.
    assumption.
    apply In_steps_cons.
    apply In_compose with b.
    apply In_compose with b0.
    apply rtrancl_refl.
    assumption.
    assumption.
Qed.

Lemma in_steps_epsclosure : forall nae p q r w, rtrancl (eps nae) (p, q) -> steps_nae nae w (q, r) -> steps_nae nae w (p, r).
Proof.
  intros nae p q r w.
  intros H H'.
  rewrite <- steps_epsclosure.
  apply In_compose with q; assumption.
Qed.

Lemma epsclosure_steps: forall nae w, compose (steps_nae nae w) (rtrancl (eps nae)) = steps_nae nae w.
Proof.
  intros nae w.
  induction w; apply Extensionality_Ensembles; split; intros (x, y) H.
  *apply In_steps_nil.
  inversion_clear H.
  inversion_clear H0.
  apply rtrancl_trans_rtrancl with b; assumption.
  *inversion_clear H.
  apply In_compose with x.
  apply In_steps_nil.
  apply rtrancl_refl.
  assumption.
  *apply In_steps_cons.
  inversion_clear H.
  inversion_clear H0.
  inversion_clear H.
  inversion_clear H0.
  apply In_compose with b0.
  apply In_compose with b1.
  assumption.
  assumption.
  rewrite <- IHw.
  apply In_compose with b; assumption.
  *inversion_clear H.
  inversion_clear H0.
  inversion_clear H.
  apply In_compose with y; try apply rtrancl_refl.
  apply In_steps_cons.
  apply In_compose with b.
  apply In_compose with b0; assumption.
  assumption.
Qed.

Lemma in_epsclosure_steps : forall nae p q r w,  steps_nae nae w (p, q) -> rtrancl (eps nae) (q, r) -> steps_nae nae w (p, r).
Proof.
  intros nae p q r w.
  intros H H'.
  rewrite <- epsclosure_steps.
  apply In_compose with q; assumption.
Qed.

End Nae.

Section BitsNAe.

Variable A : Type.

Definition bitsNAe := nae A (list bool).

Definition empty_set := fun r : list bool => False.

Inductive atom_next (a: A) : option A -> list bool -> Ensemble (list bool) :=
  | Next_atomA : atom_next a (Some a) [true] [false].

Definition atom (a: A): bitsNAe :=
  mkNfa
    ([true])
    (atom_next a)
    (Singleton _ [false]).

(*On défini inductivement l'ensemble des états auquels on prepend un élément b*)
Inductive prepend_list_set (A: Type) (b: A) (ens: Ensemble (list A)) : Ensemble (list A) :=
  (*L'élément est dans l'ensemble si*)
  | In_prep : forall q, In _ ens q -> prepend_list_set b ens (b::q).

(*On défini inductivement la fonction next pour alt*)
Inductive alt_next (nae1 nae2: bitsNAe): option A -> list bool -> Ensemble (list bool) :=
  (*[] est l'état initial du nouvelle automate, cette regle ajoute une transition epsilon vers
    le start du premier automote, prepend de true*)
  | Next_altNL : alt_next nae1 nae2 None [] (true::start nae1)
  (*[] est l'état initial du nouvelle automate, cette regle ajoute une transition epsilon vers
    le start du premier automote, prepend de false*)
  | Next_altNR : alt_next nae1 nae2 None [] (false::start nae2)
  (*Si l'etat initial est de la forme true::q, on renvoie l'ensemble des next a q du 1er automate, pour toute transition a et
    prepend de true*)
  | Next_altL : forall a q s, In _ (next nae1 a q) s -> alt_next nae1 nae2 a (true::q) (true::s)
  (*Si l'état initial est de la forme true::q, on renvoie l'ensemble des next a q du 2nd automate, pour toute transition a et
    prepend de false*)
  | Next_altR : forall a q s, In _ (next nae2 a q) s -> alt_next nae1 nae2 a (false::q) (true::s).

Definition alt (nae1: bitsNAe) (nae2: bitsNAe): bitsNAe :=
  let start1 := start nae1 in
  let start2 := start nae2 in

  let next1 := next nae1 in
  let next2 := next nae2 in

  let fin1 := fin nae1 in
  let fin2 := fin nae2 in

  mkNfa
    ([])
    (alt_next nae1 nae2)
    (*L'union des fin, avec les états du 1er automate, prepend de true
      et les états du 2nd automate prepend de false*)
    (Union _ (prepend_list_set true (fin nae1)) (prepend_list_set false (fin nae2))).

(*concaténation de deux automates*)
Inductive conc_next (nae1 nae2: bitsNAe): option A -> list bool -> Ensemble (list bool) :=
  (*Si l'etat initial est de la forme true::q, on renvoie l'ensemble des next a q du 1er automate, pour toute transition a et
    prepend de true*)
  | Next_concL : forall oa q s, next nae1 oa q s -> conc_next nae1 nae2 oa (true::q) (true::s)
  (*Lorsque l'on arrive a la fin du premier automate (l'etat s prepend de true), on fait une epsilon transition vers le start du second prepend de false*)
  | Next_concFL : forall oa s, fin nae1 s -> conc_next nae1 nae2 oa (true::s) (false::start nae2)
  (*Si l'etat initial est de la forme false::q, on renvoie l'ensemble des next a q du 2nd automate, pour toute transition a et
    prepend de true*)
  | Next_concR : forall oa q s, next nae2 oa q s -> conc_next nae1 nae2 oa (false::q) (false::s).

Definition conc (nae1: bitsNAe) (nae2: bitsNAe): bitsNAe :=
  let start1 := start nae1 in
  let start2 := start nae2 in

  let next1 := next nae1 in
  let next2 := next nae2 in

  let fin1 := fin nae1 in
  let fin2 := fin nae2 in

  mkNfa
    (true::start1)
    (conc_next nae1 nae2)
    (*Les états finaux sont ceux de fin2 prepend de false*)
    (prepend_list_set false fin2).

(*Le star de l'automate, on ajoute un état inital []*)
Inductive star_next (nae1: bitsNAe): option A -> list bool -> Ensemble (list bool) :=
  (*transition depuis l'etat inital vers le start de l'automate, prepend de true*)
  | Next_starSN : star_next nae1 None [] (true::start nae1)
  (*transition depsuis un des états finaux vers l'état inital de l'automate*)
  | Next_starN : forall s, fin nae1 s -> star_next nae1 None (true::s) (true::start nae1)
  (*Si l'etat initial est de la forme true::q, on renvoie l'ensemble des next a q de l'automate, pour toute transition a et
    prepend de true*)
  | Next_star : forall oa s q, next nae1 oa s q -> star_next nae1 oa (true::s) (true::q).

Definition star (nae1: bitsNAe): bitsNAe :=
  let start1 := start nae1 in

  let next1 := next nae1 in

  let fin1 := fin nae1 in

  mkNfa
    ([])
    (star_next nae1)
    (*tout les états finaux de l'autamate, prepend de true plus [], le nouvelle état initial*)
    (Add _ (prepend_list_set true fin1) []).

(*
  Exemple de definition utilisé avant, plus dur de prouver avec
  Definition conc (nae1: bitsNAe) (nae2: bitsNAe): bitsNAe :=
  let start1 := start nae1 in
  let start2 := start nae2 in

  let next1 := next nae1 in
  let next2 := next nae2 in

  let fin1 := fin nae1 in
  let fin2 := fin nae2 in

  mkNfa
    (true::start1)
    (fun t s =>
      match s with
      | [] => empty_set
      | true::q => prepend_list_set true (next1 t q)
      | false::q => prepend_list_set false (next2 t q)
      end)
    (prepend_list_set false fin2).*)

Fixpoint to_nfae (rexp: rexp A): bitsNAe :=
  match rexp with
  | Empty _ => mkNfa ([]) (fun s t => empty_set) (fun s => s = [])
  | Atom a => atom a
  | Alt r1 r2 => alt (to_nfae r1) (to_nfae r2)
  | Conc r1 r2 => conc (to_nfae r1) (to_nfae r2)
  | Star r => star (to_nfae r)
  end.

Lemma fin_atom : forall a q, fin (atom a) q <-> (q = [false]).
Proof.
  intros a q.
  simpl.
  split; intro H.
  inversion H; reflexivity.
  rewrite H.
  apply In_singleton.
Qed.

Lemma start_atom: forall a, start (atom a) = [true].
Proof.
  intro a.
  simpl.
  reflexivity.
Qed.

Lemma eps_atom: forall a, eps (atom a) = Empty_set _.
Proof.
  intro a.
  unfold eps.
  apply Extensionality_Ensembles; split; intros x H.
  *inversion_clear H.
  inversion_clear H0.
  *inversion_clear H.
Qed.

Lemma in_step_atom_Some: forall a b p q, step (atom a) (Some b) (p, q) <-> (p = [true] /\ q = [false] /\ b = a).
Proof.
  intros a b p q.
  split; intro H.
  inversion_clear H.
  inversion_clear H0.
  tauto.
  apply In_step.
  destruct H.
  destruct H0.
  rewrite H.
  rewrite H0.
  rewrite H1.
  apply Next_atomA.
Qed.

Lemma False_False_in_steps_atom: forall a w,  steps_nae (atom a) w ([false], [false]) <-> (w = []).
Proof.
  intros a w.
  induction w; split; intro H.
  *reflexivity.
  *apply In_steps_nil.
  apply rtrancl_refl.
  *inversion_clear H.
  inversion_clear H0.
  inversion_clear H.
  inversion_clear H2.
  destruct H.
  inversion H0.
  inversion H3.
  inversion_clear H4.
  inversion H5.
  *inversion H.
Qed.

Lemma start_fin_in_steps_atom : forall a w, steps_nae (atom a) w (start (atom a), [false]) <-> (w = [a]).
Proof.
  intros a w.
  induction w; split; intro H.
  *inversion H.
  inversion H2.
  inversion H5.
  inversion H6.
  inversion H8.
  *inversion H.
  *inversion_clear H.
  inversion_clear H0.
  inversion_clear H.
  inversion_clear H2.
  inversion H.
  rewrite <- H4 in H1.
  apply False_False_in_steps_atom in H1.
  rewrite H1.
  reflexivity.
  *apply In_steps_cons.
  inversion H.
  simpl.
  apply In_compose with [false].
  apply In_compose with [true].
  apply rtrancl_refl.
  apply In_step.
  apply Next_atomA.
  apply False_False_in_steps_atom.
  reflexivity.
Qed.

End BitsNAe.

Section Test.

Definition rexp1 := Atom 1.
Definition nfae1 := atom 1.

Lemma acc_nfae1 : accepts_eps nfae1 [1].
  unfold accepts_eps.
  exists ([false]).
  split.
  apply In_singleton.
  unfold In.
  Print steps_nae.
  simpl.
  apply In_steps_cons.
  apply In_compose with [false].
  apply In_compose with [true].
  apply rtrancl_refl.
  apply In_step.
  compute.
  apply Next_atomA.
  apply In_steps_nil.
  apply rtrancl_refl.
Qed.

Variable A: Type.

Goal forall nae: bitsNAe A, accepts_eps nae [] ->
        exists s: list bool, In _ (fin nae) s -> rtrancl (eps nae) (start nae, s).

  intros nae H.
  unfold accepts_eps in H.
  destruct H.
  destruct H as (H, H').
  exists x.
  intros _.
  inversion H'.
  assumption.
Qed.

Lemma step_imp_next:
  forall (na : bitsNAe A) (a : option A) (p q : list bool),
    In _ (step na a) (p, q) -> In _ (next na a p) q.
Proof.
  intros na a p q H.
  inversion_clear H.
  assumption.
Qed.

End Test.


Require Import rt.util.all.
Require Import rt.model.arrival.basic.job rt.model.arrival.basic.task rt.model.priority.
Require Import rt.model.schedule.uni.schedule rt.model.schedule.uni.schedulability.
Require Import rt.model.schedule.uni.susp.suspension_intervals.
Require Import rt.analysis.uni.basic.workload_bound_fp.
Require Import rt.analysis.uni.susp.dynamic.oblivious.fp_rta.
Require Import rt.implementation.uni.susp.dynamic.job
               rt.implementation.uni.susp.dynamic.task
               rt.implementation.uni.susp.dynamic.arrival_sequence.
Require Import rt.implementation.uni.susp.schedule.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq bigop div.

Module ResponseTimeAnalysisFP.

  Import Job UniprocessorSchedule SporadicTaskset Priority Schedulability
         SuspensionIntervals SuspensionObliviousFP WorkloadBoundFP.
  Import ConcreteJob ConcreteTask ConcreteArrivalSequence ConcreteScheduler.

  (* In this section, we run the suspension-oblivious FP RTA on a simple task set
     to show that the theorems contain no contradictory assumptions. *)
  Section ExampleRTA.

    Let tsk1 := {| task_id := 1; task_cost := 1; task_period := 5;
                                 task_deadline := 5; task_suspension_bound := 1 |}.
    Let tsk2 := {| task_id := 2; task_cost := 1; task_period := 5;
                                 task_deadline := 5; task_suspension_bound := 0|}.
    Let tsk3 := {| task_id := 3; task_cost := 1; task_period := 6;
                                 task_deadline := 6; task_suspension_bound := 1|}.

    (* Let ts be a task set containing these three tasks, ... *)
    Program Let ts := Build_set [:: tsk1; tsk2; tsk3] _.

    (* ...which can be shown to have valid parameters. *)
    Fact ts_has_valid_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.
    Proof.
      intros tsk IN.
      repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
    Qed.

    (* Now let's inflate the task costs with the suspension-bounds. *)
    Let inflated_cost := inflated_task_cost task_cost task_suspension_bound.

    (* After the inflation, note that the task costs are no larger than deadlines and periods. *)
    Fact inflated_cost_le_deadline_and_period:
      forall tsk,
        tsk \in ts ->
          inflated_cost tsk <= task_deadline tsk /\
          inflated_cost tsk <= task_period tsk.
    Proof.
      intros tsk IN.
      repeat (move: IN => /orP [/eqP EQ | IN]; subst; compute); by done.
    Qed.

    (* Next, recall the FP RTA schedulability test using RM as the FP policy
       and the inflated task costs. *)
    Let RTA_claimed_bounds :=
      fp_claimed_bounds inflated_cost task_period task_deadline (RM task_period).
    Let schedulability_test :=
      fp_schedulable inflated_cost task_period task_deadline (RM task_period).

    (* First, we show that the schedulability test returns the following bounds, ... *)
    Fact RTA_yields_these_bounds :
      RTA_claimed_bounds ts = Some [:: (tsk1, 3); (tsk2, 3); (tsk3, 5)].
    Proof.
      rewrite /RTA_claimed_bounds /fp_claimed_bounds /inflated_cost /inflated_task_cost.
      set RESP := [seq _ | tsk <- ts].
      suff EQ: RESP = [:: (tsk1, Some 3); (tsk2, Some 3); (tsk3, Some 5)] by rewrite EQ; compute.
      rewrite /RESP /ts /=; do 2 f_equal.
      {
        rewrite /per_task_rta /= addn1.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk1 2 = 3.
        {
          by compute; rewrite unlock; compute.
        }
        rewrite !WORK /=; clear WORK.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk1 3 = 3.
        {
          by compute; rewrite unlock; compute.
        }
        by rewrite !WORK /=.
      }
      f_equal.
      {
        rewrite /per_task_rta /= addn0.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk2 1 = 3.
        {
          by compute; rewrite unlock; compute.
        }
        rewrite !WORK /=; clear WORK.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk2 3 = 3.
        {
          by compute; rewrite unlock; compute.
        }
        by rewrite !WORK /=.
      }
      do 2 f_equal.
      {
        rewrite /per_task_rta /= addn1.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk3 2 = 5.
        {
          by compute; rewrite unlock; compute.
        }
        rewrite !WORK /=; clear WORK.
        have WORK: total_workload_bound_fp inflated_cost task_period (RM task_period)
                                                 [:: tsk1; tsk2; tsk3] tsk3 5 = 5.
        {
          by compute; rewrite unlock; compute.
        }
        by rewrite !WORK /=; clear WORK.
      }
    Qed.

    (* ...so the schedulability test indeed returns true. *)
    Fact schedulability_test_succeeds :
      schedulability_test ts = true.
    Proof.
      rewrite /schedulability_test /fp_schedulable -/RTA_claimed_bounds.
      by rewrite RTA_yields_these_bounds.
    Qed.

    (* Now, let's show that the task set is schedulable. *)

    (* Let arr_seq be the periodic arrival sequence from ts... *)
    Let arr_seq := periodic_arrival_sequence ts.

    (* ...where jobs have total suspension times that are no larger than
       the suspension bound of their tasks. *)
     Variable next_suspension: job_suspension concrete_job_eqType.
     Hypothesis H_dynamic_suspensions:
       dynamic_suspension_model job_cost job_task next_suspension task_suspension_bound.

    (* Also assume rate-monotonic priorities. *)
    Let higher_eq_priority := FP_to_JLDP job_task (RM task_period).

    (* Next, let sched be the suspension-aware RM schedule with those job suspension times. *)
    Let sched := scheduler job_arrival job_cost arr_seq next_suspension higher_eq_priority.

    (* To conclude, based on the definition of deadline miss,... *)
    Let no_deadline_missed_by :=
      task_misses_no_deadline job_arrival job_cost job_deadline job_task arr_seq sched.

    (* ...we use the result of the suspension-oblivious FP RTA to conclude that
       no task misses its deadline. *)
    Corollary ts_is_schedulable:
      forall tsk,
        tsk \in ts ->
        no_deadline_missed_by tsk.
    Proof.
      intros tsk IN.
      have VALID := periodic_arrivals_valid_job_parameters ts ts_has_valid_parameters.
      have TSVALID := ts_has_valid_parameters.
      unfold valid_sporadic_job, valid_realtime_job in *; des.
      apply suspension_oblivious_fp_rta_implies_schedulability with (task_cost := task_cost)
                (task_period := task_period) (task_deadline := task_deadline) (ts0 := ts)
                (higher_eq_priority0 := RM task_period) (next_suspension0 := next_suspension)
                (task_suspension_bound := task_suspension_bound); try (by done).
      - by apply periodic_arrivals_are_consistent.
      - by apply periodic_arrivals_is_a_set.
      - by apply periodic_arrivals_all_jobs_from_taskset.
      - by apply periodic_arrivals_are_sporadic.
      - by apply RM_is_reflexive.
      - by apply RM_is_transitive.
      - by intros tsk_a tsk_b INa INb; apply/orP; apply leq_total.
      - by apply inflated_cost_le_deadline_and_period.
      - by apply scheduler_jobs_come_from_arrival_sequence, periodic_arrivals_are_consistent.
      - by apply scheduler_jobs_must_arrive_to_execute, periodic_arrivals_are_consistent.
      - by apply scheduler_completed_jobs_dont_execute, periodic_arrivals_are_consistent.
      - by apply scheduler_work_conserving, periodic_arrivals_are_consistent.
      - apply scheduler_respects_policy; first by apply periodic_arrivals_are_consistent.
        -- by intros t; apply RM_is_transitive.
        -- by intros j1 j2 _ _ _; apply leq_total.
      - by apply scheduler_respects_self_suspensions, periodic_arrivals_are_consistent.
      - by apply schedulability_test_succeeds.
    Qed.

  End ExampleRTA.

End ResponseTimeAnalysisFP.


Require Import Coq.ZArith.BinInt.
Require Import Coq.Classes.EquivDec.

Require Import compcert.lib.Integers.

Require Import CertiGraph.lib.List_ext.
Require Import CertiGraph.graph.graph_model.
Require Export CertiGraph.graph.FiniteGraph.
Require Import CertiGraph.graph.path_lemmas.

Section Mathematical_AdjMat_Model.

  Coercion pg_lg: LabeledGraph >-> PreGraph.
  Coercion lg_gg: GeneralGraph >-> LabeledGraph.

  Local Open Scope Z_scope.

  (* Most of the types are constrained because
     we want easy AdjMat representation. *)
  Definition V : Type := Z.
  Definition E : Type := V * V.
  Definition DV: Type := unit.
  Definition DE : Type := Z.
  Definition DG: Type := unit.

  #[export] Instance V_EqDec : EqDec V eq. Proof. hnf. intros. apply Z.eq_dec. Defined.
  #[export] Instance E_EqDec: EqDec E eq.
  Proof. apply (prod_eqdec V_EqDec V_EqDec). Defined.

  Context {size : Z}.
  Context {inf : Z}.
  (* The instantiator will have to supply a max number of vertices
     and a special "infinity" value to indicate unreachability
   *)

  (* This is the basic LabeledGraph for all our AdjMat representations. *)
  Definition AdjMatLG := (@LabeledGraph V E _ _ DV DE DG).
  (* We need some further restrictions, which we will place
     in the GeneralGraph's soundness condition.
   *)

  (* Each field of the class is a "plugin"
     which further restricts various aspects of the graph
   *)
  Class SoundAdjMat (g: AdjMatLG) :=
    {
    sr: (* size_representable *)
      0 < size <= Int.max_signed;
    ir: (* inf_representable *)
      0 < inf <= Int.max_signed;
    vm: (* vvalid_meaning *)
      forall v, vvalid g v <-> 0 <= v < size;
    em: (* evalid_meaning *)
      forall e, evalid g e <->
                Int.min_signed <= elabel g e <= Int.max_signed /\
                elabel g e <> inf;
    ese: (* evalid_strong_evalid *)
      forall e, evalid g e -> strong_evalid g e;
    iew: (* invalid_edge_weight *)
      forall e, ~ evalid g e <-> elabel g e = inf;
    esf: (* edge_src_fst *)
      forall e, src g e = fst e;
    eds: (* edge_dst_snd *)
      forall e, dst g e = snd e;
    fin:
      FiniteGraph g
    }.

  (* Academic example of how to instantiate the above *)
  Definition AdjMatGG := (GeneralGraph V E DV DE DG (fun g => SoundAdjMat g)).
  (* In reality, clients may want to:
     1. create a new soundness condition where one of the
        plugins is "SoundAdjMat" above
     2. add further program-specific restrictions in
        other plugins
     3. use this new accreted soundness condition to
        build their GeneralGraph, as shown above.
   *)

  (* Getters for the plugins *)

  Definition size_representable (g: AdjMatGG) :=
    @sr g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition inf_representable (g: AdjMatGG) :=
    @ir g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition vvalid_meaning (g: AdjMatGG) :=
    @vm g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition evalid_meaning (g: AdjMatGG) :=
    @em g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition evalid_strong_evalid (g: AdjMatGG) :=
    @ese g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition invalid_edge_weight (g: AdjMatGG) :=
    @iew g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition edge_src_fst (g: AdjMatGG) :=
    @esf g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition edge_dst_snd (g: AdjMatGG) :=
    @eds g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Definition finGraph (g: AdjMatGG) :=
    @fin g ((@sound_gg _ _ _ _ _ _ _ _ g)).

  Existing Instance finGraph.
  Coercion finGraph: AdjMatGG >-> FiniteGraph.

  (* Some lemmas from the above soundness plugins *)

  Lemma valid_path_app_cons:
    forall (g: AdjMatGG) src links2u u i,
      valid_path g (src, links2u) ->
      pfoot g (src, links2u) = u ->
      strong_evalid g (u,i) ->
      valid_path g (src, links2u +:: (u,i)).
  Proof.
    intros.
    apply valid_path_app.
    split; [assumption|].
    simpl; split; trivial.
    destruct H1.
    rewrite (edge_src_fst g); simpl; assumption.
  Qed.

  Lemma path_ends_app_cons:
    forall (g: AdjMatGG) a b c a' a2b,
      a = a' ->
      path_ends g (a, a2b) a b ->
      path_ends g (a, a2b +:: (b, c)) a' c.
  Proof.
    split; trivial.
    rewrite pfoot_last.
    rewrite (edge_dst_snd g); trivial.
  Qed.

  Lemma step_in_range:
    forall (g: AdjMatGG) x x0,
      valid_path g x ->
      In x0 (snd x) ->
      vvalid g (fst x0).
  Proof.
    intros.
    rewrite (surjective_pairing x) in H.
    pose proof (valid_path_strong_evalid g _ _ _ H H0).
    destruct H1 as [? [? _]].
    rewrite <- (edge_src_fst g); trivial.
  Qed.

  Lemma step_in_range2:
    forall (g: AdjMatGG) x x0,
      valid_path g x ->
      In x0 (snd x) ->
      vvalid g (snd x0).
  Proof.
    intros.
    rewrite (surjective_pairing x) in H.
    pose proof (valid_path_strong_evalid g _ _ _ H H0).
    destruct H1 as [? [_ ?]].
    rewrite <- (edge_dst_snd g); trivial.
  Qed.

  Lemma path_ends_one_step:
    forall (g: AdjMatGG) a b,
      path_ends g (a, (a, b)::nil) a b.
  Proof.
    intros. split; trivial.
    simpl. rewrite (edge_dst_snd g); trivial.
  Qed.

  Lemma epath_to_vpath_path_glue_one_step:
    forall (g: AdjMatGG) (a b c : V) p,
      valid_path g p ->
      path_ends g p a b ->
      Permutation (epath_to_vpath g (path_glue p (b, (b, c)::nil)))
                  (c :: epath_to_vpath g p).
  Proof.
    intros.
    rewrite (surjective_pairing p) in *.
    remember (snd p) as a2b.
    replace (fst p) with a in *.
    2: destruct H0 as [? _]; simpl in H0; Lia.lia.
    clear Heqa2b.

    generalize dependent H.
    generalize dependent H0.
    generalize dependent b.
    generalize dependent a.
    generalize dependent a2b.

    induction a2b.
    - intros. simpl. red in H0. simpl in H0; destruct H0 as [_ ?].
      subst a. rewrite (edge_dst_snd g), (edge_src_fst g); simpl.
      apply perm_swap.
    - intros. rename a into new.
      inversion H. clear H2.
      unfold path_glue. simpl fst; simpl snd.
      rewrite <- app_comm_cons.
      repeat rewrite epath_to_vpath_cons_eq; trivial.
      pose proof (perm_swap c a0 (epath_to_vpath g (dst g new, a2b))).
      apply Permutation_trans with (l' := (a0 :: c :: epath_to_vpath g (dst g new, a2b))); trivial.
      apply perm_skip.
      apply IHa2b.
      + red. split; trivial.
        destruct H0. rewrite pfoot_cons in H3; trivial.
      + apply valid_path_cons in H; trivial.
  Qed.

  Lemma in_path_app_cons:
    forall (g: AdjMatGG) step p2a src a b,
      valid_path g p2a ->
      evalid g (a,b) ->
      path_ends g p2a src a ->
      In_path g step (fst p2a, snd p2a +:: (a, b)) ->
      In_path g step p2a \/ step = b.
  Proof.
    intros. destruct H2; simpl in H2.
    1: left; unfold In_path; left; trivial.
    destruct H2 as [? [? ?]].
    assert (evalid g x). {
      apply in_app_or in H2. simpl in H2.
      destruct H2 as [? | [? | ?]]; [| | Lia.lia]; [|subst;trivial].
      rewrite (surjective_pairing p2a) in H.
      apply (valid_path_evalid _ _ _ _ H H2).
    }
    rewrite (edge_src_fst g) in H3; trivial.
    apply in_app_or in H2; simpl in H2.
    destruct H2 as [? | [? | ?]]; [| | Lia.lia]; destruct H3.
    - left. unfold In_path. right.
      exists x. rewrite (edge_src_fst g); trivial.
      split; [|left]; trivial.
    - left. unfold In_path. right.
      exists x. rewrite (edge_src_fst g); trivial.
      split; [|right]; trivial.
    - left. apply pfoot_in.
      destruct H1. rewrite H3, <- H2; simpl; trivial.
    - unfold In_path. right.
      rewrite H3, <- H2; simpl; trivial.
      rewrite (edge_dst_snd g); trivial.
  Qed.

  Lemma acyclic_foot_empty: forall (g : AdjMatGG) src l,
      valid_path g (src, l) ->
      acyclic_path g (src, l) ->
      pfoot g (src, l) = src ->
      l = nil.
  Proof.
    destruct l; auto. intros. exfalso. assert (fst e = src). { destruct H.
                                                               rewrite (edge_src_fst g) in H. auto. }
                                                             apply pfoot_ptail in H1. simpl ptail in H1.
    rewrite pfoot_spec in H1. destruct H1.
    * rewrite (edge_dst_snd g) in H1. inversion H1. subst.
      red in H0. simpl in H0. rewrite (edge_src_fst g), (edge_dst_snd g) in H0.
      rewrite H4 in H0. inversion H0. apply H5. left. trivial.
    * destruct H1 as [v' [l' [e' [? ?]]]]. subst src. inversion H1. subst v' l.
      rename H into Hx. clear H1.
      red in H0.
      rewrite <- (edge_src_fst g) in H2.
      rewrite epath_to_vpath_cons_eq in H0; auto.
      rewrite NoDup_cons_iff in H0. destruct H0 as [? _].
      apply H. clear H H2.
      rewrite in_path_eq_epath_to_vpath.
      eapply path_ends_In_path_dst. split. reflexivity.
      rewrite pfoot_last. trivial.
      apply valid_path_tail in Hx. apply Hx.
  Qed.

  Lemma In_links_snd_In_path:
    forall (g: AdjMatGG) step path,
      In step (snd path) ->
      In_path g (snd step) path.
  Proof.
    intros. unfold In_path. right.
    exists step. split; trivial.
    right. rewrite (edge_dst_snd g); trivial.
  Qed.

  Lemma In_links_fst_In_path:
    forall (g: AdjMatGG) step path,
      In step (snd path) ->
      In_path g (fst step) path.
  Proof.
    intros. unfold In_path. right.
    exists step. split; trivial.
    left. rewrite (edge_src_fst g); trivial.
  Qed.

End Mathematical_AdjMat_Model.


From CoqCP Require Import Options FillInTheBlanks Completion RegularBracketString SwapUpdate ListDecomposition ListsEqual PrefixApp.
From stdpp Require Import numbers list.

Definition getSecondWitness (withBlanks : list (option Bracket)) :=
  let count := length withBlanks / 2 in
  let remainingOpenCount := count - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) in
  let remainingCloseCount := count - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) in
  repeat BracketOpen (remainingOpenCount - 1) ++ [BracketClose; BracketOpen] ++ repeat BracketClose (remainingCloseCount - 1).

Lemma twoWaysToFillCountOccBounds (withBlanks : list (option Bracket)) (witness1 witness2 : list Bracket) (hDiff : witness1 <> witness2) (hRightLength1 : length witness1 = count_occ optionBracketEqualityDecidable withBlanks None) (hRightLength2 : length witness2 = count_occ optionBracketEqualityDecidable withBlanks None) (hValid1 : isBalanced (fill withBlanks witness1)) (hValid2 : isBalanced (fill withBlanks witness2)) : count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) < length withBlanks / 2 /\ count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) < length withBlanks / 2.
Proof.
  pose proof fromArbitraryWitness_3 withBlanks witness1 ltac:(assumption) ltac:(assumption).
  pose proof fromArbitraryWitness_4 withBlanks witness1 ltac:(assumption) ltac:(assumption).
  pose proof addThreeTypes withBlanks as hTotal.
  assert (hSumWitness : forall (witness : list Bracket), count_occ bracketEqualityDecidable witness BracketOpen + count_occ bracketEqualityDecidable witness BracketClose = length witness).
  { intro witness. induction witness as [| head tail IH].
    - easy.
    - destruct head; simpl; lia. }
  split.
  - destruct (decide (count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) = length withBlanks / 2)) as [hContrary |]; try lia.
    pose proof fromArbitraryWitness_countOpen withBlanks witness1 ltac:(assumption) ltac:(assumption).
    pose proof fromArbitraryWitness_countOpen withBlanks witness2 ltac:(assumption) ltac:(assumption).
    pose proof (ltac:(lia) : count_occ bracketEqualityDecidable witness1 BracketOpen = 0) as h1.
    pose proof (ltac:(lia) : count_occ bracketEqualityDecidable witness2 BracketOpen = 0) as h2.
    pose proof (ltac:(lia) : length witness1 = length witness2) as hSameLength.
    assert (hEqual : witness1 = witness2).
    { induction witness1 as [| head tail IH] in h1, h2, witness2, hSameLength |- *.
      - simpl in hSameLength. symmetry in hSameLength. now pose proof nil_length_inv _ hSameLength.
      - destruct witness2 as [| head' tail']; try (simpl in *; easy). rewrite (IH tail'); try (destruct head; destruct head'; simpl in *; try destruct (decide _ _); try lia; try easy). }
    easy.
  - destruct (decide (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) = length withBlanks / 2)) as [hContrary |]; try lia.
    pose proof fromArbitraryWitness_countClose withBlanks witness1 ltac:(assumption) ltac:(assumption).
    pose proof fromArbitraryWitness_countClose withBlanks witness2 ltac:(assumption) ltac:(assumption).
    pose proof (ltac:(lia) : count_occ bracketEqualityDecidable witness1 BracketClose = 0) as h1.
    pose proof (ltac:(lia) : count_occ bracketEqualityDecidable witness2 BracketClose = 0) as h2.
    pose proof (ltac:(lia) : length witness1 = length witness2) as hSameLength.
    assert (hEqual : witness1 = witness2).
    { induction witness1 as [| head tail IH] in h1, h2, witness2, hSameLength |- *.
      - simpl in hSameLength. symmetry in hSameLength. now pose proof nil_length_inv _ hSameLength.
      - destruct witness2 as [| head' tail']; try (simpl in *; easy). rewrite (IH tail'); try (destruct head; destruct head'; simpl in *; try destruct (decide _ _); try lia; try easy). }
    easy.
Qed.

Lemma twoWaysToFillAux_differenceOnLeftSegment (withBlanks : list (option Bracket)) (witness : list Bracket) (position : nat) (hPosition : position < length (getWitness withBlanks)) (hSplit : position < length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) (hNth : nth position (getWitness withBlanks) BracketOpen <> nth position witness BracketOpen) (hRightLength : length witness = count_occ optionBracketEqualityDecidable withBlanks None) (hWitnessValid : isBalanced (fill withBlanks witness)) : isBalanced (fill withBlanks (getSecondWitness withBlanks)).
Proof.
  assert (hDiff : getWitness withBlanks <> witness).
  { remember (getWitness withBlanks) as witness'.
    destruct witness as [| head tail]; intro hContrary.
    - rewrite hContrary in hPosition. simpl in *. lia.
    - destruct witness' as [| head' tail']; try (simpl in *; lia).
      destruct position as [| position]; simpl in *; inversion hContrary; congruence. }
  assert (hLt : position < length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) -> nth position (getWitness withBlanks) BracketOpen = BracketOpen /\ nth position witness BracketOpen = BracketClose).
  { intro h. unfold getWitness in *. rewrite nthAppLt in *; try (rewrite repeat_length in *; lia).
  rewrite nth_repeat in *. destruct (nth position witness BracketOpen); intuition. }
  destruct (hLt ltac:(lia)) as [hNthGetWitness hNthWitness].
  destruct (fromArbitraryWitness withBlanks witness hWitnessValid hRightLength) as [hGetWitness [hEven [hCountLt1 [hCountLt2 hLengthGetWitness]]]].
  pose proof twoWaysToFillCountOccBounds withBlanks witness (getWitness withBlanks) ltac:(congruence) ltac:(assumption) ltac:(lia) ltac:(assumption) ltac:(assumption).
  pose proof updateKthPartialCompletion withBlanks position ltac:(lia) BracketClose as hPartial.
  pose proof listDecompositionSingle withBlanks (getKthBlank withBlanks position) ltac:(apply getKthBlankUpperBound; lia) None as hDecomp.
  assert (hPartial' : isPartialCompletion withBlanks (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) withBlanks)).
  { rewrite (ltac:(now rewrite <- hDecomp) : <[getKthBlank withBlanks position := Some BracketClose]> withBlanks = <[getKthBlank withBlanks position := Some BracketClose]> (take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None] ++ drop (S (getKthBlank withBlanks position)) withBlanks)) in hPartial.
    pose proof updateAppZero (take (getKthBlank withBlanks position) withBlanks) ([nth (getKthBlank withBlanks position) withBlanks None] ++ drop (S (getKthBlank withBlanks position)) withBlanks) (Some BracketClose) as hAux. rewrite take_length, (ltac:(pose proof getKthBlankUpperBound withBlanks position ltac:(lia); lia) : getKthBlank withBlanks position `min` length withBlanks = getKthBlank withBlanks position) in hAux. simpl in *. intuition congruence. }
  assert (hCanComplete : possibleToFill (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) withBlanks)).
  { exists (take position witness ++ drop (S position) witness). split.
    - rewrite app_length, !count_occ_app, takeKthBlankCountOcc, dropSuccKthBlankCountOcc, <- hRightLength, take_length, drop_length, (ltac:(lia) : position `min` length witness = position); try lia.
      simpl. lia.
    - rewrite (fillApp (take (getKthBlank withBlanks position) withBlanks) ([Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) withBlanks) (take position witness) (drop (S position) witness) ltac:(rewrite takeKthBlankCountOcc; rewrite ?take_length; lia) ltac:(rewrite count_occ_app, dropSuccKthBlankCountOcc, drop_length, <- hRightLength; simpl; lia)).
      pose proof fillApp [Some BracketClose] (drop (S (getKthBlank withBlanks position)) withBlanks) [] (drop (S position) witness) ltac:(now simpl) ltac:(rewrite dropSuccKthBlankCountOcc, drop_length, <- hRightLength; lia) as hIntermediate.
      rewrite app_nil_l in hIntermediate. rewrite hIntermediate. rewrite (ltac:(easy) : fill [Some BracketClose] [] = fill [None] [BracketClose]).
      rewrite <- (fillApp [None] (drop (S (getKthBlank withBlanks position)) withBlanks) [BracketClose] (drop (S position) witness) ltac:(easy) ltac:(rewrite dropSuccKthBlankCountOcc, drop_length, <- hRightLength; lia)).
      rewrite <- (fillApp (take (getKthBlank withBlanks position) withBlanks) ([None] ++ drop (S (getKthBlank withBlanks position)) withBlanks) (take position witness) ([BracketClose] ++ drop (S position) witness) ltac:(rewrite takeKthBlankCountOcc, take_length; lia) ltac:(rewrite app_length, drop_length, count_occ_app, dropSuccKthBlankCountOcc; simpl; lia)).
      rewrite <- (nthGetKthBlank withBlanks position None), <- hDecomp, <- hNthWitness, <- listDecompositionSingle; try lia. tauto. }
  destruct hCanComplete as [answers2 [hAnswers2a hAnswers2b]].
  pose proof fromArbitraryWitness_1 (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) withBlanks) answers2 ltac:(tauto) ltac:(tauto) as hIntermediate.
  unfold getWitness in hIntermediate.
  rewrite !app_length, take_length, (ltac:(pose proof getKthBlankUpperBound withBlanks position; lia) : getKthBlank withBlanks position `min` length withBlanks = getKthBlank withBlanks position), drop_length, (ltac:(intros; easy) : forall A (x : A), length [x] = 1), !count_occ_app, (ltac:(intro x; destruct x as [[|] |]; try easy) : forall x, count_occ optionBracketEqualityDecidable [x] x = 1), (ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] (Some BracketOpen) = 0) in hIntermediate.
  rewrite (ltac:(pose proof getKthBlankUpperBound withBlanks position; lia) : (getKthBlank withBlanks position + (1 + (length withBlanks - S (getKthBlank withBlanks position)))) = length withBlanks) in hIntermediate.
  assert (hCountOpen : count_occ optionBracketEqualityDecidable (take (getKthBlank withBlanks position) withBlanks) (Some BracketOpen) + (0 + count_occ optionBracketEqualityDecidable (drop (S (getKthBlank withBlanks position)) withBlanks) (Some BracketOpen)) = count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)).
  { pose proof nthGetKthBlank withBlanks position None ltac:(lia) as hStep.
    pose proof getKthBlankUpperBound withBlanks position.
    rewrite (ltac:(now rewrite hStep) : 0 = count_occ optionBracketEqualityDecidable [nth (getKthBlank withBlanks position) withBlanks None] (Some BracketOpen)), <- !count_occ_app, <- listDecompositionSingle; (done || lia). }
  rewrite hCountOpen in hIntermediate. clear hCountOpen.
  assert (hCountClose : count_occ optionBracketEqualityDecidable (take (getKthBlank withBlanks position) withBlanks) (Some BracketClose) + (1 + count_occ optionBracketEqualityDecidable (drop (S (getKthBlank withBlanks position)) withBlanks) (Some BracketClose)) = S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose))).
  { pose proof nthGetKthBlank withBlanks position None ltac:(lia) as hStep.
    pose proof getKthBlankUpperBound withBlanks position.
    rewrite (ltac:(now rewrite hStep) : 0 = count_occ optionBracketEqualityDecidable [nth (getKthBlank withBlanks position) withBlanks None] (Some BracketClose)), Nat.add_succ_l, Nat.add_succ_r, <- !count_occ_app, <- listDecompositionSingle; (done || lia). }
  rewrite hCountClose in hIntermediate. clear hCountClose.
  pose proof fillApp (take (getKthBlank withBlanks position) withBlanks) ([Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) withBlanks) (repeat BracketOpen position) (repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose)))) ltac:(rewrite repeat_length, takeKthBlankCountOcc; lia) ltac:(rewrite !app_length, !repeat_length, !count_occ_app, dropSuccKthBlankCountOcc, (ltac:(intros; reflexivity) : count_occ optionBracketEqualityDecidable [Some BracketClose] None = 0); destruct hEven as [w hEven]; pose proof (ltac:(apply Nat.div_mul; easy) : w * 2 / 2 = w) as hDiv; pose proof addThreeTypes withBlanks as hAdd; rewrite <- hEven in hDiv; lia) as hStep.
  rewrite (ltac:(intros; listsEqual) : forall a b, repeat BracketOpen position ++ repeat BracketOpen a ++ repeat BracketClose b = (repeat BracketOpen position ++ repeat BracketOpen a) ++ repeat BracketClose b), <- repeat_app, (ltac:(lia) : position + (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) in hStep.
  rewrite hStep in hIntermediate. clear hStep.
  pose proof fillApp [Some BracketClose] (drop (S (getKthBlank withBlanks position)) withBlanks) [] (repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose)))) ltac:(easy) ltac:(rewrite !app_length, !repeat_length, dropSuccKthBlankCountOcc; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia) as hStep.
  rewrite app_nil_l in hStep. rewrite hStep, (ltac:(easy) : fill [Some BracketClose] [] = fill [None] [BracketClose]), <- fillApp in hIntermediate; try (simpl in *; easy); try (rewrite !app_length, !repeat_length, dropSuccKthBlankCountOcc; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia). clear hStep.
  rewrite <- fillApp in hIntermediate; try (rewrite repeat_length, takeKthBlankCountOcc; lia); try (rewrite !app_length, !repeat_length, count_occ_app, (ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1), dropSuccKthBlankCountOcc, !(ltac:(easy) : length [BracketClose] = 1); pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  rewrite <- (nthGetKthBlank withBlanks position None), <- listDecompositionSingle in hIntermediate; try (pose proof getKthBlankUpperBound withBlanks position; lia).
  remember (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose)))) as x eqn:hX.
  assert (hLeft : nth position x BracketOpen = BracketClose).
  { subst x.
    assert (hStep : forall x, nth position x BracketOpen = nth (length (repeat BracketOpen position)) x BracketOpen). { intros. now rewrite repeat_length. }
    now rewrite hStep, nthAppZero. }
  assert (hRight : nth (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x BracketOpen = BracketOpen).
  { subst x.
    assert (hRebracket' : (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1)) ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose))) = repeat BracketOpen position ++ [BracketClose] ++ (repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1) ++ [BracketOpen]) ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose)))). { listsEqual. }
    assert (hArith : (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) = S (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1)). { lia. }
    assert (hRepeat : repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) = repeat BracketOpen (S (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1))). { auto. }
    assert (hRebracket : repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position) ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose))) = (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1)) ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - S (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose)))).
    { now rewrite hRebracket', <- repeat_cons, hRepeat. }
    rewrite hRebracket.
    assert (hLength : length (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1)) = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)).
    { rewrite !app_length, !repeat_length, (ltac:(easy) : length [BracketClose] = 1). lia. }
    assert (hRewrite : forall x, nth (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x BracketOpen = nth (length (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - position - 1))) x BracketOpen). { congruence. }
    rewrite hRewrite, nthAppZero. easy. }
  assert (hLength : length x = length witness).
  { subst x. rewrite !app_length, !repeat_length, (ltac:(easy) : length [BracketClose] = 1); pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia. }
  rewrite (listDecompositionSingle x (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) ltac:(pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia) BracketOpen) in hIntermediate.
  rewrite (listDecompositionSingle (take (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x) position ltac:(rewrite take_length; lia) BracketOpen), take_take in hIntermediate.
  rewrite (ltac:(lia) : position `min` (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) = position), hRight in hIntermediate.
  pose proof nthAppLt BracketOpen (take (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x) (drop (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x) position ltac:(rewrite take_length; lia) as hExtend.
  rewrite take_drop in hExtend.
  rewrite <- hExtend, hLeft in hIntermediate.
  pose proof listDecomposition withBlanks (getKthBlank withBlanks position) (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) ltac:(apply getKthBlankLt; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia) ltac:(apply getKthBlankUpperBound; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia) None as hDecomp'.
  assert (hFillWithBlanks : forall stuff, fill withBlanks stuff = fill (take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) stuff). { now rewrite <- hDecomp'. }
  rewrite hFillWithBlanks in hIntermediate. clear hFillWithBlanks hDecomp'.
  rewrite !nthGetKthBlank in hIntermediate; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  rewrite <- !app_assoc, !fillApp in hIntermediate; try (simpl in *; lia); try (rewrite ?drop_length, ?take_length, ?app_length, ?count_occ_app, ?takeKthBlankCountOcc, ?Nat.add_1_r, ?dropSuccKthBlankCountOcc); try lia; try (rewrite ?(ltac:(easy) : length [BracketOpen] = 1), ?(ltac:(easy) : length [BracketClose] = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1)); try (rewrite ?drop_length, ?take_length); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  rewrite !(ltac:(easy) : forall x : Bracket, fill [None] [x] = fill [Some x] []), <- !fillApp in hIntermediate; try (simpl in *; lia); try (rewrite ?drop_length, ?take_length, ?app_length, ?(ltac:(easy) : length ([] : list Bracket) = 0), ?count_occ_app, ?takeKthBlankCountOcc, ?Nat.add_1_r, ?dropSuccKthBlankCountOcc); try lia; try (rewrite ?(ltac:(easy) : length [BracketOpen] = 1), ?(ltac:(easy) : length [BracketClose] = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] None = 0), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] None = 0)); try (rewrite ?drop_length, ?take_length); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  pose proof fromArbitraryWitness_1 (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [Some BracketOpen] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) (take position x ++ [] ++ drop (S position) (take (length withBlanks `div` 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) x) ++ [] ++ drop (S (length withBlanks `div` 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) x) ltac:(assumption) ltac:(try (simpl in *; lia); try (rewrite ?drop_length, ?take_length, ?app_length, ?(ltac:(easy) : length ([] : list Bracket) = 0), ?count_occ_app, ?takeKthBlankCountOcc, ?Nat.add_1_r, ?dropSuccKthBlankCountOcc); try lia; try (rewrite ?(ltac:(easy) : length [BracketOpen] = 1), ?(ltac:(easy) : length [BracketClose] = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] None = 0), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] None = 0)); try (rewrite ?drop_length, ?take_length); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) as hAlmostDone.
  unfold getWitness in hAlmostDone.
  assert (hImpenetrable1 : count_occ optionBracketEqualityDecidable (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [Some BracketOpen] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) (Some BracketOpen) = count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) + 1).
  { rewrite ?count_occ_app, (ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] (Some BracketOpen) = count_occ optionBracketEqualityDecidable [None] (Some BracketOpen)), (ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] (Some BracketOpen) = S (count_occ optionBracketEqualityDecidable [None] (Some BracketOpen))).
    pose proof nthGetKthBlank withBlanks position None ltac:(lia).
    pose proof nthGetKthBlank withBlanks (length withBlanks `div` 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) None ltac:(try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) as hAnotherBlank.
    rewrite !Nat.add_assoc, !Nat.add_succ_r, <- !count_occ_app, (ltac:(congruence) : (take (getKthBlank withBlanks position) withBlanks ++ [None]) = (take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None])), (ltac:(congruence) : S (count_occ optionBracketEqualityDecidable (((take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None]) ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks)) ++ [None]) (Some BracketOpen)) +count_occ optionBracketEqualityDecidable (drop (S (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 0)) withBlanks)  (Some BracketOpen) = S (count_occ optionBracketEqualityDecidable (((take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None]) ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks)) ++ [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None]) (Some BracketOpen)) + count_occ optionBracketEqualityDecidable (drop (S (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 0)) withBlanks) (Some BracketOpen)), <- !app_assoc, Nat.add_0_r.
    pose proof listDecomposition_rhsSucc withBlanks (getKthBlank withBlanks position) (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) ltac:(apply getKthBlankLt; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) ltac:(pose proof getKthBlankUpperBound withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) None as hFold. rewrite Nat.add_succ_l, <- count_occ_app, <- !app_assoc, <- hFold. lia. }
  rewrite hImpenetrable1 in hAlmostDone.
  assert (hImpenetrable2 : count_occ optionBracketEqualityDecidable (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [Some BracketOpen] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) (Some BracketClose) = count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) + 1).
  { rewrite ?count_occ_app, (ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] (Some BracketClose) = count_occ optionBracketEqualityDecidable [None] (Some BracketClose)), (ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] (Some BracketClose) = S (count_occ optionBracketEqualityDecidable [None] (Some BracketClose))).
    pose proof nthGetKthBlank withBlanks position None ltac:(lia).
    pose proof nthGetKthBlank withBlanks (length withBlanks `div` 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) None ltac:(try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) as hAnotherBlank.
    rewrite !Nat.add_assoc, !Nat.add_succ_r, <- !count_occ_app, (ltac:(congruence) : (take (getKthBlank withBlanks position) withBlanks ++ [None]) = (take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None])), (ltac:(congruence) : count_occ optionBracketEqualityDecidable [None] (Some BracketClose) = count_occ optionBracketEqualityDecidable [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None] (Some BracketClose)), !Nat.add_succ_l, <- !count_occ_app, <- !app_assoc, !Nat.add_0_r.
    pose proof listDecomposition_rhsSucc withBlanks (getKthBlank withBlanks position) (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) ltac:(apply getKthBlankLt; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) ltac:(pose proof getKthBlankUpperBound withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) None as hFold. rewrite <- hFold. lia. }
  rewrite hImpenetrable2 in hAlmostDone.
  assert (hUnwieldy1: (length (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [Some BracketOpen] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) / 2 - (count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) + 1)) = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1).
  { rewrite !app_length, (ltac:(easy) : length [Some BracketClose] = length [nth (getKthBlank withBlanks position) withBlanks None]), (ltac:(easy) : length [Some BracketOpen] = length [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None]), <- !app_length, <- listDecomposition; try (pose proof getKthBlankUpperBound withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try apply getKthBlankLt; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia). }
  rewrite hUnwieldy1 in hAlmostDone.
  assert (hUnwieldy2 : (length (take (getKthBlank withBlanks position) withBlanks ++ [Some BracketClose] ++ drop (S (getKthBlank withBlanks position)) (take (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks) ++ [Some BracketOpen] ++ drop (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) + 1) withBlanks) / 2 - (count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) + 1)) = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1).
  { rewrite !app_length, (ltac:(easy) : length [Some BracketClose] = length [nth (getKthBlank withBlanks position) withBlanks None]), (ltac:(easy) : length [Some BracketOpen] = length [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None]), <- !app_length, <- listDecomposition; try (pose proof getKthBlankUpperBound withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try apply getKthBlankLt; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia). }
  rewrite hUnwieldy2 in hAlmostDone.
  rewrite (ltac:(rewrite app_nil_l, <- repeat_app; apply (ltac:(congruence) : forall a b, a = b -> repeat BracketOpen a = repeat BracketOpen b); lia) : repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1) = repeat BracketOpen position ++ [] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1 - position)), (ltac:(easy) : repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1) = [] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1)), <- !app_assoc, !fillApp in hAlmostDone; try (simpl in *; lia); try (rewrite ?drop_length, ?take_length, ?app_length, ?repeat_length, ?(ltac:(easy) : length ([] : list Bracket) = 0), ?count_occ_app, ?takeKthBlankCountOcc, ?Nat.add_1_r, ?dropSuccKthBlankCountOcc); try lia; try (rewrite ?(ltac:(easy) : length [BracketOpen] = 1), ?(ltac:(easy) : length [BracketClose] = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] None = 0), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] None = 0)); try (rewrite ?drop_length, ?take_length); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  rewrite <- !(ltac:(easy) : forall x : Bracket, fill [None] [x] = fill [Some x] []), <- !fillApp in hAlmostDone; try (simpl in *; lia); try (rewrite ?drop_length, ?take_length, ?app_length, ?repeat_length, ?(ltac:(easy) : length ([] : list Bracket) = 0), ?count_occ_app, ?takeKthBlankCountOcc, ?Nat.add_1_r, ?dropSuccKthBlankCountOcc); try lia; try (rewrite ?(ltac:(easy) : length [BracketOpen] = 1), ?(ltac:(easy) : length [BracketClose] = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [None] None = 1), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketOpen] None = 0), ?(ltac:(easy) : count_occ optionBracketEqualityDecidable [Some BracketClose] None = 0)); try (rewrite ?drop_length, ?take_length); try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia).
  pose proof nthGetKthBlank withBlanks position None ltac:(lia).
  pose proof nthGetKthBlank withBlanks (length withBlanks `div` 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen)) None ltac:(try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia); rewrite ?dropSuccTakeKthBlankCountOcc; try (pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; lia)) as hAnotherBlank.
  rewrite app_assoc, (ltac:(congruence) : (take (getKthBlank withBlanks position) withBlanks ++ [None]) = (take (getKthBlank withBlanks position) withBlanks ++ [nth (getKthBlank withBlanks position) withBlanks None])), (ltac:(congruence) : [None] = [nth (getKthBlank withBlanks (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) withBlanks None]), <- !app_assoc, <- listDecomposition in hAlmostDone; try apply getKthBlankLt; pose proof addThreeTypes withBlanks; destruct hEven as [w hEven]; pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv; rewrite <- hEven in hDiv; try apply getKthBlankUpperBound; try lia.
  destruct (decide (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1 - position = 0)) as [hMiddle | hMiddle]; unfold getSecondWitness.
  - now rewrite hMiddle, (ltac:(lia) : position = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1) in *.
  - pose proof canAlwaysSwapCloseAndOpenInWitness (repeat BracketOpen position) (repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position)) ([BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1)) withBlanks as hSwap.
    assert (hRewriteHyp : (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position) ++ [BracketOpen] ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1)) = (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1 - position) ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1))).
    { now rewrite (ltac:(listsEqual) : (repeat BracketOpen position ++ [BracketClose] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position) ++ [BracketOpen] ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1)) = (repeat BracketOpen position ++ [BracketClose] ++ (repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position) ++ [BracketOpen]) ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1))), (ltac:(easy) : [BracketOpen] = repeat BracketOpen 1), <- repeat_app, (ltac:(lia) : length withBlanks / 2 -
    count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position + 1 = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1 - position). }
    rewrite hRewriteHyp in hSwap.
    assert (hMassage : repeat BracketOpen position ++ [BracketOpen] ++ repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position) ++ [BracketClose] ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1) = repeat BracketOpen (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1) ++ [BracketClose] ++ [BracketOpen] ++ repeat BracketClose (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketClose) - 1)).
    { now rewrite !app_assoc, (ltac:(now rewrite <- repeat_cons) : repeat BracketOpen position ++ [BracketOpen] = repeat BracketOpen (S position)), <- repeat_app, <- !app_assoc, (ltac:(lia) : S position + (length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 2 - position) = length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) - 1). }
    rewrite hMassage in hSwap.
    unfold satisfactoryWitness in *. epose proof hSwap _. easy.
    Unshelve.
    intuition. rewrite !app_length, !repeat_length, !(ltac:(easy) : forall x : Bracket, length [x] = 1). lia.
Qed.

Fixpoint mirror (s : list Bracket) := match s with
  | [] => []
  | (BracketOpen :: tail) => mirror tail ++ [BracketClose]
  | (BracketClose :: tail) => mirror tail ++ [BracketOpen]
  end.

Fixpoint mirrorWithBlanks (s : list (option Bracket)) := match s with
  | [] => []
  | (Some BracketOpen :: tail) => mirrorWithBlanks tail ++ [Some BracketClose]
  | (Some BracketClose :: tail) => mirrorWithBlanks tail ++ [Some BracketOpen]
  | (None :: tail) => mirrorWithBlanks tail ++ [None]
  end.

Lemma mirrorPreservesLength s : length (mirror s) = length s.
Proof.
  induction s as [| [|] tail IH]; try easy; simpl in *; rewrite app_length, IH; simpl; lia.
Qed.

Lemma mirrorWithBlanksPreservesLength s : length (mirrorWithBlanks s) = length s.
Proof.
  induction s as [| [[|]|] tail IH]; try easy; simpl in *; rewrite app_length, IH; simpl; lia.
Qed.

Lemma mirrorCountOpen (s : list Bracket) : countOpen (mirror s) = countClose s.
Proof.
  induction s as [| [|] tail IH]; simpl in *; autorewrite with rewriteCount; lia.
Qed.

Lemma mirrorCountClose (s : list Bracket) : countClose (mirror s) = countOpen s.
Proof.
  induction s as [| [|] tail IH]; simpl in *; autorewrite with rewriteCount; lia.
Qed.

Lemma mirrorOpenCountEqualCloseCount (s : list Bracket) (h : countOpen s = countClose s) : countOpen (mirror s) = countClose (mirror s).
Proof.
  pose (mirrorCountOpen s).
  pose (mirrorCountClose s).
  congruence.
Qed.

Lemma mirrorApp s1 s2 : mirror (s1 ++ s2) = mirror s2 ++ mirror s1.
Proof.
  induction s1 as [| head tail IH].
  - simpl. now rewrite app_nil_r.
  - rewrite <- app_comm_cons. destruct head; simpl; now rewrite IH, <- !app_assoc.
Qed.

Lemma mirrorStillBalanced (s : list Bracket) (hBalanced : isBalanced s) : isBalanced (mirror s).
Proof.
  induction hBalanced as [| s IH |].
  - apply EmptyBalanced.
  - assert (h1 : forall s, mirror (s ++ [BracketClose]) = [BracketOpen] ++ mirror s).
    { intro l. induction l as [| head tail IH'].
      - easy.
      - rewrite <- app_comm_cons. destruct head; simpl in *; now rewrite IH'. }
    assert (h2 : forall s, mirror ([BracketOpen] ++ s ++ [BracketClose]) = [BracketOpen] ++ mirror s ++ [BracketClose]).
    { intro l. rewrite app_assoc, h1. easy. }
    rewrite h2. now apply WrapBalanced.
  - rewrite mirrorApp. now apply JoinBalanced.
Qed.

Lemma mirrorWithBlanksCountOpen (s : list (option Bracket)) : count_occ optionBracketEqualityDecidable (mirrorWithBlanks s) (Some BracketOpen) = count_occ optionBracketEqualityDecidable s (Some BracketClose).
Proof.
  induction s as [| [[|]|] tail IH]; simpl in *. { easy. }
  #[local] Hint Resolve Nat.add_1_r : core.
  all: now rewrite count_occ_app, IH.
Qed.

Lemma mirrorWithBlanksCountClose (s : list (option Bracket)) : count_occ optionBracketEqualityDecidable (mirrorWithBlanks s) (Some BracketClose) = count_occ optionBracketEqualityDecidable s (Some BracketOpen).
Proof.
  induction s as [| [[|]|] tail IH]; simpl in *. { easy. }
  #[local] Hint Resolve Nat.add_1_r : core.
  all: now rewrite count_occ_app, IH.
Qed.

Lemma mirrorWithBlanksCountNone (s : list (option Bracket)) : count_occ optionBracketEqualityDecidable (mirrorWithBlanks s) None = count_occ optionBracketEqualityDecidable s None.
Proof.
  induction s as [| [[|]|] tail IH]; simpl in *. { easy. }
  #[local] Hint Resolve Nat.add_1_r : core.
  all: now rewrite count_occ_app, IH.
Qed.

Lemma mirrorRepeatOpen (n : nat) : mirror (repeat BracketOpen n) = repeat BracketClose n.
Proof.
  induction n as [| n IH]. { easy. }
  simpl. now rewrite IH, repeat_cons.
Qed.

Lemma mirrorRepeatClose (n : nat) : mirror (repeat BracketClose n) = repeat BracketOpen n.
Proof.
  induction n as [| n IH]. { easy. }
  simpl. now rewrite IH, repeat_cons.
Qed.

Lemma getWitnessMirror (s : list (option Bracket)) : getWitness (mirrorWithBlanks s) = mirror (getWitness s).
Proof.
  unfold getWitness in *. now rewrite mirrorWithBlanksPreservesLength, mirrorApp, mirrorRepeatClose, mirrorRepeatOpen, mirrorWithBlanksCountClose, mirrorWithBlanksCountOpen.
Qed.

Lemma getSecondWitnessMirror (s : list (option Bracket)) : getSecondWitness (mirrorWithBlanks s) = mirror (getSecondWitness s).
Proof.
  unfold getSecondWitness in *. rewrite mirrorWithBlanksPreservesLength, !mirrorApp, mirrorRepeatClose, mirrorRepeatOpen, mirrorWithBlanksCountClose, mirrorWithBlanksCountOpen. simpl. listsEqual.
Qed.

Definition oppositeSign (x : Bracket) := match x with
  | BracketOpen => BracketClose
  | BracketClose => BracketOpen
  end.

Lemma nthMirror (s : list Bracket) (position : nat) (h : position < length s) default : nth position s default = oppositeSign (nth (length s - position - 1) (mirror s) default).
Proof.
  induction s as [| head tail IH] in position, h |- *. { easy. }
  destruct position as [| position].
  { simpl in *. rewrite Nat.sub_0_r in *.
    rewrite <- mirrorPreservesLength.
    destruct head; now rewrite (nthAppZero (mirror tail)). }
  simpl in *.
  destruct head; rewrite nthAppLt, IH; try (rewrite mirrorPreservesLength); (done || lia).
Qed.

Lemma nthMirror2 (s : list Bracket) (position : nat) (h : position < length s) default : oppositeSign (nth position s default) = nth (length s - position - 1) (mirror s) default.
Proof.
  induction s as [| head tail IH] in position, h |- *. { easy. }
  destruct position as [| position].
  { simpl in *. rewrite Nat.sub_0_r in *.
    rewrite <- mirrorPreservesLength.
    destruct head; now rewrite (nthAppZero (mirror tail)). }
  simpl in *.
  destruct head; rewrite nthAppLt, IH; try (rewrite mirrorPreservesLength); (done || lia).
Qed.

Lemma mirrorMirror (s : list Bracket) : mirror (mirror s) = s.
Proof.
  induction s as [| [|] tail IH]. { easy. }
  all: simpl; now rewrite mirrorApp, IH.
Qed.

Lemma fillMirror (withBlanks : list (option Bracket)) witness (hRightLength : length witness = count_occ optionBracketEqualityDecidable withBlanks None) : mirror (fill withBlanks witness) = fill (mirrorWithBlanks withBlanks) (mirror witness).
Proof.
  induction withBlanks as [| [[|] |] tail IH] in witness, hRightLength |- *. { easy. }
  - simpl in *. rewrite (ltac:(now rewrite app_nil_r) : mirror witness = mirror witness ++ []), fillApp, IH; try easy. now rewrite mirrorPreservesLength, mirrorWithBlanksCountNone.
  - simpl in *. rewrite (ltac:(now rewrite app_nil_r) : mirror witness = mirror witness ++ []), fillApp, IH; try easy. now rewrite mirrorPreservesLength, mirrorWithBlanksCountNone.
  - destruct witness as [| head' tail']; simpl in *; try lia.
    destruct head'; rewrite fillApp; try (rewrite mirrorPreservesLength, mirrorWithBlanksCountNone; lia); try easy; rewrite IH; (done || lia).
Qed.

Lemma twoWaysToFillAux (withBlanks : list (option Bracket)) (witness : list Bracket) (hDiff : getWitness withBlanks <> witness) (hRightLength : length witness = count_occ optionBracketEqualityDecidable withBlanks None) (hWitnessValid : isBalanced (fill withBlanks witness)) : isBalanced (fill withBlanks (getSecondWitness withBlanks)).
Proof.
  destruct (fromArbitraryWitness withBlanks witness hWitnessValid hRightLength) as [hGetWitness [hEven [hCountLt1 [hCountLt2 hLengthGetWitness]]]].
  pose proof twoWaysToFillCountOccBounds withBlanks witness (getWitness withBlanks) ltac:(congruence) ltac:(assumption) ltac:(lia) ltac:(assumption) ltac:(assumption).
  destruct (oneDifferentPlace (getWitness withBlanks) witness BracketOpen hDiff ltac:(congruence)) as [position [hPosition hNth]].
  assert (hLt : position < length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) -> nth position (getWitness withBlanks) BracketOpen = BracketOpen /\ nth position witness BracketOpen = BracketClose).
  { intro h. unfold getWitness in *. rewrite nthAppLt in *; try (rewrite repeat_length in *; lia).
    rewrite nth_repeat in *. destruct (nth position witness BracketOpen); intuition. }
  assert (hGeq : length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen) <= position -> nth position (getWitness withBlanks) BracketOpen = BracketClose /\ nth position witness BracketOpen = BracketOpen).
  { intro h. unfold getWitness in *. rewrite nthAppGeq in *; try (rewrite repeat_length in *; lia).
    rewrite (nth_indep _ BracketOpen BracketClose), nth_repeat in *; try (rewrite ?app_length, ?repeat_length in *; lia). destruct (nth position witness BracketOpen); intuition. }
  destruct (decide (position < length withBlanks / 2 - count_occ optionBracketEqualityDecidable withBlanks (Some BracketOpen))) as [hSplit | hSplit].
  - apply (twoWaysToFillAux_differenceOnLeftSegment withBlanks witness position); try (lia || done).
  - destruct (hGeq ltac:(lia)) as [hNthGetWitness hNthWitness].
    destruct hEven as [w hEven].
    pose proof (ltac:(now apply Nat.div_mul) : w * 2 / 2 = w) as hDiv. rewrite <- hEven in hDiv.
    pose proof addThreeTypes withBlanks.
    assert (hOppositeSignDiff : forall a b, a <> b -> oppositeSign a <> oppositeSign b).
    { intros a b h. destruct a; destruct b; easy. }
    assert (hGetWitnessLength : length (getWitness (mirrorWithBlanks withBlanks)) = length (getWitness withBlanks)).
    { unfold getWitness. rewrite !app_length, !repeat_length, !mirrorWithBlanksPreservesLength, !mirrorWithBlanksCountClose, !mirrorWithBlanksCountOpen. lia. }
    epose proof twoWaysToFillAux_differenceOnLeftSegment (mirrorWithBlanks withBlanks) (mirror witness) (length witness - position - 1) ltac:(lia) ltac:(rewrite mirrorWithBlanksPreservesLength, mirrorWithBlanksCountOpen; lia) ltac:(rewrite getWitnessMirror, nthMirror; rewrite mirrorPreservesLength, ?mirrorMirror; try lia; rewrite (ltac:(lia) : (length (getWitness withBlanks) - (length witness - position - 1) - 1) = position), <- nthMirror2; try lia; now apply hOppositeSignDiff) ltac:(now rewrite mirrorPreservesLength, mirrorWithBlanksCountNone) ltac:(rewrite <- fillMirror; now try apply mirrorStillBalanced) as hDestination.
    rewrite getSecondWitnessMirror, <- fillMirror in hDestination.
    + pose proof mirrorStillBalanced _ hDestination. now rewrite mirrorMirror in *.
    + unfold getSecondWitness. rewrite !app_length, !repeat_length, (ltac:(easy) : length [BracketClose; BracketOpen] = 2). lia.
Qed.

Lemma twoWaysToFill (withBlanks : list (option Bracket)) (witness1 witness2 : list Bracket) (hDiff : witness1 <> witness2) (hRightLength1 : length witness1 = count_occ optionBracketEqualityDecidable withBlanks None) (hRightLength2 : length witness2 = count_occ optionBracketEqualityDecidable withBlanks None) (hWitness1Valid : isBalanced (fill withBlanks witness1)) (hWitness2Valid : isBalanced (fill withBlanks witness2)) : isBalanced (fill withBlanks (getSecondWitness withBlanks)).
Proof.
  destruct (decide (witness1 = getWitness withBlanks)).
  - refine (twoWaysToFillAux withBlanks witness2 _ hRightLength2 _); (congruence || done).
  - refine (twoWaysToFillAux withBlanks witness1 _ hRightLength1 _); (congruence || done).
Qed.