ListTools.v (633 lines of code) (raw):

Require Import Commons. Section Lists. Context {X : eqType}. Definition weak_cons (x : X) := bind (fun (xs : list X) => Some (x :: xs)). Definition weak_app (xs : seq X) ys := match ys with | Some ys => Some (xs ++ ys) | None => None end. Notation "x :~: xs" := (weak_cons x xs) (at level 60, right associativity) : seq_scope. Notation "x :++: xs" := (weak_app x xs) (at level 56, left associativity) : seq_scope. Open Scope seq_scope. Lemma cons_wcons (x : X) l : Some (x :: l) = x :~: Some l. Proof. done. Qed. Lemma wcons_none x o: x :~: o = None -> o = None. Proof. by move: o => []. Qed. Lemma wcons_some x o o1: x :~: o = Some o1 -> exists o2, o = Some o2 /\ o1 = x :: o2. Proof. by move: o => [a [<-]|] //; eauto. Qed. Lemma weak_app_0s: forall xs, [::] :++: xs = xs. Proof. by move=> [xs|]. Qed. (* Insert list operation and its properties *) Fixpoint ins (i : nat) (es : seq X) (xs : seq X) := match i with 0 => Some (es ++ xs) | S i' => match xs with | x' :: xs' => x' :~: ins i' es xs' | _ => None end end. Definition oins (i : nat) (es : seq X) := bind (ins i es). Lemma oins_some n es xs: ins n es xs = oins n es (Some xs). Proof. done. Qed. Lemma ins_notnil: forall xs (i : nat) y (ys : seq X), ~ ins i (y :: ys) xs = Some (Nil _). Proof. by move=> [|x xs] [|n] y ys //= /wcons_some; case => _ [] //. Qed. Lemma ins_none' (es : seq X) k xs: ins (size xs + k.+1) es xs = None. Proof. move: xs. by elim => [|x xs] //= ->. Qed. Lemma ins_noneP k xs es: reflect (ins k es xs = None) (size xs < k). elim: xs k => [|x xs IHx] [|k] /=; rewrite ?cats0; try by constructor. case A0: (_ < k.+1); first by move: A0; rewrite ltnS => /IHx -> /=; constructor. case A1: ins; first by constructor. move /IHx in A1. by move: A0 A1; rewrite ltnS => ->. Qed. (* Seems unnecessary, should we remove? *) Lemma ins_some: forall xs es ys i, ins i es xs = Some ys -> size ys = size xs + size es /\ size xs >= i. Proof. split. elim: xs es ys i H => [|x xs IHxs] es ys. + by case => [] //= [] <-; rewrite cats0 add0n. + case => [] /=. * by case => <-; rewrite size_cat /= addnC. * by move => n /wcons_some [] ? [] /IHxs A0 ->; rewrite /= A0. move: H. move/orP: (leq_total i (size xs)) => [] //; rewrite leq_eqVlt => /orP []. + by move /eqP -> => //. + by case: (ins_noneP i xs es) => // ->. Qed. Lemma ins_id xs ys i: ins i [::] xs = Some ys -> xs = ys. Proof. by elim: i xs ys => [|i Hi] [|x xs] ys // [] //= /wcons_some [ys'] [] /Hi ->. Qed. Lemma oins_Swcons (x : X) (es : seq X): forall xs i, oins (i.+1) es (x :~: xs) = x :~: oins i es xs. Proof. by case => [] [] //=. Qed. (* Remove list opertaion and its properties*) Fixpoint rm i (es : seq X) (xs : seq X) := match xs, es with | _, [::] => Some xs | [::], _ => None | x' :: xs', e' :: es' => match i with | 0 => if x' == e' then rm 0 es' xs' else None | i'.+1 => x' :~: (rm i' es xs') end end. Definition orm (index : nat) (elements : seq X) := bind (rm index elements). Lemma orm_some n es xs: rm n es xs = orm n es (Some xs). Proof. done. Qed. Lemma rm_id k xs: rm k [::] xs = Some xs. Proof. by case: xs => [|x xs] /=. Qed. Lemma rm_len i es xs rs: size es > 0 -> rm i es xs = Some rs -> exists k, size xs = i + (size es) + k /\ size rs = i + k. Proof. elim: i es xs rs => [|i IHi] es xs rs H. move {H}. elim: es xs rs => [|e es IHes] xs rs //=. + rewrite rm_id => [] [] ->. by exists (size rs). + case: xs => [|??] //=. case: eqP => // _ /IHes [k'] []. rewrite ?add0n => -> ->. by exists k'. + move: es H => [|??] //. case: xs => [|??] // /IHi => A /= /wcons_some [?] [] /A [k'] [] -> B -> /=. rewrite B ?addnS ?addSn. by exists k'. Qed. Corollary orm_id k xs : orm k [::] xs = xs. Proof. by case : xs => [xs|] /=; rewrite ?rm_id. Qed. Lemma orm_0wcons x es xs: orm 0 (x :: es) (x :~: xs) = orm 0 es xs. Proof. by case: xs => //= => xs; rewrite eq_refl; case: xs => //=. Qed. Lemma rm_0app: forall xs1 xs2 es, rm 0 (xs1 ++ es) (xs1 ++ xs2) = rm 0 es xs2. Proof. by elim => [|x1 xs1 IHxs1] xs2 es //=; rewrite eq_refl IHxs1. Qed. Lemma rm_Scons xs x k es: rm k.+1 es (x :: xs) = x :~: (rm k es xs). Proof. case: es xs => [] //= [] //=. Qed. Lemma orm_Swcons xs x k es: orm (k .+1) es (x :~: xs) = x :~: (orm k es xs). Proof. elim: es xs => [|e es IHs] [[]|] //=. Qed. Lemma rm_addnapp xs ys k es: rm (k + size(ys)) es (ys ++ xs) = ys :++: (rm k es xs). Proof. elim: ys xs es => [|y ys IHys] xs es //=. + by rewrite addn0 weak_app_0s. + move: es => [|e es] //=; first by rewrite ?rm_id. by rewrite addnS IHys; case: rm => [mr|]. Qed. Lemma rm_none0 k xs e es: size xs <= k -> rm k (e :: es) xs = None. Proof. by elim: xs k => [k //=|x xs IHl [|k] //= /IHl ->]. Qed. Lemma rm_none1 {k xs es}: size es > 0 -> size xs < (size es) + k -> rm k es xs = None. Proof. elim: xs k es => [|x xs IHxs] [|k] [|e es] // Heq /=; case: (x == e) => //; rewrite ?addn0 ?addnS; try move=> /(IHxs _ _ Heq) -> // /(ltn_trans _ (ltnSn _)). case Hes: (size es == 0); first by move/eqP: Hes ->. move /neq0_lt0n in Hes. by rewrite -(addn0 (size es)) => /(IHxs _ _ Hes). Qed. Lemma rm_eq (l1 l2 l3 : seq X): rm 0 l2 l1 = Some l3 -> l2 ++ l3 = l1. elim: l2 l1 => [|a2 l2 IHl] [|a1 l1] //=; try by case => <-. + case A0: (a1 == a2) => // /IHl. by move: A0 => /eqP -> ->. Qed. (* nth element operation and its properties *) Fixpoint nth index xs : option X := match xs, index with nil, _ => None | x :: xs, 0 => Some x | x :: xs, S i => nth i xs end. Lemma nth_noneP i xs: reflect (nth i xs = None) (size xs <= i). elim: xs i => [|x xs IHx] [|i] /=; try by constructor. apply IHx. Qed. Lemma nth_nil_none (i : nat) (xs : seq X): nth i [::] = None. Proof. move: (leq0n i). by rewrite -[0]/(size (@nil X)) => /nth_noneP. Qed. Lemma nth_app_next xs1 xs2 k: nth (size xs1 + k) (xs1 ++ xs2) = nth k xs2. Proof. elim: xs1 k xs2 => [|x1 xs1 IHxs1] k xs2 //=. Qed. (* replace operation for lists and its properties *) Fixpoint rplc (n : nat) (e : option X) (xs : seq X) := match n, xs with | 0, x :: xs' => bind (fun e' => Some (e' :: xs')) e | S n', x :: xs' => x :~: rplc n' e xs' | _, _ => None end. Definition orplc (index : nat) (e : option X) := bind (rplc index e). Lemma orplc_some n e xs: rplc n e xs = orplc n e (Some xs). Proof. done. Qed. Lemma orplc_ind (x : X) l e i: orplc (S i) e (x :~: l) = x :~: (orplc i e l). Proof. by case l. Qed. Lemma rplc_0 xs i (e : option X): rplc i e xs = Some [::] -> False. Proof. by move: xs i e => [|??] [|?] [?|] //=; case: rplc. Qed. Lemma rplc_0none i e: rplc i e [::] = None. Proof. by case: i e => [|i] [e|]. Qed. Lemma rplc_noneP1 (e : X) {k} {xs}: reflect (rplc k (Some e) xs = None) (size xs <= k). elim: xs k => [|x xs IHx] [|k] /=; try by constructor. rewrite ltnS. by case: (rplc k (Some e) xs) (IHx k) => [a|]; case leq => [] [] //; constructor. Qed. Lemma rplc_none_none k xs: rplc k None xs = None. Proof. by elim: xs k => [|x xs Hxs] [|k] //=; rewrite Hxs. Qed. Lemma rplc_lenle k xs (e : option X): size xs <= k -> rplc k e xs = None. case: e => [a /(rplc_noneP1 a) //|] ?. by rewrite rplc_none_none. Qed. Lemma rplc_none_case k xs (e : option X): rplc k e xs = None <-> e = None \/ size xs <= k. Proof. case: e => [a|]; rewrite ?rplc_none_none; split; try move=> []; try move /rplc_noneP1; try done; by [right| left]. Qed. Lemma rplc_some k xs (e : option X) y: rplc k e xs = Some y -> k < size xs /\ (exists e', e = Some e'). Proof. case: e => [e'|]; last by rewrite rplc_none_none. case Hsz: (k < size xs); last by move: Hsz => /negbT; rewrite -leqNgt => /(rplc_lenle _ _ (Some e')) ->. by split => //; exists e'. Qed. Lemma rplc_Scons xs i (x : X) y: rplc (i.+1) y (x :: xs) = x :~: (rplc i y xs). Proof. done. Qed. Lemma orplc_0wcons xs (x : X) y: orplc 0 (Some y) (x :~: xs) = y :~: xs. Proof. by case: xs. Qed. Lemma rplc_addn_app xs1 xs2 k e: rplc (size xs1 + k) e (xs1 ++ xs2) = xs1 :++: rplc k e xs2. Proof. case: e => [e|]; last by rewrite ?rplc_none_none. by elim: xs1 => [|x1 xs1 IHxs1]; rewrite ?cat0s ?add0n //= ?IHxs1 //=; case: rplc. Qed. Lemma orplc_Swcons xs i (x : X) y: orplc (i.+1) y (x :~: xs) = x :~: (orplc i y xs). Proof. case: xs; done. Qed. Lemma rplc_some_len (xs ys : seq X) i e: rplc i e xs = Some ys -> size xs = size ys. Proof. case: e => [e|]; rewrite ?rplc_none_none //; elim: i xs ys => [|i IHi] [|x xs] //= ys; first by move=> //= [] <-. by move /wcons_some => [xs'] [] /IHi -> ->. Qed. Lemma orplc_none i l: orplc i None l = None. elim: i l => [|n IHn] [[|a l]|] //=. by move: (IHn (Some l)) => /= ->. Qed. (* replace and nth propertice *) Lemma rplc_nth_id (xs ys: seq X) i: rplc i (nth i xs) xs = Some ys -> xs = ys. Proof. elim: i xs ys => [|i Hi] [|x xs] ys //= []; first by move ->. by move /wcons_some => [xs'] [] /Hi -> ->. Qed. Lemma rplc_nth_id' i xs y: nth i xs = Some y -> rplc i (nth i xs) xs = Some xs. Proof. by elim: i y xs => [|i IHi] y [|x xs] //= /IHi ->. Qed. (* cut operation and its properties *) Fixpoint cut {X} (l : seq.seq X ) sc rc := match sc, rc, l with | S sc', _, x :: xs => x :: (cut xs sc' rc) | 0, S rc', x :: xs => (cut xs sc rc') | _, _, _ => l end. Lemma cut_id {xs : seq X} {n}: cut xs n 0 = xs. Proof. by elim: xs n => [|x xs IHxs] [|n] //=; rewrite IHxs. Qed. Lemma cut_empty_eq {Y : Type}: forall n k, cut (@nil Y) n k = @nil Y. Proof. by move=> [|n] [|k]. Qed. Lemma cut_nil {Y : Type}: forall xs, cut xs 0 (size xs) = @nil Y. Proof. by elim. Qed. (* insert/insert commutation *) Lemma ins_insC': forall xs i k (e1s e2s : seq X), (i + k) <= size xs -> oins (size e1s + (i + k)) e2s (ins i e1s xs) = oins i e1s (ins (i + k) e2s xs) /\ exists os, oins i e1s (ins (i + k) e2s xs) = Some os. Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1s e2s. rewrite add0n /=. + elim: e1s => [|e1 e1s IHx] Hsz /=. rewrite add0n. case Hins: (ins k) => [a|] /=; split => //; first by exists a. by move: Hins Hsz => /ins_noneP; rewrite ltnNge; case leq. + move: (Hsz) => /IHx => [] [] IHx' IHx''. case Hins: (ins k) => [a|] /=; split => //; try by rewrite IHx' Hins /=. by exists (e1 :: e1s ++ a). by move: Hins Hsz => /ins_noneP; rewrite ltnNge; case leq. + case: xs => [|x xs] //=. rewrite addSn addnS => /IHi /= A. move: (A e1s e2s) => []. rewrite ?oins_Swcons => -> [os] ->. split => //=. by exists (x :: os). Qed. Theorem ins_insC: forall xs i k (e1s e2s : seq X), i <= k -> k <= size xs -> oins (size e1s + k) e2s (ins i e1s xs) = oins i e1s (ins k e2s xs) /\ exists os, oins i e1s (ins k e2s xs) = Some os. Proof. move=> xs i k e1s e2s /le_ex [j] <-. exact: ins_insC'. Qed. (* remove/remove commutation *) Lemma rm_rmC': forall xs i k (e1s e2s : seq X) rrm1 rrm2, rm ((size e2s) + i + k) e1s xs = Some rrm1 -> rm i e2s xs = Some rrm2 -> orm i e2s (rm ((size e2s) + i + k) e1s xs) = orm (i + k) e1s (rm i e2s xs) /\ exists os, orm (i + k) e1s (rm i e2s xs) = Some os. Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1s e2s rrm1 rrm2. + rewrite add0n /=. elim: e2s xs e1s rrm1 rrm2 => [|e2 e2s IHe2s] [|x?] [|??] rrm1 rrm2; try by eauto. rewrite /= ?add0n. case: k => [|k]; rewrite orm_id => ->; by eauto. rewrite /= orm_id => _ ->; by eauto. simpl. case H: (x == e2) =>// /wcons_some [rrm1'] [] /IHe2s A _ /A []. move/eqP: H => ->. rewrite orm_0wcons => ->. by eauto. + rewrite addnS ?addSn //=. move: xs e1s => [|x xs] [|e1 e1s] //=; rewrite ?orm_id //=; try (move=> _ ->; by eauto). move=> /wcons_some [rrm1'] [] /IHi A _. case: e2s A => [|e2 e2s] A; [move: (rm_id i xs)| move=> /wcons_some [rrm2'] []]; move=> /A; rewrite ?orm_id ?rm_id ?cons_wcons ?orm_Swcons => [] []-> [os] -> /=; by eauto. Qed. Theorem rm_rmC: forall xs i k (e1s e2s : seq X) rrm1 rrm2, i <= k -> rm ((size e2s) + k) e1s xs = Some rrm1 -> rm i e2s xs = Some rrm2 -> orm i e2s (rm ((size e2s) + k) e1s xs) = orm k e1s (rm i e2s xs) /\ exists os, orm k e1s (rm i e2s xs) = Some os. Proof. move=> xs i k e1s e2s rrm1 rrm2 /le_ex [j] <-. rewrite addnA. move=> /rm_rmC' A /A []. by eauto. Qed. (* remove/insert commutation *) Lemma rm_insC_bef': forall xs i k eis ers rins rrm, oins ((size ers) + i + k) eis xs = Some rins -> orm i ers xs = Some rrm -> orm i ers (oins ((size ers) + i + k) eis xs) = oins (i+k) eis (orm i ers xs) /\ exists os, oins (i+k) eis (orm i ers xs) = Some os. Proof. case => [] // xs i. elim: i xs => [|i IHi] xs k eis ers. rewrite addn0 add0n /=. + elim: ers xs eis => [xs eis|er ers IHers [|x?] eis//=] rins rrm => /=. rewrite add0n orm_id rm_id; split => //. by exists rins; rewrite /= H. case H: (x == er). - move/eqP: H; move=> -> //= /wcons_some [rins'] [] /IHers A _ /A []. by rewrite orm_0wcons => ->. - by case: ins => [res|]. + move=> rins rrm; rewrite addnS addSn //=. move: xs => [|x xs] //=. move: ers => [|er ers]. - rewrite orm_id /= => ->. split => //. by exists rins. rewrite addSn orm_Swcons oins_Swcons oins_some => /wcons_some [rins'] [] /IHi A _ /wcons_some [rrm'] []. rewrite orm_some => /A [] -> [os] -> /=; split => //. by exists (x :: os). Qed. Theorem rm_insC_bef xs i k eis ers rins rrm: i <= k -> oins ((size ers) + k) eis xs = Some rins -> orm i ers xs = Some rrm -> orm i ers (oins ((size ers) + k) eis xs) = oins k eis (orm i ers xs) /\ exists os, oins k eis (orm i ers xs) = Some os. Proof. move=> /le_ex [?] <-. by rewrite addnA => /rm_insC_bef' A /A. Qed. Lemma rm_insC_aft': forall i xs k eis ers rins rrm, ins i eis xs = Some rins -> rm (i + k) ers xs = Some rrm -> orm ((size eis) + (i + k)) ers (ins i eis xs) = oins i eis (rm (i + k) ers xs) /\ exists os, oins i eis (rm (i + k) ers xs) = Some os. Proof. by elim => [|i IHi] xs k eis ers rins rrm //=; [rewrite add0n /= {1}addnC rm_addnapp; case: rm => [mr|]| move: xs ers => [|??] [|??] //=; [case H: ins => [?|] //| rewrite ?addSn addnS orm_Swcons oins_Swcons => /wcons_some [?] [] /IHi A ? /wcons_some [?] [] /A [] <- [?] ->]]; split => //=; eauto. Qed. Lemma rm_insC_aft xs i k eis ers rins rrm: i <= k -> ins i eis xs = Some rins -> rm k ers xs = Some rrm -> orm ((size eis) + k) ers (ins i eis xs) = oins i eis (rm k ers xs) /\ exists os, oins i eis (rm k ers xs) = Some os. Proof. by move=> /le_ex [?] <- /rm_insC_aft' A /A [] ->. Qed. Lemma rm_insC_in': forall i k xs eis ers ers' xs', ins k eis ers = Some ers' -> ins (i+k) eis xs = Some xs' -> rm i ers xs = rm i ers' xs'. Proof. elim => [|i Hi]. + elim => [|k Hk] [|x?] eis [|er?] ?? //=; try (by move=> [] <- [] <-; rewrite rm_0app). * move => /wcons_some [?] [] => H1 -> /wcons_some [?] [] => H2 -> /=. case: (x == er) H1 H2 => //. by apply /Hk. + by move => ? [|??] ? [|??] ? ? //= H1 /wcons_some [?] [H2 ->]; rewrite rm_Scons -(Hi _ _ _ _ _ _ H1 H2) // ?rm_id. Qed. Theorem rm_insC_in i k xs eis ers ers' xs': i <= k -> ins (k - i) eis ers = Some ers' -> ins k eis xs = Some xs' -> rm i ers xs = rm i ers' xs'. Proof. move=> /le_ex [s] <-; rewrite addnC -addnBA // subnn addn0 addnC => *. by apply (rm_insC_in' _ s _ eis). Qed. (* replace/replace commutation *) Lemma rplc_rplcC_neq': forall l i k t1 t2, orplc (S (i + k)) t2 (orplc i t1 l) = orplc i t1 (orplc ((S i + k)) t2 l). Proof. case => //. elim => [|x xs IHx]; intros. by rewrite /orplc /= rplc_0none. case: t1 t2 => [t1|] [t2|]; try by rewrite ?orplc_none. case: i => [/=|i]; first by case: rplc => []. by rewrite ?addSn ?orplc_ind IHx. Qed. Theorem rplc_rplcC_neq: forall l i k t1 t2, i == k = false -> orplc k t2 (orplc i t1 l) = orplc i t1 (orplc k t2 l). Proof. intros. case Hik: (i < k). + by move: Hik => /le_ex [j] <-; rewrite addSn rplc_rplcC_neq'. + case Hik': (k < i). - by move: Hik' => /le_ex [j] <-; rewrite addSn rplc_rplcC_neq'. - by move: Hik => /negbT; rewrite -leqNgt; move: Hik' => /negbT; rewrite -leqNgt => A B; have H': (i <= k <= i); rewrite ?B ?A //; move: H'; rewrite -eqn_leq H. Qed. Lemma rplc_rplcC_eq: forall xs i e1 e2, orplc i e2 (orplc i (Some e1) xs) = orplc i e2 xs. Proof. case=> [xs|] // i; elim: i xs => [|i IHi] xs e1 e2; first by case: xs. by case: xs IHi => [|x xs] IHi //=; rewrite orplc_Swcons IHi. Qed. (* replace/insert commutation *) Lemma rplc_insC_aft': forall xs i k e1 e2s, i + k < size xs -> orplc (size e2s + (i + k)) (Some e1) (ins i e2s xs) = oins i e2s (rplc (i + k) (Some e1) xs) /\ exists os, oins i e2s (rplc (i + k) (Some e1) xs) = Some os. Proof. move=> xs i. elim: i xs => [|i IHi] xs k e1 e2s. + rewrite add0n /= rplc_addn_app; case Hrplc: rplc => [rplc_r|] /=; first by (split => //; by exists (e2s ++ rplc_r)). move: Hrplc => /rplc_noneP1. by rewrite ltnNge; case leq. + rewrite ?addSn ?addnS. case: xs => [|x xs] //=. rewrite ?orplc_Swcons oins_Swcons => /IHi A. move: (A e1 e2s) => [] <- [os] ->. split=> //. by exists (x :: os). Qed. Theorem rplc_insC_aft: forall xs i k e1 e2s, i <= k -> k < size xs -> orplc (size e2s + k) (Some e1) (ins i e2s xs) = oins i e2s (rplc k (Some e1) xs) /\ exists os, oins i e2s (rplc k (Some e1) xs) = Some os. Proof. move=> ??? e1 e2s /le_ex [?] <- /rplc_insC_aft' A. move: (A e1 e2s) => [] -> [os] ->. split=> //. by eauto. Qed. Lemma rplc_insC_bef': forall xs i k e1 e2s, i + (S k) <= size xs -> orplc i (Some e1) (ins (S (i + k)) e2s xs) = oins (S (i + k)) e2s (rplc i (Some e1) xs) /\ exists os, orplc i (Some e1) (ins (S (i + k)) e2s xs) = Some os. Proof. move=> xs i. elim: i xs => [|i IHi]. + case=> [|x xs] k e1 e2s; rewrite add0n ?rplc_none_none //=; case Hins: ins => [ins_r|] //=. - split => //. by exists (e1 :: ins_r). - by move: Hins => /ins_noneP; rewrite ltnNge add0n -ltnS; case (_ <= _). + case=> [|x xs] k e1 e2s //. rewrite addSn /= => /IHi A. move: (A e1 e2s) => [] /=. rewrite orplc_Swcons oins_Swcons => -> [os] ->. split => //. by exists (x :: os). Qed. Theorem rplc_insC_bef: forall xs i k e1 e2s, i < k -> k <= size xs -> orplc i (Some e1) (ins k e2s xs) = oins k e2s (rplc i (Some e1) xs) /\ exists os, orplc i (Some e1) (ins k e2s xs) = Some os. Proof. move=> ??? e1 e2s /le_ex [?] <-. rewrite ?addSn -?addnS => /rplc_insC_bef' A. move: (A e1 e2s) => []. rewrite addnS=> -> [os] ->. split=> //. by exists os. Qed. Lemma rplc_insC_in: forall xs i k e1 e2s e2s', rplc k (Some e1) e2s = Some e2s' -> orplc (i + k) (Some e1) (ins i e2s xs) = ins i e2s' xs. Proof. intros. elim: i xs k e1 e2s e2s' H => [|i IHi]. + move=> xs k e1 e2s e2s'; rewrite add0n //=. elim: k xs e1 e2s e2s' => [|k IHk] xs e1 e2s e2s'; case: e2s => [|e2 e2s] //; rewrite cat_cons //=. * by move=> [] [] <-; rewrite cat_cons. * by move=> /wcons_some [e2s''] [] /(IHk xs) -> ->. + by move=> [|x xs] k e1 e2s e2s' //=; rewrite addSn orplc_Swcons => /(IHi xs) ->. Qed. (* replace/remove commutation *) Lemma rplc_rmC_aft' xs i k e1 e2s rrm: rm i e2s xs = Some rrm -> (size e2s + i + k) < size xs -> orplc (i+k) (Some e1) (rm i e2s xs) = orm i e2s (rplc (size e2s + i + k) (Some e1) xs) /\ exists os, orplc (i+k) (Some e1) (rm i e2s xs) = Some os. Proof. elim: i xs k e1 e2s rrm => [|i IHi] xs k e1 e2s rrm. + rewrite ?addn0 add0n. elim: e2s k xs e1 => [[|k]|e2 e2s IHe2s k] [|x xs] e1; rewrite ?addn0 ?orm_id ?rm_id /=; try by eauto. - move=> _. rewrite add0n. case Hrplc: rplc => [a|] /=. by eauto. move: Hrplc => /rplc_noneP1. by rewrite ltnNge ltnS => ->. case Heq: (x == e2) => //. move/eqP: Heq <-. rewrite orm_0wcons addSn => H1. move: H1. eapply IHe2s => /(_ e1) /= [] -> [os] ->. + rewrite ?addSn ?addnS; move: xs IHi => [|x xs IHi]; first by case: e2s. rewrite rm_Scons orplc_Swcons => /wcons_some [rrm'] []. move => _1 _2. move: _2 _1 => _. move => _1 _2. move: _2 _1. rewrite addSn rplc_Scons orm_Swcons => /=. move => _1 _2. move: _2 _1. maxapply IHi => /(_ e1) [] -> [os] -> /=. by eauto. Qed. Theorem rplc_rmC_aft xs i k e1 e2s rrm: i <= k -> rm i e2s xs = Some rrm -> size e2s + k < size xs -> orplc k (Some e1) (rm i e2s xs) = orm i e2s (rplc (size e2s + k) (Some e1) xs) /\ exists os, orplc k (Some e1) (rm i e2s xs) = Some os. Proof. move => /le_ex [?] <-. rewrite ?addnA. apply rplc_rmC_aft' => /(_ e1) [] -> [os] -> /=. Qed. Lemma rplc_rmC_bef': forall i xs k e1 e2s rrm, rm (S (i+k)) e2s xs = Some rrm -> i < size xs -> orplc i (Some e1) (rm (S (i+k)) e2s xs) = orm (S (i+k)) e2s (rplc i (Some e1) xs) /\ exists os, orplc i (Some e1) (rm (S (i+k)) e2s xs) = Some os. Proof. elim => [|i IHi] xs k e1 e2s rrm. + rewrite add0n; elim: e2s xs k e1 => [|er e2s IHe2s] xs k e1 /=. * rewrite rm_id => _ /=. case: xs => [|x xs] //= _ . by eauto. * case: xs => [|x xs] //=; rewrite orplc_0wcons => /wcons_some [rrm'] [] -> /=. by eauto. + rewrite ?addSn ?addnS. case: xs => [|x xs] //=. case: e2s => [|e2 e2s] /=. - move=> _. case Hrplc: rplc => [rplc_r|] /=; first by eauto. by move: Hrplc => /rplc_noneP1; rewrite ltnNge ltnS => ->. - move => /wcons_some [rrm'] []. move => _1 _2. move: _2 _1 => _. rewrite orplc_Swcons ?orm_Swcons. maxapply IHi => /(_ e1) [] -> [os] -> /=. by eauto. Qed. Theorem rplc_rmC_bef xs i k e1 e2s rrm: i < k -> rm k e2s xs = Some rrm -> i < size xs -> orplc i (Some e1) (orm k e2s (Some xs)) = orm k e2s (rplc i (Some e1) xs) /\ exists os, orplc i (Some e1) (rm k e2s xs) = Some os. Proof. move=> /le_ex [?] <-; rewrite ?addSn. by apply rplc_rmC_bef' => /(_ e1) [] -> ? ->. Qed. Theorem rplc_rmC_in {xs i k y}: forall ys ers' ers, rplc i y ers = Some ers' -> orm k ers xs = Some ys -> orm k ers' (orplc (i + k) y xs) = Some ys. Proof. case: xs i k y => [xs|*//]; intros. case: y H => [y|] //=; last by rewrite rplc_none_none. elim: k xs i y ys ers ers' H0 => [|k IHk]. + move=> xs i; elim: i xs => [|i IHi] xs y ys [|er ers] ers' //=; case: xs => [|x xs] //=; case Heq: (x == er) => // ?; first by move=> [] <-; rewrite eq_refl. by move=> /wcons_some [ers''] [] ? ->; move/eqP: Heq ->; rewrite orm_0wcons (IHi xs y ys ers ers''). + by move=> [|x xs] i y ys [|er ers] ers'; rewrite ?addnS ?rplc_0none //= orm_Swcons => /wcons_some [ys' []] ? -> ?; rewrite (IHk _ _ _ ys' (er::ers)). Qed. (* relating other operations to nth *) Lemma ins_some_nth_aft {n ys}: forall xs es n2, n < n2 -> ins n2 es xs = Some ys -> nth n ys = nth n xs. Proof. elim: n ys => [|n IHn] ys [|x xs] [|e es] [|n2] //= Hltn /wcons_some [ys'] [] Hys' -> //=; by rewrite (IHn _ xs _ n2 _ Hys')//. Qed. Lemma rm_some_nth_aft: forall n xs ys es n2, n < n2 -> rm n2 es xs = Some ys -> nth n ys = nth n xs. Proof. elim => [|n IHn] [|x xs] ys [|e es] [|n2] //= Hltn; try move=> [] <- //=; move=> /wcons_some [ys'] [] Hys' -> //; rewrite (IHn xs _ _ n2 _ Hys') //. Qed. Lemma rm_some_nth_bef: forall n xs ys es n2, n <= n2 -> rm n es xs = Some ys -> nth n2 ys = nth (n2 + size es) xs. Proof. elim => [|n IHn] xs ys es n2. + move=> H; elim: xs es => [|x xs IHxs] [[] <- //|e es] //=; try by rewrite addn0. by case Heq: (x == e) => // /IHxs ->; rewrite addnS. + case: es => [|e es]; first by rewrite rm_id addn0 => _ [] ->. by case: xs => [|x xs] //= Hleq /wcons_some [ys'] [] ? ->; case: n2 Hleq => [|n2] // /= ?; rewrite (IHn xs _ (e::es)) //. Qed. Lemma rm_some_nth_in {k i xs}: forall ys es, i < size es -> rm k es xs = Some ys -> nth (i + k) xs = nth i es. Proof. by elim: k i xs => [|k IHk i]; [elim => [|i IHi] /=|]; move => [|x xs] ys [|e es] //=; [| |(rewrite addnS ?nth_nil_none //= => ? /wcons_some [ys'] [] ?; rewrite (IHk _ _ ys' (e::es)))]; case Heq: (x == e) => //; [move /eqP: Heq => <- | move => ??; rewrite (IHi _ ys es)]. Qed. Lemma ins_some_nth_bef {n xs}: forall ys es n2, n2 <= n -> ins n2 es xs = Some ys -> nth n xs = nth (size es + n) ys. Proof. elim: n xs => [|n IHn] xs ys es n2. + by rewrite leqn0 => /eqP -> /= [] <-; rewrite nth_app_next. + case: n2 => [_|n2] /=. by move=> [] <-; rewrite nth_app_next. by case: xs => [|x xs] // ? /wcons_some [ls'] [] ?; rewrite addnS (IHn _ ls' es n2) //= => ->. Qed. Lemma ins_some_nth_in {i k es ys xs} : k < size es -> ins i es xs = Some ys -> nth (i + k) ys = nth k es. Proof. elim: i xs ys => [|i IHi] xs ys. + move=> H /= [] <-; rewrite add0n. elim: k es H => [|k IHk] [|e es] //=. by move /IHk. + by case: xs => [|x xs] //= Hlt /wcons_some [zs] [] /(IHi xs zs Hlt) <- ->. Qed. Lemma rplc_nth_eq n xs ys z: rplc n (Some z) xs = Some ys -> nth n ys = Some z. Proof. elim: n xs ys => [|n IHn] [|x xs] [|y ys] //=. - by move=> [] ->. - by case: rplc. - by case Hrplc: rplc => [ls|] //= []; move: Hrplc => /IHn /= <- _ ->. Qed. Lemma rplc_nth_neq' n1 n2 xs ys z: n1 < n2 -> rplc n1 z xs = Some ys -> nth n2 xs = nth n2 ys. Proof. case: z => [z|] //; last by rewrite rplc_none_none. elim: n1 xs ys n2 => [|n1 IHn1] [|x xs] ys n2 //=; case: n2 => [|n2] //= ?. + by move => [] <-. + by move => /wcons_some [ys'] [] ? ->; rewrite (IHn1 _ ys'). Qed. Lemma rplc_nth_neq'' n1 n2 xs ys z: n1 < n2 -> rplc n2 z xs = Some ys -> nth n1 xs = nth n1 ys. Proof. case: z => [z|] //; last by rewrite rplc_none_none. elim: n2 xs ys n1 => [|n2 IHn2] [|x xs] ys [|n1] //= ? /wcons_some [ys'[? ->]] //. by apply (IHn2 _ ys'). Qed. Theorem rplc_nth_neq n1 n2 xs ys z: n1 != n2 -> rplc n2 z xs = Some ys -> nth n1 xs = nth n1 ys. Proof. rewrite neq_ltn => /orP []; [exact: rplc_nth_neq'' |exact: rplc_nth_neq']. Qed. (* remove/cut properties *) Lemma rm_cut : forall xs n1 n2 es1 es2 ys1 ys2, orm n1 es1 xs = Some ys1 -> orm n2 es2 xs = Some ys2 -> n1 <= n2 -> n2 <= n1 + size es1 -> orm n1 (cut es2 0 (n1 + size es1 - n2)) (orm n1 es1 xs) = orm n1 (cut es1 (n2 - n1) (size es2)) (orm n2 es2 xs) /\ exists os, orm n1 (cut es1 (n2 - n1) (size es2)) (orm n2 es2 xs) = Some os. Proof. move=> [xs|] n1 //; elim: n1 xs => [|n1 IHn1]. + elim => [|x xs IHxs]. - move=> n2 [|??] [|??] //= [|??] [|??] //= _ _ _. rewrite leqn0 => /eqP ->. rewrite subnn. by eauto. - move=> n2 [|e1 es1] [|e2 es2] ys1 ys2 /= H1 H2 H3; try (rewrite leqn0 => /eqP Hn2; move: H2; rewrite Hn2 subnn ?orm_id; case: (x == e2); by eauto). * case: n2 H2 H3 => [|n2] //. by eauto. case: n2 H3 => [|n2] // _ _; rewrite add0n ?subn0; try case: subn => [|?]; move: H1; case: (x == e1) => //; rewrite ?cut_id orm_id => ->; by eauto. * move: H1. case Heq: (x == e1) => // /IHxs A. move: H2. case: n2 H3 => [|n2] _. - case: (x == e2) => // /A B. move: (B (leq0n _) (leq0n _)) => /=. rewrite add0n ?subn0 => [] [] -> [os] ->; by eauto. - move => /wcons_some [ys2'] [] /A B _. rewrite add0n => /(B (leq0n _)) /= []. rewrite subn0 => ->. move/eqP: Heq ->. rewrite orm_0wcons => [] [os] ->. by eauto. + move=> [|x xs] [|n2] es1 es2 ys1 ys2 //; rewrite ?cons_wcons ?orm_Swcons subSS. - move: es1 es2 => [|??] [|??] //=; case: subn; case: subn => //=; by eauto. move=> /wcons_some [ys1'] [] /IHn1 A _ /wcons_some [ys2'] [] /A B _ /B C. rewrite addSn. move => /C [] -> [os] -> /=. by eauto. Qed. (* inversion theorems *) Lemma rm_ins_id : forall n xs es ys, ins n es xs = Some ys -> rm n es ys = Some xs. Proof. elim => [|n IHn] xs es ys. + elim: es xs ys => [[|x xs]|e es IHes xs] ys //= [] <-; try (by rewrite rm_id). rewrite orm_some cons_wcons orm_0wcons /= (IHes xs) //. + case: xs => [|x xs] //. rewrite oins_some cons_wcons oins_Swcons => /wcons_some [ys'] []. move=> /IHn <- ->. by rewrite orm_some cons_wcons orm_Swcons. Qed. Lemma ins_rm_id : forall n xs es ys, size es > 0 -> rm n es xs = Some ys -> ins n es ys = Some xs. Proof. elim => [|n IHn] xs es ys. + move=> _. elim: es xs ys => [|e es IHes] [|x xs] ys //=; try (by rewrite rm_id => -> /=). case Heq: (x == e) => // /IHes [] <-. by move/eqP: Heq ->. + case: xs => [|x xs] //. case: es => //= [] [] <-. move => _1 _2. move: _2 _1. rewrite orm_some cons_wcons orm_Swcons. move=> /wcons_some => [] [ys'] []. move => _1 _2. move: _2 _1 => -> /=. maxapply IHn. by move=> /= ->. Qed. Section AboutSizes. Theorem cutSZ (xs : seq X) i n: size (cut xs i n) = if (i + n <= size xs) then size xs - n else if (i <= size xs) then i else size xs. Proof. elim: i xs n => [|i IHi] xs n /=. + elim: n xs => [|n IHn] [|x xs] //=. rewrite IHn. nat_norm. rewrite -addn1 -(addn1 (size xs)) leq_add2r. case Hleq: (n <= size xs) => //=. by rewrite ?addn1 subSS. + move: xs => [|x xs] //=. rewrite IHi. nat_norm. rewrite -(addn1 (i + n)) -(addn1 (size xs)) leq_add2r. case Hleq: (i + n <= size xs). move: (Hleq) => /leq_addWl. rewrite -addn1 addnC => /addnBA ->. by rewrite addnC. rewrite -(addn1 i) leq_add2r. case: (i <= size xs); ssromega. Qed. Theorem cut_lenleq (xs : seq X) i n: size (cut xs i n) <= size xs. Proof. move: (cutSZ xs i n). case: ifP => Hleq. - move: (leq_subr n (size xs)). by (move => _1 _2; move: _2 _1 => ->). - case: ifP => Hleq'; move=> /eq_leq =>//. move: Hleq'. move => _1 _2; move: _2 _1. by apply leq_trans. Qed. End AboutSizes. Section Miscellanea. Fixpoint find {Z : Type} p (xs : seq Z) : option Z := match xs with | xh :: xt => if p xh then Some xh else find p xt | _ => None end. Lemma foldl_map (T1 T2 S : Type) (f : S -> T2 -> S) (g : T1 -> T2) (x : seq T1) (r : S): foldl f r (map g x) = foldl (fun x => (f x) \o g) r x. by elim: x r => [|x xs IH] //=. Qed. Lemma filter_filter {p p' : X -> bool} {xs} : filter p (filter p' xs) = filter p' (filter p xs). elim: xs => //= [xh xt IHxs]. case P1: (p xh); case P2: (p' xh); rewrite /= ?P1 ?P2 IHxs //. Qed. Lemma all_filter p q (cs :seq X): all p cs -> all p [seq x <- cs | q x]. by elim: cs => [|c cs IH] //= /andP [] A0 /IH A1; case A2: q => /=; rewrite ?A0 A1. Qed. Lemma has_filter p q (xs : seq X): p --- q -> has q (filter p xs) = has q xs. intros A1. elim: xs => [|x xs IH] //=. move: (A1 x). case A0: (p x). + by rewrite /= IH. + by move => -> //. Qed. Lemma map_inj {X' : eqType} (f : X -> X') x s: injective f -> ((f x) \in (map f s)) = (x \in s). move => B0. elim: s => [|c s IH] //=. case A0: (x == c) => /=. + move: A0 => /eqP ->. by rewrite /in_mem /= ?eq_refl. + move: IH. rewrite /in_mem /=. case A1: eq_op. * move: A1 A0 => /eqP /B0 ->. by rewrite eq_refl. * by move: A0 => -> ->. Qed. Lemma find_absent {A p xs}: find p xs = @None A <-> has p xs = false. by elim: xs => // a l [IHa IHb] /=; case: (p a); split. Qed. Lemma has_find {A p xs}: has p xs = true -> exists (x : A), find p xs = Some x. case H: (find p xs) => [x|]. + by exists x. + by move => G; apply find_absent in H; rewrite H in G. Qed. Lemma find_pred {xs p} {x : X}: find p xs = Some x -> p x. elim: xs => [|xh xt IHxs] //. + by rewrite /=; case H: (p xh) => // [] [] <-. Qed. Lemma find_filter p q (xs : seq X): p --- q -> find q (filter p xs) = find q xs. intros A1. elim: xs => [|x xs IH] //=. move: (A1 x). case A0: (p x). + by rewrite /= IH. + by move => -> //. Qed. Lemma find_has {p xs} {x : X}: find p xs = Some x -> has p xs = true. by elim: xs => [|xh xt IHxs]; rewrite //=; case P: (p xh) => //. Qed. End Miscellanea. (* Sequence difference *) Definition seqminus (x y : seq X) := filter (fun z => z \notin y) x. Section SeqMinus. Notation "X \ Y" := (seqminus X Y) (at level 40, left associativity). Lemma sum_setminus (f : X -> nat) (S1 S2 : seq X): foldl addn 0 (map f (S1 \ S2)) <= foldl addn 0 (map f S1). elim: S1 S2 => [|s cs IH] S2 //=. case A0: (in_mem) => /=; move: (IH S2); rewrite ?add0n ?(fadd (f s)). + move: (foldl _ _ _) => a. move: (foldl _ _ _) => b. rewrite -{2}(add0n (a)). by apply leq_add. + by apply leq_add. Qed. Lemma seqminus_nil (l : seq X): l \ [::] = l. elim: l => [|t l IH] //=. by rewrite IH. Qed. Lemma seqminus_nil' (l : seq X): [::] \ l = [::]. elim: l => [|t l IH] //=. Qed. Lemma seqminus_cons (l l2 : seq X) x: x \notin l -> l \ (x :: l2) = l \ l2. elim: l => [|y l IH] //=. rewrite /in_mem /= eq_sym. case A0: eq_op => //= A1. by rewrite IH. Qed. Lemma seqminus_cons' (l l2 : seq X) x: x \notin l2 -> (x :: l) \ l2 = x :: (l \ l2). by move => /= ->. Qed. Corollary seqminus_singleton (l : seq X) x: x \notin l -> l \ [:: x] = l. move: (seqminus_cons l [::] x). by rewrite /= seqminus_nil. Qed. Import Bool. Lemma notin_setminus (l : seq X) x: x \notin (l \ [::x]). elim: l => [|z l IH] //=. case A0: (in_mem z) => //=. move: A0. by rewrite /in_mem /= orb_false_r eq_sym => ->. Qed. Corollary uniq_setminus (l l2 : seq X): uniq l -> uniq (l \ l2). rewrite /seqminus. apply filter_uniq. Qed. Lemma filter_and (l : seq X) p1 p2: filter p2 (filter p1 l) = filter (fun x => p1 x && p2 x) l. elim: l => [|x l IH] //=. case A0: (p1 x) => //=. + case A1: (p2 x) => //=. by rewrite IH. Qed. Lemma seqminus_cat (l l1 l2 : seq X): l \ l1 \ l2 = l \ (l1 ++ l2). rewrite /seqminus. rewrite filter_and. apply eq_filter => x /=. by rewrite mem_cat /= negb_orb. Qed. Lemma seqminus_p1 (l1 l2 : seq X) x: x \notin l2 -> l2 \ (l1 \ [:: x]) = l2 \ l1. rewrite /seqminus => A0. apply eq_in_filter => z A1. rewrite mem_filter /= /in_mem /= orb_false_r. case A2: eq_op => //=. by move: A2 A1 A0 => /eqP -> ->. Qed. End SeqMinus. End Lists. Notation "X \ Y" := (seqminus X Y) (at level 40, left associativity). Lemma map_seq_minus {X X' : eqType} (s1 s2 : seq X) (f : X -> X'): injective f -> map f (s1 \ s2) = (map f s1) \ (map f s2). move => B0. rewrite /seqminus. elim: s1 => [|x s1 IH] //=. rewrite map_inj //. case A1: (x \notin s2) => /=; by rewrite IH. Qed.